From fa62e095e689133ca7303c5b053cd010f9e70d18 Mon Sep 17 00:00:00 2001 From: Kevin Lyda Date: Mon, 5 May 2025 19:00:20 +0100 Subject: [PATCH] Remove all but the 91b release --- Makefile | 6 - TODO | 12 - convert-vms-record-fmt.c | 32 - decus/1989b/bulletin/allmacs.mar | 282 -- decus/1989b/bulletin/bullcoms1.hlp | 618 --- decus/1989b/bulletin/bullcoms2.hlp | 763 --- decus/1989b/bulletin/bullet1.com | 790 ---- decus/1989b/bulletin/bullet2.com | 1080 ----- decus/1989b/bulletin/bulletin.for | 1411 ------ decus/1989b/bulletin/bulletin0.for | 1429 ------ decus/1989b/bulletin/bulletin1.for | 1554 ------ decus/1989b/bulletin/bulletin2.for | 1531 ------ decus/1989b/bulletin/bulletin3.for | 1599 ------- decus/1989b/bulletin/bulletin4.for | 1715 ------- decus/1989b/bulletin/bulletin5.for | 1608 ------- decus/1989b/bulletin/bulletin6.for | 1529 ------ decus/1989b/bulletin/bulletin7.for | 1769 ------- decus/1989b/bulletin/bulletin8.for | 1472 ------ decus/1989b/bulletin/bulletin9.for | 1775 ------- decus/1989b/bulletin/bulletin_ann.txt | 324 -- decus/1989b/bulletin/bulletin_howto_get.txt | 26 - decus/1989b/bulletin/pmdf.com | 660 --- decus/lt87a/bulletin/.listing | Bin 928 -> 0 bytes decus/lt87a/bulletin/bulallmacs.mar | 204 - decus/lt87a/bulletin/bullcoms.hlp | 601 --- decus/lt87a/bulletin/bullet.com | 864 ---- decus/lt87a/bulletin/bulletin.for | 973 ---- decus/lt87a/bulletin/bulletin0.for | 928 ---- decus/lt87a/bulletin/bulletin1.for | 1073 ----- decus/lt87a/bulletin/bulletin2.for | 961 ---- decus/lt87a/bulletin/bulletin3.for | 1269 ----- decus/lt87a/bulletin/bulletin4.for | 1144 ----- decus/lt87a/bulletin/bulletin5.for | 1073 ----- decus/lt87a/bulletin/bulletin6.for | 1120 ----- decus/lt87a/bulletin/bulletinann.txt | 190 - decus/lt89b1/bulletin/aaareadme.1st | 158 - decus/lt89b1/bulletin/aaareadme.txt | 24 - decus/lt89b1/bulletin/allmacs.mar | 270 -- decus/lt89b1/bulletin/board_digest.com | 77 - decus/lt89b1/bulletin/board_special.com | 108 - decus/lt89b1/bulletin/bullcom.cld | 418 -- decus/lt89b1/bulletin/bullcoms1.hlp | 610 --- decus/lt89b1/bulletin/bullcoms2.hlp | 755 --- decus/lt89b1/bulletin/bulldir.inc | 33 - decus/lt89b1/bulletin/bullet1.com | 778 --- decus/lt89b1/bulletin/bullet2.com | 1074 ----- decus/lt89b1/bulletin/bulletin.cld | 36 - decus/lt89b1/bulletin/bulletin.com | 2 - decus/lt89b1/bulletin/bulletin.for | 1413 ------ decus/lt89b1/bulletin/bulletin.hlp | 108 - decus/lt89b1/bulletin/bulletin.info | 411 -- decus/lt89b1/bulletin/bulletin.lnk | 3 - decus/lt89b1/bulletin/bulletin0.for | 1453 ------ decus/lt89b1/bulletin/bulletin1.for | 1565 ------- decus/lt89b1/bulletin/bulletin2.for | 1499 ------ decus/lt89b1/bulletin/bulletin3.for | 1589 ------- decus/lt89b1/bulletin/bulletin4.for | 1703 ------- decus/lt89b1/bulletin/bulletin5.for | 1606 ------- decus/lt89b1/bulletin/bulletin6.for | 1586 ------- decus/lt89b1/bulletin/bulletin7.for | 1763 ------- decus/lt89b1/bulletin/bulletin8.for | 1556 ------ decus/lt89b1/bulletin/bulletin9.for | 1826 -------- decus/lt89b1/bulletin/bullfiles.inc | 28 - decus/lt89b1/bulletin/bullfolder.inc | 46 - decus/lt89b1/bulletin/bullmain.cld | 26 - decus/lt89b1/bulletin/bullstart.com | 6 - decus/lt89b1/bulletin/bulluser.inc | 42 - decus/lt89b1/bulletin/create.com | 19 - decus/lt89b1/bulletin/dclremote.com | 32 - decus/lt89b1/bulletin/handout.txt | 268 -- decus/lt89b1/bulletin/install.com | 18 - decus/lt89b1/bulletin/install_remote.com | 130 - decus/lt89b1/bulletin/instruct.com | 6 - decus/lt89b1/bulletin/instruct.txt | 8 - decus/lt89b1/bulletin/login.com | 28 - decus/lt89b1/bulletin/makefile | 74 - decus/lt89b1/bulletin/nonsystem.txt | 16 - decus/lt89b1/bulletin/pmdf.com | 743 --- decus/lt89b1/bulletin/remote.com | 48 - decus/lt89b1/bulletin/writemsg.txt | 36 - decus/vax82b/bulletin/aaareadme.txt | 110 - decus/vax82b/bulletin/bc.com | 32 - decus/vax82b/bulletin/bcmail.com | 54 - decus/vax82b/bulletin/bcmail.txt | 9 - decus/vax82b/bulletin/build.com | 4 - decus/vax82b/bulletin/bull.for | 475 -- decus/vax82b/bulletin/bullcheck.for | 106 - decus/vax82b/bulletin/bullcom.for | 20 - decus/vax82b/bulletin/bulletin.hlp | 104 - decus/vax82b/bulletin/bulletin.rno | 123 - decus/vax82b/bulletin/bullintro.rno | 33 - decus/vax82b/bulletin/bullintro.txt | 26 - decus/vax82b/bulletin/bullparse.mar | 219 - decus/vax85c/bulletin/aaareadme.doc | 73 - decus/vax85c/bulletin/aaareadme.rno | 23 - decus/vax85c/bulletin/aaareadme.txt | 44 - decus/vax85c/bulletin/announce.mai | 78 - decus/vax85c/bulletin/bboard.com | 5 - decus/vax85c/bulletin/bulet.com | 194 - decus/vax85c/bulletin/bullcom.cld | 36 - decus/vax85c/bulletin/bullcoms.hlp | 135 - decus/vax85c/bulletin/bulldir.inc | 8 - decus/vax85c/bulletin/bullet.mai | 946 ---- decus/vax85c/bulletin/bulletin.com | 2 - decus/vax85c/bulletin/bulletin.for | 1817 ------- decus/vax85c/bulletin/bulletin.hlp | 17 - decus/vax85c/bulletin/bulletin.lnk | 2 - decus/vax85c/bulletin/bulletin.txt | 49 - decus/vax85c/bulletin/bullfiles.inc | 27 - decus/vax85c/bulletin/bullflag.inc | 23 - decus/vax85c/bulletin/bullmain.cld | 4 - decus/vax85c/bulletin/bullstart.com | 3 - decus/vax85c/bulletin/bullsubs.for | 1421 ------ decus/vax85c/bulletin/bulluser.inc | 8 - decus/vax85c/bulletin/clidef.mar | 3 - decus/vax85c/bulletin/create.com | 10 - decus/vax85c/bulletin/hpwd.mar | 223 - decus/vax85c/bulletin/install.com | 8 - decus/vax85c/bulletin/instruct.txt | 6 - decus/vax85c/bulletin/login.com | 2 - decus/vax85c/bulletin/netfiles/announce.mai | 78 - decus/vax85c/bulletin/netfiles/file1.mai | 31 - decus/vax85c/bulletin/netfiles/file2.mai | 1832 -------- decus/vax85c/bulletin/netfiles/file3.mai | 1436 ------ decus/vax85c/bulletin/netfiles/file4.mai | 209 - decus/vax85c/bulletin/netfiles/file5.mai | 960 ---- decus/vax85c/bulletin/setuic.mar | 54 - decus/vax85c/bulletin/setuser.mar | 83 - decus/vax85c/bulletin/startup.com | 10 - decus/vax85c/bulletin/useropen.mar | 154 - decus/vax86c/bulletin/aaareadme.txt | 12 - decus/vax86c/bulletin/allmacs.mar | 348 -- decus/vax86c/bulletin/bullet.com | 1170 ----- decus/vax86c/bulletin/bulletin.for | 1742 ------- decus/vax86c/bulletin/bulletin.txt | 41 - decus/vax86c/bulletin/bullsub0.for | 1436 ------ decus/vax86c/bulletin/bullsub1.for | 1454 ------ decus/vax86c/bulletin/bullsub2.for | 1478 ------ decus/vax86c/bulletin/bullsub3.for | 1638 ------- decus/vax87a/bulletin/bulletin.for | 898 ---- decus/vax87a/bulletin/bulletin0.for | 911 ---- decus/vax87a/bulletin/bulletin1.for | 1043 ----- decus/vax87a/bulletin/bulletin2.for | 913 ---- decus/vax87a/bulletin/bulletin3.for | 1262 ----- decus/vax87a/bulletin/bulletin4.for | 1115 ----- decus/vax87a/bulletin/bulletin5.for | 1111 ----- decus/vax87a/bulletin/bulletin6.for | 1034 ---- decus/vax87a/bulletin/bulletinv2.doc | 150 - decus/vax87d/bulletin/bulletin.for | 1045 ----- decus/vax87d/bulletin/bulletin.txt | 206 - decus/vax87d/bulletin/bulletin0.for | 1136 ----- decus/vax87d/bulletin/bulletin1.for | 1235 ----- decus/vax87d/bulletin/bulletin2.for | 1221 ----- decus/vax87d/bulletin/bulletin3.for | 1416 ------ decus/vax87d/bulletin/bulletin4.for | 1219 ----- decus/vax87d/bulletin/bulletin5.for | 1300 ----- decus/vax87d/bulletin/bulletin6.for | 1431 ------ decus/vax87d/bulletin/bulletinann.txt | 24 - decus/vax88a2/bulletin/aaareadme.1st | 111 - decus/vax88a2/bulletin/allmacs.mar | 203 - decus/vax88a2/bulletin/board_digest.com | 77 - decus/vax88a2/bulletin/board_special.com | 107 - decus/vax88a2/bulletin/bull_command.com | 7 - decus/vax88a2/bulletin/bullcom.cld | 312 -- decus/vax88a2/bulletin/bullcoms1.hlp | 462 -- decus/vax88a2/bulletin/bullcoms2.hlp | 491 -- decus/vax88a2/bulletin/bulldir.inc | 19 - decus/vax88a2/bulletin/bullet1.com | 698 --- decus/vax88a2/bulletin/bullet2.com | 687 --- decus/vax88a2/bulletin/bulletin.com | 2 - decus/vax88a2/bulletin/bulletin.for | 1123 ----- decus/vax88a2/bulletin/bulletin.hlp | 109 - decus/vax88a2/bulletin/bulletin.lnk | 3 - decus/vax88a2/bulletin/bulletin.tex | 234 - decus/vax88a2/bulletin/bulletin0.for | 1221 ----- decus/vax88a2/bulletin/bulletin1.for | 1326 ------ decus/vax88a2/bulletin/bulletin2.for | 1269 ----- decus/vax88a2/bulletin/bulletin3.for | 1346 ------ decus/vax88a2/bulletin/bulletin4.for | 1446 ------ decus/vax88a2/bulletin/bulletin5.for | 1438 ------ decus/vax88a2/bulletin/bulletin6.for | 1328 ------ decus/vax88a2/bulletin/bulletin7.for | 1460 ------ decus/vax88a2/bulletin/bulletin8.for | 1246 ----- decus/vax88a2/bulletin/bullfiles.inc | 37 - decus/vax88a2/bulletin/bullfolder.inc | 54 - decus/vax88a2/bulletin/bullmain.cld | 22 - decus/vax88a2/bulletin/bullstart.com | 5 - decus/vax88a2/bulletin/bulluser.inc | 42 - decus/vax88a2/bulletin/create.com | 14 - decus/vax88a2/bulletin/handout.txt | 268 -- decus/vax88a2/bulletin/help.com | 5 - decus/vax88a2/bulletin/install.com | 17 - decus/vax88a2/bulletin/instruct.com | 6 - decus/vax88a2/bulletin/instruct.txt | 8 - decus/vax88a2/bulletin/login.com | 10 - decus/vax88a2/bulletin/makefile | 71 - decus/vax88a2/bulletin/nonsystem.txt | 16 - decus/vax88a3/bulletin/bulletin.for | 1180 ----- decus/vax88a3/bulletin/bulletin0.for | 1279 ----- decus/vax88a3/bulletin/bulletin1.for | 1385 ------ decus/vax88a3/bulletin/bulletin3.for | 1407 ------ decus/vax88a3/bulletin/bulletin4.for | 1507 ------ decus/vax88a3/bulletin/bulletin5.for | 1495 ------ decus/vax88a3/bulletin/bulletin6.for | 1385 ------ decus/vax88a3/bulletin/bulletin7.for | 1513 ------ decus/vax88a3/bulletin/bulletin7bugbug.txt | 19 - decus/vax88a3/bulletin/bulletinann.txt | 245 - decus/vax88b1/bulletin/aaareadme.1st | 121 - decus/vax88b1/bulletin/allmacs.mar | 201 - decus/vax88b1/bulletin/board_digest.com | 77 - decus/vax88b1/bulletin/board_special.com | 107 - decus/vax88b1/bulletin/bullcom.cld | 342 -- decus/vax88b1/bulletin/bullcoms1.hlp | 539 --- decus/vax88b1/bulletin/bullcoms2.hlp | 538 --- decus/vax88b1/bulletin/bulldir.inc | 28 - decus/vax88b1/bulletin/bullet1.com | 745 --- decus/vax88b1/bulletin/bullet2.com | 972 ---- decus/vax88b1/bulletin/bulletin.cld | 34 - decus/vax88b1/bulletin/bulletin.com | 2 - decus/vax88b1/bulletin/bulletin.for | 1182 ----- decus/vax88b1/bulletin/bulletin.hlp | 108 - decus/vax88b1/bulletin/bulletin.lnk | 3 - decus/vax88b1/bulletin/bulletin.message | 21 - decus/vax88b1/bulletin/bulletin.message2 | 251 - decus/vax88b1/bulletin/bulletin.message3 | 24 - decus/vax88b1/bulletin/bulletin0.for | 1249 ----- decus/vax88b1/bulletin/bulletin1.for | 1255 ----- decus/vax88b1/bulletin/bulletin2.for | 1374 ------ decus/vax88b1/bulletin/bulletin3.for | 1505 ------ decus/vax88b1/bulletin/bulletin4.for | 1491 ------ decus/vax88b1/bulletin/bulletin5.for | 1464 ------ decus/vax88b1/bulletin/bulletin6.for | 1387 ------ decus/vax88b1/bulletin/bulletin7.for | 1609 ------- decus/vax88b1/bulletin/bulletin8.for | 1294 ----- decus/vax88b1/bulletin/bulletin9.for | 767 --- decus/vax88b1/bulletin/bullfiles.inc | 37 - decus/vax88b1/bulletin/bullfolder.inc | 46 - decus/vax88b1/bulletin/bullmain.cld | 24 - decus/vax88b1/bulletin/bullstart.com | 5 - decus/vax88b1/bulletin/bulluser.inc | 42 - decus/vax88b1/bulletin/create.com | 15 - decus/vax88b1/bulletin/dclremote.com | 32 - decus/vax88b1/bulletin/handout.txt | 268 -- decus/vax88b1/bulletin/install.com | 17 - decus/vax88b1/bulletin/install_remote.com | 130 - decus/vax88b1/bulletin/instruct.com | 6 - decus/vax88b1/bulletin/instruct.txt | 8 - decus/vax88b1/bulletin/login.com | 13 - decus/vax88b1/bulletin/makefile | 74 - decus/vax88b1/bulletin/nonsystem.txt | 16 - decus/vax88b1/bulletin/remote.com | 48 - decus/vax88b1/bulletin/v5/aaareadme.1st | 1 - decus/vax88b5/bulletin/bulletin.bwr | 27 - decus/vax88b5/bulletin/bulletin.for | 1197 ----- decus/vax88b5/bulletin/bulletin0.for | 1261 ----- decus/vax88b5/bulletin/bulletin1.for | 1270 ----- decus/vax88b5/bulletin/bulletin2.for | 1389 ------ decus/vax88b5/bulletin/bulletin3.for | 1520 ------ decus/vax88b5/bulletin/bulletin4.for | 1506 ------ decus/vax88b5/bulletin/bulletin5.for | 1479 ------ decus/vax88b5/bulletin/bulletin6.for | 1399 ------ decus/vax88b5/bulletin/bulletin7.for | 1621 ------- decus/vax88b5/bulletin/bulletin8.for | 1309 ------ decus/vax88b5/bulletin/bulletin9.for | 782 ---- decus/vax88b5/bulletin/bulletin_ann.txt | 209 - .../bulletin/bulletin_warning_vms_v5.txt | 23 - decus/vax89a2/bulletin/aaareadme.1st | 177 - decus/vax89a2/bulletin/aaareadme.too | 311 -- decus/vax89a2/bulletin/allmacs.mar | 270 -- decus/vax89a2/bulletin/board_digest.com | 77 - decus/vax89a2/bulletin/board_special.com | 108 - decus/vax89a2/bulletin/bullcom.cld | 416 -- decus/vax89a2/bulletin/bullcoms1.hlp | 606 --- decus/vax89a2/bulletin/bullcoms2.hlp | 751 --- decus/vax89a2/bulletin/bulldir.inc | 33 - decus/vax89a2/bulletin/bullet1.com | 782 ---- decus/vax89a2/bulletin/bullet2.com | 1067 ----- decus/vax89a2/bulletin/bulletin.cld | 35 - decus/vax89a2/bulletin/bulletin.com | 2 - decus/vax89a2/bulletin/bulletin.for | 1400 ------ decus/vax89a2/bulletin/bulletin.hlp | 108 - decus/vax89a2/bulletin/bulletin.lnk | 3 - decus/vax89a2/bulletin/bulletin0.for | 1418 ------ decus/vax89a2/bulletin/bulletin1.for | 1543 ------ decus/vax89a2/bulletin/bulletin2.for | 1520 ------ decus/vax89a2/bulletin/bulletin3.for | 1588 ------- decus/vax89a2/bulletin/bulletin4.for | 1676 ------- decus/vax89a2/bulletin/bulletin5.for | 1596 ------- decus/vax89a2/bulletin/bulletin6.for | 1502 ------ decus/vax89a2/bulletin/bulletin7.for | 1750 ------- decus/vax89a2/bulletin/bulletin8.for | 1460 ------ decus/vax89a2/bulletin/bulletin9.for | 1763 ------- decus/vax89a2/bulletin/bullfiles.inc | 28 - decus/vax89a2/bulletin/bullfolder.inc | 46 - decus/vax89a2/bulletin/bullmain.cld | 25 - decus/vax89a2/bulletin/bullstart.com | 6 - decus/vax89a2/bulletin/bulluser.inc | 42 - decus/vax89a2/bulletin/create.com | 19 - decus/vax89a2/bulletin/createrest.com | 20 - decus/vax89a2/bulletin/dclremote.com | 32 - decus/vax89a2/bulletin/handout.txt | 268 -- decus/vax89a2/bulletin/install.com | 18 - decus/vax89a2/bulletin/install_remote.com | 130 - decus/vax89a2/bulletin/instruct.com | 6 - decus/vax89a2/bulletin/instruct.txt | 8 - decus/vax89a2/bulletin/login.com | 25 - decus/vax89a2/bulletin/makefile | 74 - decus/vax89a2/bulletin/nonsystem.txt | 16 - decus/vax89a2/bulletin/pmdf.com | 648 --- decus/vax89a2/bulletin/remote.com | 48 - decus/vax89a2/bulletin/writemsg.txt | 36 - decus/vax90a/bulletin/aaa-readme.net-txt | 209 - decus/vax90a/bulletin/aaareadme.1st | 161 - decus/vax90a/bulletin/aaareadme.txt | 56 - decus/vax90a/bulletin/allmacs.mar | 270 -- decus/vax90a/bulletin/board_digest.com | 77 - decus/vax90a/bulletin/board_special.com | 108 - decus/vax90a/bulletin/bullcom.cld | 419 -- decus/vax90a/bulletin/bullcoms1.hlp | 628 --- decus/vax90a/bulletin/bullcoms2.hlp | 761 --- decus/vax90a/bulletin/bulldir.inc | 33 - decus/vax90a/bulletin/bullet1.com | 778 --- decus/vax90a/bulletin/bullet2.com | 1075 ----- decus/vax90a/bulletin/bulletin.cld | 36 - decus/vax90a/bulletin/bulletin.com | 2 - decus/vax90a/bulletin/bulletin.for | 1436 ------ decus/vax90a/bulletin/bulletin.hlp | 108 - decus/vax90a/bulletin/bulletin.lnk | 3 - decus/vax90a/bulletin/bulletin0.for | 1494 ------ decus/vax90a/bulletin/bulletin1.for | 1565 ------- decus/vax90a/bulletin/bulletin2.for | 1518 ------ decus/vax90a/bulletin/bulletin3.for | 1594 ------- decus/vax90a/bulletin/bulletin4.for | 1703 ------- decus/vax90a/bulletin/bulletin5.for | 1614 ------- decus/vax90a/bulletin/bulletin6.for | 1586 ------- decus/vax90a/bulletin/bulletin7.for | 1845 -------- decus/vax90a/bulletin/bulletin8.for | 1567 ------- decus/vax90a/bulletin/bulletin9.for | 1860 -------- decus/vax90a/bulletin/bulletin_wheretoget.txt | 26 - decus/vax90a/bulletin/bullfiles.inc | 28 - decus/vax90a/bulletin/bullfolder.inc | 46 - decus/vax90a/bulletin/bullmain.cld | 26 - decus/vax90a/bulletin/bullstart.com | 6 - decus/vax90a/bulletin/bulluser.inc | 42 - decus/vax90a/bulletin/create.com | 19 - decus/vax90a/bulletin/dclremote.com | 32 - decus/vax90a/bulletin/handout.txt | 268 -- decus/vax90a/bulletin/install.com | 18 - decus/vax90a/bulletin/install_remote.com | 130 - decus/vax90a/bulletin/instruct.com | 6 - decus/vax90a/bulletin/instruct.txt | 8 - decus/vax90a/bulletin/login.com | 28 - decus/vax90a/bulletin/makefile | 74 - decus/vax90a/bulletin/nonsystem.txt | 16 - decus/vax90a/bulletin/pmdf.com | 743 --- decus/vax90a/bulletin/remote.com | 48 - decus/vax90a/bulletin/writemsg.txt | 36 - .../bulletin-net90b/bulletin_bugfix0.src | 493 -- .../bulletin-net90b/bulletin_bugfix1.src | 54 - decus/vax90b1/bulletin/aaareadme.1st | 166 - decus/vax90b1/bulletin/aaareadme.txt | 252 - decus/vax90b1/bulletin/announce.txt | 219 - decus/vax90b1/bulletin/board_digest.com | 77 - decus/vax90b1/bulletin/board_special.com | 108 - decus/vax90b1/bulletin/bullcom.cld | 437 -- decus/vax90b1/bulletin/bullcoms1.hlp | 740 --- decus/vax90b1/bulletin/bullcoms2.hlp | 784 ---- decus/vax90b1/bulletin/bulletin.cld | 40 - decus/vax90b1/bulletin/bulletin.com | 2 - decus/vax90b1/bulletin/bulletin.hlp | 137 - decus/vax90b1/bulletin/bulletin.lnk | 3 - decus/vax90b1/bulletin/bulletin10.for | 2106 --------- decus/vax90b1/bulletin/bullmain.cld | 30 - decus/vax90b1/bulletin/bullstart.com | 6 - decus/vax90b1/bulletin/create.com | 19 - decus/vax90b1/bulletin/dclremote.com | 32 - decus/vax90b1/bulletin/handout.txt | 268 -- decus/vax90b1/bulletin/install.com | 18 - decus/vax90b1/bulletin/install_remote.com | 130 - decus/vax90b1/bulletin/instruct.com | 6 - decus/vax90b1/bulletin/instruct.txt | 8 - decus/vax90b1/bulletin/login.com | 28 - decus/vax90b1/bulletin/makefile | 74 - decus/vax90b1/bulletin/nonsystem.txt | 16 - decus/vax90b1/bulletin/pmdf.com | 747 --- decus/vax90b1/bulletin/remote.com | 48 - .../bulletin/vlt90b/bulletin/allmacs.mar | 270 -- .../bulletin/vlt90b/bulletin/bulldir.inc | 33 - .../bulletin/vlt90b/bulletin/bulletin.for | 1623 ------- .../bulletin/vlt90b/bulletin/bulletin0.for | 1636 ------- .../bulletin/vlt90b/bulletin/bulletin1.for | 1603 ------- .../bulletin/vlt90b/bulletin/bulletin2.for | 1638 ------- .../bulletin/vlt90b/bulletin/bulletin3.for | 1738 ------- .../bulletin/vlt90b/bulletin/bulletin4.for | 1776 ------- .../bulletin/vlt90b/bulletin/bulletin5.for | 1859 -------- .../bulletin/vlt90b/bulletin/bulletin6.for | 1603 ------- .../bulletin/vlt90b/bulletin/bulletin7.for | 1929 -------- .../bulletin/vlt90b/bulletin/bulletin8.for | 1654 ------- .../bulletin/vlt90b/bulletin/bulletin9.for | 1950 -------- .../bulletin/vlt90b/bulletin/bullfiles.inc | 28 - .../bulletin/vlt90b/bulletin/bullfolder.inc | 46 - .../bulletin/vlt90b/bulletin/bulluser.inc | 44 - decus/vax90b1/bulletin/writemsg.txt | 36 - decus/vax90b1/bulletin_beta/allmacs.mar | 299 -- decus/vax90b1/bulletin_beta/bull20_ann.txt | 243 - decus/vax90b1/bulletin_beta/bullcoms1.hlp | 789 ---- decus/vax90b1/bulletin_beta/bullcoms2.hlp | 801 ---- decus/vax90b1/bulletin_beta/bullet1.com | 1251 ----- decus/vax90b1/bulletin_beta/bullet2.com | 1142 ----- decus/vax90b1/bulletin_beta/bulletin.doc | 875 ---- decus/vax90b1/bulletin_beta/bulletin.for | 1648 ------- decus/vax90b1/bulletin_beta/bulletin0.for | 1645 ------- decus/vax90b1/bulletin_beta/bulletin1.for | 1786 ------- decus/vax90b1/bulletin_beta/bulletin10.for | 1980 -------- decus/vax90b1/bulletin_beta/bulletin2.for | 1773 ------- decus/vax90b1/bulletin_beta/bulletin3.for | 1757 ------- decus/vax90b1/bulletin_beta/bulletin4.for | 1803 ------- decus/vax90b1/bulletin_beta/bulletin5.for | 2017 -------- decus/vax90b1/bulletin_beta/bulletin6.for | 1693 ------- decus/vax90b1/bulletin_beta/bulletin7.for | 2026 -------- decus/vax90b1/bulletin_beta/bulletin8.for | 1907 -------- decus/vax90b1/bulletin_beta/bulletin9.for | 1977 -------- .../bulletin_beta/bulletin_beta_ann.txt | 71 - decus/vax90b1/bulletin_beta/pmdf.com | 1019 ---- decus/vax91a/bulletin/aaareadme.txt | 169 - decus/vax91a/bulletin/allmacs.mar | 299 -- decus/vax91a/bulletin/board_digest.com | 77 - decus/vax91a/bulletin/board_special.com | 108 - decus/vax91a/bulletin/bull_news.c | 372 -- decus/vax91a/bulletin/bull_newsdummy.for | 58 - decus/vax91a/bulletin/bullcom.cld | 485 -- decus/vax91a/bulletin/bullcoms1.hlp | 829 ---- decus/vax91a/bulletin/bullcoms2.hlp | 945 ---- decus/vax91a/bulletin/bulldir.inc | 33 - decus/vax91a/bulletin/bullet1.com | 1360 ------ decus/vax91a/bulletin/bullet2.com | 1495 ------ decus/vax91a/bulletin/bulletin.cld | 40 - decus/vax91a/bulletin/bulletin.com | 2 - decus/vax91a/bulletin/bulletin.for | 1692 ------- decus/vax91a/bulletin/bulletin.hlp | 143 - decus/vax91a/bulletin/bulletin.lnk | 4 - decus/vax91a/bulletin/bulletin0.for | 1650 ------- decus/vax91a/bulletin/bulletin1.for | 1792 ------- decus/vax91a/bulletin/bulletin10.for | 2087 --------- decus/vax91a/bulletin/bulletin2.for | 2020 -------- decus/vax91a/bulletin/bulletin3.for | 1885 -------- decus/vax91a/bulletin/bulletin4.for | 1799 ------- decus/vax91a/bulletin/bulletin5.for | 2051 -------- decus/vax91a/bulletin/bulletin6.for | 1699 ------- decus/vax91a/bulletin/bulletin7.for | 2042 -------- decus/vax91a/bulletin/bulletin8.for | 1874 -------- decus/vax91a/bulletin/bulletin9.for | 2141 --------- decus/vax91a/bulletin/bulletin_ann.txt | 342 -- decus/vax91a/bulletin/bullfiles.inc | 29 - decus/vax91a/bulletin/bullfolder.inc | 81 - decus/vax91a/bulletin/bullmain.cld | 30 - decus/vax91a/bulletin/bullnews.inc | 7 - decus/vax91a/bulletin/bullstart.com | 6 - decus/vax91a/bulletin/bulluser.inc | 49 - decus/vax91a/bulletin/create.com | 35 - decus/vax91a/bulletin/dclremote.com | 32 - decus/vax91a/bulletin/handout.txt | 268 -- decus/vax91a/bulletin/install.com | 18 - decus/vax91a/bulletin/install_remote.com | 130 - decus/vax91a/bulletin/instruct.com | 6 - decus/vax91a/bulletin/instruct.txt | 8 - decus/vax91a/bulletin/login.com | 28 - decus/vax91a/bulletin/makefile | 78 - decus/vax91a/bulletin/mx.com | 958 ---- decus/vax91a/bulletin/news.txt | 102 - decus/vax91a/bulletin/nonsystem.txt | 16 - decus/vax91a/bulletin/optimize_rms.com | 134 - decus/vax91a/bulletin/pmdf.com | 1019 ---- decus/vax91a/bulletin/remote.com | 48 - decus/vax91a/bulletin/setuser.mar | 125 - decus/vax91a/bulletin/writemsg.txt | 36 - .../bulletin-net92a/bulletin_howtoget.txt | 42 - decus/vax92a/bulletin/aaareadme.txt | 218 - decus/vax92a/bulletin/board_digest.com | 77 - decus/vax92a/bulletin/board_special.com | 108 - decus/vax92a/bulletin/bullcoms1.hlp | 933 ---- decus/vax92a/bulletin/bullcoms2.hlp | 1060 ----- decus/vax92a/bulletin/bulletin.ann | 425 -- decus/vax92a/bulletin/bulletin.cld | 43 - decus/vax92a/bulletin/bulletin.com | 2 - decus/vax92a/bulletin/bulletin.hlp | 145 - decus/vax92a/bulletin/bulletin.lnk | 11 - decus/vax92a/bulletin/bulletin_source.tlb | Bin 894976 -> 0 bytes decus/vax92a/bulletin/bullstart.com | 6 - decus/vax92a/bulletin/dclremote.com | 32 - decus/vax92a/bulletin/extract_tlb.com | 75 - decus/vax92a/bulletin/handout.txt | 268 -- decus/vax92a/bulletin/install.com | 18 - decus/vax92a/bulletin/install_remote.com | 130 - decus/vax92a/bulletin/instruct.com | 6 - decus/vax92a/bulletin/instruct.txt | 8 - decus/vax92a/bulletin/login.com | 31 - decus/vax92a/bulletin/news.com | 568 --- decus/vax92a/bulletin/news.txt | 150 - decus/vax92a/bulletin/nonsystem.txt | 16 - decus/vax92a/bulletin/optimize_rms.com | 134 - decus/vax92a/bulletin/remote.com | 48 - decus/vax92a/bulletin/writemsg.txt | 36 - decus/vax92b/bulletin/aaareadme.txt | 60 - decus/vax92b/bulletin/allmacs.mar | 377 -- decus/vax92b/bulletin/bull_news.c | 414 -- decus/vax92b/bulletin/bull_newsdummy.for | 83 - decus/vax92b/bulletin/bullcom.cld | 641 --- decus/vax92b/bulletin/bullcoms1.hlp | 1047 ----- decus/vax92b/bulletin/bullcoms2.hlp | 1338 ------ decus/vax92b/bulletin/bullet1.com | 1519 ------ decus/vax92b/bulletin/bullet2.com | 1515 ------ decus/vax92b/bulletin/bulletin.announce | 84 - decus/vax92b/bulletin/bulletin.cld | 43 - decus/vax92b/bulletin/bulletin.for | 1871 -------- decus/vax92b/bulletin/bulletin0.for | 1896 -------- decus/vax92b/bulletin/bulletin1.for | 2179 --------- decus/vax92b/bulletin/bulletin10.for | 2836 ----------- decus/vax92b/bulletin/bulletin11.for | 2438 ---------- decus/vax92b/bulletin/bulletin2.for | 2237 --------- decus/vax92b/bulletin/bulletin3.for | 2221 --------- decus/vax92b/bulletin/bulletin4.for | 2162 --------- decus/vax92b/bulletin/bulletin5.for | 2321 --------- decus/vax92b/bulletin/bulletin6.for | 2482 ---------- decus/vax92b/bulletin/bulletin7.for | 2232 --------- decus/vax92b/bulletin/bulletin8.for | 2034 -------- decus/vax92b/bulletin/bulletin9.for | 2006 -------- decus/vax92b/bulletin/bulletin_announce.txt | 513 -- decus/vax92b/bulletin/bullmain.cld | 33 - decus/vax92b/bulletin/mx.com | 958 ---- decus/vax92b/bulletin/news.com | 679 --- decus/vax92b/bulletin/pmdf.com | 1031 ---- decus/vax92b/bulletin/setuser.mar | 125 - decus/vlt95b/bulletin/aaareadme.txt | 201 - decus/vlt95b/bulletin/allmacs.mar | 312 -- decus/vlt95b/bulletin/allmacs_axp.mar | 312 -- decus/vlt95b/bulletin/board_digest.com | 77 - decus/vlt95b/bulletin/board_special.com | 108 - decus/vlt95b/bulletin/bull_news.c | 705 --- decus/vlt95b/bulletin/bull_newsdummy.for | 99 - decus/vlt95b/bulletin/bullcom.cld | 742 --- decus/vlt95b/bulletin/bullcoms1.hlp | 1236 ----- decus/vlt95b/bulletin/bullcoms2.hlp | 1399 ------ decus/vlt95b/bulletin/bulldir.inc | 58 - decus/vlt95b/bulletin/bullet1.com | 2474 ---------- decus/vlt95b/bulletin/bullet2.com | 1678 ------- decus/vlt95b/bulletin/bulletin.cld | 44 - decus/vlt95b/bulletin/bulletin.com | 2 - decus/vlt95b/bulletin/bulletin.for | 2031 -------- decus/vlt95b/bulletin/bulletin.hlp | 151 - decus/vlt95b/bulletin/bulletin.lnk | 18 - decus/vlt95b/bulletin/bulletin0.for | 2361 ---------- decus/vlt95b/bulletin/bulletin1.for | 2263 --------- decus/vlt95b/bulletin/bulletin10.for | 3628 -------------- decus/vlt95b/bulletin/bulletin11.for | 3275 ------------- decus/vlt95b/bulletin/bulletin2.for | 2559 ---------- decus/vlt95b/bulletin/bulletin3.for | 2476 ---------- decus/vlt95b/bulletin/bulletin4.for | 2199 --------- decus/vlt95b/bulletin/bulletin5.for | 2503 ---------- decus/vlt95b/bulletin/bulletin6.for | 2800 ----------- decus/vlt95b/bulletin/bulletin7.for | 2341 --------- decus/vlt95b/bulletin/bulletin8.for | 2145 --------- decus/vlt95b/bulletin/bulletin9.for | 2436 ---------- decus/vlt95b/bulletin/bullfiles.inc | 39 - decus/vlt95b/bulletin/bullfolder.inc | 84 - decus/vlt95b/bulletin/bullmain.cld | 34 - decus/vlt95b/bulletin/bullnews.inc | 7 - decus/vlt95b/bulletin/bullstart.com | 6 - decus/vlt95b/bulletin/bulluser.inc | 53 - decus/vlt95b/bulletin/changes.txt | 634 --- decus/vlt95b/bulletin/cmds.mai | 22 - decus/vlt95b/bulletin/copyright.txt | 29 - decus/vlt95b/bulletin/create.com | 57 - decus/vlt95b/bulletin/handout.txt | 268 -- decus/vlt95b/bulletin/install.com | 25 - decus/vlt95b/bulletin/instruct.com | 6 - decus/vlt95b/bulletin/instruct.txt | 8 - decus/vlt95b/bulletin/login.com | 31 - decus/vlt95b/bulletin/makefile | 82 - decus/vlt95b/bulletin/master.com | 408 -- decus/vlt95b/bulletin/mx.com | 958 ---- decus/vlt95b/bulletin/mx.mai | 958 ---- decus/vlt95b/bulletin/news.alt | 254 - decus/vlt95b/bulletin/news.com | 679 --- decus/vlt95b/bulletin/news.create | 155 - decus/vlt95b/bulletin/news.moderators | 260 - decus/vlt95b/bulletin/news.txt | 150 - decus/vlt95b/bulletin/nonsystem.txt | 16 - decus/vlt95b/bulletin/optimize_rms.com | 134 - decus/vlt95b/bulletin/pmdf.com | 1031 ---- decus/vlt95b/bulletin/restart.com | 6 - decus/vlt95b/bulletin/setuser.mar | 125 - decus/vlt95b/bulletin/update.fil | 11 - decus/vlt95b/bulletin/upgrade.com | 53 - decus/vlt95b/bulletin/writemsg.txt | 36 - decus/vlt97a/bulletin/aaareadme.1st | 2688 ----------- decus/vlt97a/bulletin/aaareadme.txt | 201 - decus/vlt97a/bulletin/allmacs.mar | 312 -- decus/vlt97a/bulletin/allmacs_axp.mar | 312 -- decus/vlt97a/bulletin/bad.for | 22 - decus/vlt97a/bulletin/board_digest.com | 77 - decus/vlt97a/bulletin/board_special.com | 108 - decus/vlt97a/bulletin/bull_news.c | 705 --- decus/vlt97a/bulletin/bull_newsdummy.for | 99 - decus/vlt97a/bulletin/bullcom.cld | 763 --- decus/vlt97a/bulletin/bullcoms1.hlp | 1260 ----- decus/vlt97a/bulletin/bullcoms2.hlp | 1457 ------ decus/vlt97a/bulletin/bulldir.inc | 58 - decus/vlt97a/bulletin/bullet1.com | 2760 ----------- decus/vlt97a/bulletin/bullet2.com | 1703 ------- decus/vlt97a/bulletin/bulletin.ann | 26 - decus/vlt97a/bulletin/bulletin.cld | 44 - decus/vlt97a/bulletin/bulletin.com | 2 - decus/vlt97a/bulletin/bulletin.for | 2095 --------- decus/vlt97a/bulletin/bulletin.hlp | 151 - decus/vlt97a/bulletin/bulletin.lnk | 18 - decus/vlt97a/bulletin/bulletin0.for | 2439 ---------- decus/vlt97a/bulletin/bulletin1.for | 2495 ---------- decus/vlt97a/bulletin/bulletin10.for | 4059 ---------------- decus/vlt97a/bulletin/bulletin11.for | 3536 -------------- decus/vlt97a/bulletin/bulletin2.for | 2670 ----------- decus/vlt97a/bulletin/bulletin3.for | 2505 ---------- decus/vlt97a/bulletin/bulletin4.for | 2300 --------- decus/vlt97a/bulletin/bulletin5.for | 2513 ---------- decus/vlt97a/bulletin/bulletin6.for | 2810 ----------- decus/vlt97a/bulletin/bulletin7.for | 2347 ---------- decus/vlt97a/bulletin/bulletin8.for | 2163 --------- decus/vlt97a/bulletin/bulletin9.for | 2469 ---------- decus/vlt97a/bulletin/bullfiles.inc | 39 - decus/vlt97a/bulletin/bullfolder.inc | 84 - decus/vlt97a/bulletin/bullmain.cld | 34 - decus/vlt97a/bulletin/bullnews.inc | 7 - decus/vlt97a/bulletin/bullstart.com | 6 - decus/vlt97a/bulletin/bulluser.inc | 53 - decus/vlt97a/bulletin/changes.txt | 648 --- decus/vlt97a/bulletin/cmds.mai | 22 - decus/vlt97a/bulletin/copyright.txt | 29 - decus/vlt97a/bulletin/create.com | 57 - decus/vlt97a/bulletin/handout.txt | 268 -- decus/vlt97a/bulletin/install.com | 25 - decus/vlt97a/bulletin/instruct.com | 6 - decus/vlt97a/bulletin/instruct.txt | 8 - decus/vlt97a/bulletin/login.com | 31 - decus/vlt97a/bulletin/makefile | 82 - decus/vlt97a/bulletin/master.com | 408 -- decus/vlt97a/bulletin/mx.com | 958 ---- decus/vlt97a/bulletin/mx.mai | 958 ---- decus/vlt97a/bulletin/news.alt | 254 - decus/vlt97a/bulletin/news.com | 679 --- decus/vlt97a/bulletin/news.create | 155 - decus/vlt97a/bulletin/news.moderators | 260 - decus/vlt97a/bulletin/news.txt | 150 - decus/vlt97a/bulletin/nonsystem.txt | 16 - decus/vlt97a/bulletin/optimize_rms.com | 134 - decus/vlt97a/bulletin/pmdf.com | 1031 ---- decus/vlt97a/bulletin/restart.com | 6 - decus/vlt97a/bulletin/setuser.mar | 125 - decus/vlt97a/bulletin/update.fil | 11 - decus/vlt97a/bulletin/upgrade.com | 53 - decus/vlt97a/bulletin/writemsg.txt | 36 - decus/vms93a/bulletin/aaareadme | 77 - decus/vms93a/bulletin/aaareadme.txt | 201 - decus/vms93a/bulletin/allmacs.mar | 306 -- decus/vms93a/bulletin/board_digest.com | 77 - decus/vms93a/bulletin/board_special.com | 108 - decus/vms93a/bulletin/bull_news.c | 513 -- decus/vms93a/bulletin/bull_newsdummy.for | 99 - decus/vms93a/bulletin/bullcom.cld | 655 --- decus/vms93a/bulletin/bullcoms1.hlp | 1095 ----- decus/vms93a/bulletin/bullcoms2.hlp | 1393 ------ decus/vms93a/bulletin/bulldir.inc | 58 - decus/vms93a/bulletin/bullet1.com | 1 - decus/vms93a/bulletin/bulletin.cld | 43 - decus/vms93a/bulletin/bulletin.for | 1890 -------- decus/vms93a/bulletin/bulletin.hlp | 144 - decus/vms93a/bulletin/bulletin.lnk | 18 - decus/vms93a/bulletin/bulletin0.for | 2020 -------- decus/vms93a/bulletin/bulletin1.for | 2202 --------- decus/vms93a/bulletin/bulletin10.for | 2992 ------------ decus/vms93a/bulletin/bulletin11.for | 2524 ---------- decus/vms93a/bulletin/bulletin2.for | 2243 --------- decus/vms93a/bulletin/bulletin3.for | 2228 --------- decus/vms93a/bulletin/bulletin4.for | 2194 --------- decus/vms93a/bulletin/bulletin5.for | 2342 --------- decus/vms93a/bulletin/bulletin6.for | 2510 ---------- decus/vms93a/bulletin/bulletin7.for | 2248 --------- decus/vms93a/bulletin/bulletin8.for | 2049 -------- decus/vms93a/bulletin/bulletin9.for | 2085 --------- decus/vms93a/bulletin/bullfiles.inc | 41 - decus/vms93a/bulletin/bullfolder.inc | 84 - decus/vms93a/bulletin/bullmain.cld | 33 - decus/vms93a/bulletin/bullnews.inc | 7 - decus/vms93a/bulletin/bullstart.com | 6 - decus/vms93a/bulletin/bulluser.inc | 49 - decus/vms93a/bulletin/changes.txt | 533 --- decus/vms93a/bulletin/cmds.mai | 22 - decus/vms93a/bulletin/copyright.txt | 29 - decus/vms93a/bulletin/create.com | 55 - decus/vms93a/bulletin/create_use_this_one.com | 56 - decus/vms93a/bulletin/handout.txt | 268 -- decus/vms93a/bulletin/install.com | 25 - decus/vms93a/bulletin/instruct.com | 6 - decus/vms93a/bulletin/instruct.txt | 8 - decus/vms93a/bulletin/login.com | 28 - decus/vms93a/bulletin/makefile | 82 - decus/vms93a/bulletin/master.com | 408 -- decus/vms93a/bulletin/mx.com | 958 ---- decus/vms93a/bulletin/mx.mai | 958 ---- decus/vms93a/bulletin/news.alt | 254 - decus/vms93a/bulletin/news.create | 155 - decus/vms93a/bulletin/news.moderators | 260 - decus/vms93a/bulletin/news.txt | 141 - decus/vms93a/bulletin/nonsystem.txt | 16 - decus/vms93a/bulletin/optimize_rms.com | 134 - decus/vms93a/bulletin/pmdf.com | 1031 ---- decus/vms93a/bulletin/restart.com | 6 - decus/vms93a/bulletin/setuser.mar | 125 - decus/vms93a/bulletin/update.fil | 7 - decus/vms93a/bulletin/upgrade.com | 53 - decus/vms93a/bulletin/writemsg.txt | 36 - decus/vms93b/bulletin/aaareadme | 78 - decus/vms93b/bulletin/aaareadme.txt | 201 - decus/vms93b/bulletin/allmacs.mar | 312 -- decus/vms93b/bulletin/allmacs_axp.mar | 312 -- decus/vms93b/bulletin/board_digest.com | 77 - decus/vms93b/bulletin/board_special.com | 108 - decus/vms93b/bulletin/bull_news.c | 705 --- decus/vms93b/bulletin/bullcom.cld | 665 --- decus/vms93b/bulletin/bullcoms1.hlp | 1095 ----- decus/vms93b/bulletin/bullcoms2.hlp | 1411 ------ decus/vms93b/bulletin/bulldir.inc | 58 - decus/vms93b/bulletin/bullet1.com | 1 - decus/vms93b/bulletin/bulletin.cld | 43 - decus/vms93b/bulletin/bulletin.for | 1891 -------- decus/vms93b/bulletin/bulletin.hlp | 144 - decus/vms93b/bulletin/bulletin.lnk | 18 - decus/vms93b/bulletin/bulletin0.for | 2051 -------- decus/vms93b/bulletin/bulletin1.for | 2202 --------- decus/vms93b/bulletin/bulletin10.for | 3047 ------------ decus/vms93b/bulletin/bulletin11.for | 2667 ----------- decus/vms93b/bulletin/bulletin2.for | 2364 ---------- decus/vms93b/bulletin/bulletin3.for | 2281 --------- decus/vms93b/bulletin/bulletin4.for | 2191 --------- decus/vms93b/bulletin/bulletin5.for | 2349 ---------- decus/vms93b/bulletin/bulletin6.for | 2504 ---------- decus/vms93b/bulletin/bulletin7.for | 2284 --------- decus/vms93b/bulletin/bulletin8.for | 2120 --------- decus/vms93b/bulletin/bulletin9.for | 2093 --------- decus/vms93b/bulletin/bullfiles.inc | 41 - decus/vms93b/bulletin/bullfolder.inc | 84 - decus/vms93b/bulletin/bullmain.cld | 33 - decus/vms93b/bulletin/bullnews.inc | 7 - decus/vms93b/bulletin/bullstart.com | 6 - decus/vms93b/bulletin/bulluser.inc | 49 - decus/vms93b/bulletin/changes.txt | 563 --- decus/vms93b/bulletin/copyright.txt | 29 - decus/vms93b/bulletin/create.com | 57 - decus/vms93b/bulletin/handout.txt | 268 -- decus/vms93b/bulletin/install.com | 25 - decus/vms93b/bulletin/instruct.com | 6 - decus/vms93b/bulletin/instruct.txt | 8 - decus/vms93b/bulletin/login.com | 28 - decus/vms93b/bulletin/master.com | 408 -- decus/vms93b/bulletin/mx.com | 958 ---- decus/vms93b/bulletin/news.com | 679 --- decus/vms93b/bulletin/news.create | 155 - decus/vms93b/bulletin/news.txt | 150 - decus/vms93b/bulletin/nonsystem.txt | 16 - decus/vms93b/bulletin/optimize_rms.com | 134 - decus/vms93b/bulletin/pmdf.com | 1031 ---- decus/vms93b/bulletin/restart.com | 6 - decus/vms93b/bulletin/setuser.mar | 125 - decus/vms93b/bulletin/upgrade.com | 53 - decus/vms93b/bulletin/writemsg.txt | 36 - decus/vms94a/bulletin/aaareadme.txt | 201 - decus/vms94a/bulletin/allmacs.mar | 312 -- decus/vms94a/bulletin/allmacs_axp.mar | 312 -- decus/vms94a/bulletin/board_digest.com | 77 - decus/vms94a/bulletin/board_special.com | 108 - decus/vms94a/bulletin/bull_news.c | 705 --- decus/vms94a/bulletin/bull_newsdummy.for | 99 - decus/vms94a/bulletin/bullcom.cld | 667 --- decus/vms94a/bulletin/bullcoms1.hlp | 1106 ----- decus/vms94a/bulletin/bullcoms2.hlp | 1348 ------ decus/vms94a/bulletin/bulldir.inc | 58 - decus/vms94a/bulletin/bullet1.com | 1 - decus/vms94a/bulletin/bulletin.cld | 43 - decus/vms94a/bulletin/bulletin.for | 1903 -------- decus/vms94a/bulletin/bulletin.hlp | 144 - decus/vms94a/bulletin/bulletin.lnk | 18 - decus/vms94a/bulletin/bulletin0.for | 2057 -------- decus/vms94a/bulletin/bulletin1.for | 2243 --------- decus/vms94a/bulletin/bulletin10.for | 3073 ------------ decus/vms94a/bulletin/bulletin11.for | 2802 ----------- decus/vms94a/bulletin/bulletin2.for | 2374 ---------- decus/vms94a/bulletin/bulletin3.for | 2287 --------- decus/vms94a/bulletin/bulletin4.for | 2197 --------- decus/vms94a/bulletin/bulletin5.for | 2355 ---------- decus/vms94a/bulletin/bulletin6.for | 2531 ---------- decus/vms94a/bulletin/bulletin7.for | 2288 --------- decus/vms94a/bulletin/bulletin8.for | 2131 --------- decus/vms94a/bulletin/bulletin9.for | 2099 --------- decus/vms94a/bulletin/bullfiles.inc | 41 - decus/vms94a/bulletin/bullfolder.inc | 84 - decus/vms94a/bulletin/bullmain.cld | 33 - decus/vms94a/bulletin/bullnews.inc | 7 - decus/vms94a/bulletin/bullstart.com | 6 - decus/vms94a/bulletin/bulluser.inc | 49 - decus/vms94a/bulletin/bulluser.old | Bin 54272 -> 0 bytes decus/vms94a/bulletin/changes.txt | 575 --- decus/vms94a/bulletin/cmds.mai | 22 - decus/vms94a/bulletin/copyright.txt | 29 - decus/vms94a/bulletin/create.com | 57 - decus/vms94a/bulletin/handout.txt | 268 -- decus/vms94a/bulletin/install.com | 25 - decus/vms94a/bulletin/instruct.com | 6 - decus/vms94a/bulletin/instruct.txt | 8 - decus/vms94a/bulletin/login.com | 28 - decus/vms94a/bulletin/master.com | 408 -- decus/vms94a/bulletin/mx.com | 958 ---- decus/vms94a/bulletin/mx.mai | 958 ---- decus/vms94a/bulletin/news.com | 679 --- decus/vms94a/bulletin/news.create | 155 - decus/vms94a/bulletin/news.moderators | 260 - decus/vms94a/bulletin/news.txt | 159 - decus/vms94a/bulletin/nonsystem.txt | 16 - decus/vms94a/bulletin/optimize_rms.com | 134 - decus/vms94a/bulletin/pmdf.com | 1031 ---- decus/vms94a/bulletin/restart.com | 6 - decus/vms94a/bulletin/setuser.mar | 125 - decus/vms94a/bulletin/update.fil | 7 - decus/vms94a/bulletin/upgrade.com | 53 - decus/vms94a/bulletin/writemsg.txt | 36 - decus/vms94b/bulletin/aaareadme.txt | 89 - decus/vms94b/bulletin/allmacs.mar | 323 -- decus/vms94b/bulletin/allmacs_axp.mar | 323 -- decus/vms94b/bulletin/bullcoms1.hlp | 1126 ----- decus/vms94b/bulletin/bullcoms2.hlp | 1402 ------ decus/vms94b/bulletin/bullet1.com | 2480 ---------- decus/vms94b/bulletin/bullet2.com | 1613 ------- decus/vms94b/bulletin/bulletin.for | 1940 -------- decus/vms94b/bulletin/bulletin0.for | 2085 --------- decus/vms94b/bulletin/bulletin1.for | 2254 --------- decus/vms94b/bulletin/bulletin10.for | 3209 ------------- decus/vms94b/bulletin/bulletin11.for | 2967 ------------ decus/vms94b/bulletin/bulletin2.for | 2387 ---------- decus/vms94b/bulletin/bulletin3.for | 2298 --------- decus/vms94b/bulletin/bulletin4.for | 2208 --------- decus/vms94b/bulletin/bulletin5.for | 2432 ---------- decus/vms94b/bulletin/bulletin6.for | 2536 ---------- decus/vms94b/bulletin/bulletin7.for | 2318 --------- decus/vms94b/bulletin/bulletin8.for | 2146 --------- decus/vms94b/bulletin/bulletin9.for | 2368 ---------- decus/vms94b/bulletin/mx.com | 969 ---- decus/vms94b/bulletin/news.com | 690 --- decus/vms94b/bulletin/pmdf.com | 1042 ----- decus/vms95a/bulletin/aaareadme | 78 - decus/vms95a/bulletin/aaareadme.first | 201 - decus/vms95a/bulletin/allmacs.mar | 312 -- decus/vms95a/bulletin/allmacs_axp.mar | 312 -- decus/vms95a/bulletin/board_digest.com | 77 - decus/vms95a/bulletin/board_special.com | 108 - decus/vms95a/bulletin/bull_news.c | 705 --- decus/vms95a/bulletin/bull_newsdummy.for | 99 - decus/vms95a/bulletin/bullcom.cld | 724 --- decus/vms95a/bulletin/bullcoms1.hlp | 1184 ----- decus/vms95a/bulletin/bullcoms2.hlp | 1366 ------ decus/vms95a/bulletin/bulldir.inc | 58 - decus/vms95a/bulletin/bulletin.cld | 44 - decus/vms95a/bulletin/bulletin.for | 2031 -------- decus/vms95a/bulletin/bulletin.hlp | 151 - decus/vms95a/bulletin/bulletin.lnk | 18 - decus/vms95a/bulletin/bulletin0.for | 2082 -------- decus/vms95a/bulletin/bulletin1.for | 2258 --------- decus/vms95a/bulletin/bulletin10.for | 3436 -------------- decus/vms95a/bulletin/bulletin11.for | 2944 ------------ decus/vms95a/bulletin/bulletin2.for | 2388 ---------- decus/vms95a/bulletin/bulletin3.for | 2469 ---------- decus/vms95a/bulletin/bulletin4.for | 2205 --------- decus/vms95a/bulletin/bulletin5.for | 2434 ---------- decus/vms95a/bulletin/bulletin6.for | 2805 ----------- decus/vms95a/bulletin/bulletin7.for | 2315 --------- decus/vms95a/bulletin/bulletin8.for | 2147 --------- decus/vms95a/bulletin/bulletin9.for | 2432 ---------- decus/vms95a/bulletin/bullfiles.inc | 39 - decus/vms95a/bulletin/bullfolder.inc | 84 - decus/vms95a/bulletin/bullmain.cld | 34 - decus/vms95a/bulletin/bullnews.inc | 7 - decus/vms95a/bulletin/bullstart.com | 6 - decus/vms95a/bulletin/bulluser.inc | 53 - decus/vms95a/bulletin/changes.txt | 611 --- decus/vms95a/bulletin/cmds.mai | 22 - decus/vms95a/bulletin/copyright.txt | 29 - decus/vms95a/bulletin/create.com | 57 - decus/vms95a/bulletin/handout.txt | 268 -- decus/vms95a/bulletin/install.com | 25 - decus/vms95a/bulletin/instruct.com | 6 - decus/vms95a/bulletin/instruct.txt | 8 - decus/vms95a/bulletin/login.com | 28 - decus/vms95a/bulletin/makefile | 82 - decus/vms95a/bulletin/master.com | 408 -- decus/vms95a/bulletin/mx.com | 958 ---- decus/vms95a/bulletin/mx.mai | 958 ---- decus/vms95a/bulletin/news.alt | 254 - decus/vms95a/bulletin/news.com | 679 --- decus/vms95a/bulletin/news.create | 155 - decus/vms95a/bulletin/news.moderators | 260 - decus/vms95a/bulletin/news.txt | 160 - decus/vms95a/bulletin/nonsystem.txt | 16 - decus/vms95a/bulletin/optimize_rms.com | 134 - decus/vms95a/bulletin/pmdf.com | 1031 ---- decus/vms95a/bulletin/restart.com | 6 - decus/vms95a/bulletin/setuser.mar | 125 - decus/vms95a/bulletin/update.fil | 11 - decus/vms95a/bulletin/upgrade.com | 53 - decus/vms95a/bulletin/writemsg.txt | 36 - decus/vms95b/bulletin/aaareadme.txt | 201 - decus/vms95b/bulletin/allmacs.mar | 312 -- decus/vms95b/bulletin/allmacs_axp.mar | 312 -- decus/vms95b/bulletin/board_digest.com | 77 - decus/vms95b/bulletin/board_special.com | 108 - decus/vms95b/bulletin/bull_news.c | 705 --- decus/vms95b/bulletin/bull_newsdummy.for | 99 - decus/vms95b/bulletin/bullcom.cld | 742 --- decus/vms95b/bulletin/bullcoms1.hlp | 1236 ----- decus/vms95b/bulletin/bullcoms2.hlp | 1399 ------ decus/vms95b/bulletin/bulldir.inc | 58 - decus/vms95b/bulletin/bullet1.com | 2474 ---------- decus/vms95b/bulletin/bullet2.com | 1678 ------- decus/vms95b/bulletin/bulletin.cld | 44 - decus/vms95b/bulletin/bulletin.com | 2 - decus/vms95b/bulletin/bulletin.for | 2031 -------- decus/vms95b/bulletin/bulletin.hlp | 151 - decus/vms95b/bulletin/bulletin.lnk | 18 - decus/vms95b/bulletin/bulletin0.for | 2361 ---------- decus/vms95b/bulletin/bulletin1.for | 2263 --------- decus/vms95b/bulletin/bulletin10.for | 3628 -------------- decus/vms95b/bulletin/bulletin11.for | 3275 ------------- decus/vms95b/bulletin/bulletin2.for | 2559 ---------- decus/vms95b/bulletin/bulletin3.for | 2476 ---------- decus/vms95b/bulletin/bulletin4.for | 2199 --------- decus/vms95b/bulletin/bulletin5.for | 2503 ---------- decus/vms95b/bulletin/bulletin6.for | 2800 ----------- decus/vms95b/bulletin/bulletin7.for | 2341 --------- decus/vms95b/bulletin/bulletin8.for | 2145 --------- decus/vms95b/bulletin/bulletin9.for | 2436 ---------- decus/vms95b/bulletin/bullfiles.inc | 39 - decus/vms95b/bulletin/bullfolder.inc | 84 - decus/vms95b/bulletin/bullmain.cld | 34 - decus/vms95b/bulletin/bullnews.inc | 7 - decus/vms95b/bulletin/bullstart.com | 6 - decus/vms95b/bulletin/bulluser.inc | 53 - decus/vms95b/bulletin/changes.txt | 634 --- decus/vms95b/bulletin/cmds.mai | 22 - decus/vms95b/bulletin/copyright.txt | 29 - decus/vms95b/bulletin/create.com | 57 - decus/vms95b/bulletin/handout.txt | 268 -- decus/vms95b/bulletin/install.com | 25 - decus/vms95b/bulletin/instruct.com | 6 - decus/vms95b/bulletin/instruct.txt | 8 - decus/vms95b/bulletin/login.com | 31 - decus/vms95b/bulletin/makefile | 82 - decus/vms95b/bulletin/master.com | 408 -- decus/vms95b/bulletin/mx.com | 958 ---- decus/vms95b/bulletin/mx.mai | 958 ---- decus/vms95b/bulletin/news.alt | 254 - decus/vms95b/bulletin/news.com | 679 --- decus/vms95b/bulletin/news.create | 155 - decus/vms95b/bulletin/news.moderators | 260 - decus/vms95b/bulletin/news.txt | 150 - decus/vms95b/bulletin/nonsystem.txt | 16 - decus/vms95b/bulletin/optimize_rms.com | 134 - decus/vms95b/bulletin/pmdf.com | 1031 ---- decus/vms95b/bulletin/restart.com | 6 - decus/vms95b/bulletin/setuser.mar | 125 - decus/vms95b/bulletin/update.fil | 11 - decus/vms95b/bulletin/upgrade.com | 53 - decus/vms95b/bulletin/writemsg.txt | 36 - decus/vmslt00a/bulletin/aaareadme | 68 - decus/vmslt00a/bulletin/aaareadme.install | 202 - decus/vmslt00a/bulletin/aaareadme.txt | 19 - decus/vmslt00a/bulletin/allmacs.mar | 312 -- decus/vmslt00a/bulletin/allmacs_axp.mar | 312 -- decus/vmslt00a/bulletin/board_digest.com | 77 - decus/vmslt00a/bulletin/board_special.com | 108 - decus/vmslt00a/bulletin/bull_news.c | 934 ---- decus/vmslt00a/bulletin/bull_newsdummy.for | 137 - decus/vmslt00a/bulletin/bullcom.cld | 771 --- decus/vmslt00a/bulletin/bullcoms1.hlp | 1276 ----- decus/vmslt00a/bulletin/bullcoms2.hlp | 1463 ------ decus/vmslt00a/bulletin/bulldir.inc | 58 - decus/vmslt00a/bulletin/bulletin.cld | 44 - decus/vmslt00a/bulletin/bulletin.for | 2129 --------- decus/vmslt00a/bulletin/bulletin.hlp | 151 - decus/vmslt00a/bulletin/bulletin.lnk | 18 - decus/vmslt00a/bulletin/bulletin0.for | 2575 ---------- decus/vmslt00a/bulletin/bulletin1.for | 2500 ---------- decus/vmslt00a/bulletin/bulletin10.for | 4124 ---------------- decus/vmslt00a/bulletin/bulletin11.for | 3599 -------------- decus/vmslt00a/bulletin/bulletin2.for | 2692 ----------- decus/vmslt00a/bulletin/bulletin3.for | 2518 ---------- decus/vmslt00a/bulletin/bulletin4.for | 2349 ---------- decus/vmslt00a/bulletin/bulletin5.for | 2516 ---------- decus/vmslt00a/bulletin/bulletin6.for | 2835 ----------- decus/vmslt00a/bulletin/bulletin7.for | 2374 ---------- decus/vmslt00a/bulletin/bulletin8.for | 2165 --------- decus/vmslt00a/bulletin/bulletin9.for | 2474 ---------- decus/vmslt00a/bulletin/bullfiles.inc | 39 - decus/vmslt00a/bulletin/bullfolder.inc | 84 - decus/vmslt00a/bulletin/bullmain.cld | 34 - decus/vmslt00a/bulletin/bullnews.inc | 7 - decus/vmslt00a/bulletin/bullstart.com | 6 - decus/vmslt00a/bulletin/bulluser.inc | 53 - decus/vmslt00a/bulletin/changes.txt | 692 --- decus/vmslt00a/bulletin/cmds.mai | 22 - decus/vmslt00a/bulletin/copyright.txt | 29 - decus/vmslt00a/bulletin/create.com | 57 - decus/vmslt00a/bulletin/debug.txt | 0 decus/vmslt00a/bulletin/handout.txt | 268 -- decus/vmslt00a/bulletin/install.com | 25 - decus/vmslt00a/bulletin/instruct.com | 6 - decus/vmslt00a/bulletin/instruct.txt | 8 - decus/vmslt00a/bulletin/login.com | 31 - decus/vmslt00a/bulletin/makefile | 82 - decus/vmslt00a/bulletin/master.com | 408 -- decus/vmslt00a/bulletin/mx.mai | 958 ---- decus/vmslt00a/bulletin/news.txt | 133 - decus/vmslt00a/bulletin/news_to_folder.txt | 48 - decus/vmslt00a/bulletin/nonsystem.txt | 16 - decus/vmslt00a/bulletin/optimize_rms.com | 134 - decus/vmslt00a/bulletin/pmdf.com | 4 - decus/vmslt00a/bulletin/pmdf.txt | 29 - decus/vmslt00a/bulletin/restart.com | 6 - decus/vmslt00a/bulletin/setuser.mar | 125 - decus/vmslt00a/bulletin/update.fil | 11 - decus/vmslt00a/bulletin/upgrade.com | 53 - decus/vmslt00a/bulletin/writemsg.txt | 36 - decus/vmslt02a/bulletin/aaareadme | 68 - decus/vmslt02a/bulletin/aaareadme.txt | 210 - decus/vmslt02a/bulletin/allmacs.mar | 312 -- decus/vmslt02a/bulletin/allmacs_axp.mar | 312 -- decus/vmslt02a/bulletin/board_digest.com | 77 - decus/vmslt02a/bulletin/board_special.com | 108 - decus/vmslt02a/bulletin/bull_news.c | 934 ---- decus/vmslt02a/bulletin/bull_newsdummy.for | 137 - decus/vmslt02a/bulletin/bullcom.cld | 771 --- decus/vmslt02a/bulletin/bullcoms1.hlp | 1276 ----- decus/vmslt02a/bulletin/bullcoms2.hlp | 1463 ------ decus/vmslt02a/bulletin/bulldir.inc | 58 - decus/vmslt02a/bulletin/bulletin.cld | 44 - decus/vmslt02a/bulletin/bulletin.for | 2129 --------- decus/vmslt02a/bulletin/bulletin.hlp | 151 - decus/vmslt02a/bulletin/bulletin.lnk | 18 - decus/vmslt02a/bulletin/bulletin0.for | 2583 ---------- decus/vmslt02a/bulletin/bulletin1.for | 2502 ---------- decus/vmslt02a/bulletin/bulletin10.for | 4168 ----------------- decus/vmslt02a/bulletin/bulletin11.for | 3618 -------------- decus/vmslt02a/bulletin/bulletin2.for | 2693 ----------- decus/vmslt02a/bulletin/bulletin3.for | 2518 ---------- decus/vmslt02a/bulletin/bulletin4.for | 2350 ---------- decus/vmslt02a/bulletin/bulletin5.for | 2516 ---------- decus/vmslt02a/bulletin/bulletin6.for | 2835 ----------- decus/vmslt02a/bulletin/bulletin7.for | 2374 ---------- decus/vmslt02a/bulletin/bulletin8.for | 2165 --------- decus/vmslt02a/bulletin/bulletin9.for | 2480 ---------- decus/vmslt02a/bulletin/bullfiles.inc | 39 - decus/vmslt02a/bulletin/bullfolder.inc | 84 - decus/vmslt02a/bulletin/bullmain.cld | 34 - decus/vmslt02a/bulletin/bullnews.inc | 7 - decus/vmslt02a/bulletin/bullstart.com | 6 - decus/vmslt02a/bulletin/bulluser.inc | 53 - decus/vmslt02a/bulletin/changes.txt | 692 --- decus/vmslt02a/bulletin/cmds.mai | 22 - decus/vmslt02a/bulletin/copyright.txt | 29 - decus/vmslt02a/bulletin/create.com | 57 - decus/vmslt02a/bulletin/handout.txt | 268 -- decus/vmslt02a/bulletin/install.com | 25 - decus/vmslt02a/bulletin/instruct.com | 6 - decus/vmslt02a/bulletin/instruct.txt | 8 - decus/vmslt02a/bulletin/login.com | 31 - decus/vmslt02a/bulletin/makefile | 82 - decus/vmslt02a/bulletin/master.com | 408 -- decus/vmslt02a/bulletin/mx.mai | 958 ---- decus/vmslt02a/bulletin/news.txt | 133 - decus/vmslt02a/bulletin/news_to_folder.txt | 48 - decus/vmslt02a/bulletin/nonsystem.txt | 16 - decus/vmslt02a/bulletin/optimize_rms.com | 134 - decus/vmslt02a/bulletin/pmdf.com | 4 - decus/vmslt02a/bulletin/pmdf.txt | 29 - decus/vmslt02a/bulletin/restart.com | 6 - decus/vmslt02a/bulletin/setuser.mar | 125 - decus/vmslt02a/bulletin/update.fil | 11 - decus/vmslt02a/bulletin/upgrade.com | 53 - decus/vmslt02a/bulletin/writemsg.txt | 36 - decus/vmslt97a/bulletin/aaareadme.1st | 201 - decus/vmslt97a/bulletin/aaareadme.txt | 201 - decus/vmslt97a/bulletin/allmacs.mar | 312 -- decus/vmslt97a/bulletin/allmacs_axp.mar | 312 -- decus/vmslt97a/bulletin/bad.for | 22 - decus/vmslt97a/bulletin/board_digest.com | 77 - decus/vmslt97a/bulletin/board_special.com | 108 - decus/vmslt97a/bulletin/bull_news.c | 705 --- decus/vmslt97a/bulletin/bull_newsdummy.for | 99 - decus/vmslt97a/bulletin/bullcom.cld | 763 --- decus/vmslt97a/bulletin/bullcoms1.hlp | 1260 ----- decus/vmslt97a/bulletin/bullcoms2.hlp | 1457 ------ decus/vmslt97a/bulletin/bulldir.inc | 58 - decus/vmslt97a/bulletin/bullet1.com | 2760 ----------- decus/vmslt97a/bulletin/bullet2.com | 1703 ------- decus/vmslt97a/bulletin/bulletin.ann | 26 - decus/vmslt97a/bulletin/bulletin.cld | 44 - decus/vmslt97a/bulletin/bulletin.com | 2 - decus/vmslt97a/bulletin/bulletin.for | 2095 --------- decus/vmslt97a/bulletin/bulletin.hlp | 151 - decus/vmslt97a/bulletin/bulletin.lnk | 18 - decus/vmslt97a/bulletin/bulletin0.for | 2439 ---------- decus/vmslt97a/bulletin/bulletin1.for | 2495 ---------- decus/vmslt97a/bulletin/bulletin10.for | 4059 ---------------- decus/vmslt97a/bulletin/bulletin11.for | 3536 -------------- decus/vmslt97a/bulletin/bulletin2.for | 2670 ----------- decus/vmslt97a/bulletin/bulletin3.for | 2505 ---------- decus/vmslt97a/bulletin/bulletin4.for | 2300 --------- decus/vmslt97a/bulletin/bulletin5.for | 2513 ---------- decus/vmslt97a/bulletin/bulletin6.for | 2810 ----------- decus/vmslt97a/bulletin/bulletin7.for | 2347 ---------- decus/vmslt97a/bulletin/bulletin8.for | 2163 --------- decus/vmslt97a/bulletin/bulletin9.for | 2469 ---------- decus/vmslt97a/bulletin/bullfiles.inc | 39 - decus/vmslt97a/bulletin/bullfolder.inc | 84 - decus/vmslt97a/bulletin/bullmain.cld | 34 - decus/vmslt97a/bulletin/bullnews.inc | 7 - decus/vmslt97a/bulletin/bullstart.com | 6 - decus/vmslt97a/bulletin/bulluser.inc | 53 - decus/vmslt97a/bulletin/changes.txt | 648 --- decus/vmslt97a/bulletin/cmds.mai | 22 - decus/vmslt97a/bulletin/copyright.txt | 29 - decus/vmslt97a/bulletin/create.com | 57 - decus/vmslt97a/bulletin/handout.txt | 268 -- decus/vmslt97a/bulletin/install.com | 25 - decus/vmslt97a/bulletin/instruct.com | 6 - decus/vmslt97a/bulletin/instruct.txt | 8 - decus/vmslt97a/bulletin/login.com | 31 - decus/vmslt97a/bulletin/makefile | 82 - decus/vmslt97a/bulletin/master.com | 408 -- decus/vmslt97a/bulletin/mx.com | 958 ---- decus/vmslt97a/bulletin/mx.mai | 958 ---- decus/vmslt97a/bulletin/news.alt | 254 - decus/vmslt97a/bulletin/news.com | 679 --- decus/vmslt97a/bulletin/news.create | 155 - decus/vmslt97a/bulletin/news.moderators | 260 - decus/vmslt97a/bulletin/news.txt | 150 - decus/vmslt97a/bulletin/nonsystem.txt | 16 - decus/vmslt97a/bulletin/optimize_rms.com | 134 - decus/vmslt97a/bulletin/pmdf.com | 1031 ---- decus/vmslt97a/bulletin/restart.com | 6 - decus/vmslt97a/bulletin/setuser.mar | 125 - decus/vmslt97a/bulletin/update.fil | 11 - decus/vmslt97a/bulletin/upgrade.com | 53 - decus/vmslt97a/bulletin/writemsg.txt | 36 - decus/vmslt98a/bulletin/aaareadme.doc | 201 - decus/vmslt98a/bulletin/aaareadme.txt | 21 - decus/vmslt98a/bulletin/allmacs.mar | 312 -- decus/vmslt98a/bulletin/allmacs_axp.mar | 312 -- decus/vmslt98a/bulletin/bad.for | 22 - decus/vmslt98a/bulletin/board_digest.com | 77 - decus/vmslt98a/bulletin/board_special.com | 108 - decus/vmslt98a/bulletin/bull_news.c | 705 --- decus/vmslt98a/bulletin/bull_newsdummy.for | 99 - decus/vmslt98a/bulletin/bullcom.cld | 765 --- decus/vmslt98a/bulletin/bullcoms1.hlp | 1261 ----- decus/vmslt98a/bulletin/bullcoms2.hlp | 1463 ------ decus/vmslt98a/bulletin/bulldir.inc | 58 - decus/vmslt98a/bulletin/bullet1.com | 2776 ----------- decus/vmslt98a/bulletin/bullet2.com | 1701 ------- decus/vmslt98a/bulletin/bulletin.cld | 44 - decus/vmslt98a/bulletin/bulletin.com | 2 - decus/vmslt98a/bulletin/bulletin.for | 2129 --------- decus/vmslt98a/bulletin/bulletin.hlp | 151 - decus/vmslt98a/bulletin/bulletin.lnk | 18 - decus/vmslt98a/bulletin/bulletin0.for | 2520 ---------- decus/vmslt98a/bulletin/bulletin1.for | 2499 ---------- decus/vmslt98a/bulletin/bulletin10.for | 4082 ---------------- decus/vmslt98a/bulletin/bulletin11.for | 3549 -------------- decus/vmslt98a/bulletin/bulletin2.for | 2675 ----------- decus/vmslt98a/bulletin/bulletin3.for | 2510 ---------- decus/vmslt98a/bulletin/bulletin4.for | 2346 ---------- decus/vmslt98a/bulletin/bulletin5.for | 2516 ---------- decus/vmslt98a/bulletin/bulletin6.for | 2811 ----------- decus/vmslt98a/bulletin/bulletin7.for | 2352 ---------- decus/vmslt98a/bulletin/bulletin8.for | 2163 --------- decus/vmslt98a/bulletin/bulletin9.for | 2477 ---------- decus/vmslt98a/bulletin/bullfiles.inc | 39 - decus/vmslt98a/bulletin/bullfolder.inc | 84 - decus/vmslt98a/bulletin/bullmain.cld | 34 - decus/vmslt98a/bulletin/bullnews.inc | 7 - decus/vmslt98a/bulletin/bullstart.com | 6 - decus/vmslt98a/bulletin/bulluser.inc | 53 - decus/vmslt98a/bulletin/changes.txt | 648 --- decus/vmslt98a/bulletin/cmds.mai | 22 - decus/vmslt98a/bulletin/copyright.txt | 29 - decus/vmslt98a/bulletin/create.com | 57 - decus/vmslt98a/bulletin/handout.txt | 268 -- decus/vmslt98a/bulletin/install.com | 25 - decus/vmslt98a/bulletin/instruct.com | 6 - decus/vmslt98a/bulletin/instruct.txt | 8 - decus/vmslt98a/bulletin/login.com | 31 - decus/vmslt98a/bulletin/makefile | 82 - decus/vmslt98a/bulletin/master.com | 408 -- decus/vmslt98a/bulletin/mx.com | 958 ---- decus/vmslt98a/bulletin/mx.mai | 958 ---- decus/vmslt98a/bulletin/news.alt | 254 - decus/vmslt98a/bulletin/news.com | 679 --- decus/vmslt98a/bulletin/news.create | 155 - decus/vmslt98a/bulletin/news.moderators | 260 - decus/vmslt98a/bulletin/news.txt | 150 - decus/vmslt98a/bulletin/nonsystem.txt | 16 - decus/vmslt98a/bulletin/optimize_rms.com | 134 - decus/vmslt98a/bulletin/pmdf.com | 1031 ---- decus/vmslt98a/bulletin/restart.com | 6 - decus/vmslt98a/bulletin/setuser.mar | 125 - decus/vmslt98a/bulletin/update.fil | 11 - decus/vmslt98a/bulletin/upgrade.com | 53 - decus/vmslt98a/bulletin/writemsg.txt | 36 - decus/vmslt98b/bulletin/aaareadme.1st | 201 - decus/vmslt98b/bulletin/aaareadme.txt | 78 - decus/vmslt98b/bulletin/allmacs.mar | 312 -- decus/vmslt98b/bulletin/allmacs_axp.mar | 312 -- decus/vmslt98b/bulletin/bad.for | 22 - decus/vmslt98b/bulletin/board_digest.com | 77 - decus/vmslt98b/bulletin/board_special.com | 108 - decus/vmslt98b/bulletin/bull_news.c | 705 --- decus/vmslt98b/bulletin/bull_newsdummy.for | 99 - decus/vmslt98b/bulletin/bullcom.cld | 765 --- decus/vmslt98b/bulletin/bullcoms1.hlp | 1271 ----- decus/vmslt98b/bulletin/bullcoms2.hlp | 1463 ------ decus/vmslt98b/bulletin/bulldir.inc | 58 - decus/vmslt98b/bulletin/bullet1.com | 2790 ----------- decus/vmslt98b/bulletin/bullet2.com | 1705 ------- decus/vmslt98b/bulletin/bulletin.cld | 44 - decus/vmslt98b/bulletin/bulletin.com | 2 - decus/vmslt98b/bulletin/bulletin.for | 2129 --------- decus/vmslt98b/bulletin/bulletin.hlp | 151 - decus/vmslt98b/bulletin/bulletin.lnk | 18 - decus/vmslt98b/bulletin/bulletin0.for | 2520 ---------- decus/vmslt98b/bulletin/bulletin1.for | 2499 ---------- decus/vmslt98b/bulletin/bulletin10.for | 4120 ---------------- decus/vmslt98b/bulletin/bulletin11.for | 3592 -------------- decus/vmslt98b/bulletin/bulletin2.for | 2679 ----------- decus/vmslt98b/bulletin/bulletin3.for | 2518 ---------- decus/vmslt98b/bulletin/bulletin4.for | 2346 ---------- decus/vmslt98b/bulletin/bulletin5.for | 2516 ---------- decus/vmslt98b/bulletin/bulletin6.for | 2833 ----------- decus/vmslt98b/bulletin/bulletin7.for | 2374 ---------- decus/vmslt98b/bulletin/bulletin8.for | 2165 --------- decus/vmslt98b/bulletin/bulletin9.for | 2475 ---------- decus/vmslt98b/bulletin/bullfiles.inc | 39 - decus/vmslt98b/bulletin/bullfolder.inc | 84 - decus/vmslt98b/bulletin/bullmain.cld | 34 - decus/vmslt98b/bulletin/bullnews.inc | 7 - decus/vmslt98b/bulletin/bullstart.com | 6 - decus/vmslt98b/bulletin/bulluser.inc | 53 - decus/vmslt98b/bulletin/changes.txt | 684 --- decus/vmslt98b/bulletin/cmds.mai | 22 - decus/vmslt98b/bulletin/copyright.txt | 29 - decus/vmslt98b/bulletin/create.com | 57 - decus/vmslt98b/bulletin/createco.com | 57 - decus/vmslt98b/bulletin/handout.txt | 268 -- decus/vmslt98b/bulletin/install.com | 25 - decus/vmslt98b/bulletin/instruct.com | 6 - decus/vmslt98b/bulletin/instruct.txt | 8 - decus/vmslt98b/bulletin/login.com | 31 - decus/vmslt98b/bulletin/makefile | 82 - decus/vmslt98b/bulletin/master.com | 408 -- decus/vmslt98b/bulletin/mx.com | 958 ---- decus/vmslt98b/bulletin/mx.mai | 958 ---- decus/vmslt98b/bulletin/news.alt | 254 - decus/vmslt98b/bulletin/news.com | 679 --- decus/vmslt98b/bulletin/news.create | 155 - decus/vmslt98b/bulletin/news.moderators | 260 - decus/vmslt98b/bulletin/news.txt | 150 - decus/vmslt98b/bulletin/nonsystem.txt | 16 - decus/vmslt98b/bulletin/optimize_rms.com | 134 - decus/vmslt98b/bulletin/pmdf.com | 1031 ---- decus/vmslt98b/bulletin/restart.com | 6 - decus/vmslt98b/bulletin/setuser.mar | 125 - decus/vmslt98b/bulletin/update.fil | 11 - decus/vmslt98b/bulletin/upgrade.com | 53 - decus/vmslt98b/bulletin/writemsg.txt | 36 - 1288 files changed, 940655 deletions(-) delete mode 100644 Makefile delete mode 100644 TODO delete mode 100644 convert-vms-record-fmt.c delete mode 100644 decus/1989b/bulletin/allmacs.mar delete mode 100644 decus/1989b/bulletin/bullcoms1.hlp delete mode 100644 decus/1989b/bulletin/bullcoms2.hlp delete mode 100644 decus/1989b/bulletin/bullet1.com delete mode 100644 decus/1989b/bulletin/bullet2.com delete mode 100644 decus/1989b/bulletin/bulletin.for delete mode 100644 decus/1989b/bulletin/bulletin0.for delete mode 100644 decus/1989b/bulletin/bulletin1.for delete mode 100644 decus/1989b/bulletin/bulletin2.for delete mode 100644 decus/1989b/bulletin/bulletin3.for delete mode 100644 decus/1989b/bulletin/bulletin4.for delete mode 100644 decus/1989b/bulletin/bulletin5.for delete mode 100644 decus/1989b/bulletin/bulletin6.for delete mode 100644 decus/1989b/bulletin/bulletin7.for delete mode 100644 decus/1989b/bulletin/bulletin8.for delete mode 100644 decus/1989b/bulletin/bulletin9.for delete mode 100644 decus/1989b/bulletin/bulletin_ann.txt delete mode 100644 decus/1989b/bulletin/bulletin_howto_get.txt delete mode 100644 decus/1989b/bulletin/pmdf.com delete mode 100644 decus/lt87a/bulletin/.listing delete mode 100644 decus/lt87a/bulletin/bulallmacs.mar delete mode 100644 decus/lt87a/bulletin/bullcoms.hlp delete mode 100644 decus/lt87a/bulletin/bullet.com delete mode 100644 decus/lt87a/bulletin/bulletin.for delete mode 100644 decus/lt87a/bulletin/bulletin0.for delete mode 100644 decus/lt87a/bulletin/bulletin1.for delete mode 100644 decus/lt87a/bulletin/bulletin2.for delete mode 100644 decus/lt87a/bulletin/bulletin3.for delete mode 100644 decus/lt87a/bulletin/bulletin4.for delete mode 100644 decus/lt87a/bulletin/bulletin5.for delete mode 100644 decus/lt87a/bulletin/bulletin6.for delete mode 100644 decus/lt87a/bulletin/bulletinann.txt delete mode 100644 decus/lt89b1/bulletin/aaareadme.1st delete mode 100644 decus/lt89b1/bulletin/aaareadme.txt delete mode 100644 decus/lt89b1/bulletin/allmacs.mar delete mode 100644 decus/lt89b1/bulletin/board_digest.com delete mode 100644 decus/lt89b1/bulletin/board_special.com delete mode 100644 decus/lt89b1/bulletin/bullcom.cld delete mode 100644 decus/lt89b1/bulletin/bullcoms1.hlp delete mode 100644 decus/lt89b1/bulletin/bullcoms2.hlp delete mode 100644 decus/lt89b1/bulletin/bulldir.inc delete mode 100644 decus/lt89b1/bulletin/bullet1.com delete mode 100644 decus/lt89b1/bulletin/bullet2.com delete mode 100644 decus/lt89b1/bulletin/bulletin.cld delete mode 100644 decus/lt89b1/bulletin/bulletin.com delete mode 100644 decus/lt89b1/bulletin/bulletin.for delete mode 100644 decus/lt89b1/bulletin/bulletin.hlp delete mode 100644 decus/lt89b1/bulletin/bulletin.info delete mode 100644 decus/lt89b1/bulletin/bulletin.lnk delete mode 100644 decus/lt89b1/bulletin/bulletin0.for delete mode 100644 decus/lt89b1/bulletin/bulletin1.for delete mode 100644 decus/lt89b1/bulletin/bulletin2.for delete mode 100644 decus/lt89b1/bulletin/bulletin3.for delete mode 100644 decus/lt89b1/bulletin/bulletin4.for delete mode 100644 decus/lt89b1/bulletin/bulletin5.for delete mode 100644 decus/lt89b1/bulletin/bulletin6.for delete mode 100644 decus/lt89b1/bulletin/bulletin7.for delete mode 100644 decus/lt89b1/bulletin/bulletin8.for delete mode 100644 decus/lt89b1/bulletin/bulletin9.for delete mode 100644 decus/lt89b1/bulletin/bullfiles.inc delete mode 100644 decus/lt89b1/bulletin/bullfolder.inc delete mode 100644 decus/lt89b1/bulletin/bullmain.cld delete mode 100644 decus/lt89b1/bulletin/bullstart.com delete mode 100644 decus/lt89b1/bulletin/bulluser.inc delete mode 100644 decus/lt89b1/bulletin/create.com delete mode 100644 decus/lt89b1/bulletin/dclremote.com delete mode 100644 decus/lt89b1/bulletin/handout.txt delete mode 100644 decus/lt89b1/bulletin/install.com delete mode 100644 decus/lt89b1/bulletin/install_remote.com delete mode 100644 decus/lt89b1/bulletin/instruct.com delete mode 100644 decus/lt89b1/bulletin/instruct.txt delete mode 100644 decus/lt89b1/bulletin/login.com delete mode 100644 decus/lt89b1/bulletin/makefile delete mode 100644 decus/lt89b1/bulletin/nonsystem.txt delete mode 100644 decus/lt89b1/bulletin/pmdf.com delete mode 100644 decus/lt89b1/bulletin/remote.com delete mode 100644 decus/lt89b1/bulletin/writemsg.txt delete mode 100644 decus/vax82b/bulletin/aaareadme.txt delete mode 100644 decus/vax82b/bulletin/bc.com delete mode 100644 decus/vax82b/bulletin/bcmail.com delete mode 100644 decus/vax82b/bulletin/bcmail.txt delete mode 100644 decus/vax82b/bulletin/build.com delete mode 100644 decus/vax82b/bulletin/bull.for delete mode 100644 decus/vax82b/bulletin/bullcheck.for delete mode 100644 decus/vax82b/bulletin/bullcom.for delete mode 100644 decus/vax82b/bulletin/bulletin.hlp delete mode 100644 decus/vax82b/bulletin/bulletin.rno delete mode 100644 decus/vax82b/bulletin/bullintro.rno delete mode 100644 decus/vax82b/bulletin/bullintro.txt delete mode 100644 decus/vax82b/bulletin/bullparse.mar delete mode 100644 decus/vax85c/bulletin/aaareadme.doc delete mode 100644 decus/vax85c/bulletin/aaareadme.rno delete mode 100644 decus/vax85c/bulletin/aaareadme.txt delete mode 100644 decus/vax85c/bulletin/announce.mai delete mode 100644 decus/vax85c/bulletin/bboard.com delete mode 100644 decus/vax85c/bulletin/bulet.com delete mode 100644 decus/vax85c/bulletin/bullcom.cld delete mode 100644 decus/vax85c/bulletin/bullcoms.hlp delete mode 100644 decus/vax85c/bulletin/bulldir.inc delete mode 100644 decus/vax85c/bulletin/bullet.mai delete mode 100644 decus/vax85c/bulletin/bulletin.com delete mode 100644 decus/vax85c/bulletin/bulletin.for delete mode 100644 decus/vax85c/bulletin/bulletin.hlp delete mode 100644 decus/vax85c/bulletin/bulletin.lnk delete mode 100644 decus/vax85c/bulletin/bulletin.txt delete mode 100644 decus/vax85c/bulletin/bullfiles.inc delete mode 100644 decus/vax85c/bulletin/bullflag.inc delete mode 100644 decus/vax85c/bulletin/bullmain.cld delete mode 100644 decus/vax85c/bulletin/bullstart.com delete mode 100644 decus/vax85c/bulletin/bullsubs.for delete mode 100644 decus/vax85c/bulletin/bulluser.inc delete mode 100644 decus/vax85c/bulletin/clidef.mar delete mode 100644 decus/vax85c/bulletin/create.com delete mode 100644 decus/vax85c/bulletin/hpwd.mar delete mode 100644 decus/vax85c/bulletin/install.com delete mode 100644 decus/vax85c/bulletin/instruct.txt delete mode 100644 decus/vax85c/bulletin/login.com delete mode 100644 decus/vax85c/bulletin/netfiles/announce.mai delete mode 100644 decus/vax85c/bulletin/netfiles/file1.mai delete mode 100644 decus/vax85c/bulletin/netfiles/file2.mai delete mode 100644 decus/vax85c/bulletin/netfiles/file3.mai delete mode 100644 decus/vax85c/bulletin/netfiles/file4.mai delete mode 100644 decus/vax85c/bulletin/netfiles/file5.mai delete mode 100644 decus/vax85c/bulletin/setuic.mar delete mode 100644 decus/vax85c/bulletin/setuser.mar delete mode 100644 decus/vax85c/bulletin/startup.com delete mode 100644 decus/vax85c/bulletin/useropen.mar delete mode 100644 decus/vax86c/bulletin/aaareadme.txt delete mode 100644 decus/vax86c/bulletin/allmacs.mar delete mode 100644 decus/vax86c/bulletin/bullet.com delete mode 100644 decus/vax86c/bulletin/bulletin.for delete mode 100644 decus/vax86c/bulletin/bulletin.txt delete mode 100644 decus/vax86c/bulletin/bullsub0.for delete mode 100644 decus/vax86c/bulletin/bullsub1.for delete mode 100644 decus/vax86c/bulletin/bullsub2.for delete mode 100644 decus/vax86c/bulletin/bullsub3.for delete mode 100644 decus/vax87a/bulletin/bulletin.for delete mode 100644 decus/vax87a/bulletin/bulletin0.for delete mode 100644 decus/vax87a/bulletin/bulletin1.for delete mode 100644 decus/vax87a/bulletin/bulletin2.for delete mode 100644 decus/vax87a/bulletin/bulletin3.for delete mode 100644 decus/vax87a/bulletin/bulletin4.for delete mode 100644 decus/vax87a/bulletin/bulletin5.for delete mode 100644 decus/vax87a/bulletin/bulletin6.for delete mode 100644 decus/vax87a/bulletin/bulletinv2.doc delete mode 100644 decus/vax87d/bulletin/bulletin.for delete mode 100644 decus/vax87d/bulletin/bulletin.txt delete mode 100644 decus/vax87d/bulletin/bulletin0.for delete mode 100644 decus/vax87d/bulletin/bulletin1.for delete mode 100644 decus/vax87d/bulletin/bulletin2.for delete mode 100644 decus/vax87d/bulletin/bulletin3.for delete mode 100644 decus/vax87d/bulletin/bulletin4.for delete mode 100644 decus/vax87d/bulletin/bulletin5.for delete mode 100644 decus/vax87d/bulletin/bulletin6.for delete mode 100644 decus/vax87d/bulletin/bulletinann.txt delete mode 100644 decus/vax88a2/bulletin/aaareadme.1st delete mode 100644 decus/vax88a2/bulletin/allmacs.mar delete mode 100644 decus/vax88a2/bulletin/board_digest.com delete mode 100644 decus/vax88a2/bulletin/board_special.com delete mode 100644 decus/vax88a2/bulletin/bull_command.com delete mode 100644 decus/vax88a2/bulletin/bullcom.cld delete mode 100644 decus/vax88a2/bulletin/bullcoms1.hlp delete mode 100644 decus/vax88a2/bulletin/bullcoms2.hlp delete mode 100644 decus/vax88a2/bulletin/bulldir.inc delete mode 100644 decus/vax88a2/bulletin/bullet1.com delete mode 100644 decus/vax88a2/bulletin/bullet2.com delete mode 100644 decus/vax88a2/bulletin/bulletin.com delete mode 100644 decus/vax88a2/bulletin/bulletin.for delete mode 100644 decus/vax88a2/bulletin/bulletin.hlp delete mode 100644 decus/vax88a2/bulletin/bulletin.lnk delete mode 100644 decus/vax88a2/bulletin/bulletin.tex delete mode 100644 decus/vax88a2/bulletin/bulletin0.for delete mode 100644 decus/vax88a2/bulletin/bulletin1.for delete mode 100644 decus/vax88a2/bulletin/bulletin2.for delete mode 100644 decus/vax88a2/bulletin/bulletin3.for delete mode 100644 decus/vax88a2/bulletin/bulletin4.for delete mode 100644 decus/vax88a2/bulletin/bulletin5.for delete mode 100644 decus/vax88a2/bulletin/bulletin6.for delete mode 100644 decus/vax88a2/bulletin/bulletin7.for delete mode 100644 decus/vax88a2/bulletin/bulletin8.for delete mode 100644 decus/vax88a2/bulletin/bullfiles.inc delete mode 100644 decus/vax88a2/bulletin/bullfolder.inc delete mode 100644 decus/vax88a2/bulletin/bullmain.cld delete mode 100644 decus/vax88a2/bulletin/bullstart.com delete mode 100644 decus/vax88a2/bulletin/bulluser.inc delete mode 100644 decus/vax88a2/bulletin/create.com delete mode 100644 decus/vax88a2/bulletin/handout.txt delete mode 100644 decus/vax88a2/bulletin/help.com delete mode 100644 decus/vax88a2/bulletin/install.com delete mode 100644 decus/vax88a2/bulletin/instruct.com delete mode 100644 decus/vax88a2/bulletin/instruct.txt delete mode 100644 decus/vax88a2/bulletin/login.com delete mode 100644 decus/vax88a2/bulletin/makefile delete mode 100644 decus/vax88a2/bulletin/nonsystem.txt delete mode 100644 decus/vax88a3/bulletin/bulletin.for delete mode 100644 decus/vax88a3/bulletin/bulletin0.for delete mode 100644 decus/vax88a3/bulletin/bulletin1.for delete mode 100644 decus/vax88a3/bulletin/bulletin3.for delete mode 100644 decus/vax88a3/bulletin/bulletin4.for delete mode 100644 decus/vax88a3/bulletin/bulletin5.for delete mode 100644 decus/vax88a3/bulletin/bulletin6.for delete mode 100644 decus/vax88a3/bulletin/bulletin7.for delete mode 100644 decus/vax88a3/bulletin/bulletin7bugbug.txt delete mode 100644 decus/vax88a3/bulletin/bulletinann.txt delete mode 100644 decus/vax88b1/bulletin/aaareadme.1st delete mode 100644 decus/vax88b1/bulletin/allmacs.mar delete mode 100644 decus/vax88b1/bulletin/board_digest.com delete mode 100644 decus/vax88b1/bulletin/board_special.com delete mode 100644 decus/vax88b1/bulletin/bullcom.cld delete mode 100644 decus/vax88b1/bulletin/bullcoms1.hlp delete mode 100644 decus/vax88b1/bulletin/bullcoms2.hlp delete mode 100644 decus/vax88b1/bulletin/bulldir.inc delete mode 100644 decus/vax88b1/bulletin/bullet1.com delete mode 100644 decus/vax88b1/bulletin/bullet2.com delete mode 100644 decus/vax88b1/bulletin/bulletin.cld delete mode 100644 decus/vax88b1/bulletin/bulletin.com delete mode 100644 decus/vax88b1/bulletin/bulletin.for delete mode 100644 decus/vax88b1/bulletin/bulletin.hlp delete mode 100644 decus/vax88b1/bulletin/bulletin.lnk delete mode 100644 decus/vax88b1/bulletin/bulletin.message delete mode 100644 decus/vax88b1/bulletin/bulletin.message2 delete mode 100644 decus/vax88b1/bulletin/bulletin.message3 delete mode 100644 decus/vax88b1/bulletin/bulletin0.for delete mode 100644 decus/vax88b1/bulletin/bulletin1.for delete mode 100644 decus/vax88b1/bulletin/bulletin2.for delete mode 100644 decus/vax88b1/bulletin/bulletin3.for delete mode 100644 decus/vax88b1/bulletin/bulletin4.for delete mode 100644 decus/vax88b1/bulletin/bulletin5.for delete mode 100644 decus/vax88b1/bulletin/bulletin6.for delete mode 100644 decus/vax88b1/bulletin/bulletin7.for delete mode 100644 decus/vax88b1/bulletin/bulletin8.for delete mode 100644 decus/vax88b1/bulletin/bulletin9.for delete mode 100644 decus/vax88b1/bulletin/bullfiles.inc delete mode 100644 decus/vax88b1/bulletin/bullfolder.inc delete mode 100644 decus/vax88b1/bulletin/bullmain.cld delete mode 100644 decus/vax88b1/bulletin/bullstart.com delete mode 100644 decus/vax88b1/bulletin/bulluser.inc delete mode 100644 decus/vax88b1/bulletin/create.com delete mode 100644 decus/vax88b1/bulletin/dclremote.com delete mode 100644 decus/vax88b1/bulletin/handout.txt delete mode 100644 decus/vax88b1/bulletin/install.com delete mode 100644 decus/vax88b1/bulletin/install_remote.com delete mode 100644 decus/vax88b1/bulletin/instruct.com delete mode 100644 decus/vax88b1/bulletin/instruct.txt delete mode 100644 decus/vax88b1/bulletin/login.com delete mode 100644 decus/vax88b1/bulletin/makefile delete mode 100644 decus/vax88b1/bulletin/nonsystem.txt delete mode 100644 decus/vax88b1/bulletin/remote.com delete mode 100644 decus/vax88b1/bulletin/v5/aaareadme.1st delete mode 100644 decus/vax88b5/bulletin/bulletin.bwr delete mode 100644 decus/vax88b5/bulletin/bulletin.for delete mode 100644 decus/vax88b5/bulletin/bulletin0.for delete mode 100644 decus/vax88b5/bulletin/bulletin1.for delete mode 100644 decus/vax88b5/bulletin/bulletin2.for delete mode 100644 decus/vax88b5/bulletin/bulletin3.for delete mode 100644 decus/vax88b5/bulletin/bulletin4.for delete mode 100644 decus/vax88b5/bulletin/bulletin5.for delete mode 100644 decus/vax88b5/bulletin/bulletin6.for delete mode 100644 decus/vax88b5/bulletin/bulletin7.for delete mode 100644 decus/vax88b5/bulletin/bulletin8.for delete mode 100644 decus/vax88b5/bulletin/bulletin9.for delete mode 100644 decus/vax88b5/bulletin/bulletin_ann.txt delete mode 100644 decus/vax88b5/bulletin/bulletin_warning_vms_v5.txt delete mode 100644 decus/vax89a2/bulletin/aaareadme.1st delete mode 100644 decus/vax89a2/bulletin/aaareadme.too delete mode 100644 decus/vax89a2/bulletin/allmacs.mar delete mode 100644 decus/vax89a2/bulletin/board_digest.com delete mode 100644 decus/vax89a2/bulletin/board_special.com delete mode 100644 decus/vax89a2/bulletin/bullcom.cld delete mode 100644 decus/vax89a2/bulletin/bullcoms1.hlp delete mode 100644 decus/vax89a2/bulletin/bullcoms2.hlp delete mode 100644 decus/vax89a2/bulletin/bulldir.inc delete mode 100644 decus/vax89a2/bulletin/bullet1.com delete mode 100644 decus/vax89a2/bulletin/bullet2.com delete mode 100644 decus/vax89a2/bulletin/bulletin.cld delete mode 100644 decus/vax89a2/bulletin/bulletin.com delete mode 100644 decus/vax89a2/bulletin/bulletin.for delete mode 100644 decus/vax89a2/bulletin/bulletin.hlp delete mode 100644 decus/vax89a2/bulletin/bulletin.lnk delete mode 100644 decus/vax89a2/bulletin/bulletin0.for delete mode 100644 decus/vax89a2/bulletin/bulletin1.for delete mode 100644 decus/vax89a2/bulletin/bulletin2.for delete mode 100644 decus/vax89a2/bulletin/bulletin3.for delete mode 100644 decus/vax89a2/bulletin/bulletin4.for delete mode 100644 decus/vax89a2/bulletin/bulletin5.for delete mode 100644 decus/vax89a2/bulletin/bulletin6.for delete mode 100644 decus/vax89a2/bulletin/bulletin7.for delete mode 100644 decus/vax89a2/bulletin/bulletin8.for delete mode 100644 decus/vax89a2/bulletin/bulletin9.for delete mode 100644 decus/vax89a2/bulletin/bullfiles.inc delete mode 100644 decus/vax89a2/bulletin/bullfolder.inc delete mode 100644 decus/vax89a2/bulletin/bullmain.cld delete mode 100644 decus/vax89a2/bulletin/bullstart.com delete mode 100644 decus/vax89a2/bulletin/bulluser.inc delete mode 100644 decus/vax89a2/bulletin/create.com delete mode 100644 decus/vax89a2/bulletin/createrest.com delete mode 100644 decus/vax89a2/bulletin/dclremote.com delete mode 100644 decus/vax89a2/bulletin/handout.txt delete mode 100644 decus/vax89a2/bulletin/install.com delete mode 100644 decus/vax89a2/bulletin/install_remote.com delete mode 100644 decus/vax89a2/bulletin/instruct.com delete mode 100644 decus/vax89a2/bulletin/instruct.txt delete mode 100644 decus/vax89a2/bulletin/login.com delete mode 100644 decus/vax89a2/bulletin/makefile delete mode 100644 decus/vax89a2/bulletin/nonsystem.txt delete mode 100644 decus/vax89a2/bulletin/pmdf.com delete mode 100644 decus/vax89a2/bulletin/remote.com delete mode 100644 decus/vax89a2/bulletin/writemsg.txt delete mode 100644 decus/vax90a/bulletin/aaa-readme.net-txt delete mode 100644 decus/vax90a/bulletin/aaareadme.1st delete mode 100644 decus/vax90a/bulletin/aaareadme.txt delete mode 100644 decus/vax90a/bulletin/allmacs.mar delete mode 100644 decus/vax90a/bulletin/board_digest.com delete mode 100644 decus/vax90a/bulletin/board_special.com delete mode 100644 decus/vax90a/bulletin/bullcom.cld delete mode 100644 decus/vax90a/bulletin/bullcoms1.hlp delete mode 100644 decus/vax90a/bulletin/bullcoms2.hlp delete mode 100644 decus/vax90a/bulletin/bulldir.inc delete mode 100644 decus/vax90a/bulletin/bullet1.com delete mode 100644 decus/vax90a/bulletin/bullet2.com delete mode 100644 decus/vax90a/bulletin/bulletin.cld delete mode 100644 decus/vax90a/bulletin/bulletin.com delete mode 100644 decus/vax90a/bulletin/bulletin.for delete mode 100644 decus/vax90a/bulletin/bulletin.hlp delete mode 100644 decus/vax90a/bulletin/bulletin.lnk delete mode 100644 decus/vax90a/bulletin/bulletin0.for delete mode 100644 decus/vax90a/bulletin/bulletin1.for delete mode 100644 decus/vax90a/bulletin/bulletin2.for delete mode 100644 decus/vax90a/bulletin/bulletin3.for delete mode 100644 decus/vax90a/bulletin/bulletin4.for delete mode 100644 decus/vax90a/bulletin/bulletin5.for delete mode 100644 decus/vax90a/bulletin/bulletin6.for delete mode 100644 decus/vax90a/bulletin/bulletin7.for delete mode 100644 decus/vax90a/bulletin/bulletin8.for delete mode 100644 decus/vax90a/bulletin/bulletin9.for delete mode 100644 decus/vax90a/bulletin/bulletin_wheretoget.txt delete mode 100644 decus/vax90a/bulletin/bullfiles.inc delete mode 100644 decus/vax90a/bulletin/bullfolder.inc delete mode 100644 decus/vax90a/bulletin/bullmain.cld delete mode 100644 decus/vax90a/bulletin/bullstart.com delete mode 100644 decus/vax90a/bulletin/bulluser.inc delete mode 100644 decus/vax90a/bulletin/create.com delete mode 100644 decus/vax90a/bulletin/dclremote.com delete mode 100644 decus/vax90a/bulletin/handout.txt delete mode 100644 decus/vax90a/bulletin/install.com delete mode 100644 decus/vax90a/bulletin/install_remote.com delete mode 100644 decus/vax90a/bulletin/instruct.com delete mode 100644 decus/vax90a/bulletin/instruct.txt delete mode 100644 decus/vax90a/bulletin/login.com delete mode 100644 decus/vax90a/bulletin/makefile delete mode 100644 decus/vax90a/bulletin/nonsystem.txt delete mode 100644 decus/vax90a/bulletin/pmdf.com delete mode 100644 decus/vax90a/bulletin/remote.com delete mode 100644 decus/vax90a/bulletin/writemsg.txt delete mode 100644 decus/vax90b1/bulletin-net90b/bulletin_bugfix0.src delete mode 100644 decus/vax90b1/bulletin-net90b/bulletin_bugfix1.src delete mode 100644 decus/vax90b1/bulletin/aaareadme.1st delete mode 100644 decus/vax90b1/bulletin/aaareadme.txt delete mode 100644 decus/vax90b1/bulletin/announce.txt delete mode 100644 decus/vax90b1/bulletin/board_digest.com delete mode 100644 decus/vax90b1/bulletin/board_special.com delete mode 100644 decus/vax90b1/bulletin/bullcom.cld delete mode 100644 decus/vax90b1/bulletin/bullcoms1.hlp delete mode 100644 decus/vax90b1/bulletin/bullcoms2.hlp delete mode 100644 decus/vax90b1/bulletin/bulletin.cld delete mode 100644 decus/vax90b1/bulletin/bulletin.com delete mode 100644 decus/vax90b1/bulletin/bulletin.hlp delete mode 100644 decus/vax90b1/bulletin/bulletin.lnk delete mode 100644 decus/vax90b1/bulletin/bulletin10.for delete mode 100644 decus/vax90b1/bulletin/bullmain.cld delete mode 100644 decus/vax90b1/bulletin/bullstart.com delete mode 100644 decus/vax90b1/bulletin/create.com delete mode 100644 decus/vax90b1/bulletin/dclremote.com delete mode 100644 decus/vax90b1/bulletin/handout.txt delete mode 100644 decus/vax90b1/bulletin/install.com delete mode 100644 decus/vax90b1/bulletin/install_remote.com delete mode 100644 decus/vax90b1/bulletin/instruct.com delete mode 100644 decus/vax90b1/bulletin/instruct.txt delete mode 100644 decus/vax90b1/bulletin/login.com delete mode 100644 decus/vax90b1/bulletin/makefile delete mode 100644 decus/vax90b1/bulletin/nonsystem.txt delete mode 100644 decus/vax90b1/bulletin/pmdf.com delete mode 100644 decus/vax90b1/bulletin/remote.com delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/allmacs.mar delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulldir.inc delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulletin.for delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulletin0.for delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulletin1.for delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulletin2.for delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulletin3.for delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulletin4.for delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulletin5.for delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulletin6.for delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulletin7.for delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulletin8.for delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulletin9.for delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bullfiles.inc delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bullfolder.inc delete mode 100644 decus/vax90b1/bulletin/vlt90b/bulletin/bulluser.inc delete mode 100644 decus/vax90b1/bulletin/writemsg.txt delete mode 100644 decus/vax90b1/bulletin_beta/allmacs.mar delete mode 100644 decus/vax90b1/bulletin_beta/bull20_ann.txt delete mode 100644 decus/vax90b1/bulletin_beta/bullcoms1.hlp delete mode 100644 decus/vax90b1/bulletin_beta/bullcoms2.hlp delete mode 100644 decus/vax90b1/bulletin_beta/bullet1.com delete mode 100644 decus/vax90b1/bulletin_beta/bullet2.com delete mode 100644 decus/vax90b1/bulletin_beta/bulletin.doc delete mode 100644 decus/vax90b1/bulletin_beta/bulletin.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin0.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin1.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin10.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin2.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin3.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin4.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin5.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin6.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin7.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin8.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin9.for delete mode 100644 decus/vax90b1/bulletin_beta/bulletin_beta_ann.txt delete mode 100644 decus/vax90b1/bulletin_beta/pmdf.com delete mode 100644 decus/vax91a/bulletin/aaareadme.txt delete mode 100644 decus/vax91a/bulletin/allmacs.mar delete mode 100644 decus/vax91a/bulletin/board_digest.com delete mode 100644 decus/vax91a/bulletin/board_special.com delete mode 100644 decus/vax91a/bulletin/bull_news.c delete mode 100644 decus/vax91a/bulletin/bull_newsdummy.for delete mode 100644 decus/vax91a/bulletin/bullcom.cld delete mode 100644 decus/vax91a/bulletin/bullcoms1.hlp delete mode 100644 decus/vax91a/bulletin/bullcoms2.hlp delete mode 100644 decus/vax91a/bulletin/bulldir.inc delete mode 100644 decus/vax91a/bulletin/bullet1.com delete mode 100644 decus/vax91a/bulletin/bullet2.com delete mode 100644 decus/vax91a/bulletin/bulletin.cld delete mode 100644 decus/vax91a/bulletin/bulletin.com delete mode 100644 decus/vax91a/bulletin/bulletin.for delete mode 100644 decus/vax91a/bulletin/bulletin.hlp delete mode 100644 decus/vax91a/bulletin/bulletin.lnk delete mode 100644 decus/vax91a/bulletin/bulletin0.for delete mode 100644 decus/vax91a/bulletin/bulletin1.for delete mode 100644 decus/vax91a/bulletin/bulletin10.for delete mode 100644 decus/vax91a/bulletin/bulletin2.for delete mode 100644 decus/vax91a/bulletin/bulletin3.for delete mode 100644 decus/vax91a/bulletin/bulletin4.for delete mode 100644 decus/vax91a/bulletin/bulletin5.for delete mode 100644 decus/vax91a/bulletin/bulletin6.for delete mode 100644 decus/vax91a/bulletin/bulletin7.for delete mode 100644 decus/vax91a/bulletin/bulletin8.for delete mode 100644 decus/vax91a/bulletin/bulletin9.for delete mode 100644 decus/vax91a/bulletin/bulletin_ann.txt delete mode 100644 decus/vax91a/bulletin/bullfiles.inc delete mode 100644 decus/vax91a/bulletin/bullfolder.inc delete mode 100644 decus/vax91a/bulletin/bullmain.cld delete mode 100644 decus/vax91a/bulletin/bullnews.inc delete mode 100644 decus/vax91a/bulletin/bullstart.com delete mode 100644 decus/vax91a/bulletin/bulluser.inc delete mode 100644 decus/vax91a/bulletin/create.com delete mode 100644 decus/vax91a/bulletin/dclremote.com delete mode 100644 decus/vax91a/bulletin/handout.txt delete mode 100644 decus/vax91a/bulletin/install.com delete mode 100644 decus/vax91a/bulletin/install_remote.com delete mode 100644 decus/vax91a/bulletin/instruct.com delete mode 100644 decus/vax91a/bulletin/instruct.txt delete mode 100644 decus/vax91a/bulletin/login.com delete mode 100644 decus/vax91a/bulletin/makefile delete mode 100644 decus/vax91a/bulletin/mx.com delete mode 100644 decus/vax91a/bulletin/news.txt delete mode 100644 decus/vax91a/bulletin/nonsystem.txt delete mode 100644 decus/vax91a/bulletin/optimize_rms.com delete mode 100644 decus/vax91a/bulletin/pmdf.com delete mode 100644 decus/vax91a/bulletin/remote.com delete mode 100644 decus/vax91a/bulletin/setuser.mar delete mode 100644 decus/vax91a/bulletin/writemsg.txt delete mode 100644 decus/vax92a/bulletin-net92a/bulletin_howtoget.txt delete mode 100644 decus/vax92a/bulletin/aaareadme.txt delete mode 100644 decus/vax92a/bulletin/board_digest.com delete mode 100644 decus/vax92a/bulletin/board_special.com delete mode 100644 decus/vax92a/bulletin/bullcoms1.hlp delete mode 100644 decus/vax92a/bulletin/bullcoms2.hlp delete mode 100644 decus/vax92a/bulletin/bulletin.ann delete mode 100644 decus/vax92a/bulletin/bulletin.cld delete mode 100644 decus/vax92a/bulletin/bulletin.com delete mode 100644 decus/vax92a/bulletin/bulletin.hlp delete mode 100644 decus/vax92a/bulletin/bulletin.lnk delete mode 100755 decus/vax92a/bulletin/bulletin_source.tlb delete mode 100644 decus/vax92a/bulletin/bullstart.com delete mode 100644 decus/vax92a/bulletin/dclremote.com delete mode 100644 decus/vax92a/bulletin/extract_tlb.com delete mode 100644 decus/vax92a/bulletin/handout.txt delete mode 100644 decus/vax92a/bulletin/install.com delete mode 100644 decus/vax92a/bulletin/install_remote.com delete mode 100644 decus/vax92a/bulletin/instruct.com delete mode 100644 decus/vax92a/bulletin/instruct.txt delete mode 100644 decus/vax92a/bulletin/login.com delete mode 100644 decus/vax92a/bulletin/news.com delete mode 100644 decus/vax92a/bulletin/news.txt delete mode 100644 decus/vax92a/bulletin/nonsystem.txt delete mode 100644 decus/vax92a/bulletin/optimize_rms.com delete mode 100644 decus/vax92a/bulletin/remote.com delete mode 100644 decus/vax92a/bulletin/writemsg.txt delete mode 100644 decus/vax92b/bulletin/aaareadme.txt delete mode 100644 decus/vax92b/bulletin/allmacs.mar delete mode 100644 decus/vax92b/bulletin/bull_news.c delete mode 100644 decus/vax92b/bulletin/bull_newsdummy.for delete mode 100644 decus/vax92b/bulletin/bullcom.cld delete mode 100644 decus/vax92b/bulletin/bullcoms1.hlp delete mode 100644 decus/vax92b/bulletin/bullcoms2.hlp delete mode 100644 decus/vax92b/bulletin/bullet1.com delete mode 100644 decus/vax92b/bulletin/bullet2.com delete mode 100644 decus/vax92b/bulletin/bulletin.announce delete mode 100644 decus/vax92b/bulletin/bulletin.cld delete mode 100644 decus/vax92b/bulletin/bulletin.for delete mode 100644 decus/vax92b/bulletin/bulletin0.for delete mode 100644 decus/vax92b/bulletin/bulletin1.for delete mode 100644 decus/vax92b/bulletin/bulletin10.for delete mode 100644 decus/vax92b/bulletin/bulletin11.for delete mode 100644 decus/vax92b/bulletin/bulletin2.for delete mode 100644 decus/vax92b/bulletin/bulletin3.for delete mode 100644 decus/vax92b/bulletin/bulletin4.for delete mode 100644 decus/vax92b/bulletin/bulletin5.for delete mode 100644 decus/vax92b/bulletin/bulletin6.for delete mode 100644 decus/vax92b/bulletin/bulletin7.for delete mode 100644 decus/vax92b/bulletin/bulletin8.for delete mode 100644 decus/vax92b/bulletin/bulletin9.for delete mode 100644 decus/vax92b/bulletin/bulletin_announce.txt delete mode 100644 decus/vax92b/bulletin/bullmain.cld delete mode 100644 decus/vax92b/bulletin/mx.com delete mode 100644 decus/vax92b/bulletin/news.com delete mode 100644 decus/vax92b/bulletin/pmdf.com delete mode 100644 decus/vax92b/bulletin/setuser.mar delete mode 100644 decus/vlt95b/bulletin/aaareadme.txt delete mode 100644 decus/vlt95b/bulletin/allmacs.mar delete mode 100644 decus/vlt95b/bulletin/allmacs_axp.mar delete mode 100644 decus/vlt95b/bulletin/board_digest.com delete mode 100644 decus/vlt95b/bulletin/board_special.com delete mode 100644 decus/vlt95b/bulletin/bull_news.c delete mode 100644 decus/vlt95b/bulletin/bull_newsdummy.for delete mode 100644 decus/vlt95b/bulletin/bullcom.cld delete mode 100644 decus/vlt95b/bulletin/bullcoms1.hlp delete mode 100644 decus/vlt95b/bulletin/bullcoms2.hlp delete mode 100644 decus/vlt95b/bulletin/bulldir.inc delete mode 100644 decus/vlt95b/bulletin/bullet1.com delete mode 100644 decus/vlt95b/bulletin/bullet2.com delete mode 100644 decus/vlt95b/bulletin/bulletin.cld delete mode 100644 decus/vlt95b/bulletin/bulletin.com delete mode 100644 decus/vlt95b/bulletin/bulletin.for delete mode 100644 decus/vlt95b/bulletin/bulletin.hlp delete mode 100644 decus/vlt95b/bulletin/bulletin.lnk delete mode 100644 decus/vlt95b/bulletin/bulletin0.for delete mode 100644 decus/vlt95b/bulletin/bulletin1.for delete mode 100644 decus/vlt95b/bulletin/bulletin10.for delete mode 100644 decus/vlt95b/bulletin/bulletin11.for delete mode 100644 decus/vlt95b/bulletin/bulletin2.for delete mode 100644 decus/vlt95b/bulletin/bulletin3.for delete mode 100644 decus/vlt95b/bulletin/bulletin4.for delete mode 100644 decus/vlt95b/bulletin/bulletin5.for delete mode 100644 decus/vlt95b/bulletin/bulletin6.for delete mode 100644 decus/vlt95b/bulletin/bulletin7.for delete mode 100644 decus/vlt95b/bulletin/bulletin8.for delete mode 100644 decus/vlt95b/bulletin/bulletin9.for delete mode 100644 decus/vlt95b/bulletin/bullfiles.inc delete mode 100644 decus/vlt95b/bulletin/bullfolder.inc delete mode 100644 decus/vlt95b/bulletin/bullmain.cld delete mode 100644 decus/vlt95b/bulletin/bullnews.inc delete mode 100644 decus/vlt95b/bulletin/bullstart.com delete mode 100644 decus/vlt95b/bulletin/bulluser.inc delete mode 100644 decus/vlt95b/bulletin/changes.txt delete mode 100644 decus/vlt95b/bulletin/cmds.mai delete mode 100644 decus/vlt95b/bulletin/copyright.txt delete mode 100644 decus/vlt95b/bulletin/create.com delete mode 100644 decus/vlt95b/bulletin/handout.txt delete mode 100644 decus/vlt95b/bulletin/install.com delete mode 100644 decus/vlt95b/bulletin/instruct.com delete mode 100644 decus/vlt95b/bulletin/instruct.txt delete mode 100644 decus/vlt95b/bulletin/login.com delete mode 100644 decus/vlt95b/bulletin/makefile delete mode 100644 decus/vlt95b/bulletin/master.com delete mode 100644 decus/vlt95b/bulletin/mx.com delete mode 100644 decus/vlt95b/bulletin/mx.mai delete mode 100644 decus/vlt95b/bulletin/news.alt delete mode 100644 decus/vlt95b/bulletin/news.com delete mode 100644 decus/vlt95b/bulletin/news.create delete mode 100644 decus/vlt95b/bulletin/news.moderators delete mode 100644 decus/vlt95b/bulletin/news.txt delete mode 100644 decus/vlt95b/bulletin/nonsystem.txt delete mode 100644 decus/vlt95b/bulletin/optimize_rms.com delete mode 100644 decus/vlt95b/bulletin/pmdf.com delete mode 100644 decus/vlt95b/bulletin/restart.com delete mode 100644 decus/vlt95b/bulletin/setuser.mar delete mode 100644 decus/vlt95b/bulletin/update.fil delete mode 100644 decus/vlt95b/bulletin/upgrade.com delete mode 100644 decus/vlt95b/bulletin/writemsg.txt delete mode 100644 decus/vlt97a/bulletin/aaareadme.1st delete mode 100644 decus/vlt97a/bulletin/aaareadme.txt delete mode 100644 decus/vlt97a/bulletin/allmacs.mar delete mode 100644 decus/vlt97a/bulletin/allmacs_axp.mar delete mode 100644 decus/vlt97a/bulletin/bad.for delete mode 100644 decus/vlt97a/bulletin/board_digest.com delete mode 100644 decus/vlt97a/bulletin/board_special.com delete mode 100644 decus/vlt97a/bulletin/bull_news.c delete mode 100644 decus/vlt97a/bulletin/bull_newsdummy.for delete mode 100644 decus/vlt97a/bulletin/bullcom.cld delete mode 100644 decus/vlt97a/bulletin/bullcoms1.hlp delete mode 100644 decus/vlt97a/bulletin/bullcoms2.hlp delete mode 100644 decus/vlt97a/bulletin/bulldir.inc delete mode 100644 decus/vlt97a/bulletin/bullet1.com delete mode 100644 decus/vlt97a/bulletin/bullet2.com delete mode 100644 decus/vlt97a/bulletin/bulletin.ann delete mode 100644 decus/vlt97a/bulletin/bulletin.cld delete mode 100644 decus/vlt97a/bulletin/bulletin.com delete mode 100644 decus/vlt97a/bulletin/bulletin.for delete mode 100644 decus/vlt97a/bulletin/bulletin.hlp delete mode 100644 decus/vlt97a/bulletin/bulletin.lnk delete mode 100644 decus/vlt97a/bulletin/bulletin0.for delete mode 100644 decus/vlt97a/bulletin/bulletin1.for delete mode 100644 decus/vlt97a/bulletin/bulletin10.for delete mode 100644 decus/vlt97a/bulletin/bulletin11.for delete mode 100644 decus/vlt97a/bulletin/bulletin2.for delete mode 100644 decus/vlt97a/bulletin/bulletin3.for delete mode 100644 decus/vlt97a/bulletin/bulletin4.for delete mode 100644 decus/vlt97a/bulletin/bulletin5.for delete mode 100644 decus/vlt97a/bulletin/bulletin6.for delete mode 100644 decus/vlt97a/bulletin/bulletin7.for delete mode 100644 decus/vlt97a/bulletin/bulletin8.for delete mode 100644 decus/vlt97a/bulletin/bulletin9.for delete mode 100644 decus/vlt97a/bulletin/bullfiles.inc delete mode 100644 decus/vlt97a/bulletin/bullfolder.inc delete mode 100644 decus/vlt97a/bulletin/bullmain.cld delete mode 100644 decus/vlt97a/bulletin/bullnews.inc delete mode 100644 decus/vlt97a/bulletin/bullstart.com delete mode 100644 decus/vlt97a/bulletin/bulluser.inc delete mode 100644 decus/vlt97a/bulletin/changes.txt delete mode 100644 decus/vlt97a/bulletin/cmds.mai delete mode 100644 decus/vlt97a/bulletin/copyright.txt delete mode 100644 decus/vlt97a/bulletin/create.com delete mode 100644 decus/vlt97a/bulletin/handout.txt delete mode 100644 decus/vlt97a/bulletin/install.com delete mode 100644 decus/vlt97a/bulletin/instruct.com delete mode 100644 decus/vlt97a/bulletin/instruct.txt delete mode 100644 decus/vlt97a/bulletin/login.com delete mode 100644 decus/vlt97a/bulletin/makefile delete mode 100644 decus/vlt97a/bulletin/master.com delete mode 100644 decus/vlt97a/bulletin/mx.com delete mode 100644 decus/vlt97a/bulletin/mx.mai delete mode 100644 decus/vlt97a/bulletin/news.alt delete mode 100644 decus/vlt97a/bulletin/news.com delete mode 100644 decus/vlt97a/bulletin/news.create delete mode 100644 decus/vlt97a/bulletin/news.moderators delete mode 100644 decus/vlt97a/bulletin/news.txt delete mode 100644 decus/vlt97a/bulletin/nonsystem.txt delete mode 100644 decus/vlt97a/bulletin/optimize_rms.com delete mode 100644 decus/vlt97a/bulletin/pmdf.com delete mode 100644 decus/vlt97a/bulletin/restart.com delete mode 100644 decus/vlt97a/bulletin/setuser.mar delete mode 100644 decus/vlt97a/bulletin/update.fil delete mode 100644 decus/vlt97a/bulletin/upgrade.com delete mode 100644 decus/vlt97a/bulletin/writemsg.txt delete mode 100644 decus/vms93a/bulletin/aaareadme delete mode 100644 decus/vms93a/bulletin/aaareadme.txt delete mode 100644 decus/vms93a/bulletin/allmacs.mar delete mode 100644 decus/vms93a/bulletin/board_digest.com delete mode 100644 decus/vms93a/bulletin/board_special.com delete mode 100644 decus/vms93a/bulletin/bull_news.c delete mode 100644 decus/vms93a/bulletin/bull_newsdummy.for delete mode 100644 decus/vms93a/bulletin/bullcom.cld delete mode 100644 decus/vms93a/bulletin/bullcoms1.hlp delete mode 100644 decus/vms93a/bulletin/bullcoms2.hlp delete mode 100644 decus/vms93a/bulletin/bulldir.inc delete mode 100644 decus/vms93a/bulletin/bullet1.com delete mode 100644 decus/vms93a/bulletin/bulletin.cld delete mode 100644 decus/vms93a/bulletin/bulletin.for delete mode 100644 decus/vms93a/bulletin/bulletin.hlp delete mode 100644 decus/vms93a/bulletin/bulletin.lnk delete mode 100644 decus/vms93a/bulletin/bulletin0.for delete mode 100644 decus/vms93a/bulletin/bulletin1.for delete mode 100644 decus/vms93a/bulletin/bulletin10.for delete mode 100644 decus/vms93a/bulletin/bulletin11.for delete mode 100644 decus/vms93a/bulletin/bulletin2.for delete mode 100644 decus/vms93a/bulletin/bulletin3.for delete mode 100644 decus/vms93a/bulletin/bulletin4.for delete mode 100644 decus/vms93a/bulletin/bulletin5.for delete mode 100644 decus/vms93a/bulletin/bulletin6.for delete mode 100644 decus/vms93a/bulletin/bulletin7.for delete mode 100644 decus/vms93a/bulletin/bulletin8.for delete mode 100644 decus/vms93a/bulletin/bulletin9.for delete mode 100644 decus/vms93a/bulletin/bullfiles.inc delete mode 100644 decus/vms93a/bulletin/bullfolder.inc delete mode 100644 decus/vms93a/bulletin/bullmain.cld delete mode 100644 decus/vms93a/bulletin/bullnews.inc delete mode 100644 decus/vms93a/bulletin/bullstart.com delete mode 100644 decus/vms93a/bulletin/bulluser.inc delete mode 100644 decus/vms93a/bulletin/changes.txt delete mode 100644 decus/vms93a/bulletin/cmds.mai delete mode 100644 decus/vms93a/bulletin/copyright.txt delete mode 100644 decus/vms93a/bulletin/create.com delete mode 100644 decus/vms93a/bulletin/create_use_this_one.com delete mode 100644 decus/vms93a/bulletin/handout.txt delete mode 100644 decus/vms93a/bulletin/install.com delete mode 100644 decus/vms93a/bulletin/instruct.com delete mode 100644 decus/vms93a/bulletin/instruct.txt delete mode 100644 decus/vms93a/bulletin/login.com delete mode 100644 decus/vms93a/bulletin/makefile delete mode 100644 decus/vms93a/bulletin/master.com delete mode 100644 decus/vms93a/bulletin/mx.com delete mode 100644 decus/vms93a/bulletin/mx.mai delete mode 100644 decus/vms93a/bulletin/news.alt delete mode 100644 decus/vms93a/bulletin/news.create delete mode 100644 decus/vms93a/bulletin/news.moderators delete mode 100644 decus/vms93a/bulletin/news.txt delete mode 100644 decus/vms93a/bulletin/nonsystem.txt delete mode 100644 decus/vms93a/bulletin/optimize_rms.com delete mode 100644 decus/vms93a/bulletin/pmdf.com delete mode 100644 decus/vms93a/bulletin/restart.com delete mode 100644 decus/vms93a/bulletin/setuser.mar delete mode 100644 decus/vms93a/bulletin/update.fil delete mode 100644 decus/vms93a/bulletin/upgrade.com delete mode 100644 decus/vms93a/bulletin/writemsg.txt delete mode 100644 decus/vms93b/bulletin/aaareadme delete mode 100644 decus/vms93b/bulletin/aaareadme.txt delete mode 100644 decus/vms93b/bulletin/allmacs.mar delete mode 100644 decus/vms93b/bulletin/allmacs_axp.mar delete mode 100644 decus/vms93b/bulletin/board_digest.com delete mode 100644 decus/vms93b/bulletin/board_special.com delete mode 100644 decus/vms93b/bulletin/bull_news.c delete mode 100644 decus/vms93b/bulletin/bullcom.cld delete mode 100644 decus/vms93b/bulletin/bullcoms1.hlp delete mode 100644 decus/vms93b/bulletin/bullcoms2.hlp delete mode 100644 decus/vms93b/bulletin/bulldir.inc delete mode 100644 decus/vms93b/bulletin/bullet1.com delete mode 100644 decus/vms93b/bulletin/bulletin.cld delete mode 100644 decus/vms93b/bulletin/bulletin.for delete mode 100644 decus/vms93b/bulletin/bulletin.hlp delete mode 100644 decus/vms93b/bulletin/bulletin.lnk delete mode 100644 decus/vms93b/bulletin/bulletin0.for delete mode 100644 decus/vms93b/bulletin/bulletin1.for delete mode 100644 decus/vms93b/bulletin/bulletin10.for delete mode 100644 decus/vms93b/bulletin/bulletin11.for delete mode 100644 decus/vms93b/bulletin/bulletin2.for delete mode 100644 decus/vms93b/bulletin/bulletin3.for delete mode 100644 decus/vms93b/bulletin/bulletin4.for delete mode 100644 decus/vms93b/bulletin/bulletin5.for delete mode 100644 decus/vms93b/bulletin/bulletin6.for delete mode 100644 decus/vms93b/bulletin/bulletin7.for delete mode 100644 decus/vms93b/bulletin/bulletin8.for delete mode 100644 decus/vms93b/bulletin/bulletin9.for delete mode 100644 decus/vms93b/bulletin/bullfiles.inc delete mode 100644 decus/vms93b/bulletin/bullfolder.inc delete mode 100644 decus/vms93b/bulletin/bullmain.cld delete mode 100644 decus/vms93b/bulletin/bullnews.inc delete mode 100644 decus/vms93b/bulletin/bullstart.com delete mode 100644 decus/vms93b/bulletin/bulluser.inc delete mode 100644 decus/vms93b/bulletin/changes.txt delete mode 100644 decus/vms93b/bulletin/copyright.txt delete mode 100644 decus/vms93b/bulletin/create.com delete mode 100644 decus/vms93b/bulletin/handout.txt delete mode 100644 decus/vms93b/bulletin/install.com delete mode 100644 decus/vms93b/bulletin/instruct.com delete mode 100644 decus/vms93b/bulletin/instruct.txt delete mode 100644 decus/vms93b/bulletin/login.com delete mode 100644 decus/vms93b/bulletin/master.com delete mode 100644 decus/vms93b/bulletin/mx.com delete mode 100644 decus/vms93b/bulletin/news.com delete mode 100644 decus/vms93b/bulletin/news.create delete mode 100644 decus/vms93b/bulletin/news.txt delete mode 100644 decus/vms93b/bulletin/nonsystem.txt delete mode 100644 decus/vms93b/bulletin/optimize_rms.com delete mode 100644 decus/vms93b/bulletin/pmdf.com delete mode 100644 decus/vms93b/bulletin/restart.com delete mode 100644 decus/vms93b/bulletin/setuser.mar delete mode 100644 decus/vms93b/bulletin/upgrade.com delete mode 100644 decus/vms93b/bulletin/writemsg.txt delete mode 100644 decus/vms94a/bulletin/aaareadme.txt delete mode 100644 decus/vms94a/bulletin/allmacs.mar delete mode 100644 decus/vms94a/bulletin/allmacs_axp.mar delete mode 100644 decus/vms94a/bulletin/board_digest.com delete mode 100644 decus/vms94a/bulletin/board_special.com delete mode 100644 decus/vms94a/bulletin/bull_news.c delete mode 100644 decus/vms94a/bulletin/bull_newsdummy.for delete mode 100644 decus/vms94a/bulletin/bullcom.cld delete mode 100644 decus/vms94a/bulletin/bullcoms1.hlp delete mode 100644 decus/vms94a/bulletin/bullcoms2.hlp delete mode 100644 decus/vms94a/bulletin/bulldir.inc delete mode 100644 decus/vms94a/bulletin/bullet1.com delete mode 100644 decus/vms94a/bulletin/bulletin.cld delete mode 100644 decus/vms94a/bulletin/bulletin.for delete mode 100644 decus/vms94a/bulletin/bulletin.hlp delete mode 100644 decus/vms94a/bulletin/bulletin.lnk delete mode 100644 decus/vms94a/bulletin/bulletin0.for delete mode 100644 decus/vms94a/bulletin/bulletin1.for delete mode 100644 decus/vms94a/bulletin/bulletin10.for delete mode 100644 decus/vms94a/bulletin/bulletin11.for delete mode 100644 decus/vms94a/bulletin/bulletin2.for delete mode 100644 decus/vms94a/bulletin/bulletin3.for delete mode 100644 decus/vms94a/bulletin/bulletin4.for delete mode 100644 decus/vms94a/bulletin/bulletin5.for delete mode 100644 decus/vms94a/bulletin/bulletin6.for delete mode 100644 decus/vms94a/bulletin/bulletin7.for delete mode 100644 decus/vms94a/bulletin/bulletin8.for delete mode 100644 decus/vms94a/bulletin/bulletin9.for delete mode 100644 decus/vms94a/bulletin/bullfiles.inc delete mode 100644 decus/vms94a/bulletin/bullfolder.inc delete mode 100644 decus/vms94a/bulletin/bullmain.cld delete mode 100644 decus/vms94a/bulletin/bullnews.inc delete mode 100644 decus/vms94a/bulletin/bullstart.com delete mode 100644 decus/vms94a/bulletin/bulluser.inc delete mode 100755 decus/vms94a/bulletin/bulluser.old delete mode 100644 decus/vms94a/bulletin/changes.txt delete mode 100644 decus/vms94a/bulletin/cmds.mai delete mode 100644 decus/vms94a/bulletin/copyright.txt delete mode 100644 decus/vms94a/bulletin/create.com delete mode 100644 decus/vms94a/bulletin/handout.txt delete mode 100644 decus/vms94a/bulletin/install.com delete mode 100644 decus/vms94a/bulletin/instruct.com delete mode 100644 decus/vms94a/bulletin/instruct.txt delete mode 100644 decus/vms94a/bulletin/login.com delete mode 100644 decus/vms94a/bulletin/master.com delete mode 100644 decus/vms94a/bulletin/mx.com delete mode 100644 decus/vms94a/bulletin/mx.mai delete mode 100644 decus/vms94a/bulletin/news.com delete mode 100644 decus/vms94a/bulletin/news.create delete mode 100644 decus/vms94a/bulletin/news.moderators delete mode 100644 decus/vms94a/bulletin/news.txt delete mode 100644 decus/vms94a/bulletin/nonsystem.txt delete mode 100644 decus/vms94a/bulletin/optimize_rms.com delete mode 100644 decus/vms94a/bulletin/pmdf.com delete mode 100644 decus/vms94a/bulletin/restart.com delete mode 100644 decus/vms94a/bulletin/setuser.mar delete mode 100644 decus/vms94a/bulletin/update.fil delete mode 100644 decus/vms94a/bulletin/upgrade.com delete mode 100644 decus/vms94a/bulletin/writemsg.txt delete mode 100644 decus/vms94b/bulletin/aaareadme.txt delete mode 100644 decus/vms94b/bulletin/allmacs.mar delete mode 100644 decus/vms94b/bulletin/allmacs_axp.mar delete mode 100644 decus/vms94b/bulletin/bullcoms1.hlp delete mode 100644 decus/vms94b/bulletin/bullcoms2.hlp delete mode 100644 decus/vms94b/bulletin/bullet1.com delete mode 100644 decus/vms94b/bulletin/bullet2.com delete mode 100644 decus/vms94b/bulletin/bulletin.for delete mode 100644 decus/vms94b/bulletin/bulletin0.for delete mode 100644 decus/vms94b/bulletin/bulletin1.for delete mode 100644 decus/vms94b/bulletin/bulletin10.for delete mode 100644 decus/vms94b/bulletin/bulletin11.for delete mode 100644 decus/vms94b/bulletin/bulletin2.for delete mode 100644 decus/vms94b/bulletin/bulletin3.for delete mode 100644 decus/vms94b/bulletin/bulletin4.for delete mode 100644 decus/vms94b/bulletin/bulletin5.for delete mode 100644 decus/vms94b/bulletin/bulletin6.for delete mode 100644 decus/vms94b/bulletin/bulletin7.for delete mode 100644 decus/vms94b/bulletin/bulletin8.for delete mode 100644 decus/vms94b/bulletin/bulletin9.for delete mode 100644 decus/vms94b/bulletin/mx.com delete mode 100644 decus/vms94b/bulletin/news.com delete mode 100644 decus/vms94b/bulletin/pmdf.com delete mode 100644 decus/vms95a/bulletin/aaareadme delete mode 100644 decus/vms95a/bulletin/aaareadme.first delete mode 100644 decus/vms95a/bulletin/allmacs.mar delete mode 100644 decus/vms95a/bulletin/allmacs_axp.mar delete mode 100644 decus/vms95a/bulletin/board_digest.com delete mode 100644 decus/vms95a/bulletin/board_special.com delete mode 100644 decus/vms95a/bulletin/bull_news.c delete mode 100644 decus/vms95a/bulletin/bull_newsdummy.for delete mode 100644 decus/vms95a/bulletin/bullcom.cld delete mode 100644 decus/vms95a/bulletin/bullcoms1.hlp delete mode 100644 decus/vms95a/bulletin/bullcoms2.hlp delete mode 100644 decus/vms95a/bulletin/bulldir.inc delete mode 100644 decus/vms95a/bulletin/bulletin.cld delete mode 100644 decus/vms95a/bulletin/bulletin.for delete mode 100644 decus/vms95a/bulletin/bulletin.hlp delete mode 100644 decus/vms95a/bulletin/bulletin.lnk delete mode 100644 decus/vms95a/bulletin/bulletin0.for delete mode 100644 decus/vms95a/bulletin/bulletin1.for delete mode 100644 decus/vms95a/bulletin/bulletin10.for delete mode 100644 decus/vms95a/bulletin/bulletin11.for delete mode 100644 decus/vms95a/bulletin/bulletin2.for delete mode 100644 decus/vms95a/bulletin/bulletin3.for delete mode 100644 decus/vms95a/bulletin/bulletin4.for delete mode 100644 decus/vms95a/bulletin/bulletin5.for delete mode 100644 decus/vms95a/bulletin/bulletin6.for delete mode 100644 decus/vms95a/bulletin/bulletin7.for delete mode 100644 decus/vms95a/bulletin/bulletin8.for delete mode 100644 decus/vms95a/bulletin/bulletin9.for delete mode 100644 decus/vms95a/bulletin/bullfiles.inc delete mode 100644 decus/vms95a/bulletin/bullfolder.inc delete mode 100644 decus/vms95a/bulletin/bullmain.cld delete mode 100644 decus/vms95a/bulletin/bullnews.inc delete mode 100644 decus/vms95a/bulletin/bullstart.com delete mode 100644 decus/vms95a/bulletin/bulluser.inc delete mode 100644 decus/vms95a/bulletin/changes.txt delete mode 100644 decus/vms95a/bulletin/cmds.mai delete mode 100644 decus/vms95a/bulletin/copyright.txt delete mode 100644 decus/vms95a/bulletin/create.com delete mode 100644 decus/vms95a/bulletin/handout.txt delete mode 100644 decus/vms95a/bulletin/install.com delete mode 100644 decus/vms95a/bulletin/instruct.com delete mode 100644 decus/vms95a/bulletin/instruct.txt delete mode 100644 decus/vms95a/bulletin/login.com delete mode 100644 decus/vms95a/bulletin/makefile delete mode 100644 decus/vms95a/bulletin/master.com delete mode 100644 decus/vms95a/bulletin/mx.com delete mode 100644 decus/vms95a/bulletin/mx.mai delete mode 100644 decus/vms95a/bulletin/news.alt delete mode 100644 decus/vms95a/bulletin/news.com delete mode 100644 decus/vms95a/bulletin/news.create delete mode 100644 decus/vms95a/bulletin/news.moderators delete mode 100644 decus/vms95a/bulletin/news.txt delete mode 100644 decus/vms95a/bulletin/nonsystem.txt delete mode 100644 decus/vms95a/bulletin/optimize_rms.com delete mode 100644 decus/vms95a/bulletin/pmdf.com delete mode 100644 decus/vms95a/bulletin/restart.com delete mode 100644 decus/vms95a/bulletin/setuser.mar delete mode 100644 decus/vms95a/bulletin/update.fil delete mode 100644 decus/vms95a/bulletin/upgrade.com delete mode 100644 decus/vms95a/bulletin/writemsg.txt delete mode 100644 decus/vms95b/bulletin/aaareadme.txt delete mode 100644 decus/vms95b/bulletin/allmacs.mar delete mode 100644 decus/vms95b/bulletin/allmacs_axp.mar delete mode 100644 decus/vms95b/bulletin/board_digest.com delete mode 100644 decus/vms95b/bulletin/board_special.com delete mode 100644 decus/vms95b/bulletin/bull_news.c delete mode 100644 decus/vms95b/bulletin/bull_newsdummy.for delete mode 100644 decus/vms95b/bulletin/bullcom.cld delete mode 100644 decus/vms95b/bulletin/bullcoms1.hlp delete mode 100644 decus/vms95b/bulletin/bullcoms2.hlp delete mode 100644 decus/vms95b/bulletin/bulldir.inc delete mode 100644 decus/vms95b/bulletin/bullet1.com delete mode 100644 decus/vms95b/bulletin/bullet2.com delete mode 100644 decus/vms95b/bulletin/bulletin.cld delete mode 100644 decus/vms95b/bulletin/bulletin.com delete mode 100644 decus/vms95b/bulletin/bulletin.for delete mode 100644 decus/vms95b/bulletin/bulletin.hlp delete mode 100644 decus/vms95b/bulletin/bulletin.lnk delete mode 100644 decus/vms95b/bulletin/bulletin0.for delete mode 100644 decus/vms95b/bulletin/bulletin1.for delete mode 100644 decus/vms95b/bulletin/bulletin10.for delete mode 100644 decus/vms95b/bulletin/bulletin11.for delete mode 100644 decus/vms95b/bulletin/bulletin2.for delete mode 100644 decus/vms95b/bulletin/bulletin3.for delete mode 100644 decus/vms95b/bulletin/bulletin4.for delete mode 100644 decus/vms95b/bulletin/bulletin5.for delete mode 100644 decus/vms95b/bulletin/bulletin6.for delete mode 100644 decus/vms95b/bulletin/bulletin7.for delete mode 100644 decus/vms95b/bulletin/bulletin8.for delete mode 100644 decus/vms95b/bulletin/bulletin9.for delete mode 100644 decus/vms95b/bulletin/bullfiles.inc delete mode 100644 decus/vms95b/bulletin/bullfolder.inc delete mode 100644 decus/vms95b/bulletin/bullmain.cld delete mode 100644 decus/vms95b/bulletin/bullnews.inc delete mode 100644 decus/vms95b/bulletin/bullstart.com delete mode 100644 decus/vms95b/bulletin/bulluser.inc delete mode 100644 decus/vms95b/bulletin/changes.txt delete mode 100644 decus/vms95b/bulletin/cmds.mai delete mode 100644 decus/vms95b/bulletin/copyright.txt delete mode 100644 decus/vms95b/bulletin/create.com delete mode 100644 decus/vms95b/bulletin/handout.txt delete mode 100644 decus/vms95b/bulletin/install.com delete mode 100644 decus/vms95b/bulletin/instruct.com delete mode 100644 decus/vms95b/bulletin/instruct.txt delete mode 100644 decus/vms95b/bulletin/login.com delete mode 100644 decus/vms95b/bulletin/makefile delete mode 100644 decus/vms95b/bulletin/master.com delete mode 100644 decus/vms95b/bulletin/mx.com delete mode 100644 decus/vms95b/bulletin/mx.mai delete mode 100644 decus/vms95b/bulletin/news.alt delete mode 100644 decus/vms95b/bulletin/news.com delete mode 100644 decus/vms95b/bulletin/news.create delete mode 100644 decus/vms95b/bulletin/news.moderators delete mode 100644 decus/vms95b/bulletin/news.txt delete mode 100644 decus/vms95b/bulletin/nonsystem.txt delete mode 100644 decus/vms95b/bulletin/optimize_rms.com delete mode 100644 decus/vms95b/bulletin/pmdf.com delete mode 100644 decus/vms95b/bulletin/restart.com delete mode 100644 decus/vms95b/bulletin/setuser.mar delete mode 100644 decus/vms95b/bulletin/update.fil delete mode 100644 decus/vms95b/bulletin/upgrade.com delete mode 100644 decus/vms95b/bulletin/writemsg.txt delete mode 100644 decus/vmslt00a/bulletin/aaareadme delete mode 100644 decus/vmslt00a/bulletin/aaareadme.install delete mode 100644 decus/vmslt00a/bulletin/aaareadme.txt delete mode 100644 decus/vmslt00a/bulletin/allmacs.mar delete mode 100644 decus/vmslt00a/bulletin/allmacs_axp.mar delete mode 100644 decus/vmslt00a/bulletin/board_digest.com delete mode 100644 decus/vmslt00a/bulletin/board_special.com delete mode 100644 decus/vmslt00a/bulletin/bull_news.c delete mode 100644 decus/vmslt00a/bulletin/bull_newsdummy.for delete mode 100644 decus/vmslt00a/bulletin/bullcom.cld delete mode 100644 decus/vmslt00a/bulletin/bullcoms1.hlp delete mode 100644 decus/vmslt00a/bulletin/bullcoms2.hlp delete mode 100644 decus/vmslt00a/bulletin/bulldir.inc delete mode 100644 decus/vmslt00a/bulletin/bulletin.cld delete mode 100644 decus/vmslt00a/bulletin/bulletin.for delete mode 100644 decus/vmslt00a/bulletin/bulletin.hlp delete mode 100644 decus/vmslt00a/bulletin/bulletin.lnk delete mode 100644 decus/vmslt00a/bulletin/bulletin0.for delete mode 100644 decus/vmslt00a/bulletin/bulletin1.for delete mode 100644 decus/vmslt00a/bulletin/bulletin10.for delete mode 100644 decus/vmslt00a/bulletin/bulletin11.for delete mode 100644 decus/vmslt00a/bulletin/bulletin2.for delete mode 100644 decus/vmslt00a/bulletin/bulletin3.for delete mode 100644 decus/vmslt00a/bulletin/bulletin4.for delete mode 100644 decus/vmslt00a/bulletin/bulletin5.for delete mode 100644 decus/vmslt00a/bulletin/bulletin6.for delete mode 100644 decus/vmslt00a/bulletin/bulletin7.for delete mode 100644 decus/vmslt00a/bulletin/bulletin8.for delete mode 100644 decus/vmslt00a/bulletin/bulletin9.for delete mode 100644 decus/vmslt00a/bulletin/bullfiles.inc delete mode 100644 decus/vmslt00a/bulletin/bullfolder.inc delete mode 100644 decus/vmslt00a/bulletin/bullmain.cld delete mode 100644 decus/vmslt00a/bulletin/bullnews.inc delete mode 100644 decus/vmslt00a/bulletin/bullstart.com delete mode 100644 decus/vmslt00a/bulletin/bulluser.inc delete mode 100644 decus/vmslt00a/bulletin/changes.txt delete mode 100644 decus/vmslt00a/bulletin/cmds.mai delete mode 100644 decus/vmslt00a/bulletin/copyright.txt delete mode 100644 decus/vmslt00a/bulletin/create.com delete mode 100644 decus/vmslt00a/bulletin/debug.txt delete mode 100644 decus/vmslt00a/bulletin/handout.txt delete mode 100644 decus/vmslt00a/bulletin/install.com delete mode 100644 decus/vmslt00a/bulletin/instruct.com delete mode 100644 decus/vmslt00a/bulletin/instruct.txt delete mode 100644 decus/vmslt00a/bulletin/login.com delete mode 100644 decus/vmslt00a/bulletin/makefile delete mode 100644 decus/vmslt00a/bulletin/master.com delete mode 100644 decus/vmslt00a/bulletin/mx.mai delete mode 100644 decus/vmslt00a/bulletin/news.txt delete mode 100644 decus/vmslt00a/bulletin/news_to_folder.txt delete mode 100644 decus/vmslt00a/bulletin/nonsystem.txt delete mode 100644 decus/vmslt00a/bulletin/optimize_rms.com delete mode 100644 decus/vmslt00a/bulletin/pmdf.com delete mode 100644 decus/vmslt00a/bulletin/pmdf.txt delete mode 100644 decus/vmslt00a/bulletin/restart.com delete mode 100644 decus/vmslt00a/bulletin/setuser.mar delete mode 100644 decus/vmslt00a/bulletin/update.fil delete mode 100644 decus/vmslt00a/bulletin/upgrade.com delete mode 100644 decus/vmslt00a/bulletin/writemsg.txt delete mode 100644 decus/vmslt02a/bulletin/aaareadme delete mode 100644 decus/vmslt02a/bulletin/aaareadme.txt delete mode 100644 decus/vmslt02a/bulletin/allmacs.mar delete mode 100644 decus/vmslt02a/bulletin/allmacs_axp.mar delete mode 100644 decus/vmslt02a/bulletin/board_digest.com delete mode 100644 decus/vmslt02a/bulletin/board_special.com delete mode 100644 decus/vmslt02a/bulletin/bull_news.c delete mode 100644 decus/vmslt02a/bulletin/bull_newsdummy.for delete mode 100644 decus/vmslt02a/bulletin/bullcom.cld delete mode 100644 decus/vmslt02a/bulletin/bullcoms1.hlp delete mode 100644 decus/vmslt02a/bulletin/bullcoms2.hlp delete mode 100644 decus/vmslt02a/bulletin/bulldir.inc delete mode 100644 decus/vmslt02a/bulletin/bulletin.cld delete mode 100644 decus/vmslt02a/bulletin/bulletin.for delete mode 100644 decus/vmslt02a/bulletin/bulletin.hlp delete mode 100644 decus/vmslt02a/bulletin/bulletin.lnk delete mode 100644 decus/vmslt02a/bulletin/bulletin0.for delete mode 100644 decus/vmslt02a/bulletin/bulletin1.for delete mode 100644 decus/vmslt02a/bulletin/bulletin10.for delete mode 100644 decus/vmslt02a/bulletin/bulletin11.for delete mode 100644 decus/vmslt02a/bulletin/bulletin2.for delete mode 100644 decus/vmslt02a/bulletin/bulletin3.for delete mode 100644 decus/vmslt02a/bulletin/bulletin4.for delete mode 100644 decus/vmslt02a/bulletin/bulletin5.for delete mode 100644 decus/vmslt02a/bulletin/bulletin6.for delete mode 100644 decus/vmslt02a/bulletin/bulletin7.for delete mode 100644 decus/vmslt02a/bulletin/bulletin8.for delete mode 100644 decus/vmslt02a/bulletin/bulletin9.for delete mode 100644 decus/vmslt02a/bulletin/bullfiles.inc delete mode 100644 decus/vmslt02a/bulletin/bullfolder.inc delete mode 100644 decus/vmslt02a/bulletin/bullmain.cld delete mode 100644 decus/vmslt02a/bulletin/bullnews.inc delete mode 100644 decus/vmslt02a/bulletin/bullstart.com delete mode 100644 decus/vmslt02a/bulletin/bulluser.inc delete mode 100644 decus/vmslt02a/bulletin/changes.txt delete mode 100644 decus/vmslt02a/bulletin/cmds.mai delete mode 100644 decus/vmslt02a/bulletin/copyright.txt delete mode 100644 decus/vmslt02a/bulletin/create.com delete mode 100644 decus/vmslt02a/bulletin/handout.txt delete mode 100644 decus/vmslt02a/bulletin/install.com delete mode 100644 decus/vmslt02a/bulletin/instruct.com delete mode 100644 decus/vmslt02a/bulletin/instruct.txt delete mode 100644 decus/vmslt02a/bulletin/login.com delete mode 100644 decus/vmslt02a/bulletin/makefile delete mode 100644 decus/vmslt02a/bulletin/master.com delete mode 100644 decus/vmslt02a/bulletin/mx.mai delete mode 100644 decus/vmslt02a/bulletin/news.txt delete mode 100644 decus/vmslt02a/bulletin/news_to_folder.txt delete mode 100644 decus/vmslt02a/bulletin/nonsystem.txt delete mode 100644 decus/vmslt02a/bulletin/optimize_rms.com delete mode 100644 decus/vmslt02a/bulletin/pmdf.com delete mode 100644 decus/vmslt02a/bulletin/pmdf.txt delete mode 100644 decus/vmslt02a/bulletin/restart.com delete mode 100644 decus/vmslt02a/bulletin/setuser.mar delete mode 100644 decus/vmslt02a/bulletin/update.fil delete mode 100644 decus/vmslt02a/bulletin/upgrade.com delete mode 100644 decus/vmslt02a/bulletin/writemsg.txt delete mode 100644 decus/vmslt97a/bulletin/aaareadme.1st delete mode 100644 decus/vmslt97a/bulletin/aaareadme.txt delete mode 100644 decus/vmslt97a/bulletin/allmacs.mar delete mode 100644 decus/vmslt97a/bulletin/allmacs_axp.mar delete mode 100644 decus/vmslt97a/bulletin/bad.for delete mode 100644 decus/vmslt97a/bulletin/board_digest.com delete mode 100644 decus/vmslt97a/bulletin/board_special.com delete mode 100644 decus/vmslt97a/bulletin/bull_news.c delete mode 100644 decus/vmslt97a/bulletin/bull_newsdummy.for delete mode 100644 decus/vmslt97a/bulletin/bullcom.cld delete mode 100644 decus/vmslt97a/bulletin/bullcoms1.hlp delete mode 100644 decus/vmslt97a/bulletin/bullcoms2.hlp delete mode 100644 decus/vmslt97a/bulletin/bulldir.inc delete mode 100644 decus/vmslt97a/bulletin/bullet1.com delete mode 100644 decus/vmslt97a/bulletin/bullet2.com delete mode 100644 decus/vmslt97a/bulletin/bulletin.ann delete mode 100644 decus/vmslt97a/bulletin/bulletin.cld delete mode 100644 decus/vmslt97a/bulletin/bulletin.com delete mode 100644 decus/vmslt97a/bulletin/bulletin.for delete mode 100644 decus/vmslt97a/bulletin/bulletin.hlp delete mode 100644 decus/vmslt97a/bulletin/bulletin.lnk delete mode 100644 decus/vmslt97a/bulletin/bulletin0.for delete mode 100644 decus/vmslt97a/bulletin/bulletin1.for delete mode 100644 decus/vmslt97a/bulletin/bulletin10.for delete mode 100644 decus/vmslt97a/bulletin/bulletin11.for delete mode 100644 decus/vmslt97a/bulletin/bulletin2.for delete mode 100644 decus/vmslt97a/bulletin/bulletin3.for delete mode 100644 decus/vmslt97a/bulletin/bulletin4.for delete mode 100644 decus/vmslt97a/bulletin/bulletin5.for delete mode 100644 decus/vmslt97a/bulletin/bulletin6.for delete mode 100644 decus/vmslt97a/bulletin/bulletin7.for delete mode 100644 decus/vmslt97a/bulletin/bulletin8.for delete mode 100644 decus/vmslt97a/bulletin/bulletin9.for delete mode 100644 decus/vmslt97a/bulletin/bullfiles.inc delete mode 100644 decus/vmslt97a/bulletin/bullfolder.inc delete mode 100644 decus/vmslt97a/bulletin/bullmain.cld delete mode 100644 decus/vmslt97a/bulletin/bullnews.inc delete mode 100644 decus/vmslt97a/bulletin/bullstart.com delete mode 100644 decus/vmslt97a/bulletin/bulluser.inc delete mode 100644 decus/vmslt97a/bulletin/changes.txt delete mode 100644 decus/vmslt97a/bulletin/cmds.mai delete mode 100644 decus/vmslt97a/bulletin/copyright.txt delete mode 100644 decus/vmslt97a/bulletin/create.com delete mode 100644 decus/vmslt97a/bulletin/handout.txt delete mode 100644 decus/vmslt97a/bulletin/install.com delete mode 100644 decus/vmslt97a/bulletin/instruct.com delete mode 100644 decus/vmslt97a/bulletin/instruct.txt delete mode 100644 decus/vmslt97a/bulletin/login.com delete mode 100644 decus/vmslt97a/bulletin/makefile delete mode 100644 decus/vmslt97a/bulletin/master.com delete mode 100644 decus/vmslt97a/bulletin/mx.com delete mode 100644 decus/vmslt97a/bulletin/mx.mai delete mode 100644 decus/vmslt97a/bulletin/news.alt delete mode 100644 decus/vmslt97a/bulletin/news.com delete mode 100644 decus/vmslt97a/bulletin/news.create delete mode 100644 decus/vmslt97a/bulletin/news.moderators delete mode 100644 decus/vmslt97a/bulletin/news.txt delete mode 100644 decus/vmslt97a/bulletin/nonsystem.txt delete mode 100644 decus/vmslt97a/bulletin/optimize_rms.com delete mode 100644 decus/vmslt97a/bulletin/pmdf.com delete mode 100644 decus/vmslt97a/bulletin/restart.com delete mode 100644 decus/vmslt97a/bulletin/setuser.mar delete mode 100644 decus/vmslt97a/bulletin/update.fil delete mode 100644 decus/vmslt97a/bulletin/upgrade.com delete mode 100644 decus/vmslt97a/bulletin/writemsg.txt delete mode 100644 decus/vmslt98a/bulletin/aaareadme.doc delete mode 100644 decus/vmslt98a/bulletin/aaareadme.txt delete mode 100644 decus/vmslt98a/bulletin/allmacs.mar delete mode 100644 decus/vmslt98a/bulletin/allmacs_axp.mar delete mode 100644 decus/vmslt98a/bulletin/bad.for delete mode 100644 decus/vmslt98a/bulletin/board_digest.com delete mode 100644 decus/vmslt98a/bulletin/board_special.com delete mode 100644 decus/vmslt98a/bulletin/bull_news.c delete mode 100644 decus/vmslt98a/bulletin/bull_newsdummy.for delete mode 100644 decus/vmslt98a/bulletin/bullcom.cld delete mode 100644 decus/vmslt98a/bulletin/bullcoms1.hlp delete mode 100644 decus/vmslt98a/bulletin/bullcoms2.hlp delete mode 100644 decus/vmslt98a/bulletin/bulldir.inc delete mode 100644 decus/vmslt98a/bulletin/bullet1.com delete mode 100644 decus/vmslt98a/bulletin/bullet2.com delete mode 100644 decus/vmslt98a/bulletin/bulletin.cld delete mode 100644 decus/vmslt98a/bulletin/bulletin.com delete mode 100644 decus/vmslt98a/bulletin/bulletin.for delete mode 100644 decus/vmslt98a/bulletin/bulletin.hlp delete mode 100644 decus/vmslt98a/bulletin/bulletin.lnk delete mode 100644 decus/vmslt98a/bulletin/bulletin0.for delete mode 100644 decus/vmslt98a/bulletin/bulletin1.for delete mode 100644 decus/vmslt98a/bulletin/bulletin10.for delete mode 100644 decus/vmslt98a/bulletin/bulletin11.for delete mode 100644 decus/vmslt98a/bulletin/bulletin2.for delete mode 100644 decus/vmslt98a/bulletin/bulletin3.for delete mode 100644 decus/vmslt98a/bulletin/bulletin4.for delete mode 100644 decus/vmslt98a/bulletin/bulletin5.for delete mode 100644 decus/vmslt98a/bulletin/bulletin6.for delete mode 100644 decus/vmslt98a/bulletin/bulletin7.for delete mode 100644 decus/vmslt98a/bulletin/bulletin8.for delete mode 100644 decus/vmslt98a/bulletin/bulletin9.for delete mode 100644 decus/vmslt98a/bulletin/bullfiles.inc delete mode 100644 decus/vmslt98a/bulletin/bullfolder.inc delete mode 100644 decus/vmslt98a/bulletin/bullmain.cld delete mode 100644 decus/vmslt98a/bulletin/bullnews.inc delete mode 100644 decus/vmslt98a/bulletin/bullstart.com delete mode 100644 decus/vmslt98a/bulletin/bulluser.inc delete mode 100644 decus/vmslt98a/bulletin/changes.txt delete mode 100644 decus/vmslt98a/bulletin/cmds.mai delete mode 100644 decus/vmslt98a/bulletin/copyright.txt delete mode 100644 decus/vmslt98a/bulletin/create.com delete mode 100644 decus/vmslt98a/bulletin/handout.txt delete mode 100644 decus/vmslt98a/bulletin/install.com delete mode 100644 decus/vmslt98a/bulletin/instruct.com delete mode 100644 decus/vmslt98a/bulletin/instruct.txt delete mode 100644 decus/vmslt98a/bulletin/login.com delete mode 100644 decus/vmslt98a/bulletin/makefile delete mode 100644 decus/vmslt98a/bulletin/master.com delete mode 100644 decus/vmslt98a/bulletin/mx.com delete mode 100644 decus/vmslt98a/bulletin/mx.mai delete mode 100644 decus/vmslt98a/bulletin/news.alt delete mode 100644 decus/vmslt98a/bulletin/news.com delete mode 100644 decus/vmslt98a/bulletin/news.create delete mode 100644 decus/vmslt98a/bulletin/news.moderators delete mode 100644 decus/vmslt98a/bulletin/news.txt delete mode 100644 decus/vmslt98a/bulletin/nonsystem.txt delete mode 100644 decus/vmslt98a/bulletin/optimize_rms.com delete mode 100644 decus/vmslt98a/bulletin/pmdf.com delete mode 100644 decus/vmslt98a/bulletin/restart.com delete mode 100644 decus/vmslt98a/bulletin/setuser.mar delete mode 100644 decus/vmslt98a/bulletin/update.fil delete mode 100644 decus/vmslt98a/bulletin/upgrade.com delete mode 100644 decus/vmslt98a/bulletin/writemsg.txt delete mode 100644 decus/vmslt98b/bulletin/aaareadme.1st delete mode 100644 decus/vmslt98b/bulletin/aaareadme.txt delete mode 100644 decus/vmslt98b/bulletin/allmacs.mar delete mode 100644 decus/vmslt98b/bulletin/allmacs_axp.mar delete mode 100644 decus/vmslt98b/bulletin/bad.for delete mode 100644 decus/vmslt98b/bulletin/board_digest.com delete mode 100644 decus/vmslt98b/bulletin/board_special.com delete mode 100644 decus/vmslt98b/bulletin/bull_news.c delete mode 100644 decus/vmslt98b/bulletin/bull_newsdummy.for delete mode 100644 decus/vmslt98b/bulletin/bullcom.cld delete mode 100644 decus/vmslt98b/bulletin/bullcoms1.hlp delete mode 100644 decus/vmslt98b/bulletin/bullcoms2.hlp delete mode 100644 decus/vmslt98b/bulletin/bulldir.inc delete mode 100644 decus/vmslt98b/bulletin/bullet1.com delete mode 100644 decus/vmslt98b/bulletin/bullet2.com delete mode 100644 decus/vmslt98b/bulletin/bulletin.cld delete mode 100644 decus/vmslt98b/bulletin/bulletin.com delete mode 100644 decus/vmslt98b/bulletin/bulletin.for delete mode 100644 decus/vmslt98b/bulletin/bulletin.hlp delete mode 100644 decus/vmslt98b/bulletin/bulletin.lnk delete mode 100644 decus/vmslt98b/bulletin/bulletin0.for delete mode 100644 decus/vmslt98b/bulletin/bulletin1.for delete mode 100644 decus/vmslt98b/bulletin/bulletin10.for delete mode 100644 decus/vmslt98b/bulletin/bulletin11.for delete mode 100644 decus/vmslt98b/bulletin/bulletin2.for delete mode 100644 decus/vmslt98b/bulletin/bulletin3.for delete mode 100644 decus/vmslt98b/bulletin/bulletin4.for delete mode 100644 decus/vmslt98b/bulletin/bulletin5.for delete mode 100644 decus/vmslt98b/bulletin/bulletin6.for delete mode 100644 decus/vmslt98b/bulletin/bulletin7.for delete mode 100644 decus/vmslt98b/bulletin/bulletin8.for delete mode 100644 decus/vmslt98b/bulletin/bulletin9.for delete mode 100644 decus/vmslt98b/bulletin/bullfiles.inc delete mode 100644 decus/vmslt98b/bulletin/bullfolder.inc delete mode 100644 decus/vmslt98b/bulletin/bullmain.cld delete mode 100644 decus/vmslt98b/bulletin/bullnews.inc delete mode 100644 decus/vmslt98b/bulletin/bullstart.com delete mode 100644 decus/vmslt98b/bulletin/bulluser.inc delete mode 100644 decus/vmslt98b/bulletin/changes.txt delete mode 100644 decus/vmslt98b/bulletin/cmds.mai delete mode 100644 decus/vmslt98b/bulletin/copyright.txt delete mode 100644 decus/vmslt98b/bulletin/create.com delete mode 100644 decus/vmslt98b/bulletin/createco.com delete mode 100644 decus/vmslt98b/bulletin/handout.txt delete mode 100644 decus/vmslt98b/bulletin/install.com delete mode 100644 decus/vmslt98b/bulletin/instruct.com delete mode 100644 decus/vmslt98b/bulletin/instruct.txt delete mode 100644 decus/vmslt98b/bulletin/login.com delete mode 100644 decus/vmslt98b/bulletin/makefile delete mode 100644 decus/vmslt98b/bulletin/master.com delete mode 100644 decus/vmslt98b/bulletin/mx.com delete mode 100644 decus/vmslt98b/bulletin/mx.mai delete mode 100644 decus/vmslt98b/bulletin/news.alt delete mode 100644 decus/vmslt98b/bulletin/news.com delete mode 100644 decus/vmslt98b/bulletin/news.create delete mode 100644 decus/vmslt98b/bulletin/news.moderators delete mode 100644 decus/vmslt98b/bulletin/news.txt delete mode 100644 decus/vmslt98b/bulletin/nonsystem.txt delete mode 100644 decus/vmslt98b/bulletin/optimize_rms.com delete mode 100644 decus/vmslt98b/bulletin/pmdf.com delete mode 100644 decus/vmslt98b/bulletin/restart.com delete mode 100644 decus/vmslt98b/bulletin/setuser.mar delete mode 100644 decus/vmslt98b/bulletin/update.fil delete mode 100644 decus/vmslt98b/bulletin/upgrade.com delete mode 100644 decus/vmslt98b/bulletin/writemsg.txt diff --git a/Makefile b/Makefile deleted file mode 100644 index c330041..0000000 --- a/Makefile +++ /dev/null @@ -1,6 +0,0 @@ -.PHONY: all - -all: convert-vms-record-fmt - -convert-vms-record-fmt: convert-vms-record-fmt.c - gcc -o convert-vms-record-fmt convert-vms-record-fmt.c diff --git a/TODO b/TODO deleted file mode 100644 index 1599d41..0000000 --- a/TODO +++ /dev/null @@ -1,12 +0,0 @@ -1. Need to extract these dirs again - missing some files: - decus/vax87a/bbs again - decus/vax87d/rcaf87/netnew - vax88a3/rcas88/nets88/ - vax88b5/rcaf88/netf88/ - vax91b/gce91b/net91b - vms94a/london - vms93a/gce93a/net93a - vax92a/gce92a/net92a/ - vax90b1/gce90b/net90b/ -2. Need to get a dump of ls -lR or something. Git doesn't save any of - the file time attributes and they might be of use. diff --git a/convert-vms-record-fmt.c b/convert-vms-record-fmt.c deleted file mode 100644 index 1bd55ea..0000000 --- a/convert-vms-record-fmt.c +++ /dev/null @@ -1,32 +0,0 @@ -#include -#include -#include -#include - -int -main(int argc, char *argv[]) -{ - uint16_t len; - size_t bytes; - unsigned char line[0xffff + 2]; - - while (1) { - bytes = fread(&len, 1, sizeof(uint16_t), stdin); - if (bytes != 2) { - break; - } - if (len % 2 == 1) { - len++; - } - bytes = fread(line, 1, len, stdin); - if (bytes != len) { - break; - } - line[len] = '\0'; - printf("%s\n", line); - } - - exit(0); - return 0; -} - diff --git a/decus/1989b/bulletin/allmacs.mar b/decus/1989b/bulletin/allmacs.mar deleted file mode 100644 index 6e955a9..0000000 --- a/decus/1989b/bulletin/allmacs.mar +++ /dev/null @@ -1,282 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:41 -To: MRGATE::"ARISIA::EVERHART" -Subj: ALLMACS.MAR - -Message-Id: <8907211348.AA23779@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 09:02:30 EDT -Date: Fri, 21 Jul 89 08:39 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: ALLMACS.MAR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - - .END diff --git a/decus/1989b/bulletin/bullcoms1.hlp b/decus/1989b/bulletin/bullcoms1.hlp deleted file mode 100644 index 92e569d..0000000 --- a/decus/1989b/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,618 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:43 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLCOMS1.HLP - -Message-Id: <8907211348.AA23782@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 09:02:37 EDT -Date: Fri, 21 Jul 89 08:40 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLCOMS1.HLP -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does not -change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this assumes -that the remote node is capable of supporting this feature, i.e. the BULLCP -process is running on that node. If it is not, you will receive an error -message). If the the foldername is specified with only a nodename, -i.e. FOO::, the foldername is assumed to be GENERAL. NOTE: Specifying -remote nodes is only possible if that remote node is running a special -BULLCP process. If it isn't, the only way to add messages to that remote -node is via the /NODE command. However, /FOLDER is a much quicker method, -and much more versatile. - -You can specify logical names which translate to one or more folder names. -I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify /NODES= -ALL_FOLDERS. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL - -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See installation -notes). You can specify a different username to use at the other nodes by -either using the USERNAME qualifier, or by specifying the nodename with 2 -semi-colons followed by the username, i.e. nodename::username. If you -specify a username, you will be prompted for the password of the account -on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /PERMANENT -This option is restricted to privileged users for the GENERAL folder, -but available to all in other folders. If specified, message will be a -permanent message and will never expire. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -NOTE: If the bulletin files are shared between cluster nodes, the -message will be deleted after the node on which the message was -submitted from is rebooted. If the folder is a remote folder, the -message will be deleted after the remote node reboots, not the node -from which the message was added. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /TEXT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 BACK -Displays the message preceding the current message. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. If the text of the message -is to be changed, a file can be specified which contains the text. -Otherwise, you will be prompted for the text. The expiration info and -header can also be changed. If neither no qualifiers are added to the -command, it is assumed the whole message will be replaced. - - Format: - CHANGE [file-name] -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. This only applies to the GENERAL folder. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number - -Specifies the message number to be replaced. If this qualifier is L -omitted, the message that is presently being read will be replaced.O -2 /PERMANENT -Specifies that the message is to be made permanent.v -2 /SHUTDOWNA -Specifies that the message is to expire after the next computerF -shutdown. This option is restricted to SYSTEM folders.T -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEMN -Specifies that the message is to be made a SYSTEM message. This is ah -privileged command and is restricted to SYSTEM folders.i -2 /TEXTs -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to beo -copied to. Optionally, a range of messages which are to be copied can bet -specified following the folder name, i.e. COPY NEWFOLDER 2-5.t -2 /ALL -Specifies to copy all the messages in the old folder.B -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.r -2 /ORIGINALp -Specifies that the owner of the copied message will be the original ownere -of the message. The default is that the copied message will be owned by -the person copying the message.s -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically selectedb -(see information on SELECT command). The commands that can be used to -modify the folder's characteristics are: MODIFY, REMOVE, SET ACCESS, -SET BBOARD, SET NODE, and SET SYSTEM.g - - Format:d - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the foldere -is stored in a file name created with the folder name).a - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying BULLCOM.CLD. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description. - -Specifies the description of the folder, which is displayed using thec -SHOW FOLDER command. If omitted, you are prompted for a description. - -NOTE: If this folder is to receive messages from a network mailing listS -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTg -commands, the address of the mailing list should be included in thes -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST o -2 /NODE - /NODE=nodenameE -Specifies that the folder is a remote folder at the specified nodename.. -A remote folder is a folder in which the messages are actually storedr -on a folder at a remote DECNET node. The specified nodename is checked -to see if a folder of the same name is located on that node. If so, the -folder will point to that folder. This capability is only present if theD -BULLCP process is created on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If one node add a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -That information is only updated every 15 minutes (same algorithm for -updating BBOARD messages), or if a user accesses that folder.f -2 /NOTIFYf -Specifies that all users automatically have NOTIFY set for this folder.e -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command.N -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base.A -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info.D -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldernamel -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name.h -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW forb -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEMs -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is. -allowed to have SYSTEM and SHUTDOWN messages added to it. By default, -the GENERAL folder is a SYSTEM folder. This is a privileged command.a - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.e -1 CURRENTo - -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format:a - - CURRENTe -2 /EDITm -Specifies that the editor is to be used to read the message. This ise -useful for scanning a long message.r -1 DELETE -Deletes the specified message. If no message is specified, the currentp -message is deleted. Only the original owner or a privileged user canS -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want thea -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It iso -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot beq -specified if the folder is remote. -2 /ALL -Specifies to delete all the messages in the folder. Note: This willi -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. -2 /NODES - /NODES=(nodes[,...])e - -Specifies to delete the message at the listed DECNET nodes. The BULLETINa -utility must be installed properly on the other nodes. You can specifyh -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specifice -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then, -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message.m -It can be a substring of the subject. This is in case you have forgotteni -the exact subject that was specified. Case is not critical either.i -You will be notified if the deletion was successful. -2 /USERNAMEc -Specifies username to be used at remote DECNET nodes when deleting messagese -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORYg -Lists a summary of the messages. The message number, submitter's name,t -date, and subject of each message is displayed.i - - Format:t - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. -2 /DESCRIBEm -Valid when used with /FOLDERS. Specifies to include description of folder.s -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. -2 /MARKEDr -Lists messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will haveo -to be reselected using the SELECT command. -2 /NEW -Specifies to start the listing of messages with the first unread message.n -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.a -2 /START - /START=message_number - -Indicates the first message number you want to display. For example,l -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -1 EXIT -Exits the BULLETIN program.a -1 EXTRACTs -Synonym for FILE command.s -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified. - - Format:l - FILE [message_number][-message_number1]l - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5.a -2 /ALL -Copies all the messages in the current folder. -2 /HEADERw - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the a -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file.. -1 Folders -All messages are divided into separate folders. The default folder is -GENERAL. New folders can be created by any user. As an example, thes -following creates a folder for GAMES related messages: t - -BULLETIN> CREATE GAMES -Enter a one line description of folder.e -GAMESa - -To see the list of available folders, use DIRECTORY/FOLDERS. To selectT -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, thatb -user will be alerted of topics of new messages at login time, and will p -then be given the option of reading them. Similar to READNEW is SHOWNEW,o -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option,p -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added.n - -A folder can be restricted to only certain users, if desired. This is i -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATEe -rather than /PRIVATE is specified, all users can read the messages in thee -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SETa -NODE. A remote folder is one which points to a folder on a remote DECNET -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)i -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/l -SHUTDOWN/BROADCAST messages can be added. By default, the GENERAL folder -is a SYSTEM folder (and cannot be changed). One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the GENERAL -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, anda -giving access to that UIC group. Only users in that UIC group will seet -the messages in that folder when they log in.h -1 HELP -To obtain help on any topic, type: - - HELP topicL - -CTRL-Y only breaks out of a command when no files are open. Otherwise,n -use CTRL-C, which will abort the program. However, unlike CTRL-Y, you -can not resume execution using the VMS CONTINUE command. Also note that -CTRL-C will not abort if BULLETIN is waiting for input from the terminal.N -1 INDEXf -Gives directory listing of all folders in alphabetical order. If the -INDEX command is re-entered while the listing is in progress, the listingo -will skip to the next folder. This is useful for skipping a particularl -folder. It also can be used to continue the listing from where one left -off after one has read a message.S - - Format:e - INDEX -2 /MARKEDS -Shows only messages that have been marked (indicated by an asterisk).e -2 /NEW -Specifies to start the listing of each folder with the first unread message. -Otherwise, the listing will start with the first message in the folder.f -If the INDEX command is re-entered for continuing the listing, /NEW must -be respecified.t -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder.t -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/TE|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/TE| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format:e - LASTs -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format:I - - MAIL recipient-namee - -The input for the recipient name is exactly the same format as used by -the MAIL utility.d -2 /HEADERr - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the b -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of morei -than one word, enclose the text in quotation marks (").e - -If you omit this qualifier, the description of the message will be used -as the subject.. -1 MARK -Sets the current or message-id message as marked. Marked messages areS -displayed with an asterisk in the left hand column of the directory= -listing. A marked message can serve as a reminder of importantt -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers]m - UNMARK [message-number or numbers]e - -NOTE: The list of marked messages are stored in a file username.BULLMARK -in the directory pointed to by the logical name BULL_MARK. If BULL_MARK -is not defined, an error message will be displayed when attempting toE -mark a message. BULL_MARK may be defined system wide, depending onD -whether the system manager has decided to do so. -1 MODIFY -Modifies the database information for the current folder. Only the owner -of the folder or a user with privileges can use this command.f - - Format:i - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted forO -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing listh -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST* -commands, the address of the mailing list should be included in thet -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST u -2 /NAMES - /NAME=foldernameN - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not havee -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. -1 MOVE -Moves a message to another folder and deletes it from the current -folder.p - - Format:p - - MOVE folder-name [message_number][-message_number1]e - -The folder-name is the name of the folder to which the message is to beh -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,i -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /MERGE -Specifies that the original date and time of the moved messages arei -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.i -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned byc -the person moving the message. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. diff --git a/decus/1989b/bulletin/bullcoms2.hlp b/decus/1989b/bulletin/bullcoms2.hlp deleted file mode 100644 index d7d5603..0000000 --- a/decus/1989b/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,763 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:44 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLCOMS2.HLP - -Message-Id: <8907211348.AA23787@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 09:02:58 EDT -Date: Fri, 21 Jul 89 08:40 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLCOMS2.HLP -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -1 POST -Sends a message via MAIL to the network mailing list which is -associated with the selected folder. This command is used in -conjunction with a folder which receives messages from a network -mailing list. The address of the mailing list must be stored using -either CREATE/DESCRIPTION or MODIFY/DESCRIPTION. See help on those -commands for more information. -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 /TEXT -Specifies that the text of the message that is being read should be -included in the mai message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with > at the -beginning of each line. This can be suppressed with /NOINDENT. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The PRINT command can take optional qualifiers. - - Format: - - PRINT [message_number][-message_number1] - -A range of messages to be printed can optionally be specified, i.e. -FILE 2-5. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder will -be displayed. However, if there are new messages, the first new message -will be displayed. Each time you enter the command, the next page, or if -there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply hitting -the key is equivalent to "READ". -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected using the SELECT command. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged -user can remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /TEXT. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /TEXT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -2 /TEXT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing -the first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header. -If a "search-string" is not specified, a search is made using the -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default general messages. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.). - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. -2 /MARKEDV -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected.h -1 SETt -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format:s - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format:i - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database -for which access is being modified. It can also be a file name whichp -contains a list of ids. For more information concerning usage ofr -private folders, see HELP CREATE /PRIVATE. NOTE: Access is createdu -via ACLs. If a user's process privileges are set to override ACLs,p -that user will be able to access the folder even if access has not -been granted. -3 id -The id-name can be one or more ids contained in the system Rightsx -Database. This includes usernames and UICs. A UIC that contains -a comma must be enclosed in quotes. UICs can contain wildcards, -i.e. "[130,*]". Note that by default, a process is given thef -process rights id SYS$NODE_nodename, where nodename is the decnet -nodename. Thus, by specifing this id, a folder can be restricteda -to a specific node, which is useful when the folder is shared amongE -nodes in a cluster.s - -Alternatively, the id-name can be a filename which contains a list -of ids. The filename should be preceeded by a "@". If the suffix -is not specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. -If /READ is not specified, the folder will no longer be private. -If /READ is specified, all users will have read access, but only -privileged users will have write access (of course non-privilegedr -users can gain access via a later SET ACCESS command.) - -Format:n - - SET ACCESS /ALL [folder-name]t -3 /READd -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warningv -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that theu -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. u -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will applya -to the selected folder, and each folder can have its own BBOARD. Only c -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, orr -the scratch bboard_directory (specified when compiling BULLETIN) must[ -have world rwed protection. Also, certain system parameters which affect -detached subprocesses are usually too low for the subprocess which -is spawned to read the mail. The parameters and the suggested values are: -PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, and PQL_DFILLM = 30. If you -are not using the BULLCP process, the subprocess limit for users must be -at least 2. - - Format:t - - SET BBOARD [username]f - -BBOARD cannot be set for remote folders. See also the commands SET STRIPs -and SET DIGEST for options on formatting BBOARD messages. -3 /EXPIRATIONd - /EXPIRATION=dayss - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to bee -retained. The default is 14 days. The highest limit that can bei -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature.s -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username iss -specified, and the conversion still takes its input from VMS MAIL, thend -the VMS system mail file is checked to see if new mail exists for theh -specified user before running the command procedure. This saves time ande -avoids creating subprocesses. (Useful if input is digest format.) -3 More_information - -The following is relevant only if the messages in the BBOARD accountsl -are sent via a method that causes the name of the account to be placed -in the TO: line of the VMS MAIL. The normal MAIL utility, of course,N -does this. However, packages such as PMDF (and probably many others)d -will not always do this. (I.e. if the mail was sent to the account -using CC:, the address of the person to whom the mail was sent will be -placed in the TO: line rather than the CC: address.) - -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX andq -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for thei -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that havet -the /SPECIAL set on their BBOARD accounts cannot have their mail forwarded -to BBOARD accounts that don't have /SPECIAL set. Folders of the same -type, i.e. that use the same /SPECIAL command procedure, must be grouped -separately.e -2 BRIEFe -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. This cannot be specified for -the GENERAL folder. The BRIEF setting contrasts with the READNEW -setting, which causes a listing of the description of the new messages -to be displayed and prompts the user to read the messages. Setting -BRIEF will clear a READNEW setting (and visa versa). - - Format:o - - SET [NO]BRIEFe -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newT -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername: - -Specifies the folder for which the option is to modified. If notL -specified, the selected folder is modified. Valid only with NOBRIEF. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest limitU -that can be specified is 30 days. This can be overridden by a user with -privileges.r - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will -be used. - - Format:E - - SET DEFAULT_EXPIRE days, - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never beU -specified for a folder with a BBOARD, or else the messages will disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, ore -written directly from a network mailing program (i.e. PMDF). Severalg -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set,c -the messages will be separated into individual BULLETIN messages. - - Format:a - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG,e -and it is located in the folder directory. - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. -(NOTE: SHOW FOLDER/FULL is a privileged command.)c -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - SET [NO]EXPIRE_LIMIT [days]i - -The command SHOW FOLDER/FULL will show the expiration limit, if one exists. -(NOTE: SHOW FOLDER/FULL is a privileged command.)d -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information./ - - Format:p - - SET FOLDER [node-name::][folder-name]. -3 /MARKEDi -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will havec -to be reselected. -2 GENERICa -Specifies that the given account is a "generic" account, i.e used by many -different people. If an account is specified as GENERIC, new messages -placed in the GENERAL folder will be displayed upon logging in for a -specific number of days, rather than only once. The default period is 7 -days. This command is a privileged command. - - Format:Y - - SET [NO]GENERIC username -3 /DAYS - /DAYS=number_of_dayst - -Specifies the number days that new GENERAL messages will be displayedr -for upon logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format:D - - SET [NO]KEYPAD -2 LOGINe -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this willt -not occur if DISMAIL is set for an old account. Additionally, removingt -the DISMAIL flag will not automatically enable LOGIN. (The reason for -the above was to avoid extra overhead for constant checking for thei -DISMAIL flag.) This command is a privileged command.a - - Format:s - - SET [NO]LOGIN username -2 NODE -Modifies the selected folder from a local folder to a remote folder. -A remote folder is a folder in which the messages are actually storedF -on a folder at a remote DECNET node. The SET NODE command specifies -the name of the remote node, and optionally the name of the remote -folder. If the remote folder name is not included, it is assumed to -be the same as the local folder. When the command is executed, the -selected folder will then point to the remote folder. If there were -messages in the local folder, they will be deleted. This feature is -present only if the BULLCP process is running on the remote node. - - Format:3 - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that folder.t -3 /FOLDERo - /FOLDER=foldernamea - -Specifies the folder for which the node information is to modified.a -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when aa -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -This command does not presently work for remote folders. - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are loggedi -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared.t -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users foro -the specified folder. This is a privileged qualifier. - -If cluster notification is set, users will not be able to disableo -notification for themselves. This is because VMS is unable to find out -user names logged in at other nodes, which requires BULLETIN to keep a -list of users to notify. If /ALL is specified, the list may be very -large, which would cause the notification process to take a very longt -time. It is much easier to simply notify all users. However, this can -be overriden by the /NOCLUSTER qualifier, which will cause the list to -be generated.a -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specifiedo -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. - -If cluster notification is set, all users will notificated, and usersl -will not be able to disable notification for themselves. This isM -because VMS is unable to find out user names logged in at other nodes, -which requires BULLETIN to keep a list of users to notify. If /DEFAULT -is specified, the list may be very large, which would cause theO -notification process to take a very long time. It is much easier to -simply notify all users. However, /NOCLUSTER will override this, -causing the list to be generated.l -3 /CLUSTER - /[NO]CLUSTERo - -Specifies that if /ALL or /DEFAULT has been selected, and clustert -notification is enabled, all users across the network will be notified -of new messages. Users will not be able to disable notification.r -This is the default. /NOCLUSTER will disable this causing /DEFAULTr -and /ALL to work as it normally does, i.e. /DEFAULT simply setting -the default for new users, and /ALL causing all users to be notified -while enabling users to disable notification. However, if your system -has a lot of users, this will cause the notification algorithm to take -a very long time.p -3 /FOLDER - /FOLDER=foldernamep - -Specifies the folder for which the option is to modified. If notl -specified, the selected folder is modified. Valid only with NONOTIFY.] -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is F -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN.d - - Format:t - - SET [NO]PAGE -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format:. - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. l -To remove a privilege, specify the privilege preceeded by "NO".d -If /ID is specified, the parameters are rights identifiers.d -3 /IDd - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.t -2 PROMPT_EXPIREw -Specifies that a user will be prompted for an expiration date when adding -a message. If NOPROMPT_EXPIRE is specified, the user will not be prompted,v -and the default expiration (which is set by SET DEFAULT_EXPIRE or SETr -BBOARD/EXPIRATION) will be used. If the value specified is greater than the -expiration limit, and the user does not have privileges, then the expiration -limit will be used as the default expiration. (If there is no expiration. -limit, and the user doesn't have privileges, then an error will result.) -PROMPT_EXPIRE is the default.t - - Format:i - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to read -new non-system or folder messages (if any exist). The default is dependenta -on how the folder was created by the owner.a - -In order to apply this to a specific folder, first select the folder i -(using the SELECT command), and then enter the SET READNEW command./ -For messages in folders other than the GENERAL folder, both prompting -and display of topics of new messages are controlled by this command.l -For the GENERAL folder, the display of topics cannot be disabled.i - - Format:d - - SET [NO]READNEWp - -NOTE: If you have several folders with READNEW enabled, each folder'sM -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT thee -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP -SET SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersp -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERt - /FOLDER=foldernamec - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default isc -dependent on how the folder was created by the owner.t - -In order to apply this to a specific folder, first select the folder g -(using the SELECT command), and then enter the SET SHOWNEW command.c -This command cannot be used for the GENERAL folder. - - Format:a - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newl -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERu - /FOLDER=foldernamet - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -2 STRIPr -Affect only messages which are added via either the BBOARD option, oro -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped offs -before it is stored as a BULLETIN message. - - Format: - - SET [NO]STRIPi - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is an -privileged command.e - - Format:s - - SET [NO]SYSTEM - -By default, the GENERAL folder is a SYSTEM folder, and the setting for -that folder cannot be removed. - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.l -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGSn -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for thei -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected viai -the SELECT command, information about that folder is shown.i - - Format:e - - SHOW FOLDER [folder-name]e -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder ist -private, and BBOARD information. This information is only those who -have access to that folder. -2 KEYPAD -Displays the keypad command definitions. If the keypad has been enabled -by either the SET KEYPAD COMMAND, or /KEYPAD is specified on the command l -line, the keypad keys will be defined as commands. SHOW KEYPAD is the -equivalent of HELP KEYPAD. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unreads -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in. If NOLOGIN is set for a user,D -this information will be displayed instead. This is a privileged command. -Non-privileged users will only be able to display the information for -their own account. - - Format:h - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. s - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some sites -make BULLETIN/LOGIN an optional command for users to store in their ownm -LOGIN.COM, so this command can be used to show which users have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is ac -privileged command.e -3 /LOGIN - /[NO]LOGINe - -Specifies that only those users which do not have NOLOGIN set are to bet -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -2 VERSIONe -Shows the version of BULLETIN and the date that the executable was linked. -1 SPAWNy -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format:G - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 UNDELETE -Undeletes the specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have theira -expiration date set to 15 minutes in the future and are deleted then. -Undeleting the message will reset the expiration date back to its original -value. Deleted messages will be indicated as such by the string (DELETED) -when either reading or doing a directory listing.f - - Format:e - UNDELETE [message-number]D diff --git a/decus/1989b/bulletin/bullet1.com b/decus/1989b/bulletin/bullet1.com deleted file mode 100644 index 29db276..0000000 --- a/decus/1989b/bulletin/bullet1.com +++ /dev/null @@ -1,790 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:46 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLET1.COM - -Message-Id: <8907211349.AA23792@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 09:03:14 EDT -Date: Fri, 21 Jul 89 08:40 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLET1.COM -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -$set nover -$copy sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utility PMDF. If you wish to -do so for another utility, read the text file WRITEMSG.TXT. I would be glad to -include any such programs with my distribution if you think such a program -would be of use to other users. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, you may have to modify the subroutine - which executes the RESPOND command. That command sends messages to either - the originator of the message or the mailing list associated with the - folder. These routines assume that one can simply use the VMS MAIL - utility to do so. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - - BULLETIN will work for both V4 & V5. However, you will have to reassemble - ALLMACS.MAR if you are upgrading from V5, i.e. - $ MAC ALLMACS - $ LIB BULL ALLMACS - $ DELETE ALLMACS.OBJ; - $ @BULLETIN.LNK - $ COPY BULLETIN.EXE BULL_DIR: - $ RUN SYS$SYSTEM:INSTALL - BULL_DIR:BULLETIN/REPLACE - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of theR - data file. Older versions of BULLETIN will not run with newer formats2 - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format.r - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require differentE - linked executables.)s - -8) MASTER.COMy - If you are using PMDF, and want to use the BBOARD option, a set oft - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for howa - to do this. - -9) BULLETIN.COMi - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used.f - NOTE: Privileged functions such as /SYSTEM will work on other nodesl - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. -$eod r -$copy sys$input BULLDIR.INC -$decki - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4o - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIMC - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME. - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIPt - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATEv - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIMEo - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY)f - - PARAMETER LINE_LENGTH=255 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(LINE_LENGTH) -$eod h -$copy sys$input BULLETIN.HLP -$deckt -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that newh -messages have been added and the topics of those messages areR -displayed. Reading of those messages is optional. (Use the command SETA -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. i -Messages are automatically deleted after a specified expiration date,o -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility.a -Type HELP after invoking the BULLETIN command. -2 DescriptionB -The BULLETIN utility is a utility to display messages to users wheno -logging in. Users are notified of messages only once. They're notL -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled thew -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone iso -allowed to read them but write access is limited.t - -When new non-system messages are displayed, an optional feature which ao -user may enable will cause BULLETIN to ask whether the user wishes tom -read the new bulletins. The user can then read the messages (with thee -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. n - -Privileged users can broadcast their message (to either all users or -all terminals).o - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a newE -message has been added. - -An optional "Bulletin Board" feature allows messages to be created bye -users of other systems connected via networks. A username can ben -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, andL -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed toT -another user.A -2 /EDITd -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keyso -correspond to BULLETIN commands. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a fullE -screen or not. /PAGE is the default. If /NOPAGE is specified, anyp -output will continue until it finishes. This is useful if you have aL -terminal which can store several screenfuls of display in it's memory. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETINo -is aware that it is running on another node. (On the local node whereI -BULLCP is running, this logical name is automatically defined.)h -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUPO -for information on the BULLCP process.)e -2 /SYSTEMf - /SYSTEM=[days]e - -Displays system messages that have been recently added. The default ise -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages thatm -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -$eod -$copy sys$input BULLETIN.LNK -$deck -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB-t - /EXE=BULLETIN,SYS$INPUT/OPT -ID="V1.69" -$eod n -$copy sys$input BULLFILES.INCo -$decky -Ct -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -CB -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED.e -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY,e -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SUREE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVES -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30.l -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR")o -Cs - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF IT* -C IS NOT, THEN THEY SHOULD ALSO BE CHANGED. -C, - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/H - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/K - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/A -$eod M -$copy sys$input BULLFOLDER.INC -$deck -!W -! The following 2 parameters can be modified if desired before compilation. -!T - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days thatD - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING.E - PARAMETER ADDID = .TRUE. ! Allows users who are not in theE - ! rights data base to be addedR - ! according to uic number.E - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)'G - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT,r - & F_NEWEST_NOSYS_BTIM,FILLER,h - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2)e - LOGICAL FOLDER_SET. - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/I - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8s - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT,t - & F1_NEWEST_NOSYS_BTIM,FILLER1,i - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) -$eod s -$copy sys$input BULLUSER.INC -$deckl -!t -! The parameter FOLDER_MAX should be changed to increase the maximum numbera -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own.u -!w - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16w - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)'e - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEFt - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEFt - CHARACTER TEMP_USER*12s - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG)s - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2)i - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for foldere - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcastO - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DATc - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod e -$copy sys$input HANDOUT.TXTs -$deck - Introduction to BULLETIN on the Vax - 2/88 AWn - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particularl -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user forL -these things when a message is being added.f - - Several different folders are currently defined tos -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, ito -will be posted in the General folder as a 'System' message.a -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Foldersi - - Different folders have been created to contain messages on. -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post toi -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the publicu - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers.M -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 andO -Prolog journals -watch for new ones being added.K - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL,A -for short) at the '$' prompt. BULLETIN will display its promptT -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which foldersO -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like:E - - Folder Owner - *GENERAL SYSTEML - *PUBLIC_ANNOUNCEMENTS BBEYERE - NETMONTH BITNETU - *VAX_SIG BBEYERd - -An asterisk (*) next to the folder name indicates you have unreadR -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all availableR -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folderU -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTSL - -and BULLETIN would respond:N - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this foldera -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORYi -would have bulletin respond: - - # Description From Datee - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may typeM -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquiredF -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, itN -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond:* - -Message number: 1 PUBLIC_ANNOUNCEMENTSR -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message.....E - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently beingD -read.A - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current messaget -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will beP -prompted for it. For example: - -BULLETIN> Read 2M - -********** Message on Screen ********N - -A person could then type -BULLETIN> extract1 -file: FV.TXT) -BULLETIN>T - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'.T - If the file to which the user is writing already exists,E -BULLETIN will append the message to the file. The user canS -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message tot -your PC, perhaps using a BITNET journal message as a reference ind -a paper. Once the file is saved, you can transfer it to a PC byt -following the instructions in the handout 'Transferring files! -from the PC to the VAX of from the VAX to a PC". - -Adding messagesl - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided thatS -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message usingL -the VAX editor or uploading a message from your PC (seeM -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subjecto -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may alsoe -use the EDT text editor by issuing the command with thee -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTSt -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULDi -EXPIRE: ENTER ABsolute TIME: l - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The messagen -will be deleted automatically on the 20th of July as requested -by the user adding the message.i - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when newt -messages are in a folder, he should use the 'READNEW' option.A -This command does not force the reader to reading new messages,, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set toc -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTSt -folder has been set to PUBLIC_ANNOUNCEMENTST -BULLETIN> SET READNEWr - -Alternately, you may type SET SHOWNEW. This will just display ad -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send,l -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too.t - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod C -$copy sys$input INSTRUCT.TXT -$decks -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayedf -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can beM -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). o -$eod ) -$copy sys$input NONSYSTEM.TXTi -$deckl -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in thisB -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the defaulti -directory to write the file into.l - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEWS -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages.* -$eod t -$copy sys$input WRITEMSG.TXT -$decku -BULLETIN contains subroutines for writing a message directly to a folder. Thisd -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and thenm -have BULLCP read the mail. It is better if the network mail could be writtens -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead.O - -Call INIT_MESSAGE_ADD to initiate a message addition.a -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition.e - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -CT -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS:s -C IER - Error status. True if properly connected to folder. -C False if folder not found.e -Cy - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message.' -Cm - - CALL FINISH_MESSAGE_ADD -Ca -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -Ce -$eod n diff --git a/decus/1989b/bulletin/bullet2.com b/decus/1989b/bulletin/bullet2.com deleted file mode 100644 index 50047ae..0000000 --- a/decus/1989b/bulletin/bullet2.com +++ /dev/null @@ -1,1080 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:48 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLET2.COM - -Message-Id: <8907211350.AA23820@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 09:03:33 EDT -Date: Fri, 21 Jul 89 08:40 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLET2.COM -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -$set nover -$copy sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 6/29/89 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE): - QUALIFIER EDIT, NEGATABLEL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE: - QUALIFIER GENERAL, NONNEGATABLEe - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLEL - QUALIFIER SHUTDOWN, NONNEGATABLE - QUALIFIER SYSTEM,NONNEGATABLEE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERALR - DISALLOW PERMANENT AND SHUTDOWND - DISALLOW PERMANENT AND EXPIRATIONe - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADERh - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder"p - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALLX - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATET - QUALIFIER BRIEF, NONNEGATABLE: - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) -!" -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DATF -! has the following protection: (RWED,RWED,,) -!P - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED)E - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLER - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED)F - QUALIFIER SEMIPRIVATE, NONNEGATABLE- - QUALIFIER SHOWNEW, NONNEGATABLE" - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETEU - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALLm - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)U - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDERO - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLEF - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)L - QUALIFIER MARKED, NONNEGATABLE - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDERc - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULTA - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command.h - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED),s - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALLh - QUALIFIER HEADER, DEFAULTp - QUALIFIER NEW, NONNEGATABLEl - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILEw - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED),o - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALLl - QUALIFIER HEADER, DEFAULTa - QUALIFIER NEW, NONNEGATABLEa - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB HELPT - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDERi - QUALIFIER MARKED - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLEo - QUALIFIER NEWa - QUALIFIER RESTARTs - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLEC - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME). - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LASTi - DEFINE VERB MAILp - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients"l - VALUE(REQUIRED,IMPCAT,LIST)o - QUALIFIER HEADER, DEFAULTO - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFYf - QUALIFIER DESCRIPTIONi - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVEc - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder"e - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGET - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODESL - DEFINE VERB NEXT - DEFINE VERB POST - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULTS - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER, DEFAULTT - QUALIFIER NOTIFY, DEFAULTR - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLEI - QUALIFIER FORM, VALUE, NONNEGATABLEi - QUALIFIER ALLA - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUITX - DEFINE VERB READM - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULTi - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)F - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)$ - QUALIFIER ALL, NONNEGATABLEH - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE$ - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELLO - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLEH - QUALIFIER EXPIRATION, NONNEGATABLE, VALUEH - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)" - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL$ - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLER - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWNS - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED)a - NONNEGATABLE - DEFINE VERB REMOVEO - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB SEARCHt - PARAMETER P1, LABEL=SEARCH_STRINGT - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED)L - QUALIFIER SUBJECTM - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER. - QUALIFIER MARKED, NONNEGATABLE - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"N - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODEN - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIREL - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERICT - KEYWORD NOGENERIC, SYNTAX=SET_GENERICE - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGINE - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGSI - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGSW - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGSN - KEYWORD READNEW, SYNTAX=SET_FLAGS, - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESSU - KEYWORD FOLDER, SYNTAX=SET_FOLDERA - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGESI - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIREC - KEYWORD NOPROMPT_EXPIREL - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIREG - KEYWORD STRIP - KEYWORD NOSTRIPN - KEYWORD DIGEST - KEYWORD NODIGEST - DEFINE SYNTAX SET_NODEJ - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED), - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED)N - DEFINE SYNTAX SET_NONODEE - QUALIFIER FOLDER, VALUE(REQUIRED)N - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"L - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED)X - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What": - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED)i - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLER - QUALIFIER ALL, NONNEGATABLEV - QUALIFIER CLUSTER, DEFAULT - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NOT ALL AND NOT DEFAULT AND CLUSTER - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLER - QUALIFIER ALL, NONNEGATABLEE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARDE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"W - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAMEW - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLER - QUALIFIER VMSMAIL, NONNEGATABLEB - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDERL - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"G - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDERU - QUALIFIER MARKED, NONNEGATABLE - DEFINE SYNTAX SET_NOACCESSS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"F - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDERD - QUALIFIER ALL, NONNEGATABLEE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESSI - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"C - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGESa - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges"E - VALUE (REQUIRED,LIST)O - DEFINE SYNTAX SET_DEFAULT_EXPIREU - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"h - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOWA - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -!E -! The following are defined to allow qualifiers to be specifiedE -! directly after the SHOW command, i.e. SHOW/FULL FOLDER.L -! Otherwise, the CLI routines will reject the command, because itE -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLEE - QUALIFIER ALL, SYNTAX=SHOW_USERL - QUALIFIER LOGIN, SYNTAX=SHOW_USERB - QUALIFIER NOLOGIN, SYNTAX=SHOW_USERA - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINTL - DEFINE TYPE SHOW_OPTIONST - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS" - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSIONM - DEFINE SYNTAX SHOW_FLAGST - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)B - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)L - QUALIFIER PRINTU - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)I - QUALIFIER PRINT,DEFAULTB - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)L - PARAMETER P2, LABEL=SHOW_FOLDERU - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)U - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALLN - QUALIFIER LOGINA - QUALIFIER NOLOGINT - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAMEE - DISALLOW (LOGIN AND NOLOGIN) - DEFINE SYNTAX SHOW_FOLDER_FULLF - QUALIFIER FULL, DEFAULTL - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB SPAWNU - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARKA - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB UNDELETEL - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) -$eod P -$copy sys$input BULLETIN.CLD -$deckL -!N -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table.A -! The alternative is to define a symbol to execute BULLETIN.E -! Either way will work, and it is up to the user's to decide whichO -! method to work. (If you don't know which, you probably should useB -! the default symbol method.) -!O - -Define Verb BULLETIN - Image BULL_DIR:BULLETIND - Parameter P1, Label = SELECT_FOLDERL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required)T - Qualifier EDIT - Qualifier KEYPAD - Qualifier LOGINO - Qualifier MARKED - Qualifier PAGE, DefaultD - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEWN - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices.F - ! The line consists of a line of all "-"s, i.e.: - !--------------------------------------------------------------------------F - ! If you want a different character to be used, simply put in the desired oneI - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!)E - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUPE - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7")L -$eod L -$copy sys$input BULLETIN.COM -$deck -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -$eod E -$copy sys$input BULLMAIN.CLD -$deckS - MODULE BULLETIN_MAINCOMMANDSA - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED)Y - QUALIFIER EDIT - QUALIFIER KEYPAD - QUALIFIER LOGINP - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULTI - QUALIFIER READNEWT - QUALIFIER REVERSE, -!N -! The following line causes a line to be outputted separating system notices.= -! The line consists of a line of all "-"s, i.e.: -!--------------------------------------------------------------------------S -! If you want a different character to be used, simply put in the desired oneS -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!)W -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULTY - QUALIFIER STARTUPE - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER,DEFAULT="7") -$eod R -$copy sys$input BULLSTART.COME -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod E -$copy sys$input CREATE.COM -$deckY -$ FORTRAN/EXTEND BULLETIN -$ FORTRAN/EXTEND BULLETIN0 -$ FORTRAN/EXTEND BULLETIN1 -$ FORTRAN/EXTEND BULLETIN2 -$ FORTRAN/EXTEND BULLETIN3 -$ FORTRAN/EXTEND BULLETIN4 -$ FORTRAN/EXTEND BULLETIN5 -$ FORTRAN/EXTEND BULLETIN6 -$ FORTRAN/EXTEND BULLETIN7 -$ FORTRAN/EXTEND BULLETIN8 -$ FORTRAN/EXTEND BULLETIN9 -$ MAC ALLMACSU -$ SET COMMAND/OBJ BULLCOMX -$ SET COMMAND/OBJ BULLMAIN -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB; -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIB/CREATE BULLI -$ LIB BULL *.OBJ;N -$ DELETE *.OBJ;* -$ @BULLETIN.LNKN -$eod ( -$copy sys$input DCLREMOTE.COM -$deckS -$! DCL procedure to execute DCL commands passed over Decnet on a remote system.T -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE andE -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command:1 -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file.N -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. T -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang.U -$! -$ SET NOON -$ N = 0A -$AGAIN:F -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NETE -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND$ -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NETB -$eod A -$copy sys$input INSTALL.COM -$deckL -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL= -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXITL -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines andP -$! define the logical name BULL_HELP to be the help library directory, i.e.C -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY]L -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN -$eod N -$copy sys$input INSTALL_REMOTE.COM -$deckS -$! -$! INSTALL_REMOTE.COMI -$! VERSION 5/25/88 -$! -$! DESCRIPTION:1 -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. TheyD -$! should be placed on the command line which executes this commandV -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes.n -$! TEST - Specifies that all the nodes are to be checked to see if theyS -$! are up before beginning the intallation.s -$! -$! NOTES:i -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions.H -$! Also, you need to have a proxy login with privileges on those nodes.A -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you shouldO -$! use the OLD parameter when running this procedure.F -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES.D -$! Place the nodes where the executable is to be copied to in COPY_NODES.W -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +-R -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON"F -$ BULLCP_NODES = "NERUS,LAURIE,ARVON"A -$! -$ NODES = NODES + ",", -$ COPY_NODES = COPY_NODES + ",", -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0L -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0L -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1F -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1)) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TESTL -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPYn -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES)i -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR:u -$ GOTO COPY' -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51K -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE:f -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL- -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCPe -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETEE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE:C -$! -$! The procedure now installs the new BULLETIN.E -$! -$ NODES1 = NODES -$INSTALL:A -$ IF F$LEN(NODES1) .EQ. 0 THEN EXITL -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR-l -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM)- -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACEi -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLEd -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. -o - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCPF -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP:T -$ @REMOTE 'NODE' END CONTINUET -$ GOTO INSTALL -$eod L -$copy sys$input INSTRUCT.COM -$deckS -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXTy -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod X -$copy sys$input LOGIN.COMX -$deckL -$! -$! The following line defines the BULLETIN command.E -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after7 -$! the executable image. Thus, as it is presently set up, the promptU -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break." -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier.l -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time.l -$! -$eod j -$copy sys$input MAKEFILE.M -$deck -# Makefile for BULLETINa - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olbn - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel -W - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V1.68" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj' - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.IncN - Fortran /Extend /NoList Bulletin.ForU - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \I - Bullfiles.IncS - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \o - Bullfiles.Inca - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \r - Bullfiles.IncL - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \e - Bullfiles.IncS - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \C - Bulldir.IncI - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \E - Bullfiles.IncM - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \d - Bullfiles.Incl - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \i - Bullfiles.Inca - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \i - Bullfiles.Incp - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \t - Bullfiles.Inco - Fortran /Extend /NoList Bulletin9.For - -Allmacs.Obj : Allmacs.marC - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cldh - Set Command /Obj Bullcom.Cldl - -Bullmain.Obj : Bullmain.clds - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlbe -*.hlb :e - lib/help/cre $*r -$eod e -$copy sys$input REMOTE.COM -$decka -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAKT -$! DCL procedure to execute DCL commands on a remote decnet node.n -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directoryi -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control.e -$! If no access control is specified then a proxy login is attempted.e -$! The you do not have an account on the remote system then the defaultE -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$A -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8'e -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD"E -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK:E -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$S -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMANDE -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINEl -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD'F -$ WRITE SYS$OUTPUT LINEN -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR:Y -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP -$eod diff --git a/decus/1989b/bulletin/bulletin.for b/decus/1989b/bulletin/bulletin.for deleted file mode 100644 index b74afed..0000000 --- a/decus/1989b/bulletin/bulletin.for +++ /dev/null @@ -1,1411 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 09:12 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN.FOR - -Message-Id: <8907211244.AA22766@crdgw1.ge.com> -Date: Fri, 21 Jul 89 08:35 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN.FOR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -C -C BULLETIN.FOR, Version 5/9/89 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$GET_FOREIGN(INCMD) - CALL CLI$DCL_PARSE('BULLETIN '//INCMD,BULLETIN_MAINCOMMANDS) - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - END IF - CALL LIB$REVERT - - READIT = 0 - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP')) THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - CALL RUN_BULLCP ! doing what BULLCP does! - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL SHOW_SYSTEM - CALL EXIT - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - CALL NEW_MESSAGE_NOTIFICATION - - CALL OPEN_OLD_TAG - - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - - DO WHILE (1) - - CALL GET_INPUT_PROMPT(INCMD,IER, - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - - IF (IER.EQ.-2) THENA - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN- - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ')C - INCMD = INCMD(2:IER): - IER = IER - 1 - END DOI - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9')i - IER = IER - 1 - END DOb - IF (IER.EQ.0) INCMD = 'READ '//INCMDF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THENE - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN enteredU - LEN_P = 0 ! Indicate no parameter in commandR - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting themO - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletinL - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IFT - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has errorM - GO TO 100 ! ask for new commandM - END IF - - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0A - - IER = MAX(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/'))D - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiersI - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command.2 - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL'R - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THENP - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - CALL ADD - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THENL - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE?S - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY?. - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE?E - CALL CREATE_FOLDER ! Go create the folderl - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning.i - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE?e - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all foldersn - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successfulI - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - GO TO 999 ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX?L - INDEX_COUNT = 1N - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST?= - READ_COUNT = -1 - BULL_READ = 99999F - CALL READ(READ_COUNT,BULL_READ)e - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.) - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL?F - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE?R - CALL MOVE(.TRUE.)P - ELSE IF (INCMD(:4).EQ.'NEXT') THEN ! NEXT?A - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST?D - CALL RESPOND(MAIL_STATUS)O - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT ! Printout bulletinD - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ?P - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified?n - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1V - CALL READ(READ_COUNT,BULL_READ)) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY?I - CALL REPLY - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND? - CALL RESPOND(MAIL_STATUS)L - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT)S - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET?F - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER)t - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIVN - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')')t - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD?H - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD?g - CALL SET_NOKEYPADM - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE?L - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')')N - ELSE IF (FOLDER_NUMBER.EQ.-1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')')r - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.)) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD?B - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP')L - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1)u - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(1,-2,-2) - ELSEt - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)p - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE?R - CALL SET_NODE(.TRUE.)E - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE?= - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THENM - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(0,-2,-2) - ELSEI - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')D - END IF - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN' - WRITE (6,'(' - & '' ERROR: SET SHOWNEW not allowed for GENERAL folder.'')')' - ELSE IF (CLI$PRESENT('DEFAULT')) THENI - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE IF (CLI$PRESENT('ALL')) THEN_ - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,1). - ELSEO - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')c - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(1,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'(_ - & '' ERROR: SET NOSHOWNEW not allowed for GENERAL folder.'')')s - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THENL - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0)D - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')T - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE IF (CLI$PRESENT('ALL')) THENM - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,0)r - ELSEL - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')( - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW?? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSEL - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')C - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (FOLDER_NUMBER.EQ.0) THENC - WRITE (6,'( - & '' ERROR: SET BRIEF not allowed for GENERAL folder.'')')' - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,1) - ELSE( - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSEL - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(1,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN! - WRITE (6,'( - & '' ERROR: SET NOBRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0)C - ELSER - WRITE (6,'('' ERROR: /ALL is a privileged command.'')'): - END IF - ELSE& - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS?4 - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC?_ - CALL SET_GENERIC(.FALSE.)) - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.)G - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE')T - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIREu - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS: - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDERN - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - DO FOLDER_NUMBER = 0,FOLDER_MAX-1E - IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR.D - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER)E - IF (NBULL.GT.0) THEN - DIFF = COMPARE_BTIM( - & LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - IF (DIFF.LT.0) THENI - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER))) - END IFT - END IF - END IF' - END DO - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER). - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER?T - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESSN - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE?) - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.)I - END IF - -100 CONTINUE - - END DOE - -999 CALL EXITn - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - - SUBROUTINE ADDC -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -CE - IMPLICIT INTEGER (A - Z)Y - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODER - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITD - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULTT - DATA EDIT_DEFAULT/.FALSE./T - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLFOLDER.INC'. - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER*(LINE_LENGTH) INDESCRIP - - CHARACTER INLINE*80,OLD_FOLDER*25 - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying toi - END IF ! create new file. - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',READONLY,A - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privileges. - ELSE IF (CLI$PRESENT('TEXT')) THENR - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'O - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,) - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED')D - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)S - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)A - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENL - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENS - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSEB - WRITE (3,'(A)') '>'//INPUT(:ILEN)? - END IFF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IFR - - SELECT_FOLDERS = .FALSE.C - IF (CLI$PRESENT('SELECT_FOLDER')) THENE - CALL GET_FOLDER_INFO(IER)E - IF (.NOT.IER) GO TO 910_ - SELECT_FOLDERS = .TRUE.N - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDERO - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER). - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET? - USERNAME = DEFAULT_USERA - CALL CONFIRM_PRIV(USERNAME,ALLOW)N - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and6 - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910, - END IFL - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present?E - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910D - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abortO - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IFN - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?N - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?' - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privilegesL - WRITE(ERROR_UNIT,1081) ! Tell user - GO TO 910 ! and abortL - ELSE IF (F_EXPIRE_LIMIT.GT.0.AND..NOT.ALLOW ! Expiration limit - & .AND.USERNAME.NE.FOLDER_OWNER) THEN ! is present - WRITE(ERROR_UNIT,1083)w - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00') - END IF - END IFR - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privilegese - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abortL - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bitL - INEXDATE = '5-NOV-2000' - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (INEXTIME,'(I4)') NODE_NUMBER - WRITE (INEXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO- - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IFR - - SELECT_NODES = .FALSE.O - IF (CLI$PRESENT('NODES')) THEN' - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940) - SELECT_NODES = .TRUE.) - END IFI - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER)A - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11)' - INEXTIME = INPUT(13:)A - END IFC - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY?( - INDESCRIP = DESCRIP ! Use description with RE:,R - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified_ - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE. - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IFH - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: "E - -C' -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.P -CX - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THENI - IF (LEN_P.EQ.0) THEN ! If no file param specifiedL - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',_ - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')E - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')L - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',I - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')E - END IF - END IFE - - ICOUNT = 0 ! Line count for bulletin - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record countR - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80)T - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counterL - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredH - ICOUNT = ICOUNT + ILEN ! Update counterL - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file. - END IFN - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THENu - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST'))R - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST'E - IF (CLI$PRESENT('PERMANENT'))E - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT'R - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1E - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodesR - INLINE = INLINE(:LEN_INLINE)T - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolonsO - ILEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Are semicolon found?L - IF (ILEN.GT.SEMI+1) THEN ! Is username found? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! YesR - ILEN = SEMI - 1 ! Remove semicolons - ELSE ! No username found...I - TEMP_USER = DEFAULT_USER ! Set user to defaultS - ILEN = SEMI - 1 ! Remove semicolons - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons presentO - TEMP_USER = DEFAULT_USER ! Set user to default - END IF - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0)Y - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10)P - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910N - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:ILEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER)G - CLOSE (UNIT=10+NODE_NUM)I - IF (IER.NE.0) THENL - WRITE (6,'('' ERROR: Password is invalid.'')') - END IFC - END DON - INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)G - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH)R - IF (IER.EQ.0) THENF - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN)A - END IFE - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THENL - WRITE (6,'('' Message successfully sent to node '',A)')E - & NODES(POINT_NODE)u - ELSEN - WRITE (6,'('' Error while sending message to node '',A)')L - & NODES(POINT_NODE)_ - WRITE (6,'(A)') INPUT(:80)e - GO TO 940 - END IFT - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95s - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IFE - - -CA -C Add bulletin to bulletin file and directory entry for to directory file.N -C) - BRDCST = .FALSE.N - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1O - FOLDER1 = NODES(I)C - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - FROM = USERNAME ! UsernameE - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (LENDES.GT.LEN(DESCRIP)) THENt - CALL STORE_BULL(LENDES+6,. - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IFI - CALL COPY_BULL(3,1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1E -C -C Broadcast the bulletin if requested.w -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'),E - & CLI$PRESENT('CLUSTER')) - END IF9 - CALL BROADCAST(E - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - - CALL CLOSE_BULLFIL ! Finished adding bulletinE - - CALL ADD_ENTRY ! Add the new directory entry - - IF (FOLDER_NUMBER.GE.0) THEN - CALL UPDATE_FOLDER ! Update info in folder file -C' -C If user is adding message, update that user's last read time for4 -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF) - - CALL CLOSE_BULLDIR ! Totally finished with add - ELSE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - END DOE - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9r - CLOSE (UNIT=I) - END DO( - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THENC - FOLDER_NUMBER = OLD_FOLDER_NUMBER) - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IFT - - IF (CLI$PRESENT('TEXT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURNN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100)I - GOTO 100i - -920 WRITE(6,1020)r - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100o - -930 WRITE (ERROR_UNIT,1025)L - CALL CLOSE_BULLFILE - CALL CLOSE_BULLDIRf - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018)F - CLOSE (UNIT=3)N - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)I - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A)E -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')n -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for systemn - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanent - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -2010 FORMAT(A) -2020 FORMAT(1X,A)L - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER)e - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*23 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN( - - BTIM(1) = -BTIM(1) ! Convert to negative delta time_ - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURNn - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z)H - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'3 - - PARAMETER BRDCST_LIMIT = 82*12 + 2t - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8u - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*8 LOCALNODE - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN' - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE.) - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) $ - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAGN - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE(4) - RETURN' - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO' - - CALL CLOSE (4)N - - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"')' - - IF (IER.EQ.0) THENT - IER = 0N - I = 1i - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER)N - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128M - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDERN - END IF1 - - CLOSE (UNIT=17) - - RETURN - END - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURNE - END - - - - SUBROUTINE REPLYo - - IMPLICIT INTEGER (A - Z)s - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')')E - RETURN ! And returne - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinE - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IFS - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP) - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - DESCRIP = 'RE: '//DESCRIPT - ELSER - DESCRIP = 'RE:'//DESCRIP(4:) - END IFN - WRITE (6,'(1X,A)') DESCRIP - CALL ADD - - RETURNO - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - D - IMPLICIT INTEGER (A-Z)I - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUTW - - CALL INIT_ITMLSTA - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURNA - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIVL -CI -C FUNCTION: -C To get process privileges. -C OUTPUTS:T -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlists - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoS - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIVI - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/S - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSERb - NEEDPRIV(1) = USERPRIV(1)r - NEEDPRIV(2) = USERPRIV(2)i - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN- - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE.L - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIVE - IMPLICIT INTEGER (A-Z)N - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSERe -Cm -C FUNCTION: -C To get username of present process.l -C OUTPUTS: -C USERNAME - Username owner of present process.. -CN - - IMPLICIT INTEGER (A-Z)B - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 charactersN - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - CALL CHECK_BULLETIN_PRIV(USERNAME)E - - RETURNo - END - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z)E - - CHARACTER*255 COMMAND - - CALL DISABLE_PRIVS. - IF (CLI$PRESENT('COMMAND')) THENL - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - CALL LIB$SPAWN('$'//COMMAND(:CLEN))P - ELSE' - CALL LIB$SPAWN()C - END IFC - CALL ENABLE_PRIVS - - RETURN) - ENDC diff --git a/decus/1989b/bulletin/bulletin0.for b/decus/1989b/bulletin/bulletin0.for deleted file mode 100644 index 1d1e35e..0000000 --- a/decus/1989b/bulletin/bulletin0.for +++ /dev/null @@ -1,1429 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 09:14 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN0.FOR - -Message-Id: <8907211246.AA22798@crdgw1.ge.com> -Date: Fri, 21 Jul 89 08:36 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN0.FOR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -C -C BULLETIN0.FOR, Version 5/16/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = I + 1 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IF - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - - - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER) - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.REMOTE_USER.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,DESCRIP - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(1:11) - NEWEST_EXTIME = INPUT(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - DO BULL_DELETE = SBULL,EBULL" - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletinU - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error outT - CALL CLOSE_BULLDIRj - RETURNF - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURNE - ELSE IF (SBULL.EQ.EBULL) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') RETURNa - CALL OPEN_BULLDIRs - CALL READDIR(BULL_DELETE,IER)a - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error outR - CALL CLOSE_BULLDIRA - RETURN - END IF - END IFS - END IF - -CT -C Delete the bulletin directory entry. -Cm - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - END DO& - - CALL CLOSE_BULLDIRF - RETURNL - -1010 FORMAT(' ERROR: You are not reading any message.')t -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.')W -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE)L - - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - INTEGER NOW(2)G - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entryo - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventuallyD -C1 -C Change year of expiration date of message to 100 years less,O -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -CC -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -CF - - IF (SYSTEM.LE.1) THEN ! General or System message- - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99', - ELSE ! Permanent or ShutdownA - IF (EXDATE(2:2).EQ.'-') THENF - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSEE - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:)T - END IFv - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration dateE - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now, - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM)T - IER = SYS$ASCTIM(,INPUT,EX_BTIM,)O - - END IFR - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:) - - CALL WRITEDIR(0,IER) - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates.T - - IF (SBULL.LE.BULL_POINT) THEN: - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1)N - ELSE' - BULL_POINT = SBULL - END IFD - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF/ - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z)E - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVALE - ELSEW - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - END IF - IF (EVAL.LT.SVAL) IER = 2O - END IFE - - RETURNF - END - - e - - SUBROUTINE DIRECTORY(DIR_COUNT) -Cn -C SUBROUTINE DIRECTORYE -C -C FUNCTION: Display directory of messages.M -C - IMPLICIT INTEGER (A - Z)N - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'O - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/N - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENTR - - CHARACTER START_PARAMETER*16,DATETIME*23E - - INTEGER TODAY(2) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenE - - IF (INCMD(:3).EQ.'DIR'.AND..NOT.READ_TAG) THENT - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').AND. - & CLI$PRESENT('MARKED')) THEN - IF (FOLDER_NUMBER.GE.0) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)R - ELSE - WRITE (6,'('' ERROR: Cannot use /MARKED with'', - & '' remote folder.'')') - RETURNI - END IFA - END IF - END IF_ - -C= -C Directory listing is first buffered into temporary memory storage beforeL -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen,( -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1R - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified?T - IER = CLI$GET_VALUE('START',START_PARAMETER,ILEN)N - DECODE(ILEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THENv - DIR_COUNT = NBULL? - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')')t - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default.' - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSEC - CALL SYS_BINTIM(DATETIME,MSG_BTIM)T - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIRN - RETURN( - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1),, - & MSG_KEY) - END IF - END IF - - CALL READDIR_KEYGE(IER) - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')')_ - CALL CLOSE_BULLDIR - RETURN - ELSEN - DIR_COUNT = IER - END IFT - ELSE1 - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF_ - - IF (READ_TAG) THENI - IF (.NOT.(CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW') - & .OR.CLI$PRESENT('START'))) THEN - DIR_COUNT = 1 - END IFR - CALL READDIR(DIR_COUNT,IER1)U - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I))L - IF (ITEST.GT.0) THENn - MSG_KEY(I:I) = CHAR(ITEST-1)e - I = 9 - ELSE - I = I + 1 - END IF - END DO - END IFN - - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN( - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULLR - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1E - IF (SBULL.LT.1) SBULL = 1 - ELSEB - SBULL = DIR_COUNT5 - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1D - END IFT - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THEN - EBULL = NBULL - END IF - IF (.NOT.REMOTE_SET.AND..NOT.READ_TAG) THEN3 - DO I=SBULL,EBULL ! Copy messages from file_ - CALL READDIR(I,IER) ! Into the queueE - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)m - END DOV - ELSE IF (READ_TAG) THENL - I = SBULL - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)t - I = I + 1 - END DOn - EBULL = I - 1 - IF (IER1.NE.0) EBULL = EBULL - 1 - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,SBULL,EBULL - IF (IER.EQ.0) THENe - I = SBULL - DO WHILE (IER.EQ.0.AND.I.LE.EBULL)o - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1N - END DO, - END IFU - IF (IER.NE.0) THENT - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTET - RETURNt - END IFy - END IF - ELSE_ - NBULL = 0T - END IFt - - CALL CLOSE_BULLDIR ! We don't need file anymore - - IF (NBULL.EQ.0) THENn - WRITE (6,'('' There are no messages present.'')') - RETURN - END IFN - -C -C Directory entries are now in queue. Output queue entries to screen.f -Cs - - FLEN = TRIM(FOLDER) - WRITE(6,'(X,A)') FOLDER(:FLEN) - WRITE(6,1000) ! Write header - N = 3 - - IF (BULL_TAG.AND..NOT.READ_TAG) THENo - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG)b - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IFF - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - DO I=SBULL,EBULLE - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - IF (MSG_NUM.GT.999) N = 4 - IF (MSG_NUM.GT.9999) N = 5 - IF (READ_TAG.OR.(BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG)) THEN - WRITE (6,'('' *'',$)')) - ELSE - WRITE (6,'('' '',$)') - END IF - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM,'(DELETED)' - ELSE - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM,X - & DATE(1:7)//DATE(10:11) - END IF - IF (BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1N - END IF - END DOe - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (DIR_COUNT.GT.NBULL.OR.(READ_TAG.AND.IER1.NE.0)) THEN - ! Outputted all entries? - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSES - WRITE(6,1010) ! Else say there are more - END IFa - - RETURNd - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/)O - -2010 FORMAT('+',I,1X,A<55-N>,1X,A12,1X,A9)_ - - END - L - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z)r - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8N - MSG_KEY(I:I) = INPUT(9-I:9-I)E - END DOP - - RETURNE - END - - - - SUBROUTINE FILE -C -C SUBROUTINE FILE -CP -C FUNCTION: Copies a bulletin to a file. -CT - IMPLICIT INTEGER (A - Z)L - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'- - - EXTERNAL CLI$_ABSENTN - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)R - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1M - EBULL = F_NBULLE - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSEG - SBULL = BULL_POINT - EBULL = SBULL - IER = 0I - END IFP - - IF (SBULL.LE.0.OR.IER.NE.0) THENE - WRITE (6,1015) - RETURN - END IFA - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)2 - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specifiedR - WRITE(6,1020) ! Write error - RETURN ! And returnL - END IFS - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - IF (CLI$PRESENT('NEW')) THENF - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE' - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IFf - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER')i - - CALL OPEN_BULLDIR_SHAREDo - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - DO FBULL = SBULL,EBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletine - - IF (IER.NE.FBULL+1) THEN ! Was bulletin found? - WRITE(6,1030) FBULL - IF (FBULL.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE')o - CALL CLOSE_BULLFILL - CALL CLOSE_BULLDIRL - RETURNR - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN. - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8)A - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN) - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN)E - END DO - END DOW - -100 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_PARAMETER(1:LEN_P) - ! Show name of file created.' - CALL CLOSE_BULLFILS - CALL CLOSE_BULLDIR0 - - RETURN - -900 WRITE(6,1000)K - CALL ENABLE_PRIVS ! Reset BYPASS privileges_ - RETURNT - -1000 FORMAT(' ERROR: Error in opening file.'), -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.')1 -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I)s -1040 FORMAT(' Message(s) written to ',A) -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE LOGINK -CL -C SUBROUTINE LOGINR -CM -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'a - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGU - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPTF - CHARACTER*39 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHE - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)1 - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*23,INREAD*1 - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header' - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - DIMENSION NOLOGIN_BTIM(2),LOGIN_BTIM_SAVE(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -CN -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -CB - - CALL OPEN_BULLUSER_SHARED - - CALL MODIFY_SYSTEM_LIST(1)R - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry1 - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entryL - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) RETURN - ! DISMAIL setT - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1)N - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)I - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONGO - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DOS - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry - READ_BTIM(2) = NEW_BTIM(2)o - DO I = 1,FLONGu - SET_FLAG(I) = SET_FLAG_DEF(I)s - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)D - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DOt - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THENU - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - ELSED - LOGIN_BTIM_SAVE(1) = NEW_BTIM(1) - LOGIN_BTIM_SAVE(2) = NEW_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1)C - LOGIN_BTIM(2) = TODAY_BTIM(2)9 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IFM - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user fileT - CALL EXIT ! Go away...T - END IFB - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL setN - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHAREDI - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO. - WRITE (9,IOSTAT=IER) USERNAME,y - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINFX - END IF - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF_ - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM)C - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - BBOARD_BTIM(1) = TODAY_BTIM(1) - BBOARD_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSERF - IF (.NOT.TEST_BULLCP()) CALL CREATE_BBOARD_PROCESS - ELSEA - CALL CLOSE_BULLUSER - IF (IER.NE.0) CALL EXIT ! If no header, no messagesA - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entryD -CI -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -Ca - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compareL - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date0 - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM)C - END IF - END IFC - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)0 - ! - IF (NEW_FLAG(2).NE.0) THENA - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1e - RETURN - END IFI - -CE -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible.A -CE - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.FOLDER_SET) THENN - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IFS - - IF (REMOTE_SET) THEN ! If system remote folder, use remote - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, ! info, not local login time - & LAST_READ_BTIM(1,FOLDER_NUMBER+1))U - IF (DIFF1.LT.0) THEN - LOGIN_BTIM(1) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM)T - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time. - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IFG - END IF - END IFL - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (FOLDER_NUMBER.GT.0.AND.BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST2(SET_FLAG,FOLDER_NUMBER) - & .AND..NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messagesy - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) RETURNI - ! Don't overwhelm new user with lots of non-general msgs - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THENi - ! Can folder have SYSTEM messages and /SYSTEM specified? - LOGIN_BTIM(1) = SYSTEM_LOGIN_BTIM(1) ! Use specified login timeU - LOGIN_BTIM(2) = SYSTEM_LOGIN_BTIM(2) ! for system messages.e - END IFS - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE5 - NBULL = F_NBULLi - END IFa - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT))o - GEN_DIR = GEN_DIR1F - SYS_DIR = SYS_DIR1i - SYS_NUM = SYS_NUM1R - START = 1 - REVERSE = 0 - IF (REVERSE_SWITCH.AND.(.NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR.N - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THENA - REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IFI - - IF (REMOTE_SET) THENR - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY)N - IF (REVERSE) THENP - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,NBULL - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,NBULL,START - END IF - IF (IER.EQ.0) THEN - ALL_DIR = ALL_DIR1D - I = START - DO WHILE (IER.EQ.0.AND.I.LE.NBULL)/ - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY)A - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIRT - CALL DISCONNECT_REMOTEC - RETURNT - END IF - ALL_DIR = ALL_DIR1 - END IFe - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THENa - ICOUNT = NBULL + START - ICOUNT1n - ELSE - ICOUNT = ICOUNT1U - END IF - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY)r - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER)T - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user?B - ! No. Is bulletin system or from same user?S - IF (.NOT.REVERSE) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IFO - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN_ - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1E - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)s - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (SYSTEM_SWITCH) THEN_ - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM)e - ELSE - DIFF = -1 - END IF - IF (DIFF.LT.0) THENN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THENr - BULL_POINT = ICOUNT - 1M - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IFO - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF_ - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF (SYSTEM.EQ.3) THEN - NSYS = NSYS + 1E - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0) THEN ! And save only the first non-system msg - SYSTEM = ICOUNT ! Save bulletin number for displayF - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THENI - BULL_POINT = ICOUNT - 1F - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IFE - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IFL - END IF - END DON -100 CALL CLOSE_BULLDIR -CT -C Review new directory entries. If there are system messages,B -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -CT - IF (NGEN.EQ.0.AND.NSYS.EQ.0) RETURN - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THENB - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiess - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER) - S1 = (PAGE_WIDTH-(LENF+16))/2_ - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER(:LENF) ! Yep... - PAGE = PAGE + 1S - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT)M - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0E - DO J=1,NSYS, - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THENE - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))y - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTEM - ELSE - CALL GET_REMOTE_MESSAGE(IER)R - END IF - IF (IER.GT.0) THENa - CALL CLOSE_BULLFIL - RETURN - END IFD - END IFB - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IFE - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)n - END IFm - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DOr - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL) - RETURNM - END IFt - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)l - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATED - END DOA - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2M - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1U - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages. - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT)R - I = I + 1 - END IFT - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next pageC - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....')A - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenT - PAGE = 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) '+'//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) '+'//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:)B - ILEN = ILEN - PAGE_WIDTHI - END IF - ELSEL - PAGE = PAGE + 1D - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) ' '//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) ' '//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:)C - ILEN = ILEN - PAGE_WIDTHE - END IF - END IFB - END IF - END DO - IF (NGEN.EQ.0) THEN( - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1A - END IFB - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER)Y - S1 = (PAGE_WIDTH-13-LENF)/2E - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....')0 - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_Gs - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages' - PAGE = 1e - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesi - FIRST_WRITE = .FALSE. ! if this is first write to screen.e - END IFE - WRITE (6,'(''+'',A,$)') CTRL_Ge - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2E - I = 0U - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY)D - CALL CONVERT_ENTRY_FROMBINi - IF (SYSTEM.GT.9999) THEN ! # Digits in message numberS - N = 5 - ELSE IF (SYSTEM.GT.999) THEN - N = 4 - ELSEB - N = 3 - END IF) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screenT - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,M - & 'HIT Q(Quit listing) or any other key for next page....')F - CALL STR$UPCASE(INREAD,INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1T - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:56-N),FROM,DATE(:6),SYSTEM - END IFB - ! Bulletin number is stored in SYSTEM - ELSEL - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:56-N),FROM,DATE(:6),SYSTEM0 - END IFC - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST2(SET_FLAG,FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IFE -CE -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN. - WRITE(6,1030)) - ELSE IF (NGEN.EQ.0) THENe - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1m - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILENC - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.'. - ELSES - FLEN = TRIM(FOLDER)= - IF (FOLDER_NUMBER.EQ.0) FLEN = -1m - ILEN = 49 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILENs - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-48)//R - & ' command can be used to read these messages.' - ELSE - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-49-FLEN) - & //' '//FOLDER(:FLEN)// - & ' command can be used to read these messages.' - END IF - END IFF - - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<57-N>,1X,A12,1X,A6,<6-N>X,I) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.')y -1080 FORMAT(' ',/) - - END diff --git a/decus/1989b/bulletin/bulletin1.for b/decus/1989b/bulletin/bulletin1.for deleted file mode 100644 index 7c43e6b..0000000 --- a/decus/1989b/bulletin/bulletin1.for +++ /dev/null @@ -1,1554 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 09:15 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN1.FOR - -Message-Id: <8907211247.AA22804@crdgw1.ge.com> -Date: Fri, 21 Jul 89 08:36 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN1.FOR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -C -C BULLETIN1.FOR, Version 5/11/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (MAIL_SUBJECT(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - MAIL_SUBJECT(I:I) = '`' - ELSE - MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - IER = CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER,LEN_P) - - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) - & //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,STATUS) - CALL ENABLE_PRIVS - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IFE - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - CALL WRITE_FOLDER_FILE(IER)e - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IFu - - IF (IER.NE.0) THENo - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF. - - CALL CLOSE_BULLFOLDER - - RETURNs - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL)f -Ct -C SUBROUTINE MOVE -Ct -C FUNCTION: Moves message from one folder to another. -Co - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLFOLDER.INC'L - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*25 - - IF (CLI$PRESENT('ORIGINAL').AND..NOT.SETPRV_PRIV()) THENC - WRITE (6,P - & '('' ERROR: You have no privileges to keep original owner.'')') - END IF - - ALL = CLI$PRESENT('ALL')C - - MERGE = CLI$PRESENT('MERGE')R - - SAVE_BULL_POINT = BULL_POINTr - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)D - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THENn - IF (BULL_POINT.EQ.0) THEN ! If no message has been read! - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entryS - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURNt - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR! - RETURNo - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THENE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1)2 - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE/ - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL) - END IF - ALL = .TRUE.P - ELSE IF (CLI$PRESENT('ALL')) THEN - NUM_COPY = NBULL' - BULL_POINT = 1) - END IF - END IF - - FROM_REMOTE = REMOTE_SETC - - IF (REMOTE_SET) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',) - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,R - & ORGANIZATION='INDEXED',IOSTAT=IER,E - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')0 - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,( - & FORM='UNFORMATTED')D - END IF - IF (IER.EQ.0) THEN - CALL OPEN_BULLFIL - I = BULL_POINT - 1, - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THEN - IF (I.EQ.0) THENN - WRITE (12,IOSTAT=IER1) BULLDIR_HEADER - ELSEL - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IFB - END IFN - NBLOCK = 1_ - DO WHILE (I.LT.BULL_POINT+NUM_COPY-1.AND.IER.EQ.I+1)E - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THENH - BLOCK = NBLOCK - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRYI - IF (IER1.EQ.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER1) 5,I - IF (IER1.GT.0) THENR - CALL DISCONNECT_REMOTE$ - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - END IFS - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTHA - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT(:128))N - WRITE (11'NBLOCK,IOSTAT=IER1) INPUT(:128) - NBLOCK = NBLOCK + 1r - END DO - END IF - IF (IER1.NE.0) I = IER - END IFL - END DOP - NUM_COPY = I - BULL_POINT + 1 - END IF - CALL CLOSE_BULLFIL - IF (IER1.NE.0) THENE - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=11) - CLOSE (UNIT=12) - CALL CLOSE_BULLDIRF - RETURN. - END IF - END IF6 - - CALL CLOSE_BULLDIRi - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBERR - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBERN - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER) THENO - WRITE (6,'('' ERROR: Cannot access specified folder.'')')' - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11)I - CLOSE (UNIT=12) - RETURN - END IF' - - IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER. - CALL SELECT_FOLDER(.FALSE.,IER1) - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IFa - -Ca -C Add bulletin to bulletin file and directory entry for to directory file.h -Cc - - CALL OPEN_BULLDIR ! Prepare to add dir entrye - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCKn - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))E - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE) THENE - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE))R - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,L - & ORGANIZATION='INDEXED',IOSTAT=IER,, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1))e - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,' - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO. - END IF - ELSE - IER= 0 - END IFD - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)( - CALL CONVERT_ENTRY_FROMBIN - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges?R - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message?R - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND. - & .NOT.SETPRV_PRIV().AND..NOT.ALL) THEN ! Permanent?C - WRITE (6,'('' ERROR: No privileges to add'',O - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIREL - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.CLI$PRESENT('ORIGINAL')) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2L - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (MERGE) CALL ADD_MERGE_TO(IER)= - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1) - END DOC - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER)B - ELSE - CALL ADD_ENTRY ! Add the new directory entry. - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END DO - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - CLOSE (UNIT=11) - - CLOSE (UNIT=12) - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0) THEN - CALL UPDATE_FOLDER ! Update folder info/ -C -C If user is adding message, update that user's last read time forO -C folder, so user is not alerted of new message which is owned by user. -CD - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_BULLDIR ! Totally finished with addg - - IF (IER.EQ.0) THENI - WRITE (6,'('' Successful copy to folder '',A)')E - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//R - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THENT - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE: - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')')n - & BULL_POINT - START_BULL_POINT - END IF - L - FOLDER_NUMBER = SAVE_FOLDER_NUMBERg - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT' - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN) - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')')U - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - CALL DELETE - END IF - END IFN - - RETURNw - - END - - - - - - SUBROUTINE PRINTU -CI -C SUBROUTINE PRINT -CN -C FUNCTION: Print header to queue. -C) - - IMPLICIT INTEGER (A-Z)A - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENTD - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*31 FORM_NAME - - PARAMETER FF = CHAR(12) - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?T - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULLE - IER = 0R - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE' - SBULL = BULL_POINT - EBULL = SBULLI - IER = 0M - END IFI - - IF (SBULL.LE.0.OR.IER.NE.0) THEN' - WRITE (6,1015) - RETURN - END IFE - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')A - - CALL ENABLE_PRIVS - - CALL OPEN_BULLDIR_SHAREDE - - CALL OPEN_BULLFIL_SHAREDR - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified message - - IF (IER.NE.I+1) THEN ! Was message found? - IF (I.EQ.SBULL) THEN ! No, were any messages found? - WRITE(6,1030) ! If not, then error out - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIRM - RETURN2 - END IF) - ELSE ! Yes, message found.) - IF (I.GT.SBULL) WRITE(3,'(A)') FF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8)T - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)T - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IFr - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN)C - ELSEL - IF (HEAD) WRITE(3,1050) DESCRIPF - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN): - END IFR - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)T - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO= - END IF - END DOR - - CLOSE (UNIT=3) ! Bulletin copy completedF - - CALL CLOSE_BULLFILL - CALL CLOSE_BULLDIR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS'))o - - IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) ! Get queue name - IF (ILEN.EQ.0) THEN - QUEUE = 'SYS$PRINT'P - ILEN = 9 - END IF - - CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE))U - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IF - - IF (CLI$PRESENT('FORM')) THEN - IER = CLI$GET_VALUE('FORM',FORM_NAME,FORM_NAME_LEN)e - CALL ADD_2_ITMLST(FORM_NAME_LEN,SJC$_FORM_NAME,%LOC(FORM_NAME)) - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - i - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)N - IF (IER.AND.(.NOT.JBC_ERROR)) THENe - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IFE - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURNT - -900 CALL ERRSNS(IDUMMY,IER)C - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER)/ - RETURNR - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.')4 -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.')O -1030 FORMAT(' ERROR: Specified message was not found.')R -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ -C' -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER:O -C READ_COUNT - Variable to store the record in the message file0 -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C( - IMPLICIT INTEGER (A - Z)L - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC') - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG - - DATA SCRATCH_B1/0/N - - CHARACTER TODAY*11,DATETIME*23,BUFFER*(LINE_LENGTH) - CHARACTER SAVE_MSG_KEY*8 - - LOGICAL SINCE,PAGE, - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen0 - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is! - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - IF (CLI$PRESENT('MARKED')) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)T - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No marked messages found.'')')E - RETURN - ELSEo - READ_TAG = .TRUE. - END IFS - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified?. - IER = CLI$GET_VALUE('SINCE',DATETIME)F - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY)L - CALL GET_MSGKEY(TODAY,MSG_KEY)A - ELSET - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THENE - WRITE (6,'('' No new messages are present.'')') - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY)_ - END IF - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - RETURN - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IFI - - IF (READ_TAG) THENM - NEXT = .FALSE. - IF (INCMD(:4).EQ.'NEXT'.OR.INCMD.EQ.' ') THENL - NEXT = .TRUE.i - ELSE IF (INCMD(:4).EQ.'READ') THEN - IF (.NOT.CLI$PRESENT('BULLETIN_NUMBER')) NEXT = .TRUE. - END IF - IF (INCMD(:4).EQ.'BACK') THENG - SAVE_MSG_KEY = MSG_KEY - MSG_KEY = BULLDIR_HEADER - I = 0/ - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_KEY.NE.SAVE_MSG_KEY) - I = I + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ)R - END DO - IF (IER.EQ.0) THEN - MSG_KEY = BULLDIR_HEADER - DO J=1,I-1_ - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO= - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - ELSE IF (NEXT) THEN - IF (SINCE) THENI - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ)E - ELSE - IF (BULL_POINT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END IF - IF (IER.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IFL - - IF (.NOT.SINCE.AND. - & (.NOT.READ_TAG.OR.(.NOT.NEXT.AND.INCMD(:4).NE.'BACK'))) THENR - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entryN - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THENE - READ_COUNT = 0R - CALL READDIR(0,IER) - IF (NBULL.GT.0) THENE - BULL_READ = NBULLC - CALL READDIR(BULL_READ,IER)i - ELSEL - IER = 0 - END IFL - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0N - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IF! - - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2). - END IFI - - BULL_POINT = BULL_READ ! Update bulletin counterB - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'CURR') THENa - IF (CLI$PRESENT('EDIT')) THENS - CALL READ_EDIT9 - RETURN - END IF - END IFG - - FLEN = TRIM(FOLDER) - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - WRITE (INPUT,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULL - DO WHILE (INDEX(INPUT,' ').LT.TRIM(INPUT)) - I = INDEX(INPUT,' ')! - INPUT(I:) = INPUT(I+1:)g - END DO - I = TRIM(INPUT) - INPUT = ' #'//INPUT(2:TRIM(INPUT))I - INPUT(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//INPUT(:TRIM(INPUT))A - ELSEL - WRITE(6,'(1X,A)') INPUT(:TRIM(INPUT))S - END IFM - - END = 1 ! Outputted 1 line to screene - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)'L - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?: - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown'A - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent'T - ELSE0 - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF( - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF( - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - - END = END + 1 - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0)L - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1R - ELSEG - WRITE(6,'('' From: '',A)') FROMu - END = END + 1Q - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - END IFU - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - ELSER - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTHo - LINE_OFFSET = 2 - END IF - WRITE(6,'('' Subj: '',A)') DESCRIP - END = END + 1_ - END IFE - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1T - CALL CLOSE_BULLFIL ! End of bulletin file read - - WRITE(6,'(1X)') - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage beforeD -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memorye -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.s -Ce - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?R - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headp - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSEi - READ_COUNT = BLOCK ! Init bulletin record counter, - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE (BUFFER,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULLe - DO WHILE (INDEX(BUFFER,' ').LT.TRIM(BUFFER))- - I = INDEX(BUFFER,' ')I - BUFFER(I:) = BUFFER(I+1:) - END DO - BUFFER = ' #'//BUFFER(2:TRIM(BUFFER)) - BUFFER(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN)H - WRITE(6,'(1X,A,/)') BUFFER(:TRIM(BUFFER)) ! Output header info - END = END + 2 ! Increase display counter - END IFS - -200 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE.) - ELSE IF (ILEN.GT.0) THEN - IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THENE - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)( - ELSEN - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF, - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTHt - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN0 - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0G - ELSE_ - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)E - END IF, - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DOA - - CALL CLOSE_BULLFIL ! End of bulletin file readY - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at theD -C end of the previous page. The output gets confused and thinks it mustD -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -CN - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DOB - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC)T - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read?N - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counterL - END IFN - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IFC - - RETURN - -1030 FORMAT(' ERROR: Specified message was not found.')) -1070 FORMAT(1X,/,' Press RETURN for more...',/)l - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE READ_EDITR - - IMPLICIT INTEGER (A-Z)e - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'N - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')L - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER)i - CALL SYS_GETMSG(IER) - RETURN - END IF - - CALL OPEN_BULLFIL_SHAREDR - - ILEN = LINE_LENGTH + 1N - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)B - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IFB - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN)I - ELSEB - WRITE(3,1050) DESCRIPp - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)' - END IF( - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)L - END DOT - - CLOSE (UNIT=3) ! Bulletin copy completed( - CALL CLOSE_BULLFILB - - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,' Date: ',A)I - - RETURN( - END - - - SUBROUTINE READNEW(REDO)R -C -C SUBROUTINE READNEWR -CI -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -CX - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLUSER.INC'' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING) - - CHARACTER INREAD*1,FILE_DEF*80,NUMREAD*5 - - DATA LEN_FILE_DEF /0/, INREAD/0/( - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT/ - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first timeE - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there isI - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletinsF - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case. - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN6 - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DON - DO I=1,FLONG ! Test for new messages in SYSTEM folders_ - IF (NEW_MSG(I).NE.0) RETURN0 - END DO: - CALL EXIT - ELSEN - WRITE (6,'(''+o'',$)') - END IFI - RETURN ! If NO, exitP - ! Include QUIT to be consistent with next question: - ELSE - CALL LIB$ERASE_PAGE(1,1)= - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')')( - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IFE - - READ_COUNT = 0 ! Initialize display pointerf - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletinR - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed?p - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and systemr - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it.e - BULL_POINT = BULL_POINT + 1 - GO TO 10T - END IF - CALL CLOSE_BULLDIR - END IF - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSEC - WRITE(6,1030) - END IFu - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory) - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE.C - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to filec - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line.R - IF (LEN_FILE_DEF.EQ.0) THEN) - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF)L - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]'_ - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:'F - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,h - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS'Q - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//S - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEFT - END IFN - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH,ERR=18,STATUS='UNKNOWN', - & CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END DO - IF (ILEN.EQ.0) WRITE(6,1040) BULL_PARAMETER(:LEN_P)i - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)t - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - IF (READ_COUNT.GT.0) THEN ! Reposition GET_BULL routine - ILEN = LINE_LENGTH + 1 ! in case read in progress - DO I=1,LINE_OFFSET ! and partial block was read. - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)r - END DO - END IF - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privilegese - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THENU - ! If NEXT and last bulletins not finishedu - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exits - WRITE(6,1010) - RETURNl - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)')( - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN/ - WRITE(6,1010) - RETURN - END IFF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message' - & number, or any other key for yes: ',$)N -1010 FORMAT(' No more messages.')L -1020 FORMAT(1X,('-'),/,' Type Q(Quit), - & F(File it), D(Dir), R(Read msg #) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit), F(File), N(Next), - & D(Dir), R(Read msg #) or other for MORE: ',$) -1040 FORMAT(' Message written to ',A)E -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/)L - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C: -C FUNCTION: Sets default expiration date. -CS - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3E - - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER_OWNER) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN)O - IF (EX_LEN.GT.3) EX_LEN = 3L - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)D - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THENG - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEND - WRITE (6,'('' ERROR: Expiration must be > -1.'')')s - ELSE - FOLDER_BBEXPIRE = TEMPt - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSEU - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURNS - END diff --git a/decus/1989b/bulletin/bulletin2.for b/decus/1989b/bulletin/bulletin2.for deleted file mode 100644 index bb10325..0000000 --- a/decus/1989b/bulletin/bulletin2.for +++ /dev/null @@ -1,1531 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 09:18 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN2.FOR - -Message-Id: <8907211248.AA22833@crdgw1.ge.com> -Date: Fri, 21 Jul 89 08:36 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN2.FOR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -C -C BULLETIN2.FOR, Version 6/2/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23,RESPONSE*1 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*11,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM)P - - IF (NODE_AREA.EQ.0) THEN2 - IF (SHUTDOWN_BTIM(1).EQ.0) THEN: - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM)c - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zerot - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1A - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0l - END IFd - - IF (IER.NE.0) THENE - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGA - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION,Y - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGm - END IFi - - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - - RETURNW - END - - - M - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z)A - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listE - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlistT - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command.C -C_ -C NODE_AREA is set to 0 after shutdown messages are deleted.B -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'e - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENTM - - CHARACTER RESPONSE*1,FOLDER_SAVE*25 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder nameE - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileT - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF: - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER)t - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IFE - - IF (FOLDER_NUMBER.EQ.0) THEN) - WRITE (6,'('' Cannot set remote node for GENERAL folder.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - IF (.NOT.NODE_SET) THENb - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//K - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder nameC - REMOTE_SET = REMOTE_SET_SAVEh - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')')E - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE.T - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '//) - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF0 - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN( - FOLDER1 = FOLDER - END IFF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN)D - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THENR - WRITE (6,'(T - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')')6 - END IFp - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE.R - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*'i - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,' - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"')A - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0G - CLOSE (UNIT=17) - END IFe - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL, - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1)) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2)T - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSEU - WRITE (6,'('' You are not authorized to modify NODE.'')')M - END IFR - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileT - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDERS - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//L - & FOLDER - END IF* - - RETURN - END - - - - - SUBROUTINE RESPOND(STATUS)O -CE -C SUBROUTINE RESPOND -CD -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the commandY -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands.L -CI - IMPLICIT INTEGER (A - Z)G - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTO - DATA EDIT_DEFAULT/.FALSE./B - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FROM_TEST*5,INFROM*(LINE_LENGTH)Q - - EXTERNAL CLI$_NEGATED - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found?= - WRITE(6,'('' ERROR: Bulletin was not found.'')')E - CALL CLOSE_BULLDIR ! If not, then error outR - RETURN - END IF - - CALL CLOSE_BULLDIR - - BULL_PARAMETER = 'RE: '//DESCRIP - END IF8 - - IF (CLI$PRESENT('SUBJECT')) THEN2 - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P) - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')')S - RETURNE - END IF - ELSE IF (INCMD(:4).EQ.'POST') THENE - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(BULL_PARAMETER,LEN_P)L - IF (LEN_P.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURNM - END IF - END IFU - - LEN_P = TRIM(BULL_PARAMETER)T - - IF (BULL_PARAMETER(:1).NE.'"') THEN - BULL_PARAMETER = '"'//BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + 1U - END IF - - IF (BULL_PARAMETER(LEN_P:LEN_P).NE.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'"' - LEN_P = LEN_P + 1( - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE.O - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE_ - EDIT = .FALSE. - END IFG - - IF (EDIT.AND.CLI$PRESENT('TEXT')) THENA - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)T - RETURNO - END IF - END IF - - LENFRO = 0A - IF (CLI$GET_VALUE('CC',INPUT,ILEN)) THENB - INFROM = INPUT(:ILEN)//',' - LENFRO = ILEN + 1I - END IFN - - IF ((EDIT.AND.CLI$PRESENT('TEXT')).OR.C - & INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENo - INFROM = INFROM(:LENFRO)//INPUT(7:) - LENFRO = LENFRO + ILEN - 6L - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = INFROM(:LENFRO)//FROMf - LENFRO = TRIM(FROM) + LENFROV - END IF - - IF (CLI$PRESENT('LIST')) THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - - IF (EDIT.AND.CLI$PRESENT('TEXT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)R - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THENe - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)' - END DOL - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (CLI$PRESENT('LIST')) THEN - LIST = INDEX(FOLDER_DESCRIP,'<') - IF (LIST.GT.0) THEN - INFROM = INFROM(:LENFRO)//O - & FOLDER_DESCRIP(LIST+1:TRIM(FOLDER_DESCRIP)-1)A - LENFRO = LENFRO + TRIM(FOLDER_DESCRIP) - 1 - LIST - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')')o - GO TO 900 - END IF - END IFE -CI -C NOTE: Normally, RESPOND simply uses MAIL to respond to bulletin message. -C However, if you have a special mail package, you will have to make some -C sort of modification to the code. At PFC, we are still awaiting INTERNET,L -C so we get our mail sent from the user PFCVAX::CHAOSMAIL. Therefore, I have -C to test for that username, and then look for a FROM: line in the message in -C in order to find who really to respond to. However, most sites willI -C have intelligent network connections which can use the MAIL utility.R -CT - IF (INDEX(INFROM,'PFCVAX::CHAOSMAIL').EQ.0.AND. - & INDEX(INFROM,'MFENET::').EQ.0) THEN - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THENi - INFROM = INFROM(:I)//'"'//INFROM(I+1:)O - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - IF (CLI$PRESENT('TEXT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1I - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')E - END IF - END IF( - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//INFROM(:LENFRO)0 - & //'"/SUBJECT='//BULL_PARAMETER,,,,,,STATUS)) - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT "'//INFROM(:LENFRO)// - & '"/SUBJECT='//BULL_PARAMETER,,,,,,STATUS)E - END IF - CALL ENABLE_PRIVSL - ELSE - IF (INCMD(:4).NE.'POST') THEND - FROM_TEST = ' ' - CALL OPEN_BULLFIL_SHARED6 - L_INPUT = LINE_LENGTH + 1 - DO WHILE (L_INPUT.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,L_INPUT) - IF (L_INPUT.GT.0) THEN - CALL STR$UPCASE(FROM_TEST,INPUT(:5))L - IF (FROM_TEST.EQ.'FROM:'.AND. - & INDEX(INPUT,'PFCVAX::CHAOSMAIL').EQ.0) THEN - IF (INDEX(INPUT,'.').GT.0.OR.INDEX(INPUT,'@').GT.0 - & .OR.INDEX(INPUT,'%').GT.0) THEN - L_INPUT = 0 - END IF - END IFn - END IF - END DOI - CALL CLOSE_BULLFIL_ - IF (FROM_TEST.EQ.'FROM:') THENL - L_B = INDEX(INPUT,'<') - R_B = INDEX(INPUT,'>') - IF (L_B.GT.0.AND.R_B.GT.0) THENB - INPUT = INPUT(L_B+1:R_B-1)o - L_INPUT = R_B - 1 - L_B - ELSE - L_INPUT = TRIM(INPUT) - I = 6 - DO WHILE (INPUT(I:I).EQ.' '.AND.I.GT.0) - I = I + 1 - IF (I.GT.L_INPUT) I = 0E - END DOS - INPUT = INPUT(I:L_INPUT)$ - L_INPUT = L_INPUT - I + 1 - END IF - I = INDEX(INFROM,'PFCVAX::CHAOSMAIL')i - INFROM = INFROM(:I-1)//INPUT(:L_INPUT)//INFROM(I+17:)T - LENFRO = LENFRO - 17 + L_INPUT - END IF. - END IF - I = INDEX(INFROM,'MFENET::') - IF (I.GT.0) THEN - INFROM = INFROM(:I-1)//INFROM(I+8:) - LENFRO = LENFRO - 8 - END IF - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR PFCVAX::'//I - & 'MFENET/SUBJECT="'//INFROM(:LENFRO)//'"',,,,,,STATUS)S - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT PFCVAX::MFENET'// - & '/SUBJECT="'//INFROM(:LENFRO)//'"',,,,,,STATUS) - END IF - CALL ENABLE_PRIVS1 - END IFO - -900 IF (EDIT) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IFL - - RETURN0 - - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAMEo - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURNd - END - - - - - - SUBROUTINE REPLACEE -CM -C SUBROUTINE REPLACE -CL -C FUNCTION: Replaces existing bulletin to bulletin file.M -CL - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTe - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'e - - INCLUDE 'BULLFOLDER.INC'w - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH) - CHARACTER*1 ANSWERP - - CHARACTER DATE_SAVE*11,TIME_SAVE*11 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL*1 DOALL - -CU -C Get the bulletin number to be replaced. -CC - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the errorN - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are readingy - ELSEe - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IFf - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')')S - RETURNI - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THENB - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')')E - RETURN - END IF - END IFT - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')')F - RETURNN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN' - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURNu - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF_ -CA -C Check to see if specified bulletin is present, and if the userE -C is permitted to replace the bulletin. -CI - - CALL OPEN_BULLDIR_SHARED' - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletinT - - CALL CLOSE_BULLDIRE - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person. - RETURN ! and error out - END IFR - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,T - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND. - & USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out.C - RETURNT - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IFL - -C. -C If no switches were given, replace the full bulletinM -CE - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND.F - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND.R - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND.C - & (.NOT.CLI$PRESENT('PERMANENT'))) THEND - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THENT - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910D - INEXDATE = INPUT(:11)W - INEXTIME = INPUT(13:) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletinN - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IFG - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIPD - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - REC1 = 0I - - LENFROM = 0 - - IF (LENDES.GT.0.OR.CLI$PRESENT('TEXT').OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,' - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')S - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)a - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENe - INFROM = INPUT(:ILEN) - LENFROM = ILENi - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENw - IF (LENDES.EQ.0.AND..NOT.DOALL) THENy - INDESCRIP = INPUT(:ILEN)C - LENDES = ILEN - END IF& - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (CLI$PRESENT('TEXT').OR.DOALL) CLOSE(UNIT=3)P - END IF - - IF (CLI$PRESENT('TEXT').OR.DOALL) THENO -C: -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal., -CU - O - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1L - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified_ - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specifiedT - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW',) - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST')O - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)' - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file1 - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IFP - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS' - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR'): - END IFF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THENL - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVSL - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',S - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesI - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THENI - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line withA - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IFE - END IFS - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input lineO - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long.( - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTHV - ELSE IF (ILEN.GT.0) THEN ! If good input line enteredD - ICOUNT = ICOUNT + 1 + ILEN ! Increment character counte - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THENs - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANKP - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out' - ENDIF - - END IFF - -CT -C Add bulletin to bulletin file and directory entry for to directory file.i -Ce - - DATE_SAVE = DATE. - TIME_SAVE = TIMEI - INPUT = DESCRIP - - CALL OPEN_BULLDIR ! Prepare to add dir entryB - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for messagee - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1R - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message. - CALL CLOSE_BULLDIRN - CLOSE (UNIT=3,STATUS='SAVE')O - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')')t - IF (DOALL.OR.CLI$PRESENT('TEXT')) THENt - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IFU - GO TO 100 - END IF - END IFd - - CALL READDIR(0,IER) ! Get directory header. - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletina - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - NBLOCK = NBLOCK + ICOUNT - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER)g - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK)l - END IF - IF (LENDES.GT.0) THENn - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3)t - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.'I - CALL CLOSE_BULLFILN - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THENN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVER - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSEL - CALL READDIR(NUMBER_PARAM,IER) - END IF. - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:59) ! Update description header' - END IF - CALL UPDATE_DIR_HEADER(CLI$PRESENT('EXPIRATION').OR.DOALL, - & CLI$PRESENT('PERMANENT'),CLI$PRESENT('SHUTDOWN'),= - & INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN) - SYSTEM = IBSET(SYSTEM,0)0 - ELSE IF (CLI$PRESENT('GENERAL')) THEND - SYSTEM = IBCLR(SYSTEM,0)S - END IF - CALL WRITEDIR(NUMBER_PARAM,IER)n - ELSEr - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR.H - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THENG - MSGTYPE = IBSET(MSGTYPE,0)E - END IF - IF (CLI$PRESENT('PERMANENT')) THEN - MSGTYPE = IBSET(MSGTYPE,1)R - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2)H - ELSE IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THENR - MSGTYPE = IBSET(MSGTYPE,3)A - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIPC - IF (CLI$PRESENT('EXPIRATION')) THENE - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER)_ - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:59),MSGTYPE,EXDATE,EXTIMEN - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COMM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IFL - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3)G - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010)f - CLOSE (UNIT=3,ERR=100)) - GOTO 100L - -920 WRITE(6,1020)_ - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100L - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)A - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')I -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.')F -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A)D - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME)' - - IMPLICIT INTEGER (A-Z)H - - INCLUDE 'BULLDIR.INC' - - CHARACTER TODAY*23,INEXDATE*11,INEXTIME*11O - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME0 - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER)G - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THENL - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2)G - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER)T - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THENy - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBERG - WRITE (EXTIME(7:),'(I4)') NODE_AREAR - DO I=1,11I - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//E - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present timeU - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURNn - END - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -Ce -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z)E - - INCLUDE 'BULLDIR.INC' - - CHARACTER*132 SEARCH_STRING,SAVE_STRING - DATA SEARCH_STRING /' '/, SEARCH_LEN /1/ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAGC - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL DISABLE_CTRL - - IF (CLI$PRESENT('START')) THEN ! Starting message specified! - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_POINT - BULL_POINT = BULL_POINT - 1U - END IFI - - SAVE_STRING = SEARCH_STRING - SAVE_LEN = SEARCH_LEN - - IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - T - IF (.NOT.IER) THEN ! If no search string entered) - SEARCH_STRING = SAVE_STRING ! use saved search string - SEARCH_LEN = SAVE_LENn - ELSE IF (.NOT.CLI$PRESENT('START')) THEN ! If string entered but no - BULL_POINT = 0 ! starting message, use firstI - END IFN - - IF (IER) SUBJECT = CLI$PRESENT('SUBJECT') - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper caseI - - CALL OPEN_BULLDIR_SHAREDL - - CALL READDIR(0,IER) - - IF (BULL_POINT+1.GT.NBULL) THEN - WRITE (6,'('' ERROR: No more messages.'')')W - CALL CLOSE_BULLDIR - CALL ENABLE_CTRL - RETURN - END IFL - - CALL OPEN_BULLFIL_SHARED( - - CALL DECLARE_CTRLC_ASTT - - DO BULL_SEARCH = BULL_POINT+1, NBULLv - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1) THEN - CALL STR$UPCASE(DESCRIP,DESCRIP) ! Make upper caseT - IF (INDEX(DESCRIP,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIRr - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLA - BULL_POINT = BULL_SEARCH - 1d - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN_ - END IFI - END IF - IF (IER.EQ.BULL_SEARCH+1.AND..NOT.SUBJECT) THENB - IF (REMOTE_SET) THENM - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH. - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTES - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER)M - IF (IER.GT.0) GO TO 900U - END IF - END IF - ILEN = LINE_LENGTH + 1. - DO WHILE (ILEN.GT.0)E - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_ASTS - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - ELSE IF (FLAG.EQ.1) THENN - WRITE (6,'('' Search aborted.'')') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CALL ENABLE_CTRL - RETURN - END IF, - END DOr - END IF - END DO - -900 CALL CANCEL_CTRLC_ASTh - - CALL CLOSE_BULLFIL ! End of bulletin file read - CALL CLOSE_BULLDIR - - CALL ENABLE_CTRL - - WRITE (6,'('' No messages found with given search string.'')')N - - RETURNU - END - - - - - SUBROUTINE UNDELETE -CT -C SUBROUTINE UNDELETE -C= -C FUNCTION: Undeletes deleted message. -CL - IMPLICIT INTEGER (A - Z)( - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'u - - INCLUDE 'BULLFOLDER.INC'N - - EXTERNAL CLI$_ABSENTl - -C -C Get the bulletin number to be undeleted.l -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I)) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error.i - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are readingi - END IFr - - IF (BULL_DELETE.LE.0) GO TO 920 - -CL -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -CD - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?N - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF) - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,0 - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges orT - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out.. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?L - WRITE(6,1030) ! If not, then error outE - GOTO 100 - END IFC - END IF - END IFN - - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:)T - END IF - END IF0 - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration dateE - WRITE (6,'('' Message was undeleted.'')') - ELSEF - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)E - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COME - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I)e - ELSE - WRITE (6,'('' Message was undeleted.'')')0 - END IF - ELSE - CALL DISCONNECT_REMOTE! - END IF - END IFg - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010)T - GO TO 900 - -920 WRITE(6,1020)' - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.')E -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END diff --git a/decus/1989b/bulletin/bulletin3.for b/decus/1989b/bulletin/bulletin3.for deleted file mode 100644 index e37a83e..0000000 --- a/decus/1989b/bulletin/bulletin3.for +++ /dev/null @@ -1,1599 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 09:21 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN3.FOR - -Message-Id: <8907211250.AA22868@crdgw1.ge.com> -Date: Fri, 21 Jul 89 08:37 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN3.FOR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -C -C BULLETIN3.FOR, Version 6/1/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*11 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF (SYSTEM.LE.3.OR.(OLD_SHUTDOWN.EQ.0! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - EXTIME(3:4) = EXTIME(4:5) - READ (EXTIME(1:4),'(I4)') NODE_NUMBER_MSG - EXTIME(9:10) = EXTIME(10:11) - READ (EXTIME(7:10),'(I4)') NODE_AREA_MSG - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - END IF - ELSE - DIFF = 1 - END IF - IF (DIFF.EQ.1) NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF (SYSTEM.LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory fileR - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THENR - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START9 - CALL CLOSE_BULLDIRP - RETURND - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM)S - IF (DIFF.GT.0) THENB - START = START + 1 - CALL READDIR(START,IER)p - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IFB - - CALL CLOSE_BULLDIRS - - RETURNU - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER)C - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC'A - - INCLUDE 'BULLFOLDER.INC', - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 EXPDAT - CHARACTER*23 TODAYT - - DIMENSION EXTIME(2),NOW(2)L - - EXTERNAL CLI$_ABSENTU - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's dateT - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIREs - IF ((DEFAULT_EXPIRE.GT.F_EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.F_EXPIRE_LIMIT.GT.0.AND.f - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF5 - IF (BTEST(FOLDER_FLAG,3)) THEN ! NOPROMPT was set0 - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration dateI - SYSTEM = SYSTEM.OR.2 ! make permanentn - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expirationL - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IFR - ILEN = TRIM(EXPDAT) - ELSER - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4)n - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSEE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIREI - END IFE - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE)1 - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00'a - END IF - ILEN = TRIM(EXPDAT)I - END IFF - END IFE - END IF - ELSEE - RETURN - END IF. - - IF (ILEN.LE.0) THEN - IER = 0e - RETURN - END IFE - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND.P - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specifiedl - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-')P - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:)A - END IFt - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return valueT - GO TO 5 ! Re-request date (if prompting) - END IFY - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - IF (TIMLEN.EQ.16) THENA - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,)M - END IFM - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDATT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today'se - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limitN - IER = 0 ! Set error for return valueR - GO TO 5 ! Re-request date (if prompting)N - END IFA - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:),TODAY(13:))A - IF (IER.LE.0) THEN ! If expiration date not futureR - WRITE(6,1045) ! tell userg - IER = 0 ! Set error for return valueM - GO TO 5 ! Re-request date (if prompting)L - END IFF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT))F - END IF - END IFv - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.')I -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.')T -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ',P - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.')U - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z)S - - INCLUDE '($SSDEF)'F - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILER - - CHARACTER*80 MAIL_EDIT,OUT - - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0.AND.R - & IER.EQ.SS$_NORMAL) THENe - CALL DISABLE_PRIVS - IF (OUT.EQ.INFILE) THENd - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT))w - & //' "" '//OUT(:TRIM(OUT))) - ELSE - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT))E - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - END IF - CALL ENABLE_PRIVS - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0.OR.H - & IER.NE.SS$_NORMAL) THENM - CALL EDT$EDIT(INFILE,OUT) - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN - CONTEXT = 0U - IER = LIB$FIND_FILE(INFILE,MAIL_EDIT,CONTEXT) - IF (.NOT.IER) THEN - CALL TPU$EDIT(' ',OUT)1 - ELSE - CALL TPU$EDIT(INFILE,OUT) - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)T - ! TPU does CLI$ stuff which wipes our parsed command lineR - END IFS - - RETURN - END - - - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z)e - - INCLUDE '($PRCDEF)' - - INCLUDE '($JPIDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - DIMENSION IMAGEPRIV(2)) - - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15 - - IF (.NOT.SETPRV_PRIV()) THENA - WRITE (6,'('' ERROR: You do not have the privileges '',I - & ''to execute the command.'')')e - CALL EXIT - END IFR - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')')d - CALL EXITt - ELSE IF (.NOT.JUST_STOP.AND.s - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN1 - CALL SYS$SETPRV(,,,IMAGEPRIV)e - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'',U - & '' needs to be installed with SYSNAM.'')')D - CALL EXIT - END IF - END IFn - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXITB - END IF - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item listo - ! Now add items to listE - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM))T - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID))1 - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1R - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP') - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.o - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER)I - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')')+ - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')')s - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')I - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00'P - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11). - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0))U - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM','NL:' - & ,,,,'BULLCP',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1)( - END IFD - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THENH - WRITE (6,'('' WARNING: Account with username DECNET'',E - & '' does not exist.'')')L - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IFU - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCPL - - IMPLICIT INTEGER (A-Z)t - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*1 DUMMY - - IER = SYS_TRNLNM('BULL_BULLCP',DUMMY) - IF (IER) BULLCP = 1 - - RETURN0 - END - - - - - LOGICAL FUNCTION TEST_BULLCPa - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCPA - - TEST_BULLCP = BULLCPP - - RETURNT - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z)( - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'I - - COMMON /BCP/ BULLCP - LOGICAL BULLCPU - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSe - - CHARACTER*23 OLD_TIME,NEW_TIMED - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME)n - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP')' - IF (.NOT.IER) THEN ! Can't create mailbox, so exit., - CALL SYS_GETMSG(IER) - CALL EXIT - END IFX - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP) - - CALL SET_REMOTE_SYSTEM( - - CALL START_DECNET - - DO WHILE (1) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - CALL SYS$SETAST(%VAL(1)) - CALL BBOARD ! Look for BBOARD messages.t - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))T - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folderr - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Do empty blockT - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! cleanup at 3 a.m. - IF (NEMPTY.GT.200) THENT - CALL CLEANUP_BULLFILE ! Cleanup empty blocks) - END IF - END IF - END IF - END IFf - CALL SYS$SETAST(%VAL(1)) - END DO - - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Cleanup deleted users from - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! data files at 3 a.m. - CALL SYS$SETAST(%VAL(0))a - CALL TOTAL_CLEANUP_LOGIN' - CALL SYS$SETAST(%VAL(1)) - END IF - - OLD_TIME = NEW_TIMEo - CALL WAIT('15') ! Wait for 15 minutes -CR -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folderS -C which requires killing process. -C - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))d - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER)e - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER)) - CALL REGISTER_BULLCP - CALL SYS$SETAST(%VAL(1)) - END DOC - - RETURN/ - END - - - - - SUBROUTINE SET_REMOTE_SYSTEML - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFOLDER.INC'A - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER NODENAME*8T - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)A - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN/ - CALL SELECT_FOLDER(.FALSE.,IER1)I - IF (IER1) THEN( - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,T - & BTEST(FOLDER_FLAG,2),NODENAME - END IFF - END IF - END DOT - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - RETURNT - END - - - - - SUBROUTINE REGISTER_BULLCPF - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8I - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)S - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGP - END DO) - - IF (IER.NE.0) THENV - DO I=1,FLONG - SYSTEM_FLAG(I) = 0N - SHUTDOWN_FLAG(I) = 0I - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0i - END IFI - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)E - - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I)1 - END DOE - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,_ - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGR - ELSEN - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGw - END IFo - - CALL CLOSE_BULLUSER - - RETURNo - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLUSER.INC'J - - INTEGER SHUTDOWN_BTIM(FLONG)( - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)i - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER! - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGS - END DOI - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG: - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THENs - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IFT - - CALL CLOSE_BULLUSER - - RETURNu - END - - - - - - SUBROUTINE WAIT(PARAM) -CL -C SUBROUTINE WAITE -CE -C FUNCTION: Waits for specified time period in minutes.P -C( - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing timeL - ! in desired system format.F - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/I - - DATA WAIT_EF /0/T - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF), - - TIMBUF(6:7) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(2)) ! Set timer./ - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set.D - - RETURN$ - END - - - - SUBROUTINE WAIT_SEC(PARAM)E -C) -C SUBROUTINE WAIT_SEC1 -C( -C FUNCTION: Waits for specified time period in seconds.Y -CE - IMPLICIT INTEGER (A-Z)E - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/D - DATA WAIT_EF /0/) - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF)H - - TIMBUF(9:10) = PARAMS - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer.I - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set.L - - RETURN, - END - - - - - SUBROUTINE DELETE_EXPIRED - -C -C SUBROUTINE DELETE_EXPIRED -CF -C FUNCTION: -CO -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and) -C was replaced with a 128 byte record compressed format). -CL - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLUSER.INC'P - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)F - - CHARACTER UPTIME_DATE*11,UPTIME_TIME*11 - - CALL OPEN_BULLDIR_SHARED ! Open directory fileT - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFILP - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present?I - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls?C - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')r - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.E - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked?t - SHUTDOWN = 0S - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENe - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IFL - IER1 = 1E - END IF - IF (IER.LE.0.OR.IER1.LE.0) THENp - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to updater - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IFI - CALL CLOSE_BULLDIRU - - RETURN - END - - - - - SUBROUTINE BBOARD -C1 -C SUBROUTINE BBOARD -C% -C FUNCTION: Converts mail to BBOARD into non-system bulletins.O -C - - IMPLICIT INTEGER (A-Z)) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSI - DATA FOLDER_Q1/0/ - - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - - DIMENSION NEW_MAIL(FOLDER_MAX)! - - DATA SPAWN_EF/0/) - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1e - - CALL OPEN_BULLFOLDER_SHARED ! Get folder fileI - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)L - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymoree - CALL SYS$SETAST(%VAL(1))l - - CALL SYS$SETAST(%VAL(0))f - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1))D - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1E - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900O - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_QE - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD.EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1R -CA -C The process is set to the BBOARD uic and username in order to createD -C a spawned process that is able to read the BBOARD mail (a real kludge). -CE - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present accountN - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD accountT - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uicU - END IF' - - LEN_B = TRIM(BBOARD_DIRECTORY)F - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errorsE - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THENC - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)M - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THENE - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)')O - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE'E - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)R - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSEI - CONTEXT = 0_ - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARDM - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//D - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1))& - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))F - CALL SYS$SETAST(%VAL(0))O - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN) - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//A - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)4 - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0))I - END IF - END IFE - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM)N - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line* - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM)T - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store usernamer - ELSE IF (INPUT(:5).EQ.'Subj:') THENt - INDESCRIP = INPUT(7:) ! Store subjectS - ELSE IF (INPUT(:3).EQ.'To:') THENU - INTO = INPUT(5:) ! Store addressp - END IF - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail! - END DOo - - INTO = INTO(:TRIM(INTO))s - CALL STR$TRIM(INTO,INTO)A - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD)T - IF (INDEX(INTO,FOLDER_BBOARD(:FLEN)).EQ.0.AND._ - & INTO.NE.FOLDER_BBOARD.AND.INDEX(INTO,'@').EQ.0) THEN - POINT_FOLDER1 = 0T - FOLDER_Q2 = FOLDER_Q1 - FOLDER1_BBOARD = FOLDER_BBOARD - FOUND = .FALSE.a - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - FOLDER_Q2_SAVE = FOLDER_Q2N - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM)u - FLEN = TRIM(FOLDER1_BBOARD) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND.l - & FOLDER1_BBOARD.NE.'NONE') THEN - IF (INTO.EQ.FOLDER1_BBOARD) THEN - FOUND = .TRUE. - ELSEc - FIND_TO = INDEX(INTO,FOLDER1_BBOARD(:FLEN))t - IF (FIND_TO.GT.0) THEN - END_TO = FLEN+FIND_TO - IF (TRIM(INTO).LT.END_TO.OR.r - & INTO(END_TO:END_TO).LT.'A'.OR.e - & INTO(END_TO:END_TO).GT.'Z') THENL - IF (FIND_TO.EQ.1) THEN - FOUND = .TRUE. - ELSE IF (INTO(FIND_TO-1:FIND_TO-1).LT.'A'.OR. - & INTO(FIND_TO-1:FIND_TO-1).GT.'Z') THEN - FOUND = .TRUE. - END IFC - END IFA - END IF - END IF - END IFR - END DO - IF (FOUND) THENC - FOLDER_COM = FOLDER1_COMl - FOLDER_Q_SAVE = FOLDER_Q2_SAVE - END IF - END IF - - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTx - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the dateD - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER)D - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IFA - ELSE - ISTART = 1N - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ')n - END DO - NBLANK = 0R - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTI - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)C - & .AND.IER.EQ.0)t - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT) - END DOU - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSEE - NBLANK = NBLANK + 1 - END IFF - END IF - END DOF - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1))R - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1))! - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRLE - FOLDER_SET = .FALSE.L - - IF (NBBOARD_FOLDERS.EQ.0) THENd - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM)( - REWRITE (4) USER_HEADER ! Rewrite headerS - CALL CLOSE_BULLUSER - END IFT - - CALL SYS$SETAST(%VAL(1))_ - - RETURNM - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_BULLFILm - CALL CLOSE_BULLDIRT - WRITE (6,1030)L - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.')E -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESST - - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY)R - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE')e - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')C - IF (IER.NE.0) RETURNS - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT'T - WRITE(11,'(A)') '$B/'//'''F$PROCESS()'''? - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11)L - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',D - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM). -CR -C SUBROUTINE GETUIC(UIC) -CI -C FUNCTION: -C To get UIC of process submitting the job.O -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UICS -CS - - IMPLICIT INTEGER (A-Z)C - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listF - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlisti - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURNR - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)9 -CC -C SUBROUTINE GET_UPTIME -CR -C FUNCTION: Gets time of last reboot. -CL - - IMPLICIT INTEGER (A-Z)S - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - CALL INIT_ITMLSTU - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST)1 - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,)( - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURNE - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLFOLDER.INC'F - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*37,FILENAME*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointerC - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)I - OFFSET = 36 - - IF (IER.NE.0) THEN) - OPEN (UNIT=10,FILE='VMSMAIL', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT',E - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)I - OFFSET = 34A - END IF - - DO I=1,NUM_FOLDERS' - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)% - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR.$ - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::') THEN - ! If normal BBOARD or /VMSMAIL - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUTo - CALL LIB$MOVC3(2,%REF(INPUT(OFFSET:)),COUNT)e - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN) - NEW_MAIL(I) = .TRUE. - ELSE= - NEW_MAIL(I) = .FALSE. - END IFB - ELSE - NEW_MAIL(I) = .TRUE./ - END IF - END DOR - - CLOSE (10)3 - - RETURND - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN)Y -CE -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN)L -C) -C FUNCTION: -C To get image name of process., -C OUTPUT: -C IMAGNAME - Image name of processN -C ILEN - Length of imagenameI -CO - - IMPLICIT INTEGER (A-Z)n - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list: - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN))N - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURNF - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START)( - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2)_ - - IF (REMOTE_SET) THENF - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSEO - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IFL - - RETURNR - END diff --git a/decus/1989b/bulletin/bulletin4.for b/decus/1989b/bulletin/bulletin4.for deleted file mode 100644 index 56214e1..0000000 --- a/decus/1989b/bulletin/bulletin4.for +++ /dev/null @@ -1,1715 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:20 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN4.FOR - -Message-Id: <8907211344.AA23697@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 08:54:36 EDT -Date: Fri, 21 Jul 89 08:37 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN4.FOR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -C -C BULLETIN4.FOR, Version 7/7/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist -C if it creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - READ (4,IOSTAT=IER) USER_ENTRY ! Skip header - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':') THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file.I - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THENs - IF (INPUT(:6).EQ.'From: ') THENc - INPUT(:4) = 'FROM'F - END IF - END IFd - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF. - END DO - IF (NBLANK.GT.0) THENo - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT)C - END DO - LENGTH = LENGTH + NBLANK*2/ - NBLANK = 0t - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128o - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IFr - - CALL FLUSH_BULL(OCOUNT) - - RETURNt - END - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT)e - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - DATA POINT/0/ - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUTa - POINT = ILEN + 1A - ELSE IF (POINT.EQ.BRECLEN-1) THEN, - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUTJ - POINT = ILENe - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)T - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT), - END IF - OCOUNT = OCOUNT + 1T - DO WHILE (POINT.GE.BRECLEN)! - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSEd - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN)! - POINT = POINT + ILEN + 1 - END IF_ - - RETURN0 - - ENTRY FLUSH_BULL(OCOUNT)i - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = 0 - - RETURND - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z)I - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUTd - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE( - WRITE (1'OCOUNT) OUTPUTI - END IFr - - RETURNt - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN)p - - IMPLICIT INTEGER (A-Z)i - - INCLUDE 'BULLDIR.INC' - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read?C - IBLOCK = SBLOCK ! Initialize pointers. - CALL GET_BULL(IBLOCK,BUFFER,ILEN)a - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - ELSE ! Else set ILEN to zero) - ILEN = 0 ! to request next line - END IF= - - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN)O - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records.y - END DOt - - RETURN. - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC)o - - IREC = (SBLOCK+BLENGTH-1) - IBLOCKY - - RETURN_ - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,ILEN) -C -C SUBROUTINE GET_BULL -Ct -C FUNCTION: Outputs line from folder file. -CL -C INPUT:E -C IBLOCK - Input block number in input file to read from.E -C+ -C OUTPUT: -C BUFFER - Character string containing output line. -C ILEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -CD -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one orE -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be_ -C outputted, it returns ILEN=0 requesting the calling program to -C increment the record counter.0 -C - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(LINE_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/S - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read?I - POINT = 1 ! Initialize pointers.M - LEFT_LEN = 0 - END IFI - - IF (POINT.EQ.1) THEN ! Need to read new line? - IF (REMOTE_SET) THEN ! Remote folder?A - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read linesm - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queues - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from fileC - READ (1'IBLOCK,IOSTAT=IER) TEMPR - END DOD - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of lines - ILEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine.R - RETURN - END IF= - - IF (IER.GT.0) THEN ! Error in reading file. - ILEN = -1 ! ILEN = -1 signifies error - POINT = 1R - LEFT_LEN = 0 - RETURN - END IFE - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - ILEN = ICHAR(LEFT(:1)) ! previous record read.D - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record.t - BUFFER = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) ! Output line.) - POINT = LEFT_LEN + 1 ! Update pointers.e - LEFT_LEN = 0r - ELSE ! Rest of line is longer than - LEFT(ILEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - ILEN = 0 ! Request new record read.O - END IF - ELSE ! Else nothing left over.A - ILEN = ICHAR(TEMP(POINT:POINT)) ! Get line lengthi - IF (ILEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = ILEN - (BRECLEN-POINT) ! Store leftover length - ILEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (ILEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message.p - ELSE ! Else message line fully readt - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output itF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF: - - RETURNe - - ENTRY TEST_MORE_LINES(ILEN) ! Test for more lines in record.D - ! Returns length of next line.E - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - ILEN = 0 ! record, no more lines. - ELSE ! Else there is another line.D - ILEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length.T - END IF) - - RETURND - - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER)E -CE -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -CL - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty?E - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to headU - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IFO - - ILEN = 128 - IER = 0 - LENGTH = 0 - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)s - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this erroro - IER = 0 - ILEN = 0 - ELSET - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DOE - - RETURNN - END - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -CA -C SUBROUTINE DELETE_ENTRY -CE -C FUNCTION: -C To delete a directory entry. -CO -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -CN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - IF (NBULL.GT.0) THEN( - CALL READDIR(0,IER)E - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IFH - - IF (BTEST(FOLDER_FLAG,1)) THENI - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER,STATUS='OLD',R - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')c - ELSE - WRITE (3,'(A)') CHAR(12)F - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8)L - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IFN - -900 CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2)I - - NEMPTY = NEMPTY + LENGTHE - CALL WRITEDIR(0,IER)T - -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11)F - - RETURNO - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire.N -C( - IMPLICIT INTEGER (A-Z) - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12)E - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP',! - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present dateT - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1E - END DO( - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSES - LENGTH(2) = 27 - END IFU - - NUM_DAYS = NDAYS ! Put number of days into buffer variableR - - DO WHILE (NUM_DAYS.GT.0)C - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of monthU - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in monthO - DAY = 1 ! Reset day to first of monthZ - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year?a - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27B - END IF - END IF( - ELSE ! If expiration date is within the montho - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exitE - END IF - END DOS - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new datet - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT)k -Cm -C SUBROUTINE GET_LINE -Cr -C FUNCTION: -C Gets line of input from terminal.c -Ca -C OUTPUTS:l -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES:r -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -Ce - - IMPLICIT INTEGER (A-Z)e - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTHa - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITr - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGS - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPTD - - USE_PROMPT = .FALSE.R - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT)T - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -Cl -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and) -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1! -Cm - - CALL DECLARE_CTRLC_ASTL - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limitR - POINTER = 0 ! during input. - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line.= -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTe - IF (IER.NE.0) LEN_INPUT = -2 R - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE! - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompti - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER)F - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT)E - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input?o - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of liner - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO( - CALL CONVERT_TABS(INPUT,LEN_INPUT)L - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say soi - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IFf - RETURNg - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z)r - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT)I - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THENI - INPUT(MOVE:) = INPUT(TAB_POINT+1:)E - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMITd - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO) - - CALL FILTER (INPUT, LEN_INPUT) - - RETURND - END - - - SUBROUTINE FILTER (INCHAR, LENGTH)E - - IMPLICIT INTEGER (A-Z)M - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10)) - & .OR.INCHAR(I:I).GT.'~') INCHAR(I:I) = '.' - END DOA - - RETURN_ - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logicaly - CHARACTER*(*) OUTPUT ! byte to character valuen - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT)s - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routineT - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAGI - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXITT - END IF - FLAG = 1 ! to set flag - RETURN1 - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_ASTb -CI -C FUNCTION: -C Declares a CTRLC ast.L -C NOTES:. -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/.U -C - IMPLICIT INTEGER (A-Z)1 - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINEB - COMMON /TERM_CHAN/ TERM_CHAN) - - COMMON /CTRLC_FLAG/ FLAGT - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO' - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURNT - - ENTRY CANCEL_CTRLC_ASTR - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOL - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURNP - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -CL -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHANN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGW - - COMMON /READIT/ READITD - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2)L - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/3 - - DATA PURGE/.TRUE./T - - DO I=1,LEN(DATA) - DATA(I:I) = ' '. - END DO. - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),I - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.I - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),U - & TRM$M_TM_NOECHO) - END IF - - RETURNE - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT)O - - DO I=1,LEN(DATA)) - DATA(I:I) = ' 'm - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),T - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.0 - ELSE( - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),F - & TRM$M_TM_NOECHO) - END IFT - - RETURNA - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA)N - DATA(I:I) = ' 'r - END DOe - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),T - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSEO - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,,' - & TERMSET,NLEN,TERM) - END IFD - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THENL - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM)t - END IFC - - RETURN' - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal6 - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20)a - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID)I - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)i - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPADF - ELSE IF (READIT.EQ.0) THENH - CALL SET_NOKEYPADr - END IFe - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9')) - MASK(2) = IBCLR(MASK(2),I-32) - END DOo - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH)H -C1 -C SUBROUTINE GETPAGSIZt -C -C FUNCTION: -C Gets page size of the terminal.e -Ca -C OUTPUTS:1 -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C. - IMPLICIT INTEGER (A-Z)u - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1)))L - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH))D - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,)C - - PAGE_LENGTH = ZEXT(DEVDEPEND(4))y - - PAGE_WIDTH = MIN(PAGE_WIDTH,132)T - - RETURNA - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL( -CT -C FUNCTION SLOW_TERMINALt -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less).N -CE -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not.a -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)'P - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,)E - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSET - SLOW_TERMINAL = .FALSE.E - END IFL - - RETURNC - END - - - - - SUBROUTINE SHOW_PRIV( -CC -C SUBROUTINE SHOW_PRIV) -C -C FUNCTION: -C To show privileges necessary for managing bulletin board.C -C_ - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLUSER.INC'O - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)'P - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT fileO - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not presentO - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT fileC - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRVb - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')')o - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR.d - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THENC - WRITE (6,'(1X,A)') PRIVS(I) - END IFU - END DO - ELSEE - WRITE (6,'('' ERROR: Cannot show privileges.'')')M - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSERI - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER)h - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURNt - - END - - - - - SUBROUTINE SET_PRIV -CN -C SUBROUTINE SET_PRIV -CL -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z)c - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'A - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVSf - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA',P - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/L - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2)T - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THENN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN)) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs+ - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IFA - IF (.NOT.IER) CALL SYS_GETMSG(IER)E - END DO - RETURN - END IFR - - OFFPRIV(1) = 0I - OFFPRIV(2) = 0M - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1( - I = 0) - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1)D - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = In - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURNR - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE- - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)t - END IFT - ELSE - IF (PRIV_FOUND.LT.32) THENS - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE: - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32)e - END IFg - END IF - END DOo - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1))O - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE= - WRITE (6,'('' ERROR: Cannot modify privileges.'')')a - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER( - - RETURN, - - END - - - - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -Ce -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.. -C IER - Return error from attempting to set ACL. -C, -C NOTE: The ID must be in the RIGHTS data base. -CS - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLFOLDER.INC'A - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*)S - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)'F - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THENL - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THENL - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')')D - CALL SYS_GETMSG(IER)A - RETURN - END IFR - IDENT = USER + ISHFT(GROUP,16)O - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,)& - END IFH - END IF - END IFR - IF (.NOT.IER) RETURNN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(E - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)M - RETURN - END IF) - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//( - & '.BULLDIR',%VAL(ACL_ITMLST),,,)S - IF (.NOT.IER) RETURNS - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//E - & '.BULLFIL',%VAL(ACL_ITMLST),,,)s - IF (.NOT.IER) RETURNe - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C0 -C SUBROUTINE DEL_ACL_ -C_ -C FUNCTION: Adds ACL to bulletin files. -C_ -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.R -C IER - Return error from attempting to set ACL. -C( -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLFOLDER.INC'G - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*)T - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item listC - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT))D - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist_ - ELSET - CALL INIT_ITMLST ! Initialize item listN - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT))L - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistG - END IF( - - IF (INDEX(ACCESS,'C').GT.0) THENA - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(O - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IFn - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//R - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,)G - IF (.NOT.IER) RETURNU - - RETURN) - END - - - - - SUBROUTINE CREATE_FOLDER$ -CN -C SUBROUTINE CREATE_FOLDERR -CF -C FUNCTION: Creates a new bulletin folder.4 -C - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFOLDER.INC'A - - INCLUDE 'BULLUSER.INC'R - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THENC - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IFE - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')I - RETURN - END IFh - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privileged- - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR.C - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'() - & '' ERROR: No privs for SYSTEM, NOTIFY, BRIEF or READNEW.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node nameo - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B)S - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDERD - END IF - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)h - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURNU - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'',E - & '' is not SYSTEM folder.'')') - RETURNR - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0)i - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES)C - ELSE - WRITE (6,'('' Enter one line description of folder.'')')A - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')')' - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters' - WRITE(6,'('' ERROR: folder must be < 80 characters.'')')A - LENDES = 0 - END IF - END DOL - - CALL OPEN_BULLFOLDER ! Open folder fileN - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0)F - ! See if folder existsU - - IF (IER.EQ.0) THENP - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IFo - - IF (CLI$PRESENT('OWNER')) THEN) - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURNP - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER)N - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDERG - RETURN - ELSE - FOLDER_OWNER = FOLDER1_OWNERF - END IFO - END IF - ELSEI - FOLDER_OWNER = USERNAME ! Get present usernameU - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IFi - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT). - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -CF -C Folder file is placed in the directory FOLDER_DIRECTORY.N -C The file prefix is the name of the folder.R -CF - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')')R - GO TO 910 - ELSEP - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDERO - END IFT - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))p - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')I - - IF (IER.NE.0) THENP - WRITE(6,'('' ERROR: Cannot create folder directory file.'')')- - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910t - END IF. - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,S - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THENV - WRITE(6,'('' ERROR: Cannot create folder message file.'')')O - CALL ERRSNS(IDUMMY,IER)4 - CALL SYS_GETMSG(IER) - GO TO 910g - END IFs - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)a - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))e - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1)e - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))b - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1)L - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER)S - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1)E - LAST_NUMBER = LAST_NUMBER + 1I - END DOE - - IF (IER.EQ.0) THENS - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')')c - & FOLDER_MAX' - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSET - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IFD - - IF (.NOT.CLI$PRESENT('NODE')) THENR - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0E - NBULL = 0O - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name?L - REMOTE_SET = .FALSE., - CALL OPEN_BULLDIR ! If so, store name in directory fileS - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIRE - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*'I - FOLDER1 = FOLDERU - END IF - REMOTE_SET = .TRUE.O - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0)S - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULLr - END IFi - - FOLDER_OWNER = FOLDER1_OWNER - - IF (CLI$PRESENT('SYSTEM')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - END IFe - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1)b - CLOSE (UNIT=2)I - - NOTIFY = 0D - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THENN - BRIEF = 1, - READNEW = 1 - END IFC - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000N - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE._ - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE')E - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURNA - - END - diff --git a/decus/1989b/bulletin/bulletin5.for b/decus/1989b/bulletin/bulletin5.for deleted file mode 100644 index a902360..0000000 --- a/decus/1989b/bulletin/bulletin5.for +++ /dev/null @@ -1,1608 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:26 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN5.FOR - -Message-Id: <8907211344.AA23705@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 08:56:52 EDT -Date: Fri, 21 Jul 89 08:38 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN5.FOR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -C -C BULLETIN5.FOR, Version 5/16/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_NEGATED - - IF (.NOT.SETPRV_PRIV().AND.INCMD(:3).EQ.'SET') THEN - WRITE (6,'( - & '' ERROR: No privs to change all defaults.'')') - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - - FLAG = 0 - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',TEMP_USER) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',TEMP_USER) - END IF - READ (TEMP_USER(:1),'(I1)',IOSTAT=IER) FLAG - - IF (NOTIFY.EQ.1.AND.BTEST(FLAG,1).AND. - & CLI$PRESENT('CLUSTER').EQ.%LOC(CLI$_NEGATED)) THEN - CALL OPEN_BULLNOTIFY - READ (10,KEY='*',IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=10) - FLAG = -1 - END IF - - IF (BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - IF (FLAG.EQ.-1) WRITE (10,IOSTAT=IER) TEMP_USER - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - IF (FLAG.EQ.-1) THEN - CALL CLOSE_BULLNOTIFY - ELSE IF (NOTIFY.EQ.1.AND.BTEST(FLAG,1).AND. - & CLI$PRESENT('CLUSTER').NE.%LOC(CLI$_NEGATED)) THEN - WRITE (6,'('' NOTE: In a cluster, /ALL or /DEFAULT '', - & ''causes all users to be notified.'')') - WRITE (6,'('' They will not be able to disable this.'', - & '' See HELP SET NOTIFY for more info.'')') - CALL OPEN_BULLNOTIFY - CALL CLOSE_BULLNOTIFY_DELETE - CALL OPEN_BULLNOTIFY - WRITE (10) '* ' - CALL CLOSE_BULLNOTIFY - ELSE IF (NOTIFY.EQ.0.AND.BTEST(FLAG,1)) THEN - CALL OPEN_BULLNOTIFY - READ (10,IOSTAT=IER) TEMP_USER - IF ((IER.EQ.0.AND.TEMP_USER.EQ.'*').OR. - & (BRIEF.NE.-1.AND.READNEW.NE.-1)) THEN - CALL CLOSE_BULLNOTIFY_DELETE - ELSE - CALL CLOSE_BULLNOTIFY - END IF - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL OPEN_BULLNOTIFY - CALL CLOSE_BULLNOTIFY_DELETE - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - FOLDER_SET = .FALSE. - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - EXTERNAL CLI$_ABSENT - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP: - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has: - DATA FIRST_TIME /FLONG*0/ ! been selected before this.< - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR.I - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1)r - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THENU - FOLDER1 = FOLDER1(:FLEN)//'GENERAL'_ - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - CALL OPEN_BULLFOLDER_SHARED ! Go find folder' - - REMOTE_TEST = 0 - - IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::'). - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1)_ - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1))A - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMPD - & (FOLDER1(:TRIM(FOLDER1)),IER)I - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE( - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IFR - - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0U - CALL REWRITE_FOLDER_FILE_TEMP - END IFO - - CALL CLOSE_BULLFOLDER - - IF (IER.EQ.0.AND.FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allowA - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER). - IF (IER.NE.0) THEN - IF (OUTPUT) THENE - WRITE (6,'('' ERROR: Unable to connect to folder.'')') - END IFN - RETURNE - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Copy remote folder protection - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - ELSE - LOCAL_FOLDER1_FLAG = IBCLR(LOCAL_FOLDER1_FLAG,0)L - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag infoC - CALL OPEN_BULLFOLDER ! Update local folder informationn - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - FOLDER_COM = FOLDER1_COMR - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - END IF - REMOTE_SET = .TRUE.o - END IF - - IF (IER.EQ.0) THEN ! Folder foundL - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1L - IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::' - & .AND..NOT.SETPRV_PRIV()) THEND - ! Is folder protected and not remote?. - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME_ - & .NE.FOLDER1_OWNER) THEN - IF (SETPRV_PRIV()) THENE - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')')C - WRITE(6,'('' See '',A,'' if you wish to access folder.'')')R - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR.e - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER)r - CALL CLR2(SET_FLAG,FOLDER1_NUMBER)E - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0D - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND. - & IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENs - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0), - CALL REWRITE_FOLDER_FILE_TEMPL - CALL CLOSE_BULLFOLDER - END IFR - ELSE ! Folder not protectedN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (FOLDER1_BBOARD(:2).NE.'::') THEN - IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE.R - END IF - - IF (IER) THENl - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSEN - FOLDER_SET = .FALSE.T - END IF= - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - BULL_POINT = 0 ! Reset pointer to first bulletinK - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR')I - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE.( - ELSE, - READ_ONLY = .FALSE. - END IF - ELSEI - READ_ONLY = .FALSE. - END IFh - - IF (FOLDER_NUMBER.GT.0) THEN) - IF (TEST_BULLCP()) THEN) - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THENL - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.O - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2))U - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0P - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IFB - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THENS - CALL UPDATE ! Need to update_ - END IF - ELSEC - NBULL = 0D - END IFR - CALL CLOSE_BULLDIRT - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IFF - END IFF - - IF (OUTPUT) THENi - IF (FOLDER_NUMBER.GE.0.AND.CLI$PRESENT('MARKED')) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)t - IF (INCMD(:3).NE.'DIR') THENB - IF (IER.EQ.0) THENi - WRITE(6,'('' NOTE: Only marked messages'', - & '' will be shown.'')')u - ELSEr - WRITE(6,'('' ERROR: No marked messages found.'')') - END IFe - END IFn - ELSE - READ_TAG = .FALSE.e - END IF - END IFR - - IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG) THENI - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)' - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find itM - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0R - DO WHILE (NEW_COUNT.GT.0)U - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1P - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletinsD - ELSE - BULL_POINT = 0 - END IF - END IFe - END IF - END IF/ - IER = 1 - ELSE IF (OUTPUT) THENC - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER)) - END IF - ELSE ! Folder not foundC - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF. - - RETURNO - - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -Cl -C SUBROUTINE CONNECT_REMOTE_FOLDER' -CE -C FUNCTION: Connects to folder that is located on other DECNET node.E -C - IMPLICIT INTEGER (A-Z)L - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHG - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)( - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATEO - - INCLUDE 'BULLUSER.INC'F - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*25 FOLDER_SAVE - - DIMENSION DUMMY(2)B - - REMOTE_UNIT = 31 - REMOTE_UNIT' - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different0 - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 11 - END IF1 - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEND - IF (.NOT.SAME) THENM - FOLDER1_FILE = FOLDER_FILEC - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1B - REMOTE_SET_SAVE = REMOTE_SETD - REMOTE_SET = .FALSE.M - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILEL - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - END IF - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1N - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARDO - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY,T - & DUMMY(1),DUMMY(2),FOLDER1_COMO - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - END IFT - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER)f - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSERA - END IF - END IF - IER = 2 - ELSEL - FOLDER1_BBOARD = FOLDER_BBOARD_SAVEn - FOLDER1_NUMBER = FOLDER_NUMBER_SAVER - FOLDER1_OWNER = FOLDER_OWNER_SAVEE - CLOSE (UNIT=31-REMOTE_UNIT) -CR -C If remote folder has returned a last read time for the folder,O -C and if in /LOGIN mode, or last selected folder was a differentL -C folder, or folder specified with "::", then update last read time. -CO - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.LOGIN_SWITCH) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - END IF - IER = 0) - END IFN - - RETURN& - END - - - - - - - - - - SUBROUTINE UPDATE_FOLDERP -C( -C SUBROUTINE UPDATE_FOLDERC -CS -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURNI - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file_ - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)s - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2)' - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message?I - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF_ - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - RETURNR - END - - - - SUBROUTINE SHOW_FOLDERU -CR -C SUBROUTINE SHOW_FOLDERI -C( -C FUNCTION: Shows the information on any folder.F -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'F - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE '($SSDEF)'E - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT_ - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT))U - & FOLDER1 = FOLDER - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - RETURN - END IF( - - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileE - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//O - & FOLDER1e - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDERN - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THENN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSEE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IFe - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THENT - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remoteT - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Folder is a private folder.'')') - ELSE - WRITE (6,'('' Folder is not a private folder.'')') - END IFB - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1O - WRITE_ACCESS = 1I - ELSE( - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',e - & USERNAME,READ_ACCESS,WRITE_ACCESS)) - END IFn - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THENO - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THENH - WRITE (6,'('' Folder is located on node '',S - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIRL - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '',E - & A,''. Remote folder name is '',A,''.'')') T - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF_ - ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN)( - END IFR - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')R - IF (BTEST(GROUPB1,31)) THEN. - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')')E - END IF - END IF - ELSEE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IFe - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')')1 - END IFO - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')')L - END IFR - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IFt - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF_ - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THENM - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is BRIEF.'')')L - ELSE - WRITE (6,'('' Default is READNEW.'')')S - END IF - ELSEC - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is SHOWNEW.'')')C - ELSE - WRITE (6,'('' Default is NOREADNEW.'')')E - END IF - END IF1 - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY.'')') - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF1 - CALL CLOSE_BULLUSER - END IF - END IFE - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12,2 - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT)T -CD -C SUBROUTINE DIRECTORY_FOLDERS -CL -C FUNCTION: Display all FOLDER entries. -C= - IMPLICIT INTEGER (A - Z)D - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLUSER.INC'T - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING, - - DATA SCRATCH_D1/0/_ - - CHARACTER*17 DATETIME - - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE specified - ELSE - NLINE = 1 - END IFD - -CO -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.A -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder fileR - - NUM_FOLDER = 0A - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from fileE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN_ - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))B - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1)d - ELSEi - READ_ACCESS = 1 - END IFf - IF (READ_ACCESS) THEN - NUM_FOLDER = NUM_FOLDER + 1n - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM)M - END IFI - END IF - END DOU - - CALL CLOSE_BULLFOLDER ! We don't need file anymoreR - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IFR - -CB -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screenZ - - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'',F - & 2X,''Owner'',/,1X,80(''-''))') - - IF (.NOT.PAGING) THEN - DISPLAY = (NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2L - ELSE) - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2,PAGE_LENGTH-4) - ! If more entries than page size, truncate output - END IFT - - DO I=FOLDER_COUNT,FOLDER_COUNT+(DISPLAY-2)/NLINE-1I - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THENR - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,)R - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counter - END DOA - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0. - ELSEF - WRITE(6,1010) ! Else say there are moreO - END IFd - - RETURNr - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1010 FORMAT(1X,/,' Press RETURN for more...',/)l - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -CR -C SUBROUTINE SET_ACCESS -CR -C FUNCTION: Set access on folder for specified ID.R -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -CA - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLUSER.INC'0 - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'P - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENTE - - CHARACTER ID*64,RESPONSE*1L - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THENI - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IFE - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE.Q - ELSEC - READONLY = .FALSE. - END IFR - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder nameT - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN! - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')r - RETURN - END IFd - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it existsI - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN_ - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,C - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE( - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1O - CALL CHKACLF - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,E - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEND - WRITE (6,'('' Folder access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)E - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THENR - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE( - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IFF - ELSE - CALL DEL_ACL('*','R',IER) - END IFR - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER)' - END IFt - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THENN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)1 - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER)T - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)')I - & INPUT(2:ILEN) - RETURN - END IFE - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THENO - CLOSE (UNIT=3) - INPUT = ' ' - ELSE( - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1i - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1)U - INPUT = INPUT(COMMA+1:) - ELSE - ID = INPUT - INPUT = ' 'F - END IF - ILEN = TRIM(ID) - IF (ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSEG - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER)f - ELSEE - CALL ADD_ACL(ID,'R+W',IER) - END IF_ - ELSEM - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IFD - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN)o - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')'), - & ID(:ILEN) - END IF - END IF, - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUTD - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IFO - END DOI - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THENG - CALL OPEN_BULLFOLDER ! Open folder fileA - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL)r -Cb -C SUBROUTINE CHKACL -Cm -C FUNCTION: Checks ACL of given file. -Ch -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file.r -Cl - - IMPLICIT INTEGER (A-Z)u - - CHARACTER*(*) FILENAMEo - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)'u - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THENR - IERACL = SS$_NORMAL.OR.IERACL - END IF! - - RETURNe - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -CR -C SUBROUTINE CHECK_ACCESS -CQ -C FUNCTION: Checks ACL of given file. -CA -C PARAMETERS: -C FILENAME - Name of file to check.R -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -CA - - IMPLICIT INTEGER (A-Z)U - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME,Z - & %VAL(ACL_ITMLST))' - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THENn - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THENI - READ_ACCESS = 0a - END IFt - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then ofR - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IFF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THENE - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IFF - - RETURNL - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACLO -C -C FUNCTION: Shows users who are allowed to read private bulletin. -CE -C PARAMETERS: -C FILENAME - Name of file to check.0 -C! - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAMEr - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))R - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)n - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH)s - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z)I - - CHARACTER*(*) KEY_NAMEE - - INCLUDE 'BULLFOLDER.INC'E - - ENTRY WRITE_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER))L - WRITE (7,IOSTAT=IER) FOLDER_COMP - END DOL - - RETURN - - ENTRY REWRITE_FOLDER_FILE - - REWRITE (7) FOLDER_COM - - RETURNE - - ENTRY REWRITE_FOLDER_FILE_TEMPY - - REWRITE (7) FOLDER1_COM - - RETURNS - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER))L - READ (7,IOSTAT=IER) FOLDER_COM - END DOI - - RETURNT - - ENTRY READ_FOLDER_FILE_TEMP(IER)( - - DO WHILE (REC_LOCK(IER)), - READ (7,IOSTAT=IER) FOLDER1_COMc - END DO. - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBERY - - DO WHILE (REC_LOCK(IER))i - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM_ - END DOR - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER' - - RETURNN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)U - - DO WHILE (REC_LOCK(IER))) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END DO - - RETURNh - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END DO( - - RETURNE - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER)Y - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END DO( - - RETURNR - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z)A - - CHARACTER*(*) KEY_NAMEE - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAMEm - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAMEE - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAMEE - USERNAME = SAVE_USERNAMES - - RETURNF - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAMEE - - DO WHILE (REC_LOCK(IER))C - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DOA - - USERNAME = SAVE_USERNAMEI - TEMP_USER = KEY_NAMET - - RETURNf - - ENTRY READ_USER_FILE_HEADER(IER)( - - DO WHILE (REC_LOCK(IER))m - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - END DO - - RETURNF - - ENTRY WRITE_USER_FILE_NEW(IER)E - - SET_FLAG(1) = SET_FLAG_DEF(1) - SET_FLAG(2) = SET_FLAG_DEF(2) - BRIEF_FLAG(1) = BRIEF_FLAG_DEF(1) - BRIEF_FLAG(2) = BRIEF_FLAG_DEF(2) - NOTIFY_FLAG(1) = NOTIFY_FLAG_DEF(1) - NOTIFY_FLAG(2) = NOTIFY_FLAG_DEF(2) - - ENTRY WRITE_USER_FILE(IER)O - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRYY - END DOI - - RETURN - - END - - - - - - SUBROUTINE SET_GENERIC(GENERIC) -CC -C SUBROUTINE SET_GENERIC& -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displayingN -C general bulletins continually for a certain amount of days., -C) - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'(' - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN. - IF (GENERIC) THENS - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7'" - END IFX - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')')U - END IF - - CALL CLOSE_BULLUSER - - RETURNT - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C) -C SUBROUTINE SET_LOGINE -C, -C FUNCTION: Enables or disables bulletin display at login.o -Cr - IMPLICIT INTEGER (A-Z)G - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23N - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'(_ - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)N - IF (IER.EQ.0) THEN_ - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSEI - WRITE (6,'('' ERROR: Specified username not found.'')')D - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z)O - - CHARACTER USERNAME*(*),ACCOUNT*(*)C - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2)) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST)B - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2)- - - RETURNl - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4)Z - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1' - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURNC - END diff --git a/decus/1989b/bulletin/bulletin6.for b/decus/1989b/bulletin/bulletin6.for deleted file mode 100644 index ca3b181..0000000 --- a/decus/1989b/bulletin/bulletin6.for +++ /dev/null @@ -1,1529 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:31 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN6.FOR - -Message-Id: <8907211345.AA23735@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 08:57:43 EDT -Date: Fri, 21 Jul 89 08:38 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN6.FOR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -C -C BULLETIN6.FOR, Version 6/13/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - DATA LUN /0/ - - ENTRY CLOSE_BULLNOTIFY - LUN = LUN + 1 ! Unit = 10 - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - DATA LUN /0/ - - ENTRY CLOSE_BULLNOTIFY_DELETE - LUN = LUN + 8 ! Unit = 10 - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - DATA LUN /0/ - - LUN = UNIT - 10 ! 10 gets added to LUN - - ENTRY OPEN_BULLNOTIFY - LUN = LUN + 1 ! Unit = 10 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.10) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=10,STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=3, - & ORGANIZATION='INDEXED',KEY=(1:12:CHARACTER), - & FORM='UNFORMATTED', - & FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.NOTIFY') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','notify'/ - INTEGER NAME(10) - DATA NAME/1,2,0,3,0,0,4,0,5,6/2 - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IFJ - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z)I - - INCLUDE '($FORIOSDEF)'V - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC'F - - INCLUDE 'BULLUSER.INC'r - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1.t -Cf - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/E - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - CHARACTER*25 SAVE_FOLDERL - DATA SAVE_BLOCK/-1/ - - DATA LUN /0/S - - ENTRY OPEN_BULLNOTIFY_SHARED - LUN = LUN + 1 ! Unit = 10 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9N - - ENTRY OPEN_SYSUAF_SHAREDE - LUN = LUN + 1 ! Unit = 8N - - ENTRY OPEN_BULLFOLDER_SHAREDE - LUN = LUN + 3 ! Unit = 7U - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4= - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1B - - IER = 0 - - NTRIES = 0N - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN1 - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))R - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0O - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL')I - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE)L - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN_ - CLOSE (UNIT=2)! - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loopY - CALL CONVERT_BULLFILESU - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRSO - NTRIES = 0 - END IFI - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IFE - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR.D - & SAVE_FOLDER.NE.FOLDER)) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_POINT - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCKE - SAVE_FOLDER = FOLDERR - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))8 - & //'.BULLFIL',STATUS='OLD',F - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED) - IF (IER.EQ.FOR$IOS_INCRECLEN) THENU - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILET - NTRIES = 0 - END IFS - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IFu - - IF (LUN.EQ.4) THENA - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THENI - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILEE - NTRIES = 0 - END IFR - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IFN - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',E - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - - IF (IER.EQ.0) THEN( - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE)I - IF (ASK_SIZE.NE.FOLDER_RECORD/4) THENC - CLOSE (UNIT=7)7 - IDUMMY = FILE_LOCK(IER,IER1)E - CALL CONVERT_BULLFOLDER(ASK_SIZE) - NTRIES = 0 - END IF - END IFE - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IFO - - IF (LUN.EQ.8) THENZ - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC)O - END DO - END IF - - IF (LUN.EQ.9) THEN= - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXITI - END DO - END IFN - - IF (LUN.EQ.10) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=10,STATUS='OLD',IOSTAT=IER,l - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=3, - & ORGANIZATION='INDEXED',KEY=(1:12:CHARACTER), - & FORM='UNFORMATTED',N - & FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.NOTIFY') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - CALL OPEN_FILE(LUN)B - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'(l - & '' Cannot open file in OPEN_FILE_SHARE, unit = '',I)') LUNi - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IERO - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXITE - END IF, - - LUN = 0 - - RETURNS - END - - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'X - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*115E - - WRITE (6,'('' Converting data files to new format. Please wait.'')')d - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)T - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found.A - - READ (2'1,IOSTAT=IER1) BUFFER - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))I - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,T - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')M - END IFD - - IF (IER1.NE.0) GO TO 8002 - - CALL SYS_BINTIM(BUFFER(1:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM)e - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2S - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFERC - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1I - DESCRIP = BUFFER(1:)I - FROM = BUFFER(54:)I - BULLDIR_ENTRY(78:81) = BUFFER(85:)L - BULLDIR_ENTRY(90:97) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM)E - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRYL - ICOUNT = ICOUNT + 1 - END IF - END DOR - -800 CLOSE (UNIT=9,DISPOSE='KEEP')/ - CLOSE (UNIT=2)S - -900 CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN_ - - END - - - - SUBROUTINE CONVERT_BULLFILES -CE -C SUBROUTINE CONVERT_BULLFILESL -C+ -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin2 -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs)._ -CL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'L - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')')1 - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))' - & //'.BULLDIR',STATUS='OLD',C - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',G - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',1 - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD',' - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)R - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)S - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))L - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))o - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,I - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')N - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8)V - NEMPTY = 0C - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00'I - ICOUNT = 2I - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCKI - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(1:80)//CHAR(1)= - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFERA - END DOI - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DOu - - CLOSE (UNIT=9) - CLOSE (UNIT=2)L - CLOSE (UNIT=10) - CLOSE (UNIT=1)D - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionE - RETURNT - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)E -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -CO -C SUBROUTINE CONVERT_BULLFILE -CO -C FUNCTION: Converts bulletin data file to new format file. -CI -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -CR - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')'), - - CALL CLOSE_BULLDIR= - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - CALL OPEN_BULLFOLDERS - -100 READ (7,FMT=FOLDER_FMT,ERR=200)2 - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL'E - & ,STATUS='OLD',T - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)F - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,I - & FORM='UNFORMATTED')E - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE)C - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN2 - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER)A - NBLOCK = NBLOCK + 1: - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1H - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK)T - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IFS - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIRR - GOTO 100D - -200 CALL OPEN_BULLDIR_SHARED - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionO - - RETURNT - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(ASK_SIZE) -C) -C SUBROUTINE CONVERT_BULLFOLDER -CS -C FUNCTION: Converts bulletin folder file to new format.N -CO - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'F - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'S - - INCLUDE '($FORIOSDEF)', - - CHARACTER*80 NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - - EODIR = MAX(INDEX(BULLFOLDER_FILE,':'),INDEX(BULLFOLDER_FILE,']')) - SUFFIX = INDEX(BULLFOLDER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLFOLDER_FILE(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1))L - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD',E - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO' - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='NEW',a - & ACCESS='KEYED',RECORDTYPE='FIXED',E - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE')T - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.173/4) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0)S - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - IF (IER.EQ.0) THEN - WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBI - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSEL - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)I - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPY - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER))Y - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0)E - END IF( - DO WHILE (FILE_LOCK(IER,IER1))E - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',7 - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0R - F_NEWEST_BTIM(2) = 0I - ELSET - CALL READDIR(0,IER)0 - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIMEI - CALL WRITEDIR(0,IER)_ - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBL - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM, - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7)F - CLOSE (UNIT=9,STATUS='SAVE')' - - IER = LIB$RENAME_FILE(NEW_FILE,BULLFOLDER_FILE) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionE - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURNF - END - - SUBROUTINE CONVERT_USERFILE -CT -C SUBROUTINE CONVERT_USERFILE -CP -C FUNCTION: Converts user file to new format which has 8 bytes added. -CE - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'O - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIMEL - - WRITE (6,'('' Converting data files to new format. Please wait.'')')S - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))E - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'& - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',I - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,I - & KEY=(1:12:CHARACTER))' - INQUIRE (UNIT=9,RECORDSIZE=RECL)' - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')')C - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')0 - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE)D - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)L - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFU - - IF (IER.EQ.0) THENA - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',O - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IFR - - IF (IER.NE.0) THENE - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)) - CALL SYS_GETMSG(IER1)V - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXITe - END IFo - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'Xt - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0f - SET_FLAG(I) = 0 - END DOe - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR.. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50A - IER = 0R - DO WHILE (IER.EQ.0)( - READ (9,'(A)',IOSTAT=IER) BUFFERw - IF (IER.EQ.0) THENU - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23)t - LOGIN_TIME = BUFFER(24:31)L - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))F - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1))D - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM)C - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM,N - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag= - DO WHILE (IER.EQ.0)= - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,) - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFO - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9)0 - CLOSE (UNIT=4)I - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectiono - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -CA -C SUBROUTINE READDIRT -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -CL -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.' -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS:a -C ICOUNT - The last record read by this routine. -CE - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'O - - COMMON /PROMPT/ COMMAND_PROMPTU - CHARACTER*39 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*3 CFOLDER_NUMBERU - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER))A - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADERA - END DOT - IF (IER.EQ.0) THENR - CALL CONVERT_HEADER_FROMBIN - DIR_NUM = 0 - END IFE - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,0 - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER, - END IFN - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSEG - CALL CONVERT_HEADER_FROMBIN - RETURNL - END IFT - END IF - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR& - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDERN - END IFI - IF (NEMPTY.EQ.' ') NEMPTY = 0E -CE -C Check to see if cleanup of empty file space is necessary, which isO -C defined here as being 50 blocks (200 128byte records). Also check= -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THENA - WRITE (CFOLDER_NUMBER,'(I3)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX(N - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP')M - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IFI - END IF - ELSEN - IF (.NOT.REMOTE_SET) THENI - DO WHILE (REC_LOCK(IER))_ - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (MSG_NUM.NE.ICOUNT) IER = 36B - ELSER - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) BULLDIR_ENTRY - END IF - END DOR - IF (IER.EQ.0) THENH - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE) - DIR_NUM = -1 - END IFI - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNTI - IF (IER.EQ.0) THENN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IFU - IF (IER.GT.0) THEN7 - CALL ERROR_AND_EXIT - ELSER - CALL CONVERT_ENTRY_FROMBIN - RETURNR - END IFE - END IF - END IF - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - UNLOCK 2= - - RETURN - - END - - - - - - SUBROUTINE READDIR_KEYGE(IER) -CE -C SUBROUTINE READDIR_KEYGE -CF -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified.. -C0 -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS:I -C IER - If not 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z)( - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) BULLDIR_ENTRYP - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBINF - DIR_NUM = MSG_NUM - ELSE - IER = 0 - DIR_NUM = -1 - END IF - UNLOCK 2 - ELSE, - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSEC - IER = MSG_NUM - CALL CONVERT_ENTRY_FROMBIN - END IF - END IFO - - RETURNI - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z)o - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME - NEWEST_EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,)T - - NEWEST_DATE = DATETIME - NEWEST_TIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIMEI - SHUTDOWN_TIME = DATETIME(13:) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME - EXTIME = DATETIME(13:)C - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,)T - - DATE = DATETIME - TIME = DATETIME(13:) - - RETURNE - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the, -C directory file.t -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.l -C If 0, write the header of the directory file. -C OUTPUTS:I -C IER - Error status from WRITE. -CE - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - INCLUDE 'BULLDIR.INC' - - CONV = .TRUE. - - GO TO 10F - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE.E - O -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADERR - ELSE - IER = -1= - IF (DIR_NUM.EQ.0) THENA - REWRITE (2,IOSTAT=IER) BULLDIR_HEADERT - END IFt - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THENS - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEND - WRITE (2,IOSTAT=IER) BULLDIR_HEADERF - END IFI - END IF - ELSE - IF (CONV) CALL CONVERT_ENTRY_TOBIN - MSG_NUM = BULLETIN_NUM - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRYE - ELSE - IER = -1E - IF (DIR_NUM.EQ.MSG_NUM) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF) - IF (IER.NE.0) THENR - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRYE - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF8 - END IF: - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT( - - DIR_NUM = -1F - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM)I - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM), - - RETURNN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN( - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - - RETURN_ - END - - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -CG -C SUBROUTINE READACLB -C, -C FUNCTION: Reads the ACL of a file.G -C -C PARAMETERS: -C FILENAME - Name of file to check.F -C ACLENT - String which will be large enough to hold ACL information.0 -C - IMPLICIT INTEGER (A-Z)+ - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*)( - CHARACTER NOT_ID*3G - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - DO ACC_TYPE=1,2 - POINT = 1O - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)t - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR.r - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1, - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - DO WHILEo - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0) - START_ID = START_ID - 1C - END DOO - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEND - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IFN - END IFM - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THENA - WRITE (6,'(I - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THENL - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1). - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)E - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IFO - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)r - END DO. - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILET - - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))L - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')')N - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFK - - RECL = RECL/8 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW',M - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)T - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DOD - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9)C - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z)G - E - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)T - CALL ENABLE_CTRL_EXIT - - RETURNi - END - diff --git a/decus/1989b/bulletin/bulletin7.for b/decus/1989b/bulletin/bulletin7.for deleted file mode 100644 index 868ba5b..0000000 --- a/decus/1989b/bulletin/bulletin7.for +++ /dev/null @@ -1,1769 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:36 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN7.FOR - -Message-Id: <8907211346.AA23743@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 08:59:06 EDT -Date: Fri, 21 Jul 89 08:38 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN7.FOR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -C -C BULLETIN7.FOR, Version 7/20/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - INCLUDE '($SSDEF)' - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - CHARACTER OUTPUT*160,TERMINAL*7,FLAGS*1 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (FOLDER_NUMBER.GT.0) THEN ! Folder private? - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER(1:TRIM(FOLDER)) - & //'. From: '//FROM(1:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - FLAG = 0 - BFLAG = 0 - - IF (IER) THEN - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) THEN ! Node part of cluster? - CALL OPEN_BULLNOTIFY_SHARED ! Yes, get notify list. - DO WHILE (REC_LOCK(IER1)) ! Any entries? - READ (10,IOSTAT=IER1) TEMP_USER - END DO - IF (IER1.NE.0) THEN ! No entries. - CALL READ_USER_FILE(IER) ! Create entries from - DO WHILE (IER.EQ.0) ! user file. - IF (TEMP_USER(:1).NE.':'.AND.TEMP_USER(:1).NE.'*' - & .AND.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (10) TEMP_USER - END IF - CALL READ_USER_FILE(IER) - END DO - DO WHILE (REC_LOCK(IER1)) ! Reset to first entry. - READ (10,KEYGT=' ',IOSTAT=IER1) - & TEMP_USER - END DO - END IF - - BFLAG = BRK$M_CLUSTER ! Broadcast to all nodes - - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER_NUMBER).AND. ! If /ALL then - & TEMP_USER.EQ.'*'.AND.IER1.EQ.0) THEN ! notify all. - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & ,%VAL(BRK$C_ALLUSERS),,,%VAL(BFLAG),,,,) - IER1 = 1 ! Don't have to loop through notify list - END IF - END IF - END IF - - DO WHILE ((BFLAG.EQ.0.AND.GETUSERS(TEMP_USER,TERMINAL)).OR. - & (BFLAG.NE.0.AND.IER1.EQ.0)) - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - IF (BFLAG.EQ.0) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TERMINAL(:TRIM(TERMINAL)),%VAL(BRK$C_DEVICE) - & ,,,%VAL(BFLAG),,,,) - ELSE - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TEMP_USER(:TRIM(TEMP_USER)),%VAL(BRK$C_USERNAME) - & ,,,%VAL(BFLAG),,,,) - END IF - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USER//USER_ENTRY(13:) - END IF - ELSE IF (IER.NE.0.AND.BFLAG.NE.0) THEN - DELETE (UNIT=10) - END IF - IF (BFLAG.NE.0) THEN - DO WHILE (REC_LOCK(IER1)) - READ (10,IOSTAT=IER1) TEMP_USER - END DO - END IF - END DO - IF (BFLAG.NE.0) CALL CLOSE_BULLNOTIFY - END IF - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(1:11) - NEWEST_TIME = TODAY_TIME(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00.00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time: -CL - IMPLICIT INTEGER (A - Z)o - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1F - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1t - END IFi - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -CC -C FUNCTION MINUTE_DIFF: -CL -C FUNCTION: Finds difference in minutes between 2 binary times. -C. -CN - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1)f - CALL LIB$DAY(DAYS2,DATE2,MSECS2)a - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000M - - RETURNo - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2)P -CE -C FUNCTION COMPARE_DATE -Ca -C FUCTION: Compares dates to see which is farther in future.d -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates.S -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -CB - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME)r - - CALL VERIFY_DATE(USER_TIME) -C( -C LIB$DAY crashes if date invalid, which happened once due to an unknownE -C hardware or software error which created a date very far in the future. -Ci - CALL LIB$DAY(DAY1,USER_TIME)e - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME)t - ELSE - CALL SYS$GETTIM(USER_TIME) - END IFl - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2a - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM)t - - IMPLICIT INTEGER (A-Z)e - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalidN - BTIM(1) = TEMP(1)I - BTIM(2) = TEMP(2)T - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalidT - BTIM(1) = TEMP(1)I - BTIM(2) = TEMP(2) - END IF - - RETURNB - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2)F -CO -C FUNCTION COMPARE_TIME -Cd -C FUCTION: Compares times to see which is farther in future.O -CR -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second timeH -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*11 TEMP2 - - IF (TIME2.EQ.' ') THENR - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:) - ELSE - TEMP2 = TIME2U - END IF_ - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1)))M - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1N - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IFE - - RETURNI - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for A -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to closeo -C the file as soon as possible. -CA -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains, -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the. -C next record. Every time a record is written, if that record has aR -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -CL -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized: - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATAF - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4)E - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT( - RETURN= - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA. - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA)e - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4)1 - RETURN_ - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHARS - OUTCHAR = INCHAR(:LENGTH) - RETURNN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN)r - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN' - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0M - RETURNR - END - - - - SUBROUTINE DISABLE_PRIVSR -CD -C SUBROUTINE DISABLE_PRIVSD -CN -C FUNCTION: Disable image high privileges._ -C) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/, - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURNE - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privilegesM - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1)S - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURNF - END - - - - SUBROUTINE ENABLE_PRIVS -CO -C SUBROUTINE ENABLE_PRIVS -CO -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z)_ - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privsL - - RETURNP - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IOI -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z)M - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200)E - ERROR = 1F - ELSEP - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0N - END IFE - - CALL ENABLE_PRIVS ! Enable SYSPRV X - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')X - - RETURNM - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG)N -CC -C SUBROUTINE CHANGE_FLAGL -CT -C FUNCTION: Sets flags for specified folder.O -C= -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. I -C If FALSE, clear flag.L -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC's - - INCLUDE 'BULLFOLDER.INC'e - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))i - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1)i - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER- - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN2 - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IFe - -Cn -C Find user entry in BULLUSER.DAT to update information. -CZ - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1)F - READ_BTIM_SAVE(2) = READ_BTIM(2)E - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entryP - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's todaye - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entryo - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THENO - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)n - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER), - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0P - CALL WRITE_USER_FILE_NEW(IER)R - ELSET - IF (CMD) THENU - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)E - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)s - END IF - NEW_FLAG(1) = 143c - REWRITE (4,IOSTAT=IER) USER_ENTRYf - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF_ - - CALL CLOSE_FILE (4) - - IF (FLAG.EQ.4) THEN ! If notify, see if cluster - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',TEMP_USER)T - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',TEMP_USER) - END IF - READ (TEMP_USER(:1),'(I1)',IOSTAT=IER) BFLAG - IF (BTEST(BFLAG,1).AND.IER.EQ.0) THENI - CALL OPEN_BULLNOTIFY_SHARED - DO WHILE (REC_LOCK(IER))) - READ (10,IOSTAT=IER) TEMP_USER - END DO - IF (TEMP_USER.NE.'*') THENP - IF (CMD) THEN2 - WRITE (10,IOSTAT=IER) USERNAME - ELSE - DO WHILE (REC_LOCK(IER)) - READ (10,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (UNIT=10) - END IFI - END IF - CALL CLOSE_BULLNOTIFY - END IF - END IFM - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE.u - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSIONI -C -C SUBROUTINE SET_VERSION: -C -C FUNCTION: Sets version number.T -C, - IMPLICIT INTEGER (A - Z)t - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4)C - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))E - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - -C( -C Find user entry in BULLUSER.DAT to update information.E -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2)( - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry: - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143( - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entryC - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IFE - - CALL CLOSE_FILE (4) - RETURNQ - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -C2 -C SUBROUTINE CONFIRM_PRIV -C -C FUNCTION: Confirms that given username has SETPRV.P -C_ -C INPUTS: -C USERNAME - Username -C OUTPUTS:E -C ALLOW - Returns 1 if account has SETPRV. -C returns 0 if account has no SETPRV. -C- - - IMPLICIT INTEGER (A-Z)- - - CHARACTER*(*) USERNAME- - - INCLUDE '($PRVDEF)' - - INCLUDE '($UAIDEF)' - - INTEGER DEF_PRIV(2) - - CALL INIT_ITMLSTt - CALL ADD_2_ITMLST(8,UAI$_DEF_PRIV,%LOC(DEF_PRIV)) - CALL END_ITMLST(GETUAI_ITMLST)e - - ALLOW = 0 ! Set return falsee - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(DEF_PRIV(1),PRV$V_SETPRV).OR. ! SETPRV or CMRKNL - & BTEST(DEF_PRIV(1),PRV$V_CMKRNL)) THEN ! privileges? - ALLOW = 1 ! Yep - END IF - END IFs - - RETURN ! Return - END ! End - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -Ch -C SUBROUTINE CHECK_NEWUSERm -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was.. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS:i -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C- - - IMPLICIT INTEGER (A-Z)- - - CHARACTER*(*) USERNAMES - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLSTE - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST)L - - DISMAIL = 0 ! Set return falseA - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET?T - DISMAIL = 1 ! YepA - END IF - END IFO - - RETURN ! ReturnN - END ! EndT - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z)0 - - CHARACTER*(*) INPUT,OUTPUTT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RETO - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))I - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlistG - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM) OUTPUT = OUTPUT(:OLEN) - - RETURNN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT)S - - IMPLICIT INTEGER (A-Z)) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RETR - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))R - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlistN - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:TRIM(INPUT)),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM) OUTPUT = OUTPUT(:OLEN) - - RETURNM - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./G - - IF (INIT) THENL - FILE_LOCK = 1) - INIT = .FALSE. - ELSEM - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)C - IF (IER1.EQ.RMS$_FLK) THEND - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSEB - FILE_LOCK = 0N - INIT = .TRUE.N - END IFm - ELSE - FILE_LOCK = 0 - IER1 = 0Z - INIT = .TRUE. - END IF - END IFM - - RETURNR - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY( - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - QUIT = 1I - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0S - IF (QUIT.EQ.1) LEVEL = LEVEL - 1v - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THENN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - CALL UPDATE_USERINFO - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXITE - END IF - QUIT = 0 ! Reinitialize - - RETURNR - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLYN - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/, - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -CH -C SUBROUTINE CLEANUP_BULLFILE -CT -C FUNCTION: Searches for empty space in bulletin file and deletes it. -CI - IMPLICIT INTEGER (A - Z)L - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'y - - CHARACTER FILENAME*132,BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -Cy -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER, - END DOL - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THENN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - OPEN (UNIT=11,. - 1 FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',i - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - IF (IER.NE.0) THEN_ - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,)P - RETURN - END IFo - END IF - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTHI - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER1 - END DOU - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100F - END IF - WRITE(11) BUFFERA - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',C - & '*.BULLFIL') - IER = 14 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETEF - IER = 1A - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IFR - - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',) - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',_ - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN_ - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)): - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',U - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,D - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CLOSE (UNIT=11)f - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,)_ - RETURN - END IF - END IFM - - NEMPTY = 0_ - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULLR - CALL READDIR(I,IER)N - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)( - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - NBLOCK = NBLOCK + LENGTH - END DOR - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR_ - CALL OPEN_BULLDIR ! Open with no sharingu - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER)D - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DOU - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER)S - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DOP - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*',M - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURNE - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILEA -CD -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or ise -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting processt -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z)n - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE) - - CHARACTER*11 DATE_SAVE,EXDATE_SAVE - CHARACTER*11 TIME_SAVE,EXTIME_SAVEM - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRYL - DATE_SAVE = DATED - TIME_SAVE = TIMEW - EXDATE_SAVE = EXDATE) - EXTIME_SAVE = EXTIMEA - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL)! - CALL READDIR(I,IER)T - IF (IER.NE.I+1) THEN ! Have we found a deleted entry?I - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in fileI - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)W - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DOT - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries$ - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN) - END IFT - LENGTH = -LENGTH ! Indicate starting point by writingM - CALL WRITEDIR(I,IER) ! next entry into deleted entryT - FIRST_DELETE = I ! with negative lengthR - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletione - FIRST_DELETE = I ! was previously in progressN - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1R - DO K=J,NBULLG - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY)I - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_QI - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUMI - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DOT - ! If no duplicate entry found for this - ! entry, see if one exists for any. - END DO ! of the other entries - END IF - I = I + 1 - END DO6 - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessaryR - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER)Q - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IFa - END DOR - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative lengthl - CALL WRITEDIR(FIRST_DELETE,IER)E - END IFZ - - CALL WRITEDIR(0,IER). - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVEU - DATE = DATE_SAVEy - TIME = TIME_SAVEN - EXDATE = EXDATE_SAVEC - EXTIME = EXTIME_SAVE - - RETURNN - END - - - SUBROUTINE SHOW_FLAGS -Ca -C SUBROUTINE SHOW_FLAGS -CB -C FUNCTION: Show user flags.D -CH - IMPLICIT INTEGER (A - Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC'Q - -CH -C Find user entry in BULLUSER.DAT to obtain flags.E -CN - - CALL OPEN_BULLUSER_SHARED ! Open user file - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entryD - - WRITE (6,'('' For the selected folder '',A)') FOLDER(1:TRIM(FOLDER)). - F - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THENR - WRITE (6,'('' NOTIFY is set.'')')T - END IFD - - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND.A - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (.NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IFE - - CALL CLOSE_BULLUSER - - RETURNi - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURNE - END - - - SUBROUTINE CLR2(FLAG,NUMBER)) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1))0 - - RETURNE - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z)N - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))L - - RETURNw - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL)D -CF -C FUNCTION GETUSERS -C& -C FUNCTION: -C To get names of all users that are logged in.D -CT - - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($JPIDEF)' - - CHARACTER USERNAME*(*),TERMINAL*(*) - - DATA WILDCARD /-1/T - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listD - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistR - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.D - END DOI - - IF (.NOT.IER) WILDCARD = -1 - - GETUSERS = IER= - - RETURNO - END - - - - - - SUBROUTINE OPEN_USERINFOY -C: -C SUBROUTINE OPEN_USERINFOE -C' -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -CI - IMPLICIT INTEGER (A - Z)N - - INCLUDE 'BULLUSER.INC'1 - - COMMON /USERINFO/ USERINFO_READ - DATA USERINFO_READ /.FALSE./M - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,H - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX), - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET'S - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IFt - - IF (IER.NE.0) THENN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2)1 - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT filen - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_BULLUSER - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER)* - END IFL - IF (IER.EQ.0) THENR - DO I=1,FOLDER_MAXE - LAST_READ_BTIM(1,I) = READ_BTIM(1)) - LAST_READ_BTIM(2,I) = READ_BTIM(2)L - END DO - END IFF - END IF - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX)I - END IFE - - CALL CLOSE_BULLINFO - - USERINFO_READ = .TRUE. - - RETURN: - END - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -Ce -C FUNCTION: Updates the latest message read times for each folder. -Cs - IMPLICIT INTEGER (A - Z)e - - COMMON /USERINFO/ USERINFO_READ - - INCLUDE 'BULLUSER.INC'm - - IF (.NOT.USERINFO_READ) RETURNE - - CALL OPEN_BULLINF_SHAREDL - - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,V - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX)X - - CALL CLOSE_BULLINFE - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM)M - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME! - - IF (TRIM(TIME).EQ.20) THENi - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM)y - ELSEs - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IFy - - RETURNo - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -Ct -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -CN -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have beent -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit.) -CV - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'_ - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT= - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHg - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATEn - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)_ - - DIMENSION LOGIN_BTIM_SAVE(2) - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1)i - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)R - CALL UPDATE_READ ! Update login times - - IF (CLI$PRESENT('SELECT_FOLDER')) THENy - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN) - END IFE - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find foldersE - - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1N - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENR - CALL SET2(NEW_MSG,FOLDER_NUMBER)I - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)H - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.L - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THENE - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.h - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) -Ce -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed.p -Cy - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2).AND.IER.EQ.0) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2)N - CALL REWRITE_FOLDER_FILE - END IF - IF (IER.NE.0) THEN - CALL CHANGE_FLAG_NOCMD(0,2) - CALL CHANGE_FLAG_NOCMD(0,3) - CALL CHANGE_FLAG_NOCMD(0,4) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THENI - FOLDER_FLAG = 0D - CALL MODIFY_SYSTEM_LIST(0) - END IFi - ELSE IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSEE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)a - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)E - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THENU - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)D - IF (IER.LE.15) DIFF = -1C - END IF - END IF - END IFe - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messagesI - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IFY - END IF - END DOI - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - IF (TEST2(NEW_MSG,0)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - NEW_MESS = .FALSE. - DO FOLDER_NUMBER = 1,FOLDER_MAX-1t - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THENR - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),2 - & F_NEWEST_BTIM)) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM)) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time.F - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN( - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(1:TRIM(FOLDER))T - NEW_MESS = .TRUE. - END IF - END IFN - END IF - END DO - IF (NEW_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - FOLDER_NUMBER = 0D - CALL SELECT_FOLDER(.FALSE.,IER)t - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THENi - WRITE(6,'('' Type READ to read new GENERAL messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0r - DO WHILE (NEW_COUNT.GT.0)$ - NEW_COUNT = NEW_COUNT / 10M - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletinsE - ELSE - BULL_POINT = 0E - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)u - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)U - END IF - END IF - ELSE ! READNEW mode. - DO FOLDER_NUMBER = 0,FOLDER_MAX-1N - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THENT - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)( - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM)A - ELSEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - END IF) - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THENT - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.I - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN1 - IF (FOLDER_NUMBER.GT.0) THEN - WRITE (6,'('' There are new messages in folder '',T - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE IF (FOLDER_NUMBER.EQ.0.OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINTI - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY1 - BULL_POINT = SAVE_BULL_POINTE - END DOE - END IFF - END IF - END IF) - END IF - END IFU - END DO - CALL EXITE - END IF - - RETURNR - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = -1E - FOLDER1 = 'GENERAL' - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to GENERAL folder.'')') - - RETURN - END diff --git a/decus/1989b/bulletin/bulletin8.for b/decus/1989b/bulletin/bulletin8.for deleted file mode 100644 index 41ce5d0..0000000 --- a/decus/1989b/bulletin/bulletin8.for +++ /dev/null @@ -1,1472 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:40 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN8.FOR - -Message-Id: <8907211346.AA23752@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 09:00:47 EDT -Date: Fri, 21 Jul 89 08:39 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN8.FOR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -C -C BULLETIN8.FOR, Version 12/15/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - CHARACTER NAMEDESC*9 /'BULLETIN1'/ - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*9 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN),IO$_READVBLK,MBX_IOSB, - & MBX_AST,,MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*6,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL CONNECT(NODENAME,USERNAME,FROMNAME) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(200),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - CHARACTER*128 INPUT - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10G - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFv - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK)V - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN9 - - IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL EXECUTE_COMMAND(UNIT_INDEX)V - - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - - RETURNC - END - - - - - - SUBROUTINE CONNECT(NODENAME,USERNAME,FROMNAME)o - - IMPLICIT INTEGER (A-Z)r - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/- - - CHARACTER*(*) USERNAME,FROMNAME - - EXTERNAL IO$_ACCESS,IO$M_ABORTN - - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME)o - - IF (REJECT.NE.IO_REJECT) THEN - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IFR - - CALL READ_MBX - - RETURNA - END - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME)A - - IMPLICIT INTEGER (A-Z)G - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10I - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSBE - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFL - DATA COUNT /0/I - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)I - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK)_ - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - EXTERNAL IO$_ACCESS,IO$M_ABORTI - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5)T - - LEN_NCB = MBX_BUF(START_NCB-1), - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THENE - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHANE - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER)L - - IF (IER) THENT - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1U - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THENT - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT$ - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAMEC - NODE_SAVE(UNIT_INDEX) = NODENAMEM - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0M - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IFE - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,)O - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1S - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0C - END IFS - - RETURNI - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER)C -CO -C SUBROUTINE GETDEVUNIT -CN -C FUNCTION: -C To get device unit number -C INPUT:K -C CHAN - Channel number( -C OUTPUT: -C DEV_UNIT - Device unit numberL -CR - - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listM - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist) - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURNO - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C_ -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT:) -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME+ - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listN - CALL ADD_2_ITMLST_WITH_RETS - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)): - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlistR - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN= - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -CE -C SUBROUTINE DISCONNECT -CN -C FUNCTION: Disconnects channel and remove its entry from the lists.S -CR - - IMPLICIT INTEGER (A-Z). - - PARAMETER MAXLINK = 10S - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFI - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area forL - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - IF (UNITS(UNIT_INDEX).EQ.0) RETURND - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0, - UNITS(UNIT_INDEX) = 0 - - RETURNX - END - - - - SUBROUTINE SET_TIMER(MIN) -CT -C SUBROUTINE SET_TIMER -CG -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C= - IMPLICIT INTEGER (A-Z)I - INTEGER TIMADR(2) ! Buffer containing timeE - ! in desired system format. - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/, - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN)T - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURNI - END - - - - - SUBROUTINE CHECK_CONNECTIONSI - - IMPLICIT INTEGER (A-Z)L - - PARAMETER MAXLINK = 10O - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFU - - IF (COUNT.GT.0) THEN) - DO UNIT_INDEX=1,MAXLINKT - IF (DEVS(UNIT_INDEX).NE.0.AND.V - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN1 - CALL DISCONNECT(UNIT_INDEX)L - END IFI - END DO - END IF% - - CALL RESET_TIMER - - RETURNI - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*)S - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2)T - - CALL INIT_ITMLSTC - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST)F - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THENC - USERNAME = 'DECNET'( - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)_ - END IFI - - RETURNN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME)S - - IMPLICIT INTEGER (A-Z)N - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12U - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM)I - NUM = NUM + 1R - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THENE - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THENU - USERTEMP = NETUAF(65:)) - ELSEU - USERTEMP = USERNAME - END IFL - END IF - END DOU - - USERNAME = USERTEMP - - RETURNE - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z)N - - CHARACTER NETUAF*656R - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/0 - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF)K - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)I - - FORMAT = 0 - - IF (IER.NE.0) THENU - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT',A - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)E - FORMAT = 1 - END IFY - - NETUAF_NUM = 0C - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAFI - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:)_ - NLEN = NLEN - 12I - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64)R - SKIP = 4 + ICHAR(NETUAF(65:65))_ - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DOS - IF (NLEN.GT.64) THENR - ULEN = ICHAR(NETUAF(65:65))E - NETUAF(65:) = NETUAF(69:)I - DO I=65+ULEN,76C - NETUAF(I:I) = ' ' - END DO - ELSEU - NETUAF(65:) = 'DECNET' - END IF - END IF2 - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DOC - - CLOSE (UNIT=7)T - - RETURNX - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX)( - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC'( - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'E - - PARAMETER MAXLINK = 10R - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFE - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)O - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)A - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK)_ - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK)_ - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL ENABLE_CTRL_EXIT,SS$_NOSUCHNODE,SS$_NOSUCHOBJ_ - - PARAMETER TIMEOUT = -10*1000*1000*30E - DIMENSION TIMEBUF(2)_ - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*53 - CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE)C - - INTEGER BULLCP_PRIV(2)O - - BULLCP_PRIV(1) = PROCPRIV(1)N - BULLCP_PRIV(2) = PROCPRIV(2)T - - ILEN = READ_IOSB(2,UNIT_INDEX)V - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER))E - - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX)C - FOLDER = FOLDER_NAME(UNIT_INDEX)D - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)1 - NODENAME = NODE_SAVE(UNIT_INDEX) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15) THEN ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USERNAME,PRIV_SAVE(1,UNIT_INDEX))I - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND.t - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THENm - CALL CHECK_BULLETIN_PRIV(USERNAME)n - PRIV_SAVE(1,UNIT_INDEX) = PROCPRIV(1) - PRIV_SAVE(2,UNIT_INDEX) = PROCPRIV(2) - END IFe - END IF - END IF - - IF (CMD_TYPE.EQ.1) THEN ! Select folder - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER)S - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))), - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:5)))C - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9)))E - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13)))( - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),m - & %REF(BUFFER(9:9))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1)E - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1)I - END IFW - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - END IF - BUFFER = BUFFER(:16)//FOLDER_COM - CALL WRITE_CHAN(16+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - FOLDER_NAME(UNIT_INDEX) = FOLDERE - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBERO - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX)( - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message lineI - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1I - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP)) - CALL LIB$MOVC3(11,%REF(BUFFER(58:58)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(69:69)),%REF(EXTIME))o - CALL LIB$MOVC3(4,%REF(BUFFER(80:80)),SYSTEM) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)N - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENT - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000N - ELSE IF (SYSTEM.NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND.V - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)N - END IFL - IF (SYSTEM.NE.0.AND..NOT.SETPRV_PRIV()) THEN ! Priv testU - IF (FOLDER_OWNER.NE.USERNAME) THENL - SYSTEM = 0T - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IFI - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)D - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11C - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0'N - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//) - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(84:84)),BROAD)I - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEND - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(88:88)),BELL) - CALL LIB$MOVC3(4,%REF(BUFFER(92:92)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(97:97)),CLUSTER)D - FOLDER_FILE =E - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERD - CALL OPEN_BULLDIRM - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFILU - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX)E - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUER - END DO - IF (BROAD) THENU - CALL GET_BROADCAST_MESSAGE(BELL)6 - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletinD - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder fileN - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes& - TEMP_USER = ':'E - DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER)F - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAMED - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND.(TEMP_USER(2:).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE.. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000_ - END IF6 - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,I - & %VAL(1))R - CALL SETUSER(USERNAME) ! Reset to original usernameU - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE)T - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THENT - DELETE (4) - END IFP - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH)( - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER)S - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127))R - I = I + 128, - END DOA - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IFO - IER = SYS$CANTIM(%VAL(1),) - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entryN - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE =E - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THENC - CALL READDIR(ICOUNT,IER)A - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:9)),%REF(MSG_KEY(1:1))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1)))Y - IF (ICOUNT.NE.0) THENO - BUFFER(5:) = BULLDIR_ENTRYI - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER)T - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),SBULL)C - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),EBULL)0 - FOLDER_FILE =M - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX)N - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL)U - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)2 - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX)L - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY)C - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1I - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)R - OUT_SAVE(UNIT_INDEX) = OENTRYM - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE =E - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER. - CALL OPEN_BULLDIRD - IF (ICOUNT.GT.0) THENF - BULLDIR_ENTRY = BUFFER(9:)E - CALL WRITEDIR_NOCONV(ICOUNT,IER)R - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER)O - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THENE - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE)D - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),IMMEDIATE)S - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)F - CALL OPEN_BULLDIRT - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENS - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.'B - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000H - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROMT - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR( - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRYS - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message) - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX)( - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)U - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX)_ - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH% - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE), - OUT_SAVE(UNIT_INDEX) = OENTRYE - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)L - FOLDER_FILE =F - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERR - CALL OPEN_BULLDIRO - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP_TEMP))R - CALL LIB$MOVC3(4,%REF(BUFFER(58:58)),ICOUNT) - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIRa - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000U - END IF - CALL LIB$MOVC3(53,%REF(BUFFER(62:62)),%REF(DESCRIP)) - CALL LIB$MOVC3(4,%REF(BUFFER(115:115)),%REF(MSGTYPE))D - CALL LIB$MOVC3(11,%REF(BUFFER(119:119)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(130:130)),%REF(EXTIME))T - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR._ - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX)/ - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTHF - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUEA - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletinL - IF (NEW_LENGTH.GT.0) THEN) - NEMPTY = NEMPTY + LENGTH( - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 19 - END IF - CALL WRITEDIR(ICOUNT,IER)& - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1),F - & BTEST(MSGTYPE,2),EXDATE,EXTIME)L - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General?= - END IF - CALL WRITEDIR(ICOUNT,IER)E - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE)N - DESCRIP_TEMP = BUFFER(9:61)F - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)A - CALL OPEN_BULLDIRd - CALL READDIR(BULL_DELETE,IER)C - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENA - CALL CLOSE_BULLDIRM - BUFFER = 'ERROR: Cannot find message to undelete.') - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000r - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROMe - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENL - CALL CLOSE_BULLDIRD - BUFFER = 'ERROR: Insufficient privileges to undelete message.'B - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000E - END IF - CALL LIB$MOVC3(11,%REF(BUFFER(62:62)),%REF(EXDATE))L - CALL LIB$MOVC3(11,%REF(BUFFER(73:73)),%REF(EXTIME))' - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - FOLDER_FILE =P - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERO - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER)S - CALL GET_NEWEST_MSG(%REF(BUFFER(5:5)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHAREDO - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) I - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAGB - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0G - END DO, - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER,N - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER,D - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSERC - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BLENGTH), - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),START)( - IF (BLENGTH.EQ.-1) THENO - IF (SCRATCH(UNIT_INDEX).EQ.0) THENU - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF_ - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:13)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:1))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:13)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:17)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX))9 - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:21)),FOLDER_NUMBER) - FOLDER = BUFFER(25:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER)) - END IFE - END IF - END IF - -1000 PROCPRIV(1) = BULLCP_PRIV(1)Y - PROCPRIV(2) = BULLCP_PRIV(2) - - RETURNO - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC'N - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - PARAMETER MAXLINK = 10E - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)_ - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)M - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK)E - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2)) - - USERNAME = USER_SAVE(UNIT_INDEX)I - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURNU - - CALL OPEN_USERINFOD - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.GE.0) RETURN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - CALL UPDATE_USERINFOE - - RETURNS - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM)I - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)R - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2). - - RETURNO - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z)E - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS)( - IF (R_ACCESS) THEN - PROCPRIV(1) = NEEDPRIV(1) - PROCPRIV(2) = NEEDPRIV(2) - END IF - END IF% - - RETURN5 - END - - - - SUBROUTINE GETACC(ACCOUNT) -CD -C SUBROUTINE GETACC -C_ -C FUNCTION: -C To get account of present process. -C OUTPUTS:D -C ACCOUNT - ACCOUNT owner of present process.E -CY - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT))B - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistI - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURNQ - END - - - - - - SUBROUTINE GETSTS(STS)U -CA -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS:_ -C STS - Status word of present process.l -Cn - - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistO - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoR - - RETURNL - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z)N - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB)I - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS, - - END - - - - INTEGER FUNCTION REC_LOCK(IER)B - - INCLUDE '($FORIOSDEF)'5 - - DATA INIT /.TRUE./ - - IF (INIT) THENR - REC_LOCK = 1 - INIT = .FALSE. - ELSEL - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0E - INIT = .TRUE. - END IF - END IFN - - RETURNG - END - - INTEGER FUNCTION TRIM(INPUT). - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURNA - END DOL - RETURNN - END - - SUBROUTINE SYS_GETMSG(IER)B - - IMPLICIT INTEGER (A-Z)t - - CHARACTER*80 MESSAGEs - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURNG - END diff --git a/decus/1989b/bulletin/bulletin9.for b/decus/1989b/bulletin/bulletin9.for deleted file mode 100644 index 2bbe056..0000000 --- a/decus/1989b/bulletin/bulletin9.for +++ /dev/null @@ -1,1775 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 11:06 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN9.FOR - -Message-Id: <8907211347.AA23762@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 09:01:24 EDT -Date: Fri, 21 Jul 89 08:39 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN9.FOR -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -C -C BULLETIN9.FOR, Version 6/1/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - NLEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addedd - END IF - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:NLEN)//'""::' - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Is semicolon present? - IF (NLEN.GT.SEMI+1) THEN ! Yes, is username after node? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - NLEN = SEMI - 1 ! Remove semicolon - ELSE ! No username after nodename - TEMP_USER = DEFAULT_USER ! Set username to default - NLEN = SEMI - 1 ! Remove semicolon - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolon present - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username was - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:NLEN) - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '// - & PASSWORD(1:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FLAGNAME - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=13,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO2 - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(13,IOSTAT=IER1) BULLDIR_HEADER- - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1d - - RETURNA - - ENTRY ADD_MERGE_TO(IER1)d - - IER1 = 0P - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE/ - CALL CONVERT_ENTRY_FROMBINn - RETURNe - END IF - - NBULL = NBULL + 1n - MSG_NUM = NBULL7 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRYI - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DOE - - CLOSE (UNIT=13) - - RETURNE - - ENTRY ADD_MERGE_FROM(IER1)E - - NEWEST_DATE = DATEP - NEWEST_TIME = TIMER - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THENb - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIMEA - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IFC - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - RETURNE - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0)) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEND - READ (13,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(13,IOSTAT=IER1) BULLDIR_HEADERI - IF (IER1.EQ.0) THEN - CLOSE (UNIT=13,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=13) - END IF - RETURNA - END IF - - NBULL = NBULL + 1D - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)E - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRYN - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1X - END DOD - - CLOSE (UNIT=13) - - RETURNo - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATE= - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)R - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN_ - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z)L - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATEO - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1)O - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',)S - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',)D - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',)_ - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',)u - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',)e - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',)t - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',)U - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',)U - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',)M - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',)o - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',), - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',)( - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',)R - - RETURN) - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z)( - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUTR - CHARACTER*(*) LIBRARY - - INCLUDE '($HLPDEF)' - - IF (CLI$PRESENT('PRINT')) THENT - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$PRINT:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - ELSE - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8)0 - END IF - ELSEN - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD's - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURNO - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT)' - IMPLICIT INTEGER (A-Z)s - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN9 - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -CD -C SUBROUTINE OUTPUT_HELPI -C( -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library.N -CL - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,DISPLAY_ID,HELP_INPUT,HELP_INPUT_LENI - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACTF - CHARACTER*20 KEY(10)_ - DIMENSION KEYL(10)S - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA DISPLAY_ID/0/,KEYBOARD_ID/0/ - - IER = SMG$CREATE_PASTEBOARD(PASTEBOARD_ID) ! Initialize terminalA - IF (DISPLAY_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_DISPLAY(PAGE_LENGTH, - & PAGE_WIDTH,DISPLAY_ID)i - END IFf - IER = SMG$PASTE_VIRTUAL_DISPLAY(DISPLAY_ID,PASTEBOARD_ID,1,1) - - IF (KEYBOARD_ID.EQ.0) THEN' - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library readU - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library nameU - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0O - END DOd - - NKEY = 0 ! Number of help keysS - - DO WHILE (1) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key countL - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND.E - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counterG - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spacesE - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DOE - - NEXT_KEY = 2, - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search forT - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next keyE - END DOD - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key lengthR - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN)I - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1H - END IFD - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10)))U - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1( - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact matchE - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO( - NKEY = OLD_NKEY - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopicK - LPROMPT = 0 ! Create subtopic prompt lineL - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1, - END DOF - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10) - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IFD - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IFT - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LBR$CLOSE(LINDEX) ! then close library, - CALL SMG$UNPASTE_VIRTUAL_DISPLAY(DISPLAY_ID,PASTEBOARD_ID) - ! remove virtual display - RETURN ! and end help session. - END IF - - END DOT - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL)A -CI -C FUNCTION PUT_OUTPUT -C' -C FUNCTION: -C Output routine for input from LBR$GET_HELP. DisplaysE -C help text on terminal with full screen prompting.I -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -CO - IMPLICIT INTEGER (A-Z)_ - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACTD - CHARACTER*20 KEY(10)D - DIMENSION KEYL(10), - - COMMON /HELP/ HELP_PAGE,DISPLAY_ID,HELP_INPUT,HELP_INPUT_LENT - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found, - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that, - KEYL(I) = 0 ! were inputted, as they areE - END DO ! not valid, as no matchY - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND.= - & %LOC(INPUT).NE.0) THEN ! If text contains key namesA - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match.E - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length' - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys thatI - KEYL(I) = 0 ! were just inputted, allowingD - END DO ! this routine to fill them. - END IFG - - IF (NEED_ERASE) THEN ! Need to erase screen?O - IER = SMG$ERASE_DISPLAY(DISPLAY_ID) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IFB - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counterR - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screenG - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input?L - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired.E - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered$ - IER = SMG$ERASE_DISPLAY(DISPLAY_ID) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent outputO - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description.P - IF (NSPACES.GT.0) THEN ! Add spaces if present to output( - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IFT - HELP_PAGE = 1 ! Increment page counter.n - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT)C - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT)I - END IF - END IFU - - RETURNM - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z)I - - CHARACTER VERSION*10,DATE*23, - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE))) - - RETURNR - END - - - - - - - SUBROUTINE TAG(ADD_OR_DEL)_ - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./R - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENTA - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IFB - - IF (.NOT.CLI$PRESENT('NUMBER')) THENT - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error.$ - RETURND - ELSE IF (ADD_OR_DEL) THENr - CALL ADD_TAG(IER) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THENl - WRITE (6,'('' ERROR: Message was not marked.'')') - END IFr - END IF - RETURN - END IF! - - CALL OPEN_BULLDIR_SHAREDo - - IER1 = 0 - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)= - & .NE.%LOC(CLI$_ABSENT).AND.IER1.EQ.0) ! Get the specified messages - - DECODE(LEN_P,'(I)',BULL_PARAMETER) MESSAGE_NUMBER - - CALL READDIR(MESSAGE_NUMBER,IER) ! Get info for bulletin - - IF (IER.NE.MESSAGE_NUMBER+1) THEN ! Was bulletin found?K - WRITE(6,1030) ! If not, then error outH - ELSE IF (ADD_OR_DEL) THEN. - CALL ADD_TAG(IER1)L - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN_ - WRITE (6,'('' ERROR: Message '',I,r - & '' was not marked.'')') MESSAGE_NUMBER - END IFH - END IF - END DO_ - - CALL CLOSE_BULLDIRT - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found.')) - - END - - - - SUBROUTINE ADD_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC't - - CHARACTER*12 TAG_KEY_ - - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY)P - - IF (IER.EQ.FOR$IOS_INCKEYCHG) THENU - WRITE (6,'('' Message was already marked.'')') - ELSE IF (IER.NE.0) THENX - WRITE (6,'('' ERROR: Unable to add mark.'')')I - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN_ - WRITE (6,'('' IOSTAT error = '',I)') IERI - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IFP - - RETURNT - END - - - - - SUBROUTINE DEL_TAG(IER) - - IMPLICIT INTEGER (A-Z)2 - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'5 - - CHARACTER*12 TAG_KEYK - - DO WHILE (REC_LOCK(IER))7 - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER)( - END DO - IF (IER.NE.0) RETURNL - - DELETE (UNIT=13,IOSTAT=IER) - - IF (IER.NE.0) THENa - WRITE (6,'('' ERROR: Unable to delete mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IFL - - RETURN - END - - - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)'I - - INCLUDE 'BULLUSER.INC'i - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)m - IF (.NOT.IER) RETURNR - - NTRIES = 0a - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE='BULL_MARK:'//P - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,b - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER))R - NTRIES = NTRIES + 1& - END DO_ - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)E - IF (IER1.EQ.0) THENe - WRITE (6,'('' IOSTAT error = '',I)') IERv - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF. - - IF (IER.EQ.0) BULL_TAG = .TRUE. - - RETURN - END - - - - - SUBROUTINE OPEN_NEW_TAG(IER)r - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC'D - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 BULL_MARKG - - IER = SYS_TRNLNM('BULL_MARK',BULL_MARK) - IF (.NOT.IER) THENU - WRITE (6,'('' ERROR: BULL_MARK must be defined.'', - & '' See HELP MARK.'')')e - RETURN - ELSE - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1.OR.BULL_MARK.NE.BULL_PARAMETER) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)e - CALL DISABLE_PRIVSg - IER1 = 0u - END IF - OPEN (UNIT=13,FILE='BULL_MARK:'//I - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1)) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSEH - CALL SYS_GETMSG(IER1) - IER = IER1_ - END IFr - ELSE - BULL_TAG = .TRUE. - IER = 1 - END IF - END IF - - RETURND - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY) - - IMPLICIT INTEGER (A-Z)F - - CHARACTER*(*) MSG_KEY - - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN( - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z)r - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEYu - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF_ - - MSG_KEY = BULLDIR_HEADERs - - HEADER = .TRUE. - GO TO 10R - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I))k - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1)y - I = 9 - ELSE - I = I + 1 - END IF - END DOx - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - HEADER = .FALSE.( - -10 DO WHILE (1)t - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - & INPUT_KEY - END DO - - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY)E - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)r - END IF - - IF (FOLDER1_NUMBER.NE.FOLDER_NUMBER.OR.IER.NE.0) THEN - IER = 1 - UNLOCK 13 - RETURNs - ELSE - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9T - ELSEE - I = I + 1. - END IFN - END DOA - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL OPEN_BULLDIR - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIRi - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:))f - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THENT - MESSAGE = MESSAGE - 1r - MSG_KEY = BULLDIR_HEADER - END IFR - IER = 0 - RETURN - ELSEL - DELETE (UNIT=13)e - IER = 1 - END IFL - END IF - - END DOc - - END - - - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT)L -C. -C Add INDEX command to BULLETIN, display directories of ALL -C folders. Added per request of a faculty member for his private -C board. Changes to BULLETIN.FOR should be fairly obvious. -C( -C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2)t -C. - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC'n - INCLUDE 'BULLUSER.INC'E - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - DATA FOLDER_Q1/0/ - - BULL_POINT = 0N - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THENE - INDEX_COUNT = 2 - DIR_COUNT = 0T - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM)B - - FOLDER_Q = FOLDER_Q1P - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from fileR - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN) - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))O - & //FOLDER1 - CALL CHECK_ACCESS/ - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',O - & USERNAME,READ_ACCESS,-1)A - ELSEL - READ_ACCESS = 1 - END IFA - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1I - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IFT - END IF - END DOe - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - WRITE (6,1000) - WRITE (6,1020)L - DO J = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - WRITE (6,1030) FOLDER1(:15),F1_NBULL, - & FOLDER1_DESCRIP(:MIN(TRIM(FOLDER1_DESCRIP),59)) - END DOH - WRITE (6,1060)' - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - READ_TAG = .FALSE.O - IF (CLI$PRESENT('MARKED')) READ_TAG = .TRUE.B - RETURNA - ELSE IF (INDEX_COUNT.EQ.2) THEN - IF (DIR_COUNT.EQ.0) THEN - F1_NBULL = 0E - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1H - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN( - FOLDER_NUMBER = -1T - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0' - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0F - RETURN - END IFo - END IF - e - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)N - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040)t - ELSE - INDEX_COUNT = 0 - END IF - END IFE - - RETURNF - -1000 FORMAT (' The following folders are present'/)) -1020 FORMAT (' Name Count Description'/)k -1030 FORMAT (1X,A15,I5,1X,A) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') - - END - - - - - SUBROUTINE SHOW_USERY -CE -C SUBROUTINE SHOW_USERE -CI -C FUNCTION: Shows information for specified users.) -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'I - - INCLUDE 'BULLUSER.INC' - - DIMENSION NOLOGIN_BTIM(2) - - CHARACTER*17 DATETIME - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL')I - & .OR.CLI$PRESENT('LOGIN') - IF (.NOT.ALL) THEN3 - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IFA - - IF (.NOT.SETPRV_PRIV().AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to user command.'')')_ - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)O - - CALL OPEN_BULLUSER_SHARED - - IF (.NOT.ALL) THENI - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THENL - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE) - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IFN - ELSE - WRITE (6,'('' Entry for specified user not found.'')')F - END IF - ELSE - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - CALL READ_USER_FILE(IER)S - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND.E - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM)1 - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0) THENT - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,)T - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IFL - END IFP - END DO - END IFP - - CALL CLOSE_BULLUSER - - RETURNG - END - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C6 -C SUBROUTINE INIT_MESSAGE_ADD -Cn -C FUNCTION: Opens specified folder in order to add message. -CE -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS:S -C IER - Error status. True if properly connected to folder. -C False if folder not found.' -CS - IMPLICIT INTEGER (A - Z)Y - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCPe - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/R - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIPT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPA - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIPD - - COMMON /TEXT_PRESENT/ TEXTC - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL OPEN_BULLFOLDER ! Get folder fileM - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER)E - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER)_ - RETURN - ELSEM - IER = 1G - END IFP - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE.U - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folderT - FOLDER_SET = .FALSE. ! indicate itD - ELSE ! Else it's another folderO - FOLDER_SET = .TRUE. ! indicate it - END IF, - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCKH - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0, - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - - LEN_FROM = TRIM(IN_FROM). - IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM)T - ELSEO - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THENN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocolD - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO)T - END IF - END IFE - - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THENE - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' 'i - END IFC - - CALL STRIP_HEADER(INPUT,0,IER1) - - RETURN) - END - - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -CN -C SUBROUTINE WRITE_MESSAGE_LINE -CM -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message.E -CL - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROU - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPr - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIPe - - COMMON /DIGEST/ LDESCR,FIRST_BREAKl - DATA FIRST_BREAK/.TRUE./ - - COMMON /STRIP_HEADER/ STRIP - DATA STRIP/.TRUE./2 - - COMMON /TEXT_PRESENT/ TEXTT - - CHARACTER*(*) BUFFER' - - LEN_BUFFER = TRIM(BUFFER) - - IF (BTEST(FOLDER_FLAG,5)) THEN' - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE.E - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DOI - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THENE - IF (.NOT.FIRST_BREAK) THENE - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSED - FIRST_BREAK = .FALSE. - END IF! - LFROM = 0 - LDESCR = 00 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THENl - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THENE - LDESCR = LEN_BUFFER - 9A - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM)& - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LPRO.GT.0) THEN_ - LFROM = LFROM + LPRO + 1I - CALL STORE_FROM(PROTOCOL(:LPRO)//O - & BUFFER(7:LEN_BUFFER)//'"',LFROM)( - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IFS - RETURNR - END IFn - ELSE - RETURNL - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF (.NOT.STRIP) THEN - CALL STORE_BULL(1,' ',NBLOCK) ! just store one spaceE - ELSE - STRIP = .FALSE. - END IF - ELSEN - IF (LEN_DESCRP.EQ.0) THEN( - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:)Q - LEN_DESCRP = LEN_BUFFER - END IFX - END IF - IF (STRIP) THENR - CALL STRIP_HEADER(BUFFER,LEN_BUFFER,IER) - IF (IER) THEN - RETURN - ELSE. - STRIP = .FALSE.. - END IFF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - TEXT = .TRUE. - END IF - - RETURN_ - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -CE -C FUNCTION: Writes message entry into directory file and closes folder -CF -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAKE - - COMMON /STRIP_HEADER/ STRIP - - COMMON /TEXT_PRESENT/ TEXTD - - STRIP = .TRUE. ! Reset strip flag0 - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msgo - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry0 - RETURN - END IFu - - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time?r - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)I - SYSTEM = 0 - END IF - EXTIME = '00:00:00.00'I - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add$ - - CALL UPDATE_FOLDER. - - RETURNE - END - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(LINE_LENGTH) INFROMN - - INFROM = IFROM - - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK)' - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol programH - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - IF (INDEX(INFROM,'<').GT.0) THEN ! Name may be of formE - INFROM = INFROM(INDEX(INFROM,'<'):) ! personal-name - END IFS - - IF (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name) - & INDEX(INFROM,'@').GT.INDEX(INFROM,'(')) THEN - INFROM = INFROM(INDEX(INFROM,'(')+1:)N - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'"')) - I = I + 1C - END DOS - INFROM = INFROM(I:) - - I = 1 ! Trim username to end at a alpha charactera - DO WHILE (I.LE.12.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'"')A - I = I + 1_ - END DOE - FROM = INFROM(:I-1) - - DO J=2,I-1S - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THENn - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a'))n - END IF - END DO - - RETURN- - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z)e - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' 'C - END DOP - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THENM - ! Is length > allowable subject length?R - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//E - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IFR - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP)))E - - RETURNR - END - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER)D -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -CE -C INPUTS: -C BUFFER - Character string containing input line of message._ -C BLEN - Length of character string. If = 0, initialize subroutine. -CL -C OUTPUTS:Y -C IER - If true, line should be stripped. Else, end of header._ -CS - IMPLICIT INTEGER (A - Z)E - - CHARACTER*(*) BUFFERL - - INCLUDE 'BULLFOLDER.INC'f - - IF (.NOT.BTEST(FOLDER_FLAG,4).OR.TRIM(BUFFER).EQ.0) THENE - ! If STRIP not set for folder or empty line - IER = .FALSE.E - CONT_LINE = .FALSE.r - RETURN - END IFS - - IF (BLEN.EQ.0) CONT_LINE = .FALSE. - - IER = .TRUE.L - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuationi - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header line - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuationK - RETURNC - ELSE - I = I + 1 - END IF - END DOi - - IER = .FALSE. - CONT_LINE = .FALSE. - - RETURNO - END diff --git a/decus/1989b/bulletin/bulletin_ann.txt b/decus/1989b/bulletin/bulletin_ann.txt deleted file mode 100644 index 483df26..0000000 --- a/decus/1989b/bulletin/bulletin_ann.txt +++ /dev/null @@ -1,324 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 09:10 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN utility. - -Message-Id: <8907211243.AA22754@crdgw1.ge.com> -Date: Fri, 21 Jul 89 08:35 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN utility. -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -You are about to receive version 1.69 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -The PMDF files have been made part of the general distribution. - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -This version includes all necessary modifications to work under VMS -V5.0. However, it will still be necessary to reassemble the ALLMACS.MAR -source under V5 and relink. The V4 version will not be installable -under V5 due to a change in a shared library which BULLETIN uses. -However, relinking by itself will not be enough. You MUST also -reassemble ALLMACS.MAR. If you only relink, BULLETIN can cause your -system to crash (the BULLCP process will do this because it uses the -routines in ALLMACS.MAR). - -If you are running a version of BULLETIN older than 1.52, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. This -format change can take a significant amount of time if the folder is -large. If your site has large folders, it is suggested that the new -version be installed during off peak hours. NOTE: Problems can occur -if the old version of BULLETIN is run after the data files have been -modified. Such a situation is possible on a cluster where each node has -installed the executable separately. To help installation, a new -command procedure INSTALL_REMOTE.COM has been included. This can be -used to install BULLETIN on several nodes from a single node. Read the -comments in the file for information on how to use it. - -NOTE: The BULLCP process should be stopped using the BULLETIN/STOP -command before the new version of BULLETIN is installed. It can then be -restarted using the BULLETIN/STARTUP command. (The INSTALL_REMOTE.COM -command procedure does this automatically for remote nodes.) - -You will be receiving 17 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) ALLMACS.MAR - 13) BULLCOMS1.HLP - 14) BULLCOMS2.HLP - 15) BULLET1.COM - 16) BULLET2.COM - 17) PMDF.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. Otherwise, you can delete -it. Read AAAREADME.TXT for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. A command procedure is included at the -end of this message which can be run which uses EDT to do this for you. - - MRL%MIT.MFENET@NMFECC.ARPA ------------------------------------------------------------------------- -V1.69 - -Fixed bug which caused a user to obtain full bulletin privileges if that -user created a privileged folder. - -V1.68 - -Fixed bug which prevented SHUTDOWN messages from being deleted. - -Fixed code to allow SHOW KEY/PRINT to work properly. - -Fixed folder conversion routine which was used for updating folder data -file when either upgrading from older version of BULLETIN, or when -increasing the number of folders. Recent software changes broke it. - -Modified user data file cleanup algorithm. User entries are now deleted -only if both the user doesn't exist in the SYSUAF file, and the user has -not used BULLETIN within the last 6 months. This change solves a -problem which occurs when nodes on the same cluster use different SYSUAF -files. The node that BULLCP runs on will only see one of the SYSUAF -file, and would discard the "valid" users from the other SYSUAF. The -previous suggested solution for this was to use separate BULL_DIR and -BULLCPs. However, messages added with /BROADCAST would be seen -throughout the whole cluster, and if the same message was added to both -BULL_DIRs, the message would be seen twice. - -V1.67 - -A bug was fixed which allowed unauthorized users to add messages to -semi-private folders by using the ADD/FOLDER command. - -Modified algorithm which decides if a user has "BULLETIN" privileges. -There was a problem with this algorithm, in that the SET PRIV/ID command -grants privileges to a user by creating an ACL on BULLUSER.DAT. -BULLETIN privileges are granted by checking access to that file. -Unfortunately, for this to properly work, the protection on this file -must be (RWED,RWED,,). However, due to various reasons, it has been -found that the protection of this file has changed and thus allowed -non-authorized users to obtain privileges. Therefore, the checking -algorithm now makes sure that access is obtained via ACLs. However, -this will also affect users that have the ability to set process -privileges to access the file. In the past, setting those privileges -was not necessary to gain BULLETIN privileges, only the ability to set -them was necessary. Now, it is necessary to set them. - -V1.66 - -The SET NODEFAULT_EXPIRE command would not work, since it conflicted -with SET NODE. The command has been removed. Removing the default -expiration time is now accomplished by SET DEFAULT_EXPIRE 0. Setting -the value to -1 specifies that the default is that messages will become -permanent. - -V1.65 - -Added option to COPY, MOVE, FILE, and PRINT commands to be able to -specify a range of messages, i.e. m1-m2. - -Under certain conditions, BULLETIN/STARTUP could be executed such that -the BULLCP created would not fully work, due to privilege problems. -BULLETIN/STARTUP has been changed so that it will work properly. - -V1.64 - -Added SET DIGEST command for a folder. This causes network mail -messages which are in digest form to be undigested, thus avoiding the -necessity of a special command procedure to do it. - -Added SET STRIP command for a folder. This caused network mail messages -to have their mail headers stripped off. - -Added the /ALL and /FORM= qualifiers to the PRINT command. - -Added the SPAWN command. - -Fixed minor bug relating to displaying remote folder messages when -logging in. If a message was added to a remote folder less than 15 -minutes before a user on another node logged in, and that was the only -new message in the folder, it is possible that the message will not be -displayed. This is because BULLCP only updates remote folders on the -local node every 15 minutes. The fix was that when logging in, remote -folders are checked for new messages that have been added since the -previous login time plus 15 minutes. - -If a site does not have a DECNET account, BULLETIN/START will now work -without having to modify the sources. The BULLCP process will be owned -by the process which started it. - -The PMDF program now writes out the owner of the message prefixed by -IN%", so that the RESPOND command will work with requiring modification -of the sources. - -V1.63 - -Fixed bug in deletion algorithm. If a deletion was interrupted, the -file could be left in a state such that BULLETIN would loop when -attempting to recover from the interruption. Also optimized the -recovery algorithm, as it would takes a long time to recover a large -folder.A - -Fixed bug regarding remote folders. If user flags (SHOWNEW, READNEW, -etc.) were set for a remote folder, and there was an attempt to access -the remote folder when the remote node was down, BULLETIN would assume -the folder was no longer present, and remove the flags. BULLETIN now is -smart enough to know that the node is simply down, not removed.e - -V1.62 - -Fixed exit handler to avoid possibility of default protection being -changed if BULLETIN is exited abnormally. - -Fixed REMOVE bug relating to forgetting to change default protection. -If a user without process privileges attempts to remove a folder, and -the default protection for SYSTEM is not RWED, BULLETIN will crash.w - -The algorithm for getting the last boot time in order to determine when -to delete SHUTDOWN messages wouldn't work under V5 if the source was -compiled under V4. The routine has been rewritten so it is no longer -dependent on the VMS version. - -V1.61h - -Added SHOW USER command. Will show login times for a user (as recorded -by BULLETIN/LOGIN), and will show which users have NOLOGIN set. - -Fixed SET LOGIN command, as it was not working. - -V1.6 - -Changed message line length limit from 80 to 255 characters. Messages -lines longer than the terminal width will wrap when displayed. 132 -column mode is now supported.n - -Message owner and subject fields have also been increased to 255 -characters.n - -In most cases, the RESPOND subroutine should no longer have to be -customized to work with a site's network mail routine. The original -message owner as stored in VMS MAIL message is copied in full, and the -RESPOND command will use that when responding via the MAIL utility. - -The SET PRIV command now has a /ID qualifier which will allow a rights -identify to be specified. Thus, a user can be granted the ability to -execute privileged commands without the need to have higher VMS -privileges.n - -There is now a SHOW VERSION command. - -There is now a POST and RESPOND/LIST command which will send a mail -message to the network mailing list which is associated with a folder, -i.e. if a folder receives mail from a mailing list via the BBOARD -feature. The address of the mailing list is stored in the folder's -description. There is also a /CC qualifier for both POST & RESPOND. - -The ability to mark messages has been added, similar to the command in -the V5 version of VMS MAIL. New commands are MARK & UNMARK, DIR/MARKED, -READ/MARK, and SELECT/MARKED.6 - -Several terminal output statements could not handle message numbers of -greater than 9999. They have been corrected.A - -Fixed bug which didn't allow proper display if page length was > 127.) - -Fixed 2 bugs associated with using the TPU editor when adding a message. -A "BULL.SCR file not found" message used to be displayed. It has now -been suppressed. Also a bug has been fixed which would cause a copy of -BULL.SCR to remain in SYS$LOGIN, if /TEXT was specified. - -Fixed bug which causes a BBOARD message to be split up if a form feedt -character occurs on a line by itself in the message. - -------------------------------------------------------------------------------- -$ set noverl -$ edit/edt/nocommand allmacs.mar -'; Name: SETACC.MAR' -d 1:.-2r -exit -$ edit/edt/nocommand bulletin.fore -'C BULLETIN' -d 1:.-2i -exit -$ edit/edt/nocommand bulletin0.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin1.for -'C BULLETIN'- -d 1:.-2- -exit -$ edit/edt/nocommand bulletin2.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin3.for -'C BULLETIN' -d 1:.-2r -exit -$ edit/edt/nocommand bulletin4.for -'C BULLETIN'c -d 1:.-2e -exit -$ edit/edt/nocommand bulletin5.for -'C BULLETIN' -d 1:.-2W -exit -$ edit/edt/nocommand bulletin6.for -'C BULLETIN'r -d 1:.-2i -exit -$ edit/edt/nocommand bulletin7.for -'C BULLETIN'g -d 1:.-2o -exit -$ edit/edt/nocommand bulletin8.for -'C BULLETIN'e -d 1:.-2f -exit -$ edit/edt/nocommand bulletin9.for -'C BULLETIN'u -d 1:.-2f -exit -$ edit/edt/nocommand bullcoms1.hlp -'1 ADD'd -d 1:.-1 -exit -$ edit/edt/nocommand bullcoms2.hlp -'1 POST' -d 1:.-1h -exit -$ edit/edt/nocommand bullet1.com -'$set nover' -d 1:.-1a -exit -$ edit/edt/nocommand bullet2.com -'$set nover' -d 1:.-1e -exit -$ edit/edt/nocommand pmdf.com -'$set nover' -d 1:.-1 -exit diff --git a/decus/1989b/bulletin/bulletin_howto_get.txt b/decus/1989b/bulletin/bulletin_howto_get.txt deleted file mode 100644 index 13aa407..0000000 --- a/decus/1989b/bulletin/bulletin_howto_get.txt +++ /dev/null @@ -1,26 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 20-JUL-1989 17:12 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN and change of address for me. - -Message-Id: <8907202059.AA08952@crdgw1.ge.com> -Received: From KL.SRI.COM ([0.0.0.0]) by CRVAX.SRI.COM with TCP; Thu, 20 JUL 89 13:34:53 PDT -Received: from PFCVAX.PFC.MIT.EDU by KL.SRI.COM with TCP; Thu, 20 Jul 89 13:09:23 PDT -Date: Thu, 20 Jul 89 16:07 EDT -From: MRL@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN and change of address for me. -To: info-vax@kl.sri.com -X-Vms-To: IN%"info-vax@kl.sri.com" - -In regards to the problem with incorrect file protection on folder files -which someone recently posted here, I believe I have fixed the problem. -The bug is in BULLETIN7.FOR. Also, I have a new address if anyone wishes -to get in touch with me with regard to problems with BULLETIN. It is now: - MRL@PFCVAX.PFC.MIT.EDU -However, I will be away on vacation until July 28. - -In order to receive the BULLETIN distribution, send mail to - BULLETIN@PFCVAX.PFC.MIT.EDU -and specify SEND ALL to receive all the sources. If you just want one -file, send SEND followed by the file name, i.e. SEND BULLETIN7.FOR. - Mark - diff --git a/decus/1989b/bulletin/pmdf.com b/decus/1989b/bulletin/pmdf.com deleted file mode 100644 index 178beb0..0000000 --- a/decus/1989b/bulletin/pmdf.com +++ /dev/null @@ -1,660 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:49 -To: MRGATE::"ARISIA::EVERHART" -Subj: PMDF.COM - -Message-Id: <8907211350.AA23844@crdgw1.ge.com> -Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 09:04:17 EDT -Date: Fri, 21 Jul 89 08:41 EDT -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: PMDF.COM -To: EVERHART@ARISIA.DECNET -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -$set nover -$copy sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE '[-]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE '[-]APFILES.INC', - %INCLUDE '[-]MMFILES.INC', - %INCLUDE '[-]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* Winter 1988 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE '[-]UTILCONST.INC' - %INCLUDE '[-]OSCONST.INC' - %INCLUDE '[-]APCONST.INC' - %INCLUDE '[-]MMCONST.INC' - %INCLUDE '[-]HECONST.INC' - %INCLUDE '[-]LOGCONST.INC' - - TYPE - %INCLUDE '[-]UTILTYPE.INC' - %INCLUDE '[-]OSTYPE.INC' - %INCLUDE '[-]APTYPE.INC' - %INCLUDE '[-]MMTYPE.INC' - %INCLUDE '[-]HETYPE.INC' - %INCLUDE '[-]LOGTYPE.INC' - - VAR - %INCLUDE '[-]UTILVAR.INC' - %INCLUDE '[-]OSVAR.INC' - %INCLUDE '[-]APVAR.INC' - %INCLUDE '[-]QUVAR.INC' - %INCLUDE '[-]MMVAR.INC' - %INCLUDE '[-]HEVAR.INC' - %INCLUDE '[-]LOGVAR.INC' - - outbound : text; - - %INCLUDE '[-]UTILDEF.INC' - %INCLUDE '[-]OSDEF.INC' - %INCLUDE '[-]APDEF.INC' - %INCLUDE '[-]HEDEF.INC' - %INCLUDE '[-]LOGDEF.INC' - %INCLUDE '[-]MMDEF.INC' - %INCLUDE '[-]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - -(* pmdf_to_vms_backward is used to convert a PMDF From: address into something - that VMS MAIL will like. *) - -procedure pmdf_to_vms_backward (var addressee : vstring); - -var - buffer, dummy : vstring; i,stat : integer; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - -begin (* pmdf_to_vms_backward *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - copyvstring (buffer, addressee); - addressee.length := 0; - for i := 1 to protocol_name.length do catchar (addressee, protocol_name[i]); - catchar (addressee, '"'); - for i := 1 to buffer.length do begin - case buffer.body[i] of - '''' : begin - catchar (addressee, '\'); catchar (addressee, 's'); - end; - '"' : catchar (addressee, ''''); - '\' : begin - catchar (addressee, '\'); catchar (addressee, '\'); - end; - otherwise catchar (addressee, buffer.body[i]); - end; (* case *) - end; (* for *) - catchar (addressee, '"'); -end; (* pmdf_to_vms_backward *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR filename, fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - pmdf_to_vms_backward (fromaddr); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - substr (fromaddr.body, 1, fromaddr.length), - ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp"D -$ define/process outbound 'dirlst_file'E -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ !y -$ ! Determine whether or not connection should really be made -$ !: -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ !V -$ ! Handle various channels speciallyR -$ !A -$ if channel_name .eqs. "l" then goto local_channel$ -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channelO -$ !I -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ !I -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read.n -$ chan = f$extract (0, f$locate(" ", line), line)a -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then -a - goto list_loop -$ ! Found at least one to try.g -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name'e -$ define PMDF_DEVICE TTa -$ !* -$ ! Define other logical names -$ !n -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ !t -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ !e -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. -n - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ !r -$ ! Run master to deliver the mails -$ !i -$ run pmdf_root:[exe]mastery -$ exit_stat = $statuse -$ !* -$ ! Activate optional cleanup script to reset terminal/modem -$ !r -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then -' - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TTo -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection.s -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list:= -$ close pmdf_data. -$ !h -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism.. -$ !i -$ if cnt .gt. 0 then goto out_phonenet -$ !h -$ regular_master:; -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TTd -$ !e -$ ! Define logical namesg -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master* -$ exit_stat = $statusL -$ ! -$ ! Activate optional cleanup script to reset terminal/modemm -$ !; -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat'd -$ deallocate TT -$ deassign TTr -$ deassign PMDF_DEVICE -$ !d -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30N -$ goto out1 -$ ! -$ ! Directory channele -$ !: -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_masterl -$ goto out1 -$ !p -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel:o -$ !l -$ ! Define other logical names -$ !] -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1I -$ !S -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ !E -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1) -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ !a -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gatewaye -$ goto out1 -$ !a -$ ! This is a BULLETIN channel; use BULLETIN_MASTERr -$ ! -$ BULLETIN_channel: -$ !L -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTERt -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1l -$ !_ -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel:. -$ !u -$ run pmdf_root:[exe]ctcp_master -$ goto out1R -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTERq -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ !f -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ !o -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ !j -$ MTCP_channel: -$ !e -$ run pmdf_root:[exe]mtcp_master -$ goto out1o -$ !s -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ !A -$ ETCP_channel:f -$ !t -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ !f -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ !' -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1p -$ !l -$ CN_channel:e -$ !c -$ ! Define other logical names -$ !e -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277q -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_mastera -$ goto out1 -$ !g -$ KER_channel: -$ !n -$ ! kermit protocol is slave only. If we get here there has been a mistake.o -$ ! however we will just exit and no harm done. -$ goto out1" -$ !D -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ !o -$ PX25_channel:c -$ != -$ ! Define other logical names -$ !- -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ !c -$ run pmdf_root:[exe]PX25_master -$ goto out1n -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTERN -$ !a -$ UUCP_channel:a -$ !4 -$ ! Define other logical names -$ !t -$ uucp_to_host = channel_name - "uucp_"n -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmpc -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfilen -$ !. -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll". -$ uupoll 'uucp_to_host'_ -$ goto out1f -$ !t -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ !f -$ XSMTP_channel: -$ !m -$ run pmdf_root:[exe]xsmtp_mastera -$ goto out1e -$ !t -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ !a -$ DSMTP_channel: -$ !q -$ run pmdf_root:[exe]dsmtp_master -$ goto out1t -$ !c -$ ! Handle delivery on the local channel, MAIL_ channels, anda -$ ! the DECnet compatibility channel -$ !t -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel:g -$ open/read queue_file 'dirlst_file' -$ local_loop:q -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list)) -$ goto local_loopn -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1n -$ !t -$ ! This is a SMTP test channel, use TEST_SMTP_MASTERo -$ !i -$ TEST_channel:s -$ !e -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1l -$ ! -$ out1: -$ delete 'dirlst_file';* -$ !t -$ ! Common exit point - clean up things first -$ !f -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_datan -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT. -$ deassign TTt -$ deassign PMDF_DEVICE -$ restore: -$ !_ -$ ! Restore saved stufft -$ !a -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ !s -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel] -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87e -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988e -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminatel -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988l -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988_ -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DATe -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT tot -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters:a -$ !c -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed./ -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTERT -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod : -$copy sys$input PMDF.TXT -$deck -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETINa -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it asa -follows: m - - LINK BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB,] - -and put the .EXE in PMDF_ROOT:[EXE]. Put the new MASTER.COM in PMDF_ROOT:[EXE]._ - -You then need a channel definition like the following in your configurationa -file PMDF.CNF: - - bull_local single master logging - BULLETIN-DAEMONa - -And a rewrite rule of the form:n - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON_ - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletinT - tex-hax: tex-hax@bulletinb - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletinn - jnet-l: jnet-l@bulletinI - policy-l: policy-l@bulletinr - future-l: future-l@bulletin - mon-l: mon-l@bulletinT - ug-l: ug-l@bulletinM - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders. After -doing so, restart BULLCP using BULLETIN/START. -$eod n diff --git a/decus/lt87a/bulletin/.listing b/decus/lt87a/bulletin/.listing deleted file mode 100644 index c2daac8fb97925ac05bbb8a91c27c8f61fdd0ae9..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 928 zcmZQzFko=>^Y@GN^$!iUiZ%cPy|7>d0}FFKpAZXkM?H6ES3RdtA0O8cPd@`gW5ZYm z24@DRP#;GhA74l3U_D>QAZtSfC@?fsFf!8h3iZ=9w6ri+FtD^Tv`~mP)G>@z&| z_{ap^6k`liObENh6wMSYp-Y61%+O6SLU)T1!Bpqz=ji9B7ZMQyPkM%?3Wk=59AIc> rWn_rUM+^*d3?ca?i8%`SX$po$3T~M>sl_@9W`@QJPC5C>*~NMQ|E0~k diff --git a/decus/lt87a/bulletin/bulallmacs.mar b/decus/lt87a/bulletin/bulallmacs.mar deleted file mode 100644 index 0528b62..0000000 --- a/decus/lt87a/bulletin/bulallmacs.mar +++ /dev/null @@ -1,204 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 21:04 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: ALLMACS.MAR - -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - .END diff --git a/decus/lt87a/bulletin/bullcoms.hlp b/decus/lt87a/bulletin/bullcoms.hlp deleted file mode 100644 index cc4b600..0000000 --- a/decus/lt87a/bulletin/bullcoms.hlp +++ /dev/null @@ -1,601 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 20:55 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: BULLCOMS.HLP - -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users. If specified, message -is both stored and broadcasted to all users logged in at the time. -See also /ALL and /BELL. -2 /EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /FOLDER=foldername -Specify the folder into which the message is to be added. -2 /NODES=(nodes[,...]) -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. -2 /PERMANENT -This option is restricted to privileged users for the GENERAL folder, -but available to all in other folders. If specified, message will be a -permanent message and will never expire. -2 /SHUTDOWN -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to the general message file. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the general folder and displayed in full as a system -message when a user logs in. System messages should be as brief as possible -to avoid the possibility that system messages could scroll off the screen. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 BACK -Displays the message preceding the current message. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped seperately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically selected -(see information on SELECT command). The commands that can be used to -modify the folder's characteristics are: SET ACCESS, SET BBOARD, REMOVE. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the folder -is stored in a file name created with the folder name). -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. -1 CURRENT - -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. - - Format: - DELETE [message-number] - -The message's relative number is found by the DIRECTORY command. -2 /NODES=(nodes[,...]) -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. -2 /SUBJECT=subject -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message. -It can be a substring of the subject. This is in case you have forgotten -the exact subject that was specified. Case is not critical either. -You will be notified if the deletion was successful. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting messages -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. -2 /FOLDERS -Lists the available message folders. -2 /SINCE=date -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START=start-point -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified. - - Format: - FILE file-name -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 Folders -All messages are divided into separate folders. The default folder is -GENERAL, in which also is stored SYSTEM messages. New folders can be -created by any user. As an example, the following creates a folder for -GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that -user will be alerted of topics of new messages at login time, and will -then be given the option of reading them. Note, however, that the display -of topics of new GENERAL folders is not controlled by this command, and -that READNEW is the default for the GENERAL folder. - -Instead of SET READNEW, SET BRIEF can be specified, which will only cause -a brief message upon logging in indicating there are new message in the -specified folder. Additionally, a user can be immediately alerted when a -new message has been added to a folder by the SET NOTIFY command. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controller by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in the -folder, but only those give access can add messages. -1 HELP -To obtain help on any topic, type: - - HELP topic -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name - -The input for the recipient name is exactly the same format as used by -the MAIL utility. -2 /SUBJECT - - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MODIFY -Modifies the database information for the current folder. Only the owner -of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. -2 /NAME - - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - - /OWNER=username - -Specifies a new owner for the folder. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The PRINT command can take optional qualifiers. - - Format: - - PRINT -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /QUEUE=queue-name -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder will -be displayed. However, if there are new messages, the first new message -will be displayed. Each time you enter the command, the next page, or if -there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply hitting -the key is equivalent to "READ". -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE=date -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged -user can remove the folder. - - Format: - REMOVE folder-name -1 REPLACE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. If the text of the message -is to be changed, a file can be specified which contains the text. -Otherwise, you will be promptted for the text. The expiration info and -header can also be changed. If neither no qualifiers are added to the -command, it is assumed the whole message will be replaced. - - Format: - REPLACE [file-name] -2 /EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION -Specifies that the message expiration date is to be replaced. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. This only applies to the GENERAL folder. -2 /HEADER -Specifies that the message header is to be replaced. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER=n -Specifies the message number to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN -Specifies that the message is to expire after the next computer -shutdown. This only applies to general or system messages. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and only applies to the GENERAL folder. -2 /TEXT -Specifies that the message text is to be replaced. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. If the owner of the -message is not a valid user, it is assumed that the message was from -a network, and the message is searched for a line starting with "From:". -The username is then extracted from that line, and the necessary mail -routine to send over the network is invoked. -2 /SUBJECT - - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing -the first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -message searches for the given search-string in the currently -selected folder. The search starts from the beginning of the -messages in the current folder. If a "search-string" is not -specified, a search is made for the previously specified string, -starting after the message you are currently reading (or have just -read). -2 /START - - /SUBJECT=message number - -Specifies the message number to start the search at. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [folder-name] - -Omitting the folder name will select the default general messages. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id [folder-name] - -The parameter "id" is the id in the system Rights Database to which -access is being affected. For more infomation concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created -by use of ACLs. If a user is able to set his process's privileges -to override ACLs, that user will be able to access the folder even if -access has not been granted via BULLETIN. Also note that if a user -logs in after a private folder has been created but before being -given access, and then is given access, any defaults that the folder -has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that user. -This is because if the id is not a username, it becomes an extremely -lengthy operation to check each user to see if have that id assigned -to them. The alternative is to set the defaults for all users after -every SET ACCESS, but that might cause problems with users who have -manually reset those defaults. The correct solution requires a large -programming modification, which will be done in a later version. -3 /ALL -Specifies that access to the folder is granted to all users, in other -words the folder is made no longer private. /ALL is specified in -place of the id name after the SET ACCESS command: - SET ACCESS /ALL [folder-name] -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have it's own BBOARD. If -no folder is selected, the general message file is modified. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSTEM privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. - - Format: - - SET BBOARD [username] -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes it's input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time and -avoids creating subprocesses. (Useful if input is digest format.) -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. This cannot be specified for -the GENERAL folder. The BRIEF setting contrasts with the READNEW -setting, which causes a listing of the description of the new messages -to be displayed and prompts the user to read the messages. Setting -BRIEF will clear a READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [folder-name] -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will -not occur if DISMAIL is set for an old account. Additionally, removing -the DISMAIL flag will not automatically enable LOGIN. (The reason for -the above was to avoid extra overhead for constant checking for the -DISMAIL flag.) - - Format: - - SET [NO]LOGIN [username] -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -2 PRIVILEGES -Specifies the privileges that are necessary to use privileged commands. -Use the SHOW PRIVILEGES command to see what privileges are presently set. -This is a privileged command. - - Format: - - SET PRIVILEGES privilege-list - -Privilege-list is the list of privileges seperated by commas. -To remove a privilege, specify the privilege preceeded by "NO". -2 READNEW -Controls whether you will be prompted upon logging in if you wish to read -new non-system or folder messages (if any exist). The default is that you -are prompted. In order to apply this to a specific folder, first select -the folder (using the SELECT command), and then enter the READNEW command. -For messages in folders other than the GENERAL folder, both prompting -and display of topics of new messages are controlled by this command. - - Format: - - SET [NO]READNEW -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -1 SHOW -The SHOW command displays information about certain characteristics. -2 BRIEF -Shows whether BRIEF has been set for this folder. (See HELP SET BRIEF). -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected via -the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Controls whether the access list and the BBOARD information for the -folder is displayed. This infomation is only those who have access to -that message. -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 NOTIFY -Shows whether NOTIFY has been set for this folder. (See HELP SET NOTIFY). -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. -2 READNEW -Shows whether READNEW has been set for this folder. (See HELP SET READNEW). diff --git a/decus/lt87a/bulletin/bullet.com b/decus/lt87a/bulletin/bullet.com deleted file mode 100644 index a0131f7..0000000 --- a/decus/lt87a/bulletin/bullet.com +++ /dev/null @@ -1,864 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 21:00 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: BULLET.COM - -$set nover -$copy sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLFILES.INC must first - be modified before this procedure is run. It contains the names of data files - which BULLETIN creates. It also includes specifications of directories used - by the FOLDER and BBOARD features. (In relation to the FOLDER feature, you - can restrict FOLDER creation to privileged users. See BULLCOM.CLD). - You should also look at BULLFOLDER.INC, as there may be some parameters in - that you may or may not want to modify. - - (NOTE: If you are simply receiving the objects, you should use the procedure - CREATE_NOFORT.COM. The objects have have been compiled to use the directory - BULLETIN$ for all data files. You should define this as a system logical - name pointing to the directory which you plan to use, i.e. $ DEFINE/SYSTEM - BULLETIN$ USRD$:[BULLETIN] . You should also include this definition in - BULLSTART.COM, which is mentioned below.) - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, and wish the RESPOND command to be able - to send messages to the originators of these messages, you must modify - the subroutine RESPOND in BULLETIN2.FOR in order to specify the mail - utility which you use to send mail over those networks. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL$HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the comands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Also note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new emssages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It simply installs the BULLETIN utility with correct privileges. - -5) BULLETIN.COM - If one wants the feature of using BULLETIN between DECNET nodes, - this file must be put in each node's DECNET default user's directory - (usually [DECNET]). Once this is done, the /NODE qualifer for the - ADD command can be used. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. - -6) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -7) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. -$eod -$copy sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULLETIN$:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULLETIN$:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULLETIN$: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 6/16/87 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER BULLETIN_NUMBER - QUALIFIER ORIGINAL - DISALLOW FOLDER AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER SEMIPRIVATE, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DEFINE VERB CURRENT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND NODES - DEFINE VERB DIRECTORY - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW START AND SINCE - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,TYPE=$REST_OF_LINE) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER BULLETIN_NUMBER - QUALIFIER NODES - QUALIFIER ORIGINAL - DISALLOW FOLDER AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DEFINE VERB REPLACE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - DEFINE TYPE SET_OPTIONS - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_FLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_FLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD BRIEF, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NOTIFY, SYNTAX=SHOW_FLAGS - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD READNEW, SYNTAX=SHOW_FLAGS - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER -$eod -$copy sys$input BULLDIR.INC -$deck - COMMON /BULL_DIR/ DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME - & ,SYSTEM,BLOCK,NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*8 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - LOGICAL SYSTEM - - CHARACTER*116 BULLDIR_COM ! This value + 12 must be - EQUIVALENCE (DESCRIP,BULLDIR_COM) ! divisable by 4 -$eod -$copy sys$input BULLETIN.COM -$deck -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -$eod -$copy sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -There is a feature which allows adding GENERAL non-system and system -messages to other DECNET nodes from within the BULLETIN the utility (see -the ADD command). All information about the message, such as expiration -date, are transferred to the host, thus making it more flexible than the -BBOARD method of adding messages. Deletion of messages is also -possible across DECNET. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -$eod -$copy sys$input BULLETIN.LNK -$deck -$ LINK/NOTRACE BULLETIN,BULLETIN0,BULLETIN1,BULLETIN2,BULLETIN3,- -BULLETIN4,BULLETIN5,BULLETIN6,- -BULLCOM,BULLMAIN,ALLMACS,SYS$SYSTEM:SYS.STB/SEL -$eod -$copy sys$input BULLFILES.INC -$deck -C -C THE FIRST 2 FILES ARE FILES CREATED AND USED BY BULLETIN. -C SPECIFY THE DEVICE/DIRECTORY IN WHICH YOU DESIRE THAT THEY BE KEPT. -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THIS DIRECTORY MUST BE GIVEN WORLD READ/WRITE ACCESS, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU ALSO MAY HAVE -C TO INCREASE SOME SUBPROCESS SYSTEM PARAMETERS: PQL_DPGFLQUOTA AND -C PQL_DWSQUOTA MAY HAVE TO BE CHANGED. (10000 AND 500 ARE TYPICAL). -C - COMMON /FILES/ BULLDIR_FILE,BULLETIN_FILE,BULLUSER_FILE - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - CHARACTER*80 BULLUSER_FILE /'BULLETIN$:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULLETIN$:BULLFOLDER.DAT'/ - CHARACTER*80 FOLDER_DIRECTORY /'BULLETIN$:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULLETIN$:'/ -C -C THE FOLLOWING 2 FILES ARE OBSOLETE AS OF V1.1 AND NO LONGER HAVE TO -C BE SPECIFIED. BULLETIN NOW TREATS THE GENERAL FOLDER AS ANY OTHER -C FOLDER. NEW USERS SHOULD JUST LEAVE THEM ALONE. HOWEVER, USERS -C USING OLDER VERSIONS STILL HAVE TO SPECIFY THEM IN ORDER THAT -C BULLETIN KNOWS THE NAMES IN ORDER TO RENAME THEM. -C - CHARACTER*80 BULLDIR_FILE /'BULLETIN$:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULLETIN$:BULLETIN.DAT'/ -$eod -$copy sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8)' - PARAMETER FOLDER_RECORD = 153 - - COMMON /BULL_FOLDER/ FOLDER_SET,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER,FOLDER_NUMBER,FOLDER_FILE, - & FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - COMMON /BULL_FOLDER1/ FOLDER1_OWNER,FOLDER1_DESCRIP, - & FOLDER1,FOLDER1_NUMBER,FOLDER1_FILE, - & FOLDER1_BBOARD,FOLDER1_BBEXPIRE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - - CHARACTER*120 FOLDER_COM - EQUIVALENCE (FOLDER1_OWNER,FOLDER_COM) -$eod -$copy sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - QUALIFIER BBOARD - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER LOGIN - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT -$eod -$copy sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXIT -$eod -$copy sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. -$eod -$copy sys$input BULL_COMMAND.COM -$deck -$B:=$PFCVAX$DBC1:[MRL.BULLETIN]BULLETIN.EXE;13 -$ON ERROR THEN GOTO EXIT -$ON SEVERE THEN GOTO EXIT -$ON WARNING THEN GOTO EXIT -$B/'F$PROCESS()' -$EXIT: -$LOGOUT -$eod -$copy sys$input CREATE.COM -$deck -$ FORTRAN/EXTEND BULLETIN -$ FORTRAN/EXTEND BULLETIN0 -$ FORTRAN/EXTEND BULLETIN1 -$ FORTRAN/EXTEND BULLETIN2 -$ FORTRAN/EXTEND BULLETIN3 -$ FORTRAN/EXTEND BULLETIN4 -$ FORTRAN/EXTEND BULLETIN5 -$ FORTRAN/EXTEND BULLETIN6 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ @BULLETIN.LNK -$eod -$copy sys$input CREATE_NOFORT.COM -$deck -$! -$! CREATE_NOFORT.COM -$! Command procedure to create bulletin executable without fortran compiler. -$! -$ RUN ASC2BIN -BULLETIN.ASC -BULLETIN.BAK -$ BACKUP BULLETIN.BAK/SAVE */NEW -$ RUN ASC2BIN -BULLSUB0.ASC -BULLSUB0.BAK -$ BACKUP BULLSUB0.BAK/SAVE */NEW -$ RUN ASC2BIN -BULLSUB1.ASC -BULLSUB1.BAK -$ BACKUP BULLSUB1.BAK/SAVE */NEW -$ RUN ASC2BIN -BULLSUB2.ASC -BULLSUB2.BAK -$ BACKUP BULLSUB2.BAK/SAVE */NEW -$ RUN ASC2BIN -BULLSUB3.ASC -BULLSUB3.BAK -$ BACKUP BULLSUB3.BAK/SAVE */NEW -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ @BULLETIN.LNK -$ WRITE SYS$OUTPUT "You can now delete all the .BAK and .ASC files." -$eod -$copy sys$input INSTALL.COM -$deck -$ COPY BULLETIN.EXE SYS$SYSTEM: -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/DEL -SYS$SYSTEM:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL$HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL$HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy sys$input LOGIN.COM -$deck -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! If you wish bulletins to be displayed upon logging in starting with -$! oldest rather than newest, change BULLETIN/LOGIN to BULLETIN/LOGIN/REVERSE. -$! -$ BULL*ETIN :== $SYS$SYSTEM:BULLETIN -$ BULLETIN/LOGIN -$eod -$copy sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod diff --git a/decus/lt87a/bulletin/bulletin.for b/decus/lt87a/bulletin/bulletin.for deleted file mode 100644 index 1339759..0000000 --- a/decus/lt87a/bulletin/bulletin.for +++ /dev/null @@ -1,973 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 21:01 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: BULLETIN.FOR - -C -C BULLETIN.FOR, Version 6/10/87 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C NOTES: See BULLETIN.TXT for general info. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*11 UPTIME_DATE - CHARACTER*8 UPTIME_TIME - CHARACTER*64 HELP_DIRECTORY - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT) - LEN = 1 - DO WHILE (LEN.GT.0) - LEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (LEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(LEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(1:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))//FOLDER - -C -C Test for /LOGIN switch. -C NOTE: /READ has been replaced by the SET READNEW command. -C - - CALL LIB$GET_FOREIGN(INCMD) - - IER = CLI$DCL_PARSE('BULLETIN'//INCMD,BULLETIN_MAINCOMMANDS) - - READIT = 0 - LOGIT = 0 - IF (CLI$PRESENT('LOGIN')) LOGIT = 1 ! Test for /LOGIN switch. - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - END IF - -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - CALL OPEN_FILE_SHARED(2) ! Open directory file - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - CALL CLOSE_FILE(1) - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0) THEN ! Do shutdown bulletins exist? - CALL GET_UPTIME(UPTIME_DATE,UPTIME_TIME) - IER1 = COMPARE_DATE(SHUTDOWN_DATE,UPTIME_DATE) - IF (IER1.EQ.0) IER1 = COMPARE_TIME(SHUTDOWN_TIME,UPTIME_TIME) - IF (IER1.LE.0) SHUTDOWN = 0 - ELSE - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_FILE(4) ! Create user file to be able to set - CALL CLOSE_FILE(4) ! defaults, privileges, etc. - END IF - CALL CLOSE_FILE(2) - - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - CALL GETSTS(STS) ! Get process status word - - IF (LOGIT.GT.0) THEN ! If BULLETIN/LOGIN then - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - END IF - - IF ((STS.AND.PCB$M_NETWRK).GT.0) THEN - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - ELSE - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - END IF - - CALL ASSIGN_TERMINAL ! Assign terminal - -C -C Get page length for the terminal. -C - - CALL GETPAGLEN(PAGE_LENGTH) - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIT.GT.0) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL UPDATE_READ(NEW_GENERAL_BULL) ! Update last read time - DO FOLDER_NUMBER = 1,FOLDER_MAX - IF (TEST2(NEW_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (TEST2(NEW_FLAG,FOLDER_NUMBER)) THEN - IF (NBULL.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - ELSE - CALL CHANGE_FLAG(0,1) - END IF - END IF - ELSE ! Can't select the folder - CALL CHANGE_FLAG(0,2) ! then clear SET_FLAG - END IF - END IF - END DO - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (NEW_GENERAL_BULL) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new general messages.'')') - ELSE - BULL_POINT = 0 - END IF - END IF - ELSE ! READNEW mode. - READ_DONE = -1 - DO FOLDER_NUMBER = 0,FOLDER_MAX - IF (TEST2(NEW_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - IF (FOLDER_NUMBER.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE - SAVE_BULL_POINT = BULL_POINT - CALL READNEW - IF (BULL_POINT.NE.SAVE_BULL_POINT - & .AND.READ_DONE.EQ.-1) READ_DONE = FOLDER_NUMBER - END IF - ELSE ! If really no new messages, - CALL CHANGE_FLAG(0,1) ! then clear NEW_FLAG - END IF - ELSE ! Can't select the folder - CALL CHANGE_FLAG(0,2) ! then clear SET_FLAG - END IF - END IF - END DO - IF (READ_DONE.GE.0) THEN - IF (READ_DONE.EQ.0) CALL UPDATE_READ(NEW_GENERAL_BULL) - DO FOLDER_NUMBER = 0,FOLDER_MAX - IF (TEST2(NEW_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(0,1) ! Clear NEW_FLAG - END IF - END DO - END IF - CALL EXIT - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - - MAIL_STATUS = 1 - - DO WHILE (1) - - IF (MAIL_STATUS) THEN - CALL GET_INPUT_PROMPT(INCMD,IER, - & COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - ELSE - CALL GET_INPUT_PROMPT(INCMD,IER, - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - MAIL_STATUS = 0 - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(1:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9') - IER = IER - 1 - END DO - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - - CALL CLI$GET_VALUE('$VERB',INCMD) ! Get the VERB command - IF (READ_ONLY.AND.(INCMD(1:3).EQ.'ADD'.OR.INCMD(1:3).EQ.'DEL' - & .OR.INCMD(1:3).EQ.'REP')) THEN ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(1:3).EQ.'ADD') THEN ! ADD bulletin command? - CALL ADD ! Go add bulletin - ELSE IF (INCMD(1:4).EQ.'BACK') THEN ! BACK command? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(1:4).EQ.'COPY') THEN ! COPY command? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(1:4).EQ.'CREA') THEN ! CREATE command? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(1:4).EQ.'CURR') THEN ! CURRENT command? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(1:4).EQ.'DELE') THEN ! DELETE command? - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(1:4).EQ.'DIRE') THEN ! DIRECTORY command? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(1:4).EQ.'FILE'.OR. - & INCMD(1:4).EQ.'EXTR') THEN ! FILE command? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(1:1).EQ.'E'.OR. - & INCMD(1:4).EQ.'QUIT') THEN ! EXIT command? - GO TO 999 ! Exit from program - ELSE IF (INCMD(1:4).EQ.'HELP') THEN ! HELP command? - IER = LIB$SYS_TRNLOG('BULL$HELP',LEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - LEN = 9 - END IF - CALL HELP(HELP_DIRECTORY(1:LEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(1:4).EQ.'LAST') THEN ! LAST command? - READ_COUNT = -1 - BULL_READ = 99999 - CALL READ(READ_COUNT,BULL_READ) - ELSE IF (INCMD(1:4).EQ.'MAIL') THEN ! MAIL command? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(1:3).EQ.'MOD') THEN ! MODIFY command? - CALL MODIFY_FOLDER - ELSE IF (INCMD(1:4).EQ.'MOVE') THEN ! MOVE command? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(1:4).EQ.'NEXT') THEN ! NEXT command? - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(1:4).EQ.'PRIN') THEN ! PRINT command? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(1:4).EQ.'READ') THEN ! READ command? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(1:3).EQ.'REM') THEN ! REMOVE command? - CALL REMOVE_FOLDER - ELSE IF (INCMD(1:3).EQ.'REP') THEN ! REPLACE command? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(1:3).EQ.'RES') THEN ! RESPOND command? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(1:3).EQ.'SEA') THEN ! SEARCH command? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(1:3).EQ.'SEL') THEN ! SELECT command? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(1:3).EQ.'SET') THEN ! SET command? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(1:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(1:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOT') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(1,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,4) - END IF - ELSE IF (BULL_PARAMETER(1:3).EQ.'NON') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(0,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (BULL_PARAMETER(1:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(1:2).EQ.'BR') THEN ! SET BRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET BRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,1) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(1,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(1:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOBRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(1:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(1:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(1:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOL') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(1:1).EQ.'P') THEN ! SET PRIVILEGES? - CALL SET_PRIV - END IF - ELSE IF (INCMD(1:4).EQ.'SHOW') THEN ! SHOW command? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(1:1).EQ.'B') THEN ! SHOW BRIEF? - CALL SHOW_BRIEF - ELSE IF (BULL_PARAMETER(1:1).EQ.'F') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(1:2).EQ.'NE') THEN ! SHOW NEW? - DO FOLDER_NUMBER = 0,FOLDER_MAX - IF (TEST2(NEW_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER).AND.NBULL.GT.0) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - END DO - ELSE IF (BULL_PARAMETER(1:2).EQ.'NO') THEN ! SHOW NOTIFY? - CALL SHOW_NOTIFY - ELSE IF (BULL_PARAMETER(1:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(1:1).EQ.'R') THEN ! SHOW READNEW? - CALL SHOW_READNEW - END IF - END IF - -100 CONTINUE - - END DO - -999 DO FOLDER_NUMBER = 0,FOLDER_MAX - IF (TEST2(NEW_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(0,1) ! Clear NEW_FLAG - END IF - END DO - - CALL EXIT - - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - CHARACTER INEXDATE*11,INEXTIME*8 - CHARACTER*80 INDESCRIP,INPUT - - INTEGER TIMADR(2) - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - - CHARACTER*80 INLINE - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - EXTERNAL CLI$_ABSENT - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN (UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET? - USERNAME = DEFAULT_USER - CALL CONFIRM_PRIV(USERNAME,ALLOW) - END IF - - IF (FOLDER_SET.AND. ! If folder set and - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST switch present? - & CLI$PRESENT('SHUTDOWN').OR. ! Is /SHUTDOWN switch present? - & CLI$PRESENT('NODES'))) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: Invalid parameter used with folder set.'')') - RETURN - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - RETURN ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - RETURN ! and abort - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privileges - WRITE(ERROR_UNIT,1081) ! Tell user - RETURN ! and abort - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - RETURN ! and abort - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IF - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - OLD_FOLDER_NUMBER = FOLDER_NUMBER - CALL SELECT_FOLDER(.TRUE.,IER) - IF (.NOT.IER) RETURN - END IF - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(1:11) - INEXTIME = INPUT(13:20) - END IF - - LENDES = 54 - DO WHILE (LENDES.GT.53) ! Do until valid description - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fit - END IF - END DO - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - - IF (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IF - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) LEN,INPUT ! get record count - IF (LEN.GT.80) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(LEN,80) - IF (LEN.EQ.0) ICOUNT = ICOUNT + 1 ! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Sratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 81 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,LEN) ! Get input line - IF (LEN.GT.80) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > 80. Reinput:'')') - ELSE IF (LEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + LEN ! Increment record count - IF (LEN.EQ.0) ICOUNT = ICOUNT + 1 - WRITE(3,2010) INPUT(1:LEN) ! Save line in scratch file - END IF - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - IF (NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(1:LEN_INLINE) - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolons - LEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Are semicolon found? - IF (LEN.GT.SEMI+1) THEN ! Is username found? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes - LEN = SEMI - 1 ! Remove semicolons - ELSE ! No username found... - TEMP_USER = DEFAULT_USER ! Set user to default - LEN = SEMI - 1 ! Remove semicolons - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons present - TEMP_USER = DEFAULT_USER ! Set user to default - END IF - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (STR$POSITION(PASSWORD,CHAR(13)).LE.1) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:LEN)// - & '"'//TEMP_USER(1:TRIM(TEMP_USER))//' '// - & PASSWORD(1:STR$POSITION(PASSWORD,CHAR(13))-1)//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1) - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(1:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) LEN,INPUT - LEN = MIN(LEN,80) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(1:LEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (.NOT.LOCAL_NODE_FOUND) GO TO 95 ! Was local node specified? - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - DESCRIP=INDESCRIP(1:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - LENGTH = (ICOUNT+127)/128 ! Number of records - FROM = USERNAME ! Username - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_FILE(2) ! Totally finished with add - -C -C Broadcast the bulletin if requested. -C - - IF (CLI$PRESENT('BROADCAST')) THEN ! Should we broadcast the bull? - REWIND (UNIT=3) ! Yes, rewind the input file - IF (CLI$PRESENT('BELL')) THEN ! Include BELL in message? - BROAD(1:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - START = 37 ! Start adding next line here - ELSE - BROAD(1:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - START = 35 ! Start adding next line here - END IF - NBLANK = 0 - END = 0 - DO WHILE (ICOUNT.GT.0) ! Stuff bulletin into string - READ(3,'(Q,A)') LEN,INPUT ! Read input line - ICOUNT = ICOUNT - LEN - 1 - IF (LEN.EQ.0) THEN - NBLANK = NBLANK + 1 ! Count number of blank lines - ICOUNT = ICOUNT - 1 ! ICOUNT counts blank line as one space - ELSE ! Ignore blank liness at start or end of message - IF (NBLANK.GT.0.AND.END.GT.0) THEN - END = START + NBLANK*2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) GO TO 90 ! String too long? - DO I=1,NBLANK - BROAD(START:START+1) = CR//LF - START = START + 2 - END DO - END IF - NBLANK = 0 - END = START + LEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) GO TO 90 ! String too long? - BROAD(START:END) = CR//LF//INPUT(1:LEN)! Else add new input - START = END + 1 ! Reset pointer - END IF - END DO -90 IF (CLI$PRESENT('ALL')) THEN ! Should we broadcast to ALL? - CALL SYS$BRKTHRU - & (,BROAD(1:START-1)//CR,,%VAL(BRK$C_ALLTERMS),,,,,,,) - ELSE ! Else just broadcast to users. - CALL SYS$BRKTHRU - & (,BROAD(1:START-1)//CR,,%VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IF - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - CALL SELECT_FOLDER(.TRUE.,IER) - END IF - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be - & truncated to:') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanent - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END diff --git a/decus/lt87a/bulletin/bulletin0.for b/decus/lt87a/bulletin/bulletin0.for deleted file mode 100644 index 46027d0..0000000 --- a/decus/lt87a/bulletin/bulletin0.for +++ /dev/null @@ -1,928 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 20:58 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: BULLETIN0.FOR - -C -C BULLETIN0.FOR, Version 5/18/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER) - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL OPEN_FILE(2) - BULL_DELETE = 0 - IER = 1 - DO WHILE (BULL_DELETE+1.EQ.IER) - BULL_DELETE = BULL_DELETE + 1 - CALL READDIR(BULL_DELETE,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (BULL_DELETE+1.EQ.IER.AND.REMOTE_USER.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - GO TO 50 - END IF - END DO - CALL CLOSE_FILE(2) ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_FILE(2) - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(ERROR_UNIT,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(ERROR_UNIT,1040) ! Then error out. - GO TO 100 - ELSE - CALL CLOSE_FILE (2) - IF (.NOT.DECNET_PROC) THEN - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') GO TO 900 - END IF - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(ERROR_UNIT,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - -50 CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - CALL CLEANUP_DIRFILE(BULL_DELETE) ! Reorder directory file - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - CALL READDIR(0,IER) ! Get shutdown count - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - - CALL UPDATE ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (BULL_DELETE.LE.BULL_POINT) BULL_POINT = BULL_POINT - 1 - ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - -100 CALL CLOSE_FILE(2) - IF (DECNET_PROC) WRITE (5,'(''END'')') - ! Tell DECNET that delete went ok. -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - EXTERNAL CLI$_ABSENT - - CHARACTER START_PARAMETER*16,DATETIME*23,TODAY*11 - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_COM) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_FILE_SHARED(2) ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1) THEN ! If so, there are messages - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified? - IER = CLI$GET_VALUE('START',START_PARAMETER,LEN) - DECODE(LEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEN - DIR_COUNT = NBULL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_FILE(2) - DIR_COUNT = 0 - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE')) THEN ! Date specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$ASCTIM(,TODAY,,) ! Need to get date. - DATETIME = TODAY//' 00:00:00.0' - END IF - TEMP_COUNT = 0 - IER = 1 - DO WHILE (IER.EQ.TEMP_COUNT+1) - TEMP_COUNT = TEMP_COUNT + 1 - CALL READDIR(TEMP_COUNT,IER) - IF (IER.NE.TEMP_COUNT+1) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE(2) - RETURN - ELSE - DIFF = COMPARE_DATE(DATETIME(1:11),DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME) - IF (DIFF.LE.0) THEN - DIR_COUNT = TEMP_COUNT - IER = IER + 1 - END IF - END IF - END DO - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - IF (CLI$PRESENT('SINCE')) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-4) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-4) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1 - END IF - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - DO I=SBULL,EBULL ! Copy messages from file - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - END DO - ELSE - NBULL = 0 - END IF - - CALL CLOSE_FILE(2) ! We don't need file anymore - - IF (NBULL.EQ.0) THEN - WRITE (6,'('' There are no messages present.'')') - RETURN - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - WRITE(6,1000) ! Write header - DO I=SBULL,EBULL - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - WRITE(6,2010) I,DESCRIP(:52),FROM,DATE(1:7)//DATE(10:11) - END DO - - DIR_COUNT = EBULL + 1 ! Update directory counter - - IF (DIR_COUNT.GT.NBULL) THEN ! Outputted all entries? - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - -2010 FORMAT(1X,I4,1X,A52,1X,A12,1X,A9) - - END - - - SUBROUTINE FILE -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And return - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,1010) ! Write error - RETURN ! And return - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030) - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE - END IF - - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 90 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IF - END DO - LEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_POINT,BULL_PARAMETER(1:LEN_P) - ! Show name of file created. -100 CALL CLOSE_FILE(1) - RETURN - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 100 - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/) - - END - - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - CHARACTER TODAY*23,INPUT*80,INREAD*1 - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - DIMENSION H_NEW_FLAG(FLONG),H_SET_FLAG(FLONG),H_BRIEF_FLAG(FLONG) - DIMENSION NOLOGIN_BTIM(2),LOGIN_BTIM_SAVE(2),TODAY_BTIM(2) - DIMENSION DIR_BTIM(2),NEW_BTIM(2) - - CHARACTER*1 SEPARATE - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS$BINTIM(TODAY,TODAY_BTIM) - - CALL SYS$BINTIM('5-NOV-2956',NOLOGIN_BTIM) - CALL SYS$BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_FILE_SHARED(4) ! Open user file - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) TEMP_USER, - & NEWEST_BTIM,BBOARD_BTIM,H_NEW_FLAG,H_SET_FLAG, - & H_BRIEF_FLAG,NOTIFY_FLAG ! Get the header - END DO - - IF (IER.EQ.0) THEN ! Header is present. - DO WHILE (REC_LOCK(IER1)) - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER1) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG, - & BRIEF_FLAG,NOTIFY_FLAG ! Find if there is an entry - END DO - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).EQ.0) RETURN ! DISMAIL set - IF (IER1.EQ.0) THEN ! There is a user entry - REWRITE (4,FMT=USER_FMT) USERNAME,TODAY_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG ! Update login date - & ,NOTIFY_FLAG - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry - READ_BTIM(2) = NEW_BTIM(2) - DO I = 1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - SET_FLAG(I) = H_SET_FLAG(I) - BRIEF_FLAG(I) = H_BRIEF_FLAG(I) - END DO - CALL CHECK_DISMAIL(USERNAME,DISMAIL) - IF (DISMAIL.EQ.1) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,NOLOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - ELSE - WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,TODAY_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - END IF - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_FILE(4) ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - END IF - DO WHILE (REC_LOCK(IER2)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER2) TEMP_USER, - & NEWEST_BTIM,BBOARD_BTIM,H_NEW_FLAG,H_SET_FLAG, - & H_BRIEF_FLAG,NOTIFY_FLAG ! Reset read back to header - END DO - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - REWRITE (4,FMT=USER_FMT) TEMP_USER,NEWEST_BTIM, ! Rewrite header - & TODAY_BTIM,H_NEW_FLAG,H_SET_FLAG,H_BRIEF_FLAG,NOTIFY_FLAG - CALL CLOSE_FILE(4) - CALL CREATE_BBOARD_PROCESS - ELSE - CALL CLOSE_FILE(4) - IF (IER.NE.0) CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compare - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user. - - DIFF = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - - IF (DIFF.GT.0) THEN - BULL_POINT = -1 - RETURN - END IF - -C -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible. -C - - ENTRY LOGIN_FOLDER - - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - - CALL OPEN_FILE_SHARED(2) ! Yes, so go get bulletin directory - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - CALL READDIR(0,IER) ! Get header info - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_COM) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_COM) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - BULL_POINT = -1 - START = 1 - REVERSE = 0 - IF (CLI$PRESENT('REVERSE').AND. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - REVERSE = 1 - START = NBULL + 1 - IER = START + 1 - DIFF = 0 - IF (IER1.NE.0) THEN - START = 1 - ELSE - DO WHILE (START+1.EQ.IER.AND.DIFF.LE.0) - START = START - 1 - IF (START.GT.0) CALL READDIR(START,IER) - IF (START+1.EQ.IER) THEN - CALL SYS$BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - END IF - END DO - START = START + 1 - END IF - END IF - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - CALL READDIR(ICOUNT,IER) - IF (IER1.EQ.0) THEN ! Is this a totally new user? - ! No. Is bulletin system or from same user? - IF (.NOT.REVERSE) THEN - CALL SYS$BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM) - ELSE - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - END IF - END IF - ELSE ! Totally new user, save all messages - IF (SYSTEM) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM) - ELSE - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - END IF - END IF - END DO -100 CALL CLOSE_FILE(2) - IF (FOLDER_SET) NSYS = 0 -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (NGEN.EQ.0.AND.NSYS.EQ.0) RETURN - - IF (NSYS.GT.0) THEN ! Are there any system messages? - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,1026) CTRL_G ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_FILE_SHARED(1) - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM) - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin to SYS_BUL link list - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - CALL CLOSE_FILE(1) - RETURN - ELSE IF (LEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - END IF - END DO - LEN = 80 - END DO - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,80 - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - END IF - END DO - CALL CLOSE_FILE(1) - SYS_BUL = SYS_BUL1 - DO WHILE (SYS_BUL.NE.0) ! Write out the system messages - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO(INREAD) ! Get terminal input - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1065) INPUT(1:TRIM(INPUT)) - PAGE = 1 - ELSE - WRITE(6,1060) INPUT(1:TRIM(INPUT)) - PAGE = PAGE + 1 - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER) - S1 = (80-13-LENF)/2 - S2 = 80-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO(INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages',CTRL_G - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages',CTRL_G - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - DO I=1,NGEN - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - IF (PAGE.EQ.PAGE_LENGTH-2) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO(INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - ELSE - PAGE = PAGE + 1 - END IF - WRITE(6,1040) DESCRIP,FROM,DATE(:6),SYSTEM - ! Bulletin number is stored in SYSTEM - END DO - IF (FOLDER_NUMBER.GT.0.OR.(FOLDER_NUMBER.EQ.0.AND. - & BTEST(SET_FLAG(1),0))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set for - END IF ! GENERAL, as no prompt to read is generated. - END IF - IF (NGEN.EQ.0.OR. - & READIT.NE.0.OR.COMPARE_BTIM(READ_BTIM,NEW_BTIM).NE.0) THEN - WRITE(6,1030) - ELSE - LEN = 27 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (80-LEN)/2 - S2 = 80 - S1 - LEN - WRITE(6,1035) - & 'Type '//COMMAND_PROMPT(:LEN-27)//' to read new messages.' - END IF - - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',33('*'),'System Messages',32('*'),A1) -1027 FORMAT(/,' ',('*'),A,('*'),A1) -1028 FORMAT('+',('*'),A,('*'),A1) -1030 FORMAT(' ',80('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(' ',A53,1X,A12,1X,A6,1X,I4) -1060 FORMAT(1X,A) -1065 FORMAT('+',A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/,' HIT any key for next page....') - - END - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER*32 LOCAL_NODE - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - LEN = 0 ! GET_VALUE crashes if LEN<0 - DO WHILE (CLI$GET_VALUE('NODES',NODES(NODE_NUM+1),LEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - NODE_NUM = NODE_NUM + 1 - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - LEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addedd - END IF - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:LEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:LEN)//'""::' - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - - RETURN - END - - - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - LEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Is semicolon present? - IF (LEN.GT.SEMI+1) THEN ! Yes, is username after node? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - LEN = SEMI - 1 ! Remove semicolon - ELSE ! No username after nodename - TEMP_USER = DEFAULT_USER ! Set username to default - LEN = SEMI - 1 ! Remove semicolon - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolon present - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username was - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (STR$POSITION(PASSWORD,CHAR(13)).LE.1) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:LEN) - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '// - & PASSWORD(1:STR$POSITION(PASSWORD,CHAR(13))-1)//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END diff --git a/decus/lt87a/bulletin/bulletin1.for b/decus/lt87a/bulletin/bulletin1.for deleted file mode 100644 index 8ab2d03..0000000 --- a/decus/lt87a/bulletin/bulletin1.for +++ /dev/null @@ -1,1073 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 21:03 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: BULLETIN1.FOR - -C -C BULLETIN1.FOR, Version 6/3/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - LEN_I = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN_I.GT.0) - CALL GET_BULL(I,INPUT,LEN_I) - IF (LEN_I.LT.0) THEN - GO TO 90 - ELSE IF (LEN_I.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN_I) - END IF - END DO - LEN_I = 80 - END DO - -90 CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_FILE(1) - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - IF (MAIL_SUBJECT(1:1).NE.'"') THEN - MAIL_SUBJECT = '"'//MAIL_SUBJECT(1:LEN_D) - LEN_D = LEN_D + 1 - END IF - - IF (MAIL_SUBJECT(LEN_D:LEN_D).NE.'"') THEN - MAIL_SUBJECT = MAIL_SUBJECT(1:LEN_D)//'"' - LEN_D = LEN_D + 1 - END IF - - IER = CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER,LEN_P) - - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(1:LEN_P) - & //'/SUBJECT='//MAIL_SUBJECT(1:LEN_D),,,,,,STATUS) - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(1:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder owner.'')') - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(1:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_FILE(7) ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - END IF - - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=FOLDER,KEYID=0) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE - - IF (IER.EQ.0) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_FILE(7) - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - LOGICAL DELETE_ORIGINAL - - CHARACTER INPUT*80,SAVE_USERNAME*12 - - CHARACTER*116 BULLDIR_COM_SAVE - - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_FILE(2) - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - - CALL LIB$MOVC3(116,%REF(BULLDIR_COM),%REF(BULLDIR_COM_SAVE)) - SAVE_BULL_POINT = BULL_POINT - - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Scratch file to save bulletin - - CALL OPEN_FILE_SHARED(1) - - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 90 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IF - END DO - LEN = 80 - END DO - -90 REWIND (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - SAVE_USERNAME = USERNAME - IF (CLI$PRESENT('ORIGINAL')) THEN - IF (SETPRV_PRIV()) THEN - USERNAME = FROM - ELSE - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - END IF - END IF - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER.OR.READ_ONLY) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - CLOSE (UNIT=3) - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - USERNAME = SAVE_USERNAME - RETURN - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE(6,'('' ERROR: Message copy aborted.'')') - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CLOSE (UNIT=3) - END IF - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - CALL LIB$MOVC3(116,%REF(BULLDIR_COM_SAVE),%REF(BULLDIR_COM)) - - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - IF (BTEST(SYSTEM,2)) THEN ! Shutdown message? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND. - & .NOT.SETPRV_PRIV()) THEN ! Permanent? - WRITE (6,'('' ERROR: No privileges to add permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') FOLDER_BBEXPIRE - END IF - - FROM = USERNAME ! Specify owner - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_FILE(2) ! Totally finished with add - - CLOSE (UNIT=3) ! Close the input file - - WRITE (6,'('' Message has been copied to folder '',A)') - & FOLDER(1:TRIM(FOLDER))//'.' - - USERNAME = SAVE_USERNAME - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL) CALL DELETE - - RETURN - - END - - - - - SUBROUTINE PRINT -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*80 INPUT - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,1010) ! Write error - RETURN ! And return - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030) - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE - END IF - - LEN =81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.GT.0) WRITE(3,'(A)') INPUT(1:TRIM(INPUT)) - END DO - LEN = 80 - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,LEN) ! Get queue name - IF (LEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - LEN = 9 - END IF - - CALL ADD_2_ITMLST(LEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_FILE(1) - WRITE(6,1000) - CALL SYS_GETMSG(IER) - - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT('Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/) - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*11,DATETIME*23 - - LOGICAL SINCE,PAGE - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - IF (INCMD(1:4).EQ.'READ') THEN ! If READ command... - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - DATETIME = TODAY//' 00:00:00.0' - END IF - CALL OPEN_FILE_SHARED(2) - TEMP_READ = 0 - IER = 1 - DO WHILE (IER.EQ.TEMP_READ+1) - TEMP_READ = TEMP_READ + 1 - CALL READDIR(TEMP_READ,IER) - IF (IER.NE.TEMP_READ+1) THEN - WRITE (6,'('' No messages found past specified date.'')') - CALL CLOSE(2) - RETURN - ELSE - DIFF = COMPARE_DATE(DATETIME(1:11),DATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME) - IF (DIFF.LE.0) THEN - BULL_READ = TEMP_READ - IER = IER + 1 - END IF - END IF - END DO - IER = BULL_READ + 1 - SINCE = .TRUE. - END IF - END IF - - IF (.NOT.SINCE) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - CALL CLOSE_FILE(2) - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IF - - BULL_POINT = BULL_READ ! Update bulletin counter - - FLEN = TRIM(FOLDER) - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header info - WRITE(6,1050) DESCRIP - IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - WRITE(6,1065) FROM,DATE,'Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - WRITE(6,1065) FROM,DATE,'Permanent message' - ELSE - WRITE(6,1060) FROM,DATE,EXDATE//' '//EXTIME - END IF - -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - END = 4 ! Outputted 4 lines to screen - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - -100 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - IF (READ_COUNT.GT.BLOCK.AND.READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header info - END = END + 1 ! Increase display counter - END IF - CALL OPEN_FILE_SHARED(1) ! Get bulletin file - MORE_LINES = .TRUE. - READ_REC = READ_COUNT - IF (READ_ALREADY.EQ.0) LEN = 81 - DO WHILE (MORE_LINES.AND.READ_REC.LE.BLOCK+LENGTH-1) - DO WHILE (LEN.GT.0.AND.MORE_LINES) - CALL GET_BULL(READ_REC,INPUT,LEN) - IF (LEN.LT.0) THEN ! Error, couldn't read record - READ_REC = BLOCK + LENGTH ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (LEN.GT.0) THEN - LEN_TEMP = LEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - READ_ALREADY = 1 - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - LEN = 80 - IF (MORE_LINES) THEN - READ_REC = READ_REC + 1 - READ_ALREADY = 0 - END IF - END DO - - CALL CLOSE_FILE(1) ! End of bulletin file read - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) ! Get queue record - IF (I.EQ.1.AND.READ_REC.NE.BLOCK.AND.READIT.GT.0) THEN - WRITE(6,2020) INPUT(1:TRIM(INPUT)) ! (See above comments) - ELSE - WRITE(6,2010) INPUT(1:TRIM(INPUT)) - END IF - END DO - - READ_COUNT = READ_REC ! Update bull record counter - - IF (READ_REC.EQ.BLOCK+LENGTH) THEN ! Last block? - READ_COUNT = 0 ! init bulletin record counter - ELSE IF (READ_REC.EQ.BLOCK+LENGTH-1.AND..NOT.MORE_LINES) THEN - ! Possibly last block since end of page could be last line - CALL TEST_MORE_LINES(LEN) ! More lines to read? - IF (LEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Else if this is not /READ - WRITE(6,1070) ! say there is more of bulletin - END IF - - RETURN - -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT('+Message number: ',I4,<60-FLEN>X,A) -1050 FORMAT(' Description: ',A53) -1060 FORMAT(' From: ',A12,' Date: ',A11,' Expires: ',A20,/) -1065 FORMAT(' From: ',A12,' Date: ',A11,' ',A,/) -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) -2010 FORMAT(1X,A) -2020 FORMAT('+',A) - - END - - - - - - SUBROUTINE READNEW -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER INREAD*1,INPUT*80,FILE_DEF*80 - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - -C -C This subroutine is executed due to the BULLETIN/LOGIN command which is -C normally executed by a command procedure during login. In order to use -C LIB$GET_INPUT, we must redefine SYS$INPUT to the terminal (temporarily -C using user mode). -C - IF (ICHAR(INREAD).EQ.0) THEN - CALL CRELNM('SYS$INPUT','TT') - CALL PURGE_TYPEAHEAD - SLOW = SLOW_TERMINAL() - END IF - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - INREAD = '0' - TEMP_READ = 0 - DO WHILE (INREAD.GE.'0'.AND.INREAD.LE.'9') - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Make input upper case - IF (TEMP_READ.GT.0.AND.(INREAD.LT.'0'.OR.INREAD.GT.'9').AND. - & INREAD.NE.CHAR(13)) THEN - GO TO 1 - ELSE IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+Quit'',$)') - ELSE - WRITE (6,'(''+No'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE IF (INREAD.GE.'0'.AND.INREAD.LE.'9') THEN - TEMP_READ = TEMP_READ*10 + ICHAR(INREAD) - ICHAR('0') - WRITE (6,'(''+'',A1,$)') INREAD - END IF - END DO - - IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.BULL_POINT+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_FILE_SHARED(2) ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND.(SYSTEM)) THEN - BULL_POINT = BULL_POINT + 1 ! If system bulletin, skip it. - GO TO 10 - END IF - CALL CLOSE_FILE(2) - END IF - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - IF (READ_COUNT.EQ.BLOCK) THEN - WRITE(6,1030) 'TEXT' - ELSE - WRITE(6,1030) 'MORE' - END IF - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',LEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:LEN-1)//'.BULL]' - LEN_FILE_DEF = LEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_FILE_SHARED(2) - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),IOSTAT=IER,ERR=18, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 18 - ELSE IF (LEN.GT.0) THEN - WRITE(3,'(A)') INPUT(1:TRIM(INPUT)) - END IF - END DO - LEN = 80 - END DO - WRITE(6,1040) BULL_PARAMETER(1:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_FILE_SHARED(2) ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_FILE(2) ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM) THEN ! Else if NEXT bulletin SYSTEM - BULL_POINT = BULL_POINT + 1 ! Skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_FILE(2) - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),Q(Quit),message - & number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,80('-'),/, - &' Type Q(Quit), F(File it) or any other key for next message: ',$) -1030 FORMAT(1X,80('-'),/,' Type Q(Quit), F(File it), N(Next message), - & or any other key for ',A4,'... ',$) -1040 FORMAT(' Message written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/) - - END - - - - - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - PARAMETER UAF$V_DISACNT = 4 - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER) - IF (IER.AND..NOT.BTEST(FLAGS,UAF$V_DISACNT)) THEN ! DISUSER? - WRITE (6,' - & ('' ERROR: BBOARD account needs DISUSER flag set.'')') - IER = 0 - END IF - IF (IER) THEN - READ (7,FMT=FOLDER_FMT,KEY='GENERAL',KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - READ (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_FILE(7) - RETURN - ELSE - READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE - FOLDER_BBOARD = INPUT_BBOARD - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - END IF - ELSE - CALL CLOSE_FILE(7) - RETURN - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_FILE(7) - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_FILE(7) - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - REWRITE (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - CALL CLOSE_FILE(7) - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END diff --git a/decus/lt87a/bulletin/bulletin2.for b/decus/lt87a/bulletin/bulletin2.for deleted file mode 100644 index 8a6ecb5..0000000 --- a/decus/lt87a/bulletin/bulletin2.for +++ /dev/null @@ -1,961 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 20:59 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: BULLETIN2.FOR - -C -C BULLETIN2.FOR, Version 6/16/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: Replaces existing bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*8 - CHARACTER INDESCRIP*80,INPUT*80,TODAY*23 - CHARACTER*1 ANSWER - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT - - LOGICAL*1 DOALL - -C -C Get the bulletin number to be replaced. -C - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are reading - ELSE - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (FOLDER_SET.AND.CLI$PRESENT('SYSTEM')) THEN - WRITE (6,'( - & '' ERROR: Invalid parameter used with folder set.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (FOLDER_SET.AND.CLI$PRESENT('SHUTDOWN')) THEN - WRITE (6,'( - & '' ERROR: Invalid parameter used with folder set.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletin - - CALL CLOSE_FILE(2) - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person - RETURN ! and error out - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND. - & USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(1:11) - INEXTIME = INPUT(13:20) - END IF - -8 IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LEN,INDESCRIP - IF (LEN.EQ.0) GO TO 910 ! If no header, don't add bull - IF (LEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fit - GO TO 8 ! and re-request header - END IF - END IF - - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & CLI$PRESENT('EDIT').OR.EDIT_DEFAULT) THEN ! or /EDIT specified - - IF (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy mesage into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 5 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IF - END DO - LEN = 80 - END DO -5 CALL CLOSE_FILE(1) - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) LEN,INPUT ! get record count - IF (LEN.GT.80) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,LEN) - IF (LEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + LEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (LEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 80 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,LEN) ! Get input line - IF (LEN.GT.80) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > 80. Reinput::'')') - ELSE IF (LEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + LEN ! Increment character count - WRITE(3,'(A)') INPUT(1:LEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (LEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(1:LEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - INPUT = DESCRIP - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.INPUT.NE.DESCRIP) THEN - ! Message disappeared in the mean time? - CALL CLOSE_FILE(2) - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Message file info invalidated. - & Find message and do REPLACE again.'')') - GO TO 100 - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN ! If text has been replaced - - LENGTH_SAVE = LENGTH ! Copy BULL modifies LENGTH - - CALL OPEN_FILE(1) ! Prepare to add bulletin - ICOUNT = (ICOUNT+127)/128 - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - NBLOCK = NBLOCK + ICOUNT - - CALL WRITEDIR(0,IER) - - CALL COPY_BULL(3,REC1,BLOCK,IER) ! Replace old bulletin - - CALL CLOSE_FILE(1) - - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = ICOUNT ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (CLI$PRESENT('HEADER').OR.DOALL) DESCRIP=INDESCRIP(1:53) - ! Update description header - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (CLI$PRESENT('PERMANENT').AND. - & (.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00' - ELSE IF (CLI$PRESENT('SHUTDOWN').AND. - & (.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00' - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(1:11) - SHUTDOWN_TIME = TODAY(13:20) - CALL WRITEDIR(0,IER) - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - - CALL WRITEDIR(NUMBER_PARAM,IER) - - CALL CLOSE_FILE(2) ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be - & truncated to:') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - - - SUBROUTINE RESPOND(STATUS) -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER INPUT*80,FROM_TEST*5 - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - BULL_PARAMETER = 'RE: '//DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P) - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - LEN_P = TRIM(BULL_PARAMETER) - - IF (BULL_PARAMETER(1:1).NE.'"') THEN - BULL_PARAMETER = '"'//BULL_PARAMETER(1:LEN_P) - LEN_P = LEN_P + 1 - END IF - - IF (BULL_PARAMETER(LEN_P:LEN_P).NE.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(1:LEN_P)//'"' - LEN_P = LEN_P + 1 - END IF - - IF (CONFIRM_USER(FROM).EQ.0) THEN - CALL LIB$SPAWN('$MAIL SYS$INPUT '//FROM//'/SUBJECT='// - & BULL_PARAMETER,,,,,,STATUS) - ELSE - FROM_TEST = ' ' - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - L_INPUT = 81 - I = BLOCK - DO WHILE (I.LT.BLOCK+LENGTH.AND.L_INPUT.GT.0) - CALL GET_BULL(I,INPUT,L_INPUT) - IF (L_INPUT.GT.0) THEN - CALL STR$UPCASE(FROM_TEST,INPUT(1:5)) - IF (FROM_TEST.EQ.'FROM:') THEN - IF (INDEX(INPUT,'.').GT.0.OR.INDEX(INPUT,'@').GT.0 - & .OR.INDEX(INPUT,'%').GT.0) THEN - L_INPUT = 0 - END IF - END IF - ELSE IF (L_INPUT.EQ.0) THEN - L_INPUT = 80 - I = I + 1 - END IF - END DO - CALL CLOSE_FILE(1) - IF (FROM_TEST.EQ.'FROM:') THEN - L_B = INDEX(INPUT,'<') - R_B = INDEX(INPUT,'>') - IF (L_B.GT.0.AND.R_B.GT.0) THEN - INPUT = INPUT(L_B+1:R_B-1) - L_INPUT = R_B - 1 - L_B - ELSE - L_INPUT = TRIM(INPUT) - I = 6 - DO WHILE (INPUT(I:I).EQ.' '.AND.I.GT.0) - I = I + 1 - IF (I.GT.L_INPUT) I = 0 - END DO - INPUT = INPUT(I:L_INPUT) - L_INPUT = L_INPUT - I + 1 - END IF - CALL LIB$SPAWN('$CHMAIL/I '//INPUT(:L_INPUT)// - & '@XX/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSE - WRITE (6,'('' ERROR: Cannot respond to mail.'')') - END IF - END IF - - RETURN - - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_FILE_SHARED(8) - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_FILE(8) - - RETURN - END - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - - CHARACTER*132 SEARCH_STRING,SAVE_STRING - DATA SEARCH_STRING /' '/, SEARCH_LEN /1/ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL DISABLE_CTRL - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_POINT - BULL_POINT = BULL_POINT - 1 - END IF - - SAVE_STRING = SEARCH_STRING - SAVE_LEN = SEARCH_LEN - - IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - - IF (.NOT.IER) THEN ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - SEARCH_LEN = SAVE_LEN - ELSE IF (.NOT.CLI$PRESENT('START')) THEN ! If string entered but no - BULL_POINT = 0 ! starting message, use first - END IF - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(0,IER) - - IF (BULL_POINT+1.GT.NBULL) THEN - WRITE (6,'('' ERROR: No more messages.'')') - CALL CLOSE_FILE(2) - CALL ENABLE_CTRL - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) - - DO BULL_SEARCH = BULL_POINT+1, NBULL - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1) THEN - LEN = 81 - DO J=BLOCK,BLOCK+LENGTH-1 - DO WHILE (LEN.GT.0) - CALL GET_BULL(J,INPUT,LEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(1:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - END IF - END DO - LEN = 80 - END DO - END IF - END DO - - CALL CLOSE_FILE(1) ! End of bulletin file read - CALL CLOSE_FILE(2) - - CALL ENABLE_CTRL - - WRITE (6,'('' No messages found with given search string.'')') - - RETURN - END - - - - - - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - CHARACTER*107 DIRLINE - - INCLUDE 'BULLDIR.INC' - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE - CHARACTER*8 TEMP_TIME,TEMP_EXTIME - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00' ! bulletin date if deletion occurs - - CALL OPEN_FILE(1) ! Open both bulletin files - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF (SYSTEM.LE.1.OR.(SHUTDOWN.EQ.0 ! If not permanent, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - DIFF = 0 ! If so, delete it - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF (SYSTEM.LE.1) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date so when we quit - TEMP_TIME = TIME ! search, we'll have the - END IF ! latest bulletin date - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - NEW_SHUTDOWN = SHUTDOWN - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - CALL CLOSE_FILE(1) -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(NEW_BULL) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - - NEW_BULL = .FALSE. - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - - IF (IER.NE.0) THEN ! If header not present, exit - CALL CLOSE_FILE(4) - RETURN - ELSE IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG(I) = 0 ! information, write default - NOTIFY_FLAG(I) = 0 ! flags. - BRIEF_FLAG(I) = 0 - NEW_FLAG(I) = 0 - END DO - SET_FLAG(1) = 1 - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - REWRITE (4,FMT=USER_FMT) - & TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS$BINTIM(TODAY,TODAY_BTIM) - - DO WHILE (REC_LOCK(IER1)) - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER1) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG ! Find user's info - END DO - - IF (IER1.EQ.0) THEN ! If entry found, update it - DIFF = COMPARE_BTIM(READ_BTIM,NEWEST_BTIM) - IF (DIFF.LE.0) NEW_BULL = .TRUE. ! If new bull set flag -C -C No need to update read time/date if no new bulletins and no READNEW set, -C unless new bulletin is in general folder. -C - TEST_NEW_BULL = 0 - I = 0 - DO WHILE (TEST_NEW_BULL.EQ.0.AND.I.LT.FLONG) - I = I + 1 - TEST_NEW_BULL = NEW_FLAG(I).AND.SET_FLAG(I) - END DO - IF (TEST_NEW_BULL.NE.0.OR.NEW_BULL) THEN - REWRITE (4,FMT=USER_FMT) USERNAME,LOGIN_BTIM,TODAY_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! If no entry create a new entry - NEW_BULL = .TRUE. - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - END DO - WRITE (4,FMT=USER_FMT) USERNAME,TODAY_BTIM,TODAY_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER READ_DATE_TIME*20,LOGIN_DATE_TIME*20 - - CALL SYS$ASCTIM(,READ_DATE_TIME,READ_BTIM,) - CALL SYS$ASCTIM(,LOGIN_DATE_TIME,LOGIN_BTIM,) -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer -C -C Following stores a "possible" new bulletin. That is, the user has -C READNEW set, but ignored reading the bulletins. The user then enters -C BULLETIN, and if new bulletins are added after logging in, we want to -C point to that bulletin. However, if there were none added since then, -C we want to point to the first unread one. Thus, the first new unread -C bulletin is stored in BULL_POSSIBLE, and the search continues for -C new bulletins since logging in. -C - BULL_POSSIBLE = -1 - - CALL OPEN_FILE_SHARED(2) ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN ! If header present - DO ICOUNT=1,NBULL ! Get each bulletin to compare - CALL READDIR(ICOUNT,IER) ! its date with last read date - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - DIFF = COMPARE_DATE(READ_DATE_TIME(1:11),DATE) - IF (DIFF.EQ.0) - & DIFF = COMPARE_TIME(READ_DATE_TIME(13:20),TIME) - IF (DIFF.LE.0) THEN ! If new bull or new user - IF (SYSTEM) THEN ! If system bulletin - DIFF = COMPARE_DATE(LOGIN_DATE_TIME(1:11),DATE) - IF (DIFF.EQ.0) - & DIFF = COMPARE_TIME(LOGIN_DATE_TIME(13:20),TIME) - IF (DIFF.LE.0) THEN ! If system bull, make it - BULL_POINT = ICOUNT - 1 ! the first new bull only - GO TO 100 ! if added since user logged in - END IF ! else he's read it already. - ELSE - IF (TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (BULL_POSSIBLE.EQ.-1) BULL_POSSIBLE = ICOUNT - 1 - DIFF = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF.GT.0) THEN - DIFF = COMPARE_DATE(LOGIN_DATE_TIME(1:11),DATE) - IF(DIFF.EQ.0) - & DIFF=COMPARE_TIME(LOGIN_DATE_TIME(13:20),TIME) - END IF - END IF - IF (DIFF.LE.0) THEN - BULL_POINT = ICOUNT - 1 ! If not system bull then - GO TO 100 ! make it the new bull - END IF - END IF - END IF - END IF - END DO - END IF - - BULL_POINT = BULL_POSSIBLE - -100 CALL CLOSE_FILE(2) ! Its time for this program - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(INPUT,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*20 INPUT - CHARACTER*23 TODAY - - DIMENSION EXTIME(2),NOW(2) - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - -5 WRITE(6,1030) TODAY ! Prompt for expiration date - CALL GET_LINE(INPUT,LEN) ! Get input line - - IF (LEN.LE.0) THEN - IER = 0 - RETURN - END IF - - INPUT = INPUT(1:LEN) ! Change trailing zeros 2 spaces - - IF (INDEX(INPUT,'-').EQ.0.AND.INDEX(INPUT,':').GT.0.AND. - & INDEX(INPUT(1:LEN),' ').EQ.0) THEN - INPUT = TODAY(1:INDEX(TODAY(2:),' ')+1)//INPUT - END IF - - CALL STR$UPCASE(INPUT,INPUT) ! Convert to upper case - IER = SYS$BINTIM(INPUT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - GO TO 5 - END IF - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - END IF - - IF (INPUT(2:2).EQ.'-') INPUT = '0'//INPUT - IER = COMPARE_DATE(INPUT(1:11),TODAY(1:11)) ! Compare date with today's - IF (IER.EQ.0) IER = COMPARE_TIME(INPUT(13:20),TODAY(13:20)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - GO TO 5 ! and re-request date - END IF - - IER = 1 - - RETURN - -1030 FORMAT (' It is ',A23, - &'. Specify when the message should expire:',/,1x, - &'Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - &'or delta time: dddd hh:mm:ss') -1040 FORMAT (' ERROR: Invalid date format specified.') -1045 FORMAT (' ERROR: Specified time has already passed.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - IF (IER.NE.SS$_NORMAL) MAIL_EDIT = 'SYS$SYSTEM:MAILEDIT' - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0) THEN - CALL EDT$EDIT(INFILE,OUT) - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN - CALL TPU$EDIT(INFILE,OUT) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - ! TPU does CLI$ stuff which wipes our parsed command line - END IF - - RETURN - END diff --git a/decus/lt87a/bulletin/bulletin3.for b/decus/lt87a/bulletin/bulletin3.for deleted file mode 100644 index b7c156a..0000000 --- a/decus/lt87a/bulletin/bulletin3.for +++ /dev/null @@ -1,1269 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 20:57 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: BULLETIN3.FOR - -C -C BULLETIN3.FOR, Version 6/17/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*80,INFROM*80,INPUT*132 - CHARACTER*8 ACCOUNT - - CALL DISABLE_CTRL - - CALL OPEN_FILE_SHARED(7) - -1 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - END DO - UNLOCK 7 - - IF (IER.NE.0) GO TO 900 - IF (FOLDER_BBOARD.EQ.'NONE') GO TO 1 - IF (FOLDER_NUMBER.EQ.0) THEN - FOLDER_SET = .FALSE. - ELSE - FOLDER_SET = .TRUE. - FOLDER_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - IF ((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)) THEN ! If normal BBOARD or /VMSMAIL - CALL CHECK_MAIL(FOLDER_BBOARD,COUNT) ! Any new VMS mail? - IF (COUNT.EQ.0) GO TO 1 ! None. - END IF - -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME) ! Get present username - CALL GETACC(ACCOUNT) ! Get present account - CALL GETUIC(GROUP,USER) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(1:LEN_B)// - & FOLDER_BBOARD(1:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B) - & //'BOARD.COM','NL:','NL:',,,,STATUS) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(1:LEN_B)//'BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(1:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B) - & //'BOARD.COM','NL:','NL:',,,,STATUS) - END IF - ELSE - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B)//FOLDER_BBOARD - & (1:TRIM(FOLDER_BBOARD))//'.COM','NL:','NL:',,,,STATUS) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',,,,STATUS) - END IF - END IF - ! Create sequential mail file - CALL SETACC(ACCOUNT) ! Reset to original account - CALL SETUSER(USERNAME) ! Reset to original username - CALL SETUIC(GROUP,USER) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_DIRECTORY(1:LEN_B)//FOLDER_BBOARD - & (1:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - -5 LEN_INPUT = 1 - DO WHILE (LEN_INPUT.GT.0) - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - IF (INPUT(1:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(1:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - END IF - END DO - - -C -C Add bulletin to bulletin file and directory entry to directory file. -C - -10 CALL OPEN_FILE(2) ! Prepare to add dir entry - - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - IF (IER.NE.0) GO TO 100 ! If end of file, exit - IF (LEN_INPUT.EQ.1.AND.INPUT(1:1).EQ.CHAR(12)) GO TO 5 - ! If line is just form feed, the message is empty - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - OCOUNT = NBLOCK + 1 ! Initialize line count - - SPACE = INDEX(INFROM,' ') - 1 ! Strip off the date - IF (SPACE.GT.0) INFROM = INFROM(1:SPACE)! From the "From:" line - - IF (TRIM(INFROM).GT.12) THEN ! Is length > allowable? - LEN_INFROM = TRIM(INFROM) - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(1:LEN_INFROM), - & OCOUNT) - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) - I = 12 ! Trim username to first non-alpha character - DO WHILE (I.GT.1.AND. - & ((INFROM(I:I).GE.'A'.AND.INFROM(I:I).LE.'Z').OR. - & (INFROM(I:I).GE.'a'.AND.INFROM(I:I).LE.'z')) ) - I = I - 1 - END DO - IF (I.GT.1) INFROM = INFROM(1:I-1) - END IF - - LEN_DESCRP = TRIM(INDESCRIP) - IF (LEN_DESCRP.GT.53) THEN ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//INDESCRIP(1:LEN_DESCRP), - & OCOUNT) - INDESCRIP = INDESCRIP(1:LEN_DESCRP) - DO I=1,LEN_DESCRP - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - ELSE - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - END IF - - ISTART = 0 - NBLANK = 0 - DO WHILE (INPUT(1:1).NE.CHAR(12)) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - NBLANK = 0 - CALL STORE_BULL(MIN(LEN_INPUT,80),INPUT,OCOUNT) - IF (LEN_INPUT.GT.80) THEN ! Breakup line if > 80 chars - CALL STORE_BULL(MIN(LEN_INPUT,132)-80,INPUT(81:),OCOUNT) - END IF - END IF - READ (3,'(Q,A)',END=25) LEN_INPUT,INPUT - END DO - -25 CALL FLUSH_BULL(OCOUNT) - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - DESCRIP = INDESCRIP(1:53) ! Description header - FROM = INFROM(1:12) ! Username - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - EXTIME = '00:00:00' - LENGTH = OCOUNT - NBLOCK ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - -30 CALL CLOSE_FILE(2) ! Totally finished with add - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - GOTO 1 - -900 FOLDER_NUMBER = 0 - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=0,KEYID=1) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - CALL CLOSE_FILE(7) - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - WRITE (6,1030) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:' - & ,,,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL EXE$GL_ABSTIM - INTEGER UPTIME(2),SYSTIME(2),UPSINCE(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - UPTIME(1) = GET_L_VAL(EXE$GL_ABSTIM) ! Up time (sec) - - CALL LIB$EMUL(10000000,UPTIME,0,UPTIME) ! 64 bit format - CALL SYS$GETTIM(SYSTIME) - CALL LIB$SUBX(SYSTIME,UPTIME,UPSINCE) - CALL SYS$ASCTIM(,ASCSINCE,UPSINCE,) ! Up since - - UPTIME_DATE = ASCSINCE(1:11) - UPTIME_TIME = ASCSINCE(13:20) - - RETURN - END - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(USER,NEW_MESSAGES) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*35,USER*(*) - EQUIVALENCE (INPUT(34:),COUNT) - - OPEN (UNIT=10,FILE='VMSMAIL',DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED) - READ(10,'(A)',KEY=USER,IOSTAT=IER) INPUT - CLOSE (10) - - NEW_MESSAGES = COUNT - - IF (IER.NE.0) COUNT = 0 - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C -C NOTE: These routines don't presently allow return length address -C in item list. -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist -C if it creates empty space for new user. -C - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CALL OPEN_FILE_SHARED(8) - - READ (4,'(A12)',IOSTAT=IER1,KEYGT=USERNAME) TEMP_USER ! Look forward one - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER) THEN - DELETE(UNIT=4) ! Delete non-existant user - END IF - - CALL CLOSE_FILE(8) ! All done... - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER INPUT*80 - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - LEN = 0 - DO WHILE (LEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) LEN,INPUT - LEN = MIN(LEN,TRIM(INPUT),80) - IF (LEN.GT.1.AND.ICHAR(INPUT(LEN:LEN)).EQ.10) THEN - INPUT(LEN-1:LEN-1) = CHAR(32) ! Remove imbedded - INPUT(LEN:LEN) = CHAR(32) ! CR/LFs at end of file. - LEN = LEN - 2 - END IF - IF (LEN.GT.0) THEN - ICOUNT = ICOUNT + 1 - ELSE IF (LEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(LEN,INPUT,OCOUNT) - LENGTH = LENGTH + LEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - SUBROUTINE STORE_BULL(LEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*(BRECLEN) - - DATA POINT/0/ - - IF (LEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - WRITE (1'OCOUNT) OUTPUT(1:POINT) - OUTPUT = CHAR(LEN)//INPUT - POINT = LEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - WRITE (1'OCOUNT) OUTPUT(1:POINT)//CHAR(LEN) - OUTPUT = INPUT - POINT = LEN - ELSE - WRITE (1'OCOUNT) OUTPUT(1:POINT)//CHAR(LEN) - & //INPUT(1:BRECLEN-1-POINT) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = LEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - ELSE - OUTPUT(POINT+1:) = CHAR(LEN)//INPUT(1:LEN) - POINT = POINT + LEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - WRITE (1'OCOUNT) OUTPUT - POINT = 0 - - RETURN - - END - - - SUBROUTINE GET_BULL(BLOCK,INPUT,LEN) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128,LINE_LENGTH=80 - - CHARACTER INPUT*(*),TEMP*(BRECLEN), LEFT*(BRECLEN) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (LEN.GT.LINE_LENGTH) THEN - POINT = 1 - LEFT_LEN = 0 - END IF - - IF (POINT.EQ.1) THEN - DO WHILE (REC_LOCK(IER)) - READ (1'BLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (POINT.EQ.BRECLEN+1) THEN - LEN = 0 - POINT = 1 - RETURN - END IF - - IF (IER.GT.0) THEN - LEN = -1 - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN - LEN = ICHAR(LEFT(1:1)) - INPUT = LEFT(2:LEN-LEFT_LEN+1)//TEMP(1:LEFT_LEN) - POINT = LEFT_LEN + 1 - LEFT_LEN = 0 - ELSE - LEN = ICHAR(TEMP(POINT:POINT)) - IF (LEN.GT.BRECLEN-POINT) THEN - LEFT = TEMP(POINT:) - LEFT_LEN = LEN - (BRECLEN-POINT) - LEN = 0 - POINT = 1 - ELSE IF (LEN.EQ.0) THEN - POINT = 1 - ELSE - INPUT = TEMP(POINT+1:POINT+LEN) - POINT = POINT+LEN+1 - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(LEN) - - IF (POINT.EQ.BRECLEN+1) THEN - LEN = 0 - ELSE - LEN = ICHAR(TEMP(POINT:POINT)) - END IF - - RETURN - - END - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - DELETE(UNIT=2,REC=BULL_ENTRY+1) - - NEMPTY = NEMPTY + LENGTH - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(1:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(1:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($RMSDEF)' - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - CHARACTER*(*) PROMPT - LOGICAL*1 USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - FLAG = 0 ! Yep, init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,FLAG,,,,) ! Enable the AST - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limit - POINTER = 0 ! during input. - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = LIB$GET_INPUT(DESCRIP,PROMPT) ! Get line from terminal - ELSE - IER = LIB$GET_INPUT(DESCRIP) ! Get line from terminal - END IF - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - IER1 = SYS$CANCEL(%VAL(TERM_CHAN)) ! Cancel CTRL-C AST - IF (IER.NE.RMS$_EOF) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE(FLAG) ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal and purge -C type ahead buffer. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA - - EXTERNAL IO$_READVBLK,IO$M_NOECHO,IO$M_PURGE,IO$M_TIMED - - COMMON /TERM_CHAN/ TERM_CHAN - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO) - - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, - & %VAL(%LOC(DATA)),%VAL(LEN(DATA)),,,,) - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - RETURN - - ENTRY PURGE_TYPEAHEAD ! Purge type-ahead buffer - - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO)+%LOC(IO$M_PURGE) - & +%LOC(IO$M_TIMED) - - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, - & %VAL(%LOC(IER)),%VAL(0),%VAL(5),,,) ! Purge type ahead buffer - - RETURN - END - - - - - - SUBROUTINE GETPAGLEN(PAGE_LENGTH) -C -C SUBROUTINE GETPAGLEN -C -C FUNCTION: -C Gets page length of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = DEVDEPEND(4) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($PRVDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_FILE(4) - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - NEW_FLAG(2) = 0 - REWRITE (4,FMT=USER_FMT) - & TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(NEW_FLAG(1),I)).OR. - & (I.GT.31.AND.BTEST(NEW_FLAG(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*8 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,LEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(1:LEN) - RETURN - ELSE IF (INPUT_PRIV(1:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_FILE(4) ! Get BULLUSER.DAT file - - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - - IF (IER.EQ.0) THEN ! If header is present, exit - NEW_FLAG(1) = NEW_FLAG(1).OR.ONPRIV(1) - NEW_FLAG(2) = NEW_FLAG(2).OR.ONPRIV(2) - NEW_FLAG(1) = NEW_FLAG(1).AND.(.NOT.OFFPRIV(1)) - NEW_FLAG(2) = NEW_FLAG(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4,FMT=USER_FMT) - & TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN - - END diff --git a/decus/lt87a/bulletin/bulletin4.for b/decus/lt87a/bulletin/bulletin4.for deleted file mode 100644 index c0a85cf..0000000 --- a/decus/lt87a/bulletin/bulletin4.for +++ /dev/null @@ -1,1144 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 20:56 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: BULLETIN4.FOR - -C -C BULLETIN4.FOR, Version 6/1/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C NOTE: Subroutine CHECK_ACCESS which is used to see if user has only read -C access to a folder only works for VMS V4.4 or later. If you have an -C early version, modify as indicated. -C - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) RETURN - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - LEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - LEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privileged - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF'))) THEN - WRITE (6,'( - & '' ERROR: No privs to change all NOTIFY, BRIEF or READNEW.'')') - RETURN - END IF - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - WRITE (6,'('' Enter one line description of folder.'')') - -10 CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(1:LENDES) ! End fill with spaces - IF (LENDES.LE.0) GO TO 910 - IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - GO TO 10 - END IF - - FOLDER_OWNER = USERNAME ! Get present username - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(1:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',IOSTAT=IER, - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER_NUMBER = LAST_NUMBER - 1 - END IF - - FOLDER_OWNER = USERNAME ! Get present username - FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = 14 - - WRITE (7,FMT=FOLDER_FMT) FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(1:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_FILE(7) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - - - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets NOTIFY or READNEW defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (.NOT.SETPRV_PRIV().AND.INCMD(1:3).EQ.'SET') THEN - WRITE (6,'( - & '' ERROR: No privs to change all defaults.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(4) - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) ! Get header - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG, - & BRIEF_FLAG,NOTIFY_FLAG - END DO - DO WHILE (IER.EQ.0) - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEYGT=TEMP_USER,IOSTAT=IER) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG, - & BRIEF_FLAG,NOTIFY_FLAG ! Find if there is an entry - END DO - IF (TEMP_USER.NE.USER_HEADER.AND. - & (BRIEF.EQ.-1.OR.NOTIFY.EQ.-1.OR.READNEW.EQ.-1)) THEN - IER = 1 ! Modify READNEW and NOTIFY for all users - END IF ! only during folder creation or deletion. - END DO - CALL CLOSE_FILE(4) - - RETURN - END - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) FOLDER1, - & FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP ! See if it exists - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(1:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL OPEN_FILE(2) ! Remove directory file - CALL OPEN_FILE(1) ! Remove bulletin file - CALL CLOSE_FILE_DELETE(1) - CALL CLOSE_FILE_DELETE(2) - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) FOLDER_SET = .FALSE. - -1000 CALL CLOSE_FILE(7) - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL CLI$_ABSENT - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - IF (OUTPUT) IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1,FLEN) - ! Get folder name - - CALL OPEN_FILE_SHARED(7) ! Go find folder - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.EQ.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - FLEN = 7 - END IF - - DO WHILE (REC_LOCK(IER)) - IF (OUTPUT.OR.FOLDER_NUMBER.EQ.-1) THEN - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB1,GROUPB1 - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - READ (7,FMT=FOLDER_FMT,KEY=FOLDER_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB1,GROUPB1 - END IF - END DO - - CALL CLOSE_FILE(7) - - IF (IER.EQ.0) THEN ! Folder found - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHKACL - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER) THEN - CALL CHECK_ACCESS - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(1:TRIM(FOLDER1_OWNER)) - END IF - IER = 0 - RETURN - END IF - END IF - IF (IER) THEN - - FOLDER = FOLDER1 ! Folder successfully set - FOLDER_NUMBER = FOLDER1_NUMBER ! so update permanent folder - FOLDER_OWNER = FOLDER1_OWNER ! parameters. - FOLDER_DESCRIP = FOLDER1_DESCRIP - FOLDER_BBOARD = FOLDER1_BBOARD - FOLDER_BBEXPIRE = FOLDER1_BBEXPIRE - FOLDER_FILE = FOLDER1_FILE - USERB = USERB1 - GROUPB = GROUPB1 - - IF (FOLDER_NUMBER.GT.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (OUTPUT) THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(1:FLEN)//'.' - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT) - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0) THEN - IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (IER.LE.0) CALL UPDATE ! Need to update - ELSE - NBULL = 0 - END IF - CALL CLOSE_FILE(2) - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - - IF (OUTPUT.AND.TEST2(NEW_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(0,1) - CALL FIND_NEWEST_BULL ! See if there are new bulletins - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - IER = 1 - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - RETURN - - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT - - CALL OPEN_FILE_SHARED(7) ! Open folder file - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).NE.%LOC(CLI$_ABSENT)) - & THEN -10 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB - END DO - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_FILE(7) - RETURN - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(1:TRIM(FOLDER1_DESCRIP)) - END IF - ELSE IF (FOLDER_SET) THEN - WRITE (6,1000) FOLDER,FOLDER_OWNER, - & FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP)) - FOLDER1_FILE = FOLDER_FILE - FOLDER1_BBOARD = FOLDER_BBOARD - FOLDER1_BBEXPIRE = FOLDER_BBEXPIRE - FOLDER1_NUMBER = FOLDER_NUMBER - ELSE - FOLDER1 = 'GENERAL' - GO TO 10 - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - WRITE (6,'('' Folder is not a private folder.'')') - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(1:FLEN) - END IF - IF ((USERB.EQ.0.AND.GROUPB.EQ.0).OR.BTEST(USERB,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' BBOARD expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE - WRITE (6,'('' BBOARD messages will not expire.'')') - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - CALL OPEN_FILE_SHARED(4) - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - IF (TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is BRIEF.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - ELSE - WRITE (6,'('' Default is NOREADNEW.'')') - END IF - IF (TEST2(NOTIFY_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY.'')') - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_FILE(4) - END IF - END IF - - CALL CLOSE_FILE(7) - - RETURN - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH - - DATA SCRATCH_D1/0/ - - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_D1.EQ.0) THEN ! Is queue empty? - CALL LIB$GET_VM(132,SCRATCH_D) ! If so, allocated memory - CALL MAKE_CHAR(%VAL(SCRATCH_D),120) ! Form a character string - SCRATCH_D1 = SCRATCH_D ! Init header pointer - ELSE ! Else queue is not empty - SCRATCH_D = SCRATCH_D1 ! so reinit queue pointer - END IF ! to the header. - - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDER = 0 - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,KEYGT=FOLDER1,KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - END DO - IF (IER.EQ.0) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER_COM) - END IF - END DO - - CALL CLOSE_FILE(7) ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*2,PAGE_LENGTH-4) - ! If more entries then page size, truncate output - DO I=FOLDER_COUNT,FOLDER_COUNT+DISPLAY/2-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER_COM) - WRITE (6,1000) FOLDER1,FOLDER1_OWNER,FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counter - END DO - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(' Folder: ',A25,' Owner: ',A12,' Description:',/,1X,A80) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*25,RESPONSE*1 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',ID,LEN) ! Get ID - IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: ID name must be < 26 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP ! See if it exists - CALL CLOSE_FILE(7) - - IF ((.NOT.ALL).AND.(ID.EQ.FOLDER1_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Cannot modify access for owner of folder.'')') - RETURN - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - CALL CHKACL - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder access was not changed.'')') - RETURN - ELSE - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - RETURN - END IF - END IF - END IF - IF (ACCESS) THEN - IF (.NOT.ALL) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL DEL_ACL(' ','R+W',IER) - END IF - END IF - ELSE - IF (ALL) THEN - CALL DEL_ACL('*','R',IER) - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' ERROR: Cannot modify ACL of folder files.'')') - CALL SYS_GETMSG(IER) - ELSE - WRITE (6,'('' Access to folder has been modified.'')') - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C -C NOTE: SYS$CHECK_ACCESS is only available under V4.4 or later. -C If you have an earlier version, comment out the lines which call -C it and set both READ_ACCESS and WRITE_ACCESS to 1, which will -C allow program to run, but will not allow READONLY access feature. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(1:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(1:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*) - CHARACTER NOT_ID*3 - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - DO ACCESS_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - IF ((ACCESS_TYPE.EQ.1.AND.INDEX(ACLSTR,'WRITE').GT.0).OR. - & (ACCESS_TYPE.EQ.2.AND.INDEX(ACLSTR,'READ)').GT.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - DO WHILE - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0) - START_ID = START_ID - 1 - END DO - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (ACCESS_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - OUTLEN = 1 - END IF - LEN = END_ID - START_ID + 1 - IF (OUTLEN+LEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = LEN + 2 - ELSE IF (OUTLEN+LEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + LEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END diff --git a/decus/lt87a/bulletin/bulletin5.for b/decus/lt87a/bulletin/bulletin5.for deleted file mode 100644 index cc5da18..0000000 --- a/decus/lt87a/bulletin/bulletin5.for +++ /dev/null @@ -1,1073 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 20:58 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: BULLETIN5.FOR - -C -C BULLETIN5.FOR, Version 5/17/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_FILE_SHARED(4) - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEYEQ=TEMP_USER,IOSTAT=IER) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG, - & BRIEF_FLAG,NOTIFY_FLAG ! Find if there is an entry - END DO - - CALL SYS$BINTIM('5-NOV-2956',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).EQ.0) THEN - CALL SYS$BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER UAF$V_DISACNT = 4, UAF$L_UIC = '24'X - PARAMETER UAF$L_ACCOUNT = 53 - PARAMETER UAF$L_FLAGS = '1D4'X - PARAMETER INPUT_LEN = UAF$L_FLAGS + 4 - - CHARACTER INPUT*(INPUT_LEN),USERNAME*(*),ACCOUNT*(*) - - EQUIVALENCE (INPUT(UAF$L_UIC+1:),USER2) - EQUIVALENCE (INPUT(UAF$L_UIC+3:),GROUP2) - EQUIVALENCE (INPUT(UAF$L_FLAGS+1:),FLAGS2) - - INTEGER*2 USER2,GROUP2 - - CALL OPEN_FILE_SHARED(8) - - READ (8,KEY=USERNAME,IOSTAT=IER) INPUT - ! Move pointer to top of file - - CALL CLOSE_FILE(8) - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - ELSE - FLAGS = FLAGS2 - IER = 1 - USER = USER2 - GROUP = GROUP2 - ACCOUNT = INPUT(UAF$L_ACCOUNT:UAF$L_ACCOUNT+7) - END IF - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - CALL CLOSE_FILE(4) - NEEDPRIV(1) = NEW_FLAG(1) - NEEDPRIV(2) = NEW_FLAG(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P) - & ,LIBRARY,,LIB$GET_INPUT) - - RETURN - END - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - CALL STR$TRIM(INPUT,INPUT,TRIM) - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - -C -C BULLSUB3.FOR, Version 12/18/86 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE(INPUT) -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C -C INPUT: -C INPUT - Unit number of file to close out. -C 1 = BULLETIN.DAT -C 2 = BULLDIR.DAT -C 4 = BULLUSER.DAT -C 7 = BULLFOLDER.DAT -C 8 = SYS$SYSTEM:SYSUAF.DAT -C - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT) - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE(INPUT) - - IMPLICIT INTEGER (A-Z) - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT,STATUS='DELETE') - - RETURN - END - - - SUBROUTINE OPEN_FILE(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - EXTERNAL BULLDIR_ERR,BULLETIN_ERR,BULLUSER_ERR,BULLFOLDER_ERR - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2) - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - IF (TIMEEFN.EQ.0) CALL LIB$GET_EF(TIMEEFN) - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (INPUT.EQ.2) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='UNKNOWN',IOSTAT=IER, - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.FOLDER_NUMBER.EQ.0) THEN - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - END IF - END DO - END IF - - IF (INPUT.EQ.1) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.FOLDER_NUMBER.EQ.0) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - END IF - END DO - END IF - - IF (INPUT.EQ.4) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER,NEWEST_BTIM, - 1 BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - 1 PRV$M_SETPRV,(0,I=1,FLONG*4-1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - END IF - END DO - END IF - - IF (INPUT.EQ.7) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLFOLDER_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED', - 1 RECORDSIZE=FOLDER_RECORD, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - 1 ACCESS='KEYED',RECORDTYPE='FIXED', - 1 RECORDSIZE=FOLDER_RECORD, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER1) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - END IF - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - IER = SYS$CANTIM(,) ! Successful, so cancel timer. - - RETURN - END - - SUBROUTINE TIMER_ERR - - IMPLICIT INTEGER (A-Z) - - ENTRY BULLDIR_ERR - WRITE(6,'('' ERROR: Unable to open directory file after 30 secs.'')') - GO TO 10 - - ENTRY BULLETIN_ERR - WRITE(6,'('' ERROR: Unable to open message file after 30 secs.'')') - GO TO 10 - - ENTRY BULLUSER_ERR - WRITE(6,'('' ERROR: Unable to open BULLUSER.DAT after 30 secs.'')') - GO TO 10 - - ENTRY BULLFOLDER_ERR - WRITE(6,'('' ERROR: Unable to open BULLFOLDER.DAT after 30 secs.'')') - GO TO 10 - -10 CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - EXTERNAL LNM_MODE_EXEC - - CALL DISABLE_CTRL - - IF (INPUT.EQ.2) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 SHARED,READONLY,IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.FOLDER_NUMBER.EQ.0) THEN - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - END IF - END DO - END IF - - IF (INPUT.EQ.1) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.FOLDER_NUMBER.EQ.0) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - END IF - END DO - END IF - - IF (INPUT.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - 1 IOSTAT=IER,FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED, - 1 KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - END IF - END DO - END IF - - IF (INPUT.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED', - 1 RECORDSIZE=FOLDER_RECORD,IOSTAT=IER, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED, - 1 KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - END IF - - IF (INPUT.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.INPUT.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - CALL OPEN_FILE(INPUT) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL ENABLE_CTRL_EXIT - END IF - - RETURN - END - - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 INPUT,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) THEN ! Error. Why? - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=80, - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) THEN ! Error. Why? - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - 1 FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 IOSTAT=IER) - - NEWEST_EXTIME = '00:00:00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 INPUT,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_FILE(2) - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - - CALL OPEN_FILE(7) - -100 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - END DO - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - 1 ,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) THEN ! Error. Why? - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_FILE(2) - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') INPUT - LEN = TRIM(INPUT) - IF (LEN.EQ.0) LEN = 1 - CALL STORE_BULL(LEN,INPUT,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_FILE(2) - GOTO 100 - -200 CALL OPEN_FILE_SHARED(2) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED', - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF (IER.EQ.0) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS$BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS$BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - CHARACTER*2 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (2'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - END DO - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) - CALL CLEANUP_DIRFILE(1) - END IF - IF (NEMPTY.EQ.' ') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200) THEN - WRITE (CFOLDER_NUMBER,'(I2)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ(2'ICOUNT+1,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCK - END DO - END IF - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - RETURN - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4) - - END - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - IF (BULLETIN_NUM.EQ.0) THEN - WRITE (2'1,1000,IOSTAT=IER) NEWEST_EXDATE,NEWEST_EXTIME, - & NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - ELSE - WRITE(2'BULLETIN_NUM+1,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCK - END IF - - RETURN - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4) - - END diff --git a/decus/lt87a/bulletin/bulletin6.for b/decus/lt87a/bulletin/bulletin6.for deleted file mode 100644 index 5f51a3a..0000000 --- a/decus/lt87a/bulletin/bulletin6.for +++ /dev/null @@ -1,1120 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 21:05 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: BULLETIN6.FOR - -C -C BULLETIN6.FOR, Version 6/10/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - INCLUDE '($SSDEF)' - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - CHARACTER*160 OUTPUT - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - - DIMENSION SAVE_NEW_FLAG(FLONG) - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_FILE_SHARED(4) - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,TEMP_BTIM,BBOARD_BTIM,NEW_FLAG, - & SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_FILE(4) - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS$BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,FMT=USER_FMT) TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - -C -C Set flags in all user entries that have SET READNEW on the particular -C folder to indicate that a new bulletin is present for the particular folder. -C Also send broadcast if notify flag set. -C - OUTPUT = BELL//CR//LF//LF//'New bulletin added to folder '// - & FOLDER(1:TRIM(FOLDER))//'. From: '//FROM(1:TRIM(FROM))// - & CR//LF//'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IF (.NOT.ADD_BULL) THEN - DO I=1,FLONG - SAVE_NEW_FLAG(I) = NEW_FLAG(I) - END DO - ELSE - IF (FOLDER_NUMBER.GT.0) THEN - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - END IF - - F_POINT = FOLDER_NUMBER/32 + 1 - IER = 0 - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,IOSTAT=IER) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - SAVE_FLAG = NEW_FLAG(F_POINT) - IF ((IER.EQ.0).AND.(TEMP_USER.NE.FROM.OR..NOT.ADD_BULL)) THEN - IF (ADD_BULL) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - DIFF = COMPARE_BTIM(NEWEST_BTIM,READ_BTIM) - IF (DIFF.LT.0) THEN - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - IF (TEMP_USER.EQ.USERNAME) THEN - SAVE_NEW_FLAG(F_POINT) = NEW_FLAG(F_POINT) - END IF - END IF - END IF - IF (SAVE_FLAG.NE.NEW_FLAG(F_POINT)) THEN - REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END IF - END DO - - IF (ADD_BULL) THEN - IER = 1 - DO WHILE (GETUSERS(TEMP_USER)) - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,IOSTAT=IER,KEY=TEMP_USER) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG - END DO - IF (IER.EQ.0.AND.TEMP_USER.NE.USERNAME.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TEMP_USER,%VAL(BRK$C_USERNAME),,,,,,,) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END IF - END DO - END IF - - DO I=1,FLONG - NEW_FLAG(I) = SAVE_NEW_FLAG(I) - END DO - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG - ! Reobtain present values as calling programs still uses them - END DO - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_FILE(4) - - RETURN - - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 TODAY_TIME - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:20) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GT.0) THEN - COMPARE_BTIM = +1 - ELSE - IF (DIFF(1).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(1).GT.0) THEN - COMPARE_BTIM = +1 - ELSE - COMPARE_BTIM = 0 - END IF - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*3600 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS$BINTIM(DATE1,USER_TIME) - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS$BINTIM(DATE2,USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*8 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:20) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = LEN(DATA) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = LEN(DATA) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,LEN) - DIMENSION IARRAY(1) - IARRAY(1) = LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable SYSPRV privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - SETPRV(1) = 0 - SETPRV(1) = IBSET(SETPRV(1),PRV$V_SYSPRV) - SETPRV(1) = IBSET(SETPRV(1),PRV$V_WORLD) - SETPRV(1) = IBSET(SETPRV(1),PRV$V_OPER) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable SYSPRV - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable SYSPRV privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable SYSPRV - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - CHARACTER*23 TODAY - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_FILE_SHARED(4) ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - DO WHILE (REC_LOCK(IER)) ! Read old entry - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS$ASCTIM(,TODAY,,) - CALL SYS$BINTIM(TODAY,LOGIN_BTIM) - CALL SYS$BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) TEMP_USER - & NEWEST_BTIM,BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - REWRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME, ! Write modified entry - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -C -C SUBROUTINE CONFIRM_PRIV -C -C FUNCTION: Confirms that given username has SETPRV. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C ALLOW - Returns 1 if account has SETPRV. -C returns 0 if account has no SETPRV. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INCLUDE '($PRVDEF)' - - PARAMETER UAF$Q_DEF_PRIV = '1A4'X - - LOGICAL*1 UAF(0:583) - EQUIVALENCE (UAF(UAF$Q_DEF_PRIV),UAF_DEF_PRIV) - - CALL OPEN_FILE_SHARED(8) - ALLOW = 0 ! Set return false - READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Record - IF (STATUS.EQ.0) THEN ! If username found - IF (BTEST(UAF_DEF_PRIV,PRV$V_SETPRV).OR. ! SETPRV or CMRKNL - & BTEST(UAF_DEF_PRIV,PRV$V_CMKRNL)) THEN ! privileges? - ALLOW = 1 ! Yep - END IF - END IF - CALL CLOSE_FILE(8) - RETURN ! Return - END ! End - - - - - - SUBROUTINE CHECK_DISMAIL(USERNAME,DISMAIL) -C -C SUBROUTINE CHECK_DISMAIL -C -C FUNCTION: Checks that given username has DISMAIL. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - PARAMETER UAF$V_DISMAIL = '7'X - PARAMETER UAF$L_FLAGS = '1D4'X - - LOGICAL*1 UAF(0:583) - EQUIVALENCE (UAF(UAF$L_FLAGS),UAF_L_FLAGS) - - CALL OPEN_FILE_SHARED(8) - DISMAIL = 0 ! Set return false - READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Record - IF (STATUS.EQ.0) THEN ! If username found - IF (BTEST(UAF_L_FLAGS,UAF$V_DISMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - CALL CLOSE_FILE(8) - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT,, - & %VAL(TRNLNM_ITMLST)) - - RETURN - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) CALL EXIT - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FILENAME*132,INPUT*128 - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(0,IER) - - FILENAME = FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL' - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_FILE(2) - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - IER = LIB$RENAME_FILE(FILENAME,FILENAME(1:TRIM(FILENAME))//';2') - ! Old file name to version number 2 - - IF (.NOT.IER) RETURN - - OPEN (UNIT=11,FILE=FILENAME(1:TRIM(FILENAME))//';1', - 1 STATUS='UNKNOWN',IOSTAT=IER, - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - ! Compressed version is number 1 - - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - READ(1'ICOUNT) INPUT - WRITE(11) INPUT - ICOUNT = ICOUNT + 1 - END DO - END DO - - CALL CLOSE_FILE(1) - CLOSE (UNIT=11) - - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) - - NEMPTY = -1 ! Copying done, but not directory updating. - CALL WRITEDIR(0,IER) - END IF - - IER = LIB$DELETE_FILE(FILENAME(1:TRIM(FILENAME))//';2') - ! Can safely delete old file, since NEMPTY = -1 - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL WRITEDIR(I,IER) - NBLOCK = NBLOCK + LENGTH - END DO - - READ (2'1,1000,IOSTAT=IER) ! Read directory header - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - ! NOTE: Can't use READDIR since it'll call CLEANUP_BULLFILE - - NEMPTY = 0 - CALL WRITEDIR(0,IER) ! Update header to show no empty spaces - - CALL CLOSE_FILE(2) - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - BLOCK_SAVE = BLOCK - K = J + 1 ! Search for duplicate entries - DO WHILE (MOVE_FROM.EQ.0.AND.K.LE.NBULL) - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO=J+1 - MOVE_FROM=K+1 - ELSE - K = K + 1 - END IF - END IF - END DO - J = J + 1 ! If no duplicate entry found for this - CALL READDIR(J,IER) ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - DELETE(UNIT=2,REC=J+1,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - CALL READDIR(FIRST_DELETE,IER) - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show READNEW and NOTIFY flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - LOGICAL SKIP,FLAG_NOTIFY,FLAG_READNEW,FLAG_BRIEF - DATA SKIP /.FALSE./ - - ENTRY SHOW_BRIEF - IF (.NOT.SKIP) THEN - FLAG_BRIEF = .TRUE. - FLAG_NOTIFY = .FALSE. - FLAG_READNEW =.FALSE. - SKIP = .TRUE. - END IF - - ENTRY SHOW_NOTIFY - IF (.NOT.SKIP) THEN - FLAG_BRIEF = .FALSE. - FLAG_NOTIFY = .TRUE. - FLAG_READNEW =.FALSE. - SKIP = .TRUE. - END IF - - ENTRY SHOW_READNEW - IF (.NOT.SKIP) THEN - FLAG_BRIEF = .FALSE. - FLAG_NOTIFY = .FALSE. - FLAG_READNEW =.TRUE. - SKIP = .TRUE. - END IF - - SKIP = .FALSE. - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - - CALL OPEN_FILE_SHARED(4) ! Open user file - - DO WHILE (REC_LOCK(IER)) ! Read old entry - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - - WRITE (6,'('' For the selected folder '',A,$)') FOLDER(1:TRIM(FOLDER)) - - IF (FLAG_READNEW) THEN - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND. - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'(''+, READNEW is set.'')') - ELSE - WRITE (6,'(''+, READNEW is not set.'')') - END IF - ELSE IF (FLAG_NOTIFY) THEN - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'(''+, NOTIFY is set.'')') - ELSE - WRITE (6,'(''+, NOTIFY is not set.'')') - END IF - ELSE IF (FLAG_BRIEF) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'(''+, BRIEF is set.'')') - ELSE - WRITE (6,'(''+, BRIEF is not set.'')') - END IF - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) USERNAME - - DATA WILDCARD /-1/ - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(1,JPI$_TERMINAL,%LOC(TERM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERM = 0 - DO WHILE (IER.AND.TERM.EQ.0) ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) WILDCARD = -1 - - GETUSERS = IER - - RETURN - END diff --git a/decus/lt87a/bulletin/bulletinann.txt b/decus/lt87a/bulletin/bulletinann.txt deleted file mode 100644 index 4c4ca2b..0000000 --- a/decus/lt87a/bulletin/bulletinann.txt +++ /dev/null @@ -1,190 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 19-JUN-1987 16:19 -To: "SYSTEM%UK.AC.SOTON.ESP.V1" , -Subj: BULLETIN - -You are about to receive version 1.31 of the PFC BULLETIN. This software is -public domain. (I will gladly accept recommendations for new features, not -for changes that are due to "personal" preference.) - -(The latest feature and bug fixes for this new version are listed later.) - -You will be receiving 11 files: - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) ALLMACS.MAR - 10) BULLCOMS.HLP - 11) BULLET.COM - (They will be indentified in the SUBJECT header.) -BULLET.COM is a command procedure which when run, will create several small -files. After you run it, you can delete it. -Read AAAREADME.TXT for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS MAIL -utility, you will have to strip off any mail headers that are present, including -blank lines. A command procedure is included at this end of this message which -can be run which uses EDT to do this for you. - -SECOND NOTE: The feature which allows setting up folders to be publicly -readable but with limited access for writing requires at least VMS VERSION 4.4, -as the code uses a new system service $CHECK_ACCESS. The code is in -BULLETIN4.FOR, and instructions are there for how to comment it out if you are -running an earlier version. This will simply cause the feature to be disabled. -Creating fully private folders will still be possible (i.e. limited access for -both reading and writing). - -I've had various problems sending files to certain sites. I've had to reduce -file sizes in order to transfer the files, and more reduction may be necessary. -BITNET sites are being sent files without any TABs, as TABs were getting -converted to 4 spaces. Please let me know of any sites which have similar -problems (or any other type, for that matter). Thank you. - Mark London - MRL%PFCVAX@XX.LCS.MIT.EDU ------------------------------------------------------------------------------- -The following is a description of recent new features and bug fixes. - -V1.0 - -One is now able to increase the limit of the number folders to whatever you -want rather than the previous limit of 64. However, changing the limit -requires rebuilding the executable. - -/VMSMAIL added to use with SET BBOARD/SPECIAL to check if there is VMS MAIL -before running special command procedure. This saves time and avoids -needless subprocess creation. - -EXTRACT command added as synonym command to FILE (for compatibility). Also -/NEW qualifier added to create new file rather than appending to existing file. - -CREATE/BRIEF did not work properly. Although SHOW BRIEF would show that BRIEF -was set, in reality it was not. Note that help for these two commands were -also omitted. - -V1.1 - -Removed restriction that prevented GENERAL folder from being set to PRIVATE -or SEMIPRIVATE. - -Fixed bugs with regards to PRIVATE folders. If it had /BRIEF or /READNEW -defaults, a user without the ability to access that folder would get access -violation when logging in. Also, if /NOTIFY was a default, the user would get -notified. These have been fixed. Also, a bug which caused a crash when -attempting to MOVE a message to a PRIVATE folder has been fixed. - -Access to private folders besides being allowed via SET ACCESS commands, -is now allowed based on process privileges. Previously, access was allowed -based on the UAF authorized privileges rather than process privileges. - -Made MODIFY/OWNER a privileged command. Also, modifying ownership of a private -bulletin has been corrected. Previously, it did not change access correctly. -It now removes access from the old user and adds access to the new user. - -Allow the CREATE command to become privileged command via change in BULLCOM.CLD. - -Add /FOLDER qualifier to ADD command. - -Modified algorithm which deleted non-existant users from user data file when -new user logged in. For large databases, this was taking a long time, and -in fact was not very useful. - -Add /EDIT qualifier to BULLETIN command, similar to MAIL/EDIT, to cause /EDIT -to be the default for ADD & REPLACE commands. - -EX command is equal to EXIT, and is not flagged as being ambiguous (due to -conflict with EXTRACT command added in V1.0). - -Fixed bug which caused incorrect notification of new messages in folders. -Situation occurred if new message expired after user logged in. BULLETIN -would notify user that new message existed, and would place user at a -message that the user had already read. - -In login display, add line of minus signs to separate SYSTEM messages. -(This can be disabled if desired by modifying BULLMAIN.CLD). - -Fixed (?) bugs which prevented proper file conversion from older versions of -BULLETIN (circa 1985). - -V1.2 - -Added SHOW NEW command to show folders with unread new messages. This is -useful if you enter BULLETIN and are notified that there are new messages -in certain folder, and later in the session which to show which folders -still have unread messages. - -CREATE/BRIEF should have been a privileged command, but was not. It is -now privileged. - -The /ALL qualifier has been added to the SET BRIEF/NOTIFY/READNEW command. -It will modify the option for the selected option for all users. This is -in contrast to /DEFAULT, which would only modify the default for new users. -This is a privileged command. - -When reading messages, the name of the folder is displayed on the top line -at the upper right hand corner (similar to MAIL). - -V1.3 - -Fixed bug introduced in V1.1 that would put wrong subject in MOVED message. - -/EDIT feature now correctly recognizes MAIL$EDIT definitions of CALLABLE_EDT -and CALLABLE_TPU. - -Messages sent via BBOARD that have lines containing greater than 80 characters -are now broken into separate lines rather than truncated. - -V1.31 - -SEARCH did not work as advertised. It would start the search at the currently -read message rather than at the beginning of the folder. This has been fixed. -Additionally, a /START qualifier has been added to the command. -------------------------------------------------------------------------------- -$ set nover -$ edit/edt/nocommand allmacs.mar -'; Name: SETACC.MAR' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin0.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin1.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin2.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin3.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin4.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin5.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin6.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bullcoms.hlp -'1 ADD' -d 1:.-1 -exit -$ edit/edt/nocommand bullet.com -'$set nover' -d 1:.-1 -exit diff --git a/decus/lt89b1/bulletin/aaareadme.1st b/decus/lt89b1/bulletin/aaareadme.1st deleted file mode 100644 index 4a4b898..0000000 --- a/decus/lt89b1/bulletin/aaareadme.1st +++ /dev/null @@ -1,158 +0,0 @@ -Note: Source code is in BULLETIN.ZOO. Use ZOO to extract files if needed. - -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utility PMDF. If you wish to -do so for another utility, read the text file WRITEMSG.TXT. I would be glad to -include any such programs with my distribution if you think such a program -would be of use to other users. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, you may have to modify the subroutine - which executes the RESPOND command. That command sends messages to either - the originator of the message or the mailing list associated with the - folder. These routines assume that one can simply use the VMS MAIL - utility to do so. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - - BULLETIN will work for both V4 & V5. However, you will have to reassemble - ALLMACS.MAR if you are upgrading from V5, i.e. - $ MAC ALLMACS - $ LIB BULL ALLMACS - $ DELETE ALLMACS.OBJ; - $ @BULLETIN.LNK - $ COPY BULLETIN.EXE BULL_DIR: - $ RUN SYS$SYSTEM:INSTALL - BULL_DIR:BULLETIN/REPLACE - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require different - linked executables.) - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. diff --git a/decus/lt89b1/bulletin/aaareadme.txt b/decus/lt89b1/bulletin/aaareadme.txt deleted file mode 100644 index 9abfe5b..0000000 --- a/decus/lt89b1/bulletin/aaareadme.txt +++ /dev/null @@ -1,24 +0,0 @@ - BULLETIN - -Note: Source code is in BULLETIN.ZOO. Use ZOO to extract files if needed. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - diff --git a/decus/lt89b1/bulletin/allmacs.mar b/decus/lt89b1/bulletin/allmacs.mar deleted file mode 100644 index f8a6793..0000000 --- a/decus/lt89b1/bulletin/allmacs.mar +++ /dev/null @@ -1,270 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - - .END diff --git a/decus/lt89b1/bulletin/board_digest.com b/decus/lt89b1/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/lt89b1/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/lt89b1/bulletin/board_special.com b/decus/lt89b1/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/lt89b1/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/lt89b1/bulletin/bullcom.cld b/decus/lt89b1/bulletin/bullcom.cld deleted file mode 100644 index 714b8ec..0000000 --- a/decus/lt89b1/bulletin/bullcom.cld +++ /dev/null @@ -1,418 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 8/8/89 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER RESTART - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB POST - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REVERSE - QUALIFIER SUBJECT - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLUSTER, DEFAULT - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NOT ALL AND NOT DEFAULT AND CLUSTER - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER LOGIN - QUALIFIER NOLOGIN - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) diff --git a/decus/lt89b1/bulletin/bullcoms1.hlp b/decus/lt89b1/bulletin/bullcoms1.hlp deleted file mode 100644 index 2d78dd0..0000000 --- a/decus/lt89b1/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,610 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does not -change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this assumes -that the remote node is capable of supporting this feature, i.e. the BULLCP -process is running on that node. If it is not, you will receive an error -message). If the the foldername is specified with only a nodename, -i.e. FOO::, the foldername is assumed to be GENERAL. NOTE: Specifying -remote nodes is only possible if that remote node is running a special -BULLCP process. If it isn't, the only way to add messages to that remote -node is via the /NODE command. However, /FOLDER is a much quicker method, -and much more versatile. - -You can specify logical names which translate to one or more folder names. -I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify /NODES= -ALL_FOLDERS. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL - -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See installation -notes). You can specify a different username to use at the other nodes by -either using the USERNAME qualifier, or by specifying the nodename with 2 -semi-colons followed by the username, i.e. nodename::username. If you -specify a username, you will be prompted for the password of the account -on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /PERMANENT -This option is restricted to privileged users for the GENERAL folder, -but available to all in other folders. If specified, message will be a -permanent message and will never expire. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /TEXT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 BACK -Displays the message preceding the current message. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. If the text of the message -is to be changed, a file can be specified which contains the text. -Otherwise, you will be prompted for the text. The expiration info and -header can also be changed. If neither no qualifiers are added to the -command, it is assumed the whole message will be replaced. - - Format: - CHANGE [file-name] -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. This only applies to the GENERAL folder. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number - -Specifies the message number to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically selected -(see information on SELECT command). The commands that can be used to -modify the folder's characteristics are: MODIFY, REMOVE, SET ACCESS, -SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the folder -is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying BULLCOM.CLD. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST -2 /NODE - /NODE=nodename -Specifies that the folder is a remote folder at the specified nodename. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified nodename is checked -to see if a folder of the same name is located on that node. If so, the -folder will point to that folder. This capability is only present if the -BULLCP process is created on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If one node add a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -That information is only updated every 15 minutes (same algorithm for -updating BBOARD messages), or if a user accesses that folder. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. By default, -the GENERAL folder is a SYSTEM folder. This is a privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 CURRENT - -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message. -It can be a substring of the subject. This is in case you have forgotten -the exact subject that was specified. Case is not critical either. -You will be notified if the deletion was successful. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting messages -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of folder. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected using the SELECT command. -2 /NEW -Specifies to start the listing of messages with the first unread message. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified. - - Format: - FILE [message_number][-message_number1] - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5. -2 /ALL -Copies all the messages in the current folder. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 Folders -All messages are divided into separate folders. The default folder is -GENERAL. New folders can be created by any user. As an example, the -following creates a folder for GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that -user will be alerted of topics of new messages at login time, and will -then be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in the -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote DECNET -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP) -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. By default, the GENERAL folder -is a SYSTEM folder (and cannot be changed). One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the GENERAL -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, and -giving access to that UIC group. Only users in that UIC group will see -the messages in that folder when they log in. -1 HELP -To obtain help on any topic, type: - - HELP topic - -CTRL-Y only breaks out of a command when no files are open. Otherwise, -use CTRL-C, which will abort the program. However, unlike CTRL-Y, you -can not resume execution using the VMS CONTINUE command. Also note that -CTRL-C will not abort if BULLETIN is waiting for input from the terminal. -1 INDEX -Gives directory listing of all folders in alphabetical order. If the -INDEX command is re-entered while the listing is in progress, the listing -will skip to the next folder. This is useful for skipping a particular -folder. It also can be used to continue the listing from where one left -off after one has read a message. - - Format: - INDEX -2 /MARKED -Shows only messages that have been marked (indicated by an asterisk). -2 /NEW -Specifies to start the listing of each folder with the first unread message. -Otherwise, the listing will start with the first message in the folder. -If the INDEX command is re-entered for continuing the listing, /NEW must -be respecified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/TE|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/TE| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL utility. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers] - -NOTE: The list of marked messages are stored in a file username.BULLMARK -in the directory pointed to by the logical name BULL_MARK. If BULL_MARK -is not defined, an error message will be displayed when attempting to -mark a message. BULL_MARK may be defined system wide, depending on -whether the system manager has decided to do so. -1 MODIFY -Modifies the database information for the current folder. Only the owner -of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However, -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. diff --git a/decus/lt89b1/bulletin/bullcoms2.hlp b/decus/lt89b1/bulletin/bullcoms2.hlp deleted file mode 100644 index aa0df98..0000000 --- a/decus/lt89b1/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,755 +0,0 @@ -1 POST -Sends a message via MAIL to the network mailing list which is -associated with the selected folder. This command is used in -conjunction with a folder which receives messages from a network -mailing list. The address of the mailing list must be stored using -either CREATE/DESCRIPTION or MODIFY/DESCRIPTION. See help on those -commands for more information. -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 /TEXT -Specifies that the text of the message that is being read should be -included in the mai message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with > at the -beginning of each line. This can be suppressed with /NOINDENT. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The PRINT command can take optional qualifiers. - - Format: - - PRINT [message_number][-message_number1] - -A range of messages to be printed can optionally be specified, i.e. -FILE 2-5. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder will -be displayed. However, if there are new messages, the first new message -will be displayed. Each time you enter the command, the next page, or if -there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply hitting -the key is equivalent to "READ". -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected using the SELECT command. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged -user can remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /TEXT. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /TEXT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -2 /TEXT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing -the first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header. -If a "search-string" is not specified, a search is made using the -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the last -message. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default general messages. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database -for which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created -via ACLs. If a user's process privileges are set to override ACLs, -that user will be able to access the folder even if access has not -been granted. -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains -a comma must be enclosed in quotes. UICs can contain wildcards, -i.e. "[130,*]". Note that by default, a process is given the -process rights id SYS$NODE_nodename, where nodename is the decnet -nodename. Thus, by specifing this id, a folder can be restricted -to a specific node, which is useful when the folder is shared among -nodes in a cluster. - -Alternatively, the id-name can be a filename which contains a list -of ids. The filename should be preceeded by a "@". If the suffix -is not specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. -If /READ is not specified, the folder will no longer be private. -If /READ is specified, all users will have read access, but only -privileged users will have write access (of course non-privileged -users can gain access via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which affect -detached subprocesses are usually too low for the subprocess which -is spawned to read the mail. The parameters and the suggested values are: -PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, and PQL_DFILLM = 30. If you -are not using the BULLCP process, the subprocess limit for users must be -at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET STRIP -and SET DIGEST for options on formatting BBOARD messages. -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time and -avoids creating subprocesses. (Useful if input is digest format.) -3 More_information - -The following is relevant only if the messages in the BBOARD accounts -are sent via a method that causes the name of the account to be placed -in the TO: line of the VMS MAIL. The normal MAIL utility, of course, -does this. However, packages such as PMDF (and probably many others) -will not always do this. (I.e. if the mail was sent to the account -using CC:, the address of the person to whom the mail was sent will be -placed in the TO: line rather than the CC: address.) - -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail forwarded -to BBOARD accounts that don't have /SPECIAL set. Folders of the same -type, i.e. that use the same /SPECIAL command procedure, must be grouped -separately. -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. This cannot be specified for -the GENERAL folder. The BRIEF setting contrasts with the READNEW -setting, which causes a listing of the description of the new messages -to be displayed and prompts the user to read the messages. Setting -BRIEF will clear a READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest limit -that can be specified is 30 days. This can be overridden by a user with -privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will -be used. - - Format: - - SET DEFAULT_EXPIRE days - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, -the messages will be separated into individual BULLETIN messages. - - Format: - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory. - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. -(NOTE: SHOW FOLDER/FULL is a privileged command.) -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one exists. -(NOTE: SHOW FOLDER/FULL is a privileged command.) -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by many -different people. If an account is specified as GENERIC, new messages -placed in the GENERAL folder will be displayed upon logging in for a -specific number of days, rather than only once. The default period is 7 -days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new GENERAL messages will be displayed -for upon logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will -not occur if DISMAIL is set for an old account. Additionally, removing -the DISMAIL flag will not automatically enable LOGIN. (The reason for -the above was to avoid extra overhead for constant checking for the -DISMAIL flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NODE -Modifies the selected folder from a local folder to a remote folder. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The SET NODE command specifies -the name of the remote node, and optionally the name of the remote -folder. If the remote folder name is not included, it is assumed to -be the same as the local folder. When the command is executed, the -selected folder will then point to the remote folder. If there were -messages in the local folder, they will be deleted. This feature is -present only if the BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that folder. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -This command does not presently work for remote folders. - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are logged -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. - -If cluster notification is set, users will not be able to disable -notification for themselves. This is because VMS is unable to find out -user names logged in at other nodes, which requires BULLETIN to keep a -list of users to notify. If /ALL is specified, the list may be very -large, which would cause the notification process to take a very long -time. It is much easier to simply notify all users. However, this can -be overriden by the /NOCLUSTER qualifier, which will cause the list to -be generated. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. - -If cluster notification is set, all users will notificated, and users -will not be able to disable notification for themselves. This is -because VMS is unable to find out user names logged in at other nodes, -which requires BULLETIN to keep a list of users to notify. If /DEFAULT -is specified, the list may be very large, which would cause the -notification process to take a very long time. It is much easier to -simply notify all users. However, /NOCLUSTER will override this, -causing the list to be generated. -3 /CLUSTER - /[NO]CLUSTER - -Specifies that if /ALL or /DEFAULT has been selected, and cluster -notification is enabled, all users across the network will be notified -of new messages. Users will not be able to disable notification. -This is the default. /NOCLUSTER will disable this causing /DEFAULT -and /ALL to work as it normally does, i.e. /DEFAULT simply setting -the default for new users, and /ALL causing all users to be notified -while enabling users to disable notification. However, if your system -has a lot of users, this will cause the notification algorithm to take -a very long time. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format: - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. -To remove a privilege, specify the privilege preceeded by "NO". -If /ID is specified, the parameters are rights identifiers. -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed. -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when adding -a message. If NOPROMPT_EXPIRE is specified, the user will not be prompted, -and the default expiration (which is set by SET DEFAULT_EXPIRE or SET -BBOARD/EXPIRATION) will be used. If the value specified is greater than the -expiration limit, and the user does not have privileges, then the expiration -limit will be used as the default expiration. (If there is no expiration -limit, and the user doesn't have privileges, then an error will result.) -PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to read -new non-system or folder messages (if any exist). The default is dependent -on how the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. -For messages in folders other than the GENERAL folder, both prompting -and display of topics of new messages are controlled by this command. -For the GENERAL folder, the display of topics cannot be disabled. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP -SET SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. -This command cannot be used for the GENERAL folder. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -2 STRIP -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped off -before it is stored as a BULLETIN message. - - Format: - - SET [NO]STRIP - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -By default, the GENERAL folder is a SYSTEM folder, and the setting for -that folder cannot be removed. - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected via -the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 KEYPAD -Displays the keypad command definitions. If the keypad has been enabled -by either the SET KEYPAD COMMAND, or /KEYPAD is specified on the command -line, the keypad keys will be defined as commands. SHOW KEYPAD is the -equivalent of HELP KEYPAD. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in. If NOLOGIN is set for a user, -this information will be displayed instead. This is a privileged command. -Non-privileged users will only be able to display the information for -their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some sites -make BULLETIN/LOGIN an optional command for users to store in their own -LOGIN.COM, so this command can be used to show which users have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGIN - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -2 VERSION -Shows the version of BULLETIN and the date that the executable was linked. -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 UNDELETE -Undeletes the specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have their -expiration date set to 15 minutes in the future and are deleted then. -Undeleting the message will reset the expiration date back to its original -value. Deleted messages will be indicated as such by the string (DELETED) -when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] diff --git a/decus/lt89b1/bulletin/bulldir.inc b/decus/lt89b1/bulletin/bulldir.inc deleted file mode 100644 index 640dc6c..0000000 --- a/decus/lt89b1/bulletin/bulldir.inc +++ /dev/null @@ -1,33 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(LINE_LENGTH) diff --git a/decus/lt89b1/bulletin/bullet1.com b/decus/lt89b1/bulletin/bullet1.com deleted file mode 100644 index 6d101e2..0000000 --- a/decus/lt89b1/bulletin/bullet1.com +++ /dev/null @@ -1,778 +0,0 @@ -$set nover -$copy sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utility PMDF. If you wish to -do so for another utility, read the text file WRITEMSG.TXT. I would be glad to -include any such programs with my distribution if you think such a program -would be of use to other users. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, you may have to modify the subroutine - which executes the RESPOND command. That command sends messages to either - the originator of the message or the mailing list associated with the - folder. These routines assume that one can simply use the VMS MAIL - utility to do so. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - - BULLETIN will work for both V4 & V5. However, you will have to reassemble - ALLMACS.MAR if you are upgrading from V5, i.e. - $ MAC ALLMACS - $ LIB BULL ALLMACS - $ DELETE ALLMACS.OBJ; - $ @BULLETIN.LNK - $ COPY BULLETIN.EXE BULL_DIR: - $ RUN SYS$SYSTEM:INSTALL - BULL_DIR:BULLETIN/REPLACE - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require different - linked executables.) - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. -$eod -$copy sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(LINE_LENGTH) -$eod -$copy sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in it's memory. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -$eod -$copy sys$input BULLETIN.LNK -$deck -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB- - /EXE=BULLETIN,SYS$INPUT/OPT -ID="V1.75" -$eod -$copy sys$input BULLFILES.INC -$deck -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF IT -C IS NOT, THEN THEY SHOULD ALSO BE CHANGED. -C - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ -$eod -$copy sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,FILLER, - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) -$eod -$copy sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod -$copy sys$input WRITEMSG.TXT -$deck -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/lt89b1/bulletin/bullet2.com b/decus/lt89b1/bulletin/bullet2.com deleted file mode 100644 index c5f9db5..0000000 --- a/decus/lt89b1/bulletin/bullet2.com +++ /dev/null @@ -1,1074 +0,0 @@ -$set nover -$copy sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 8/8/89 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER RESTART - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB POST - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REVERSE - QUALIFIER SUBJECT - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLUSTER, DEFAULT - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NOT ALL AND NOT DEFAULT AND CLUSTER - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER LOGIN - QUALIFIER NOLOGIN - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) -$eod -$copy sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") -$eod -$copy sys$input BULLETIN.COM -$deck -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -$eod -$copy sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER,DEFAULT="7") -$eod -$copy sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy sys$input CREATE.COM -$deck -$ FORTRAN/EXTEND BULLETIN -$ FORTRAN/EXTEND BULLETIN0 -$ FORTRAN/EXTEND BULLETIN1 -$ FORTRAN/EXTEND BULLETIN2 -$ FORTRAN/EXTEND BULLETIN3 -$ FORTRAN/EXTEND BULLETIN4 -$ FORTRAN/EXTEND BULLETIN5 -$ FORTRAN/EXTEND BULLETIN6 -$ FORTRAN/EXTEND BULLETIN7 -$ FORTRAN/EXTEND BULLETIN8 -$ FORTRAN/EXTEND BULLETIN9 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB; -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIB/CREATE BULL -$ LIB BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK -$eod -$copy sys$input DCLREMOTE.COM -$deck -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET -$eod -$copy sys$input INSTALL.COM -$deck -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy sys$input INSTALL_REMOTE.COM -$deck -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL -$eod -$copy sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy sys$input LOGIN.COM -$deck -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! -$eod -$copy sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V1.68" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin9.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* -$eod -$copy sys$input REMOTE.COM -$deck -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP -$eod diff --git a/decus/lt89b1/bulletin/bulletin.cld b/decus/lt89b1/bulletin/bulletin.cld deleted file mode 100644 index 7b0312a..0000000 --- a/decus/lt89b1/bulletin/bulletin.cld +++ /dev/null @@ -1,36 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") diff --git a/decus/lt89b1/bulletin/bulletin.com b/decus/lt89b1/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/lt89b1/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/lt89b1/bulletin/bulletin.for b/decus/lt89b1/bulletin/bulletin.for deleted file mode 100644 index 3c598b4..0000000 --- a/decus/lt89b1/bulletin/bulletin.for +++ /dev/null @@ -1,1413 +0,0 @@ -C -C BULLETIN.FOR, Version 10/24/89 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$GET_FOREIGN(INCMD) - CALL CLI$DCL_PARSE('BULLETIN '//INCMD,BULLETIN_MAINCOMMANDS) - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - END IF - CALL LIB$REVERT - - READIT = 0 - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP')) THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - CALL RUN_BULLCP ! doing what BULLCP does! - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL SHOW_SYSTEM - CALL EXIT - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - CALL NEW_MESSAGE_NOTIFICATION - - CALL OPEN_OLD_TAG - - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - - DO WHILE (1) - - CALL GET_INPUT_PROMPT(INCMD,IER, - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9') - IER = IER - 1 - END DO - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - - IER = MIN(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - CALL ADD - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - GO TO 999 ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 99999 - CALL READ(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.) - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEXT') THEN ! NEXT? - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - CALL REPLY - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(1,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(0,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET SHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,1) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(1,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOSHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET BRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,1) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(1,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOBRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (NBULL.GT.0) THEN - DIFF = COMPARE_BTIM( - & LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - END IF - END IF - END DO - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.) - END IF - -100 CONTINUE - - END DO - -999 CALL EXIT - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER*(LINE_LENGTH) INDESCRIP - - CHARACTER INLINE*80,OLD_FOLDER*25,LOCAL_NODE*8 - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - ELSE IF (CLI$PRESENT('TEXT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET? - USERNAME = DEFAULT_USER - CALL CONFIRM_PRIV(USERNAME,ALLOW) - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privileges - WRITE(ERROR_UNIT,1081) ! Tell user - GO TO 910 ! and abort - ELSE IF (F_EXPIRE_LIMIT.GT.0.AND..NOT.ALLOW ! Expiration limit - & .AND.USERNAME.NE.FOLDER_OWNER) THEN ! is present - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - WRITE (INEXTIME,'(I4)') NODE_NUMBER - WRITE (INEXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - INDESCRIP = DESCRIP ! Use description with RE:, - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IF - - ICOUNT = 0 ! Line count for bulletin - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolons - ILEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Are semicolon found? - IF (ILEN.GT.SEMI+1) THEN ! Is username found? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes - ILEN = SEMI - 1 ! Remove semicolons - ELSE ! No username found... - TEMP_USER = DEFAULT_USER ! Set user to default - ILEN = SEMI - 1 ! Remove semicolons - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons present - TEMP_USER = DEFAULT_USER ! Set user to default - END IF - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:ILEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - INLINE = INLINE(:STR$POSITION(INLINE,' ')-1) - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = LEN(LOCAL_NODE) - LUSER = LEN(USERNAME) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - BRDCST = .FALSE. - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - FROM = USERNAME ! Username - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - CALL STORE_BULL(LNODE+LUSER+6,'From: '// - & LOCAL_NODE(:LNODE)//USERNAME(:LUSER),OBLOCK) - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF - CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - CALL ADD_ENTRY ! Add the new directory entry - - IF (FOLDER_NUMBER.GE.0) THEN - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add - ELSE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (CLI$PRESENT('TEXT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanent - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*23 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*8 LOCALNODE - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE(4) - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE (4) - - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP) - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - DESCRIP = 'RE: '//DESCRIP - ELSE - DESCRIP = 'RE:'//DESCRIP(4:) - END IF - WRITE (6,'(1X,A)') DESCRIP - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - CALL CHECK_BULLETIN_PRIV(USERNAME) - - RETURN - END - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - CHARACTER*255 COMMAND - - CALL DISABLE_PRIVS - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - CALL LIB$SPAWN('$'//COMMAND(:CLEN)) - ELSE - CALL LIB$SPAWN() - END IF - CALL ENABLE_PRIVS - - RETURN - END diff --git a/decus/lt89b1/bulletin/bulletin.hlp b/decus/lt89b1/bulletin/bulletin.hlp deleted file mode 100644 index b3e6d24..0000000 --- a/decus/lt89b1/bulletin/bulletin.hlp +++ /dev/null @@ -1,108 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in it's memory. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) diff --git a/decus/lt89b1/bulletin/bulletin.info b/decus/lt89b1/bulletin/bulletin.info deleted file mode 100644 index d99a583..0000000 --- a/decus/lt89b1/bulletin/bulletin.info +++ /dev/null @@ -1,411 +0,0 @@ -From: IN%"BULLETIN@PFCVAX.PFC.MIT.EDU" 26-OCT-1989 18:48:30.28 -To: TNIELAND -CC: -Subj: BULLETIN utility. - -Return-path: BULLETIN@PFCVAX.PFC.MIT.EDU -Received: from AAMRL.AF.MIL by FALCON; Thu, 26 Oct 89 18:48 EST -Received: from PFCVAX.PFC.MIT.EDU by AAMRL.AF.MIL; Thu, 26 Oct 89 18:43 EDT -Date: Thu, 26 Oct 89 17:53 EST -From: BULLETIN@PFCVAX.PFC.MIT.EDU -Subject: BULLETIN utility. -To: TNIELAND -X-VMS-To: IN%"@AAMRL.AF.MIL:TNIELAND@FALCON" -Message-id: <325D8B33AADF002445@PFCVAX.PFC.MIT.EDU> -X-Envelope-to: @AAMRL.AF.MIL:TNIELAND@FALCON - -You are about to receive version 1.75 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -NOTE: The following commands can be sent to BULLETIN@PFCVAX.PFC.MIT.EDU: - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -This version includes all necessary modifications to work under VMS -V5.0. However, it will still be necessary to reassemble the ALLMACS.MAR -source under V5 and relink. The V4 version will not be installable -under V5 due to a change in a shared library which BULLETIN uses. -However, relinking by itself will not be enough. You MUST also -reassemble ALLMACS.MAR. If you only relink, BULLETIN can cause your -system to crash (the BULLCP process will do this because it uses the -routines in ALLMACS.MAR). - -If you are running a version of BULLETIN older than 1.52, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. This -format change can take a significant amount of time if the folder is -large. If your site has large folders, it is suggested that the new -version be installed during off peak hours. NOTE: Problems can occur -if the old version of BULLETIN is run after the data files have been -modified. Such a situation is possible on a cluster where each node has -installed the executable separately. To help installation, a new -command procedure INSTALL_REMOTE.COM has been included. This can be -used to install BULLETIN on several nodes from a single node. Read the -comments in the file for information on how to use it. - -NOTE: The BULLCP process should be stopped using the BULLETIN/STOP -command before the new version of BULLETIN is installed. It can then be -restarted using the BULLETIN/STARTUP command. (The INSTALL_REMOTE.COM -command procedure does this automatically for remote nodes.) - -You will be receiving 17 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) ALLMACS.MAR - 13) BULLCOMS1.HLP - 14) BULLCOMS2.HLP - 15) BULLET1.COM - 16) BULLET2.COM - 17) PMDF.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. Otherwise, you can delete -it. Read AAAREADME.TXT for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. A command procedure is included at the -end of this message which can be run which uses EDT to do this for you. - - MRL@PFCVAX.PFC.MIT.EDU ------------------------------------------------------------------------- -V1.75 - -A bug in the data file cleanup algorithm was fixed which destroys the -acls on the folder files, therefore wiping out private and semiprivate -designations. This was introduced several versions back in order to fix -a problem with a user whose BULL_DIR directory had SET -DIRECTORY/VERSION=1 was set, as the previous algorithm created temporary -files with the same name as the old data files. The temporary files are -now creating with a different name, which was not causing the acls to be -propagated. A subroutine has been added to copy the acls. - -V1.74 - -Added /ALL qualifier on BULLETIN command. This suppresses the automatic -setting of NOLOGIN for users which have DISMAIL set. It also removes the -NOLOGIN setting if any account already has it set. - -Fixed bug in BBOARD digest code. Crash would occur if the FROM line was -empty in the digested message. - -Modified BULLETINN_MASTER to send message to POSTMASTER in the event that -PMDF mail was sent to a non-existant folder. Previously, the mail would -simply disappear without any recording of the error. - -Fixed bug which caused entering command SHOW FOLDER/ALL to crash -BULLETIN. - -V1.73 - -Modified the affect of the SET STRIP command. It now strips all headers -which appear at the top of the message. Previously it stopped stripping -headers as soon as it encountered a blank line. - -Fixed the MAIL command. It was unable to accept a quote (") in the -username. It also was unable to send mail to more than one user (even -though it accepted a username list.) - -Fixed the conversion routines which upgraded file formats from older -bulletin versions (i.e. circa 1986). - -V1.72 - -Corrected the corrections I applied in V1.71. There were a few minor -bugs, one of which can cause BULLETIN_MASTER to crash. - -Fixed bug which prevented the POST and RESPOND commands from working if -the subject line contained a quotation mark ("). Fixed bug in POST -which caused message to be sent to owner of message if /EDIT/TEXT is -specified. - -Fixed bug in MOVE command which prevented messages from being deleted -from original folder if a range of messages is specified. - -V1.71 - -The PMDF interface was not placing the proper address into the owner -field of the message. The last forwarding address was being entered -rather than the address in the From: field of the message. This has -been fixed. Also, if a Reply-to: field exists, it will be used as the -owner rather than the From: address. Additionally modified code to -correctly store usernames in digested folders so that messages can be -RESPOND'ed to. Rebuild both BULLETIN and BULLETIN_MASTER sources, and -remember to relink and reinstall BULLETIN_MASTER.EXE in order for these -changes to be installed. - -V1.70 - -Added /REVERSE qualifier for SEARCH command. - -Added ability to specify a nodename when using the /SHUTDOWN option. -This is useful in a cluster environment. Normally, the message would be -deleted only after the node on which the message was added was rebooted. -Now, any node on the cluster can now be specified. - -V1.69 - -Fixed bug which caused a user to obtain full bulletin privileges if that -user created a privileged folder. - -V1.68 - -Fixed bug which prevented SHUTDOWN messages from being deleted. - -Fixed code to allow SHOW KEY/PRINT to work properly. - -Fixed folder conversion routine which was used for updating folder data -file when either upgrading from older version of BULLETIN, or when -increasing the number of folders. Recent software changes broke it. - -Modified user data file cleanup algorithm. User entries are now deleted -only if both the user doesn't exist in the SYSUAF file, and the user has -not used BULLETIN within the last 6 months. This change solves a -problem which occurs when nodes on the same cluster use different SYSUAF -files. The node that BULLCP runs on will only see one of the SYSUAF -file, and would discard the "valid" users from the other SYSUAF. The -previous suggested solution for this was to use separate BULL_DIR and -BULLCPs. However, messages added with /BROADCAST would be seen -throughout the whole cluster, and if the same message was added to both -BULL_DIRs, the message would be seen twice.s - -V1.67 - -A bug was fixed which allowed unauthorized users to add messages to -semi-private folders by using the ADD/FOLDER command.s - -Modified algorithm which decides if a user has "BULLETIN" privileges. -There was a problem with this algorithm, in that the SET PRIV/ID command -grants privileges to a user by creating an ACL on BULLUSER.DAT. -BULLETIN privileges are granted by checking access to that file. -Unfortunately, for this to properly work, the protection on this file -must be (RWED,RWED,,). However, due to various reasons, it has been -found that the protection of this file has changed and thus allowed -non-authorized users to obtain privileges. Therefore, the checking -algorithm now makes sure that access is obtained via ACLs. However, -this will also affect users that have the ability to set process -privileges to access the file. In the past, setting those privileges -was not necessary to gain BULLETIN privileges, only the ability to set -them was necessary. Now, it is necessary to set them. - -V1.66a - -The SET NODEFAULT_EXPIRE command would not work, since it conflicted -with SET NODE. The command has been removed. Removing the default -expiration time is now accomplished by SET DEFAULT_EXPIRE 0. Setting -the value to -1 specifies that the default is that messages will become -permanent. - -V1.65o - -Added option to COPY, MOVE, FILE, and PRINT commands to be able to -specify a range of messages, i.e. m1-m2. - -Under certain conditions, BULLETIN/STARTUP could be executed such that -the BULLCP created would not fully work, due to privilege problems. -BULLETIN/STARTUP has been changed so that it will work properly. - -V1.64g - -Added SET DIGEST command for a folder. This causes network mail -messages which are in digest form to be undigested, thus avoiding the -necessity of a special command procedure to do it. - -Added SET STRIP command for a folder. This caused network mail messages -to have their mail headers stripped off. - -Added the /ALL and /FORM= qualifiers to the PRINT command. - -Added the SPAWN command. - -Fixed minor bug relating to displaying remote folder messages when -logging in. If a message was added to a remote folder less than 15 -minutes before a user on another node logged in, and that was the only -new message in the folder, it is possible that the message will not be -displayed. This is because BULLCP only updates remote folders on the -local node every 15 minutes. The fix was that when logging in, remote -folders are checked for new messages that have been added since the -previous login time plus 15 minutes. - -If a site does not have a DECNET account, BULLETIN/START will now work -without having to modify the sources. The BULLCP process will be owned -by the process which started it. - -The PMDF program now writes out the owner of the message prefixed by -IN%", so that the RESPOND command will work with requiring modification -of the sources.O - -V1.63U - -Fixed bug in deletion algorithm. If a deletion was interrupted, the -file could be left in a state such that BULLETIN would loop when -attempting to recover from the interruption. Also optimized the -recovery algorithm, as it would takes a long time to recover a large -folder.e - -Fixed bug regarding remote folders. If user flags (SHOWNEW, READNEW, -etc.) were set for a remote folder, and there was an attempt to access -the remote folder when the remote node was down, BULLETIN would assume -the folder was no longer present, and remove the flags. BULLETIN now is -smart enough to know that the node is simply down, not removed.- - -V1.62- - -Fixed exit handler to avoid possibility of default protection being -changed if BULLETIN is exited abnormally.e - -Fixed REMOVE bug relating to forgetting to change default protection. -If a user without process privileges attempts to remove a folder, and -the default protection for SYSTEM is not RWED, BULLETIN will crash.S - -The algorithm for getting the last boot time in order to determine when -to delete SHUTDOWN messages wouldn't work under V5 if the source was -compiled under V4. The routine has been rewritten so it is no longer -dependent on the VMS version. - -V1.61d - -Added SHOW USER command. Will show login times for a user (as recorded -by BULLETIN/LOGIN), and will show which users have NOLOGIN set.h - -Fixed SET LOGIN command, as it was not working.n - -V1.6 - -Changed message line length limit from 80 to 255 characters. Messages -lines longer than the terminal width will wrap when displayed. 132 -column mode is now supported. - -Message owner and subject fields have also been increased to 255 -characters.y - -In most cases, the RESPOND subroutine should no longer have to be -customized to work with a site's network mail routine. The original -message owner as stored in VMS MAIL message is copied in full, and the -RESPOND command will use that when responding via the MAIL utility.u - -The SET PRIV command now has a /ID qualifier which will allow a rights -identify to be specified. Thus, a user can be granted the ability to -execute privileged commands without the need to have higher VMS -privileges.c - -There is now a SHOW VERSION command. - -There is now a POST and RESPOND/LIST command which will send a mail -message to the network mailing list which is associated with a folder, -i.e. if a folder receives mail from a mailing list via the BBOARD -feature. The address of the mailing list is stored in the folder's -description. There is also a /CC qualifier for both POST & RESPOND. - -The ability to mark messages has been added, similar to the command in -the V5 version of VMS MAIL. New commands are MARK & UNMARK, DIR/MARKED, -READ/MARK, and SELECT/MARKED.t - -Several terminal output statements could not handle message numbers of -greater than 9999. They have been corrected.e - -Fixed bug which didn't allow proper display if page length was > 127.r - -Fixed 2 bugs associated with using the TPU editor when adding a message. -A "BULL.SCR file not found" message used to be displayed. It has now -been suppressed. Also a bug has been fixed which would cause a copy of -BULL.SCR to remain in SYS$LOGIN, if /TEXT was specified. - -Fixed bug which causes a BBOARD message to be split up if a form feedI -character occurs on a line by itself in the message. - -------------------------------------------------------------------------------- -$ set novere -$ edit/edt/nocommand allmacs.mar -'; Name: SETACC.MAR'y -d 1:.-2c -exit -$ edit/edt/nocommand bulletin.foro -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin0.for -'C BULLETIN'e -d 1:.-2y -exit -$ edit/edt/nocommand bulletin1.for -'C BULLETIN'e -d 1:.-2a -exit -$ edit/edt/nocommand bulletin2.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin3.for -'C BULLETIN' -d 1:.-2r -exit -$ edit/edt/nocommand bulletin4.for -'C BULLETIN'c -d 1:.-2e -exit -$ edit/edt/nocommand bulletin5.for -'C BULLETIN' -d 1:.-2W -exit -$ edit/edt/nocommand bulletin6.for -'C BULLETIN'r -d 1:.-2i -exit -$ edit/edt/nocommand bulletin7.for -'C BULLETIN'g -d 1:.-2o -exit -$ edit/edt/nocommand bulletin8.for -'C BULLETIN'e -d 1:.-2f -exit -$ edit/edt/nocommand bulletin9.for -'C BULLETIN'u -d 1:.-2f -exit -$ edit/edt/nocommand bullcoms1.hlp -'1 ADD'd -d 1:.-1 -exit -$ edit/edt/nocommand bullcoms2.hlp -'1 POST' -d 1:.-1h -exit -$ edit/edt/nocommand bullet1.com -'$set nover' -d 1:.-1a -exit -$ edit/edt/nocommand bullet2.com -'$set nover' -d 1:.-1e -exit -$ edit/edt/nocommand pmdf.com -'$set nover' -d 1:.-1 -exit diff --git a/decus/lt89b1/bulletin/bulletin.lnk b/decus/lt89b1/bulletin/bulletin.lnk deleted file mode 100644 index aa1c89c..0000000 --- a/decus/lt89b1/bulletin/bulletin.lnk +++ /dev/null @@ -1,3 +0,0 @@ -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB- - /EXE=BULLETIN,SYS$INPUT/OPT -ID="V1.75" diff --git a/decus/lt89b1/bulletin/bulletin0.for b/decus/lt89b1/bulletin/bulletin0.for deleted file mode 100644 index 506fad3..0000000 --- a/decus/lt89b1/bulletin/bulletin0.for +++ /dev/null @@ -1,1453 +0,0 @@ -C -C BULLETIN0.FOR, Version 10/6/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = I + 1 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IF - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - - - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER) - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.REMOTE_USER.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,DESCRIP - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(1:11) - NEWEST_EXTIME = INPUT(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - DO BULL_DELETE = SBULL,EBULL - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM) - IER = SYS$ASCTIM(,INPUT,EX_BTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:) - - CALL WRITEDIR(0,IER) - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT - - CHARACTER START_PARAMETER*16,DATETIME*23 - - INTEGER TODAY(2) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (INCMD(:3).EQ.'DIR'.AND..NOT.READ_TAG) THEN - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').AND. - & CLI$PRESENT('MARKED')) THEN - IF (FOLDER_NUMBER.GE.0) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: Cannot use /MARKED with'', - & '' remote folder.'')') - RETURN - END IF - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified? - IER = CLI$GET_VALUE('START',START_PARAMETER,ILEN) - DECODE(ILEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEN - DIR_COUNT = NBULL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - END IF - - CALL READDIR_KEYGE(IER) - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - RETURN - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IF (READ_TAG) THEN - IF (.NOT.(CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW') - & .OR.CLI$PRESENT('START'))) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - END IF - - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - END IF - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THEN - EBULL = NBULL - END IF - IF (.NOT.REMOTE_SET.AND..NOT.READ_TAG) THEN - DO I=SBULL,EBULL ! Copy messages from file - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - END DO - ELSE IF (READ_TAG) THEN - I = SBULL - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) EBULL = EBULL - 1 - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,SBULL,EBULL - IF (IER.EQ.0) THEN - I = SBULL - DO WHILE (IER.EQ.0.AND.I.LE.EBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - RETURN - END IF - END IF - ELSE - NBULL = 0 - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - IF (NBULL.EQ.0) THEN - WRITE (6,'('' There are no messages present.'')') - RETURN - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - FLEN = TRIM(FOLDER) - WRITE(6,'(X,A)') FOLDER(:FLEN) - WRITE(6,1000) ! Write header - N = 3 - - IF (BULL_TAG.AND..NOT.READ_TAG) THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - DO I=SBULL,EBULL - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - IF (MSG_NUM.GT.999) N = 4 - IF (MSG_NUM.GT.9999) N = 5 - IF (READ_TAG.OR.(BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG)) THEN - WRITE (6,'('' *'',$)') - ELSE - WRITE (6,'('' '',$)') - END IF - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM,'(DELETED)' - ELSE - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM, - & DATE(1:7)//DATE(10:11) - END IF - IF (BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (DIR_COUNT.GT.NBULL.OR.(READ_TAG.AND.IER1.NE.0)) THEN - ! Outputted all entries? - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - -2010 FORMAT('+',I,1X,A<55-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1015) - RETURN - END IF - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And return - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - DO FBULL = SBULL,EBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1) THEN ! Was bulletin found? - WRITE(6,1030) FBULL - IF (FBULL.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_PARAMETER(1:LEN_P) - ! Show name of file created. - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - - RETURN - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message(s) written to ',A) -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*23,INREAD*1 - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - DIMENSION NOLOGIN_BTIM(2),LOGIN_BTIM_SAVE(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL MODIFY_SYSTEM_LIST(1) - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - ELSE - RETURN ! Don't notify - END IF - END IF - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry - READ_BTIM(2) = NEW_BTIM(2) - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - ELSE - LOGIN_BTIM_SAVE(1) = NEW_BTIM(1) - LOGIN_BTIM_SAVE(2) = NEW_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - BBOARD_BTIM(1) = TODAY_BTIM(1) - BBOARD_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - IF (.NOT.TEST_BULLCP()) CALL CREATE_BBOARD_PROCESS - ELSE - CALL CLOSE_BULLUSER - IF (IER.NE.0) CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compare - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - - IF (NEW_FLAG(2).NE.0) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - RETURN - END IF - -C -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible. -C - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.FOLDER_SET) THEN - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IF - - IF (REMOTE_SET) THEN ! If system remote folder, use remote - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, ! info, not local login time - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - LOGIN_BTIM(1) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (FOLDER_NUMBER.GT.0.AND.BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST2(SET_FLAG,FOLDER_NUMBER) - & .AND..NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) RETURN - ! Don't overwhelm new user with lots of non-general msgs - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - LOGIN_BTIM(1) = SYSTEM_LOGIN_BTIM(1) ! Use specified login time - LOGIN_BTIM(2) = SYSTEM_LOGIN_BTIM(2) ! for system messages. - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF (REVERSE_SWITCH.AND.(.NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,NBULL - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,NBULL,START - END IF - IF (IER.EQ.0) THEN - ALL_DIR = ALL_DIR1 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.NBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - RETURN - END IF - ALL_DIR = ALL_DIR1 - END IF - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - ! No. Is bulletin system or from same user? - IF (.NOT.REVERSE) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (SYSTEM_SWITCH) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - ELSE - DIFF = -1 - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF (SYSTEM.EQ.3) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0) THEN ! And save only the first non-system msg - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (NGEN.EQ.0.AND.NSYS.EQ.0) RETURN - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - RETURN - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - RETURN - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) '+'//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) '+'//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - ELSE - PAGE = PAGE + 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) ' '//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) ' '//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - IF (SYSTEM.GT.9999) THEN ! # Digits in message number - N = 5 - ELSE IF (SYSTEM.GT.999) THEN - N = 4 - ELSE - N = 3 - END IF - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD,INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:56-N),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:56-N),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST2(SET_FLAG,FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - ELSE - FLEN = TRIM(FOLDER) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 49 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-48)// - & ' command can be used to read these messages.' - ELSE - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-49-FLEN) - & //' '//FOLDER(:FLEN)// - & ' command can be used to read these messages.' - END IF - END IF - - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<57-N>,1X,A12,1X,A6,<6-N>X,I) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IF - - RETURN - END - diff --git a/decus/lt89b1/bulletin/bulletin1.for b/decus/lt89b1/bulletin/bulletin1.for deleted file mode 100644 index fc51748..0000000 --- a/decus/lt89b1/bulletin/bulletin1.for +++ /dev/null @@ -1,1565 +0,0 @@ -C -C BULLETIN1.FOR, Version 9/26/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (MAIL_SUBJECT(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - MAIL_SUBJECT(I:I) = '`' - ELSE - MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_P = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_P = LEN_P + I + 1 - BULL_PARAMETER(LEN_P:LEN_P) = ',' - END DO - LEN_P = LEN_P - 1 - - I = 1 ! Must change all " to "" in MAIL recipients - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:I)//'"'// - & BULL_PARAMETER(I+1:) - I = I + 1 - LEN_P = LEN_P + 1 - END IF - I = I + 1 - END DO - - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) - & //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,STATUS) - CALL ENABLE_PRIVS - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - EXTERNAL BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*25 - - IF (CLI$PRESENT('ORIGINAL').AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - END IF - END IF - - FROM_REMOTE = REMOTE_SET - - IF (REMOTE_SET) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.0) THEN - CALL OPEN_BULLFIL - I = BULL_POINT - 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THEN - IF (I.EQ.0) THEN - WRITE (12,IOSTAT=IER1) BULLDIR_HEADER - ELSE - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - END IF - NBLOCK = 1 - DO WHILE (I.LT.BULL_POINT+NUM_COPY-1.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THEN - BLOCK = NBLOCK - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - IF (IER1.EQ.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER1) 5,I - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - END IF - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT(:128)) - WRITE (11'NBLOCK,IOSTAT=IER1) INPUT(:128) - NBLOCK = NBLOCK + 1 - END DO - END IF - IF (IER1.NE.0) I = IER - END IF - END DO - NUM_COPY = I - BULL_POINT + 1 - END IF - CALL CLOSE_BULLFIL - IF (IER1.NE.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=11) - CLOSE (UNIT=12) - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IF - - IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_BULLDIR ! Prepare to add dir entry - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND. - & .NOT.SETPRV_PRIV().AND..NOT.ALL) THEN ! Permanent? - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.CLI$PRESENT('ORIGINAL')) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END DO - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - CLOSE (UNIT=11) - - CLOSE (UNIT=12) - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0) THEN - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE - END IF - END IF - - RETURN - - END - - - - - SUBROUTINE PRINT -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*31 FORM_NAME - - PARAMETER FF = CHAR(12) - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1015) - RETURN - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - CALL OPEN_BULLDIR_SHARED - - CALL OPEN_BULLFIL_SHARED - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified message - - IF (IER.NE.I+1) THEN ! Was message found? - IF (I.EQ.SBULL) THEN ! No, were any messages found? - WRITE(6,1030) ! If not, then error out - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE ! Yes, message found. - IF (I.GT.SBULL) WRITE(3,'(A)') FF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - END IF - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) ! Get queue name - IF (ILEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - ILEN = 9 - END IF - - CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IF - - IF (CLI$PRESENT('FORM')) THEN - IER = CLI$GET_VALUE('FORM',FORM_NAME,FORM_NAME_LEN) - CALL ADD_2_ITMLST(FORM_NAME_LEN,SJC$_FORM_NAME,%LOC(FORM_NAME)) - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*11,DATETIME*23,BUFFER*(LINE_LENGTH) - CHARACTER SAVE_MSG_KEY*8 - - LOGICAL SINCE,PAGE - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - IF (CLI$PRESENT('MARKED')) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No marked messages found.'')') - RETURN - ELSE - READ_TAG = .TRUE. - END IF - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - RETURN - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IF - - IF (READ_TAG) THEN - NEXT = .FALSE. - IF (INCMD(:4).EQ.'NEXT'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - IF (.NOT.CLI$PRESENT('BULLETIN_NUMBER')) NEXT = .TRUE. - END IF - IF (INCMD(:4).EQ.'BACK') THEN - SAVE_MSG_KEY = MSG_KEY - MSG_KEY = BULLDIR_HEADER - I = 0 - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_KEY.NE.SAVE_MSG_KEY) - I = I + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO - IF (IER.EQ.0) THEN - MSG_KEY = BULLDIR_HEADER - DO J=1,I-1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - ELSE IF (NEXT) THEN - IF (SINCE) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - ELSE - IF (BULL_POINT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END IF - IF (IER.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND. - & (.NOT.READ_TAG.OR.(.NOT.NEXT.AND.INCMD(:4).NE.'BACK'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IF - - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2) - END IF - - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'CURR') THEN - IF (CLI$PRESENT('EDIT')) THEN - CALL READ_EDIT - RETURN - END IF - END IF - - FLEN = TRIM(FOLDER) - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - WRITE (INPUT,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULL - DO WHILE (INDEX(INPUT,' ').LT.TRIM(INPUT)) - I = INDEX(INPUT,' ') - INPUT(I:) = INPUT(I+1:) - END DO - I = TRIM(INPUT) - INPUT = ' #'//INPUT(2:TRIM(INPUT)) - INPUT(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//INPUT(:TRIM(INPUT)) - ELSE - WRITE(6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - - END = END + 1 - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - WRITE(6,'('' From: '',A)') FROM - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - ELSE - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - END IF - WRITE(6,'('' Subj: '',A)') DESCRIP - END = END + 1 - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - WRITE(6,'(1X)') - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE (BUFFER,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULL - DO WHILE (INDEX(BUFFER,' ').LT.TRIM(BUFFER)) - I = INDEX(BUFFER,' ') - BUFFER(I:) = BUFFER(I+1:) - END DO - BUFFER = ' #'//BUFFER(2:TRIM(BUFFER)) - BUFFER(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN) - WRITE(6,'(1X,A,/)') BUFFER(:TRIM(BUFFER)) ! Output header info - END = END + 2 ! Increase display counter - END IF - -200 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - - RETURN - -1030 FORMAT(' ERROR: Specified message was not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE READ_EDIT - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_BULLFIL - - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,' Date: ',A) - - RETURN - END - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - CHARACTER INREAD*1,FILE_DEF*80,NUMREAD*5 - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH,ERR=18,STATUS='UNKNOWN', - & CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END DO - IF (ILEN.EQ.0) WRITE(6,1040) BULL_PARAMETER(:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - IF (READ_COUNT.GT.0) THEN ! Reposition GET_BULL routine - ILEN = LINE_LENGTH + 1 ! in case read in progress - DO I=1,LINE_OFFSET ! and partial block was read. - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - END IF - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message - & number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit), - & F(File it), D(Dir), R(Read msg #) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit), F(File), N(Next), - & D(Dir), R(Read msg #) or other for MORE: ',$) -1040 FORMAT(' Message written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER_OWNER) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END diff --git a/decus/lt89b1/bulletin/bulletin2.for b/decus/lt89b1/bulletin/bulletin2.for deleted file mode 100644 index 5a10bc7..0000000 --- a/decus/lt89b1/bulletin/bulletin2.for +++ /dev/null @@ -1,1499 +0,0 @@ -C -C BULLETIN2.FOR, Version 9/1/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23,RESPONSE*1 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*11,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,FOLDER_SAVE*25 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for GENERAL folder.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND(STATUS) -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FROM_TEST*5,INFROM*(LINE_LENGTH) - - EXTERNAL CLI$_NEGATED - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - BULL_PARAMETER = 'RE: '//DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P) - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - IF (EDIT.AND.CLI$PRESENT('TEXT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - END IF - - LENFRO = 0 - IF (CLI$GET_VALUE('CC',INPUT,ILEN)) THEN - INFROM = INPUT(:ILEN)//',' - LENFRO = ILEN + 1 - END IF - - IF ((EDIT.AND.CLI$PRESENT('TEXT')).OR. - & INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INFROM(:LENFRO)//INPUT(7:) - LENFRO = LENFRO + ILEN - 6 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (CLI$PRESENT('LIST')) THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - - IF (INCMD(:4).EQ.'POST') LENFRO = 0 - - IF (EDIT.AND.CLI$PRESENT('TEXT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (CLI$PRESENT('LIST')) THEN - LIST = INDEX(FOLDER_DESCRIP,'<') - IF (LIST.GT.0) THEN - INFROM = INFROM(:LENFRO)// - & FOLDER_DESCRIP(LIST+1:TRIM(FOLDER_DESCRIP)-1) - LENFRO = LENFRO + TRIM(FOLDER_DESCRIP) - 1 - LIST - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - LEN_P = TRIM(BULL_PARAMETER) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - IF (LEN_P.EQ.64) THEN - BULL_PARAMETER(I:I) = '`' - ELSE - BULL_PARAMETER = BULL_PARAMETER(:I)//'"' - & //BULL_PARAMETER(I+1:) - I = I + 1 - LEN_P = LEN_P + 1 - END IF - END IF - I = I + 1 - END DO - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - IF (CLI$PRESENT('TEXT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//INFROM(:LENFRO) - & //'"/SUBJECT="'//BULL_PARAMETER//'"',,,,,,STATUS) - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT "'//INFROM(:LENFRO)// - & '"/SUBJECT="'//BULL_PARAMETER//'"',,,,,,STATUS) - END IF - CALL ENABLE_PRIVS - -900 IF (EDIT) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: Replaces existing bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH) - CHARACTER*1 ANSWER - - CHARACTER DATE_SAVE*11,TIME_SAVE*11 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL*1 DOALL - -C -C Get the bulletin number to be replaced. -C - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are reading - ELSE - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletin - - CALL CLOSE_BULLDIR - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person - RETURN ! and error out - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND. - & USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - REC1 = 0 - - LENFROM = 0 - - IF (LENDES.GT.0.OR.CLI$PRESENT('TEXT').OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (CLI$PRESENT('TEXT').OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - CALL OPEN_BULLDIR ! Prepare to add dir entry - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.CLI$PRESENT('TEXT')) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - NBLOCK = NBLOCK + ICOUNT - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:59) ! Update description header - END IF - CALL UPDATE_DIR_HEADER(CLI$PRESENT('EXPIRATION').OR.DOALL, - & CLI$PRESENT('PERMANENT'),CLI$PRESENT('SHUTDOWN'), - & INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT')) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION')) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:59),MSGTYPE,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER TODAY*23,INEXDATE*11,INEXTIME*11 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*132 SEARCH_STRING,SAVE_STRING - DATA SEARCH_STRING /' '/, SEARCH_LEN /1/ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL DISABLE_CTRL - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_POINT - BULL_POINT = BULL_POINT - 1 - END IF - - SAVE_STRING = SEARCH_STRING - SAVE_LEN = SEARCH_LEN - - IER1 = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - - IF (.NOT.IER1) THEN ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - SEARCH_LEN = SAVE_LEN - IF (SAVE_LEN.EQ.0) THEN - WRITE (6,'('' No search string present.'')') - RETURN - END IF - IF (STEP_BULL.EQ.-1) BULL_POINT = BULL_POINT - 2 - END IF - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - IF (IER1) THEN ! If string entered - IF (.NOT.CLI$PRESENT('START')) THEN ! If starting message not - BULL_POINT = 0 ! specified, use first - IF (CLI$PRESENT('REVERSE')) BULL_POINT = NBULL - 1 ! or last - END IF - SUBJECT = CLI$PRESENT('SUBJECT') - IF (CLI$PRESENT('REVERSE')) THEN - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - END IF - END IF - - IF ((BULL_POINT+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (BULL_POINT+1.EQ.0)) THEN - WRITE (6,'('' ERROR: No more messages.'')') - CALL CLOSE_BULLDIR - CALL ENABLE_CTRL - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - CALL DECLARE_CTRLC_AST - - DO BULL_SEARCH = BULL_POINT+1, END_BULL, STEP_BULL - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1) THEN - CALL STR$UPCASE(DESCRIP,DESCRIP) ! Make upper case - IF (INDEX(DESCRIP,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND..NOT.SUBJECT) THEN - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CALL ENABLE_CTRL - RETURN - END IF - END DO - END IF - END DO - -900 CALL CANCEL_CTRLC_AST - - CALL CLOSE_BULLFIL ! End of bulletin file read - CALL CLOSE_BULLDIR - - CALL ENABLE_CTRL - - WRITE (6,'('' No messages found with given search string.'')') - - RETURN - END - - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')') - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END diff --git a/decus/lt89b1/bulletin/bulletin3.for b/decus/lt89b1/bulletin/bulletin3.for deleted file mode 100644 index b593297..0000000 --- a/decus/lt89b1/bulletin/bulletin3.for +++ /dev/null @@ -1,1589 +0,0 @@ -C -C BULLETIN3.FOR, Version 10/23/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*11 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF (SYSTEM.LE.3.OR.(OLD_SHUTDOWN.EQ.0! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - EXTIME(3:4) = EXTIME(4:5) - READ (EXTIME(1:4),'(I4)') NODE_NUMBER_MSG - EXTIME(9:10) = EXTIME(10:11) - READ (EXTIME(7:10),'(I4)') NODE_AREA_MSG - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - END IF - ELSE - DIFF = 1 - END IF - IF (DIFF.EQ.1) NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF (SYSTEM.LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 EXPDAT - CHARACTER*23 TODAY - - DIMENSION EXTIME(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF ((DEFAULT_EXPIRE.GT.F_EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3)) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:),TODAY(13:)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0.AND. - & IER.EQ.SS$_NORMAL) THEN - CALL DISABLE_PRIVS - IF (OUT.EQ.INFILE) THEN - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT))) - ELSE - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - END IF - CALL ENABLE_PRIVS - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0.OR. - & IER.NE.SS$_NORMAL) THEN - CALL EDT$EDIT(INFILE,OUT) - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN - CONTEXT = 0 - IER = LIB$FIND_FILE(INFILE,MAIL_EDIT,CONTEXT) - IF (.NOT.IER) THEN - CALL TPU$EDIT(' ',OUT) - ELSE - CALL TPU$EDIT(INFILE,OUT) - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - ! TPU does CLI$ stuff which wipes our parsed command line - END IF - - RETURN - END - - - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($JPIDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXIT - END IF - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1 - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP') - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0)) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM','NL:' - & ,,,,'BULLCP',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*1 DUMMY - - IER = SYS_TRNLNM('BULL_BULLCP',DUMMY) - IF (IER) BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - CHARACTER*23 OLD_TIME,NEW_TIME - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - DO WHILE (1) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - CALL SYS$SETAST(%VAL(1)) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Do empty block - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Cleanup deleted users from - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! data files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - - OLD_TIME = NEW_TIME - CALL WAIT('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL REGISTER_BULLCP - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER NODENAME*8 - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - END IF - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE WAIT(PARAM) -C -C SUBROUTINE WAIT -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(6:7) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(2)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(9:10) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - - SUBROUTINE DELETE_EXPIRED - -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER UPTIME_DATE*11,UPTIME_TIME*11 - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD.EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - IF (INDEX(INTO,FOLDER_BBOARD(:FLEN)).EQ.0.AND. - & INTO.NE.FOLDER_BBOARD.AND.INDEX(INTO,'@').EQ.0) THEN - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOLDER1_BBOARD = FOLDER_BBOARD - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - FOLDER_Q2_SAVE = FOLDER_Q2 - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - FLEN = TRIM(FOLDER1_BBOARD) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD.NE.'NONE') THEN - IF (INTO.EQ.FOLDER1_BBOARD) THEN - FOUND = .TRUE. - ELSE - FIND_TO = INDEX(INTO,FOLDER1_BBOARD(:FLEN)) - IF (FIND_TO.GT.0) THEN - END_TO = FLEN+FIND_TO - IF (TRIM(INTO).LT.END_TO.OR. - & INTO(END_TO:END_TO).LT.'A'.OR. - & INTO(END_TO:END_TO).GT.'Z') THEN - IF (FIND_TO.EQ.1) THEN - FOUND = .TRUE. - ELSE IF (INTO(FIND_TO-1:FIND_TO-1).LT.'A'.OR. - & INTO(FIND_TO-1:FIND_TO-1).GT.'Z') THEN - FOUND = .TRUE. - END IF - END IF - END IF - END IF - END IF - END DO - IF (FOUND) THEN - FOLDER_COM = FOLDER1_COM - FOLDER_Q_SAVE = FOLDER_Q2_SAVE - END IF - END IF - - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - WRITE (6,1030) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*37,FILENAME*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - OFFSET = 36 - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='VMSMAIL', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - OFFSET = 34 - END IF - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::') THEN - ! If normal BBOARD or /VMSMAIL - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - CALL LIB$MOVC3(2,%REF(INPUT(OFFSET:)),COUNT) - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END diff --git a/decus/lt89b1/bulletin/bulletin4.for b/decus/lt89b1/bulletin/bulletin4.for deleted file mode 100644 index d86064c..0000000 --- a/decus/lt89b1/bulletin/bulletin4.for +++ /dev/null @@ -1,1703 +0,0 @@ -C -C BULLETIN4.FOR, Version 8/2/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist -C if it creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - READ (4,IOSTAT=IER) USER_ENTRY ! Skip header - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':') THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - DATA POINT/0/ - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = 0 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - IBLOCK = SBLOCK ! Initialize pointers. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,ILEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C ILEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns ILEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(LINE_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? - IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - ILEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - ILEN = -1 ! ILEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - ILEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - BUFFER = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) ! Output line. - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(ILEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - ILEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - ILEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (ILEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = ILEN - (BRECLEN-POINT) ! Store leftover length - ILEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (ILEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(ILEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - ILEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - ILEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - IF (BTEST(FOLDER_FLAG,1)) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -900 CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - CALL WRITEDIR(0,IER) - -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limit - POINTER = 0 ! during input. - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privileged - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'( - & '' ERROR: No privs for SYSTEM, NOTIFY, BRIEF or READNEW.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - LENDES = 0 - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_OWNER = FOLDER1_OWNER - END IF - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_OWNER = FOLDER1_OWNER - - IF (CLI$PRESENT('SYSTEM')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - diff --git a/decus/lt89b1/bulletin/bulletin5.for b/decus/lt89b1/bulletin/bulletin5.for deleted file mode 100644 index 212e3fa..0000000 --- a/decus/lt89b1/bulletin/bulletin5.for +++ /dev/null @@ -1,1606 +0,0 @@ -C -C BULLETIN5.FOR, Version 10/24/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_NEGATED - - IF (.NOT.SETPRV_PRIV().AND.INCMD(:3).EQ.'SET') THEN - WRITE (6,'( - & '' ERROR: No privs to change all defaults.'')') - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - - FLAG = 0 - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',TEMP_USER) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',TEMP_USER) - END IF - READ (TEMP_USER(:1),'(I1)',IOSTAT=IER) FLAG - - IF (NOTIFY.EQ.1.AND.BTEST(FLAG,1).AND. - & CLI$PRESENT('CLUSTER').EQ.%LOC(CLI$_NEGATED)) THEN - CALL OPEN_BULLNOTIFY - READ (10,KEY='*',IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=10) - FLAG = -1 - END IF - - IF (BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - IF (FLAG.EQ.-1) WRITE (10,IOSTAT=IER) TEMP_USER - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - IF (FLAG.EQ.-1) THEN - CALL CLOSE_BULLNOTIFY - ELSE IF (NOTIFY.EQ.1.AND.BTEST(FLAG,1).AND. - & CLI$PRESENT('CLUSTER').NE.%LOC(CLI$_NEGATED)) THEN - WRITE (6,'('' NOTE: In a cluster, /ALL or /DEFAULT '', - & ''causes all users to be notified.'')') - WRITE (6,'('' They will not be able to disable this.'', - & '' See HELP SET NOTIFY for more info.'')') - CALL OPEN_BULLNOTIFY - CALL CLOSE_BULLNOTIFY_DELETE - CALL OPEN_BULLNOTIFY - WRITE (10) '* ' - CALL CLOSE_BULLNOTIFY - ELSE IF (NOTIFY.EQ.0.AND.BTEST(FLAG,1)) THEN - CALL OPEN_BULLNOTIFY - READ (10,IOSTAT=IER) TEMP_USER - IF ((IER.EQ.0.AND.TEMP_USER.EQ.'*').OR. - & (BRIEF.NE.-1.AND.READNEW.NE.-1)) THEN - CALL CLOSE_BULLNOTIFY_DELETE - ELSE - CALL CLOSE_BULLNOTIFY - END IF - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL OPEN_BULLNOTIFY - CALL CLOSE_BULLNOTIFY_DELETE - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - FOLDER_SET = .FALSE. - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - EXTERNAL CLI$_ABSENT - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1) - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - - REMOTE_TEST = 0 - - IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP - END IF - - CALL CLOSE_BULLFOLDER - - IF (IER.EQ.0.AND.FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable select the folder.'')') - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD)) - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Copy remote folder protection - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - ELSE - LOCAL_FOLDER1_FLAG = IBCLR(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - END IF - REMOTE_SET = .TRUE. - END IF - - IF (IER.EQ.0) THEN ! Folder found - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::' - & .AND..NOT.SETPRV_PRIV()) THEN - ! Is folder protected and not remote? - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND. - & IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (FOLDER1_BBOARD(:2).NE.'::') THEN - IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - END IF - - IF (IER) THEN - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0) THEN - IF (TEST_BULLCP()) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (FOLDER_NUMBER.GE.0.AND.CLI$PRESENT('MARKED')) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - IF (INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only marked messages'', - & '' will be shown.'')') - ELSE - WRITE(6,'('' ERROR: No marked messages found.'')') - END IF - END IF - ELSE - READ_TAG = .FALSE. - END IF - END IF - - IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - RETURN - - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*25 FOLDER_SAVE - - DIMENSION DUMMY(2) - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - END IF - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.LOGIN_SWITCH) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - END IF - IER = 0 - END IF - - RETURN - END - - - - - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & FOLDER1 = FOLDER - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Folder is a private folder.'')') - ELSE - WRITE (6,'('' Folder is not a private folder.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is BRIEF.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is SHOWNEW.'')') - ELSE - WRITE (6,'('' Default is NOREADNEW.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY.'')') - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - CHARACTER*17 DATETIME - - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE specified - ELSE - NLINE = 1 - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDER = 0 - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - - IF (.NOT.PAGING) THEN - DISPLAY = (NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2 - ELSE - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2,PAGE_LENGTH-4) - ! If more entries than page size, truncate output - END IF - - DO I=FOLDER_COUNT,FOLDER_COUNT+(DISPLAY-2)/NLINE-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counter - END DO - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*1 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ELSE - ID = INPUT - INPUT = ' ' - END IF - ILEN = TRIM(ID) - IF (ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - CALL OPEN_BULLFOLDER ! Open folder file - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - ENTRY WRITE_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE - - REWRITE (7) FOLDER_COM - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP - - REWRITE (7) FOLDER1_COM - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END DO - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - SET_FLAG(1) = SET_FLAG_DEF(1) - SET_FLAG(2) = SET_FLAG_DEF(2) - BRIEF_FLAG(1) = BRIEF_FLAG_DEF(1) - BRIEF_FLAG(2) = BRIEF_FLAG_DEF(2) - NOTIFY_FLAG(1) = NOTIFY_FLAG_DEF(1) - NOTIFY_FLAG(2) = NOTIFY_FLAG_DEF(2) - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END diff --git a/decus/lt89b1/bulletin/bulletin6.for b/decus/lt89b1/bulletin/bulletin6.for deleted file mode 100644 index f567bff..0000000 --- a/decus/lt89b1/bulletin/bulletin6.for +++ /dev/null @@ -1,1586 +0,0 @@ -C -C BULLETIN6.FOR, Version 10/26/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - DATA LUN /0/ - - ENTRY CLOSE_BULLNOTIFY - LUN = LUN + 1 ! Unit = 10 - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - DATA LUN /0/ - - ENTRY CLOSE_BULLNOTIFY_DELETE - LUN = LUN + 8 ! Unit = 10 - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - DATA LUN /0/ - - LUN = UNIT - 10 ! 10 gets added to LUN - - ENTRY OPEN_BULLNOTIFY - LUN = LUN + 1 ! Unit = 10 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.10) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=10,STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=3, - & ORGANIZATION='INDEXED',KEY=(1:12:CHARACTER), - & FORM='UNFORMATTED', - & FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.NOTIFY') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','notify'/ - INTEGER NAME(10) - DATA NAME/1,2,0,3,0,0,4,0,5,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - CHARACTER*25 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNOTIFY_SHARED - LUN = LUN + 1 ! Unit = 10 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_POINT - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - - IF (IER.EQ.0) THEN - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.FOLDER_RECORD/4) THEN - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(ASK_SIZE) - NTRIES = 0 - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.10) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=10,STATUS='OLD',IOSTAT=IER, - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=3, - & ORGANIZATION='INDEXED',KEY=(1:12:CHARACTER), - & FORM='UNFORMATTED', - & FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.NOTIFY') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - CALL OPEN_FILE(LUN) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE_SHARE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*115 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(1:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(1:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(78:81) = BUFFER(85:) - BULLDIR_ENTRY(90:97) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(ASK_SIZE) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*80 NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - - EODIR = MAX(INDEX(BULLFOLDER_FILE,':'),INDEX(BULLFOLDER_FILE,']')) - SUFFIX = INDEX(BULLFOLDER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLFOLDER_FILE(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.173/4) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - IF (IER.EQ.0) THEN - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,BULLFOLDER_FILE) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*3 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - DIR_NUM = 0 - END IF - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,0 - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_HEADER_FROMBIN - RETURN - END IF - END IF - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' ') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I3)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (MSG_NUM.NE.ICOUNT) IER = 36 - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) BULLDIR_ENTRY - END IF - END DO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - DIR_NUM = -1 - END IF - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - END IF - END IF - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - UNLOCK 2 - - RETURN - - END - - - - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If not 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) BULLDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - IER = 0 - DIR_NUM = -1 - END IF - UNLOCK 2 - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - IER = MSG_NUM - CALL CONVERT_ENTRY_FROMBIN - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME - NEWEST_EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME - NEWEST_TIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME - SHUTDOWN_TIME = DATETIME(13:) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME - EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME - TIME = DATETIME(13:) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - INCLUDE 'BULLDIR.INC' - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - ELSE - IF (CONV) CALL CONVERT_ENTRY_TOBIN - MSG_NUM = BULLETIN_NUM - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - - RETURN - END - - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*) - CHARACTER NOT_ID*3 - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - DO WHILE - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0) - START_ID = START_ID - 1 - END DO - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = RECL/8 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*255 - - CHARACTER*(*) INFILE,OUTFILE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl output - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C -C SUBROUTINE COPY_ACL1 -C -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,) - ! Read input file acl - - CALL INIT_ITMLST ! Initialize item list - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END diff --git a/decus/lt89b1/bulletin/bulletin7.for b/decus/lt89b1/bulletin/bulletin7.for deleted file mode 100644 index 398456d..0000000 --- a/decus/lt89b1/bulletin/bulletin7.for +++ /dev/null @@ -1,1763 +0,0 @@ -C -C BULLETIN7.FOR, Version 10/26/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - INCLUDE '($SSDEF)' - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - CHARACTER OUTPUT*160,TERMINAL*7,FLAGS*1 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (FOLDER_NUMBER.GT.0) THEN ! Folder private? - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER(1:TRIM(FOLDER)) - & //'. From: '//FROM(1:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - FLAG = 0 - BFLAG = 0 - - IF (IER) THEN - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) THEN ! Node part of cluster? - CALL OPEN_BULLNOTIFY_SHARED ! Yes, get notify list. - DO WHILE (REC_LOCK(IER1)) ! Any entries? - READ (10,IOSTAT=IER1) TEMP_USER - END DO - IF (IER1.NE.0) THEN ! No entries. - CALL READ_USER_FILE(IER) ! Create entries from - DO WHILE (IER.EQ.0) ! user file. - IF (TEMP_USER(:1).NE.':'.AND.TEMP_USER(:1).NE.'*' - & .AND.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (10) TEMP_USER - END IF - CALL READ_USER_FILE(IER) - END DO - DO WHILE (REC_LOCK(IER1)) ! Reset to first entry. - READ (10,KEYGT=' ',IOSTAT=IER1) - & TEMP_USER - END DO - END IF - - BFLAG = BRK$M_CLUSTER ! Broadcast to all nodes - - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER_NUMBER).AND. ! If /ALL then - & TEMP_USER.EQ.'*'.AND.IER1.EQ.0) THEN ! notify all. - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & ,%VAL(BRK$C_ALLUSERS),,,%VAL(BFLAG),,,,) - IER1 = 1 ! Don't have to loop through notify list - END IF - END IF - END IF - - DO WHILE ((BFLAG.EQ.0.AND.GETUSERS(TEMP_USER,TERMINAL)).OR. - & (BFLAG.NE.0.AND.IER1.EQ.0)) - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - IF (BFLAG.EQ.0) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TERMINAL(:TRIM(TERMINAL)),%VAL(BRK$C_DEVICE) - & ,,,%VAL(BFLAG),,,,) - ELSE - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TEMP_USER(:TRIM(TEMP_USER)),%VAL(BRK$C_USERNAME) - & ,,,%VAL(BFLAG),,,,) - END IF - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USER//USER_ENTRY(13:) - END IF - ELSE IF (IER.NE.0.AND.BFLAG.NE.0) THEN - DELETE (UNIT=10) - END IF - IF (BFLAG.NE.0) THEN - DO WHILE (REC_LOCK(IER1)) - READ (10,IOSTAT=IER1) TEMP_USER - END DO - END IF - END DO - IF (BFLAG.NE.0) CALL CLOSE_BULLNOTIFY - END IF - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(1:11) - NEWEST_TIME = TODAY_TIME(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00.00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*11 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - - IF (FLAG.EQ.4) THEN ! If notify, see if cluster - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',TEMP_USER) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',TEMP_USER) - END IF - READ (TEMP_USER(:1),'(I1)',IOSTAT=IER) BFLAG - IF (BTEST(BFLAG,1).AND.IER.EQ.0) THEN - CALL OPEN_BULLNOTIFY_SHARED - DO WHILE (REC_LOCK(IER)) - READ (10,IOSTAT=IER) TEMP_USER - END DO - IF (TEMP_USER.NE.'*') THEN - IF (CMD) THEN - WRITE (10,IOSTAT=IER) USERNAME - ELSE - DO WHILE (REC_LOCK(IER)) - READ (10,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (UNIT=10) - END IF - END IF - CALL CLOSE_BULLNOTIFY - END IF - END IF - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -C -C SUBROUTINE CONFIRM_PRIV -C -C FUNCTION: Confirms that given username has SETPRV. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C ALLOW - Returns 1 if account has SETPRV. -C returns 0 if account has no SETPRV. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INCLUDE '($PRVDEF)' - - INCLUDE '($UAIDEF)' - - INTEGER DEF_PRIV(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_DEF_PRIV,%LOC(DEF_PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - ALLOW = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(DEF_PRIV(1),PRV$V_SETPRV).OR. ! SETPRV or CMRKNL - & BTEST(DEF_PRIV(1),PRV$V_CMKRNL)) THEN ! privileges? - ALLOW = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM) OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:TRIM(INPUT)),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM) OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - CALL UPDATE_USERINFO - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FILENAME*132,BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - OPEN (UNIT=11, - 1 FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - NBLOCK = NBLOCK + LENGTH - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*11 DATE_SAVE,EXDATE_SAVE - CHARACTER*11 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - WRITE (6,'('' For the selected folder '',A)') FOLDER(1:TRIM(FOLDER)) - - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - END IF - - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND. - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (.NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER USERNAME*(*),TERMINAL*(*) - - DATA WILDCARD /-1/ - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) WILDCARD = -1 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ - DATA USERINFO_READ /.FALSE./ - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_BULLUSER - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - - CALL CLOSE_BULLINF - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - COMMON /USERINFO/ USERINFO_READ - - INCLUDE 'BULLUSER.INC' - - IF (.NOT.USERINFO_READ) RETURN - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - IF (TRIM(TIME).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - DIMENSION LOGIN_BTIM_SAVE(2) - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ ! Update login time - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2).AND.IER.EQ.0) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE - END IF - IF (IER.NE.0) THEN - CALL CHANGE_FLAG_NOCMD(0,2) - CALL CHANGE_FLAG_NOCMD(0,3) - CALL CHANGE_FLAG_NOCMD(0,4) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = 0 - CALL MODIFY_SYSTEM_LIST(0) - END IF - ELSE IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - IF (TEST2(NEW_MSG,0)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - NEW_MESS = .FALSE. - DO FOLDER_NUMBER = 1,FOLDER_MAX-1 - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(1:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - IF (NEW_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new GENERAL messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (FOLDER_NUMBER.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE IF (FOLDER_NUMBER.EQ.0.OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = -1 - FOLDER1 = 'GENERAL' - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to GENERAL folder.'')') - - RETURN - END diff --git a/decus/lt89b1/bulletin/bulletin8.for b/decus/lt89b1/bulletin/bulletin8.for deleted file mode 100644 index 7d2c223..0000000 --- a/decus/lt89b1/bulletin/bulletin8.for +++ /dev/null @@ -1,1556 +0,0 @@ -C -C BULLETIN8.FOR, Version 8/18/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - CHARACTER NAMEDESC*9 /'BULLETIN1'/ - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*9 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN),IO$_READVBLK,MBX_IOSB, - & MBX_AST,,MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*6,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL CONNECT(NODENAME,USERNAME,FROMNAME) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(200),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - CHARACTER*128 INPUT - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - - IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL EXECUTE_COMMAND(UNIT_INDEX) - - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - - RETURN - END - - - - - - SUBROUTINE CONNECT(NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/ - - CHARACTER*(*) USERNAME,FROMNAME - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IF (REJECT.NE.IO_REJECT) THEN - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL ENABLE_CTRL_EXIT,SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2) - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*53 - CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - BULLCP_PRIV(1) = PROCPRIV(1) - BULLCP_PRIV(2) = PROCPRIV(2) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDER_NAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - NODENAME = NODE_SAVE(UNIT_INDEX) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15) THEN ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USERNAME,PRIV_SAVE(1,UNIT_INDEX)) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - PRIV_SAVE(1,UNIT_INDEX) = PROCPRIV(1) - PRIV_SAVE(2,UNIT_INDEX) = PROCPRIV(2) - END IF - END IF - END IF - - IF (CMD_TYPE.EQ.1) THEN ! Select folder - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:5))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:9))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - END IF - BUFFER = BUFFER(:16)//FOLDER_COM - CALL WRITE_CHAN(16+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - FOLDER_NAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP)) - CALL LIB$MOVC3(11,%REF(BUFFER(58:58)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(69:69)),%REF(EXTIME)) - CALL LIB$MOVC3(4,%REF(BUFFER(80:80)),SYSTEM) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (SYSTEM.NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF (SYSTEM.NE.0.AND..NOT.SETPRV_PRIV()) THEN ! Priv test - IF (FOLDER_OWNER.NE.USERNAME) THEN - SYSTEM = 0 - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(84:84)),BROAD) - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(88:88)),BELL) - CALL LIB$MOVC3(4,%REF(BUFFER(92:92)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(97:97)),CLUSTER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND.(TEMP_USER(2:).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(1)) - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - IER = SYS$CANTIM(%VAL(1),) - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:9)),%REF(MSG_KEY(1:1))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),EBULL) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP_TEMP)) - CALL LIB$MOVC3(4,%REF(BUFFER(58:58)),ICOUNT) - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(53,%REF(BUFFER(62:62)),%REF(DESCRIP)) - CALL LIB$MOVC3(4,%REF(BUFFER(115:115)),%REF(MSGTYPE)) - CALL LIB$MOVC3(11,%REF(BUFFER(119:119)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(130:130)),%REF(EXTIME)) - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE) - DESCRIP_TEMP = BUFFER(9:61) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(11,%REF(BUFFER(62:62)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(73:73)),%REF(EXTIME)) - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:5)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:13)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:1))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:13)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:17)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:21)),FOLDER_NUMBER) - FOLDER = BUFFER(25:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - END IF - -1000 PROCPRIV(1) = BULLCP_PRIV(1) - PROCPRIV(2) = BULLCP_PRIV(2) - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.GE.0) RETURN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) THEN - PROCPRIV(1) = NEEDPRIV(1) - PROCPRIV(2) = NEEDPRIV(2) - END IF - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - NLEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addedd - END IF - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:NLEN)//'""::' - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - - RETURN - END diff --git a/decus/lt89b1/bulletin/bulletin9.for b/decus/lt89b1/bulletin/bulletin9.for deleted file mode 100644 index ecabd14..0000000 --- a/decus/lt89b1/bulletin/bulletin9.for +++ /dev/null @@ -1,1826 +0,0 @@ -C -C BULLETIN9.FOR, Version 10/10/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Is semicolon present? - IF (NLEN.GT.SEMI+1) THEN ! Yes, is username after node? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - NLEN = SEMI - 1 ! Remove semicolon - ELSE ! No username after nodename - TEMP_USER = DEFAULT_USER ! Set username to default - NLEN = SEMI - 1 ! Remove semicolon - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolon present - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username was - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:NLEN) - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '// - & PASSWORD(1:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FLAGNAME - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=13,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(13,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=13) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (13,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(13,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=13,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=13) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=13) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - INCLUDE '($HLPDEF)' - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$PRINT:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - ELSE - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8) - END IF - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,DISPLAY_ID,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA DISPLAY_ID/0/,KEYBOARD_ID/0/ - - IER = SMG$CREATE_PASTEBOARD(PASTEBOARD_ID) ! Initialize terminal - IF (DISPLAY_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_DISPLAY(PAGE_LENGTH, - & PAGE_WIDTH,DISPLAY_ID) - END IF - IER = SMG$PASTE_VIRTUAL_DISPLAY(DISPLAY_ID,PASTEBOARD_ID,1,1) - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (1) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LBR$CLOSE(LINDEX) ! then close library, - CALL SMG$UNPASTE_VIRTUAL_DISPLAY(DISPLAY_ID,PASTEBOARD_ID) - ! remove virtual display - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,DISPLAY_ID,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = SMG$ERASE_DISPLAY(DISPLAY_ID) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = SMG$ERASE_DISPLAY(DISPLAY_ID) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - CHARACTER VERSION*10,DATE*23 - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - END - - - - - - - SUBROUTINE TAG(ADD_OR_DEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - IER1 = 0 - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT).AND.IER1.EQ.0) ! Get the specified messages - - DECODE(LEN_P,'(I)',BULL_PARAMETER) MESSAGE_NUMBER - - CALL READDIR(MESSAGE_NUMBER,IER) ! Get info for bulletin - - IF (IER.NE.MESSAGE_NUMBER+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER1) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Message '',I, - & '' was not marked.'')') MESSAGE_NUMBER - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found.') - - END - - - - SUBROUTINE ADD_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 TAG_KEY - - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY) - - IF (IER.EQ.FOR$IOS_INCKEYCHG) THEN - WRITE (6,'('' Message was already marked.'')') - ELSE IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to add mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE DEL_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 TAG_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - END DO - IF (IER.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to delete mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER) RETURN - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE='BULL_MARK:'// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (IER.EQ.0) BULL_TAG = .TRUE. - - RETURN - END - - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 BULL_MARK - - IER = SYS_TRNLNM('BULL_MARK',BULL_MARK) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: BULL_MARK must be defined.'', - & '' See HELP MARK.'')') - RETURN - ELSE - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1.OR.BULL_MARK.NE.BULL_PARAMETER) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = 0 - END IF - OPEN (UNIT=13,FILE='BULL_MARK:'// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - BULL_TAG = .TRUE. - IER = 1 - END IF - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - GO TO 10 - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - HEADER = .FALSE. - -10 DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - & INPUT_KEY - END DO - - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (FOLDER1_NUMBER.NE.FOLDER_NUMBER.OR.IER.NE.0) THEN - IER = 1 - UNLOCK 13 - RETURN - ELSE - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL OPEN_BULLDIR - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - RETURN - ELSE - DELETE (UNIT=13) - IER = 1 - END IF - END IF - - END DO - - END - - - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. Added per request of a faculty member for his private -C board. Changes to BULLETIN.FOR should be fairly obvious. -C -C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2) -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - DATA FOLDER_Q1/0/ - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - WRITE (6,1000) - WRITE (6,1020) - DO J = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - WRITE (6,1030) FOLDER1(:15),F1_NBULL, - & FOLDER1_DESCRIP(:MIN(TRIM(FOLDER1_DESCRIP),59)) - END DO - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - READ_TAG = .FALSE. - IF (CLI$PRESENT('MARKED')) READ_TAG = .TRUE. - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - IF (DIR_COUNT.EQ.0) THEN - F1_NBULL = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1020 FORMAT (' Name Count Description'/) -1030 FORMAT (1X,A15,I5,1X,A) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') - - END - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - DIMENSION NOLOGIN_BTIM(2) - - CHARACTER*17 DATETIME - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV_PRIV().AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to user command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - CALL OPEN_BULLUSER_SHARED - - IF (.NOT.ALL) THEN - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - ELSE - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - RETURN - ELSE - IER = 1 - END IF - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - ELSE - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - CALL STRIP_HEADER(INPUT,0,IER1) - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - CHARACTER*255 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /STRIP_HEADER/ STRIP - DATA STRIP/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - DATA OLD_BUFFER_FROM /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:LEN_BUFFER) - IF (OLD_BUFFER_FROM.AND.BUFFER(:1).EQ.' ') THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER - OLD_BUFFER_FROM = .FALSE. - ELSE IF (BUFFER(:5).EQ.'From:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.OR.LEN_BUFFER.EQ.0) THEN - IF (BUFFER(:9).EQ.'Reply-to:') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0.AND.SAVE_IN_FROM.EQ.' ') THEN - CALL GETUSER(SAVE_IN_FROM) - END IF - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - END IF - RETURN - END IF - - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF (.NOT.STRIP) THEN - CALL STORE_BULL(1,' ',NBLOCK) ! just store one space - ELSE - CALL STRIP_HEADER(BUFFER,LEN_BUFFER,IER) - END IF - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (STRIP) THEN - CALL STRIP_HEADER(BUFFER,LEN_BUFFER,IER) - IF (IER) THEN - RETURN - ELSE - STRIP = .FALSE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - TEXT = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /STRIP_HEADER/ STRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - STRIP = .TRUE. ! Reset strip flag - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - RETURN - END IF - - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - EXTIME = '00:00:00.00' - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(LINE_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.'''') THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - IF (INDEX(INFROM,'<').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<'):) ! personal-name - END IF - - IF (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name) - & INDEX(INFROM,'@').GT.INDEX(INFROM,'(')) THEN - INFROM = INFROM(INDEX(INFROM,'(')+1:) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'"')) - I = I + 1 - END DO - INFROM = INFROM(I:) - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.12.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'"') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,I-1 - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) BUFFER - - INCLUDE 'BULLFOLDER.INC' - - IF (.NOT.BTEST(FOLDER_FLAG,4).OR.TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - RETURN - END IF - - IF (BLEN.EQ.0) CONT_LINE = .FALSE. - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header line - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - - RETURN - END diff --git a/decus/lt89b1/bulletin/bullfiles.inc b/decus/lt89b1/bulletin/bullfiles.inc deleted file mode 100644 index 33021bc..0000000 --- a/decus/lt89b1/bulletin/bullfiles.inc +++ /dev/null @@ -1,28 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF IT -C IS NOT, THEN THEY SHOULD ALSO BE CHANGED. -C - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ diff --git a/decus/lt89b1/bulletin/bullfolder.inc b/decus/lt89b1/bulletin/bullfolder.inc deleted file mode 100644 index 6e31f77..0000000 --- a/decus/lt89b1/bulletin/bullfolder.inc +++ /dev/null @@ -1,46 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,FILLER, - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) diff --git a/decus/lt89b1/bulletin/bullmain.cld b/decus/lt89b1/bulletin/bullmain.cld deleted file mode 100644 index 6f23cd7..0000000 --- a/decus/lt89b1/bulletin/bullmain.cld +++ /dev/null @@ -1,26 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER,DEFAULT="7") diff --git a/decus/lt89b1/bulletin/bullstart.com b/decus/lt89b1/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/lt89b1/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/lt89b1/bulletin/bulluser.inc b/decus/lt89b1/bulletin/bulluser.inc deleted file mode 100644 index 04dc139..0000000 --- a/decus/lt89b1/bulletin/bulluser.inc +++ /dev/null @@ -1,42 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/lt89b1/bulletin/create.com b/decus/lt89b1/bulletin/create.com deleted file mode 100644 index ec2a1a4..0000000 --- a/decus/lt89b1/bulletin/create.com +++ /dev/null @@ -1,19 +0,0 @@ -$ FORTRAN/EXTEND BULLETIN -$ FORTRAN/EXTEND BULLETIN0 -$ FORTRAN/EXTEND BULLETIN1 -$ FORTRAN/EXTEND BULLETIN2 -$ FORTRAN/EXTEND BULLETIN3 -$ FORTRAN/EXTEND BULLETIN4 -$ FORTRAN/EXTEND BULLETIN5 -$ FORTRAN/EXTEND BULLETIN6 -$ FORTRAN/EXTEND BULLETIN7 -$ FORTRAN/EXTEND BULLETIN8 -$ FORTRAN/EXTEND BULLETIN9 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB; -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIB/CREATE BULL -$ LIB BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/lt89b1/bulletin/dclremote.com b/decus/lt89b1/bulletin/dclremote.com deleted file mode 100644 index 97f40f0..0000000 --- a/decus/lt89b1/bulletin/dclremote.com +++ /dev/null @@ -1,32 +0,0 @@ -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET diff --git a/decus/lt89b1/bulletin/handout.txt b/decus/lt89b1/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/lt89b1/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/lt89b1/bulletin/install.com b/decus/lt89b1/bulletin/install.com deleted file mode 100644 index 7f61965..0000000 --- a/decus/lt89b1/bulletin/install.com +++ /dev/null @@ -1,18 +0,0 @@ -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/lt89b1/bulletin/install_remote.com b/decus/lt89b1/bulletin/install_remote.com deleted file mode 100644 index 5e9e9aa..0000000 --- a/decus/lt89b1/bulletin/install_remote.com +++ /dev/null @@ -1,130 +0,0 @@ -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL diff --git a/decus/lt89b1/bulletin/instruct.com b/decus/lt89b1/bulletin/instruct.com deleted file mode 100644 index 49627f6..0000000 --- a/decus/lt89b1/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/lt89b1/bulletin/instruct.txt b/decus/lt89b1/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/lt89b1/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/lt89b1/bulletin/login.com b/decus/lt89b1/bulletin/login.com deleted file mode 100644 index e4302af..0000000 --- a/decus/lt89b1/bulletin/login.com +++ /dev/null @@ -1,28 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/lt89b1/bulletin/makefile b/decus/lt89b1/bulletin/makefile deleted file mode 100644 index 6ed2c9a..0000000 --- a/decus/lt89b1/bulletin/makefile +++ /dev/null @@ -1,74 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V1.68" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin9.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/lt89b1/bulletin/nonsystem.txt b/decus/lt89b1/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/lt89b1/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/lt89b1/bulletin/pmdf.com b/decus/lt89b1/bulletin/pmdf.com deleted file mode 100644 index 34f626e..0000000 --- a/decus/lt89b1/bulletin/pmdf.com +++ /dev/null @@ -1,743 +0,0 @@ -$set nover -$copy sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE '[-]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE '[-]APFILES.INC', - %INCLUDE '[-]MMFILES.INC', - %INCLUDE '[-]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE '[-]UTILCONST.INC' - %INCLUDE '[-]OSCONST.INC' - %INCLUDE '[-]APCONST.INC' - %INCLUDE '[-]MMCONST.INC' - %INCLUDE '[-]HECONST.INC' - %INCLUDE '[-]LOGCONST.INC' - %INCLUDE '[-]SYCONST.INC' - - TYPE - %INCLUDE '[-]UTILTYPE.INC' - %INCLUDE '[-]OSTYPE.INC' - %INCLUDE '[-]APTYPE.INC' - %INCLUDE '[-]SYTYPE.INC' - %INCLUDE '[-]MMTYPE.INC' - %INCLUDE '[-]HETYPE.INC' - %INCLUDE '[-]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE '[-]UTILVAR.INC' - %INCLUDE '[-]OSVAR.INC' - %INCLUDE '[-]APVAR.INC' - %INCLUDE '[-]QUVAR.INC' - %INCLUDE '[-]MMVAR.INC' - %INCLUDE '[-]HEVAR.INC' - %INCLUDE '[-]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - %INCLUDE '[-]UTILDEF.INC' - %INCLUDE '[-]OSDEF.INC' - %INCLUDE '[-]APDEF.INC' - %INCLUDE '[-]HEDEF.INC' - %INCLUDE '[-]LOGDEF.INC' - %INCLUDE '[-]MMDEF.INC' - %INCLUDE '[-]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - 'IN%',' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy sys$input PMDF.TXT -$deck -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows: - - LINK BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - -and put the .EXE in PMDF_ROOT:[EXE]. Put the new MASTER.COM in PMDF_ROOT:[EXE]. -NOTE: Check your MASTER.COM, as the latest version of PMDF contains the code -necessary to check for bulletin mail. However, it will not necessary have the -latest copy of BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single master logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders. After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/lt89b1/bulletin/remote.com b/decus/lt89b1/bulletin/remote.com deleted file mode 100644 index 9ec5a2e..0000000 --- a/decus/lt89b1/bulletin/remote.com +++ /dev/null @@ -1,48 +0,0 @@ -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP diff --git a/decus/lt89b1/bulletin/writemsg.txt b/decus/lt89b1/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/lt89b1/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vax82b/bulletin/aaareadme.txt b/decus/vax82b/bulletin/aaareadme.txt deleted file mode 100644 index 57142b3..0000000 --- a/decus/vax82b/bulletin/aaareadme.txt +++ /dev/null @@ -1,110 +0,0 @@ - - - - - - - BULLETIN - - - - BULLETIN provides an effective means for the system - -managers to disseminate information to users in a friendly - -fashion. - - - - Features - - - - o Bulletins of general interest can be sent to all - - users - - o Bulletins can be filed by subject for perusal by - - interested users - - o Users are presented with bulletins only once - - (unless they request old ones) - - o Users are informed of new information on - - specialized topics only once - - o Users may optionally file or print bulletins - - - - - - Setting up - - - -The nicest feature about bulletin is its friendly nature. - -Unwanted and indecipherable information is not forced down a - -users' throats, but is there for any interested user. Thus, - -for example, if you file a bulletin under the subject of - -PASCAL, all users will be informed (only once!) that there - -is new information on PASCAL. Interested users can read the - -new bulletins, while those not using PASCAL can ignore them. - -There are three things to set up for most effective use of - -the program. - - - - 1. Put the BULLETIN help file in your system help - - file: - - $ LIBR/HELP SYS$HELP:HELPLIB BULLETIN - - - - - - 2. If you have a system wide login.com file, you - - should enter the command: - - $ if "''f$mode()" .eqs. "INTERACTIVE" then - - - $bulletin - - If you enter this command before enabling - - control-Y, this will force users to read new - - BULLETINS filed under the general interest - - category. - - - - 3. Encourage users to place in their personal - - LOGIN.COM files BULLETIN commands to read - - information on subjects of interest to them. - - - - - -Refer to the first bulletin and the HELP BULLETIN command - -for more info. - diff --git a/decus/vax82b/bulletin/bc.com b/decus/vax82b/bulletin/bc.com deleted file mode 100644 index 8cafff1..0000000 --- a/decus/vax82b/bulletin/bc.com +++ /dev/null @@ -1,32 +0,0 @@ -$ save_verify = 'f$verify("NO") -$ if p1 .eqs. "" then p1 := "*" -$ on error then goto done -$ on control_y then goto done -$ temp := "SYS$DISK" -$ mgrdir := "''f$logical(temp)'''f$directory()'" -$ set def sys$sysdisk:[sysexe] -$ open/write tfile temp.bcm -$ write tfile "$ run authorize" -$ write tfile "list ''p1'" -$ close tfile -$ @temp.bcm -$ del temp.bcm;0 -$ open/read uaflis sysuaf.lis -$ read/end=eol uaflis line -$ loop: -$ read/end=eol uaflis line -$ user := "''f$extract(21,12,line)'" -$ account := "''f$extract(44,8,line)'" -$ if account .eqs. " " then goto loop -$ deff := "''f$extract(63,1000,line)'" -$ write sys$output "''user' ''deff'" -$ set def 'deff' -$ run sys$system:bullcheck -$ goto loop -$ eol: -$ close uaflis -$ done: -$ set def sys$sysdisk:[sysexe] -$ delete sysuaf.lis;0 -$ set def 'mgrdir' -$ if save_verify then set verify diff --git a/decus/vax82b/bulletin/bcmail.com b/decus/vax82b/bulletin/bcmail.com deleted file mode 100644 index 504510b..0000000 --- a/decus/vax82b/bulletin/bcmail.com +++ /dev/null @@ -1,54 +0,0 @@ -$ save_verify = 'f$verify("NO") -$ if p1 .eqs. "" then p1 := "*" -$ on error then goto done -$ on control_y then goto done -$ temp := "SYS$DISK" -$ mgrdir := "''f$logical(temp)'''f$directory()'" -$ del temp.dat;* -$ set def sys$sysdisk:[sysexe] -$ open/write tfile temp.bcm -$ write tfile "$ run authorize" -$ write tfile "list ''p1'" -$ close tfile -$ @temp.bcm -$ del temp.bcm;0 -$ open/read uaflis sysuaf.lis -$ read/end=eol uaflis line -$ loop: -$ read/end=eol uaflis line -$ user := "''f$extract(21,12,line)'" -$ account := "''f$extract(44,8,line)'" -$ if account .eqs. " " then goto loop -$ deff := "''f$extract(63,1000,line)'" -$ write sys$output "''user' ''deff'" -$ set def 'deff' -$ assign/user 'mgrdir'temp.dat sys$output -$ run sys$system:bullcheck -$ set def 'mgrdir' -$ open/read/err=loop tempf temp.dat -$ read/end=notempdat tempf line -$ read/end=notempdat tempf line -$ close tempf -$ write sys$output "Sending mail to ''user'" -$ open/write bcm bcmail.tmp -$ write bcm "$mail" -$ write bcm "send" -$ write bcm "''user'" -$ write bcm "Bulletins" -$ close bcm -$ append bcmail.txt bcmail.tmp -$ append temp.dat bcmail.tmp -$ @bcmail.tmp -$ delete bcmail.tmp;*,temp.dat;* -$ goto loop -$ notempdat: -$ close tempf -$ delete temp.dat;* -$ goto loop -$ eol: -$ close uaflis -$ done: -$ set def sys$sysdisk:[sysexe] -$ delete sysuaf.lis;0 -$ set def 'mgrdir' -$ if save_verify then set verify diff --git a/decus/vax82b/bulletin/bcmail.txt b/decus/vax82b/bulletin/bcmail.txt deleted file mode 100644 index 7ef66d0..0000000 --- a/decus/vax82b/bulletin/bcmail.txt +++ /dev/null @@ -1,9 +0,0 @@ - Some users have missed bulletins of interest to them either because -they missed the announcement that there were new bulletins on a subject, or -for other reasons. I am sending you a list of subjects which contain bull- -etins you have not read as of this mailing. If you do not wish to read any -of them, please ignore this letter. You may read new bulletins on a given -subject by typing "BULL/SUB=subject". You should include this command for -subjects of interest in your login command file (login.com), so that you -will always get the lastest information. - diff --git a/decus/vax82b/bulletin/build.com b/decus/vax82b/bulletin/build.com deleted file mode 100644 index b718f25..0000000 --- a/decus/vax82b/bulletin/build.com +++ /dev/null @@ -1,4 +0,0 @@ -$ compile/list/link=(/notrace/map) - - bull/nowarn/nodebug/inc=bullcom.for,bullparse -$ compile/list/link=(/notrace/map) - - bullcheck/nowarn/nodebug/inc=bullcom.for diff --git a/decus/vax82b/bulletin/bull.for b/decus/vax82b/bulletin/bull.for deleted file mode 100644 index bb045c5..0000000 --- a/decus/vax82b/bulletin/bull.for +++ /dev/null @@ -1,475 +0,0 @@ -c -c Program by: -c Robert K. Stodola -c The Institute for Cancer Research -c 7701 Burholme Avenue -c Philadelphia, PA 19111 -c - implicit integer (a - z) - include 'bullcom.for' - character*132 inline - integer stat - logical lstat - equivalence (lstat,stat) - logical is,isnt - - lincnt = 0 - stat = lib$get_foreign(inline,,len) - stat = bullparse(inline(1:len)) - open (unit=4,file='SYS$OUTPUT',carriagecontrol='fortran') - open (unit=5,file='SYS$COMMAND') - if (.not.stat) call lib$stop(%val(stat)) - if (is(delete_flag)) then - call delete - else if (is(add_flag)) then - call add - else if (is(directory_flag)) then - call directory - else - call list - endif - end - - - subroutine delete - implicit integer (a - z) - include 'bullcom.for' - integer stat - logical lstat - equivalence (lstat,stat) - logical is,isnt - integer*4 t(2),l,nch - character*20 seqasc - character*80 dat - - if (isnt(subject_present)) subject_buffer = 'AAASYSBUL' - if (subject_buffer.eq.'* ') call invsub - if (isnt(sequence_present)) call nosequ - open (unit=1,file='sys$public:sysbulsub.dat',status='old', - 1 dispose='keep',access='keyed',organization='indexed', - 1 recordtype='fixed',recordsize=17,key=(1:9:character), - 1 shared,readonly,err=105) - read (1,key=subject_buffer,err=100) subject_buffer,t - close (unit=1) - open (unit=2,file='sys$public:'//subject_buffer//'.sbl', - 1 status='unknown', - 1 dispose='keep',access='keyed',organization='indexed', - 1 recordtype='fixed',recordsize=102,key=(1:20:character), - 1 form='formatted',shared,err=105) - if (.not.copyms(seq,4,.true.,t,subject_buffer)) goto 110 - close (unit=2) - return -100 continue - close (unit=1) -105 continue - call nosubj -110 continue - close (unit=2) - call nosseq - return - end - - - subroutine add - implicit integer (a - z) - include 'bullcom.for' - integer stat - logical lstat - equivalence (lstat,stat) - logical is,isnt - integer*4 t(2),l,nch - character*20 seqasc - character*80 dat - - if (isnt(subject_present)) subject_buffer = 'AAASYSBUL' - if (subject_buffer.eq.'* ') call invsub - call sys$gettim(seq) - open (unit=1,file='sys$public:sysbulsub.dat',status='unknown', - 1 dispose='keep',access='keyed',organization='indexed', - 1 recordtype='fixed',recordsize=17,key=(1:9:character), - 1 shared) - open (unit=2,file='sys$public:'//subject_buffer//'.sbl', - 1 status='unknown', - 1 dispose='keep',access='keyed',organization='indexed', - 1 recordtype='fixed',recordsize=102,key=(1:20:character), - 1 form='formatted',shared) - read (1,key=subject_buffer,err=10) subject_buffer - rewrite (1) subject_buffer,seq - go to 20 -10 continue - write (1) subject_buffer,seq -20 continue - close (unit=1) - l = 1 - if (is(file_present)) then - lun = 7 - open (unit=lun,file=file_name,status='old',readonly,shared) - else - lun = 5 - write (4,30) -30 format (' Enter message followed by control-z') - endif -40 continue - read (lun,50,end=80,err=80)nch,dat -50 format (q,a80) - call makseq(seqasc,seq,l) - write (2,60)seqasc,nch,dat -60 format (a20,i2,a80) - l = l+1 - go to 40 -80 continue - close (unit=lun) - close (unit=2) - return - end - - - subroutine directory - implicit integer (a - z) - include 'bullcom.for' - logical is,isnt - integer*4 t(2) - character*23 date - - open (unit=1,file='sys$public:sysbulsub.dat',status='old', - 1 dispose='keep',access='keyed',organization='indexed', - 1 recordtype='fixed',recordsize=17,key=(1:9:character), - 1 shared,readonly,err=100) - read (1,keyge=' ',err=100) subject_buffer,t - lc = 0 - subject_buffer = ' ' -10 continue - if (lc.eq.0) then - call outln(4,'Subject Date of last entry') - call outln(4,'------- ------------------') - lc = 1 - endif - call lib$sys_asctim(,date,t) - call outln(4,subject_buffer//' '//date) - read (1,err=100,end=100) subject_buffer,t - go to 10 -100 continue - close (unit=1) - return - end - - - subroutine list - implicit integer (a - z) - include 'bullcom.for' - integer stat - logical lstat - equivalence (lstat,stat)I - logical is,isnt,first - integer*4 t(2),tred(2),tinf(2),curt(2),zbuf(2),l,nch9 - character*9 cursubn - character*11 todayu - character*20 seqasc - character*80 dat - character*36 outg - character*1 answern - data first/.true./g - data zbuf/0,0/l - - answer = ' ' - if (isnt(subject_present)) subject_buffer = 'AAASYSBUL' - call sys$gettim(curt) - open (unit=1,file='sys$public:sysbulsub.dat',status='old',e - 1 dispose='keep',access='keyed',organization='indexed', - 1 recordtype='fixed',recordsize=17,key=(1:9:character), - 1 shared,readonly) - open (unit=3,file='sys$login:sysbull.dat',status='unknown', - 1 dispose='keep',access='keyed',organization='indexed', - 1 recordtype='fixed',recordsize=25,key=(1:9:character), - 1 shared) - read (1,keyge=' ',err=120) cursub,t -10 continuel - read (3,key=cursub,err=20) cursub,tred,tinf - go to 30c -20 continuea - write (3) cursub,0,0,0,0s - read (3,key=cursub) cursub,tred,tinf -30 continuee - if (subject_buffer.ne.cursub.and.subject_buffer.ne.'* ') - 1 goto 80 - if (is(since_flag)) thens - if (timcmp(t,since_buffer).lt.0) go to 110e - call makseq(seqasc,since_buffer,1)c - else if (is(old_flag).or.is(before_flag)) then - call makseq(seqasc,zbuf,1)a - elses - if (timcmp(t,tred).lt.0) go to 110 - call makseq(seqasc,tred,1)i - endif -40 continuef - open (unit=2,file='sys$public:'//cursub//'.sbl',c - 1 status='old', - 1 dispose='keep',access='keyed',organization='indexed', - 1 recordtype='fixed',recordsize=102,key=(1:20:character), - 1 form='formatted',readonly,shared) - read (2,50,keyge=seqasc,err=70) seq(2),seq(1),l,nch,dat -50 format (2z8,i4,i2,a80)e -60 continue1 - if (is(before_flag)) then - if (timcmp(seq,before_buffer).gt.0) go to 70 - else if (isnt(old_flag).and.isnt(since_flag)) thenr - if (timcmp(seq,tred))69,65,65n - endif, -65 continue, - call copyms(seq,4,.false.,t,cursub) - if (answer.eq.'G'.or.answer.eq.'g') goto 68 - if (.not.first) thenS - type 6500b -6500 format (/,'$Type F,P,G,Q or ? ') - elsem - write(4,66)u -66 format(/,'$Type File, Print, Go, Quit or for next:')s - first = .false.' - endifg - read(5,67,end=6705,err=6705)answer, -67 format(a1)9 - lincnt = 0a - if (answer.ne.'q'.and.answer.ne.'Q') goto 68r -6705 continue= - call exit -68 continue' - if (answer.eq.'f'.or.answer.eq.'F') thenx - open (unit=6,name='SYS$LOGIN:'//cursub//'.bul',f - 1 status='unknown',a - 1 access='append',carriagecontrol='fortran', - 1 dispose='keep')b - call copyms(seq,6,.false.,t,cursub)w - close(unit=6)b - else if (answer.eq.'p'.or.answer.eq.'P') then - open (unit=6,name=cursub//'.lis',status='new', - 1 carriagecontrol='fortran', - 1 dispose='print/delete') - call copyms(seq,6,.false.,t,cursub)a - close(unit=6)e - endif - seq(1) = t(1) - seq(2) = t(2) -69 continuer - if (seq(1).ne.0.or.seq(2).ne.0) goto 60 -70 continuei - if (isnt(before_flag)) rewrite (3) cursub,curt,curt - close (unit=2)i - go to 110 -80 continuee - if (timcmp(t,tinf)) 110,90,90 -90 continuer - call outln(4,' ') - if (cursub.ne.'AAASYSBUL') then - encode (36,100,out) cursuba -100 format ('There are new bulletins on 'a9) - call outln(4,out) - else' - call outln(4,'There are new bulletins.')r - endif - rewrite (3) cursub,tred,curtr -110 continue - read (1, end=120) cursub,te - go to 10e -120 continue - close (unit=1) - close (unit=3)e - return - end - 0 - n - logical function copyms(inseq,lun,delflag,outseq,sub) - implicit integer (a - z) - integer*4 inseq(2),lun,outseq(2)- - logical delflag - character*9 sub - include 'bullcom.for' - integer*4 l,nch - character*80 dat_ - character*20 seqasc - r - call makseq(seqasc,inseq,1) - read (2,10,key=seqasc,err=110) outseq(2),outseq(1),l,nch,datr -10 format (2z8,i4,i2,a80)i - if (delflag) write (lun,20) -20 format (' Deleting record:')r - call listhd(lun,inseq,sub)v -30 continue, - call outln(lun,dat(1:nch)) - if (delflag) then - delete(2) - lincnt = 0 - endif - read (2,10,err=80,end=80) outseq(2),outseq(1),l,nch,dat - if (outseq(1).eq.inseq(1).and.outseq(2).eq.inseq(2)) go to 30 - goto 60 -80 continuel - outseq(1) = 0 - outseq(2) = 0 -60 continuej - copyms = .true. - return -110 continue - copyms = .false.i - returnu - end - - s - logical function is(x)1 - implicit integer (a - z)e - include 'bullcom.for' - - is = (x.and.parameters).ne.0i - return= - end - - - logical function isnt(x) - implicit integer (a - z)o - include 'bullcom.for' - - isnt = (x.and.parameters).eq.0s - returno - end - - - subroutine makseq(seqbuf,seqnum,linnum) - implicit integer (a - z), - character*20 seqbuf - integer*4 seqnum(2) - integer*4 linnumc - include 'bullcom.for' - integer statu - logical lstat - equivalence (lstat,stat)w - logical is,isnt - - encode(20,10,seqbuf)seqnum(2),seqnum(1),linnumc -10 format (2z8,i4) - return. - end - - - subroutine listln(lun,nch,dat)) - implicit integer (a - z)c - integer*4 nch - character*(*) dat - character*60 outo - integer l1,l2 - - l1 = (54-nch)/2 - l2 = (55-nch)/2 - encode (60,30,out) dat(1:nch) -30 format('***',x,a,x,'***')f - call outln(lun,out) - return( - end - - - subroutine listhd(lun,tim,sub)s - implicit integer (a - z) - integer*4 tim(2) - character*9 sub - include 'bullcom.for' - character*23 date - character*17 seqnum - integer lenseqe - - call outln(lun,' ') - call lib$sys_asctim(,date,tim)i - lenseq = 0: - if (is(sequence_flag)) then - encode (17,10,seqnum) tim -10 format (z8,':',z8)r - do 20 i = 1,17l - if (seqnum(i:i).ne.' ') thena - lenseq = lenseq+1 - seqnum(lenseq:lenseq) = seqnum(i:i) - endif -20 end dot - endif - if (sub.eq.'AAASYSBUL') theni - call listln(lun,24+lenseq,date//' '//seqnum(1:lenseq)) - else - call listln(lun,34+lenseq,date//' '//sub//' '//seqnum(1:lenseq)) - endif - end - - - subroutine outln(lun,dat) - implicit integer (a - z) - parameter pagesz = 24 - character*(*) dat - include 'bullcom.for' - - if (lun.eq.4) theno - if (lincnt.ge.pagesz-4) theni - write (4,10)' -10 format(/'$Type to continue ')a - read (5,20,end=25,err=25) -20 format()( -25 continuen - lincnt = 0 - endif - lincnt = lincnt+1 - endif - write (lun,30) dat -30 format(1x,a) - returnc - end - - - subroutine mvq(a,b) - integer*4 a(2),b(2) - - a(1) = b(1) - a(2) = b(2) - return/ - end - - u - integer function timcmp(t1,t2) - integer*4 t1(2),t2(2),dif(2)= - - call lib$subx(t1,t2,dif)' - if (dif(2).ne.0) then - timcmp = dif(2) - else if (dif(1).ne.0) then - timcmp = 1p - elses - timcmp = 0n - endif - returnm - end - - . - subroutine invsub - - write (4,10)o -10 format('0Invalid subject given.') - call exit - end - - , - subroutine nosequ - - write (4,10)e -10 format('0Sequence number required for this operation.') - call exit - end - - i - subroutine nosseq - - write (4,10)0 -10 format('0Sequence number not found.') - call exit - end - s - - subroutine nosubj - - write (4,10) -10 format('0No such subject.') - call exit - end - 0 diff --git a/decus/vax82b/bulletin/bullcheck.for b/decus/vax82b/bulletin/bullcheck.for deleted file mode 100644 index 8e7ade4..0000000 --- a/decus/vax82b/bulletin/bullcheck.for +++ /dev/null @@ -1,106 +0,0 @@ - implicit integer (a - z) - include 'bullcom.for' - integer stat - logical lstat - equivalence (lstat,stat) - logical is,isnt - - open (unit=4,file='SYS$OUTPUT',carriagecontrol='fortran') - open (unit=5,file='SYS$COMMAND') - call directory - end - - - subroutine directory - implicit integer (a - z) - include 'bullcom.for' - integer*4 t1(2),t2(2) - character*23 date1,date2 - - open (unit=1,file='sys$public:sysbulsub.dat',status='old', - 1 dispose='keep',access='keyed',organization='indexed', - 1 recordtype='fixed',recordsize=17,key=(1:9:character), - 1 shared,readonly,err=100) - open (unit=3,file='sys$disk:[]sysbull.dat',status='old', - 1 dispose='keep',access='keyed',organization='indexed', - 1 recordtype='fixed',recordsize=25,key=(1:9:character), - 1 shared,readonly,err=90) -3 continue - read (1,keyge=' ',err=100) subject_buffer,t1 - lc = 0 - t2(1) = 0 - t2(2) = 0 - read (3,key=subject_buffer,err=5,end=5) subject_buffer,t2 -5 continue - subject_buffer = ' ' -10 continue - if (timcmp(t1,t2) .gt. 0) then - if (lc.eq.0) then - call outln(4, - *' Subject Date of last entry Date last read') - call outln(4, - *' ------- ------------------ --------------') - lc = 1 - endif - call lib$sys_asctim(,date1,t1) - if (t2(1) .eq. 0 .and. t2(2) .eq.0) then - date2 = 'Never read' - else - call lib$sys_asctim(,date2,t2) - endif - call outln(4,' '//subject_buffer//' '//date1//' '//date2) - endif - read (1,err=100,end=100) subject_buffer,t1 - t2(1) = 0 - t2(2) = 0 - read (3,key=subject_buffer,err=10,end=10) subject_buffer,t2 - go to 10 -90 continue - write (4,95) -95 format(' User never logged in!!') - go to 110 -100 continue - close (unit=3) -110 continue - close (unit=1) - return - end - - - subroutine outln(lun,dat) - implicit integer (a - z) - parameter pagesz = 24 - character*(*) dat - include 'bullcom.for' - - if (lun.eq.4) then - if (lincnt.ge.pagesz-4) then - write (4,10) -10 format(/'$Type to continue ') - read (5,20,end=25,err=25) -20 format() -25 continue - lincnt = 0 - endif - lincnt = lincnt+1 - endif - write (lun,30) dat -30 format(1x,a) - return - end - - - integer function timcmp(t1,t2) - integer*4 t1(2),t2(2),dif(2) - - call lib$subx(t1,t2,dif) - if (dif(2).ne.0) then - timcmp = dif(2) - else if (dif(1).ne.0) then - timcmp = 1 - else - timcmp = 0 - endif - return - end - diff --git a/decus/vax82b/bulletin/bullcom.for b/decus/vax82b/bulletin/bullcom.for deleted file mode 100644 index c081079..0000000 --- a/decus/vax82b/bulletin/bullcom.for +++ /dev/null @@ -1,20 +0,0 @@ - parameter subject_flag = '1'x - parameter subject_present = '2'x - parameter since_flag = '4'x - parameter before_flag = '10'x - parameter sequence_flag = '40'x - parameter sequence_present = '80'x - parameter old_flag = '100'x - parameter add_flag = '200'x - parameter delete_flag = '400'x - parameter file_present = '800'x - parameter directory_flag = '1000'x - integer*4 parameters,since_buffer(2),before_buffer(2) - integer*4 seq(2) - character*9 subject_buffer - character*64 file_name - common /bulpar/ parameters,subject_buffer,since_buffer, - 1 before_buffer,seq,file_name - - integer*4 lincnt - common /lincnt/ lincnt diff --git a/decus/vax82b/bulletin/bulletin.hlp b/decus/vax82b/bulletin/bulletin.hlp deleted file mode 100644 index a62851d..0000000 --- a/decus/vax82b/bulletin/bulletin.hlp +++ /dev/null @@ -1,104 +0,0 @@ -1 BULLETIN - - Invokes the ICR system bulletin utility. This utility is used to - provide information to users of the system. - - There are two distinct classes of bulletins: those intended for all - users, and those concerning a particular subject which only a part of - the user community will be interested. - - - Format: - - BULLETIN [file-spec] - - - Note that unlike many VAX/VMS commands, all switches must precede the - file-spec. - -2 Parameters - - file-spec - - The file-spec parameter is, if present, used as the input text - for the add command. - - If you omit the file-spec parameter, text input will be from - SYS$INPUT. - - No wild card characters are allowed in the file specification. - -2 Qualifiers - -/ADD -/DELETE -/LIST (D) -/DIRECTORY - - /LIST allows users to display bulletins. Unless /OLD or /SINCE - is used, bulletins which you have already read will not be - displayed. If no subjects are specified, you will be informed - about subjects which have had new bulletins added since you last - inquired. - - /DIRECTORY will list those subjects with messages. - - /ADD allows the bulletin manager to add messages. If the - file-spec was specified, the text in that file will be added. If - the file-spec is not specified, the text to be added will come - from SYS$INPUT. - If the /SUBJECT switch is omitted, this bulletin will be for all - users. All other switches will be ignored. - - /DELETE allows the bulletin manager to delete a message. - If the /SUBJECT switch is omitted, the message to be deleted will - be from the file of general messages. - The /SEQUENCE switch must be specified with a sequence number. - -/OLD -/SINCE[=date] -/BEFORE[=date] - - Normally, only new messages will be displayed. These switches - allow you to view past messages. - - /OLD alone will begin at the beginning of the message file. - - /SINCE will start with the first message with the specified date - and proceed forward. If unspecified, the date used will be - todays date. - - /BEFORE will not display any messages from the specified or later - dates. If unspecified, the date used will be todays date. If - /BEFORE is used, any new messages will be displayed the next time - you ask for new messages, even if they are displayed with this - switch. - -/SEQUENCE[=id] - - For listing operations, this switch specifies that bulletin id's - be displayed with the message. This is normally used prior to a - /DELETE operation to get the sequence number of the message. In - this case, the id, if specified, is ignored. - - For the /DELETE operation, this switch must be used with a value - to indicate the message to be deleted. - - 'id' formats are two 1-8 hexadecimal digit numbers separated by a - colon. - -/SUBJECT=subject - - For list operations, this specifies the subject to be listed. If - not specified, only messages of general interest are displayed. - If an asterisk is used, all subjects are presented. You will - always be informed when new messages have been added to any - subject. - - For add operations, this specifies the subject of the new - material. If not specified, the new message will be added to - those of general interest. - - For delete operations, this specifies the subject of the message - to be deleted. If not specified, the message to be deleted was - of general interest. diff --git a/decus/vax82b/bulletin/bulletin.rno b/decus/vax82b/bulletin/bulletin.rno deleted file mode 100644 index e7075ed..0000000 --- a/decus/vax82b/bulletin/bulletin.rno +++ /dev/null @@ -1,123 +0,0 @@ -.paper size 1000,72 -.left margin 0 -.right margin 71 -.literal -1 BULLETIN -.end literal -.left margin 1 -.paragraph 0,1 - Invokes the ICR system bulletin utility. This utility is used to - provide information to users of the system. -.paragraph 0,1 - There are two distinct classes of bulletins: those intended for all users, - and those concerning a particular subject which only a part of the - user community will be interested. -.literal - - - Format: - - BULLETIN [file-spec] - -.end literal -.paragraph 0,1 - Note that unlike many VAX/VMS commands, all switches must precede the - file-spec.a -.right margin 66 -.left margin 0 -.literal -2 Parameters - file-spec -.end literal -.left margin 1 -.paragraph 0,1 - The file-spec parameter is, if present, used as the input text for the - add command.b -.paragraph 0,1 - If you omit the file-spec parameter, text input will be from SYS$INPUT. -.paragraph 0,1 - No wild card characters are allowed in the file specification. -.left margin 0 -.literal -2 Qualifiers -/ADD -/DELETE, -/LIST (D)h -/DIRECTORY -.end literal -.left margin 1 -.paragraph 0,1 - /LIST allows users to display bulletins. Unless /OLD or /SINCE isN - used, bulletins which you have already read will not be displayed.u - If no subjects are specified, you will be informed about subjects which - have had new bulletins added since you last inquired. -.paragraph 0,1 - /DIRECTORY will list those subjects with messages.d -.paragraph 0,1 - /ADD allows the bulletin manager to add messages. - If the file-spec was specified, the - text in that file will be added. If the file-spec is not specified,w - the text to be added will come from SYS$INPUT.n -.paragraph 0,0 - If the /SUBJECT switch is omitted, this bulletin will be for all users. - All other switches will be ignored. -.paragraph 0,1 - /DELETE allows the bulletin manager to delete a message.E -.paragraph 0,0 - If the /SUBJECT switch is omitted, the message to be deleted will be from - the file of general messages. -.paragraph 0,0 - The /SEQUENCE switch must be specified with a sequence number. -.left margin 0 -.literal -/OLD -/SINCE[=date] -/BEFORE[=date] -.end literal -.left margin 1 -.paragraph 0,1 - Normally, only new messages will be displayed. These switches allow youO - to view past messages. -.paragraph 0,1 - /OLD alone will begin at the beginning of the message file. -.paragraph 0,1 - /SINCE will - start with the first message with the specified date and proceed forward. - If unspecified, the date used will be todays date. -.paragraph 0,1 - /BEFORE will not display any messages from the specified or later dates.f - If unspecified, the date used will be todays date., - If /BEFORE is used, any new messagesf - will be displayed the next time you ask for new messages, even if theyu - are displayed with this switch. -.left margin 0 -.literal -/SEQUENCE[=id] -.end literal -.left margin 1 -.paragraph 0,1 - For listing operations, this switch specifies that bulletin id's be - displayed with the message. This is normally used prior to a /DELETE - operation to get the sequence number of the message. In this case, - the id, if specified, is ignored. -.paragraph 0,1 - For the /DELETE operation, this switch must be used with a value to - indicate the message to be deleted. -.paragraph 0,1 - 'id' formats are two 1-8 hexadecimal digit numbers separated by a colon.s -.left margin 0 -.literal -/SUBJECT=subject -.end literal -.left margin 1 -.paragraph 0,1 - For list operations, this specifies the subject to be listed. If not - specified, only messages of general interest are displayed. If an - asterisk is used, all subjects are presented. You will always be informede - when new messages have been added to any subject. -.paragraph 0,1 - For add operations, this specifies the subject of the new material. If - not specified, the new message will be added to those of general interest.e -.paragraph 0,1 - For delete operations, this specifies the subject of the message to be - deleted. If not specified, the message to be deleted was of general interest. diff --git a/decus/vax82b/bulletin/bullintro.rno b/decus/vax82b/bulletin/bullintro.rno deleted file mode 100644 index 60f9b75..0000000 --- a/decus/vax82b/bulletin/bullintro.rno +++ /dev/null @@ -1,33 +0,0 @@ -.paper size 1000,80 -.left margin 0 -.right margin 79 -.paragraph 0,1 -This program displays bulletins of general interest. -You may get information on how -to use it by typing "HELP BULLETIN". When you log in, -the program will print -messages you have not yet read (unless you ask for old -messages). It will also tell you when new messages have been -added on possible topics of interest, but you must specifically -ask to read these messages. You may wish to put "BULL/SUBJECT=subject" in -your login.com file for those subjects in which you are interested. -Those subjects on which there are bulletins can be listed by -typing "BULL/DIRECTORY". -.paragraph 0,1 -At the end of each message -(as below), the program will allow you to select various options. -Typing "Go" will cause all messages to be displayed without further -interruption -(except at the bottom of the screen). Typing "Quit" will discontinue the -bulletins, but they will all be typed again the next time you login -(or ask for bulletins). Typing "File" will save the preceding -message in a file named "AAASYSBUL.BUL" or "subject.BUL" -on your login directory, while typing -"Print" will print the bulletin. A carriage return will proceed -to the next message. -.paragraph 0,1 -.center ;*** NOTE *** -.skip -Do not delete your file SYS$LOGIN:SYSBULL.DAT_! This file remembers -which bulletins you have read and not read. Deleting it will cause -BULLETIN to recreate it next time, and assume you have read no bulletins_! diff --git a/decus/vax82b/bulletin/bullintro.txt b/decus/vax82b/bulletin/bullintro.txt deleted file mode 100644 index b6d7d56..0000000 --- a/decus/vax82b/bulletin/bullintro.txt +++ /dev/null @@ -1,26 +0,0 @@ - - -This program displays bulletins of general interest. You may get information -on how to use it by typing "HELP BULLETIN". When you log in, the program will -print messages you have not yet read (unless you ask for old messages). It -will also tell you when new messages have been added on possible topics of -interest, but you must specifically ask to read these messages. You may wish -to put "BULL/SUBJECT=subject" in your login.com file for those subjects in -which you are interested. Those subjects on which there are bulletins can be -listed by typing "BULL/DIRECTORY". - -At the end of each message (as below), the program will allow you to select -various options. Typing "Go" will cause all messages to be displayed without -further interruption (except at the bottom of the screen). Typing "Quit" will -discontinue the bulletins, but they will all be typed again the next time you -login (or ask for bulletins). Typing "File" will save the preceding message in -a file named "AAASYSBUL.BUL" or "subject.BUL" on your login directory, while -typing "Print" will print the bulletin. A carriage return will proceed to the -next message. - - *** NOTE *** - -Do not delete your file SYS$LOGIN:SYSBULL.DAT! This file remembers which -bulletins you have read and not read. Deleting it will cause BULLETIN to -recreate it next time, and assume you have read no bulletins! - diff --git a/decus/vax82b/bulletin/bullparse.mar b/decus/vax82b/bulletin/bullparse.mar deleted file mode 100644 index 8b419d5..0000000 --- a/decus/vax82b/bulletin/bullparse.mar +++ /dev/null @@ -1,219 +0,0 @@ - .title bullparse -- parse bull command linesr - .sbttl definitions - $dscdef - $tpadef -; -subject_flag = 1 ;flag subject present -subject_present = 2 ;flag subject has value -since_flag = 4 ;flag since present -since_present = 8 ;flag since has value (unused) -before_flag = 16 ;flag before present -before_present = 32 ;flag before has value (unused)y -sequence_flag = 64 ;flag sequence present -sequence_present = 128 ;flag sequence has valuee -old_flag = 256 ;flag old presentp -add_flag = 512 ;flag add present -delete_flag = 1024 ;flag delete presentp -file_present = 2048 ;flag filename present -directory_flag = 4096 ;flag directory presente -;y - .macro .descr addr,length=0,class=dsc$k_class_s,type=dsc$k_dtype_t - .word lengtht - .byte type,classs - .address addr - .endm .descr. -; - .page - .sbttl common area - .psect bulpar,pic,ovr,noexe,gbl,rel,shr,rd,wrt,long -parameters: - .long 0 ;parameter flags -subject_buf: - .blkb 9 ;name of subject -since_buffer: - .quad 0 ;value of since flag -before_buffer: - .quad 0 ;value of before flag -seq: - .quad 0 ;sequence number -seq_1 = seq -seq_2 = seq+4 -file_name: - .blkb 64 ;filename -; - .sbttl impure area - .psect impure,wrt,noexe -subject_buffer: - .descr subject_buf,9 ;subject buffer descriptor -file_buffer: - .descr file_name,64 ;filename buffer -dball: .ascid /00-xxx-0000 00:00:00.00/ -db: .descr dball+8,11 -dayb: .descr dball+8,2 -date_month: - .descr dball+8+3,3 -yearb: .descr dball+8+7,4 -date_year: - .long 0 -date_day: - .long 0 -bull_param: - .long tpa$k_count0 - .blkb tpa$k_length0-4 - .page - .sbttl main code - .psect code,wrt,exe -; -; call bullparse(comlin) -; -; comlin: string descriptor of command line -; - .entry bullparse,^m - clrl parameters ;clear all parameter flag bits - clrq since_buffer ;clear since value buffer - clrq before_buffer ;clear before value buffer - movaq @4(ap),r2 ;get string descriptor - movzwl (r2),bull_param+tpa$l_stringcnt ;save string count - movl 4(r2),bull_param+tpa$l_stringptr - movl #tpa$m_blanks!tpa$m_abbrev,bull_param+tpa$l_options - pushal bull_key - pushal bull_state - pushal bull_param - calls #3,g^ - ret - .page - .sbttl bull parse structures and routines. -; -; - $init_state bull_state,bull_key -; -; parse for a switch -; - $state options - $tran TPA$_BLANK - $tran TPA$_LAMBDA - $state - $tran '/' - $tran TPA$_EOS,TPA$_EXIT - $tran TPA$_LAMBDA,TPA$_EXIT,filecopy,file_present,parameters,- - file_buffer - $state - $tran 'SUBJECT',subject,,subject_flag,parameters - $tran 'SINCE',since,,since_flag,parameters - $tran 'BEFORE',before,,before_flag,parameters - $tran 'LIST',options - $tran 'OLD',options,,old_flag,parameters - $tran 'SEQUENCE',sequence,,sequence_flag,parameters - $tran 'ADD',options,,add_flag,parameters - $tran 'DELETE',options,,delete_flag,parameters - $tran 'DIRECTORY',options,,directory_flag,parameters -; -; subject processing -; - $state subject - $tran '=',,,subject_present,parameters - $tran TPA$_LAMBDA,options - $state - $tran '*',options,movestring,,,subject_buffer - $tran TPA$_STRING,options,movestring,,,subject_buffer -; -; since processing -; - $state since - $tran !date,options,movedate,,,since_buffer -; -; before processing -; - $state before - $tran !date,options,movedate,,,before_buffer -; -; sequence number processing -; - $state sequence - $tran '=',,,sequence_present,parameters - $tran TPA$_LAMBDA,options - $state - $tran TPA$_HEX,,,,seq_1 - $state - $tran ':' - $state - $tran TPA$_HEX,,,,seq_2 -; -; parse the date -; - $state date - $tran !dmy,TPA$_EXIT - $tran TPA$_LAMBDA,TPA$_EXIT -; -; parse day/month/year -; - $state dmy - $tran TPA$_LAMBDA,,defdmy - $state - $tran '=' - $tran TPA$_LAMBDA,TPA$_EXIT - $state - $tran TPA$_DECIMAL,,,,date_day - $state - $tran '-' - $state - $tran TPA$_STRING,,movestring,,,date_month - $state - $tran '-' - $tran TPA$_LAMBDA,TPA$_EXIT,defyear - $state - $tran TPA$_DECIMAL,,,,date_year - $state - $tran TPA$_LAMBDA,TPA$_EXIT,checkdmy - $end_state -; -; action routines -; - .psect code,wrt,exe -defdmy: - .word ^m<> - - pushaq db ; get date - calls #1,g^ - ret -; -checkdmy: - .word ^m<> - pushl #4 ;convert year to ascii - pushl #4 - pushaq yearb - pushal date_year - calls #4,g^ - brb doday -defyear: - .word ^m<> -doday: - pushl #4 ;convert day to ascii - pushl #2 - pushaq dayb - pushal date_day - calls #4,g^ - ret -; -movedate: - .word ^m<> - $bintim_s dball,@tpa$l_param(ap) - ret -; -movestring: - .word ^m<> - pushaq @tpa$l_param(ap) - pushab @tpa$l_tokenptr(ap) - pushal tpa$l_tokencnt(ap) - calls #3,g^ - ret -; -filecopy: - .word ^m<> - pushaq file_buffer - pushab @tpa$l_stringptr(ap) - pushal tpa$l_stringcnt(ap) - calls #3,g^ - ret -; - .end diff --git a/decus/vax85c/bulletin/aaareadme.doc b/decus/vax85c/bulletin/aaareadme.doc deleted file mode 100644 index 39fd3f9..0000000 --- a/decus/vax85c/bulletin/aaareadme.doc +++ /dev/null @@ -1,73 +0,0 @@ -The following are instructions for creating the BULLETIN executable and -installation of the utility. A brief explanation of how the internals -of the BULLETIN utility works can be found in BULLETIN.TXT . None of -the command procedures included here are sophisticated, so it is likely -that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are severalu - INCLUDE files for the fortran sources (.INC files). BULLFILES.INC must first - be modified before this procedure is run. It contains the names of data files - which BULLETIN creates. It also has the username for the BBOARD account.t - BBOARD is an option by which mail sent to the specified username will bet - converted into bulletins. This allows a user on a different system, which is - connected via a network, to be able to submit a bulletin. This feature can - be disabled if it is not desired by specifying the username NONE. In any - case, you should edit BULLFILES.INC and specify the appropriate device ands - directories in which you desire that the files be located. (NOTE: Although - the BBOARD feature can be used over DECNET, a more sophisticated method - is available to easily allow one to add bulletins to other DECNET nodes - with all the features of BULLETIN. See below). - -2) STARTUP.COM - The data files that BULLETIN creates should be owned by a system UIC, - and MUST be protected from users being able to have access them.L - STARTUP.COM sets the process UIC to [1,4] (you should change this ifc - you want something else), sets the WORLD and GROUP protection to NONE,t - adds the bulletin found in the file INSTRUCT.TXT (it is added withl - /PERMANENT, so it never expires), and then resets the UIC and PROTECTION - to what they were before running the procedure. - INSTRUCT.BUL contains a bulletin with instructions to the users as to - how to use the BULLETIN utility. You may want to modify it. - -3) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessaryh - help files in SYS$HELP. - -4) LOGIN.COM - This contains the comands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands.d - It also executes the command BULLETIN/LOGIN in order to notifyu - the user of new bulletins. If desired, the /READNEW qualifierd - can also be added. If there are any new non-system bulletins, this - qualifier creates a prompt asking the user if the non-systemv - bulletins are to be displayed or not. Normally, only system bulletins - are displayed in full, and only the subjects of the non-systema - bulletins are displayed. ( Some systems might have a lot of userso - who are not interested in reading the non-system bulletins, in - which case /READNEW should probably not be added. Instead, you could - let users enable this feature by entering the BULLETIN utility andh - typing the command SET READNEW ). (NOTE: Since /LOGIN and /READNEW - are system commands, they are not included in the help file). - -5) BULLSTART.COM - This procedure contains the commands that should be executed afterd - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM - as a batch job. It simply installs the BULLETIN utility with correct - privileges. - -6) BULLETIN.COMc - If one wants the feature of using BULLETIN between DECNET nodes,t - this file must be put in each node's DECNET default user's directoryA - (usually [DECNET]). Once this is done, the /NODE qualifer for the - ADD command can be used.i - NOTE: Presently, privileged functions such as /SYSTEM will worka - on other nodes only if you have an account on the other node with - the same username, and with appropriate privileges. You will bet - prompted for the password for the account on the remote node. However, - due to unknown reasons, the software I have to check the password will' - only work for passwords that have been set under V4.x. If the password - was created under V3.x, the program will not work, and you password wills - be treated as invalid.u diff --git a/decus/vax85c/bulletin/aaareadme.rno b/decus/vax85c/bulletin/aaareadme.rno deleted file mode 100644 index 297ba5b..0000000 --- a/decus/vax85c/bulletin/aaareadme.rno +++ /dev/null @@ -1,23 +0,0 @@ -.ps 60,80 -.lm 5 -.rm 75 -.ap -.blank 2 -.c;Mark London -.c;MIT Plasma Fusion Center -.c;167 Albany St. NW16-262 -.c;Cambridge, MA 02139 -.c;MRL%PFCVAX@ZERMATT -.blank 2 -This submission contains a new version of BULLETIN, -a bulletin board/announcement system for VMS. -ANNOUNCE.MAI describes the features added and bugs corrected, including -a change to the BBOARD feature which -broke with VMS version 4. - -See AAAREADME.DOC for instructions on building BULLETIN. - -Librarian's note: This package was copied from the ARPANET and put on the -tape with the permission of the author. Since I have expanded but not -compiled and run the programs/procedures I am including the raw mail files -as I got them from the net in [.NET__FILES]. diff --git a/decus/vax85c/bulletin/aaareadme.txt b/decus/vax85c/bulletin/aaareadme.txt deleted file mode 100644 index c42254f..0000000 --- a/decus/vax85c/bulletin/aaareadme.txt +++ /dev/null @@ -1,44 +0,0 @@ - - - - - - - Mark London - - MIT Plasma Fusion Center - - 167 Albany St. NW16-262 - - Cambridge, MA 02139 - - MRL%PFCVAX@ZERMATT - - - - - - This submission contains a new version of BULLETIN, a bulletin - - board/announcement system for VMS. ANNOUNCE.MAI describes the - - features added and bugs corrected, including a change to the BBOARD - - feature which broke with VMS version 4. - - - - See AAAREADME.DOC for instructions on building BULLETIN. - - - - Librarian's note: This package was copied from the ARPANET and - - put on the tape with the permission of the author. Since I have - - expanded but not compiled and run the programs/procedures I am - - including the raw mail files as I got them from the net in - - [.NET_FILES]. - diff --git a/decus/vax85c/bulletin/announce.mai b/decus/vax85c/bulletin/announce.mai deleted file mode 100644 index f85b5d9..0000000 --- a/decus/vax85c/bulletin/announce.mai +++ /dev/null @@ -1,78 +0,0 @@ -To: info-vax@sri-kl@mc -Subject: BULLETIN - -A new version of BULLETIN is now available. BULLETIN is a bulletin program -that I wrote to use under VMS until DEC comes up with their own. (A -description follows after the next couple of paragraphs.) The new version -fixes the BBOARD feature, which breaks under VMS V4.0, plus a few random bugs. -Some of the new features are: - -The command /NODE has been created to the ADD command in order to add bulletins -to other DECNET nodes. All features of the ADD command will apply to the -bulletin added to the other DECNET nodes. (i.e. /BROADCAST, etc.) -The command /EDIT has been created to the ADD command (similar to SEND/EDIT in -MAIL). System bulletins displayed upon logging do not run off the end of screen -if they are too large. Instead, the output is stopped at the end of the screen -and awaits a prompt. -Bulletins written by the FILE command include a header comment (controlled -by the /HEADER qualifer). - -A few minor changes: -The /BELL qualifier has been added to make it optional whether to include a bell -with a broadcasted bulletin. -A user can now enable prompting for reading non-system bulletins by using -the SET READNEW command rather than adding a BULLETIN/READNEW line in his login, -thus eliminating an addition image execution. -BULLETIN/SYSTARTUP is no longer necessary. (SHUTDOWN bulletins are -automatically deleted). - -(Future plans: I'm in the process of modifying bulletin to work with multiple -bulletin boards files.) - ------------------------------------------------------------------------------- - -Description of BULLETIN utility: - -Easy to use utility to submit and read bulletins. Similar to mail utility. -Users are notified of bulletins only once. They're not forced into reading -them every time they log in. - -SYSTEM bulletins are displayed in full. Only privileged users can submit them. -Any non-privileged users can submit non-system bulletins. Only the "subjects" -of these bulletins are displayed at login. The user can decide if the -bulletins are worthwhile reading. (There is also an optional feature which, if -installed, will ask a user upon logging in whether he or she wants to read -the non-system bulletins or not, and if so, they are automatically displayed. -The alternative is to let the user manually enter the commands in order to read -the bulletins.) -Privileged users can broadcast their bulletin to users that are logged -in. This allows you to get your message across to both logged in users -and non-logged in users. -Bulletins have expiration dates and are deleted automatically. -Privileged users can specify "SHUTDOWN" bulletins, i.e. bulletins that get -deleted after a system shutdown has occurred. -An optional feature allows non-system bulletins to be created by users of -other systems connected via networks. This "Bulletin Board" feature is on -several computers on the ArpaNet. This is accomplished by sending mail -to the dummy user BBOARD. (These bulletins expire after 7 days). -There is also a much more sophisticated optional feature which allows adding -bulletins to DECNET nodes from within the BULLETIN the utility (see the -ADD command). -This bulletin program does not create lots of files. It needs only 3 data -files. Neither does it create any additional processes (all events are -triggered by people logging in). - ----------------------------------------------------------------------------- - -Our VAX is not directly on the ArpaNet, so if you desire the sources, send -me your request and I will send the sources via mail. - -There are some command procedures for installation included. However, they -are pretty crude, as I have not had time to write something more sophisticated. -(P.s. If you already have an old version of the bulletin utility, you should -create the version in a different directory, as the command procedure is not -smart enough to delete obsolete files.) - - Mark R. London - MRL%PFCVAX@MC - diff --git a/decus/vax85c/bulletin/bboard.com b/decus/vax85c/bulletin/bboard.com deleted file mode 100644 index 79f3e52..0000000 --- a/decus/vax85c/bulletin/bboard.com +++ /dev/null @@ -1,5 +0,0 @@ -$ SET PROTECT=(W:RWED)/DEFAULT -$ MAIL -READ -EXTRACT/ALL USRD$:[BBOARD]BBOARD.MAI -DELETE/ALL diff --git a/decus/vax85c/bulletin/bulet.com b/decus/vax85c/bulletin/bulet.com deleted file mode 100644 index a8e866b..0000000 --- a/decus/vax85c/bulletin/bulet.com +++ /dev/null @@ -1,194 +0,0 @@ -$open/read input bullet.mai -$open/write output AAAREADME.TXT -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 73 then goto again -$ close output -$open/write output BBOARD.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 5 then goto again -$ close output -$open/write output BULLCOM.CLD -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 36 then goto again -$ close output -$open/write output BULLCOMS.HLP -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 135 then goto again -$ close output -$open/write output BULLDIR.INC -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 8 then goto again -$ close output -$open/write output BULLETIN.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 2 then goto again -$ close output -$open/write output BULLETIN.HLP -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 17 then goto again -$ close output -$open/write output BULLETIN.LNK -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 2 then goto again -$ close output -$open/write output BULLETIN.TXT -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 49 then goto again -$ close output -$open/write output BULLFILES.INC -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 27 then goto again -$ close output -$open/write output BULLFLAG.INC -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 23 then goto again -$ close output -$open/write output BULLMAIN.CLD -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 4 then goto again -$ close output -$open/write output BULLSTART.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 3 then goto again -$ close output -$open/write output BULLUSER.INC -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 8 then goto again -$ close output -$open/write output CLIDEF.MAR -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 3 then goto again -$ close output -$open/write output CREATE.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 10 then goto again -$ close output -$open/write output HPWD.MAR -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 223 then goto again -$ close output -$open/write output INSTALL.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 8 then goto again -$ close output -$open/write output INSTRUCT.TXT -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 6 then goto again -$ close output -$open/write output LOGIN.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 2 then goto again -$ close output -$open/write output SETUIC.MAR -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 54 then goto again -$ close output -$open/write output SETUSER.MAR -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 83 then goto again -$ close output -$open/write output STARTUP.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 10 then goto again -$ close output -$open/write output USEROPEN.MAR -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 154 then goto again -$ close output -$ close input diff --git a/decus/vax85c/bulletin/bullcom.cld b/decus/vax85c/bulletin/bullcom.cld deleted file mode 100644 index 0d0eebd..0000000 --- a/decus/vax85c/bulletin/bullcom.cld +++ /dev/null @@ -1,36 +0,0 @@ - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL = FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER BELL - QUALIFIER BROADCAST - QUALIFIER EDIT - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER PASSWORD, LABEL=PASSWORD, VALUE(REQUIRED) - QUALIFIER PERMANENT - QUALIFIER SHUTDOWN - QUALIFIER SYSTEM - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE VERB BACK - DEFINE VERB DELETE - PARAMETER P1, LABEL = BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB DIRECTORY - DEFINE VERB EXITA - DEFINE VERB FILEE - PARAMETER P1, LABEL = FILESPEC, VALUE(TYPE=$FILE,REQUIRED),C - PROMPT="File" - QUALIFIER HEADER, DEFAULTL - DEFINE VERB HELPD - PARAMETER P1, LABEL = HELP_TOPIC, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB NEXTN - DEFINE VERB READT - PARAMETER P1, LABEL = BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - DEFINE VERB REPLACE - PARAMETER P1, LABEL = FILESPEC, VALUE(TYPE=$FILE)E - QUALIFIER EXPIRATION - QUALIFIER HEADER - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER TEXT - DEFINE VERB SET - PARAMETER P1, LABEL = SET_PARAM1, VALUE(REQUIRED), - PROMPT="What" diff --git a/decus/vax85c/bulletin/bullcoms.hlp b/decus/vax85c/bulletin/bullcoms.hlp deleted file mode 100644 index 5c70d9b..0000000 --- a/decus/vax85c/bulletin/bullcoms.hlp +++ /dev/null @@ -1,135 +0,0 @@ -1 ADD -Adds a bulletin to the bulletin file. A file can be specified which -contains the bulletin. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the bulletin. - -Format - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the bulletin is broadcasted.t -2 /BROADCAST -This option is restricted to privileged users. If specified, bulletin -is both saved in the bulletin file and broadcasted to all users logged -in at the time.f -2 /EDIT -Determines whether or not the EDT editor is invoked to edit the bulletin -you are sending. -2 /NODES=(nodes[,...]) -Specifies to send the bulletin to other DECNET nodes. The BULLETIN utilityh -must be installed properly on the other nodes. You will prompted for thel -username to use at the other node. If you give a different username thanc -that of the local node, or if privileged qualifiers are specified, you willi -be prompted for the password of your account on the other nodes. At -present, if the password is invalid, the bulletin will be rejected on then -node, but no error message will be displayed on the local node that this -happened. -2 /PERMANENT -This option is restricted to privileged users. If specified, bulletin -will be a permanent bulletin and will never expire.r -2 /SHUTDOWNg -This option is restricted to privileged users. If specified, bulletin -will be automatically deleted after a computer shutdown has occurred.o -2 /SYSTEM -This option is restricted to privileged users. If specified, bulletin -is both saved in the bulletin file and displayed in full as a system -notice when a user logs in. System notices should be as brief as possible -to avoid the possibility that system notices could scroll off the screen. -1 BACK -Displays the bulletin preceding the current bulletin.r -1 DELETE -Deletes the specified bulletin. If no bulletin is specified, the currentf -bulletin is deleted. Only the original owner or a privileged user can -delete a bulletin. - -Format - DELETE [bulletin-number] - -The bulletin's relative number is found by the DIRECTORY command. -1 DIRECTORY -Lists a summary of the bulletins. The bulletin number, submitter's name,a -date, and subject of each bulletin is displayed. -1 EXIT -Exits the BULLETIN program.h -1 FILE -Copies the current bulletin to the named file. The file-name parameters -is required, and consists of up to 9 alpha-numeric characters in length. - -Format:s - FILE file-name -2 /HEADER - -/[NO]HEADER[ - -Controls whether a header containing the owner, subject, and date of the c -bulletin is written in the file. The default is to write the header.i -1 Bulletin -The BULLETIN utility permits a user to create a bulletin for reading by -all users. Users are notified upon logging in that new bulletins have -been added, and what the topic of the bulletins are. Actual reading off -the bulletins is optional. (See the command SET READNEW for info onE -automatic reading.) Bulletins are automatically deleted when theirh -expiration date has passed.j - -1 HELP -To obtain help on any topic, type: - - HELP topic -1 NEXT -Skips to the next bulletin and displays it. This is useful when pagingt -through the bulletins and you encounter a particularly long bulletin -that you would like to skip over.n -1 READ -Displays the specified bulletin. If you do not specify a bulletin, then -the first time you enter the command, the oldest bulletin will bee -displayed. However, if there are new bulletins, the first new bulletin -will be displayed. Each time you enter the command, the next page, or if -there are no more pages, the next bulletin will be displayed. - -Format - READ [bulletin-number] - -The bulletin's relative number is found by the DIRECTORY command.d - -Pressing just performs the same as the READ command.f -1 REPLACEp -Replaces an existing bulletin in the bulletin file. This is for changingl -part or all of a bulletin without causing users who have already seen then -bulletin to be notified of it a second time. If the text of the bulletin -is to be changed, a file can be specified which contains the text. -Otherwise, BULLETIN will prompt for the text. The expiration date and -header can also be changed. If neither /EXPIRATION, /HEADER, nor /TEXTT -are specified, it is assumed the whole bulletin will be replaced.s - -Format - REPLACE [file-name]i -2 /EXPIRATIONc -Specifies that the bulletin expiration date is to be replaced. -2 /HEADERe -Specifies that the bulletin header is to be replaced.f -2 /NUMBER=ne -Specifies the bulletin number to be replaced. If this qualifier is -omitted, the bulletin that is presently being read will be replaced. -2 /TEXT -Specifies that the bulletin text is to be replaced./ -1 SETo -Defines or changes characteristics associated with automatic reading -of bulletins.m - -Format: - - SET option -2 READNEWp -Controls whether you will be prompted upon logging in if you wish to read -new non-system bulletins (if any exist). The default is that you are notc -prompted. (Previously this was done by including the BULLETIN/READNEW -command in one's login command procedure). - - Format: - - SET [NO]READNEWt diff --git a/decus/vax85c/bulletin/bulldir.inc b/decus/vax85c/bulletin/bulldir.inc deleted file mode 100644 index 07fdc33..0000000 --- a/decus/vax85c/bulletin/bulldir.inc +++ /dev/null @@ -1,8 +0,0 @@ - COMMON /BULL_DIR/ DESCRIP,FROM,DATE,TIME,BLOCK,LENGTH,EXDATE - & ,NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME,SYSTEM,NBULL,NBLOCK - & ,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*8 TIME,NEWEST_TIME,SHUTDOWN_TIME - LOGICAL SYSTEM diff --git a/decus/vax85c/bulletin/bullet.mai b/decus/vax85c/bulletin/bullet.mai deleted file mode 100644 index bbbdd98..0000000 --- a/decus/vax85c/bulletin/bullet.mai +++ /dev/null @@ -1,946 +0,0 @@ -The following are instructions for creating the BULLETIN executable and -installation of the utility. A brief explanation of how the internals -of the BULLETIN utility works can be found in BULLETIN.TXT . None of -the command procedures included here are sophisticated, so it is likely -that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLFILES.INC must first - be modified before this procedure is run. It contains the names of data files - which BULLETIN creates. It also has the username for the BBOARD account. - BBOARD is an option by which mail sent to the specified username will be - converted into bulletins. This allows a user on a different system, which is - connected via a network, to be able to submit a bulletin. This feature can - be disabled if it is not desired by specifying the username NONE. In any - case, you should edit BULLFILES.INC and specify the appropriate device and - directories in which you desire that the files be located. (NOTE: Although - the BBOARD feature can be used over DECNET, a more sophisticated method - is available to easily allow one to add bulletins to other DECNET nodes - with all the features of BULLETIN. See below). - -2) STARTUP.COM - The data files that BULLETIN creates should be owned by a system UIC, - and MUST be protected from users being able to have access them. - STARTUP.COM sets the process UIC to [1,4] (you should change this if - you want something else), sets the WORLD and GROUP protection to NONE, - adds the bulletin found in the file INSTRUCT.TXT (it is added with - /PERMANENT, so it never expires), and then resets the UIC and PROTECTION - to what they were before running the procedure. - INSTRUCT.BUL contains a bulletin with instructions to the users as to - how to use the BULLETIN utility. You may want to modify it. - -3) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. - -4) LOGIN.COM - This contains the comands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new bulletins. If desired, the /READNEW qualifier - can also be added. If there are any new non-system bulletins, this - qualifier creates a prompt asking the user if the non-system - bulletins are to be displayed or not. Normally, only system bulletins - are displayed in full, and only the subjects of the non-system - bulletins are displayed. ( Some systems might have a lot of users - who are not interested in reading the non-system bulletins, in - which case /READNEW should probably not be added. Instead, you could - let users enable this feature by entering the BULLETIN utility and - typing the command SET READNEW ). (NOTE: Since /LOGIN and /READNEW - are system commands, they are not included in the help file). - -5) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM - as a batch job. It simply installs the BULLETIN utility with correct - privileges. - -6) BULLETIN.COM - If one wants the feature of using BULLETIN between DECNET nodes, - this file must be put in each node's DECNET default user's directory - (usually [DECNET]). Once this is done, the /NODE qualifer for the - ADD command can be used. - NOTE: Presently, privileged functions such as /SYSTEM will work - on other nodes only if you have an account on the other node with - the same username, and with appropriate privileges. You will be - prompted for the password for the account on the remote node. However, - due to unknown reasons, the software I have to check the password will - only work for passwords that have been set under V4.x. If the password - was created under V3.x, the program will not work, and you password will - be treated as invalid. -$ SET PROTECT=(W:RWED)/DEFAULT -$ MAIL -READ -EXTRACT/ALL USRD$:[BBOARD]BBOARD.MAI -DELETE/ALL - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL = FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER BELL - QUALIFIER BROADCAST - QUALIFIER EDIT - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER PASSWORD, LABEL=PASSWORD, VALUE(REQUIRED) - QUALIFIER PERMANENT - QUALIFIER SHUTDOWN - QUALIFIER SYSTEM - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE VERB BACK - DEFINE VERB DELETE - PARAMETER P1, LABEL = BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB DIRECTORY - DEFINE VERB EXIT - DEFINE VERB FILE - PARAMETER P1, LABEL = FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - DEFINE VERB HELP - PARAMETER P1, LABEL = HELP_TOPIC, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB NEXT - DEFINE VERB READ - PARAMETER P1, LABEL = BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - DEFINE VERB REPLACE - PARAMETER P1, LABEL = FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION - QUALIFIER HEADER - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER TEXT - DEFINE VERB SET - PARAMETER P1, LABEL = SET_PARAM1, VALUE(REQUIRED), - PROMPT="What" -1 ADD -Adds a bulletin to the bulletin file. A file can be specified which -contains the bulletin. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the bulletin. - -Format - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the bulletin is broadcasted. -2 /BROADCAST -This option is restricted to privileged users. If specified, bulletin -is both saved in the bulletin file and broadcasted to all users logged -in at the time. -2 /EDIT -Determines whether or not the EDT editor is invoked to edit the bulletin -you are sending. -2 /NODES=(nodes[,...]) -Specifies to send the bulletin to other DECNET nodes. The BULLETIN utility -must be installed properly on the other nodes. You will prompted for the -username to use at the other node. If you give a different username than -that of the local node, or if privileged qualifiers are specified, you will -be prompted for the password of your account on the other nodes. At -present, if the password is invalid, the bulletin will be rejected on the -node, but no error message will be displayed on the local node that this -happened. -2 /PERMANENT -This option is restricted to privileged users. If specified, bulletin -will be a permanent bulletin and will never expire. -2 /SHUTDOWN -This option is restricted to privileged users. If specified, bulletin -will be automatically deleted after a computer shutdown has occurred. -2 /SYSTEM -This option is restricted to privileged users. If specified, bulletin -is both saved in the bulletin file and displayed in full as a system -notice when a user logs in. System notices should be as brief as possible -to avoid the possibility that system notices could scroll off the screen. -1 BACK -Displays the bulletin preceding the current bulletin. -1 DELETE -Deletes the specified bulletin. If no bulletin is specified, the current -bulletin is deleted. Only the original owner or a privileged user can -delete a bulletin. - -Format - DELETE [bulletin-number] - -The bulletin's relative number is found by the DIRECTORY command. -1 DIRECTORY -Lists a summary of the bulletins. The bulletin number, submitter's name, -date, and subject of each bulletin is displayed. -1 EXIT -Exits the BULLETIN program. -1 FILE -Copies the current bulletin to the named file. The file-name parameter -is required, and consists of up to 9 alpha-numeric characters in length. - -Format: - FILE file-name -2 /HEADER - -/[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -bulletin is written in the file. The default is to write the header. -1 Bulletin -The BULLETIN utility permits a user to create a bulletin for reading by -all users. Users are notified upon logging in that new bulletins have -been added, and what the topic of the bulletins are. Actual reading of -the bulletins is optional. (See the command SET READNEW for info on -automatic reading.) Bulletins are automatically deleted when their -expiration date has passed. - -1 HELP -To obtain help on any topic, type: - - HELP topic -1 NEXT -Skips to the next bulletin and displays it. This is useful when paging -through the bulletins and you encounter a particularly long bulletin -that you would like to skip over. -1 READ -Displays the specified bulletin. If you do not specify a bulletin, then -the first time you enter the command, the oldest bulletin will be -displayed. However, if there are new bulletins, the first new bulletin -will be displayed. Each time you enter the command, the next page, or if -there are no more pages, the next bulletin will be displayed. - -Format - READ [bulletin-number] - -The bulletin's relative number is found by the DIRECTORY command. - -Pressing just performs the same as the READ command. -1 REPLACE -Replaces an existing bulletin in the bulletin file. This is for changing -part or all of a bulletin without causing users who have already seen the -bulletin to be notified of it a second time. If the text of the bulletin -is to be changed, a file can be specified which contains the text. -Otherwise, BULLETIN will prompt for the text. The expiration date and -header can also be changed. If neither /EXPIRATION, /HEADER, nor /TEXT -are specified, it is assumed the whole bulletin will be replaced. - -Format - REPLACE [file-name] -2 /EXPIRATION -Specifies that the bulletin expiration date is to be replaced. -2 /HEADER -Specifies that the bulletin header is to be replaced. -2 /NUMBER=n -Specifies the bulletin number to be replaced. If this qualifier is -omitted, the bulletin that is presently being read will be replaced. -2 /TEXT -Specifies that the bulletin text is to be replaced. -1 SET -Defines or changes characteristics associated with automatic reading -of bulletins. - -Format: - - SET option -2 READNEW -Controls whether you will be prompted upon logging in if you wish to read -new non-system bulletins (if any exist). The default is that you are not -prompted. (Previously this was done by including the BULLETIN/READNEW -command in one's login command procedure). - - Format: - - SET [NO]READNEW - COMMON /BULL_DIR/ DESCRIP,FROM,DATE,TIME,BLOCK,LENGTH,EXDATE - & ,NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME,SYSTEM,NBULL,NBLOCK - & ,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*8 TIME,NEWEST_TIME,SHUTDOWN_TIME - LOGICAL SYSTEM -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, adding -and deleting bulletins. Any user can submit a bulletin. Users are -notified at login time that new bulletins have been added and the topics of -those bulletins are displayed. Reading of those bulletins is optional. -(Use the command SET READNEW while in BULLETIN for setting automatic -reading.) Privileged users can add system bulletins that are displayed -in full at login time. These bulletins are also saved, and can be read -by BULLETIN. Bulletins are automatically deleted after a specified -expiration date, or they can manually be deleted by either the submitter -of the bulletin or a privileged user. - -BULLETIN has an interactive help available while using the utility. - - Format: - - BULLETIN -$ LINK/NOTRACE BULLETIN,HPWD,BULLSUBS,BULLCOM,BULLMAIN,CLIDEF,USEROPEN,SETUSER,SETUIC,- -SYS$SYSTEM:SYS.STB/SEL -This file describes the general operation of the BULLETIN utility. - -BULLETIN uses 3 files to store its data: BULLETIN.DAT, BULLDIR.DAT, & -BULLUSER.DAT. These files are opened with the shared attribute as much as -possible to allow simultaneous operations on the files. However, when a -bulletin is added or deleted, the file cannot be shared, as this might cause -the file to be corrupted. Because of this problem, files are closed as soon as -possible so that it may be quickly opened for adding and deleting files. -During read operations, the information is passed to temporary storage, the -file is closed, and then the information is sent to the terminal. This avoids a -possible problem where the terminal output is stopped by the user, therefore -delaying the closing of the file. Also, the use of CTRL-Y & CTRL-C is disabled -while the file is opened to avoid lockout problems. - -BULLETIN.DAT stores the actual bulletins in a fixed 80 character length file. -Bulletins are store sequentially datewise. New bulletins are appended to the -end of the file. When a bulletin is deleted, all the following bulletins are -moved up in the file to remove the gap, and the file is then truncated to -remove the unused space. - -BULLDIR.DAT is a fixed record length file storing directory entries for each -bulletin in BULLETIN.DAT. Each entry contains the header information, length, -and starting record position in BULLETIN.DAT. The first line of BULLDIR.DAT is -a header containing the date of the next expiration that will occur, the date -of the latest sumbitted bulletin, the number of bulletins, and the total size -of BULLETIN.DAT. The last two numbers make it easier to add bulletins. The -directory entries then follow, again stored sequentially datewise. - -NOTE: There are several advantages to keeping a seperate directory file versus -storing the header information with the actual bulletin. Obviously, it avoids -having to scan through a large bulletin file just to extract header -information. This operation is done when a DIRECTORY listing is requested in -BULLETIN. More importantly when a login occurs, non-system bulletins just -require that the header information be displayed. Having a file with pointers -to where the bulletin is stored also avoids requiring the software to read all -the previous bulletins in order to arrive at the desired bulletin. The main -disadvantage is the extra time spent on locating the second file. This time -appears to be minimal. In all the software, the convention is to open the -directory file first, and then if needed to open the bulletin file. When -adding and delete files, this becomes important, as files are opened unshared. -A deadlock might occur if one user opens the bulletin file first while another -user opens the directory file, and then each try to open the alternate file. - -BULLUSER.DAT is a relative indexed file, where the keyword is the username of -the user. Each entry contains the latest time that the user logged in, plus -the latest time that the BULLETIN utility was used to read bulletins. A header -entry with a blank username stores the latest bulletin date. The information -in this file is used for checking to see if the user should be alerted to new -bulletins or not. -C -C THE FIRST 3 FILES ARE FILES CREATED AND USED BY BULLETIN. -C SEE BULLETIN.TXT FOR MORE INFORMATION. SPECIFY THE DEVICE/DIRECTORY -C IN WHICH YOU DESIRE THAT THEY BE KEPT. THE FOURTH FILE IS SIMPLY -C THE MAIL FILE FROM WHICH MESSAGES ARE CONVERTED TO NON-SYSTEM -C BULLETINS (AFTER WHICH THE MAIL IS DELETED.) IF YOU DO NOT WISH -C THE BBOARD OPTION, CHANGE THE DEFINITION FOR BBOARD TO BE: /'NONE'/. -C IF IT IS NOT SELECTED, YOU DO NOT HAVE TO MODIFY THE REST OF THE -C BBOARD VARIABLES. IF IT IS SELECTED, YOU MUST SPECIFY THE UIC -C NUMBER OF THE BBOARD ACCOUNT. YOU MUST ALSO SPECIFY BBOARD_FILE, -C WHICH IS A TEMPORARY FILE WHICH IS USED TO CONVERT THE BBOARD MAILn -C TO A SEQUENTIAL FILE. -Cn - COMMON /FILES/ BULLDIR_FILE,BULLETIN_FILE,BULLUSER_FILE,BBOARD_USER - COMMON /FILES/ BBOARD_UIC,BBOARD_FILE,BBOARD_COMMANDt - CHARACTER*80 BULLDIR_FILE /'IML$EXE:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'IML$EXE:BULLETIN.DAT'/ - CHARACTER*80 BULLUSER_FILE /'IML$EXE:BULLUSER.DAT'/ - CHARACTER*12 BBOARD_USER /'BBOARD'/,BBOARD_UIC/'[330,5]'/ - CHARACTER*80 BBOARD_FILE/'USRD$:[BBOARD]BBOARD.MAI'/ -CT -C THE BBOARD.COM IS INCLUDED WITH THE SOURCES AND IS USED IF THE BBOARD -C FEATURE IS DESIRED. IT IS NOT CREATED, SO YOU MUST MOVE IT TO THEs -C DESIRED DIRECTORY. YOU MUST ALSO EDIT IT SO THAT THE FILE SPECIFIEDm -C IN THE 'EXTRACT' LINE MATCHES THE FILE SPECIFIED BY BBOARD_FILE. -C - CHARACTER*80 BBOARD_COMMAND/'IML$EXE:BBOARD.COM'/ - PARAMETER ADD_FLAG = '1'X - PARAMETER BACK_FLAG = '2'Xt - PARAMETER DELETE_FLAG = '4'X - PARAMETER DIRECTORY_FLAG = '8'X - PARAMETER EXIT_FLAG = '10'X - PARAMETER FILE_FLAG = '20'X - PARAMETER HELP_FLAG = '40'X - PARAMETER NEXT_FLAG = '80'X - PARAMETER READ_FLAG = '100'XN - PARAMETER SYSTEM_FLAG = '200'Xd - PARAMETER BROADCAST_FLAG = '400'X - PARAMETER BADSWITCH_FLAG = '800'X - PARAMETER REPLACE_FLAG = '1000'X - PARAMETER EXPIRE_FLAG = '2000'X - PARAMETER HEADER_FLAG = '4000'X - PARAMETER TEXT_FLAG = '8000'X - PARAMETER NUMBER_FLAG = '10000'Xo - PARAMETER SHUTDOWN_FLAG = '20000'XT - PARAMETER PERMANENT_FLAG = '40000'X - - COMMON /BULLPAR/ FLAGS,BULL_PARAMETER,LEN_P,NUMBER_PARAMt - CHARACTER*64 BULL_PARAMETER - INTEGER FLAGS - MODULE BULLETIN_MAINCOMMANDSf - DEFINE VERB BULLETIN - QUALIFIER READNEW - QUALIFIER LOGINh -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/SHARE/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL) -/EXITn - - COMMON /BULL_USER/ USERNAME,LOGIN_DATE,LOGIN_TIME,READ_DATE,i - & READ_TIME,FLAGSd - CHARACTER*12 USERNAME - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIMEh - DIMENSION FLAGS(2)u - - .LIBRARY /SYS$LIBRARY:LIB.MLB/U - $CLIDEF GLOBALe - .ENDh -$ FORTRAN BULLETIN -$ FORTRAN BULLSUBS -$ MAC CLIDEF -$ MAC HPWD -$ MAC SETUIC -$ MAC SETUSERt -$ MAC USEROPEN -$ SET COMMAND/OBJ BULLCOMe -$ SET COMMAND/OBJ BULLMAIN -$ @BULLETIN.LNKM -.TITLE HPWD - hash user password -.IDENT 'V02-002' - -; This code was gotten by disassembling the AUTHORIZE program. -; It is quite shameful that DEC has not seen fit to provide -; this as a system service.: - -; If you want lots of good comments, see the fiche. - -; e _lib$code:_lib$code+68 - - -; Inputs: PWDDSC -- Addres of password descriptore -; ENCRYPT -- Encryption algorithm index (byte) -; SALT - random number (word) -; USRDSC - Address of username descriptorc - -; output: OUTDSC -- Address of encrypted output descriptor - -OUTDSC=4 -PWDDSC=OUTDSC+4 -ENCRYPT=PWDDSC+4 -SALT=ENCRYPT+4 -USRDSC=SALT+4d - -.PSECT _LIB$CODE RD,NOWRT,PIC,SHR,BYTE,EXE - -; AUTODIN-II polynomial table used by CRC algorithm -AUTODIN: - .LONG ^X000000000,^X01DB71064,^X03B6E20C8,^X026D930AC,^X076DC4190 - .LONG ^X06B6B51F4,^X04DB26158,^X05005713C,^X0EDB88320,^X0F00F9344 - .LONG ^X0D6D6A3E8,^X0CB61B38C,^X09B64C2B0,^X086D3D2D4,^X0A00AE278 - .LONG ^X0BDBDF21C - -; Purdy polynomial coefficients. Prime, but don't need to beR -Purdy_Poly:e -c: - .LONG -83,-1h - .LONG -179,-1 - .LONG -257,-1 - .LONG -323,-1 - .LONG -363,-1 - -.ENTRY LGI$HPWD,^M - MOVAQ @outdsc(AP),R4e - MOVAQ @4(R4),R4 - TSTB encrypt(AP) - BGTRU 10$ - MNEGL #1,R0 - MOVAQ @pwddsc(AP),R1 - CRC autodin,R0,(R1),@4(R1)E - CLRL R1i - MOVQ R0,(R4) - BRB 20$ - -10$: CLRQ (R4) - MOVAQ @pwddsc(AP),R3u - BSBB COLLAPSE_R2 - ADDW2 salt(AP),3(R4)i - MOVAQ @usrdsc(AP),R3d - BSBB COLLAPSE_R2 - PUSHAQ (R4) - CALLS #1,PURDY] - -20$: MOVL #1,R0 - RET - - -COLLAPSE_R2: - MOVZWL (R3),R0 - BEQL 20$ - MOVAL @4(R3),R2 - PUSHR #^Mc - MOVL R0,R1 -5$: CMPB (R2)+,#32 - BNEQ 7$ - DECL R1 -7$: SOBGTR R0,5$c - MOVL R1,R0o - POPR #^M -10$: BICL3 #-8,R0,R1 - ADDB2 (R2)+,(R4)[R1]e - SOBGTR R0,10$ -20$: RSB - -a=59 -n0=1@24-3d -n1=1@24-63 - - -.ENTRY PURDY,^M - MOVQ @4(AP),-(SP) - BSBW PQMOD_R0 - MOVAQ (SP),R4 - MOVAQ PURDY_POLY,R5 - MOVQ (R4),-(SP)p - PUSHL #n1 - BSBB PQEXP_R3 - MOVQ (R4),-(SP)d - PUSHL #n0-n1u - BSBB PQEXP_R3r - MOVQ (R5)+,-(SP) - BSBW PQADD_R0 - BSBW PQMUL_R2v - MOVQ (R5)+,-(SP) - MOVQ (R4),-(SP)A - BSBW PQMUL_R2L - MOVQ (R5)+,-(SP) - BSBW PQADD_R0M - MOVQ (R4),-(SP)M - BSBB PQMUL_R2B - MOVQ (R5)+,-(SP) - BSBW PQADD_R0A - MOVQ (R4),-(SP)U - BSBB PQMUL_R2L - MOVQ (R5)+,-(SP) - BSBW PQADD_R0L - BSBW PQADD_R0N - MOVQ (SP)+,@4(AP)S - MOVL #1,R0 - RET - -PQEXP_R3:S - POPR #^M - MOVQ #1,-(SP)E - MOVQ 8+4(SP),-(SP) - TSTL 8+8(SP) - BEQL 30$ -10$: BLBC 8+8(SP),20$ - MOVQ (SP),-(SP)D - MOVQ 8+8(SP),-(SP) - BSBB PQMUL_R2 - MOVQ (SP)+,8(SP) - CMPZV #1,#31,8+8(SP),#0 - BEQL 30$ -20$: MOVQ (SP),-(SP)F - BSBB PQMUL_R2F - EXTZV #1,#31,8+8(SP),8+8(SP)A - BRB 10$ - -30$: MOVQ 8(SP),8+8+4(SP) - MOVAQ 8+8+4(SP),SPL - JMP (R3)E - -u=0 -v=u+4 -y=u+8L -z=y+4A - -PQMOD_R0:A - POPR #^M - CMPL v(SP),#-1 - BLSSU 10$ - CMPL u(SP),#-a - BLSSU 10$ - ADDL2 #a,u(SP)E - ADWC #0,v(SP), -10$: JMP (R0)) - -PQMUL_R2:B - POPR #^M - MOVL SP,R2 - PUSHL z(R2) - PUSHL v(R2) - BSBB EMULQ - BSBB PQMOD_R0E - BSBB PQLSH_R0U - PUSHL y(R2) - PUSHL v(R2) - BSBB EMULQ - BSBB PQMOD_R0S - PUSHL z(R2) - PUSHL u(R2) - BSBB EMULQ - BSBB PQMOD_R0= - BSBB PQADD_R0s - BSBB PQADD_R0b - BSBB PQLSH_R0 - PUSHL y(R2) - PUSHL u(R2) - BSBB EMULQb - BSBB PQMOD_R0, - BSBB PQADD_R0 - MOVQ (SP)+,Y(R2) - MOVAQ Y(R2),SPn - JMP (R1)e - -EMULQ: - EMUL 4(SP),8(SP),#0,-(SP)e - CLRL -(SP) - TSTL 4+8+4(SP) - BGEQ 10$ - ADDL2 4+8+8(SP),(SP)E -10$: TSTL 4+8+8(SP) - BGEQ 20$ - ADDL2 4+8+4(SP),(SP) -20$: ADDL2 (SP)+,4(SP) - MOVQ (SP)+,4(SP) - RSB - -PQLSH_R0: -.ENABLE LSB - POPR #^M - PUSHL v(SP) - PUSHL #ah - BSBB EMULQ - ASHQ #32,Y(SP),Y(SP) - BRB 10$ - -PQADD_R0:d - POPR #^M -10$: ADDL2 u(SP),y(SP) - ADWC v(SP),z(SP) - BLSSU 20$ - CMPL z(SP),#-1 - BLSSU 30$ - CMPL y(SP),#-a - BLSSU 30$ -20$: ADDL2 #a,y(SP) - ADWC #0,z(SP)e -30$: MOVAQ Y(SP),SP - JMP (R0)i -.END -$ COPY BULLETIN.EXE SYS$SYSTEM: -$ SET FILE SYS$SYSTEM:BULLETIN.EXE/OWN=[1,4] -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/SHARE/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL)r -/EXITh -$ LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMSh -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. System messages, such as this -one, are displayed in full. Only topics will be displayed for non-system -messages. Messages are submitted using the BULLETIN command. Any user mayp -submit a non-system message. Only privileged users can submit a systems -message. For more information, see the on-line help (via HELP BULLETIN). -$ BULL*ETIN :== $SYS$SYSTEM:BULLETIN -$ BULLETIN/LOGIN -; -; Name: SETUIC.MARn -;i -; Type: Integer*4 Function (MACRO)o -;t -; Author: M. R. London -; -; Date: May 31, 1983s -;s -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage:i -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group numbers -; user number - longword containing UIC user numberE -; -; NOTES: -; Must link with SS:SYS.STBl -;i - - .Title SETUIC Set uic - .IDENT /830531/ -;e -; Libraries:i -;a - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -;e -; Global variables: -; - $PCBDEF -;l -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable codeO - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error codes - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel modeE -5$: RETe -10$: .WORD ^M<> ; Entry masko - MOVL SCH$GL_CURPCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - .END -; -; Name: SETUSER.MAR -;a -; Type: Integer*4 Function (MACRO)g -; -; Author: M. R. Londono -;i -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns outu -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -;i -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing usernamei -;e -; NOTES:o -; Must link with SS:SYS.STB -;T - - .Title SETUSER Set uicn - .IDENT /830531/ -;i -; Libraries:n -;g - .LIBRARY /SYS$LIBRARY:LIB.MLB/o -;n -; Global variables: -;n - $PCBDEF - $JIBDEF -;u -; local variables: -; - - .PSECT SETUSER_DATA,NOEXEl - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old usernamee -;b -; Executable: -;i - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flage - RET ; error and returnm -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RETb -10$: .WORD ^M<> ; Entry maskr - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Blocku - ; NOTE: MOVC destroys r0-r5h - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIBn - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry maski - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Blocke - ; NOTE: MOVC destroys r0-r5s - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIBe - RET - .END -$ UIC := 'F$GETJPI("","UIC") -$ SET UIC [1,4]o -$ SET PROTECT=(SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)/DEFAULT -$ RUN BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT] -INFORMATION ON HOW TO USE THE BULLETIN UTILITY.M -EXIT -$ SET UIC 'UIC' -$ DEFAULT := 'F$FILE("SYS$LOGIN:LOGIN.COM","PRO")M -$ SET PROTECT=('DEFAULT')/DEFAULTH -;------------------------------------------------------------------------------R -; -; Name: USER_OPEN -;T -; Type: Multilple Function (MACRO)T -;8 -; Author: T.W.FredianM -; MIT Plasma Fusion Center -;S -; Date: January 26, 1983 -;U -; Version:h -;F -; Purpose: Used to permit qio access to files with fortran. -; Returns channel and file size information and -; provides file truncation capability. Files opened -; with these useopens cannot be accessed using fortrani -; reads and writes and the dispose= keyword on thee -; close of the file will have no effect. To make thet -; logical unit reuseable for normal RMS access you must -; deassign the channel using SYS$DASSGN(%VAL(channel))n -; and then use the close (unit= ) statement. -;l -; Types of useropens provided: -; -; USER_OPEN$OLD - open old file -; USER_OPEN$NEW - open new file -; USER_OPEN$TRUNCATE - open old file and truncate it -; to the size specified by the, -; INITIALSIZE keyword of the open -;e -; To receive the channel, open RMS status and size of the filee -; include a common USER_OPEN as follows:L -;R -; Common /USER_OPEN/ CHANNEL,STATUS,SIZE -; Integer*4 CHANNEL - I/O channel assigned to the fileH -; Integer*4 STATUS - RMS status return of open -; Integer*4 SIZE - Size of the file opened in blocks -;s -;------------------------------------------------------------------------------ -; -; Call seqence: NONE - USEROPEN keyword of fortran OPEN statemento -; for example: -; -; External USER_OPEN$NEW -; . -; .h -; .o -; OPEN (UNIT=lun,FILE=filename,....,USEROPEN=USER_OPEN$NEW)o -; -;------------------------------------------------------------------------------ -;l -; Description:n -;t -; Entry mask for USER_OPEN$OLD -; Get the FAB addressc -; Set the user file open bit -; Open old filei -; Save the channel -; Save the sizey -; Save the statusl -; Return - -; Entry mask for USER_OPEN$NEW -; Get the FAB addressl -; Set the user file open bit -; Open new filep -; Save the channel -; Save the sizeh -; Save the statusc -; Return - -; Entry mask for USER_OPEN$TRUNCATEA -; Get the FAB addressg -; Get the RAB addressr -; Save the sizeh -; Open old fileL -; Connect file to record stream -; Load the size of the file in the RAB -; Set the access mode to relative file address -; Find the last record in the file -; Place the end of file marker at this location -; Mark the file to be truncated on close -; Close the file -; Return - -; Endd -;e -;+-----------------------------------------------------------------------------i - - .TITLE USER_OPENn - .IDENT /V_830128/ - -;s -;------------------------------------------------------------------------------ -;e -; Global variables:e -;s - .PSECT USER_OPEN LONG,PIC,OVR,GBL,SHR,NOEXE - -CHANNEL: .BLKL 1 ; Channel numberi -STATUS: .BLKL 1 ; Status return of open -SIZE: .BLKL 1 ; Size of file. - -;s -;------------------------------------------------------------------------------o -;n -; Executable:n -;c - .PSECT $CODE LONG,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVECt - - .ENTRY USER_OPEN$OLD,^M ; Entry mask for USER_OPEN$OLD - MOVL 4(AP),R2 ; Get the FAB addressa - INSV #1,#FAB$V_UFO,#1,FAB$L_FOP(R2) ; Set the user file open bits - $OPEN FAB=(R2) ; Open old filea - MOVL FAB$L_STV(R2),CHANNEL ; Save the channel - MOVL FAB$L_ALQ(R2),SIZE ; Save the sizeh - MOVL R0,STATUS ; Save the status - RET ; Returne - - .ENTRY USER_OPEN$NEW,^M ; Entry mask for USER_OPEN$NEW - MOVL 4(AP),R2 ; Get the FAB address - INSV #1,#FAB$V_UFO,#1,FAB$L_FOP(R2) ; Set the user file open bito - INSV #0,#FAB$V_CBT,#1,FAB$L_FOP(R2) ; Disable contiguous best try - $CREATE FAB=(R2) ; Open new filea - MOVL FAB$L_STV(R2),CHANNEL ; Save the channel - MOVL FAB$L_ALQ(R2),SIZE ; Save the sizeh - MOVL R0,STATUS ; Save the statuss - RET ; Returnr - - .ENTRY USER_OPEN$TRUNCATE,^M ; Entry mask for USER_OPEN$TRUNCATE - MOVL 4(AP),R2 ; Get the FAB addresst - MOVL 8(AP),R3 ; Get the RAB address - MOVL FAB$L_ALQ(R2),R4 ; Save the sizen - INCL R4 ; Increment the size - INSV #0,#FAB$V_SQO,#1,FAB$L_FOP(R2) ; Clear the sequential only bit - $OPEN FAB=(R2) ; Open old fileE - BLBC R0,CLOSE ; If unsuccessful branch to close - $CONNECT RAB=@8(AP) ; Connect file to record stream - BLBC R0,CLOSE ; If unsuccessful branch to closeS - MOVL R4,RAB$L_RFA0(R3) ; Load the size of the file in the RABA - MOVW #0,RAB$W_RFA4(R3)O - MOVB #RAB$C_RFA,RAB$B_RAC(R3) ; Set the access mode to relative file addressE - $FIND RAB=(R3) ; Find the last record in the file - BLBC R0,CLOSE ; If unsuccessful branch to close - $TRUNCATE RAB=(R3) ; Place the end of file marker at this location - INSV #1,#FAB$V_TEF,#1,FAB$L_FOP(R2) ; Mark the file to be truncated on closeT -CLOSE: PUSHL R0 ; Save error status - $CLOSE FAB=(R2) ; Close the fileL - POPL R0 ; Restore error status - MOVL R0,STATUS ; Return the status - RET ; ReturnO - - .END ; End8 - diff --git a/decus/vax85c/bulletin/bulletin.com b/decus/vax85c/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vax85c/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vax85c/bulletin/bulletin.for b/decus/vax85c/bulletin/bulletin.for deleted file mode 100644 index 9bf6ba1..0000000 --- a/decus/vax85c/bulletin/bulletin.for +++ /dev/null @@ -1,1817 +0,0 @@ -C -C BULLETIN.FOR, Version P850716 -C Purpose: Facility for reading, adding, and delete bulletins. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C NOTES: See BULLETIN.TXT for general info. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /CTRLY/ CTRLY - - COMMON /TERM_CHAN/ TERM_CHAN - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT,CLI$_NOCOMD,CLI$_ABSENT - EXTERNAL BULLETIN_MAINCOMMANDS - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - CHARACTER*32 INLINE - - CHARACTER*11 UPTIME_DATE - CHARACTER*8 UPTIME_TIME - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV(ALLOW) ! Check privileges - IF (ALLOW.EQ.0) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - -C -C Delete any expired bulletins (normal or shutdown ones). -C - - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (SHUTDOWN.GT.0) THEN ! Do shutdown bulletins exist? - CALL GET_UPTIME(UPTIME_DATE,UPTIME_TIME) - IER1 = COMPARE_DATE(SHUTDOWN_DATE,UPTIME_DATE) - IF (IER1.EQ.0) IER1 = COMPARE_TIME(SHUTDOWN_TIME,UPTIME_TIME) - IF (IER1.LE.0) SHUTDOWN = 0 - END IF - IF (IER.LE.0.OR.IER1.LE.0) CALL UPDATE ! Need to update - END IF - CALL CLOSE_FILE(2) - -C -C Test for /READ & /LOGIN switches. -C - - CALL LIB$GET_FOREIGN(INLINE) - - IER = CLI$DCL_PARSE('BULLETIN'//INLINE,BULLETIN_MAINCOMMANDS) - - READIT = 0 - IF (CLI$PRESENT('READNEW')) READIT = 1 ! Test for /READ switch. - LOGIT = 0 - IF (CLI$PRESENT('LOGIN')) LOGIT = 1 ! Test for /LOGIN switch. - -C -C Ignore BULLETIN/READ or BULLETIN/LOGIN if this is a batch process. -C - - IF (READIT.GT.0.OR.LOGIT.GT.0) THEN - CALL GETSTS(STS) ! Get process status word - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - END IF - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal -C -C Get page length for the terminal. -C - - CALL GETPAGLEN(PAGE_LENGTH) - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIT.GT.0) THEN ! Is /LOGIN present? - CALL LOGIN(READIT) ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If not /READ, exit program - END IF - -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If /READ switch and no new bulletins, just exit. -C - - CALL UPDATE_READ ! Bulletins added since last read? - IF (BULL_POINT.EQ.-1) THEN ! BULL_POINT would be bulletin # -1 - BULL_POINT = 0 ! Since its -1, no new bulletins - IF (READIT.GT.0) CALL EXIT ! If /READ, just exit - ELSE IF (READIT.EQ.0) THEN ! There are new bulletins - WRITE(6,1000) ! Alert user of the fact - END IF ! if not in /READ mode - - IF (READIT.GT.0) CALL READNEW ! /READ mode. READNEW exits the program - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - - DO WHILE (1) - - IER = CLI$DCL_PARSE(%VAL(0),BULLETIN_SUBCOMMANDS,LIB$GET_INPUT, - & LIB$GET_INPUT,'BULLETIN> ') - - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - DIR_COUNT = 0 ! Reinit dir and read pointers - READ_COUNT = 0 - -80 CALL CLI$GET_VALUE('$VERB',INLINE) ! Get the VERB command - IF (INLINE(1:3).EQ.'ADD') THEN ! ADD bulletin command? - CALL ADD ! Go add bulletin - ELSE IF (INLINE(1:4).EQ.'BACK') THEN ! BACK command? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INLINE(1:4).EQ.'DELE') THEN ! DELETE command? - CALL DELETE ! Go delete bulletin - ELSE IF (INLINE(1:4).EQ.'DIRE') THEN ! DIRECTORY command? - CALL DIRECTORY(DIR_COUNT) ! Get directory of bulletins - ELSE IF (INLINE(1:4).EQ.'EXIT') THEN ! EXIT command? - CALL EXIT ! Exit from program - ELSE IF (INLINE(1:4).EQ.'FILE') THEN ! FILE command? - CALL FILE ! Copy bulletin to file - ELSE IF (INLINE(1:4).EQ.'HELP') THEN ! HELP command? - CALL HELP('BULL.HLB') ! Get help - ELSE IF (INLINE(1:4).EQ.'NEXT') THEN ! NEXT command? - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INLINE(1:4).EQ.'READ') THEN ! READ command? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INLINE(1:4).EQ.'REPL') THEN ! REPLACE command? - CALL REPLACE ! Replace old bulletin - ELSE IF (INLINE(1:3).EQ.'SET') THEN ! SET command? - CALL CLI$GET_VALUE('SET_PARAM1',INLINE) - IF (INLINE(1:4).EQ.'READ') THEN ! SET READNEW? - CALL SET_READNEW(1,1) - ELSE IF (INLINE(1:4).EQ.'NORE') THEN - CALL SET_READNEW(0,1) - END IF - ELSE ! Else bad parameter - WRITE(6,1020) ! Inform user of it - ENDIF - -100 CONTINUE - - END DO - -999 CALL EXIT - -1000 FORMAT(' Type READ to read new bulletins.') -1010 FORMAT(Q,A) -1020 FORMAT(' ERROR: Unknown command. Please retype.') -1060 FORMAT(' ERROR: There are no more bulletins.') - - END - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - CHARACTER*11 INEXDATE,TODAY - CHARACTER*80 INDESCRIP,INPUT - - INTEGER TIMADR(2) - - DIMENSION SETPRV(2) - DATA SETPRV/Z10000000,0/ ! SYSPRV privileges - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLY/ CTRLY - - EXTERNAL CLI$_ABSENT - EXTERNAL IO$_READVBLK,IO$M_NOECHO,IO$M_PURGE - - CHARACTER*80 MAILEDIT,INLINE - CHARACTER*32 NODES(10) - CHARACTER PASSWORD*31,TEMPUSER*12 - - CALL LIB$DISABLE_CTRL(CTRLY,) ! Disable CTRL-Y & -C - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GETPRIV(ALLOW) ! Does user have SETPRV privileges? - IF (ALLOW.EQ.0) THEN ! If not, then remove SYSPRV - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! privileges when trying to - END IF ! create new file. - OPEN (UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset SYSPRV privileges - END IF - - IER = SYS_TRNLNM('SYS$NET',INLINE,1) - IF (IER.EQ.SS$_NORMAL) THEN ! Running via DECNET? - IER = CLI$GET_VALUE('USERNAME',USERNAME) - IF (CLI$GET_VALUE('PASSWORD',PASSWORD).EQ.SS$_NORMAL) THEN - CALL CONFIRM_PRIV(USERNAME,PASSWORD,ALLOW) - END IF - ELSE - CALL GETPRIV(ALLOW) ! Check privileges - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (ALLOW.EQ.0) THEN ! If no privileges - WRITE(6,1070) ! Tell user - RETURN ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (ALLOW.EQ.0) THEN ! If no privileges - WRITE(6,1080) ! Tell user - RETURN ! and abort - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (CLI$PRESENT('SHUTDOWN')) THEN - WRITE(6,1083) - RETURN - ELSE IF (ALLOW.EQ.0) THEN ! If no privileges - WRITE(6,1081) ! Tell user - RETURN ! and abort - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = 'PERMANENT' - GO TO 8 ! Skip expiration date question - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (CLI$PRESENT('PERMANENT')) THEN - WRITE(6,1083) - RETURN - ELSE IF (ALLOW.EQ.0) THEN ! If no privileges - WRITE(6,1082) ! Tell user - RETURN ! and abort - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = 'SHUTDOWN' - GO TO 8 ! Skip expiration date question - END IF - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - LEN = 0 ! GET_VALUE crashes if LEN<0 - DO WHILE (CLI$GET_VALUE('NODES',NODES(NODE_NUM+1),LEN) - & .EQ.SS$_NORMAL) ! Get the specified nodes - NODE_NUM = NODE_NUM + 1 - IF (NODES(NODE_NUM)(LEN-1:LEN).EQ.'::') THEN ! Remove :: if - LEN = LEN - 2 ! added - END IF - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:LEN)//'""::'// - & '"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',ERR=940) - END DO - END IF - -5 IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - WRITE(6,1030) TODAY ! Prompt for expiration date - CALL GET_LINE(INEXDATE,LEN) ! Get input line - IF (LEN.LE.0) GO TO 910 - DECODE(LEN,'(I)',INEXDATE,IOSTAT=IER) NDAYS ! Is it # days? - IF (IER.EQ.0) THEN ! If so, - IF (NDAYS.LE.0) THEN ! Is # days not in future - WRITE(6,1045) ! tell user - GO TO 5 ! and re-request date - ELSE - CALL GET_EXDATE(INEXDATE,NDAYS) ! Get expiration date - END IF - END IF - IF (INEXDATE(2:2).EQ.'-') INEXDATE = '0'//INEXDATE - CALL STR$UPCASE(INEXDATE,INEXDATE) ! Convert to upper for BINTIM - IER = SYS$BINTIM(INEXDATE,TIMADR(1)) ! Is real date? - IF (IER.NE.1) THEN ! If not, -7 WRITE(6,1040) ! tell user input is wrong - GO TO 5 ! and re-request date - END IF - IER = SYS$ASCTIM(,INEXDATE,TIMADR(1),) - IER = COMPARE_DATE(INEXDATE,TODAY) ! Compare date with today's - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - GO TO 5 ! and re-request date - END IF - -8 WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fit - GO TO 8 ! and re-request header - END IF - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - - IF (CLI$PRESENT('EDIT')) THEN ! If /EDIT specified, then - LEN = 0 - IER = LIB$SYS_TRNLOG('MAIL$EDIT',LEN,MAILEDIT) - IF (IER.NE.SS$_NORMAL) MAILEDIT = 'SYS$SYSTEM:MAILEDIT' - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL LIB$SPAWN('$@'//MAILEDIT//' "" SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL LIB$SPAWN('$@'//MAILEDIT//' '//BULL_PARAMETER(1:LEN_P) - & //' SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IF - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,2000,END=10) ! get record count - ICOUNT = ICOUNT + 1 - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Sratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 81 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,LEN) ! Get input line - IF (LEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 ! Increment record count - WRITE(3,2010) INPUT(1:LEN) ! Save line in scratch file - END IF - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - IF (NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/BELL' - - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO)+%LOC(IO$M_PURGE) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - WRITE (6,'('' Enter username at node '',A)') NODES(POINT_NODE) - WRITE (6,'('' Hit RETURN to use username of local node.'')') - READ (5,'(Q,A)',ERR=910,END=910) LEN,TEMPUSER - IF (INLINE.NE.'ADD'.OR.LEN.GT.0) THEN - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, - & %VAL(%LOC(PASSWORD)),%VAL(31),,,,) - INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/PASSWORD=' - & //PASSWORD(1:STR$POSITION(PASSWORD,CHAR(13))-1) - END IF - IF (LEN.EQ.0) TEMPUSER = USERNAME - INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1) - & //'/USERNAME='//TEMPUSER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(1:LENDES) - DO I=1,ICOUNT - READ (3,'(Q,A)') LEN,INPUT - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(1:LEN) - END DO - WRITE (6,'('' Bulletin successfully sent to node '',A)') - & NODES(POINT_NODE) - REWIND (UNIT=3) - END DO - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - DESCRIP=INDESCRIP(1:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration datee - LENGTH = ICOUNT ! Number of records - FROM = USERNAME ! Username - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCKT - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletinR - - CLOSE (UNIT=1) ! Finished adding bulletin/ - - CALL ADD_ENTRY ! Add the new directory entry - - CLOSE (UNIT=2) ! Totally finished with add - -CR -C Broadcast the bulletin if requested.I -CO - - IF (CLI$PRESENT('BROADCAST')) THEN ! Should we broadcast the bull?B - REWIND (UNIT=3) ! Yes, rewind the input file - IF (CLI$PRESENT('BELL')) THEN ! Include BELL in message? - BROAD(1:36) = ! Say who the bulletin is fromL - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROMi - START = 37 ! Start adding next line herec - ELSE - BROAD(1:34) = ! Say who the bulletin is fromo - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM. - START = 35 ! Start adding next line herei - END IF - DO I=1,ICOUNT ! Stuff bulletin into string - READ(3,2000) LEN,INPUT ! Read input line - END = START + LEN - 1 + 2 ! Check how long string will be) - IF (END.GT.BRDCST_LIMIT) GO TO 90 ! If too much for string, exit. - BROAD(START:END) = CR//LF//INPUT(1:LEN) ! Else add new inputS - START = END + 1 ! Reset pointer - END DO -90 CALL SYS$BRDCST(BROAD(1:START-1)//CR,,,) ! Do the BROADCAST - END IFR - - CLOSE (UNIT=3) ! Close the input file - -100 CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -Cs - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DOD - RETURN) - -910 WRITE(6,1010)r - CLOSE (UNIT=3,ERR=100)E - GOTO 100! - -920 WRITE(6,1020) - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset SYSPRV privileges - GOTO 100 - -930 WRITE (6,1025) - CALL CLOSE_FILE(3)t - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - CLOSE (UNIT=3)E - GO TO 100 - -1000 FORMAT (' Enter bulletin: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No bulletin was added.')T -1015 FORMAT (' ERROR: Unable to reach node ',A). -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add bulletin to bulletin file.') -1030 FORMAT (' Today is ',A11, - &'. Specify when the bulletin should expire:',/,1x, - &'Enter specific date, dd-mmm-yyyy, or number of days from today.') -1040 FORMAT (' ERROR: Invalid date format specified.') -1045 FORMAT (' ERROR: Specified date has already passed.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would beF - & truncated to:') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system( - & bulletins.')s -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcastC - & bulletins.')N -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanent - & bulletins.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & bulletins.')a -1083 FORMAT (' ERROR: Permanent and shutdown cannot be specified - & simultaneously.') -2000 FORMAT(Q,A) -2010 FORMAT(A) -2020 FORMAT(1X,A)e - - END - - - SUBROUTINE DELETE -Cn -C SUBROUTINE DELETE -Cs -C FUNCTION: Deletes a bulletin entry from the bulletin file. -Cn - IMPLICIT INTEGER (A - Z)e - - CHARACTER*107 DIRLINE - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'u - - EXTERNAL CLI$_ABSENT - - CHARACTER*1 ANSWER - -C1 -C Get the bulletin number to be deleted.L -CX - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I)A - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error.# - ELSEo - BULL_DELETE = BULL_POINT ! Delete the file we are readingl - END IFb - -Ci -C Check to see if specified bulletin is present, and if the userA -C is permitted to delete the bulletin.I -CT - - CALL OPEN_FILE(2) - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?O - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - CALL GETPRIV(ALLOW) ! then see if owner has privileges. - IF (ALLOW.EQ.0) THEN ! If owner doesn't have privileges, - WRITE(6,1040) ! Then error out.o - GO TO 100 - ELSE - CALL CLOSE_FILE (2) - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') GO TO 100 - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error outL - GOTO 100 - END IFm - END IF - END IFP - -CL -C Delete the bulletin from the bulletin file. -C - - CALL OPEN_FILE(1) ! Open BULLETIN file - - CALL COPY_BULL(1,BLOCK+LENGTH,BLOCK,IER)! Delete the bulletin byD - ! overwriting rest of file - - CLOSE (UNIT=1) - -Cl -C Delete the bulletin directory entry.. -CR - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry! - - TRUNC_SIZE = (NBLOCK*80)/512 + 1 ! Truncate bulletin file - CALL TRUNCATE_FILE(TRUNC_SIZE) ! To remove extra space - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown countI - END IF( - - CALL UPDATE ! Somewhat a kludgey way of updating latest. - ! bulletin and expired dates.L - -100 CALL CLOSE_FILE(2) -900 RETURN - -910 WRITE(6,1010)( - GO TO 900 - -920 WRITE(6,1020)n - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any bulletin.') -1020 FORMAT(' ERROR: Specified bulletin number has incorrect format.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' ERROR: Specified bulletin is not owned by you.') -1050 FORMAT(' Bulletin is not owned by you.', - & ' Are you sure you want to delete it? ',$) - -2000 FORMAT(A107)I - - END - - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORYl -C -C FUNCTION: Display directory of bulletins. -CT - IMPLICIT INTEGER (A - Z)C - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH - - DATA SCRATCH_D1/0/! - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenE - - IF (DIR_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of directory - -Ce -C Directory listing is first buffered into temporary memory storage beforeU -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.C -CO - - IF (SCRATCH_D1.EQ.0) THEN ! Is queue empty?U - CALL LIB$GET_VM(100,SCRATCH_D) ! If so, allocated memory - CALL MAKE_CHAR(%VAL(SCRATCH_D),88) ! Form a character string - SCRATCH_D1 = SCRATCH_D ! Init header pointer - ELSE ! Else queue is not empty0 - SCRATCH_D = SCRATCH_D1 ! so reinit queue pointers - END IF ! to the header. - - CALL OPEN_FILE_SHARED(2) ! Get directory filel - - CALL READDIR(0,IER) ! Does directory header exist?) - IF (IER.EQ.1) THEN ! If so, there are bulletins - DO I=1,NBULL ! Copy all bulletins from file - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_DIR(%VAL(SCRATCH_D),SCRATCH_D) - END DO - END IFM - - CALL CLOSE_FILE(2) ! We don't need file anymore - -CT -C Directory entries are now in queue. Output queue entries to screen.A -CT - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - DIR_COUNT = 1 ! Init directory number counterL - -50 DISPLAY = MIN(NBULL-DIR_COUNT+1,PAGE_LENGTH-6)E - ! If more entries then page size, truncate output - WRITE(6,1000) ! Write header - DO I=DIR_COUNT,DIR_COUNT+DISPLAY-1i - CALL READ_DIR(%VAL(SCRATCH_D),SCRATCH_D) ! Get entry from queue - WRITE(6,2010) I,DESCRIP,FROM,DATE(1:7)//DATE(10:11)t - END DO - - DIR_COUNT = DIR_COUNT + DISPLAY ! Update directory counter - - IF (DIR_COUNT.GT.NBULL) THEN ! Outputted all entries?R - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSEA - WRITE(6,1010) ! Else say there are morep - END IF - - RETURN - -1000 FORMAT(' #',1X,'DESCRIPTION',43X,'FROM',9X,'DATE',/)L -1010 FORMAT(1X,/,' Press RETURN for more...',/)_ - -2000 FORMAT(A53,A12,A11) -2010 FORMAT(1X,I3,1X,A53,1X,A12,1X,A9) - - END - O - - SUBROUTINE FILE -C -C SUBROUTINE FILE -CA -C FUNCTION: Copies a bulletin to a file. -CT - IMPLICIT INTEGER (A - Z)l - CHARACTER*107 DIRLINE - CHARACTER*80 INPUT - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - DIMENSION SETPRV(2) - DATA SETPRV/Z10000000,0/ ! SYSPRV privileges - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)' - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specifiedI - WRITE(6,1020) ! Write error - RETURN ! And returnR - END IF! - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been readN - WRITE(6,1010) ! Write error - RETURN ! And returnN - END IFW - - CALL OPEN_FILE_SHARED(2)8 - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletine - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030)L - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - CALL GETPRIV(ALLOW) ! Does user have SETPRV privileges?D - IF (ALLOW.EQ.0) THEN ! If not, then remove SYSPRV - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! privileges when trying to. - END IF ! create new file. - - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset SYSPRV privileges - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATET - END IFc - - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - READ(1'I,2010,ERR=100) INPUT - CALL STR$TRIM(INPUT,INPUT,LEN) - WRITE(3,2010) INPUT(1:LEN) - END DOs - - CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_POINT,BULL_PARAMETER(1:LEN_P)! - ! Show name of file created. -100 CALL CLOSE_FILE(1) - RETURN - -900 WRITE(6,1000)N - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset BYPASS privileges - GO TO 100 - -1000 FORMAT(' ERROR: Error in opening file.')' -1010 FORMAT(' ERROR: You have not read any bulletin.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' Bulletin ',I3,' written to ',A)D -1050 FORMAT('DESCRIPTION: ',A53) -1060 FORMAT('FROM: ',A12,' DATE: ',A11,/)I - -2000 FORMAT(A107)D -2010 FORMAT(A) - - END - - - - - SUBROUTINE LOGIN(READIT)F -CD -C SUBROUTINE LOGIN -Ca -C FUNCTION: Alerts user of new bulletins upon logging in. -C Also saves latest login time, which is accessed by FINGER. -CA - IMPLICIT INTEGER (A - Z)p - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC') - - CHARACTER*23 TODAY/ - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /TERM_CHAN/ TERM_CHAN( - - CHARACTER BBOARD_DATE*11,BBOARD_TIME*8 - - LOGICAL*1 CTRL_G/7/ - - EXTERNAL IO$_READVBLK,IO$M_NOECHO,IO$M_PURGET - - INCLUDE '($FORIOSDEF)'e - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - -C= -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that bulletins were read. -C - - CALL OPEN_FILE_SHARED(4) ! Open user file! - -10 READ (4,1000,KEY=' ',IOSTAT=IER) ! Get the headere - & USERNAME,NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME,FLAGSL - IF (IER.EQ.FOR$IOS_SPERECLOC) GO TO 10 ! If locked record,try again - IF (IER.EQ.0) UNLOCK 4 ! If no error, unlock read - - CALL GETUSER(USERNAME) ! Get present username - - READ (4,1000,KEY=USERNAME,ERR=20,IOSTAT=IER1) USERNAME, - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,FLAGS. - ! Find if there is an entryh - - REWRITE (4,1000) USERNAME,TODAY(1:11),TODAY(13:20), - & READ_DATE,READ_TIME,FLAGS ! Update login datee - - IF (FLAGS(1).AND.1) READIT = 1 - - GO TO 30L - -20 READ_DATE = ' 5-NOV-1956' ! No entry, so make new one - READ_TIME = '11:05:56' ! Fake a read date. Set to the past. - FLAGS(1) = 0p - FLAGS(2) = 0 - WRITE (4,1000,IOSTAT=IER) USERNAME,TODAY(1:11),TODAY(13:20), - & READ_DATE,READ_TIME,FLAGSL - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_FILE(4) ! Close the user fileW - CALL EXIT ! Go away... - END IF: - CALL CLEANUP_LOGIN ! Good time to delete dead users - DIFF = -1 ! Force us to look at the bulletins - -30 IF (IER.EQ.0.AND.(BBOARD_DATE.NE.TODAY(1:11).OR.! Look for BBOARD mail - & BBOARD_TIME(1:2).NE.TODAY(13:14)) ) THEN ! when hour changes - READ (4,1000,KEY=' ') ! Get the header0 - & USERNAME,NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME,FLAGS - REWRITE (4,1000) ! Rewrite header= - & USERNAME,NEWEST_DATE,NEWEST_TIME,TODAY(1:11),TODAY(13:20),FLAGSe - CALL CLOSE_FILE(4) - CALL BBOARD ! Convert any BBOARD mail to bulletins - ELSE - CALL CLOSE_FILE(4) - IF (IER.NE.0) CALL EXIT ! If no header, no bulletins - END IF - IF (IER1.NE.0) GO TO 40 ! Skip date comparison if new entry. - -CE -C Compare and see if bulletins have been added since the last time -C that the user has logged in or used the BULLETIN facility.t -Cf - - DIFF = COMPARE_DATE(LOGIN_DATE,READ_DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,READ_TIME)C - IF (DIFF.LT.0) THEN ! If read bulletins since last login, - LOGIN_TIME = READ_TIME ! then use the read date to compare - LOGIN_DATE = READ_DATE ! with the latest bulletin date - END IF ! to see if should alert user.M - - DIFF = COMPARE_DATE(LOGIN_DATE,NEWEST_DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,NEWEST_TIME)S - -C -C If there are new bulletins, look for them in BULLDIR.DATE -C Save all new entries in the SCRATCH_D file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible.T -C( - -40 IF (DIFF.LE.0) THEN ! Are there new unread bulletins? - CALL OPEN_FILE_SHARED(2) ! Yes, so go get bulletin directory - NEW_BULLS = 0 ! Number of new bulletins - NSYS = 0 ! Number of system bulletinsD - CALL READDIR(0,IER) ! Get header info - CALL LIB$GET_VM(100,SCRATCH_D) - CALL MAKE_CHAR(%VAL(SCRATCH_D),88) - SCRATCH_D1 = SCRATCH_D - DO ICOUNT = NBULL,1,-1 - CALL READDIR(ICOUNT,IER)A - IF (IER1.EQ.0) THEN ! Is this a totally new user? - ! No. Is bulletin system or from same user?p - DIFF = COMPARE_DATE(LOGIN_DATE,DATE) ! No, so compare date - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,TIME) - IF (DIFF.GT.0) GO TO 100W - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN1 - IF (DIFF.LE.0) THEN ! Is bulletin new? - CALL WRITE_DIR(%VAL(SCRATCH_D),SCRATCH_D) - NEW_BULLS = NEW_BULLS + 1 ! Yep, so save it - IF (SYSTEM) NSYS = NSYS + 1P - END IF) - END IF - ELSE ! Totally new user, save all bulletins - CALL WRITE_DIR(%VAL(SCRATCH_D),SCRATCH_D) - NEW_BULLS = NEW_BULLS + 1 - IF (SYSTEM) NSYS = NSYS + 1 - END IFC - END DO -100 CALL CLOSE_FILE(2) - -C -C Review new directory entries. If there are system bulletins, -C copy the system bulletin into SCRATCH_D file BULLSYS.SCR for outputting -C to the terminal. If there are simple bulletins, just output theW -C header information. -CE - - IF (NEW_BULLS.EQ.0) CALL EXITe - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO)+%LOC(IO$M_PURGE)N - PAGE = 0 - NEW_BULLS = NEW_BULLS - NSYS - IF (NSYS.GT.0) THEN ! Are there any system bulletins? - WRITE (6,1026) CTRL_G ! Yep...U - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls! - CALL OPEN_FILE_SHARED(1) - CALL LIB$GET_VM(92,SCRATCH_B) - CALL MAKE_CHAR(%VAL(SCRATCH_B),80)i - SCRATCH_B1 = SCRATCH_BO - SCRATCH_D = SCRATCH_D1n - DO WHILE (NSYS.GT.0) ! Find which new bulls are systemC - CALL READ_DIR(%VAL(SCRATCH_D),SCRATCH_D) - IF (SYSTEM) THEN ! If it is a system bulletin - INPUT = ' ' - CALL WRITE_BULL(%VAL(SCRATCH_B),SCRATCH_B) - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy the bulletin to SCRATCH_D - READ(1'I,1050,ERR=999) INPUT - CALL WRITE_BULL(%VAL(SCRATCH_B),SCRATCH_B) - END DO - NSYS = NSYS - 1 ! Decrement system bulletin count - END IFw - END DO - CALL CLOSE_FILE(1)L - PAGE = 1W - SCRATCH_B = SCRATCH_B1 - DO WHILE (SCRATCH_B.NE.0) ! Write out the system bulletinsD - CALL READ_BULL(%VAL(SCRATCH_B),SCRATCH_B) - CALL STR$TRIM(INPUT,INPUT,LEN)M - IF (SCRATCH_B.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next pageU - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,,h - & %VAL(%LOC(INREAD)),%VAL(1),,,,). - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1065) INPUT(1:LEN) - PAGE = 1 - ELSE - WRITE(6,1060) INPUT(1:LEN) - PAGE = PAGE + 1L - END IFR - END IF- - END DO -150 WRITE(6,1050) ! Write delimiting blank line - END IF - SCRATCH_D = SCRATCH_D1 - IF (NEW_BULLS.GT.0) THEN ! Are there new non-system bulletins? - IF (PAGE.NE.0) THEN ! Yep...( - WRITE(6,1080) ! Ask for input to proceed to next page( - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, - & %VAL(%LOC(INREAD)),%VAL(1),,,,)2 - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1028) CTRL_G - ELSE) - WRITE(6,1027) CTRL_G - END IF' - WRITE(6,1020) - WRITE(6,1025) - PAGE = 3F - DO WHILE (SCRATCH_D.NE.0) - CALL READ_DIR(%VAL(SCRATCH_D),SCRATCH_D) - IF (.NOT.SYSTEM.AND.SCRATCH_D.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,,a - & %VAL(%LOC(INREAD)),%VAL(1),,,,)) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen5 - PAGE = 1 - WRITE(6,1045) DESCRIP,FROM,DATEt - ELSEi - PAGE = PAGE + 1t - WRITE(6,1040) DESCRIP,FROM,DATEr - END IFe - END IFw - END DO& - END IF - IF (NEW_BULLS.GT.0.AND.READ_DATE.EQ.' 5-NOV-1956') THENs - WRITE (6,1035) ! Tell novice how to read the non-system bulls - ELSE - WRITE(6,1030) - END IF - END IFF - -998 RETURN - -999 CALL CLOSE_FILE(1) ! Just in case bulletins gets deleted - GO TO 998 ! while we are trying to read it (unlikely) - -1000 FORMAT(A12,A11,A8,A11,A8,2A4) -1005 FORMAT(A53,A12,A11,A8,A4,A11,A4)c -1020 FORMAT(' DESCRIPTION',43X,'FROM',9X,'DATE') -1025 FORMAT(' -----------',43X,'----',9X,'----') -1026 FORMAT(' ',33('*'),'SYSTEM NOTICES',33('*'),A1) -1027 FORMAT(' ',33('*'),'NEW BULLETINS',34('*'),A1)h -1028 FORMAT('+',33('*'),'NEW BULLETINS',34('*'),A1)C -1030 FORMAT(' ',80('*')) -1035 FORMAT(' ',14('*'), - & 'USE THE BULLETIN COMMAND TO READ THE ABOVE BULLETINS',14('*')) -1040 FORMAT(' ',A53,1X,A12,1X,A11) -1045 FORMAT(' ',A53,1X,A12,1X,A11) -1050 FORMAT(A) -1060 FORMAT(1X,A) -1065 FORMAT('+',A) -1070 FORMAT(' ERROR: Cannot add new entry to BULLETIN user file.') -1080 FORMAT(' ',/,' HIT any key for next page....')) - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -CA -C SUBROUTINE READ -CE -C FUNCTION: Reads a specified bulletin. -C( - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT! - - COMMON /READIT/ READITd - - COMMON /PAGE/ PAGE_LENGTH - - DATA SCRATCH_B1/0/l - - CALL LIB$ERASE_PAGE(1,1) ! Clear screenm - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this isc - ! not first page of bulletin - - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entrym - CALL CLOSE_FILE(2) - ELSEA - IER = 0L - END IFe - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 900 - END IFe - - BULL_POINT = BULL_READ ! Update bulletin counterS - - WRITE(6,1040) BULL_POINT ! Output bulletin header info - WRITE(6,1050) DESCRIP - WRITE(6,1060) FROM,DATE,EXDATE - - END = 4 ! Outputted 4 lines to screen - - READ_COUNT = BLOCK ! Init bulletin record counter - -CC -C Each page of the bulletin is buffered into temporary memory storage beforeN -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory) -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.l -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?L - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL LIB$GET_VM(92,SCRATCH_B) ! Allocate first recordT - CALL MAKE_CHAR(%VAL(SCRATCH_B),80) ! Form into character stringh - SCRATCH_B1 = SCRATCH_B ! Init header pointerc - END IFu - -100 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to headery - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = MIN(LENGTH,PAGE_LENGTH-END-4) ! Figure how much can outputR - CALL OPEN_FILE_SHARED(1) ! Get bulletin file - DO I=READ_COUNT,READ_COUNT+DISPLAY-1 ! Get page full from bulletinb - READ(1'I,2000,IOSTAT=IER) INPUT ! Read bulletin record - IF (IER.NE.0) GO TO 105n - CALL WRITE_BULL(%VAL(SCRATCH_B),SCRATCH_B) ! Save record in queue0 - END DO( - GO TO 107 - -105 DISPLAY = I - READ_COUNT ! If read error, output only this much - LENGTH = DISPLAY ! This forces the bulletin read to end - -107 CALL CLOSE_FILE(1) ! End of bulletin file read - -CN -C Bulletin page is now in temporary memory, so output to terminal.C -C Note that if this is a /READ, the first line will have problems with_ -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at theo -C end of the previous page. The output gets confused and thinks it muste -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -Ce - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=READ_COUNT,READ_COUNT+DISPLAY-1 ! Output page to terminal - CALL READ_BULL(%VAL(SCRATCH_B),SCRATCH_B) ! Get the queue record - CALL STR$TRIM(INPUT,INPUT,LEN) ! Strip leading blanks - IF (I.EQ.READ_COUNT.AND.I.NE.BLOCK.AND.READIT.GT.0) THEN - WRITE(6,2020) INPUT(1:LEN) ! (See above comments) - ELSE - WRITE(6,2010) INPUT(1:LEN)h - END IF - END DOC - -110 READ_COUNT = READ_COUNT + DISPLAY ! Update bull record counter - - LENGTH = LENGTH - DISPLAY ! Length of remaining recordso - IF (LENGTH.EQ.0) THEN ! If no more recordsP - READ_COUNT = 0 ! init bulletin record counterD - ELSE IF (READIT.EQ.0) THEN ! Else if this is not /READ - WRITE(6,1070) ! say there is more of bulletinU - END IFo - -900 RETURN - -910 WRITE(6,1010)C - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any bulletin.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT('+BULLETIN NUMBER: ',I3) -1050 FORMAT(' DESCRIPTION: ',A53)u -1060 FORMAT(' FROM: ',A12,' DATE: ',A11,' EXPIRES: ',A11,/)R -1070 FORMAT(1X,/,' Press RETURN for more...',/)C - -2000 FORMAT(A) -2010 FORMAT(1X,A)o -2020 FORMAT('+',A) - - END - - - - - SUBROUTINE READNEW6 -C -C SUBROUTINE READNEWe -Ca -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -CN - - IMPLICIT INTEGER (A-Z)_ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TERM_CHAN/ TERM_CHAN - - EXTERNAL IO$_READVBLK,IO$M_NOECHO,IO$M_PURGEL - - CHARACTER*1 INREADl - - LEN_P = 0 ! Tells read subroutine there isr - ! no bulletin paramter0 - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO)+%LOC(IO$M_PURGE) - WRITE(6,1000) ! Ask if want to read new bulletins - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, ! Use QIOsA - & %VAL(%LOC(INREAD)),%VAL(1),,,,) ! So no prompt is needed - CALL STR$UPCASE(INREAD,INREAD) ! Make input upper caseO - IF (INREAD.EQ.'N') CALL EXIT ! If NO, exit - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletinU - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed?P - CALL OPEN_FILE_SHARED(2) ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no new bulls, exit. - CALL CLOSE_FILE(2)V - IF (INREAD.EQ.'N') WRITE (6,1010) - CALL EXIT - ELSE IF (SYSTEM) THEN ! If bull is system - BULL_POINT = BULL_POINT + 1 ! If so, just skip it.t - GO TO 10 - END IF - CALL CLOSE_FILE(2) - END IFa - - IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030)L - END IFR - - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, ! Use QIOs1 - & %VAL(%LOC(INREAD)),%VAL(1),,,,) ! So no prompt is needed - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper caseL - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - CALL EXIT - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THENv - ! If NEXT and last bulletins not finishedn - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_FILE_SHARED(2) ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletinR - CALL CLOSE_FILE(2) ! Exit) - WRITE(6,1010) - CALL EXIT - ELSE IF (SYSTEM) THEN ! Else if NEXT bulletin SYSTEMR - BULL_POINT = BULL_POINT + 1 ! Skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_FILE(2) - END IFi - GO TO 5 - -1000 FORMAT(' Read new bulletins? Type N(No) or any otherU - & key for yes',$) -1010 FORMAT(' No more messages.')( -1020 FORMAT(1X,80('-'),/,' Type Q(Quit) or any other key for - & next message.',$) -1030 FORMAT(1X,80('-'),/,' Type Q(Quit), N(Next message), or - & any other key for MORE... ',$) - - END - - - - - SUBROUTINE REPLACEB -CS -C SUBROUTINE REPLACE0 -C -C FUNCTION: Replaces existing bulletin to bulletin file.( -CR - IMPLICIT INTEGER (A - Z)b - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC't - - CHARACTER*11 INEXDATE - CHARACTER*80 INDESCRIP,INPUTA - CHARACTER*1 ANSWER: - - INTEGER TIMADR(2) - - COMMON /TERM_CHAN/ TERM_CHAND - - COMMON /CTRLY/ CTRLYI - - EXTERNAL CLI$_ABSENTT - - DIMENSION SETPRV(2) - DATA SETPRV/Z10000000,0/ ! SYSPRV privileges - - LOGICAL*1 DOALL - -Co -C Get the bulletin number to be replaced. -CP - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are readingA - ELSEE - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IFn - -Cr -C Check to see if specified bulletin is present, and if the usert -C is permitted to replace the bulletin. -C - - CALL OPEN_FILE_SHARED(2)s - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletinh - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the personR - GOTO 100 ! and error out - END IFa - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,U - CALL GETPRIV(ALLOW) ! then see if owner has privileges. - IF (ALLOW.EQ.0) THEN ! If owner doesn't have privileges,T - WRITE(6,1090) ! Then error out.i - GO TO 100 - ELSE - CALL CLOSE_FILE(2) ! Let go of the file - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') GO TO 100 ! If not Yes, then exit - END IF - END IFW - - CALL CLOSE_FILE(2)) - -CN -C If no switches were given, replace the full bulletinM -CL - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND.A - & (.NOT.CLI$PRESENT('TEXT'))) THEN - DOALL = .TRUE. - END IFE - - CALL LIB$DISABLE_CTRL(CTRLY,) ! Disable CTRL-Y & -C - -5 IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - WRITE(6,1030) ! Prompt for expiration date - READ(5,2000,END=910,ERR=7) LEN,INEXDATE - CALL STR$UPCASE(INEXDATE,INEXDATE) ! Convert to upper for BINTIM - IF (LEN.EQ.0) GO TO 910) - IER = SYS$BINTIM(INEXDATE,TIMADR(1)) ! Is date format valid? - IF ((IER.AND.1).NE.1) THEN ! If not,4 -7 WRITE(6,1040) ! tell user - GO TO 5 ! and re-request date1 - END IF - IER = SYS$ASCTIM(,INEXDATE,TIMADR(1),) - IER = COMPARE_DATE(INEXDATE,' ') ! Compare date with today's - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - GO TO 5 ! and re-request datei - END IF - END IF - -8 IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletinn - READ(5,2000,END=910,ERR=910) LEN,INDESCRIP - IF (LEN.EQ.0) GO TO 910 ! If no header, don't add bullM - IF (LEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fit - GO TO 8 ! and re-request headerh - END IF - END IFe - - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN -CD -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.h -C - - ICOUNT = 0 ! Line count for bulletin - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)C - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! If file param in ADD command - - CALL GETPRIV(ALLOW) ! Does user have SETPRV privileges? - IF (ALLOW.EQ.0) THEN ! If not, then remove SYSPRVy - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! privileges when trying toe - END IF ! create new file.A - - OPEN (UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset SYSPRV privilegesI - - DO WHILE(1) ! Read until end of file to - READ (3,2000,END=10) ! get record countp - ICOUNT = ICOUNT + 1 - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 81 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,LEN) ! Get input line - IF (LEN.GE.0) THEN ! If good input line enterede - ICOUNT = ICOUNT + 1 ! Increment record count - WRITE(3,2010) INPUT(1:LEN) ! Save line in scratch file - END IF - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - END IFD - -C -C Add bulletin to bulletin file and directory entry for to directory file.s -Cu - - CALL OPEN_FILE(2) ! Prepare to add dir entryF - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for bulletin - CALL READDIR(0,IER) ! Get directory headerE - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN ! If text has been replacedt - CALL OPEN_FILE(1) ! Prepare to add bulletinT - IF (ICOUNT.LT.LENGTH) THEN ! If new bulletin smaller... - CALL COPY_BULL(3,1,BLOCK,IER) ! Replace old bulletinH - CALL COPY_BULL(1,BLOCK+LENGTH,BLOCK+ICOUNT,IER) - ! Move up any future bulletins - ELSE IF (ICOUNT.EQ.LENGTH) THEN ! If new bulletin same size - CALL COPY_BULL(3,1,BLOCK,IER) ! Replace old bulletin - ELSE ! If new bulletin is larger... - IF (NBULL.GT.NUMBER_PARAM) THEN ! If there are future bulletins - DO I=NBLOCK,BLOCK+LENGTH,-1 ! Move future bulletins down - READ (1'I,'(A80)') INPUTH - WRITE (1'I+ICOUNT-LENGTH,'(A80)') INPUT - END DO - END IF_ - CALL COPY_BULL(3,1,BLOCK,IER) ! Replace old bulletinD - END IF - - CLOSE (UNIT=1) - - IF (ICOUNT.NE.LENGTH) THEN ! If new bull different size - DIFF = ICOUNT - LENGTH ! Get difference in sizeS - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entryD - LENGTH = ICOUNT ! Update size - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - DO I=NUMBER_PARAM+1,NBULL ! Fix sizes of future bulletins, - CALL READDIR(I,IER) - BLOCK = BLOCK + DIFF - CALL WRITEDIR(I,IER)L - END DOL - NBLOCK = NBLOCK + DIFF ! Update NBLOCK - IF (DIFF.LT.0) THEN ! If bulletin file smaller - TRUNC_SIZE = (NBLOCK*80)/512 + 1 ! Truncate fileE - CALL TRUNCATE_FILE(TRUNC_SIZE) - END IF0 - CALL WRITEDIR(0,IER)E - END IF - END IFD - - CALL READDIR(NUMBER_PARAM,IER)5 - IF (CLI$PRESENT('HEADER').OR.DOALL) DESCRIP=INDESCRIP(1:53) - ! Update description header - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) EXDATE=INEXDATE - ! Update expiration date - CALL WRITEDIR(NUMBER_PARAM,IER) - - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expirationC - IF (DIFF.LT.0) THEN ! If it's the oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - CALL WRITEDIR(0,IER) ! the directory file - END IF - - CALL CLOSE_FILE(2) ! Totally finished with replace6 - - CLOSE (UNIT=3)E - -100 CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C. - RETURN - -910 WRITE(6,1010)L - CLOSE (UNIT=3,ERR=100) - GOTO 100( - -920 WRITE(6,1020)C - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset SYSPRV privileges - GOTO 100n - -1000 FORMAT (' Enter bulletin: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any bulletin.')& -1010 FORMAT (' No bulletin was replaced.') -1015 FORMAT (' ERROR: Specified bulletin was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' Enter expiration date of bulletin: dd-mmm-yyyy') -1040 FORMAT (' ERROR: Invalid date format specified.') -1045 FORMAT (' ERROR: Specified date has already passed.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be - & truncated to:') -1090 FORMAT(' ERROR: Specified bulletin is not owned by you.') -1100 FORMAT(' Bulletin is not owned by you.',o - & ' Are you sure you want to replace it? ',$) -2000 FORMAT(Q,A) -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - - - SUBROUTINE UPDATE -C5 -C SUBROUTINE UPDATE -CX -C FUNCTION: Searches for bulletins that have expired and deletes them. -C7 -C NOTE: Assumes directory file is already opened.8 -CR - IMPLICIT INTEGER (A - Z)I - CHARACTER*107 DIRLINE - - INCLUDE 'BULLDIR.INC' - - CHARACTER*11 TEMP_DATE/'5-NOV-2000'/ ! Default exp date if no bulls - CHARACTER*11 TEMP_EXDATEF - CHARACTER*8 TEMP_TIME - - NEW_EX = 0 ! Init expiration flag - - CALL OPEN_FILE(1) ! Open both bulletin files, - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - DO WHILE (1)' - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not foundb - IF (SYSTEM.LE.1.OR.(SHUTDOWN.EQ.0 ! If not permanent, or shutdown - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! bulletin and /SHUT specified? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - DIFF = 0 ! If so, delete it - ELSE! - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed?_ - END IFO - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL COPY_BULL(1,BLOCK+LENGTH,BLOCK,IER) ! Delete the bulletin by - ! rewriting rest of file - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - UPDATE_DONE = 1 ! Set bulletin deleted flag - ELSE IF (SYSTEM.LE.1) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latestB - ! expiration date. The following does that.e - IF (DIFF.LT.NEW_EX.OR.NEW_EX.EQ.0) THEN - TEMP_EXDATE = EXDATE ! If this is the latest expA - NEW_EX = DIFF ! date seen so far, save it. - END IF - BULL_ENTRY = BULL_ENTRY + 1 ! Increment bulletin counterh - TEMP_DATE = DATE ! Keep date so when we quitf - TEMP_TIME = TIME ! search, we'll have the - END IF ! latest bulletin datee - ELSE - BULL_ENTRY = BULL_ENTRY + 1 - END IF - END DOr - -100 DATE = NEWEST_DATE - TIME = NEWEST_TIMEs - CALL READDIR(0,IER) - NEWEST_EXDATE = TEMP_EXDATE - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER)u - CLOSE(UNIT=1) - - IF (UPDATE_DONE.EQ.1) THEN ! If any deletions occurred - TRUNC_SIZE = (NBLOCK*80)/512 + 1 ! truncate bulletin file. - CALL TRUNCATE_FILE(TRUNC_SIZE) - END IF - - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THENH - NEWEST_DATE = TEMP_DATE ! If the newest bulletin date - NEWEST_TIME = TEMP_TIME ! has been changed, it must - CALL UPDATE_LOGIN ! be changed in BULLUSER.DAT - END IFC - - RETURN! - -1000 FORMAT(A11,A11,A8,A4,A4)I -1020 FORMAT(A107) - - END - - - - SUBROUTINE UPDATE_READn -C -C SUBROUTINE UPDATE_READL -CT -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin.i -Ce -C OUTPUTS:( -C BULL_POINT - If -1, no new bulletins to read, else there are.) -CS - - IMPLICIT INTEGER (A - Z)( - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER*23 TODAYT - - INCLUDE '($FORIOSDEF)'d - - BULL_POINT = -1 ! Init bulletin pointeru - -Cn -C Update user's latest read time in his entry in BULLUSER.DAT. -Cp - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - -10 READ (4,1000,KEY=' ',IOSTAT=IER) ! Get newest bulletin - & USERNAME,NEWEST_DATE,NEWEST_TIME - IF (IER.EQ.FOR$IOS_SPERECLOC) GO TO 10 ! If record locked, retryh - - IF (IER.NE.0) THEN ! If header not present, exits - CALL CLOSE_FILE(4) - RETURN - END IFi - - UNLOCK 4 ! Release header record for other users to read - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - - CALL GETUSER(USERNAME) ! Get users name - - READ (4,1000,KEY=USERNAME,IOSTAT=IER1) USERNAME, ! Find user'sA - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,FLAGS ! info entry - - IF (IER1.EQ.0) THEN ! If entry found, update it - REWRITE (4,1000) USERNAME,LOGIN_DATE,LOGIN_TIME, - & TODAY(1:11),TODAY(13:20),FLAGS - ELSE ! else create a new entryN - WRITE (4,1000) USERNAME,TODAY(1:11),TODAY(13:20),) - & TODAY(1:11),TODAY(13:20),FLAGS - END IFC - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - -C -C Now see if bulletins have been added since the user's previousN -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in.e -CU - - DIFF = COMPARE_DATE(READ_DATE,NEWEST_DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(READ_TIME,NEWEST_TIME) - - IF (DIFF.LE.0.OR.IER1.NE.0) THEN ! New bulls or New user? - CALL OPEN_FILE_SHARED(2) ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header, - IF (IER.EQ.1) THEN ! If header present - DO ICOUNT=1,NBULL ! Get each bulletin to compare( - CALL READDIR(ICOUNT,IER) ! its date with last read date - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is usery - DIFF = COMPARE_DATE(READ_DATE,DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(READ_TIME,TIME)L - IF (DIFF.LE.0.OR.IER1.NE.0) THEN ! If new bull or new user - IF (SYSTEM) THEN ! If system bulletin - DIFF = COMPARE_DATE(LOGIN_DATE,DATE)_ - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,TIME) - IF (DIFF.LE.0) THEN ! If system bull, make it - BULL_POINT = ICOUNT - 1 ! the first new bull onlyE - GO TO 100 ! if added since user logged inS - END IF ! else he's read it already.! - ELSE - BULL_POINT = ICOUNT - 1 ! If not system bull thenL - GO TO 100 ! make it the new bull - END IF' - END IF - END IF - END DOC - END IF - END IFR - -100 CALL CLOSE_FILE(2) ! Its time for this program - RETURN ! to go home...A - -1000 FORMAT(A12,A11,A8,A11,A8,2A4) -1005 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END diff --git a/decus/vax85c/bulletin/bulletin.hlp b/decus/vax85c/bulletin/bulletin.hlp deleted file mode 100644 index ed2eec9..0000000 --- a/decus/vax85c/bulletin/bulletin.hlp +++ /dev/null @@ -1,17 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, adding -and deleting bulletins. Any user can submit a bulletin. Users are -notified at login time that new bulletins have been added and the topics of -those bulletins are displayed. Reading of those bulletins is optional. -(Use the command SET READNEW while in BULLETIN for setting automatic -reading.) Privileged users can add system bulletins that are displayed -in full at login time. These bulletins are also saved, and can be read -by BULLETIN. Bulletins are automatically deleted after a specifiede -expiration date, or they can manually be deleted by either the submitter -of the bulletin or a privileged user. - -BULLETIN has an interactive help available while using the utility.b - - Format: - - BULLETIN diff --git a/decus/vax85c/bulletin/bulletin.lnk b/decus/vax85c/bulletin/bulletin.lnk deleted file mode 100644 index cb50532..0000000 --- a/decus/vax85c/bulletin/bulletin.lnk +++ /dev/null @@ -1,2 +0,0 @@ -$ LINK/NOTRACE BULLETIN,HPWD,BULLSUBS,BULLCOM,BULLMAIN,CLIDEF,USEROPEN,SETUSER,SETUIC,- -SYS$SYSTEM:SYS.STB/SEL diff --git a/decus/vax85c/bulletin/bulletin.txt b/decus/vax85c/bulletin/bulletin.txt deleted file mode 100644 index af5a714..0000000 --- a/decus/vax85c/bulletin/bulletin.txt +++ /dev/null @@ -1,49 +0,0 @@ -This file describes the general operation of the BULLETIN utility. - -BULLETIN uses 3 files to store its data: BULLETIN.DAT, BULLDIR.DAT, & -BULLUSER.DAT. These files are opened with the shared attribute as much as -possible to allow simultaneous operations on the files. However, when a -bulletin is added or deleted, the file cannot be shared, as this might cause -the file to be corrupted. Because of this problem, files are closed as soon as -possible so that it may be quickly opened for adding and deleting files. e -During read operations, the information is passed to temporary storage, thes -file is closed, and then the information is sent to the terminal. This avoids at -possible problem where the terminal output is stopped by the user, therefore -delaying the closing of the file. Also, the use of CTRL-Y & CTRL-C is disablede -while the file is opened to avoid lockout problems.c - -BULLETIN.DAT stores the actual bulletins in a fixed 80 character length file.k -Bulletins are store sequentially datewise. New bulletins are appended to thet -end of the file. When a bulletin is deleted, all the following bulletins arei -moved up in the file to remove the gap, and the file is then truncated toi -remove the unused space. u - -BULLDIR.DAT is a fixed record length file storing directory entries for each -bulletin in BULLETIN.DAT. Each entry contains the header information, length,L -and starting record position in BULLETIN.DAT. The first line of BULLDIR.DAT ist -a header containing the date of the next expiration that will occur, the datef -of the latest sumbitted bulletin, the number of bulletins, and the total size -of BULLETIN.DAT. The last two numbers make it easier to add bulletins. Thet -directory entries then follow, again stored sequentially datewise. r - -NOTE: There are several advantages to keeping a seperate directory file versus -storing the header information with the actual bulletin. Obviously, it avoids -having to scan through a large bulletin file just to extract headert -information. This operation is done when a DIRECTORY listing is requested inu -BULLETIN. More importantly when a login occurs, non-system bulletins just -require that the header information be displayed. Having a file with pointers -to where the bulletin is stored also avoids requiring the software to read all -the previous bulletins in order to arrive at the desired bulletin. The main -disadvantage is the extra time spent on locating the second file. This time -appears to be minimal. In all the software, the convention is to open theI -directory file first, and then if needed to open the bulletin file. Wheno -adding and delete files, this becomes important, as files are opened unshared. d -A deadlock might occur if one user opens the bulletin file first while another -user opens the directory file, and then each try to open the alternate file. - -BULLUSER.DAT is a relative indexed file, where the keyword is the username ofe -the user. Each entry contains the latest time that the user logged in, plus -the latest time that the BULLETIN utility was used to read bulletins. A headere -entry with a blank username stores the latest bulletin date. The information -in this file is used for checking to see if the user should be alerted to newf -bulletins or not. diff --git a/decus/vax85c/bulletin/bullfiles.inc b/decus/vax85c/bulletin/bullfiles.inc deleted file mode 100644 index ff0afb8..0000000 --- a/decus/vax85c/bulletin/bullfiles.inc +++ /dev/null @@ -1,27 +0,0 @@ -C -C THE FIRST 3 FILES ARE FILES CREATED AND USED BY BULLETIN. -C SEE BULLETIN.TXT FOR MORE INFORMATION. SPECIFY THE DEVICE/DIRECTORY -C IN WHICH YOU DESIRE THAT THEY BE KEPT. THE FOURTH FILE IS SIMPLY -C THE MAIL FILE FROM WHICH MESSAGES ARE CONVERTED TO NON-SYSTEM -C BULLETINS (AFTER WHICH THE MAIL IS DELETED.) IF YOU DO NOT WISH -C THE BBOARD OPTION, CHANGE THE DEFINITION FOR BBOARD TO BE: /'NONE'/. -C IF IT IS NOT SELECTED, YOU DO NOT HAVE TO MODIFY THE REST OF THE -C BBOARD VARIABLES. IF IT IS SELECTED, YOU MUST SPECIFY THE UICB -C NUMBER OF THE BBOARD ACCOUNT. YOU MUST ALSO SPECIFY BBOARD_FILE, -C WHICH IS A TEMPORARY FILE WHICH IS USED TO CONVERT THE BBOARD MAILI -C TO A SEQUENTIAL FILE. -C - COMMON /FILES/ BULLDIR_FILE,BULLETIN_FILE,BULLUSER_FILE,BBOARD_USER - COMMON /FILES/ BBOARD_UIC,BBOARD_FILE,BBOARD_COMMANDR - CHARACTER*80 BULLDIR_FILE /'IML$EXE:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'IML$EXE:BULLETIN.DAT'/ - CHARACTER*80 BULLUSER_FILE /'IML$EXE:BULLUSER.DAT'/ - CHARACTER*12 BBOARD_USER /'BBOARD'/,BBOARD_UIC/'[330,5]'/ - CHARACTER*80 BBOARD_FILE/'USRD$:[BBOARD]BBOARD.MAI'/H -C -C THE BBOARD.COM IS INCLUDED WITH THE SOURCES AND IS USED IF THE BBOARD -C FEATURE IS DESIRED. IT IS NOT CREATED, SO YOU MUST MOVE IT TO THEE -C DESIRED DIRECTORY. YOU MUST ALSO EDIT IT SO THAT THE FILE SPECIFIEDC -C IN THE 'EXTRACT' LINE MATCHES THE FILE SPECIFIED BY BBOARD_FILE.T -CL - CHARACTER*80 BBOARD_COMMAND/'IML$EXE:BBOARD.COM'/ diff --git a/decus/vax85c/bulletin/bullflag.inc b/decus/vax85c/bulletin/bullflag.inc deleted file mode 100644 index 2061d8d..0000000 --- a/decus/vax85c/bulletin/bullflag.inc +++ /dev/null @@ -1,23 +0,0 @@ - PARAMETER ADD_FLAG = '1'X - PARAMETER BACK_FLAG = '2'X - PARAMETER DELETE_FLAG = '4'X - PARAMETER DIRECTORY_FLAG = '8'X - PARAMETER EXIT_FLAG = '10'X - PARAMETER FILE_FLAG = '20'X - PARAMETER HELP_FLAG = '40'X - PARAMETER NEXT_FLAG = '80'X - PARAMETER READ_FLAG = '100'X - PARAMETER SYSTEM_FLAG = '200'X - PARAMETER BROADCAST_FLAG = '400'X - PARAMETER BADSWITCH_FLAG = '800'X - PARAMETER REPLACE_FLAG = '1000'X - PARAMETER EXPIRE_FLAG = '2000'X - PARAMETER HEADER_FLAG = '4000'X - PARAMETER TEXT_FLAG = '8000'X - PARAMETER NUMBER_FLAG = '10000'XR - PARAMETER SHUTDOWN_FLAG = '20000'XC - PARAMETER PERMANENT_FLAG = '40000'X - - COMMON /BULLPAR/ FLAGS,BULL_PARAMETER,LEN_P,NUMBER_PARAM= - CHARACTER*64 BULL_PARAMETER - INTEGER FLAGS diff --git a/decus/vax85c/bulletin/bullmain.cld b/decus/vax85c/bulletin/bullmain.cld deleted file mode 100644 index c2e8f22..0000000 --- a/decus/vax85c/bulletin/bullmain.cld +++ /dev/null @@ -1,4 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - QUALIFIER READNEW - QUALIFIER LOGIN diff --git a/decus/vax85c/bulletin/bullstart.com b/decus/vax85c/bulletin/bullstart.com deleted file mode 100644 index c7aa49a..0000000 --- a/decus/vax85c/bulletin/bullstart.com +++ /dev/null @@ -1,3 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/SHARE/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL) -/EXIT diff --git a/decus/vax85c/bulletin/bullsubs.for b/decus/vax85c/bulletin/bullsubs.for deleted file mode 100644 index 05b93f2..0000000 --- a/decus/vax85c/bulletin/bullsubs.for +++ /dev/null @@ -1,1421 +0,0 @@ - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*11 INEXDATE - CHARACTER*80 INDESCRIP,INFROM,INPUT - - COMMON /CTRLY/ CTRLY - - CHARACTER*12 USERNAME - - IF (BBOARD_USER.EQ.'NONE') RETURN ! BBOARD disabled? - - CALL LIB$DISABLE_CTRL(CTRLY,) ! Disable CTRL-Y & -C - -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME) ! Get present username - CALL GETUIC(GROUP,USER) ! Get present uic - IER = SETUSER(BBOARD_USER,USERNAME) ! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - READ(BBOARD_UIC(2:INDEX(BBOARD_UIC,',')-1),'(O)') GROUPB - READ(BBOARD_UIC(INDEX(BBOARD_UIC,',')+1:INDEX(BBOARD_UIC,']')-1) - & ,'(O)') USERB - CALL SETUIC(GROUPB,USERB) ! Set to BBOARD uic - IER = LIB$SPAWN('$@'//BBOARD_COMMAND,'NL:','NL:') - ! Create sequential mail file - CALL SETUSER(USERNAME) ! Reset to original username - CALL SETUIC(GROUP,USER) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_FILE,STATUS='OLD',ERR=100) - -5 LEN = 1 - DO WHILE (LEN.GT.0) - READ (3,'(Q,A)',END=100) LEN,INPUT ! Read next line from mail - IF (INPUT(1:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(1:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - END IF - END DO - - -C -C Add bulletin to bulletin file and directory entry to directory file. -C - -10 CALL OPEN_FILE(2) ! Prepare to add dir entry - - READ (3,'(Q,A)',IOSTAT=IER) LEN,INPUT ! Read first line - IF (IER.NE.0) GO TO 100 ! If end of file, exit - IF (LEN.EQ.1.AND.INPUT(1:1).EQ.CHAR(12)) GO TO 5 - ! If line is just form feed, the message is empty - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - ICOUNT = 0 ! Initialize line count - - SPACE = INDEX(INFROM,' ') - 1 ! Strip off the date - IF (SPACE.GT.0) INFROM = INFROM(1:SPACE)! From the "From:" line - - CALL STR$TRIM(INFROM,INFROM,LEN) ! Get length of From line - IF (LEN.GT.12) THEN ! Is it > allowable username length? - ICOUNT = ICOUNT + 1 ! If so, put From line in bulletin text - WRITE(1'NBLOCK+ICOUNT,'(A80)',ERR=930) 'From: '//INFROM(1:74) - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) - I = 12 ! Trim username to first non-alpha character - DO WHILE (I.GT.1.AND. - & ((INFROM(I:I).GE.'A'.AND.INFROM(I:I).LE.'Z').OR. - & (INFROM(I:I).GE.'a'.AND.INFROM(I:I).LE.'z')) ) - I = I - 1 - END DO - IF (I.GT.1) INFROM = INFROM(1:I-1) - END IF - - CALL STR$TRIM(INDESCRIP,INDESCRIP,LEN) ! Get length of Subj line - IF (LEN.GT.53) THEN ! Is it > allowable subject length? - ICOUNT = ICOUNT + 1 ! If so, put Subj line in bulletin text - WRITE(1'NBLOCK+ICOUNT,'(A80)',ERR=930) 'Subj: '//INDESCRIP(1:74) - I = 53 ! Trim subject to first space - DO WHILE (I.GT.1.AND.INDESCRIP(I:I).NE.' ') - I = I - 1 - END DO - IF (I.GT.1) INDESCRIP = INDESCRIP(1:I-1) - END IF - - DO WHILE (INPUT(1:1).NE.CHAR(12)) ! Move text to bulletin file - ICOUNT = ICOUNT + 1 - WRITE(1'NBLOCK+ICOUNT,'(A80)',ERR=930) INPUT - READ (3,'(A)',END=25) INPUT - END DO - -25 CLOSE (UNIT=1) ! Finished adding bulletin - - DESCRIP = INDESCRIP(1:53) ! Description header - FROM = INFROM(1:53) ! Username - CALL GET_EXDATE(EXDATE,7) ! Expires after a week - LENGTH = ICOUNT ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - -30 CLOSE (UNIT=2) ! Totally finished with add - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_FILE(3) - WRITE (6,1030) - GO TO 100 - -1010 FORMAT (' ERROR: Install BULLETIN with CMKRNL privileges or relink.') -1030 FORMAT (' ERROR: Alert system programmer. BULLETIN file problems.') - - END - - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entries in user file of users that no longer exist. -C - CHARACTER*12 USERNAME - - OPEN (UNIT=7,FILE='SYS$SYSTEM:SYSUAF.DAT',SHARED,STATUS='OLD', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED',READONLY, - & ERR=30) - - READ (4,'(A12)',ERR=20,KEYGE=' ') USERNAME - ! Move pointer to top of file - -5 READ (4,'(A12)',ERR=20) USERNAME ! Get user entry - READ (7,'(A12)',KEY=USERNAME,ERR=10) USERNAME ! See if user exists - GO TO 5 ! If so, get next user entry - -10 DELETE(UNIT=4) ! Delete non-existant user - GO TO 5 ! Go get next user entry - -20 CLOSE (UNIT=7) ! All done... - -30 RETURN - END - - - - - SUBROUTINE CLOSE_FILE(INPUT) -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C -C INPUT: -C INPUT - Unit number of file to close out. (EXCEPT FOR 3) -C 1 = BULLETIN.DAT -C 2 = BULLDIR.DAT -C 3 = Close out both 1 & 2 -C 4 = BULLUSER.DAT -C - - COMMON /CTRLY/ CTRLY - - CALL LIB$ENABLE_CTRL(CTRLY,) ! Re-enable breaks - - IF (INPUT.NE.3) THEN - CLOSE (UNIT=INPUT) - ELSE - CLOSE (UNIT=2) - CLOSE (UNIT=1) - END IF - - RETURN - END - - - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - CHARACTER*80 INPUT - - IF (INLUN.GT.1) THEN - DO I=1,IBLOCK-1 - READ(INLUN,1000) - END DO - END IF - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - DO WHILE (1) - IF (INLUN.EQ.1) THEN - READ(INLUN'ICOUNT,1000,ERR=100) INPUT - ICOUNT = ICOUNT + 1 - ELSE - LEN = 0 - DO WHILE (LEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) LEN,INPUT - IF (LEN.EQ.0) THEN - INPUT(1:) = ' ' - LEN = 1 - ELSE IF (ICHAR(INPUT(LEN:LEN)).EQ.10) THEN - INPUT(LEN-1:LEN-1) = CHAR(32) - INPUT(LEN:LEN) = CHAR(32) - LEN = LEN - 2 - END IF - END DO - END IF - WRITE(1'OCOUNT,1000,IOSTAT=IER,ERR=100) INPUT - OCOUNT = OCOUNT + 1 - END DO - -100 RETURN - -1000 FORMAT(A80) - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - OFFSET = LENGTH - DO I=BULL_ENTRY+1,NBULL - CALL READDIR(I,IER) - BLOCK = BLOCK - OFFSET - CALL WRITEDIR(I-1,IER) - END DO - - DELETE(UNIT=2,REC=NBULL+1) - - CALL READDIR(0,IER) - NBULL = NBULL - 1 - NBLOCK = NBLOCK - OFFSET - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(1:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(1:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($RMSDEF)' - - LIMIT = LEN(INPUT) ! Get input line size limit - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - FLAG = 0 ! Yep, init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,FLAG,,,,) ! Enable the AST - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limit - POINTER = 0 ! during input. - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IER = LIB$GET_INPUT(DESCRIP) ! Get line from terminal - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - IER1 = SYS$CANCEL(%VAL(TERM_CHAN)) ! Cancel CTRL-C AST - IF (IER.NE.RMS$_EOF) THEN ! See if CTRL-Z is in input - LEN_INPUT = MIN(LIMIT,LENGTH) ! Yep. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE(FLAG) ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - FLAG = 1 ! to set flag - RETURN - END - - - - - - - - - SUBROUTINE GETPAGLEN(PAGE_LENGTH) -C -C SUBROUTINE GETPAGLEN -C -C FUNCTION: -C Gets page length of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C - IMPLICIT INTEGER (A-Z) - PARAMETER DVI$_DEVDEPEND = 'A'X - INTEGER ITMLST(3) - LOGICAL*1 DEVDEPEND(4) - ITMLST(1) = ISHFT(DVI$_DEVDEPEND,16).OR.4 - ITMLST(2) = %LOC(DEVDEPEND(1)) - ITMLST(3) = LEN - ITMLST(4) = 0 - CALL SYS$GETDVIW(,,'TT',ITMLST,,,,) - PAGE_LENGTH = DEVDEPEND(4) - RETURN - END - - - - - - - SUBROUTINE GETPRIV(ALLOW) -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To check if process has SETPRV capabilities. -C OUTPUTS: -C ALLOW - Set to 0 if no privileges, set to 1 if privileges. -C - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 ITMLST(4) ! Item list for SYS$GETJPI -C -C ITMLST is the ITEMLIST for the SYS$GETJPI system service. -C It has the following format: -C ITMLST(1) Top 16 bits = Item code (found in macro $JPIDEF -C in SYS$LIBRARY:STARTLET.MLB). -C Bottom 16 bits = length of buffer in bytes to -C receive the device information. -C ITMLST(2) Address of buffer to receive device information. -C ITMLST(3) Address of buffer to receive the length of the -C information. 0 indicates no such buffer desired. -C ... -C ITMLST(N) The last longword in an item list must be 0. -C - DATA ITMLST/4*0/ - PARAMETER JPI$_PROCPRIV='204'X ! Item code to get JPI$_PROCPRIV - PARAMETER PRV$M_SETPRV='4000'X ! Mask for SETPRV privileges - - ITMLST(1) = ISHFT(JPI$_PROCPRIV,16).OR.4 ! Move JPI$_PROCPRIV to upper - ! word & fill bottom word with # bytes. - ITMLST(2) = %LOC(PROCPRIV) ! PROCPRIV is buffer to receive info. - - IER = SYS$GETJPIW(,,,ITMLST,,,,) ! Get info - - IF ((PROCPRIV.AND.PRV$M_SETPRV).NE.0) THEN - ALLOW = 1 - ELSE - ALLOW = 0 - END IF - - RETURN - END - - - - - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 ITMLST(4) ! Item list for SYS$GETJPI -C -C ITMLST is the ITEMLIST for the SYS$GETJPI system service. -C It has the following format: -C ITMLST(1) Top 16 bits = Item code (found in macro $JPIDEF -C in SYS$LIBRARY:STARTLET.MLB). -C Bottom 16 bits = length of buffer in bytes to -C receive the device information. -C ITMLST(2) Address of buffer to receive device information. -C ITMLST(3) Address of buffer to receive the length of the -C information. 0 indicates no such buffer desired. -C ... -C ITMLST(N) The last longword in an item list must be 0. -C - DATA ITMLST/4*0/ - PARAMETER JPI$_USERNAME='202'X ! Item code to get JPI$_USERNAME - CHARACTER*(*) USERNAME ! Limit is 12 characters - - ITMLST(1) = ISHFT(JPI$_USERNAME,16).OR.12 ! Move JPI$_USERNAME to upper - ! word & fill bottom word with # bytes. - ITMLST(2) = %LOC(USERNAME) ! USERNAME is buffer to receive info. - - IER = SYS$GETJPIW(,,,ITMLST,,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 ITMLST(4) ! Item list for SYS$GETJPI -C -C ITMLST is the ITEMLIST for the SYS$GETJPI system service. -C It has the following format: -C ITMLST(1) Top 16 bits = Item code (found in macro $JPIDEF -C in SYS$LIBRARY:STARTLET.MLB). -C Bottom 16 bits = length of buffer in bytes to -C receive the device information. -C ITMLST(2) Address of buffer to receive device information. -C ITMLST(3) Address of buffer to receive the length of the -C information. 0 indicates no such buffer desired. -C ... -C ITMLST(N) The last longword in an item list must be 0. -C - DATA ITMLST/4*0/ - PARAMETER JPI$_STS='305'X ! Item code to get JPI$_USERNAME - INTEGER STS - - ITMLST(1) = ISHFT(JPI$_STS,16).OR.4 ! Move JPI$_STS to upper - ! word & fill bottom word with # bytes. - ITMLST(2) = %LOC(STS) ! STS is buffer to receive info. - - IER = SYS$GETJPIW(,,,ITMLST,,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_TOPIC',BULL_PARAMETER,LEN_P) - - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P) - & ,LIBRARY,,LIB$GET_INPUT) - - RETURNe - END - - - SUBROUTINE OPEN_FILE(INPUT) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($FORIOSDEF)'I - - EXTERNAL BULLDIR_ERR,BULLETIN_ERR,BULLUSER_ERRN - - PARAMETER TIMEOUT = -10*1000*1000*30T - DIMENSION TIMEBUF(2)S - DATA TIMEBUF /TIMEOUT,-1/ - PARAMETER TIMEEFN = 1 - - COMMON /CTRLY/ CTRLY$ - - CALL LIB$DISABLE_CTRL(CTRLY,) ! No breaks while file is openi - - IF (INPUT.EQ.3.OR.INPUT.EQ.2) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,) -20 OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='UNKNOWN', - 1 RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',ERR=20,r - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - END IFI - - IF (INPUT.EQ.3.OR.INPUT.EQ.1) THENr - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,), -10 OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='UNKNOWN',, - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=80,L - 1 FORM='FORMATTED',ERR=10) - END IFI - - IF (INPUT.EQ.4) THENR - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR,) -30 OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN',C - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=58,IOSTAT=IER,B - 1 FORM='FORMATTED',ORGANIZATION='INDEXED', - 1 KEY=(1:12:CHARACTER)), - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - CALL CONVERT_USERFILE - GO TO 30 - ELSE IF (IER.NE.0) THEN - GO TO 30 - END IF - END IF5 - - IER = SYS$CANTIM(,) ! Successful, so cancel timer. - - RETURN - END - - SUBROUTINE TIMER_ERR - - IMPLICIT INTEGER (A-Z)i - - COMMON /CTRLY/ CTRLY - - ENTRY BULLDIR_ERR - WRITE (6,'('' ERROR: Unable to open BULLDIR.DAT after 30 seconds.'')')I - GO TO 10L - - ENTRY BULLETIN_ERRi - WRITE (6,'('' ERROR: Unable to open BULLETIN.DAT after 30 seconds.'')') - GO TO 10E - - ENTRY BULLUSER_ERR - WRITE (6,'('' ERROR: Unable to open BULLUSER.DAT after 30 seconds.'')') - GO TO 10t - -10 CALL LIB$ENABLE_CTRL(CTRLY,) ! No breaks while file is open - CALL EXIT - END - - - - SUBROUTINE OPEN_FILE_SHARED(INPUT) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /CTRLY/ CTRLY - - CALL LIB$DISABLE_CTRL(CTRLY,) ! No breaks while file is open - - IF (INPUT.EQ.3.OR.INPUT.EQ.2) THENe -20 OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',IOSTAT=IER,m - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 SHARED,READONLY) - - IF (IER.EQ.FOR$IOS_FILNOTFOU) GO TO 100n - IF (IER.NE.0) GO TO 20 - - END IFR - - IF (INPUT.EQ.3.OR.INPUT.EQ.1) THENm -10 OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='OLD',A - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=80,' - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.EQ.FOR$IOS_FILNOTFOU) GO TO 100 - IF (IER.NE.0) GO TO 10 - - END IFD - - IF (INPUT.EQ.4) THEND -30 OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN',N - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=58,IOSTAT=IER, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED,B - 1 KEY=(1:12:CHARACTER))j - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - CALL CONVERT_USERFILE - GO TO 301 - ELSE IF (IER.NE.0) THEN - GO TO 30 - END IF - END IF. - - RETURNC - -100 CALL OPEN_FILE(INPUT)I - - RETURNH - END - - - - SUBROUTINE CONVERT_USERFILE -Cu -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C= - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLFILES.INC' - - CHARACTER*58 BUFFER - DIMENSION ZERO(2) - DATA ZERO/2*0/ - -10 OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=50,ERR=10,r - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED,e - 1 KEY=(1:12:CHARACTER))t - - OPEN (UNIT=8,FILE=BULLUSER_FILE,STATUS='NEW', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=58,IOSTAT=IER,u - 1 FORM='FORMATTED',ORGANIZATION='INDEXED', - 1 KEY=(1:12:CHARACTER))1 - - DO WHILE (1) - READ (4,'(A50)',END=20) BUFFER - WRITE (8,'(A50,2A4)') BUFFER,(ZERO(I),I=1,2) - END DOR - -20 CLOSE (UNIT=4)t - CLOSE (UNIT=8)e - - RETURN. - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -CE -C SUBROUTINE READDIR -CD -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.E -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS:R -C ICOUNT - The last record read by this routine. -CE - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - f - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - READ (2'1,1000,ERR=999) NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME - ELSED - READ(2'ICOUNT+1,1010,ERR=999)a - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCKE - END IF - - ICOUNT = ICOUNT + 1 - -999 RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C- -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C= -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.A -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C) - - IMPLICIT INTEGER (A - Z)) - - INCLUDE 'BULLDIR.INC' - - IF (BULLETIN_NUM.EQ.0) THEN - WRITE (2'1,1000,IOSTAT=IER) NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIMEt - ELSEe - WRITE(2'BULLETIN_NUM+1,1010,IOSTAT=IER)n - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCKi - END IF - - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)f -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - - SUBROUTINE TRUNCATE_FILE(TRUNC_SIZE) - - IMPLICIT INTEGER (A-Z)s - - INCLUDE 'BULLFILES.INC' - - COMMON /USER_OPEN/ CHANNEL,STATUS,SIZEv - - EXTERNAL USER_OPEN$TRUNCATE - - INCLUDE '($RMSDEF)' - - COMMON /CTRLY/ CTRLYe - - CALL LIB$DISABLE_CTRL(CTRLY,) ! No breaks while file is openT - -10 OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=80,INITIALSIZE=TRUNC_SIZE, - 1 FORM='FORMATTED',ERR=20,USEROPEN=USER_OPEN$TRUNCATE) - -15 CLOSE (UNIT=1)A - CALL LIB$ENABLE_CTRL(CTRLY,)P - RETURN - -20 IF ((STATUS.AND.1).EQ.1.OR.STATUS.EQ.RMS$_EOF) THEN - GO TO 15 - ELSE - GO TO 10 - END IF' - - END - - - SUBROUTINE UPDATE_LOGIN -CE -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted. -CU - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 TEMP_USERE - CHARACTER*11 TEMP_DATE,BBOARD_DATET - CHARACTER*8 TEMP_TIME,BBOARD_TIME - - CALL OPEN_FILE(4) - - READ (4,1000,KEY=' ',ERR=10) - & TEMP_USER,TEMP_DATE,TEMP_TIME,BBOARD_DATE,BBOARD_TIME - REWRITE (4,1000)E - & TEMP_USER,NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME - CLOSE (UNIT=4) - RETURNi - -10 WRITE (4,1000) ' ',NEWEST_DATE,NEWEST_TIME - CLOSE (UNIT=4). - RETURNO - -1000 FORMAT(A12,A11,A8,A11,A8) - - END - - - L - SUBROUTINE ADD_ENTRYL -C -C SUBROUTINE ADD_ENTRYL -CI -C FUNCTION: Enters a new directory entry in the directory file. -CD - IMPLICIT INTEGER (A - Z)- - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 TODAY_TIME - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:20)E - - CALL READDIR(0,IER) - IF (IER.EQ.1) GO TO 20n - -10 NEWEST_EXDATE = DATE - NBULL = 0 - NBLOCK = 0A - SHUTDOWN = 0T - -20 NEWEST_DATE = DATER - NEWEST_TIME = TIMEN - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) NEWEST_EXDATE = EXDATE - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1G - NBLOCK = NBLOCK + LENGTH3 - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1d - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF( - - CALL WRITEDIR(0,IER)A - - CALL UPDATE_LOGIN - - CALL WRITEDIR(NBULL,IER)) - - RETURN4 - END - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2)Y -C, -C FUNCTION COMPARE_DATE -Cu -C FUCTION: Compares dates to see which is farther in future.S -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date)T -C OUTPUT: -C Returns the difference in days between the two dates.o -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -Ce - IMPLICIT INTEGER (A - Z)e - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2)o - - CALL SYS$BINTIM(DATE1,USER_TIME)! - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THENo - CALL SYS$BINTIM(DATE2,USER_TIME) - ELSEm - CALL SYS$GETTIM(USER_TIME) - END IFm - - CALL LIB$DAY(DAY2,USER_TIME)O - - COMPARE_DATE = DAY1 - DAY2F - - RETURNg - END - - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -CT -C FUCTION: Compares times to see which is farther in future.x -Ca -C INPUTS: -C TIME1 - First time (hh:mm:ss)Y -C TIME2 - Second timea -C OUTPUT: -C Outputs 1 if time1 greater in future, outputs -1 if time2 -C greater in future. If exactly the same, output 0. -Ct - - IMPLICIT INTEGER (A-Z)( - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*8 TIME2_TEMP - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TIME2_TEMP = TODAY_TIME(13:20) - ELSEE - TIME2_TEMP = TIME2 - END IFf - - COMPARE_TIME = 0 - - DO J=1,7,3S - DO I=J,J+1 - IF (TIME1(I:I).GT.TIME2_TEMP(I:I)) THEN - COMPARE_TIME = 1 - RETURNe - ELSE IF (TIME1(I:I).LT.TIME2_TEMP(I:I)) THENR - COMPARE_TIME = -1 - RETURN - END IFc - END DO - END DO - - RETURN - END - -C------------------------------------------------------------------------- -CG -C The following are subroutines to create a linked-list queue for P -C temporary buffer storage of data that is read from files to beN -C outputted to the terminal. This is done so as to be able to closeC -C the file as soon as possible. -C_ -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word ofL -C the record. The last word in the record contains the address of theE -C next record. Every time a record is written, if that record has a, -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -Ci -C There are 2 seperate queues. One for directory listings, and one -C for bulletins reads. The bulletin queue is made of character -C variables of length 80. The directory listings contain character -C variables of length 88. Although BULLETIN does not use all the -C info that is stored, (SYSTEM,BLOCK,LENGTH), that info is used byi -C BULLCHECK.N -CP -C------------------------------------------------------------------------- - - SUBROUTINE WRITE_DIR(RECORD,NEXT) - INTEGER RECORD(1) - CALL WRITE_DIR_CHAR(%VAL(%LOC(RECORD))) - NEXT = RECORD(25) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(100,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),88) - RECORD(25) = NEXT - RETURNT - END - - SUBROUTINE WRITE_DIR_CHAR(SCRATCH)T - CHARACTER*(*) SCRATCH - INCLUDE 'BULLDIR.INC' - WRITE(SCRATCH,1035) DESCRIP,FROM,DATE,SYSTEM,BLOCK,LENGTHI - RETURNR -1035 FORMAT(A53,A12,A11,A4,A4,A4)O - END - - SUBROUTINE READ_DIR(RECORD,NEXT)I - INTEGER RECORD(1) - CALL READ_DIR_CHAR(%VAL(%LOC(RECORD)))e - NEXT = RECORD(25) - RETURN - END - - SUBROUTINE READ_DIR_CHAR(SCRATCH) - CHARACTER*(*) SCRATCH - INCLUDE 'BULLDIR.INC' - READ(SCRATCH,1035) DESCRIP,FROM,DATE,SYSTEM,BLOCK,LENGTH - RETURN -1035 FORMAT(A53,A12,A11,A4,A4,A4)I - END - - SUBROUTINE WRITE_BULL(RECORD,NEXT)P - INTEGER RECORD(1) - CALL WRITE_BULL_CHAR(%VAL(%LOC(RECORD)))S - NEXT = RECORD(23) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(92,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),80) - RECORD(23) = NEXT - RETURNM - END - - SUBROUTINE WRITE_BULL_CHAR(SCRATCH) - CHARACTER*(*) SCRATCH - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUTP - SCRATCH = INPUT - RETURNo - END - - SUBROUTINE READ_BULL(RECORD,NEXT) - INTEGER RECORD(1) - CALL READ_BULL_CHAR(%VAL(%LOC(RECORD))) - NEXT = RECORD(23) - RETURN - END - - SUBROUTINE READ_BULL_CHAR(SCRATCH)m - CHARACTER*(*) SCRATCH - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUTs - INPUT = SCRATCH - RETURNh - END - - - SUBROUTINE MAKE_CHAR(IARRAY,LEN) - DIMENSION IARRAY(1) - IARRAY(1) = LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -Cf -C SUBROUTINE CHECK_PRIV_IOs -Cf -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -Ce - - IMPLICIT INTEGER (A-Z)t - - DIMENSION SETPRV(2) - DATA SETPRV/Z10000000,0/ ! SYSPRV privileges - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE')a - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200)% - ERROR = 1 - ELSEV - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0, - END IF, - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable SYSPRV ) - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')E - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM)T -C: -C SUBROUTINE GETUIC(UIC)e -Cp -C FUNCTION: -C To get UIC of process submitting the job.p -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UICl -C - - IMPLICIT INTEGER (A-Z)S - - INTEGER*4 ITMLST(7) ! Item list for SYS$GETJPI -C -C ITMLST is the ITEMLIST for the SYS$GETJPI system service. -C It has the following format: -C ITMLST(1) Top 16 bits = Item code (found in macro $JPIDEF -C in SYS$LIBRARY:STARTLET.MLB). -C Bottom 16 bits = length of buffer in bytes tof -C receive the device information. -C ITMLST(2) Address of buffer to receive device information. -C ITMLST(3) Address of buffer to receive the length of the -C information. 0 indicates no such buffer desired. -C ...D -C ITMLST(N) The last longword in an item list must be 0. -C - DATA ITMLST/7*0/E - PARAMETER JPI$_GRP='308'X ! Item code to get JPI$_GRP - PARAMETER JPI$_MEM='307'X ! Item code to get JPI$_MEM - - ITMLST(1) = ISHFT(JPI$_GRP,16).OR.4 ! Move JPI$_GRP to upperI - ! word & fill bottom word with # bytes. - ITMLST(2)=%LOC(GRP) ! GRP is buffer to receive info. - ITMLST(4) = ISHFT(JPI$_MEM,16).OR.4 ! Move JPI$_MEM to upper - ! word & fill bottom word with # bytes. - ITMLST(5)=%LOC(MEM) ! MEM is buffer to receive info. - - IER = SYS$GETJPIW(,,,ITMLST,,,,) ! Get Info command.e - - RETURNs - END - - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)t -Cl -C SUBROUTINE GET_UPTIME -CM -C FUNCTION: Gets time of last reboot. -Ce - - IMPLICIT INTEGER (A-Z)o - - EXTERNAL EXE$GL_ABSTIM1 - INTEGER UPTIME(2),SYSTIME(2),UPSINCE(2)J - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - UPTIME(1) = GET_L_VAL(EXE$GL_ABSTIM) ! Up time (sec)r - - CALL LIB$EMUL(10000000,UPTIME,0,UPTIME) ! 64 bit format - CALL SYS$GETTIM(SYSTIME)s - CALL LIB$SUBX(SYSTIME,UPTIME,UPSINCE) - CALL SYS$ASCTIM(,ASCSINCE,UPSINCE,) ! Up sincee - - UPTIME_DATE = ASCSINCE(1:11)t - UPTIME_TIME = ASCSINCE(13:20) - - RETURN - END - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - SUBROUTINE SET_READNEW(CMD,TOPIC) -C. -C SUBROUTINE SET_READNEWe -C -C FUNCTION: Sets readnew for specified topic (TOPIC = 1 is general topic).s -Cf -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set readnew. -C If FALSE, clear readnew. -C TOPIC - TOPIC number, corresponding to bit number.T -CA - IMPLICIT INTEGER (A - Z)P - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'P - - LOGICAL CMD - -CA -C Find user entry in BULLUSER.DAT to update information., -CL - - CALL OPEN_FILE_SHARED(4) ! Open user file$ - - READ (4,1000,KEY=USERNAME) USERNAME, ! Read old entry - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,FLAGS( - - F_POINT = TOPIC/32 + 1 - IF (CMD) THEN - I = IBSET(FLAGS(F_POINT),TOPIC-1)S - ELSE - I = IBCLR(FLAGS(F_POINT),TOPIC-1)L - END IFN - - REWRITE (4,1000) USERNAME, ! Write modified entryT - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,FLAGSN - - CALL CLOSE_FILE (4) - RETURN - -1000 FORMAT(A12,A11,A8,A11,A8,2A4) - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,PASSWORD,ALLOW) -CE -C SUBROUTINE CONFIRM_PRIV -CM -C FUNCTION: Confirms that given username has SETPRV, and that the -C the given password is correct. -CR -C INPUTS: -C USERNAME - Usernamer -C PASSWORD - Username's password -C OUTPUTS:' -C ALLOW - Returns 1 if correct password and SETPRV set, -C returns 0 if not.% -C( - - IMPLICIT INTEGER (A-Z)R - - CHARACTER*(*) USERNAME,PASSWORD - - PARAMETER UAF$Q_DEF_PRIV = '1A4'X, UAF$Q_PWD = '154'X - PARAMETER UAF$W_SALT = '166'X, UAF$B_ENCRYPT = '168'X - - PARAMETER PRV$V_SETPRV = 'E'X - - LOGICAL*1 UAF(0:583)Y - CHARACTER*(*) SYSUAFT - PARAMETER (SYSUAF = 'SYS$SYSTEM:SYSUAF.DAT')= - EQUIVALENCE (UAF(UAF$B_ENCRYPT), UAF_ENCRYPT) - EQUIVALENCE (UAF(UAF$W_SALT), UAF_SALT) - EQUIVALENCE (UAF(UAF$Q_PWD), UAF_PWD) - EQUIVALENCE (UAF(UAF$Q_DEF_PRIV),UAF_DEF_PRIV)H - CHARACTER UAF_PWD*8,HASH*8R - - CALL STR$UPCASE(PASSWORD,PASSWORD) ! Password must be upper case - ALLOW = 0 ! Set return false - CALL LIB$GET_LUN(LUN) ! Get LUNI - OPEN (UNIT=LUN,FILE=SYSUAF,SHARED,READONLY,ACCESS='KEYED', - & FORM='UNFORMATTED',TYPE='OLD',ERR=999) ! Open UAFi - READ (LUN,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Record - IF (STATUS.EQ.0) THEN ! If username found3 - IF (BTEST(UAF_DEF_PRIV,PRV$V_SETPRV)) THEN ! System privileges?E - CALL LGI$HPWD(HASH,PASSWORD,%VAL(UAF_ENCRYPT),) - & %VAL(UAF_SALT),USERNAME) ! HASH the passwordR - IF (HASH.EQ.UAF_PWD) ALLOW = 1 ! Set return true - END IF ! If correct password - END IFo - CLOSE (UNIT=LUN) ! Close the LUN -999 CALL LIB$FREE_LUN(LUN) ! Free the LUN - RETURN ! ReturnI - END ! EndU - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT,ACCESS)$ - - IMPLICIT INTEGER (A-Z)r - - CHARACTER*(*) INPUT,OUTPUT - - INTEGER ITMLST(4) - - PARAMETER LNM$_STRING = '2'X - - ITMLST(1) = ISHFT(LNM$_STRING,16).OR.LEN(OUTPUT)R - ITMLST(2) = %LOC(OUTPUT)T - ITMLST(3) = 0 - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$PROCESS',INPUT,ACCESS,ITMLST) - - RETURN - END diff --git a/decus/vax85c/bulletin/bulluser.inc b/decus/vax85c/bulletin/bulluser.inc deleted file mode 100644 index b166728..0000000 --- a/decus/vax85c/bulletin/bulluser.inc +++ /dev/null @@ -1,8 +0,0 @@ - - COMMON /BULL_USER/ USERNAME,LOGIN_DATE,LOGIN_TIME,READ_DATE, - & READ_TIME,FLAGS - CHARACTER*12 USERNAME - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - DIMENSION FLAGS(2) - diff --git a/decus/vax85c/bulletin/clidef.mar b/decus/vax85c/bulletin/clidef.mar deleted file mode 100644 index b633374..0000000 --- a/decus/vax85c/bulletin/clidef.mar +++ /dev/null @@ -1,3 +0,0 @@ - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $CLIDEF GLOBAL - .END diff --git a/decus/vax85c/bulletin/create.com b/decus/vax85c/bulletin/create.com deleted file mode 100644 index cc1e7e7..0000000 --- a/decus/vax85c/bulletin/create.com +++ /dev/null @@ -1,10 +0,0 @@ -$ FORTRAN BULLETIN -$ FORTRAN BULLSUBS -$ MAC CLIDEF -$ MAC HPWD -$ MAC SETUIC -$ MAC SETUSER -$ MAC USEROPEN -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ @BULLETIN.LNK diff --git a/decus/vax85c/bulletin/hpwd.mar b/decus/vax85c/bulletin/hpwd.mar deleted file mode 100644 index d035df1..0000000 --- a/decus/vax85c/bulletin/hpwd.mar +++ /dev/null @@ -1,223 +0,0 @@ -.TITLE HPWD - hash user password -.IDENT 'V02-002' - -; This code was gotten by disassembling the AUTHORIZE program. -; It is quite shameful that DEC has not seen fit to provide -; this as a system service. - -; If you want lots of good comments, see the fiche. - -; e _lib$code:_lib$code+68 - - -; Inputs: PWDDSC -- Addres of password descriptor -; ENCRYPT -- Encryption algorithm index (byte) -; SALT - random number (word) -; USRDSC - Address of username descriptor - -; output: OUTDSC -- Address of encrypted output descriptor - -OUTDSC=4 -PWDDSC=OUTDSC+4h -ENCRYPT=PWDDSC+4 -SALT=ENCRYPT+4 -USRDSC=SALT+4 - -.PSECT _LIB$CODE RD,NOWRT,PIC,SHR,BYTE,EXE - -; AUTODIN-II polynomial table used by CRC algorithm -AUTODIN: - .LONG ^X000000000,^X01DB71064,^X03B6E20C8,^X026D930AC,^X076DC4190 - .LONG ^X06B6B51F4,^X04DB26158,^X05005713C,^X0EDB88320,^X0F00F9344 - .LONG ^X0D6D6A3E8,^X0CB61B38C,^X09B64C2B0,^X086D3D2D4,^X0A00AE278 - .LONG ^X0BDBDF21C - -; Purdy polynomial coefficients. Prime, but don't need to be -Purdy_Poly: -c: - .LONG -83,-1R - .LONG -179,-1 - .LONG -257,-1 - .LONG -323,-1 - .LONG -363,-1 - -.ENTRY LGI$HPWD,^M - MOVAQ @outdsc(AP),R4e - MOVAQ @4(R4),R4 - TSTB encrypt(AP) - BGTRU 10$ - MNEGL #1,R0 - MOVAQ @pwddsc(AP),R1 - CRC autodin,R0,(R1),@4(R1)0 - CLRL R13 - MOVQ R0,(R4) - BRB 20$ - -10$: CLRQ (R4)^ - MOVAQ @pwddsc(AP),R3. - BSBB COLLAPSE_R2 - ADDW2 salt(AP),3(R4)e - MOVAQ @usrdsc(AP),R3 - BSBB COLLAPSE_R2 - PUSHAQ (R4)3 - CALLS #1,PURDY1 - -20$: MOVL #1,R0 - RET - - -COLLAPSE_R2: - MOVZWL (R3),R0 - BEQL 20$ - MOVAL @4(R3),R2 - PUSHR #^M, - MOVL R0,R1e -5$: CMPB (R2)+,#32 - BNEQ 7$ - DECL R1 -7$: SOBGTR R0,5$) - MOVL R1,R0 - POPR #^M -10$: BICL3 #-8,R0,R1 - ADDB2 (R2)+,(R4)[R1] - SOBGTR R0,10$R -20$: RSB - -a=59 -n0=1@24-3. -n1=1@24-63 - - -.ENTRY PURDY,^M - MOVQ @4(AP),-(SP) - BSBW PQMOD_R0 - MOVAQ (SP),R4 - MOVAQ PURDY_POLY,R5 - MOVQ (R4),-(SP)V - PUSHL #n1 - BSBB PQEXP_R3E - MOVQ (R4),-(SP)0 - PUSHL #n0-n1 - BSBB PQEXP_R3 - MOVQ (R5)+,-(SP) - BSBW PQADD_R0B - BSBW PQMUL_R2$ - MOVQ (R5)+,-(SP) - MOVQ (R4),-(SP)R - BSBW PQMUL_R2> - MOVQ (R5)+,-(SP) - BSBW PQADD_R04 - MOVQ (R4),-(SP)0 - BSBB PQMUL_R2 - MOVQ (R5)+,-(SP) - BSBW PQADD_R0E - MOVQ (R4),-(SP)r - BSBB PQMUL_R2S - MOVQ (R5)+,-(SP) - BSBW PQADD_R0V - BSBW PQADD_R0M - MOVQ (SP)+,@4(AP)S - MOVL #1,R0 - RET - -PQEXP_R3:( - POPR #^M - MOVQ #1,-(SP) - MOVQ 8+4(SP),-(SP) - TSTL 8+8(SP) - BEQL 30$ -10$: BLBC 8+8(SP),20$ - MOVQ (SP),-(SP) - MOVQ 8+8(SP),-(SP) - BSBB PQMUL_R2( - MOVQ (SP)+,8(SP) - CMPZV #1,#31,8+8(SP),#0 - BEQL 30$ -20$: MOVQ (SP),-(SP)- - BSBB PQMUL_R2D - EXTZV #1,#31,8+8(SP),8+8(SP)B - BRB 10$ - -30$: MOVQ 8(SP),8+8+4(SP) - MOVAQ 8+8+4(SP),SPD - JMP (R3)( - -u=0S -v=u+4 -y=u+8 -z=y+4 - -PQMOD_R0: - POPR #^M - CMPL v(SP),#-1 - BLSSU 10$ - CMPL u(SP),#-a - BLSSU 10$ - ADDL2 #a,u(SP)8 - ADWC #0,v(SP) -10$: JMP (R0) - -PQMUL_R2: - POPR #^M - MOVL SP,R2 - PUSHL z(R2) - PUSHL v(R2) - BSBB EMULQ - BSBB PQMOD_R0( - BSBB PQLSH_R0L - PUSHL y(R2) - PUSHL v(R2) - BSBB EMULQ - BSBB PQMOD_R0 - PUSHL z(R2) - PUSHL u(R2) - BSBB EMULQ - BSBB PQMOD_R0 - BSBB PQADD_R0= - BSBB PQADD_R0 - BSBB PQLSH_R0 - PUSHL y(R2) - PUSHL u(R2) - BSBB EMULQ - BSBB PQMOD_R0U - BSBB PQADD_R0 - MOVQ (SP)+,Y(R2) - MOVAQ Y(R2),SP( - JMP (R1)_ - -EMULQ: - EMUL 4(SP),8(SP),#0,-(SP)P - CLRL -(SP) - TSTL 4+8+4(SP) - BGEQ 10$ - ADDL2 4+8+8(SP),(SP)P -10$: TSTL 4+8+8(SP) - BGEQ 20$ - ADDL2 4+8+4(SP),(SP)B -20$: ADDL2 (SP)+,4(SP) - MOVQ (SP)+,4(SP) - RSB U - -PQLSH_R0:M -.ENABLE LSB - POPR #^M - PUSHL v(SP) - PUSHL #a - BSBB EMULQ - ASHQ #32,Y(SP),Y(SP) - BRB 10$ - -PQADD_R0:B - POPR #^M -10$: ADDL2 u(SP),y(SP) - ADWC v(SP),z(SP) - BLSSU 20$ - CMPL z(SP),#-1 - BLSSU 30$ - CMPL y(SP),#-a - BLSSU 30$ -20$: ADDL2 #a,y(SP)A - ADWC #0,z(SP)P -30$: MOVAQ Y(SP),SP) - JMP (R0) -.END diff --git a/decus/vax85c/bulletin/install.com b/decus/vax85c/bulletin/install.com deleted file mode 100644 index 958e066..0000000 --- a/decus/vax85c/bulletin/install.com +++ /dev/null @@ -1,8 +0,0 @@ -$ COPY BULLETIN.EXE SYS$SYSTEM: -$ SET FILE SYS$SYSTEM:BULLETIN.EXE/OWN=[1,4] -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/SHARE/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL) -/EXIT -$ LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vax85c/bulletin/instruct.txt b/decus/vax85c/bulletin/instruct.txt deleted file mode 100644 index 3d06352..0000000 --- a/decus/vax85c/bulletin/instruct.txt +++ /dev/null @@ -1,6 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. System messages, such as this -one, are displayed in full. Only topics will be displayed for non-system -messages. Messages are submitted using the BULLETIN command. Any user may -submit a non-system message. Only privileged users can submit a system -message. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vax85c/bulletin/login.com b/decus/vax85c/bulletin/login.com deleted file mode 100644 index 21978bf..0000000 --- a/decus/vax85c/bulletin/login.com +++ /dev/null @@ -1,2 +0,0 @@ -$ BULL*ETIN :== $SYS$SYSTEM:BULLETIN -$ BULLETIN/LOGIN diff --git a/decus/vax85c/bulletin/netfiles/announce.mai b/decus/vax85c/bulletin/netfiles/announce.mai deleted file mode 100644 index f85b5d9..0000000 --- a/decus/vax85c/bulletin/netfiles/announce.mai +++ /dev/null @@ -1,78 +0,0 @@ -To: info-vax@sri-kl@mc -Subject: BULLETIN - -A new version of BULLETIN is now available. BULLETIN is a bulletin program -that I wrote to use under VMS until DEC comes up with their own. (A -description follows after the next couple of paragraphs.) The new version -fixes the BBOARD feature, which breaks under VMS V4.0, plus a few random bugs. -Some of the new features are: - -The command /NODE has been created to the ADD command in order to add bulletins -to other DECNET nodes. All features of the ADD command will apply to the -bulletin added to the other DECNET nodes. (i.e. /BROADCAST, etc.) -The command /EDIT has been created to the ADD command (similar to SEND/EDIT in -MAIL). System bulletins displayed upon logging do not run off the end of screen -if they are too large. Instead, the output is stopped at the end of the screen -and awaits a prompt. -Bulletins written by the FILE command include a header comment (controlled -by the /HEADER qualifer). - -A few minor changes: -The /BELL qualifier has been added to make it optional whether to include a bell -with a broadcasted bulletin. -A user can now enable prompting for reading non-system bulletins by using -the SET READNEW command rather than adding a BULLETIN/READNEW line in his login, -thus eliminating an addition image execution. -BULLETIN/SYSTARTUP is no longer necessary. (SHUTDOWN bulletins are -automatically deleted). - -(Future plans: I'm in the process of modifying bulletin to work with multiple -bulletin boards files.) - ------------------------------------------------------------------------------- - -Description of BULLETIN utility: - -Easy to use utility to submit and read bulletins. Similar to mail utility. -Users are notified of bulletins only once. They're not forced into reading -them every time they log in. - -SYSTEM bulletins are displayed in full. Only privileged users can submit them. -Any non-privileged users can submit non-system bulletins. Only the "subjects" -of these bulletins are displayed at login. The user can decide if the -bulletins are worthwhile reading. (There is also an optional feature which, if -installed, will ask a user upon logging in whether he or she wants to read -the non-system bulletins or not, and if so, they are automatically displayed. -The alternative is to let the user manually enter the commands in order to read -the bulletins.) -Privileged users can broadcast their bulletin to users that are logged -in. This allows you to get your message across to both logged in users -and non-logged in users. -Bulletins have expiration dates and are deleted automatically. -Privileged users can specify "SHUTDOWN" bulletins, i.e. bulletins that get -deleted after a system shutdown has occurred. -An optional feature allows non-system bulletins to be created by users of -other systems connected via networks. This "Bulletin Board" feature is on -several computers on the ArpaNet. This is accomplished by sending mail -to the dummy user BBOARD. (These bulletins expire after 7 days). -There is also a much more sophisticated optional feature which allows adding -bulletins to DECNET nodes from within the BULLETIN the utility (see the -ADD command). -This bulletin program does not create lots of files. It needs only 3 data -files. Neither does it create any additional processes (all events are -triggered by people logging in). - ----------------------------------------------------------------------------- - -Our VAX is not directly on the ArpaNet, so if you desire the sources, send -me your request and I will send the sources via mail. - -There are some command procedures for installation included. However, they -are pretty crude, as I have not had time to write something more sophisticated. -(P.s. If you already have an old version of the bulletin utility, you should -create the version in a different directory, as the command procedure is not -smart enough to delete obsolete files.) - - Mark R. London - MRL%PFCVAX@MC - diff --git a/decus/vax85c/bulletin/netfiles/file1.mai b/decus/vax85c/bulletin/netfiles/file1.mai deleted file mode 100644 index f80d2bf..0000000 --- a/decus/vax85c/bulletin/netfiles/file1.mai +++ /dev/null @@ -1,31 +0,0 @@ - -From: MAILER 30-OCT-1985 10:58 -To: BINGHAM -Subj: [TCP/IP Mail From: MRL%PFCVAX@ZERMATT] BULLETIN utility. - -Return-Path: <@MIT-ZERMATT.ARPA:MRL%MIT-PFC-VAX@MIT-MC.ARPA> -Received: from MIT-ZERMATT.ARPA by ari-hq1.ARPA ; 30 Oct 85 10:58:20 EST -Received: from MIT-PFC-VAX by ZERMATT via CHAOS with CHAOS-MAIL id 15461; Wed 30-Oct-85 10:53:24-EST -Date: 30 Oct 85 10:54:33 EST -From: MRL%PFCVAX@ZERMATT -Sender: MRL@MIT-PFC-VAX -To: BINGHAM@ARI-HQ1@ZERMATT -Subject: BULLETIN utility. - -You will be receiving 4 files for the BULLETIN facility. The first file is -BULLETIN.FOR. The second file is BULLSUBS.FOR. The third file is BULLET.COM . -The 4th is BULLET.MAI . BULLETIN.FOR and BULLSUBS.FOR are seperate files. -BULLET.MAI contains many individual files that appended into one large file -(in order so I don't have to send them individually). BULLET.COM is a command -procedure to separate BULLET.MAI into individual files. This takes several -minutes. Afterwards, you can delete BULLET.MAI. Read AAAREADME.TXT for -instructions. - Mark London - MRL%PFCVAX@ZERMATT - -NOTE: You can use the old DAT files with the new version of BULLETIN. However, -when you run the new version of BULLETIN for the first time, it will create a -new copy of BULLUSER.DAT from the old copy, as the length of the records have -to be increased. After you have confirmed that the new BULLETIN is running -properly, you can delete the old version of BULLUSER.DAT. - diff --git a/decus/vax85c/bulletin/netfiles/file2.mai b/decus/vax85c/bulletin/netfiles/file2.mai deleted file mode 100644 index 7be1287..0000000 --- a/decus/vax85c/bulletin/netfiles/file2.mai +++ /dev/null @@ -1,1832 +0,0 @@ - -From: MAILER 30-OCT-1985 11:00 -To: BINGHAM -Subj: [TCP/IP Mail From: MRL%PFCVAX@ZERMATT] BULLETIN.FOR - -Return-Path: <@MIT-ZERMATT.ARPA:MRL%MIT-PFC-VAX@MIT-MC.ARPA> -Received: from MIT-ZERMATT.ARPA by ari-hq1.ARPA ; 30 Oct 85 10:59:27 EST -Received: from MIT-PFC-VAX by ZERMATT via CHAOS with CHAOS-MAIL id 15462; Wed 30-Oct-85 10:53:42-EST -Date: 30 Oct 85 10:54:51 EST -From: MRL%PFCVAX@ZERMATT -Sender: MRL@MIT-PFC-VAX -To: BINGHAM@ARI-HQ1@ZERMATT -Subject: BULLETIN.FOR - -C -C BULLETIN.FOR, Version P850716 -C Purpose: Facility for reading, adding, and delete bulletins. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C NOTES: See BULLETIN.TXT for general info. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /CTRLY/ CTRLY - - COMMON /TERM_CHAN/ TERM_CHAN - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT,CLI$_NOCOMD,CLI$_ABSENT - EXTERNAL BULLETIN_MAINCOMMANDS - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - CHARACTER*32 INLINE - - CHARACTER*11 UPTIME_DATE - CHARACTER*8 UPTIME_TIME - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV(ALLOW) ! Check privileges - IF (ALLOW.EQ.0) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - -C -C Delete any expired bulletins (normal or shutdown ones). -C - - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (SHUTDOWN.GT.0) THEN ! Do shutdown bulletins exist? - CALL GET_UPTIME(UPTIME_DATE,UPTIME_TIME) - IER1 = COMPARE_DATE(SHUTDOWN_DATE,UPTIME_DATE) - IF (IER1.EQ.0) IER1 = COMPARE_TIME(SHUTDOWN_TIME,UPTIME_TIME) - IF (IER1.LE.0) SHUTDOWN = 0 - END IF - IF (IER.LE.0.OR.IER1.LE.0) CALL UPDATE ! Need to update - END IF - CALL CLOSE_FILE(2) - -C -C Test for /READ & /LOGIN switches. -C - - CALL LIB$GET_FOREIGN(INLINE) - - IER = CLI$DCL_PARSE('BULLETIN'//INLINE,BULLETIN_MAINCOMMANDS) - - READIT = 0 - IF (CLI$PRESENT('READNEW')) READIT = 1 ! Test for /READ switch. - LOGIT = 0 - IF (CLI$PRESENT('LOGIN')) LOGIT = 1 ! Test for /LOGIN switch. - -C -C Ignore BULLETIN/READ or BULLETIN/LOGIN if this is a batch process. -C - - IF (READIT.GT.0.OR.LOGIT.GT.0) THEN - CALL GETSTS(STS) ! Get process status word - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - END IF - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal -C -C Get page length for the terminal. -C - - CALL GETPAGLEN(PAGE_LENGTH) - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIT.GT.0) THEN ! Is /LOGIN present? - CALL LOGIN(READIT) ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If not /READ, exit program - END IF - -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If /READ switch and no new bulletins, just exit. -C - - CALL UPDATE_READ ! Bulletins added since last read? - IF (BULL_POINT.EQ.-1) THEN ! BULL_POINT would be bulletin # -1 - BULL_POINT = 0 ! Since its -1, no new bulletins - IF (READIT.GT.0) CALL EXIT ! If /READ, just exit - ELSE IF (READIT.EQ.0) THEN ! There are new bulletins - WRITE(6,1000) ! Alert user of the fact - END IF ! if not in /READ mode - - IF (READIT.GT.0) CALL READNEW ! /READ mode. READNEW exits the program - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - - DO WHILE (1) - - IER = CLI$DCL_PARSE(%VAL(0),BULLETIN_SUBCOMMANDS,LIB$GET_INPUT, - & LIB$GET_INPUT,'BULLETIN> ') - - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - DIR_COUNT = 0 ! Reinit dir and read pointers - READ_COUNT = 0 - -80 CALL CLI$GET_VALUE('$VERB',INLINE) ! Get the VERB command - IF (INLINE(1:3).EQ.'ADD') THEN ! ADD bulletin command? - CALL ADD ! Go add bulletin - ELSE IF (INLINE(1:4).EQ.'BACK') THEN ! BACK command? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INLINE(1:4).EQ.'DELE') THEN ! DELETE command? - CALL DELETE ! Go delete bulletin - ELSE IF (INLINE(1:4).EQ.'DIRE') THEN ! DIRECTORY command? - CALL DIRECTORY(DIR_COUNT) ! Get directory of bulletins - ELSE IF (INLINE(1:4).EQ.'EXIT') THEN ! EXIT command? - CALL EXIT ! Exit from program - ELSE IF (INLINE(1:4).EQ.'FILE') THEN ! FILE command? - CALL FILE ! Copy bulletin to file - ELSE IF (INLINE(1:4).EQ.'HELP') THEN ! HELP command? - CALL HELP('BULL.HLB') ! Get help - ELSE IF (INLINE(1:4).EQ.'NEXT') THEN ! NEXT command? - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INLINE(1:4).EQ.'READ') THEN ! READ command? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INLINE(1:4).EQ.'REPL') THEN ! REPLACE command? - CALL REPLACE ! Replace old bulletin - ELSE IF (INLINE(1:3).EQ.'SET') THEN ! SET command? - CALL CLI$GET_VALUE('SET_PARAM1',INLINE) - IF (INLINE(1:4).EQ.'READ') THEN ! SET READNEW? - CALL SET_READNEW(1,1) - ELSE IF (INLINE(1:4).EQ.'NORE') THEN - CALL SET_READNEW(0,1) - END IF - ELSE ! Else bad parameter - WRITE(6,1020) ! Inform user of it - ENDIF - -100 CONTINUE - - END DO - -999 CALL EXIT - -1000 FORMAT(' Type READ to read new bulletins.') -1010 FORMAT(Q,A) -1020 FORMAT(' ERROR: Unknown command. Please retype.') -1060 FORMAT(' ERROR: There are no more bulletins.') - - END - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - CHARACTER*11 INEXDATE,TODAY - CHARACTER*80 INDESCRIP,INPUT - - INTEGER TIMADR(2) - - DIMENSION SETPRV(2) - DATA SETPRV/Z10000000,0/ ! SYSPRV privileges - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway.% -C- - - PARAMETER BRDCST_LIMIT = 82*12 + 2T - CHARACTER*(BRDCST_LIMIT) BROAD0 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLY/ CTRLY - - EXTERNAL CLI$_ABSENTT - EXTERNAL IO$_READVBLK,IO$M_NOECHO,IO$M_PURGEX - - CHARACTER*80 MAILEDIT,INLINE - CHARACTER*32 NODES(10)M - CHARACTER PASSWORD*31,TEMPUSER*12 - - CALL LIB$DISABLE_CTRL(CTRLY,) ! Disable CTRL-Y & -C - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)I - IF (IER.NE.%LOC(CLI$_ABSENT)) THENo - CALL GETPRIV(ALLOW) ! Does user have SETPRV privileges? - IF (ALLOW.EQ.0) THEN ! If not, then remove SYSPRV - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! privileges when trying to - END IF ! create new file.T - OPEN (UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset SYSPRV privilegesU - END IFB - - IER = SYS_TRNLNM('SYS$NET',INLINE,1)B - IF (IER.EQ.SS$_NORMAL) THEN ! Running via DECNET?P - IER = CLI$GET_VALUE('USERNAME',USERNAME) - IF (CLI$GET_VALUE('PASSWORD',PASSWORD).EQ.SS$_NORMAL) THEN - CALL CONFIRM_PRIV(USERNAME,PASSWORD,ALLOW) - END IF - ELSEs - CALL GETPRIV(ALLOW) ! Check privileges - END IFi - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (ALLOW.EQ.0) THEN ! If no privilegesa - WRITE(6,1070) ! Tell user - RETURN ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSEa - SYSTEM = 0 ! Clear system bit - END IFI - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?Y - IF (ALLOW.EQ.0) THEN ! If no privileges! - WRITE(6,1080) ! Tell user - RETURN ! and abort - END IF - END IFK - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (CLI$PRESENT('SHUTDOWN')) THEND - WRITE(6,1083) - RETURN! - ELSE IF (ALLOW.EQ.0) THEN ! If no privileges - WRITE(6,1081) ! Tell user - RETURN ! and abort - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = 'PERMANENT'd - GO TO 8 ! Skip expiration date question - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (CLI$PRESENT('PERMANENT')) THEN - WRITE(6,1083) - RETURNE - ELSE IF (ALLOW.EQ.0) THEN ! If no privilegesA - WRITE(6,1082) ! Tell user - RETURN ! and abort - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bitH - INEXDATE = 'SHUTDOWN' - GO TO 8 ! Skip expiration date questiona - END IF - END IFL - - NODE_NUM = 0 ! Initialize number of nodesi - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - LEN = 0 ! GET_VALUE crashes if LEN<0A - DO WHILE (CLI$GET_VALUE('NODES',NODES(NODE_NUM+1),LEN) - & .EQ.SS$_NORMAL) ! Get the specified nodes - NODE_NUM = NODE_NUM + 1 - IF (NODES(NODE_NUM)(LEN-1:LEN).EQ.'::') THEN ! Remove :: ifi - LEN = LEN - 2 ! added - END IF. - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:LEN)//'""::'// - & '"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED',T - & CARRIAGECONTROL='NONE',TYPE='NEW',ERR=940) - END DO - END IFa - -5 IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - WRITE(6,1030) TODAY ! Prompt for expiration dateY - CALL GET_LINE(INEXDATE,LEN) ! Get input line - IF (LEN.LE.0) GO TO 910 - DECODE(LEN,'(I)',INEXDATE,IOSTAT=IER) NDAYS ! Is it # days? - IF (IER.EQ.0) THEN ! If so, - IF (NDAYS.LE.0) THEN ! Is # days not in future - WRITE(6,1045) ! tell user - GO TO 5 ! and re-request datee - ELSE - CALL GET_EXDATE(INEXDATE,NDAYS) ! Get expiration date - END IF - END IFw - IF (INEXDATE(2:2).EQ.'-') INEXDATE = '0'//INEXDATEo - CALL STR$UPCASE(INEXDATE,INEXDATE) ! Convert to upper for BINTIMd - IER = SYS$BINTIM(INEXDATE,TIMADR(1)) ! Is real date?L - IF (IER.NE.1) THEN ! If not, -7 WRITE(6,1040) ! tell user input is wrong - GO TO 5 ! and re-request date - END IFx - IER = SYS$ASCTIM(,INEXDATE,TIMADR(1),)a - IER = COMPARE_DATE(INEXDATE,TODAY) ! Compare date with today'sE - IF (IER.LE.0) THEN ! If expiration date not futureA - WRITE(6,1045) ! tell usere - GO TO 5 ! and re-request date - END IFo - -8 WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910b - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user, - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fitB - GO TO 8 ! and re-request header - END IF - -CG -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.P -C0 - ! - ICOUNT = 0 ! Line count for bulletin - - IF (CLI$PRESENT('EDIT')) THEN ! If /EDIT specified, then - LEN = 0I - IER = LIB$SYS_TRNLOG('MAIL$EDIT',LEN,MAILEDIT) - IF (IER.NE.SS$_NORMAL) MAILEDIT = 'SYS$SYSTEM:MAILEDIT'U - IF (LEN_P.EQ.0) THEN ! If no file param specifiedG - CALL LIB$SPAWN('$@'//MAILEDIT//' "" SYS$LOGIN:BULL.SCR')E - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')d - LEN_P = 1 - ELSE - CLOSE (UNIT=3)A - CALL LIB$SPAWN('$@'//MAILEDIT//' '//BULL_PARAMETER(1:LEN_P) - & //' SYS$LOGIN:BULL.SCR')e - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',I - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IFT - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,2000,END=10) ! get record countE - ICOUNT = ICOUNT + 1 - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Sratch file to save bulletino - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 81 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,LEN) ! Get input linen - IF (LEN.GE.0) THEN ! If good input line enteredP - ICOUNT = ICOUNT + 1 ! Increment record count - WRITE(3,2010) INPUT(1:LEN) ! Save line in scratch filed - END IFR - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out( -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outE - ENDIF - - REWIND (UNIT=3) - - IF (NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN'I - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/BELL'Q - - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO)+%LOC(IO$M_PURGE)! - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - WRITE (6,'('' Enter username at node '',A)') NODES(POINT_NODE)R - WRITE (6,'('' Hit RETURN to use username of local node.'')')A - READ (5,'(Q,A)',ERR=910,END=910) LEN,TEMPUSER - IF (INLINE.NE.'ADD'.OR.LEN.GT.0) THEN - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10)l - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,,T - & %VAL(%LOC(PASSWORD)),%VAL(31),,,,)A - INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/PASSWORD=' - & //PASSWORD(1:STR$POSITION(PASSWORD,CHAR(13))-1) - END IFA - IF (LEN.EQ.0) TEMPUSER = USERNAME - INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1) - & //'/USERNAME='//TEMPUSERe - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(1:LENDES)T - DO I=1,ICOUNT - READ (3,'(Q,A)') LEN,INPUT - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(1:LEN) - END DOA - WRITE (6,'('' Bulletin successfully sent to node '',A)') - & NODES(POINT_NODE)A - REWIND (UNIT=3) - END DO - END IF$ - -CN -C Add bulletin to bulletin file and directory entry for to directory file.I -CN - - CALL OPEN_FILE(2) ! Prepare to add dir entryR - - DESCRIP=INDESCRIP(1:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration dateT - LENGTH = ICOUNT ! Number of records, - FROM = USERNAME ! Username - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCKe - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0( - - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletiny - - CLOSE (UNIT=1) ! Finished adding bulletin) - - CALL ADD_ENTRY ! Add the new directory entry - - CLOSE (UNIT=2) ! Totally finished with add - -CI -C Broadcast the bulletin if requested.T -CL - - IF (CLI$PRESENT('BROADCAST')) THEN ! Should we broadcast the bull?! - REWIND (UNIT=3) ! Yes, rewind the input file - IF (CLI$PRESENT('BELL')) THEN ! Include BELL in message? - BROAD(1:36) = ! Say who the bulletin is fromN - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROMM - START = 37 ! Start adding next line hereE - ELSE - BROAD(1:34) = ! Say who the bulletin is fromS - & CR//LF//LF//'NEW BULLETIN FROM: '//FROMU - START = 35 ! Start adding next line hereB - END IF - DO I=1,ICOUNT ! Stuff bulletin into string - READ(3,2000) LEN,INPUT ! Read input line - END = START + LEN - 1 + 2 ! Check how long string will beO - IF (END.GT.BRDCST_LIMIT) GO TO 90 ! If too much for string, exitV - BROAD(START:END) = CR//LF//INPUT(1:LEN) ! Else add new input - START = END + 1 ! Reset pointer - END DO -90 CALL SYS$BRDCST(BROAD(1:START-1)//CR,,,) ! Do the BROADCAST - END IFR - - CLOSE (UNIT=3) ! Close the input file - -100 CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -Cy - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO) - RETURNs - -910 WRITE(6,1010)e - CLOSE (UNIT=3,ERR=100)0 - GOTO 100I - -920 WRITE(6,1020) - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset SYSPRV privileges - GOTO 100 - -930 WRITE (6,1025) - CALL CLOSE_FILE(3)T - CLOSE (UNIT=3)N - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - CLOSE (UNIT=3)I - GO TO 100 - -1000 FORMAT (' Enter bulletin: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No bulletin was added.')T -1015 FORMAT (' ERROR: Unable to reach node ',A)T -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add bulletin to bulletin file.') -1030 FORMAT (' Today is ',A11, - &'. Specify when the bulletin should expire:',/,1x, - &'Enter specific date, dd-mmm-yyyy, or number of days from today.') -1040 FORMAT (' ERROR: Invalid date format specified.') -1045 FORMAT (' ERROR: Specified date has already passed.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would beN - & truncated to:') -1070 FORMAT (' ERROR: SETPRV privileges are needed for systemE - & bulletins.')o -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & bulletins.')U -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanentG - & bulletins.')s -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & bulletins.') -1083 FORMAT (' ERROR: Permanent and shutdown cannot be specified - & simultaneously.') -2000 FORMAT(Q,A) -2010 FORMAT(A) -2020 FORMAT(1X,A)M - - END - - - SUBROUTINE DELETE -CB -C SUBROUTINE DELETE -CI -C FUNCTION: Deletes a bulletin entry from the bulletin file. -CR - IMPLICIT INTEGER (A - Z)a - - CHARACTER*107 DIRLINE - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - EXTERNAL CLI$_ABSENTE - - CHARACTER*1 ANSWER - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I)E - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error.r - ELSEp - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IFI - -CR -C Check to see if specified bulletin is present, and if the usert -C is permitted to delete the bulletin.s -Ca - - CALL OPEN_FILE(2) - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?f - WRITE(6,1030) ! If not, then error out5 - GOTO 100 - END IFO - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,e - CALL GETPRIV(ALLOW) ! then see if owner has privileges. - IF (ALLOW.EQ.0) THEN ! If owner doesn't have privileges,T - WRITE(6,1040) ! Then error out.( - GO TO 100 - ELSE - CALL CLOSE_FILE (2) - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWERi - CALL STR$UPCASE(ANSWER,ANSWER)n - IF (ANSWER.NE.'Y') GO TO 100n - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?I - WRITE(6,1030) ! If not, then error out. - GOTO 100 - END IFE - END IF - END IF( - -C. -C Delete the bulletin from the bulletin file. -CC - - CALL OPEN_FILE(1) ! Open BULLETIN file - - CALL COPY_BULL(1,BLOCK+LENGTH,BLOCK,IER)! Delete the bulletin byL - ! overwriting rest of file - - CLOSE (UNIT=1)E - -C -C Delete the bulletin directory entry.( -CT - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry: - - TRUNC_SIZE = (NBLOCK*80)/512 + 1 ! Truncate bulletin file - CALL TRUNCATE_FILE(TRUNC_SIZE) ! To remove extra space - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF1 - - CALL UPDATE ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - -100 CALL CLOSE_FILE(2) -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020)E - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any bulletin.') -1020 FORMAT(' ERROR: Specified bulletin number has incorrect format.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' ERROR: Specified bulletin is not owned by you.') -1050 FORMAT(' Bulletin is not owned by you.',T - & ' Are you sure you want to delete it? ',$) - -2000 FORMAT(A107)c - - END - - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -Cr -C SUBROUTINE DIRECTORYR -C -C FUNCTION: Display directory of bulletins. -Ce - IMPLICIT INTEGER (A - Z)F - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH - - DATA SCRATCH_D1/0/I - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenD - - IF (DIR_COUNT.GT.0) GO TO 50 ! Skip init steps if this isE - ! not the 1st page of directoryM - -C -C Directory listing is first buffered into temporary memory storage before( -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen,( -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.( -CM - - IF (SCRATCH_D1.EQ.0) THEN ! Is queue empty?, - CALL LIB$GET_VM(100,SCRATCH_D) ! If so, allocated memory - CALL MAKE_CHAR(%VAL(SCRATCH_D),88) ! Form a character string - SCRATCH_D1 = SCRATCH_D ! Init header pointer' - ELSE ! Else queue is not emptyE - SCRATCH_D = SCRATCH_D1 ! so reinit queue pointer. - END IF ! to the header. - - CALL OPEN_FILE_SHARED(2) ! Get directory fileD - - CALL READDIR(0,IER) ! Does directory header exist?R - IF (IER.EQ.1) THEN ! If so, there are bulletins - DO I=1,NBULL ! Copy all bulletins from file - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_DIR(%VAL(SCRATCH_D),SCRATCH_D) - END DO - END IFD - - CALL CLOSE_FILE(2) ! We don't need file anymore - -CN -C Directory entries are now in queue. Output queue entries to screen.U -Ce - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - DIR_COUNT = 1 ! Init directory number counteri - -50 DISPLAY = MIN(NBULL-DIR_COUNT+1,PAGE_LENGTH-6) - ! If more entries then page size, truncate output - WRITE(6,1000) ! Write header - DO I=DIR_COUNT,DIR_COUNT+DISPLAY-1 - CALL READ_DIR(%VAL(SCRATCH_D),SCRATCH_D) ! Get entry from queue - WRITE(6,2010) I,DESCRIP,FROM,DATE(1:7)//DATE(10:11)R - END DOh - - DIR_COUNT = DIR_COUNT + DISPLAY ! Update directory counter - - IF (DIR_COUNT.GT.NBULL) THEN ! Outputted all entries? - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IFB - - RETURNe - -1000 FORMAT(' #',1X,'DESCRIPTION',43X,'FROM',9X,'DATE',/)T -1010 FORMAT(1X,/,' Press RETURN for more...',/)( - -2000 FORMAT(A53,A12,A11) -2010 FORMAT(1X,I3,1X,A53,1X,A12,1X,A9) - - END - l - - SUBROUTINE FILE -C -C SUBROUTINE FILE -CS -C FUNCTION: Copies a bulletin to a file. -CL - IMPLICIT INTEGER (A - Z) - CHARACTER*107 DIRLINE - CHARACTER*80 INPUTd - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT3 - - DIMENSION SETPRV(2) - DATA SETPRV/Z10000000,0/ ! SYSPRV privileges - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)! - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specifiedr - WRITE(6,1020) ! Write error - RETURN ! And returno - END IFr - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read) - WRITE(6,1010) ! Write error - RETURN ! And returnt - END IFN - - CALL OPEN_FILE_SHARED(2)R - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinT - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030)T - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IFs - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - CALL GETPRIV(ALLOW) ! Does user have SETPRV privileges?r - IF (ALLOW.EQ.0) THEN ! If not, then remove SYSPRV - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! privileges when trying toS - END IF ! create new file. - - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset SYSPRV privileges - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATER - END IFd - - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - READ(1'I,2010,ERR=100) INPUT - CALL STR$TRIM(INPUT,INPUT,LEN) - WRITE(3,2010) INPUT(1:LEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed' - - WRITE(6,1040) BULL_POINT,BULL_PARAMETER(1:LEN_P)R - ! Show name of file created.i -100 CALL CLOSE_FILE(1) - RETURNr - -900 WRITE(6,1000)E - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset BYPASS privileges - GO TO 100 - -1000 FORMAT(' ERROR: Error in opening file.')f -1010 FORMAT(' ERROR: You have not read any bulletin.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' Bulletin ',I3,' written to ',A)2 -1050 FORMAT('DESCRIPTION: ',A53) -1060 FORMAT('FROM: ',A12,' DATE: ',A11,/)' - -2000 FORMAT(A107)R -2010 FORMAT(A) - - END - - - - - SUBROUTINE LOGIN(READIT)l -Ce -C SUBROUTINE LOGIN( -C) -C FUNCTION: Alerts user of new bulletins upon logging in. -C Also saves latest login time, which is accessed by FINGER. -Cu - IMPLICIT INTEGER (A - Z)t - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'R - - CHARACTER*23 TODAY - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUTM - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /TERM_CHAN/ TERM_CHANN - - CHARACTER BBOARD_DATE*11,BBOARD_TIME*8 - - LOGICAL*1 CTRL_G/7/ - - EXTERNAL IO$_READVBLK,IO$M_NOECHO,IO$M_PURGE - - INCLUDE '($FORIOSDEF)'C - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - -CI -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that bulletins were read.! -Cs - - CALL OPEN_FILE_SHARED(4) ! Open user fileE - -10 READ (4,1000,KEY=' ',IOSTAT=IER) ! Get the headero - & USERNAME,NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME,FLAGS - IF (IER.EQ.FOR$IOS_SPERECLOC) GO TO 10 ! If locked record,try again - IF (IER.EQ.0) UNLOCK 4 ! If no error, unlock read - - CALL GETUSER(USERNAME) ! Get present username - - READ (4,1000,KEY=USERNAME,ERR=20,IOSTAT=IER1) USERNAME, - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,FLAGS - ! Find if there is an entryo - - REWRITE (4,1000) USERNAME,TODAY(1:11),TODAY(13:20), - & READ_DATE,READ_TIME,FLAGS ! Update login dateG - - IF (FLAGS(1).AND.1) READIT = 1h - - GO TO 30. - -20 READ_DATE = ' 5-NOV-1956' ! No entry, so make new one - READ_TIME = '11:05:56' ! Fake a read date. Set to the past.0 - FLAGS(1) = 0 - FLAGS(2) = 0I - WRITE (4,1000,IOSTAT=IER) USERNAME,TODAY(1:11),TODAY(13:20), - & READ_DATE,READ_TIME,FLAGS) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_FILE(4) ! Close the user fileE - CALL EXIT ! Go away... - END IF - CALL CLEANUP_LOGIN ! Good time to delete dead usersd - DIFF = -1 ! Force us to look at the bulletins - -30 IF (IER.EQ.0.AND.(BBOARD_DATE.NE.TODAY(1:11).OR.! Look for BBOARD mailt - & BBOARD_TIME(1:2).NE.TODAY(13:14)) ) THEN ! when hour changes - READ (4,1000,KEY=' ') ! Get the headerR - & USERNAME,NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME,FLAGS - REWRITE (4,1000) ! Rewrite headero - & USERNAME,NEWEST_DATE,NEWEST_TIME,TODAY(1:11),TODAY(13:20),FLAGSr - CALL CLOSE_FILE(4) - CALL BBOARD ! Convert any BBOARD mail to bulletins - ELSEN - CALL CLOSE_FILE(4) - IF (IER.NE.0) CALL EXIT ! If no header, no bulletins - END IFl - IF (IER1.NE.0) GO TO 40 ! Skip date comparison if new entry - -CD -C Compare and see if bulletins have been added since the last time -C that the user has logged in or used the BULLETIN facility. -CU - - DIFF = COMPARE_DATE(LOGIN_DATE,READ_DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,READ_TIME)t - IF (DIFF.LT.0) THEN ! If read bulletins since last login,e - LOGIN_TIME = READ_TIME ! then use the read date to compare - LOGIN_DATE = READ_DATE ! with the latest bulletin date - END IF ! to see if should alert user.A - - DIFF = COMPARE_DATE(LOGIN_DATE,NEWEST_DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,NEWEST_TIME)( - -Cc -C If there are new bulletins, look for them in BULLDIR.DATB -C Save all new entries in the SCRATCH_D file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible.I -CN - -40 IF (DIFF.LE.0) THEN ! Are there new unread bulletins?C - CALL OPEN_FILE_SHARED(2) ! Yes, so go get bulletin directory - NEW_BULLS = 0 ! Number of new bulletins - NSYS = 0 ! Number of system bulletins - CALL READDIR(0,IER) ! Get header info - CALL LIB$GET_VM(100,SCRATCH_D) - CALL MAKE_CHAR(%VAL(SCRATCH_D),88) - SCRATCH_D1 = SCRATCH_D - DO ICOUNT = NBULL,1,-1 - CALL READDIR(ICOUNT,IER)u - IF (IER1.EQ.0) THEN ! Is this a totally new user? - ! No. Is bulletin system or from same user?t - DIFF = COMPARE_DATE(LOGIN_DATE,DATE) ! No, so compare date - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,TIME)e - IF (DIFF.GT.0) GO TO 100D - IF (USERNAME.NE.FROM.OR.SYSTEM) THENL - IF (DIFF.LE.0) THEN ! Is bulletin new? - CALL WRITE_DIR(%VAL(SCRATCH_D),SCRATCH_D) - NEW_BULLS = NEW_BULLS + 1 ! Yep, so save itn - IF (SYSTEM) NSYS = NSYS + 1e - END IF - END IF - ELSE ! Totally new user, save all bulletins - CALL WRITE_DIR(%VAL(SCRATCH_D),SCRATCH_D) - NEW_BULLS = NEW_BULLS + 1 - IF (SYSTEM) NSYS = NSYS + 1 - END IFR - END DO -100 CALL CLOSE_FILE(2)a - -Cl -C Review new directory entries. If there are system bulletins, -C copy the system bulletin into SCRATCH_D file BULLSYS.SCR for outputting -C to the terminal. If there are simple bulletins, just output thet -C header information. -C - - IF (NEW_BULLS.EQ.0) CALL EXIT - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO)+%LOC(IO$M_PURGE)n - PAGE = 0 - NEW_BULLS = NEW_BULLS - NSYS - IF (NSYS.GT.0) THEN ! Are there any system bulletins? - WRITE (6,1026) CTRL_G ! Yep...e - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bullsI - CALL OPEN_FILE_SHARED(1) - CALL LIB$GET_VM(92,SCRATCH_B) - CALL MAKE_CHAR(%VAL(SCRATCH_B),80)0 - SCRATCH_B1 = SCRATCH_BE - SCRATCH_D = SCRATCH_D1T - DO WHILE (NSYS.GT.0) ! Find which new bulls are systemC - CALL READ_DIR(%VAL(SCRATCH_D),SCRATCH_D) - IF (SYSTEM) THEN ! If it is a system bulletin - INPUT = ' ' - CALL WRITE_BULL(%VAL(SCRATCH_B),SCRATCH_B) - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy the bulletin to SCRATCH_D - READ(1'I,1050,ERR=999) INPUT - CALL WRITE_BULL(%VAL(SCRATCH_B),SCRATCH_B)M - END DO - NSYS = NSYS - 1 ! Decrement system bulletin count - END IFE - END DOH - CALL CLOSE_FILE(1) - PAGE = 1 - SCRATCH_B = SCRATCH_B1e - DO WHILE (SCRATCH_B.NE.0) ! Write out the system bulletinsE - CALL READ_BULL(%VAL(SCRATCH_B),SCRATCH_B) - CALL STR$TRIM(INPUT,INPUT,LEN) - IF (SCRATCH_B.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page5 - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, - & %VAL(%LOC(INREAD)),%VAL(1),,,,) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1065) INPUT(1:LEN) - PAGE = 1 - ELSE - WRITE(6,1060) INPUT(1:LEN) - PAGE = PAGE + 1R - END IFA - END IFL - END DOI -150 WRITE(6,1050) ! Write delimiting blank line - END IF - SCRATCH_D = SCRATCH_D1 - IF (NEW_BULLS.GT.0) THEN ! Are there new non-system bulletins? - IF (PAGE.NE.0) THEN ! Yep..._ - WRITE(6,1080) ! Ask for input to proceed to next page, - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, - & %VAL(%LOC(INREAD)),%VAL(1),,,,)e - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1028) CTRL_G - ELSE - WRITE(6,1027) CTRL_G - END IFL - WRITE(6,1020) - WRITE(6,1025) - PAGE = 3. - DO WHILE (SCRATCH_D.NE.0) - CALL READ_DIR(%VAL(SCRATCH_D),SCRATCH_D) - IF (.NOT.SYSTEM.AND.SCRATCH_D.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next pagel - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,,V - & %VAL(%LOC(INREAD)),%VAL(1),,,,)l - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen( - PAGE = 1 - WRITE(6,1045) DESCRIP,FROM,DATEG - ELSEI - PAGE = PAGE + 1A - WRITE(6,1040) DESCRIP,FROM,DATEE - END IF) - END IFr - END DO - END IF - IF (NEW_BULLS.GT.0.AND.READ_DATE.EQ.' 5-NOV-1956') THEN0 - WRITE (6,1035) ! Tell novice how to read the non-system bulls - ELSE - WRITE(6,1030) - END IF - END IFS - -998 RETURN - -999 CALL CLOSE_FILE(1) ! Just in case bulletins gets deleted - GO TO 998 ! while we are trying to read it (unlikely)L - -1000 FORMAT(A12,A11,A8,A11,A8,2A4) -1005 FORMAT(A53,A12,A11,A8,A4,A11,A4)L -1020 FORMAT(' DESCRIPTION',43X,'FROM',9X,'DATE') -1025 FORMAT(' -----------',43X,'----',9X,'----') -1026 FORMAT(' ',33('*'),'SYSTEM NOTICES',33('*'),A1) -1027 FORMAT(' ',33('*'),'NEW BULLETINS',34('*'),A1)e -1028 FORMAT('+',33('*'),'NEW BULLETINS',34('*'),A1) -1030 FORMAT(' ',80('*')) -1035 FORMAT(' ',14('*'), - & 'USE THE BULLETIN COMMAND TO READ THE ABOVE BULLETINS',14('*')) -1040 FORMAT(' ',A53,1X,A12,1X,A11) -1045 FORMAT(' ',A53,1X,A12,1X,A11) -1050 FORMAT(A) -1060 FORMAT(1X,A)A -1065 FORMAT('+',A) -1070 FORMAT(' ERROR: Cannot add new entry to BULLETIN user file.') -1080 FORMAT(' ',/,' HIT any key for next page....') - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ -CA -C FUNCTION: Reads a specified bulletin. -C' - IMPLICIT INTEGER (A - Z)R - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUTR - - COMMON /READIT/ READITA - - COMMON /PAGE/ PAGE_LENGTH - - DATA SCRATCH_B1/0/_ - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen$ - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this isr - ! not first page of bulletin - - IF (BULL_READ.GT.0) THEN ! Valid bulletin number?r - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - CALL CLOSE_FILE(2) - ELSEo - IER = 0E - END IFE - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 900 - END IF - - BULL_POINT = BULL_READ ! Update bulletin counterL - - WRITE(6,1040) BULL_POINT ! Output bulletin header info - WRITE(6,1050) DESCRIP - WRITE(6,1060) FROM,DATE,EXDATEI - - END = 4 ! Outputted 4 lines to screen - - READ_COUNT = BLOCK ! Init bulletin record counter - -CA -C Each page of the bulletin is buffered into temporary memory storage befored -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory= -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -Ce - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?l - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headC - ELSE ! Else if queue is empty - CALL LIB$GET_VM(92,SCRATCH_B) ! Allocate first recordl - CALL MAKE_CHAR(%VAL(SCRATCH_B),80) ! Form into character stringo - SCRATCH_B1 = SCRATCH_B ! Init header pointerA - END IF - -100 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header) - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = MIN(LENGTH,PAGE_LENGTH-END-4) ! Figure how much can output - CALL OPEN_FILE_SHARED(1) ! Get bulletin file - DO I=READ_COUNT,READ_COUNT+DISPLAY-1 ! Get page full from bulletin - READ(1'I,2000,IOSTAT=IER) INPUT ! Read bulletin record - IF (IER.NE.0) GO TO 105 - CALL WRITE_BULL(%VAL(SCRATCH_B),SCRATCH_B) ! Save record in queue - END DOp - GO TO 107 - -105 DISPLAY = I - READ_COUNT ! If read error, output only this muche - LENGTH = DISPLAY ! This forces the bulletin read to ends - -107 CALL CLOSE_FILE(1) ! End of bulletin file read - -CD -C Bulletin page is now in temporary memory, so output to terminal.I -C Note that if this is a /READ, the first line will have problems withO -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must0 -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -CH - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=READ_COUNT,READ_COUNT+DISPLAY-1 ! Output page to terminale - CALL READ_BULL(%VAL(SCRATCH_B),SCRATCH_B) ! Get the queue record - CALL STR$TRIM(INPUT,INPUT,LEN) ! Strip leading blanks - IF (I.EQ.READ_COUNT.AND.I.NE.BLOCK.AND.READIT.GT.0) THEN - WRITE(6,2020) INPUT(1:LEN) ! (See above comments) - ELSE - WRITE(6,2010) INPUT(1:LEN)8 - END IF - END DOS - -110 READ_COUNT = READ_COUNT + DISPLAY ! Update bull record counter - - LENGTH = LENGTH - DISPLAY ! Length of remaining records - IF (LENGTH.EQ.0) THEN ! If no more recordst - READ_COUNT = 0 ! init bulletin record counter, - ELSE IF (READIT.EQ.0) THEN ! Else if this is not /READ - WRITE(6,1070) ! say there is more of bulletin - END IFE - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any bulletin.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT('+BULLETIN NUMBER: ',I3) -1050 FORMAT(' DESCRIPTION: ',A53)D -1060 FORMAT(' FROM: ',A12,' DATE: ',A11,' EXPIRES: ',A11,/)b -1070 FORMAT(1X,/,' Press RETURN for more...',/)C - -2000 FORMAT(A) -2010 FORMAT(1X,A) -2020 FORMAT('+',A) - - END - - - - - SUBROUTINE READNEW -C -C SUBROUTINE READNEW -Cl -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -Ct - - IMPLICIT INTEGER (A-Z)f - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TERM_CHAN/ TERM_CHANE - - EXTERNAL IO$_READVBLK,IO$M_NOECHO,IO$M_PURGEN - - CHARACTER*1 INREADn - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin paramter' - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO)+%LOC(IO$M_PURGE) - WRITE(6,1000) ! Ask if want to read new bulletins - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, ! Use QIOsL - & %VAL(%LOC(INREAD)),%VAL(1),,,,) ! So no prompt is needed - CALL STR$UPCASE(INREAD,INREAD) ! Make input upper case - IF (INREAD.EQ.'N') CALL EXIT ! If NO, exit - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletinR - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed?D - CALL OPEN_FILE_SHARED(2) ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no new bulls, exit. - CALL CLOSE_FILE(2) - IF (INREAD.EQ.'N') WRITE (6,1010) - CALL EXIT - ELSE IF (SYSTEM) THEN ! If bull is system - BULL_POINT = BULL_POINT + 1 ! If so, just skip it.$ - GO TO 10! - END IF - CALL CLOSE_FILE(2) - END IFU - - IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030)E - END IF5 - - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, ! Use QIOsF - & %VAL(%LOC(INREAD)),%VAL(1),,,,) ! So no prompt is needed - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case. - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - CALL EXIT - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN, - ! If NEXT and last bulletins not finishede - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_FILE_SHARED(2) ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin. - CALL CLOSE_FILE(2) ! Exit - WRITE(6,1010) - CALL EXIT - ELSE IF (SYSTEM) THEN ! Else if NEXT bulletin SYSTEMH - BULL_POINT = BULL_POINT + 1 ! Skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_FILE(2) - END IFE - GO TO 5 - -1000 FORMAT(' Read new bulletins? Type N(No) or any otherO - & key for yes',$) -1010 FORMAT(' No more messages.')E -1020 FORMAT(1X,80('-'),/,' Type Q(Quit) or any other key for - & next message.',$) -1030 FORMAT(1X,80('-'),/,' Type Q(Quit), N(Next message), or - & any other key for MORE... ',$)D - - END - - - - - SUBROUTINE REPLACE -CD -C SUBROUTINE REPLACEF -CE -C FUNCTION: Replaces existing bulletin to bulletin file.W -CE - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'l - - CHARACTER*11 INEXDATE - CHARACTER*80 INDESCRIP,INPUTe - CHARACTER*1 ANSWER1 - - INTEGER TIMADR(2) - - COMMON /TERM_CHAN/ TERM_CHAN, - - COMMON /CTRLY/ CTRLYI - - EXTERNAL CLI$_ABSENTE - - DIMENSION SETPRV(2) - DATA SETPRV/Z10000000,0/ ! SYSPRV privileges - - LOGICAL*1 DOALL - -C( -C Get the bulletin number to be replaced. -CS - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the errorI - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are readingA - ELSEA - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)e - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF - -Cp -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -Cs - - CALL OPEN_FILE_SHARED(2)I - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletinU - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person/ - GOTO 100 ! and error out - END IFC - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,u - CALL GETPRIV(ALLOW) ! then see if owner has privileges. - IF (ALLOW.EQ.0) THEN ! If owner doesn't have privileges,B - WRITE(6,1090) ! Then error out.b - GO TO 100 - ELSE - CALL CLOSE_FILE(2) ! Let go of the file - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') GO TO 100 ! If not Yes, then exitl - END IF - END IFI - - CALL CLOSE_FILE(2)! - -Cu -C If no switches were given, replace the full bulletin1 -C) - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND.d - & (.NOT.CLI$PRESENT('TEXT'))) THEN - DOALL = .TRUE. - END IFe - - CALL LIB$DISABLE_CTRL(CTRLY,) ! Disable CTRL-Y & -C - -5 IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - WRITE(6,1030) ! Prompt for expiration date - READ(5,2000,END=910,ERR=7) LEN,INEXDATEh - CALL STR$UPCASE(INEXDATE,INEXDATE) ! Convert to upper for BINTIM - IF (LEN.EQ.0) GO TO 910e - IER = SYS$BINTIM(INEXDATE,TIMADR(1)) ! Is date format valid? - IF ((IER.AND.1).NE.1) THEN ! If not, -7 WRITE(6,1040) ! tell usere - GO TO 5 ! and re-request date - END IF - IER = SYS$ASCTIM(,INEXDATE,TIMADR(1),) - IER = COMPARE_DATE(INEXDATE,' ') ! Compare date with today's - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - GO TO 5 ! and re-request date - END IF - END IFC - -8 IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,2000,END=910,ERR=910) LEN,INDESCRIP - IF (LEN.EQ.0) GO TO 910 ! If no header, don't add bull - IF (LEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fit - GO TO 8 ! and re-request headerI - END IF - END IFB - - - IF (CLI$PRESENT('TEXT').OR.DOALL) THENp -CG -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.b -Ce - - ICOUNT = 0 ! Line count for bulletin - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)t - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! If file param in ADD command - - CALL GETPRIV(ALLOW) ! Does user have SETPRV privileges? - IF (ALLOW.EQ.0) THEN ! If not, then remove SYSPRV - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! privileges when trying to - END IF ! create new file. - - OPEN (UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset SYSPRV privilegesH - - DO WHILE(1) ! Read until end of file to - READ (3,2000,END=10) ! get record countg - ICOUNT = ICOUNT + 1 - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 81 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more inputT - CALL GET_LINE(INPUT,LEN) ! Get input liner - IF (LEN.GE.0) THEN ! If good input line enteredo - ICOUNT = ICOUNT + 1 ! Increment record count - WRITE(3,2010) INPUT(1:LEN) ! Save line in scratch fileE - END IFE - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - END IFa - -Ct -C Add bulletin to bulletin file and directory entry for to directory file.n -C) - - CALL OPEN_FILE(2) ! Prepare to add dir entry( - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for bulletin - CALL READDIR(0,IER) ! Get directory headere - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN ! If text has been replacedF - CALL OPEN_FILE(1) ! Prepare to add bulletin - IF (ICOUNT.LT.LENGTH) THEN ! If new bulletin smaller... - CALL COPY_BULL(3,1,BLOCK,IER) ! Replace old bulletinI - CALL COPY_BULL(1,BLOCK+LENGTH,BLOCK+ICOUNT,IER) - ! Move up any future bulletins - ELSE IF (ICOUNT.EQ.LENGTH) THEN ! If new bulletin same sizeT - CALL COPY_BULL(3,1,BLOCK,IER) ! Replace old bulletin$ - ELSE ! If new bulletin is larger...0 - IF (NBULL.GT.NUMBER_PARAM) THEN ! If there are future bulletins - DO I=NBLOCK,BLOCK+LENGTH,-1 ! Move future bulletins down - READ (1'I,'(A80)') INPUTl - WRITE (1'I+ICOUNT-LENGTH,'(A80)') INPUTR - END DO - END IFV - CALL COPY_BULL(3,1,BLOCK,IER) ! Replace old bulletin - END IF - - CLOSE (UNIT=1) - - IF (ICOUNT.NE.LENGTH) THEN ! If new bull different size - DIFF = ICOUNT - LENGTH ! Get difference in sizei - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entryD - LENGTH = ICOUNT ! Update size - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - DO I=NUMBER_PARAM+1,NBULL ! Fix sizes of future bulletins- - CALL READDIR(I,IER) - BLOCK = BLOCK + DIFFE - CALL WRITEDIR(I,IER)B - END DOE - NBLOCK = NBLOCK + DIFF ! Update NBLOCK - IF (DIFF.LT.0) THEN ! If bulletin file smaller - TRUNC_SIZE = (NBLOCK*80)/512 + 1 ! Truncate file! - CALL TRUNCATE_FILE(TRUNC_SIZE)L - END IFR - CALL WRITEDIR(0,IER)n - END IF - END IFI - - CALL READDIR(NUMBER_PARAM,IER)n - IF (CLI$PRESENT('HEADER').OR.DOALL) DESCRIP=INDESCRIP(1:53) - ! Update description headerl - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) EXDATE=INEXDATE - ! Update expiration date - CALL WRITEDIR(NUMBER_PARAM,IER) - - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expirationu - IF (DIFF.LT.0) THEN ! If it's the oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - CALL WRITEDIR(0,IER) ! the directory file - END IFo - - CALL CLOSE_FILE(2) ! Totally finished with replaceI - - CLOSE (UNIT=3)E - -100 CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -CO - RETURN) - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100)T - GOTO 100R - -920 WRITE(6,1020) - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Reset SYSPRV privileges - GOTO 100 - -1000 FORMAT (' Enter bulletin: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any bulletin.') -1010 FORMAT (' No bulletin was replaced.') -1015 FORMAT (' ERROR: Specified bulletin was not found.')D -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' Enter expiration date of bulletin: dd-mmm-yyyy') -1040 FORMAT (' ERROR: Invalid date format specified.') -1045 FORMAT (' ERROR: Specified date has already passed.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would ben - & truncated to:') -1090 FORMAT(' ERROR: Specified bulletin is not owned by you.') -1100 FORMAT(' Bulletin is not owned by you.',u - & ' Are you sure you want to replace it? ',$)R -2000 FORMAT(Q,A) -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - - - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -CN -C FUNCTION: Searches for bulletins that have expired and deletes them. -Cl -C NOTE: Assumes directory file is already opened.Z -C - IMPLICIT INTEGER (A - Z)T - CHARACTER*107 DIRLINE - - INCLUDE 'BULLDIR.INC' - - CHARACTER*11 TEMP_DATE/'5-NOV-2000'/ ! Default exp date if no bulls - CHARACTER*11 TEMP_EXDATEA - CHARACTER*8 TEMP_TIME - - NEW_EX = 0 ! Init expiration flagG - - CALL OPEN_FILE(1) ! Open both bulletin filesC - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deletedS - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not founde - IF (SYSTEM.LE.1.OR.(SHUTDOWN.EQ.0 ! If not permanent, or shutdowns - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! bulletin and /SHUT specified? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - DIFF = 0 ! If so, delete it - ELSEA - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed?L - END IFP - IF (DIFF.LE.0) THEN ! If so then delete bulletinf - CALL COPY_BULL(1,BLOCK+LENGTH,BLOCK,IER) ! Delete the bulletin by - ! rewriting rest of file - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - UPDATE_DONE = 1 ! Set bulletin deleted flag - ELSE IF (SYSTEM.LE.1) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latestN - ! expiration date. The following does that.u - IF (DIFF.LT.NEW_EX.OR.NEW_EX.EQ.0) THEN - TEMP_EXDATE = EXDATE ! If this is the latest expd - NEW_EX = DIFF ! date seen so far, save it. - END IF - BULL_ENTRY = BULL_ENTRY + 1 ! Increment bulletin counter - TEMP_DATE = DATE ! Keep date so when we quitd - TEMP_TIME = TIME ! search, we'll have the - END IF ! latest bulletin dateA - ELSE - BULL_ENTRY = BULL_ENTRY + 1 - END IF - END DO' - -100 DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - NEWEST_EXDATE = TEMP_EXDATE - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - CLOSE(UNIT=1) - - IF (UPDATE_DONE.EQ.1) THEN ! If any deletions occurred - TRUNC_SIZE = (NBLOCK*80)/512 + 1 ! truncate bulletin file. - CALL TRUNCATE_FILE(TRUNC_SIZE) - END IFT - - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN( - NEWEST_DATE = TEMP_DATE ! If the newest bulletin date - NEWEST_TIME = TEMP_TIME ! has been changed, it must - CALL UPDATE_LOGIN ! be changed in BULLUSER.DAT - END IFe - - RETURNM - -1000 FORMAT(A11,A11,A8,A4,A4) -1020 FORMAT(A107)I - - END - - - - SUBROUTINE UPDATE_READi -C -C SUBROUTINE UPDATE_READH -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility.e -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin.y -C -C OUTPUTS:E -C BULL_POINT - If -1, no new bulletins to read, else there are.! -Cl - - IMPLICIT INTEGER (A - Z)n - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'H - - CHARACTER*23 TODAY - - INCLUDE '($FORIOSDEF)'i - - BULL_POINT = -1 ! Init bulletin pointerR - -C -C Update user's latest read time in his entry in BULLUSER.DAT.F -CE - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - -10 READ (4,1000,KEY=' ',IOSTAT=IER) ! Get newest bulletin - & USERNAME,NEWEST_DATE,NEWEST_TIME - IF (IER.EQ.FOR$IOS_SPERECLOC) GO TO 10 ! If record locked, retry) - - IF (IER.NE.0) THEN ! If header not present, exito - CALL CLOSE_FILE(4) - RETURN - END IF, - - UNLOCK 4 ! Release header record for other users to read - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - - CALL GETUSER(USERNAME) ! Get users name - - READ (4,1000,KEY=USERNAME,IOSTAT=IER1) USERNAME, ! Find user's - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,FLAGS ! info entry - - IF (IER1.EQ.0) THEN ! If entry found, update it - REWRITE (4,1000) USERNAME,LOGIN_DATE,LOGIN_TIME, - & TODAY(1:11),TODAY(13:20),FLAGS - ELSE ! else create a new entryR - WRITE (4,1000) USERNAME,TODAY(1:11),TODAY(13:20),, - & TODAY(1:11),TODAY(13:20),FLAGS - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - -Ci -C Now see if bulletins have been added since the user's previousA -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -CS - - DIFF = COMPARE_DATE(READ_DATE,NEWEST_DATE)) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(READ_TIME,NEWEST_TIME) - - IF (DIFF.LE.0.OR.IER1.NE.0) THEN ! New bulls or New user? - CALL OPEN_FILE_SHARED(2) ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from headern - IF (IER.EQ.1) THEN ! If header present - DO ICOUNT=1,NBULL ! Get each bulletin to comparer - CALL READDIR(ICOUNT,IER) ! its date with last read date - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user9 - DIFF = COMPARE_DATE(READ_DATE,DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(READ_TIME,TIME)e - IF (DIFF.LE.0.OR.IER1.NE.0) THEN ! If new bull or new user - IF (SYSTEM) THEN ! If system bulletinR - DIFF = COMPARE_DATE(LOGIN_DATE,DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,TIME) - IF (DIFF.LE.0) THEN ! If system bull, make it - BULL_POINT = ICOUNT - 1 ! the first new bull only. - GO TO 100 ! if added since user logged inL - END IF ! else he's read it already.l - ELSEC - BULL_POINT = ICOUNT - 1 ! If not system bull then - GO TO 100 ! make it the new bull - END IF - END IF - END IF - END DO) - END IF - END IFi - -100 CALL CLOSE_FILE(2) ! Its time for this program - RETURN ! to go home...H - -1000 FORMAT(A12,A11,A8,A11,A8,2A4) -1005 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - diff --git a/decus/vax85c/bulletin/netfiles/file3.mai b/decus/vax85c/bulletin/netfiles/file3.mai deleted file mode 100644 index 4fcd953..0000000 --- a/decus/vax85c/bulletin/netfiles/file3.mai +++ /dev/null @@ -1,1436 +0,0 @@ - -From: MAILER 30-OCT-1985 11:01 -To: BINGHAM -Subj: [TCP/IP Mail From: MRL%PFCVAX@ZERMATT] BULLSUBS.FOR - -Return-Path: <@MIT-ZERMATT.ARPA:MRL%MIT-PFC-VAX@MIT-MC.ARPA> -Received: from MIT-ZERMATT.ARPA by ari-hq1.ARPA ; 30 Oct 85 11:00:54 EST -Received: from MIT-PFC-VAX by ZERMATT via CHAOS with CHAOS-MAIL id 15463; Wed 30-Oct-85 10:54:56-EST -Date: 30 Oct 85 10:56:04 EST -From: MRL%PFCVAX@ZERMATT -Sender: MRL@MIT-PFC-VAX -To: BINGHAM@ARI-HQ1@ZERMATT -Subject: BULLSUBS.FOR - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*11 INEXDATE - CHARACTER*80 INDESCRIP,INFROM,INPUT - - COMMON /CTRLY/ CTRLY - - CHARACTER*12 USERNAME - - IF (BBOARD_USER.EQ.'NONE') RETURN ! BBOARD disabled? - - CALL LIB$DISABLE_CTRL(CTRLY,) ! Disable CTRL-Y & -C - -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME) ! Get present username - CALL GETUIC(GROUP,USER) ! Get present uic - IER = SETUSER(BBOARD_USER,USERNAME) ! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - READ(BBOARD_UIC(2:INDEX(BBOARD_UIC,',')-1),'(O)') GROUPB - READ(BBOARD_UIC(INDEX(BBOARD_UIC,',')+1:INDEX(BBOARD_UIC,']')-1) - & ,'(O)') USERB - CALL SETUIC(GROUPB,USERB) ! Set to BBOARD uic - IER = LIB$SPAWN('$@'//BBOARD_COMMAND,'NL:','NL:') - ! Create sequential mail file - CALL SETUSER(USERNAME) ! Reset to original username - CALL SETUIC(GROUP,USER) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_FILE,STATUS='OLD',ERR=100) - -5 LEN = 1 - DO WHILE (LEN.GT.0) - READ (3,'(Q,A)',END=100) LEN,INPUT ! Read next line from mail - IF (INPUT(1:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(1:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - END IF - END DO - - -C -C Add bulletin to bulletin file and directory entry to directory file. -C - -10 CALL OPEN_FILE(2) ! Prepare to add dir entry - - READ (3,'(Q,A)',IOSTAT=IER) LEN,INPUT ! Read first line - IF (IER.NE.0) GO TO 100 ! If end of file, exit - IF (LEN.EQ.1.AND.INPUT(1:1).EQ.CHAR(12)) GO TO 5 - ! If line is just form feed, the message is empty - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - ICOUNT = 0 ! Initialize line count - - SPACE = INDEX(INFROM,' ') - 1 ! Strip off the date - IF (SPACE.GT.0) INFROM = INFROM(1:SPACE)! From the "From:" line - - CALL STR$TRIM(INFROM,INFROM,LEN) ! Get length of From line - IF (LEN.GT.12) THEN ! Is it > allowable username length? - ICOUNT = ICOUNT + 1 ! If so, put From line in bulletin text - WRITE(1'NBLOCK+ICOUNT,'(A80)',ERR=930) 'From: '//INFROM(1:74) - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) - I = 12 ! Trim username to first non-alpha character - DO WHILE (I.GT.1.AND. - & ((INFROM(I:I).GE.'A'.AND.INFROM(I:I).LE.'Z').OR. - & (INFROM(I:I).GE.'a'.AND.INFROM(I:I).LE.'z')) ) - I = I - 1 - END DO - IF (I.GT.1) INFROM = INFROM(1:I-1) - END IF - - CALL STR$TRIM(INDESCRIP,INDESCRIP,LEN) ! Get length of Subj line - IF (LEN.GT.53) THEN ! Is it > allowable subject length? - ICOUNT = ICOUNT + 1 ! If so, put Subj line in bulletin text - WRITE(1'NBLOCK+ICOUNT,'(A80)',ERR=930) 'Subj: '//INDESCRIP(1:74) - I = 53 ! Trim subject to first space - DO WHILE (I.GT.1.AND.INDESCRIP(I:I).NE.' ') - I = I - 1 - END DO - IF (I.GT.1) INDESCRIP = INDESCRIP(1:I-1) - END IF - - DO WHILE (INPUT(1:1).NE.CHAR(12)) ! Move text to bulletin file - ICOUNT = ICOUNT + 1 - WRITE(1'NBLOCK+ICOUNT,'(A80)',ERR=930) INPUT - READ (3,'(A)',END=25) INPUT - END DO - -25 CLOSE (UNIT=1) ! Finished adding bulletin - - DESCRIP = INDESCRIP(1:53) ! Description header - FROM = INFROM(1:53) ! Username - CALL GET_EXDATE(EXDATE,7) ! Expires after a week - LENGTH = ICOUNT ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - -30 CLOSE (UNIT=2) ! Totally finished with add - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_FILE(3) - WRITE (6,1030) - GO TO 100 - -1010 FORMAT (' ERROR: Install BULLETIN with CMKRNL privileges or relink.') -1030 FORMAT (' ERROR: Alert system programmer. BULLETIN file problems.') - - END - - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entries in user file of users that no longer exist. -C - CHARACTER*12 USERNAME - - OPEN (UNIT=7,FILE='SYS$SYSTEM:SYSUAF.DAT',SHARED,STATUS='OLD', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED',READONLY, - & ERR=30) - - READ (4,'(A12)',ERR=20,KEYGE=' ') USERNAME - ! Move pointer to top of file - -5 READ (4,'(A12)',ERR=20) USERNAME ! Get user entry - READ (7,'(A12)',KEY=USERNAME,ERR=10) USERNAME ! See if user exists - GO TO 5 ! If so, get next user entry - -10 DELETE(UNIT=4) ! Delete non-existant user - GO TO 5 ! Go get next user entry - -20 CLOSE (UNIT=7) ! All done... - -30 RETURN - END - - - - - SUBROUTINE CLOSE_FILE(INPUT) -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C -C INPUT: -C INPUT - Unit number of file to close out. (EXCEPT FOR 3) -C 1 = BULLETIN.DAT -C 2 = BULLDIR.DAT -C 3 = Close out both 1 & 2 -C 4 = BULLUSER.DAT -C - - COMMON /CTRLY/ CTRLY - - CALL LIB$ENABLE_CTRL(CTRLY,) ! Re-enable breaks - - IF (INPUT.NE.3) THEN - CLOSE (UNIT=INPUT) - ELSE - CLOSE (UNIT=2) - CLOSE (UNIT=1) - END IF - - RETURN - END - - - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - CHARACTER*80 INPUT - - IF (INLUN.GT.1) THEN - DO I=1,IBLOCK-1 - READ(INLUN,1000) - END DO - END IF - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - DO WHILE (1) - IF (INLUN.EQ.1) THEN - READ(INLUN'ICOUNT,1000,ERR=100) INPUT - ICOUNT = ICOUNT + 1 - ELSE - LEN = 0 - DO WHILE (LEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) LEN,INPUT - IF (LEN.EQ.0) THEN - INPUT(1:) = ' ' - LEN = 1 - ELSE IF (ICHAR(INPUT(LEN:LEN)).EQ.10) THEN - INPUT(LEN-1:LEN-1) = CHAR(32) - INPUT(LEN:LEN) = CHAR(32) - LEN = LEN - 2 - END IF - END DO - END IF - WRITE(1'OCOUNT,1000,IOSTAT=IER,ERR=100) INPUT - OCOUNT = OCOUNT + 1 - END DO - -100 RETURN - -1000 FORMAT(A80) - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - OFFSET = LENGTH - DO I=BULL_ENTRY+1,NBULL - CALL READDIR(I,IER) - BLOCK = BLOCK - OFFSET - CALL WRITEDIR(I-1,IER) - END DO - - DELETE(UNIT=2,REC=NBULL+1) - - CALL READDIR(0,IER) - NBULL = NBULL - 1 - NBLOCK = NBLOCK - OFFSET - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z)R - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12)T - DIMENSION LENGTH(12)C - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP',- - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/1 - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present dateH - - DECODE(2,'(I2)',EXDATE(1:2)) DAY ! Get day5 - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1. - END DOS - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variableA - - DO WHILE (NUM_DAYS.GT.0)8 - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THENT - ! If expiration date exceeds end of monthS - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of monthe - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27R - END IF - END IFA - ELSE ! If expiration date is within the month, - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exitS - END IF - END DOM - - ENCODE(2,'(I2)',EXDATE(1:2)) DAY ! Put day into new dateE - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new dateE - - RETURNE - END - - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT)G -C) -C SUBROUTINE GET_LINE -C0 -C FUNCTION: -C Gets line of input from terminal.N -C( -C OUTPUTS:: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES:P -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/.A -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST.e -Ce - - IMPLICIT INTEGER (A-Z) - LOGICAL*1 DESCRIP(8),DTYPE,CLASSR - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE)) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINEe - COMMON /TERM_CHAN/ TERM_CHANE - - INCLUDE '($RMSDEF)' - - LIMIT = LEN(INPUT) ! Get input line size limitK - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE andI -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -CN - - FLAG = 0 ! Yep, init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOC - & CTRLC_ROUTINE,FLAG,,,,) ! Enable the AST - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limit: - POINTER = 0 ! during input.m - -Cf -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line.( -CR - - IER = LIB$GET_INPUT(DESCRIP) ! Get line from terminal1 - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - IER1 = SYS$CANCEL(%VAL(TERM_CHAN)) ! Cancel CTRL-C AST - IF (IER.NE.RMS$_EOF) THEN ! See if CTRL-Z is in input - LEN_INPUT = MIN(LIMIT,LENGTH) ! Yep. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor, - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DOt - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so' - END IF - ELSE1 - LEN_INPUT = -1 ! If CTRL-C, say so - END IF( - RETURNE - END - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logicalf - CHARACTER*(*) OUTPUT ! byte to character valueI - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT), - RETURN= - END - - SUBROUTINE CTRLC_ROUTINE(FLAG) ! CTRL-C AST routineb - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - FLAG = 1 ! to set flag - RETURNU - END - - - - - - - - - SUBROUTINE GETPAGLEN(PAGE_LENGTH) -C -C SUBROUTINE GETPAGLENb -Co -C FUNCTION: -C Gets page length of the terminal.c -Cy -C OUTPUTS:C -C PAGE_LENGTH - Page length of the terminal. -C - IMPLICIT INTEGER (A-Z)s - PARAMETER DVI$_DEVDEPEND = 'A'X - INTEGER ITMLST(3) - LOGICAL*1 DEVDEPEND(4) - ITMLST(1) = ISHFT(DVI$_DEVDEPEND,16).OR.4 - ITMLST(2) = %LOC(DEVDEPEND(1)) - ITMLST(3) = LEN - ITMLST(4) = 0 - CALL SYS$GETDVIW(,,'TT',ITMLST,,,,) - PAGE_LENGTH = DEVDEPEND(4)' - RETURNn - END - - - - - - - SUBROUTINE GETPRIV(ALLOW) -C) -C SUBROUTINE GETPRIV -Cr -C FUNCTION: -C To check if process has SETPRV capabilities. -C OUTPUTS:L -C ALLOW - Set to 0 if no privileges, set to 1 if privileges. -CR - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 ITMLST(4) ! Item list for SYS$GETJPI -CA -C ITMLST is the ITEMLIST for the SYS$GETJPI system service. -C It has the following format:F -C ITMLST(1) Top 16 bits = Item code (found in macro $JPIDEF= -C in SYS$LIBRARY:STARTLET.MLB).G -C Bottom 16 bits = length of buffer in bytes to -C receive the device information.= -C ITMLST(2) Address of buffer to receive device information. -C ITMLST(3) Address of buffer to receive the length of the -C information. 0 indicates no such buffer desired. -C ...x -C ITMLST(N) The last longword in an item list must be 0. -CO - DATA ITMLST/4*0/l - PARAMETER JPI$_PROCPRIV='204'X ! Item code to get JPI$_PROCPRIV - PARAMETER PRV$M_SETPRV='4000'X ! Mask for SETPRV privileges - - ITMLST(1) = ISHFT(JPI$_PROCPRIV,16).OR.4 ! Move JPI$_PROCPRIV to uppern - ! word & fill bottom word with # bytes. - ITMLST(2) = %LOC(PROCPRIV) ! PROCPRIV is buffer to receive info.e - - IER = SYS$GETJPIW(,,,ITMLST,,,,) ! Get info - - IF ((PROCPRIV.AND.PRV$M_SETPRV).NE.0) THEN( - ALLOW = 1a - ELSEa - ALLOW = 0T - END IFE - - RETURNS - END - - - - - - - - SUBROUTINE GETUSER(USERNAME) -CI -C SUBROUTINE GETUSERR -C -C FUNCTION: -C To get username of present process.C -C OUTPUTS: -C USERNAME - Username owner of present process. -Ct - - IMPLICIT INTEGER (A-Z)I - - INTEGER*4 ITMLST(4) ! Item list for SYS$GETJPI -C- -C ITMLST is the ITEMLIST for the SYS$GETJPI system service. -C It has the following format:o -C ITMLST(1) Top 16 bits = Item code (found in macro $JPIDEFl -C in SYS$LIBRARY:STARTLET.MLB).T -C Bottom 16 bits = length of buffer in bytes to. -C receive the device information.v -C ITMLST(2) Address of buffer to receive device information. -C ITMLST(3) Address of buffer to receive the length of the -C information. 0 indicates no such buffer desired. -C ... -C ITMLST(N) The last longword in an item list must be 0. -C - DATA ITMLST/4*0/ - PARAMETER JPI$_USERNAME='202'X ! Item code to get JPI$_USERNAME - CHARACTER*(*) USERNAME ! Limit is 12 characters - - ITMLST(1) = ISHFT(JPI$_USERNAME,16).OR.12 ! Move JPI$_USERNAME to upper - ! word & fill bottom word with # bytes. - ITMLST(2) = %LOC(USERNAME) ! USERNAME is buffer to receive info. - - IER = SYS$GETJPIW(,,,ITMLST,,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS:T -C STS - Status word of present process. -CE - - IMPLICIT INTEGER (A-Z)0 - - INTEGER*4 ITMLST(4) ! Item list for SYS$GETJPI -CY -C ITMLST is the ITEMLIST for the SYS$GETJPI system service. -C It has the following format: -C ITMLST(1) Top 16 bits = Item code (found in macro $JPIDEFe -C in SYS$LIBRARY:STARTLET.MLB). -C Bottom 16 bits = length of buffer in bytes to= -C receive the device information.I -C ITMLST(2) Address of buffer to receive device information. -C ITMLST(3) Address of buffer to receive the length of the -C information. 0 indicates no such buffer desired. -C ...R -C ITMLST(N) The last longword in an item list must be 0. -CA - DATA ITMLST/4*0/ - PARAMETER JPI$_STS='305'X ! Item code to get JPI$_USERNAMEt - INTEGER STS - - ITMLST(1) = ISHFT(JPI$_STS,16).OR.4 ! Move JPI$_STS to upperA - ! word & fill bottom word with # bytes. - ITMLST(2) = %LOC(STS) ! STS is buffer to receive info. - - IER = SYS$GETJPIW(,,,ITMLST,,,,) ! Get info - - RETURN, - END - - - - - SUBROUTINE HELP(LIBRARY), - - IMPLICIT INTEGER (A-Z)Y - EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_TOPIC',BULL_PARAMETER,LEN_P)) - - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P)P - & ,LIBRARY,,LIB$GET_INPUT) - - RETURNo - END - - - SUBROUTINE OPEN_FILE(INPUT) - - IMPLICIT INTEGER (A-Z)e - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($FORIOSDEF)' - - EXTERNAL BULLDIR_ERR,BULLETIN_ERR,BULLUSER_ERR, - - PARAMETER TIMEOUT = -10*1000*1000*30I - DIMENSION TIMEBUF(2)P - DATA TIMEBUF /TIMEOUT,-1/ - PARAMETER TIMEEFN = 1 - - COMMON /CTRLY/ CTRLYT - - CALL LIB$DISABLE_CTRL(CTRLY,) ! No breaks while file is openR - - IF (INPUT.EQ.3.OR.INPUT.EQ.2) THEN( - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,) -20 OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='UNKNOWN', - 1 RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',ERR=20,Y - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - END IF - - IF (INPUT.EQ.3.OR.INPUT.EQ.1) THENE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,)N -10 OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='UNKNOWN',r - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=80,e - 1 FORM='FORMATTED',ERR=10) - END IFN - - IF (INPUT.EQ.4) THENh - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR,)e -30 OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN',R - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=58,IOSTAT=IER,C - 1 FORM='FORMATTED',ORGANIZATION='INDEXED', - 1 KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - CALL CONVERT_USERFILE - GO TO 30I - ELSE IF (IER.NE.0) THENh - GO TO 30D - END IF - END IF! - - IER = SYS$CANTIM(,) ! Successful, so cancel timer. - - RETURN - END - - SUBROUTINE TIMER_ERR( - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLYD - - ENTRY BULLDIR_ERR - WRITE (6,'('' ERROR: Unable to open BULLDIR.DAT after 30 seconds.'')')t - GO TO 10d - - ENTRY BULLETIN_ERR - WRITE (6,'('' ERROR: Unable to open BULLETIN.DAT after 30 seconds.'')') - GO TO 10N - - ENTRY BULLUSER_ERRi - WRITE (6,'('' ERROR: Unable to open BULLUSER.DAT after 30 seconds.'')') - GO TO 101 - -10 CALL LIB$ENABLE_CTRL(CTRLY,) ! No breaks while file is open - CALL EXIT - END - - - - SUBROUTINE OPEN_FILE_SHARED(INPUT)A - - INCLUDE '($FORIOSDEF)', - - INCLUDE 'BULLFILES.INC' - - COMMON /CTRLY/ CTRLYn - - CALL LIB$DISABLE_CTRL(CTRLY,) ! No breaks while file is openC - - IF (INPUT.EQ.3.OR.INPUT.EQ.2) THEN2 -20 OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',IOSTAT=IER,P - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 SHARED,READONLY) - - IF (IER.EQ.FOR$IOS_FILNOTFOU) GO TO 100 - IF (IER.NE.0) GO TO 20 - - END IF - - IF (INPUT.EQ.3.OR.INPUT.EQ.1) THEN -10 OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='OLD',C - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=80,R - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.EQ.FOR$IOS_FILNOTFOU) GO TO 100A - IF (IER.NE.0) GO TO 10 - - END IF& - - IF (INPUT.EQ.4) THEN, -30 OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN',u - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=58,IOSTAT=IER,c - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED,i - 1 KEY=(1:12:CHARACTER))t - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - CALL CONVERT_USERFILE - GO TO 30s - ELSE IF (IER.NE.0) THENp - GO TO 30i - END IF - END IFB - - RETURND - -100 CALL OPEN_FILE(INPUT)i - - RETURN - END - - - - SUBROUTINE CONVERT_USERFILE -Cd -C SUBROUTINE CONVERT_USERFILE -CH -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLFILES.INC' - - CHARACTER*58 BUFFER - DIMENSION ZERO(2) - DATA ZERO/2*0/d - -10 OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=50,ERR=10,C - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED,I - 1 KEY=(1:12:CHARACTER))R - - OPEN (UNIT=8,FILE=BULLUSER_FILE,STATUS='NEW', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=58,IOSTAT=IER,u - 1 FORM='FORMATTED',ORGANIZATION='INDEXED', - 1 KEY=(1:12:CHARACTER))T - - DO WHILE (1)- - READ (4,'(A50)',END=20) BUFFER - WRITE (8,'(A50,2A4)') BUFFER,(ZERO(I),I=1,2) - END DOR - -20 CLOSE (UNIT=4) - CLOSE (UNIT=8)N - - RETURN( - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -CT -C SUBROUTINE READDIRh -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -CE -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.M -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS:L -C ICOUNT - The last record read by this routine. -CE - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - O - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - READ (2'1,1000,ERR=999) NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME - ELSEI - READ(2'ICOUNT+1,1010,ERR=999)M - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCKE - END IF - - ICOUNT = ICOUNT + 1 - -999 RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -Ci -C SUBROUTINE WRITEDIR -Ct -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file.e -Cv -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.n -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -Cr - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - M - IF (BULLETIN_NUM.EQ.0) THEN - WRITE (2'1,1000,IOSTAT=IER) NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIMEO - ELSEo - WRITE(2'BULLETIN_NUM+1,1010,IOSTAT=IER)l - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCKR - END IF - - RETURNe - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)T -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - - SUBROUTINE TRUNCATE_FILE(TRUNC_SIZE) - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFILES.INC' - - COMMON /USER_OPEN/ CHANNEL,STATUS,SIZEO - - EXTERNAL USER_OPEN$TRUNCATE - - INCLUDE '($RMSDEF)' - - COMMON /CTRLY/ CTRLYU - - CALL LIB$DISABLE_CTRL(CTRLY,) ! No breaks while file is open - -10 OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=80,INITIALSIZE=TRUNC_SIZE, - 1 FORM='FORMATTED',ERR=20,USEROPEN=USER_OPEN$TRUNCATE) - -15 CLOSE (UNIT=1) - CALL LIB$ENABLE_CTRL(CTRLY,)I - RETURN - -20 IF ((STATUS.AND.1).EQ.1.OR.STATUS.EQ.RMS$_EOF) THEN - GO TO 15 - ELSEt - GO TO 10 - END IFi - - END - - - SUBROUTINE UPDATE_LOGIN -Cb -C SUBROUTINE UPDATE_LOGIN -Ct -C FUNCTION: Updates the login file when a bulletin has been deleted. -Cm - IMPLICIT INTEGER (A - Z)b - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'r - - CHARACTER*12 TEMP_USER. - CHARACTER*11 TEMP_DATE,BBOARD_DATEJ - CHARACTER*8 TEMP_TIME,BBOARD_TIME - - CALL OPEN_FILE(4) - - READ (4,1000,KEY=' ',ERR=10) - & TEMP_USER,TEMP_DATE,TEMP_TIME,BBOARD_DATE,BBOARD_TIMEE - REWRITE (4,1000) - & TEMP_USER,NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME - CLOSE (UNIT=4)u - RETURNe - -10 WRITE (4,1000) ' ',NEWEST_DATE,NEWEST_TIME - CLOSE (UNIT=4)D - RETURN - -1000 FORMAT(A12,A11,A8,A11,A8) - - END - - - S - SUBROUTINE ADD_ENTRYo -Ct -C SUBROUTINE ADD_ENTRYs -Ch -C FUNCTION: Enters a new directory entry in the directory file. -Cr - IMPLICIT INTEGER (A - Z) - I - INCLUDE 'BULLDIR.INC' - I - CHARACTER*23 TODAY_TIME - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:20) - - CALL READDIR(0,IER) - IF (IER.EQ.1) GO TO 206 - -10 NEWEST_EXDATE = DATE - NBULL = 0 - NBLOCK = 0S - SHUTDOWN = 0E - -20 NEWEST_DATE = DATEi - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) NEWEST_EXDATE = EXDATE - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1r - NBLOCK = NBLOCK + LENGTHe - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1i - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL WRITEDIR(0,IER)L - - CALL UPDATE_LOGIN - - CALL WRITEDIR(NBULL,IER) - - RETURNE - END - - - - - S - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2)L -CP -C FUNCTION COMPARE_DATE -C_ -C FUCTION: Compares dates to see which is farther in future.I -CI -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date)U -C OUTPUT: -C Returns the difference in days between the two dates.F -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -CI - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2)T - - CALL SYS$BINTIM(DATE1,USER_TIME)A - CALL LIB$DAY(DAY1,USER_TIME)) - - IF (DATE2.NE.' ') THENU - CALL SYS$BINTIM(DATE2,USER_TIME) - ELSED - CALL SYS$GETTIM(USER_TIME) - END IFT - - CALL LIB$DAY(DAY2,USER_TIME)N - - COMPARE_DATE = DAY1 - DAY2= - - RETURN) - END - - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -CY -C FUNCTION COMPARE_TIME -CF -C FUCTION: Compares times to see which is farther in future.' -CN -C INPUTS: -C TIME1 - First time (hh:mm:ss)I -C TIME2 - Second time -C OUTPUT: -C Outputs 1 if time1 greater in future, outputs -1 if time2E -C greater in future. If exactly the same, output 0. -C - - IMPLICIT INTEGER (A-Z)R - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*8 TIME2_TEMPE - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TIME2_TEMP = TODAY_TIME(13:20) - ELSE - TIME2_TEMP = TIME2 - END IFN - - COMPARE_TIME = 0_ - - DO J=1,7,3 - DO I=J,J+1 - IF (TIME1(I:I).GT.TIME2_TEMP(I:I)) THEN - COMPARE_TIME = 1I - RETURNN - ELSE IF (TIME1(I:I).LT.TIME2_TEMP(I:I)) THENE - COMPARE_TIME = -1 - RETURNI - END IF - END DO - END DOR - - RETURN - END - -C------------------------------------------------------------------------- -C. -C The following are subroutines to create a linked-list queue for b -C temporary buffer storage of data that is read from files to beY -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -CL -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second containsI -C the address. The address is simply the address of the 3rd word of. -C the record. The last word in the record contains the address of the, -C next record. Every time a record is written, if that record has aR -C zero link, it adds a new record for the next write operation. D -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C= -C There are 2 seperate queues. One for directory listings, and one E -C for bulletins reads. The bulletin queue is made of character -C variables of length 80. The directory listings contain character -C variables of length 88. Although BULLETIN does not use all the -C info that is stored, (SYSTEM,BLOCK,LENGTH), that info is used byR -C BULLCHECK.D -CE -C------------------------------------------------------------------------- - - SUBROUTINE WRITE_DIR(RECORD,NEXT) - INTEGER RECORD(1) - CALL WRITE_DIR_CHAR(%VAL(%LOC(RECORD))) - NEXT = RECORD(25) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(100,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),88) - RECORD(25) = NEXT - RETURNE - END - - SUBROUTINE WRITE_DIR_CHAR(SCRATCH) - CHARACTER*(*) SCRATCH - INCLUDE 'BULLDIR.INC' - WRITE(SCRATCH,1035) DESCRIP,FROM,DATE,SYSTEM,BLOCK,LENGTH - RETURNe -1035 FORMAT(A53,A12,A11,A4,A4,A4) - END - - SUBROUTINE READ_DIR(RECORD,NEXT) - INTEGER RECORD(1) - CALL READ_DIR_CHAR(%VAL(%LOC(RECORD)))= - NEXT = RECORD(25) - RETURNU - END - - SUBROUTINE READ_DIR_CHAR(SCRATCH) - CHARACTER*(*) SCRATCH - INCLUDE 'BULLDIR.INC' - READ(SCRATCH,1035) DESCRIP,FROM,DATE,SYSTEM,BLOCK,LENGTH - RETURN) -1035 FORMAT(A53,A12,A11,A4,A4,A4)I - END - - SUBROUTINE WRITE_BULL(RECORD,NEXT)C - INTEGER RECORD(1) - CALL WRITE_BULL_CHAR(%VAL(%LOC(RECORD)))M - NEXT = RECORD(23) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(92,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),80) - RECORD(23) = NEXT - RETURN' - END - - SUBROUTINE WRITE_BULL_CHAR(SCRATCH) - CHARACTER*(*) SCRATCH - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUTN - SCRATCH = INPUT - RETURNN - END - - SUBROUTINE READ_BULL(RECORD,NEXT) - INTEGER RECORD(1) - CALL READ_BULL_CHAR(%VAL(%LOC(RECORD))) - NEXT = RECORD(23) - RETURNf - END - - SUBROUTINE READ_BULL_CHAR(SCRATCH)U - CHARACTER*(*) SCRATCH - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUTe - INPUT = SCRATCH - RETURN, - END - - - SUBROUTINE MAKE_CHAR(IARRAY,LEN). - DIMENSION IARRAY(1) - IARRAY(1) = LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -CN -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -CT - - IMPLICIT INTEGER (A-Z)E - - DIMENSION SETPRV(2) - DATA SETPRV/Z10000000,0/ ! SYSPRV privileges - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE')A - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1i - ELSEv - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0S - END IFh - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable SYSPRV . - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURNL - END - - - - SUBROUTINE GETUIC(GRP,MEM), -CT -C SUBROUTINE GETUIC(UIC)T -CT -C FUNCTION: -C To get UIC of process submitting the job., -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UICC -C, - - IMPLICIT INTEGER (A-Z)E - - INTEGER*4 ITMLST(7) ! Item list for SYS$GETJPI -C, -C ITMLST is the ITEMLIST for the SYS$GETJPI system service. -C It has the following format:N -C ITMLST(1) Top 16 bits = Item code (found in macro $JPIDEFE -C in SYS$LIBRARY:STARTLET.MLB).P -C Bottom 16 bits = length of buffer in bytes toN -C receive the device information.O -C ITMLST(2) Address of buffer to receive device information. -C ITMLST(3) Address of buffer to receive the length of the -C information. 0 indicates no such buffer desired. -C ...I -C ITMLST(N) The last longword in an item list must be 0. -C_ - DATA ITMLST/7*0/5 - PARAMETER JPI$_GRP='308'X ! Item code to get JPI$_GRP - PARAMETER JPI$_MEM='307'X ! Item code to get JPI$_MEM - - ITMLST(1) = ISHFT(JPI$_GRP,16).OR.4 ! Move JPI$_GRP to upperS - ! word & fill bottom word with # bytes. - ITMLST(2)=%LOC(GRP) ! GRP is buffer to receive info. - ITMLST(4) = ISHFT(JPI$_MEM,16).OR.4 ! Move JPI$_MEM to upper - ! word & fill bottom word with # bytes. - ITMLST(5)=%LOC(MEM) ! MEM is buffer to receive info. - - IER = SYS$GETJPIW(,,,ITMLST,,,,) ! Get Info command.L - - RETURN( - END - - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)E -CE -C SUBROUTINE GET_UPTIME -C, -C FUNCTION: Gets time of last reboot. -CT - - IMPLICIT INTEGER (A-Z)_ - - EXTERNAL EXE$GL_ABSTIME - INTEGER UPTIME(2),SYSTIME(2),UPSINCE(2), - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - UPTIME(1) = GET_L_VAL(EXE$GL_ABSTIM) ! Up time (sec) - - CALL LIB$EMUL(10000000,UPTIME,0,UPTIME) ! 64 bit format - CALL SYS$GETTIM(SYSTIME)t - CALL LIB$SUBX(SYSTIME,UPTIME,UPSINCE) - CALL SYS$ASCTIM(,ASCSINCE,UPSINCE,) ! Up since' - - UPTIME_DATE = ASCSINCE(1:11) - UPTIME_TIME = ASCSINCE(13:20) - - RETURN - END - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURNE - END - - - SUBROUTINE SET_READNEW(CMD,TOPIC) -CL -C SUBROUTINE SET_READNEWW -C -C FUNCTION: Sets readnew for specified topic (TOPIC = 1 is general topic).W -C_ -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set readnew. -C If FALSE, clear readnew. -C TOPIC - TOPIC number, corresponding to bit number. -CN - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'E - - LOGICAL CMD - -CR -C Find user entry in BULLUSER.DAT to update information.L -CR - - CALL OPEN_FILE_SHARED(4) ! Open user fileT - - READ (4,1000,KEY=USERNAME) USERNAME, ! Read old entry - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,FLAGSr - - F_POINT = TOPIC/32 + 1: - IF (CMD) THEN - I = IBSET(FLAGS(F_POINT),TOPIC-1)d - ELSEI - I = IBCLR(FLAGS(F_POINT),TOPIC-1)e - END IFT - - REWRITE (4,1000) USERNAME, ! Write modified entryd - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,FLAGSu - - CALL CLOSE_FILE (4) - RETURNt - -1000 FORMAT(A12,A11,A8,A11,A8,2A4) - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,PASSWORD,ALLOW)I -CM -C SUBROUTINE CONFIRM_PRIV -CR -C FUNCTION: Confirms that given username has SETPRV, and that the -C the given password is correct. -C -C INPUTS: -C USERNAME - UsernameG -C PASSWORD - Username's password -C OUTPUTS:( -C ALLOW - Returns 1 if correct password and SETPRV set, -C returns 0 if not.& -CO - - IMPLICIT INTEGER (A-Z)T - - CHARACTER*(*) USERNAME,PASSWORD - - PARAMETER UAF$Q_DEF_PRIV = '1A4'X, UAF$Q_PWD = '154'X - PARAMETER UAF$W_SALT = '166'X, UAF$B_ENCRYPT = '168'X - - PARAMETER PRV$V_SETPRV = 'E'X - - LOGICAL*1 UAF(0:583)E - CHARACTER*(*) SYSUAF) - PARAMETER (SYSUAF = 'SYS$SYSTEM:SYSUAF.DAT')E - EQUIVALENCE (UAF(UAF$B_ENCRYPT), UAF_ENCRYPT) - EQUIVALENCE (UAF(UAF$W_SALT), UAF_SALT) - EQUIVALENCE (UAF(UAF$Q_PWD), UAF_PWD) - EQUIVALENCE (UAF(UAF$Q_DEF_PRIV),UAF_DEF_PRIV)M - CHARACTER UAF_PWD*8,HASH*8_ - - CALL STR$UPCASE(PASSWORD,PASSWORD) ! Password must be upper casee - ALLOW = 0 ! Set return falses - CALL LIB$GET_LUN(LUN) ! Get LUNd - OPEN (UNIT=LUN,FILE=SYSUAF,SHARED,READONLY,ACCESS='KEYED',u - & FORM='UNFORMATTED',TYPE='OLD',ERR=999) ! Open UAFm - READ (LUN,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Record - IF (STATUS.EQ.0) THEN ! If username foundA - IF (BTEST(UAF_DEF_PRIV,PRV$V_SETPRV)) THEN ! System privileges?T - CALL LGI$HPWD(HASH,PASSWORD,%VAL(UAF_ENCRYPT), - & %VAL(UAF_SALT),USERNAME) ! HASH the password_ - IF (HASH.EQ.UAF_PWD) ALLOW = 1 ! Set return true - END IF ! If correct password - END IF - CLOSE (UNIT=LUN) ! Close the LUN -999 CALL LIB$FREE_LUN(LUN) ! Free the LUN - RETURN ! ReturnD - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT,ACCESS)- - - IMPLICIT INTEGER (A-Z)- - - CHARACTER*(*) INPUT,OUTPUTf - - INTEGER ITMLST(4) - - PARAMETER LNM$_STRING = '2'X - - ITMLST(1) = ISHFT(LNM$_STRING,16).OR.LEN(OUTPUT) - ITMLST(2) = %LOC(OUTPUT)t - ITMLST(3) = 0 - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$PROCESS',INPUT,ACCESS,ITMLST) - - RETURN - END - diff --git a/decus/vax85c/bulletin/netfiles/file4.mai b/decus/vax85c/bulletin/netfiles/file4.mai deleted file mode 100644 index 302bf00..0000000 --- a/decus/vax85c/bulletin/netfiles/file4.mai +++ /dev/null @@ -1,209 +0,0 @@ - -From: MAILER 30-OCT-1985 11:01 -To: BINGHAM -Subj: [TCP/IP Mail From: MRL%PFCVAX@ZERMATT] BULLET.COM - -Return-Path: <@MIT-ZERMATT.ARPA:MRL%MIT-PFC-VAX@MIT-MC.ARPA> -Received: from MIT-ZERMATT.ARPA by ari-hq1.ARPA ; 30 Oct 85 11:01:48 EST -Received: from MIT-PFC-VAX by ZERMATT via CHAOS with CHAOS-MAIL id 15465; Wed 30-Oct-85 10:56:15-EST -Date: 30 Oct 85 10:57:21 EST -From: MRL%PFCVAX@ZERMATT -Sender: MRL@MIT-PFC-VAX -To: BINGHAM@ARI-HQ1@ZERMATT -Subject: BULLET.COM - -$open/read input bullet.mai -$open/write output AAAREADME.TXT -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 73 then goto again -$ close output -$open/write output BBOARD.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 5 then goto again -$ close output -$open/write output BULLCOM.CLD -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 36 then goto again -$ close output -$open/write output BULLCOMS.HLP -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 135 then goto again -$ close output -$open/write output BULLDIR.INC -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 8 then goto again -$ close output -$open/write output BULLETIN.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 2 then goto again -$ close output -$open/write output BULLETIN.HLP -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 17 then goto again -$ close output -$open/write output BULLETIN.LNK -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 2 then goto again -$ close output -$open/write output BULLETIN.TXT -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 49 then goto again -$ close output -$open/write output BULLFILES.INC -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 27 then goto again -$ close output -$open/write output BULLFLAG.INC -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 23 then goto again -$ close output -$open/write output BULLMAIN.CLD -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 4 then goto again -$ close output -$open/write output BULLSTART.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 3 then goto again -$ close output -$open/write output BULLUSER.INC -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 8 then goto again -$ close output -$open/write output CLIDEF.MAR -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 3 then goto again -$ close output -$open/write output CREATE.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 10 then goto again -$ close output -$open/write output HPWD.MAR -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 223 then goto again -$ close output -$open/write output INSTALL.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 8 then goto again -$ close output -$open/write output INSTRUCT.TXT -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 6 then goto again -$ close output -$open/write output LOGIN.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 2 then goto again -$ close output -$open/write output SETUIC.MAR -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 54 then goto again -$ close output -$open/write output SETUSER.MAR -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 83 then goto again -$ close output -$open/write output STARTUP.COM -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 10 then goto again -$ close output -$open/write output USEROPEN.MAR -$n = 0 -$again: -$read input input -$write output input -$ n = n + 1 -$ if n .lt. 154 then goto again -$ close output -$ close input - diff --git a/decus/vax85c/bulletin/netfiles/file5.mai b/decus/vax85c/bulletin/netfiles/file5.mai deleted file mode 100644 index ee215d7..0000000 --- a/decus/vax85c/bulletin/netfiles/file5.mai +++ /dev/null @@ -1,960 +0,0 @@ - -From: MAILER 30-OCT-1985 11:03 -To: BINGHAM -Subj: [TCP/IP Mail From: MRL%PFCVAX@ZERMATT] BULLET.MAI - -Return-Path: <@MIT-ZERMATT.ARPA:MRL%MIT-PFC-VAX@MIT-MC.ARPA> -Received: from MIT-ZERMATT.ARPA by ari-hq1.ARPA ; 30 Oct 85 11:02:45 EST -Received: from MIT-PFC-VAX by ZERMATT via CHAOS with CHAOS-MAIL id 15466; Wed 30-Oct-85 10:56:40-EST -Date: 30 Oct 85 10:57:49 EST -From: MRL%PFCVAX@ZERMATT -Sender: MRL@MIT-PFC-VAX -To: BINGHAM@ARI-HQ1@ZERMATT -Subject: BULLET.MAI - -The following are instructions for creating the BULLETIN executable and -installation of the utility. A brief explanation of how the internals -of the BULLETIN utility works can be found in BULLETIN.TXT . None of -the command procedures included here are sophisticated, so it is likely -that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLFILES.INC must first - be modified before this procedure is run. It contains the names of data files - which BULLETIN creates. It also has the username for the BBOARD account. - BBOARD is an option by which mail sent to the specified username will be - converted into bulletins. This allows a user on a different system, which is - connected via a network, to be able to submit a bulletin. This feature can - be disabled if it is not desired by specifying the username NONE. In any - case, you should edit BULLFILES.INC and specify the appropriate device and - directories in which you desire that the files be located. (NOTE: Although - the BBOARD feature can be used over DECNET, a more sophisticated method - is available to easily allow one to add bulletins to other DECNET nodes - with all the features of BULLETIN. See below). - -2) STARTUP.COM - The data files that BULLETIN creates should be owned by a system UIC, - and MUST be protected from users being able to have access them. - STARTUP.COM sets the process UIC to [1,4] (you should change this if - you want something else), sets the WORLD and GROUP protection to NONE, - adds the bulletin found in the file INSTRUCT.TXT (it is added with - /PERMANENT, so it never expires), and then resets the UIC and PROTECTION - to what they were before running the procedure. - INSTRUCT.BUL contains a bulletin with instructions to the users as to - how to use the BULLETIN utility. You may want to modify it. - -3) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. - -4) LOGIN.COM - This contains the comands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new bulletins. If desired, the /READNEW qualifier - can also be added. If there are any new non-system bulletins, this - qualifier creates a prompt asking the user if the non-system - bulletins are to be displayed or not. Normally, only system bulletins - are displayed in full, and only the subjects of the non-system - bulletins are displayed. ( Some systems might have a lot of users - who are not interested in reading the non-system bulletins, in - which case /READNEW should probably not be added. Instead, you could - let users enable this feature by entering the BULLETIN utility and - typing the command SET READNEW ). (NOTE: Since /LOGIN and /READNEW - are system commands, they are not included in the help file). - -5) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM - as a batch job. It simply installs the BULLETIN utility with correct - privileges. - -6) BULLETIN.COM - If one wants the feature of using BULLETIN between DECNET nodes, - this file must be put in each node's DECNET default user's directory - (usually [DECNET]). Once this is done, the /NODE qualifer for the - ADD command can be used. - NOTE: Presently, privileged functions such as /SYSTEM will work - on other nodes only if you have an account on the other node with - the same username, and with appropriate privileges. You will be - prompted for the password for the account on the remote node. However, - due to unknown reasons, the software I have to check the password will - only work for passwords that have been set under V4.x. If the password - was created under V3.x, the program will not work, and you password will - be treated as invalid. -$ SET PROTECT=(W:RWED)/DEFAULT -$ MAIL -READ -EXTRACT/ALL USRD$:[BBOARD]BBOARD.MAI -DELETE/ALL - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL = FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER BELL - QUALIFIER BROADCAST - QUALIFIER EDIT - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER PASSWORD, LABEL=PASSWORD, VALUE(REQUIRED) - QUALIFIER PERMANENT - QUALIFIER SHUTDOWN - QUALIFIER SYSTEM - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE VERB BACK - DEFINE VERB DELETE - PARAMETER P1, LABEL = BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB DIRECTORY - DEFINE VERB EXIT - DEFINE VERB FILE - PARAMETER P1, LABEL = FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - DEFINE VERB HELP - PARAMETER P1, LABEL = HELP_TOPIC, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB NEXT - DEFINE VERB READ - PARAMETER P1, LABEL = BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - DEFINE VERB REPLACE - PARAMETER P1, LABEL = FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION - QUALIFIER HEADER - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER TEXT - DEFINE VERB SET - PARAMETER P1, LABEL = SET_PARAM1, VALUE(REQUIRED), - PROMPT="What" -1 ADD -Adds a bulletin to the bulletin file. A file can be specified which -contains the bulletin. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the bulletin. - -Format - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the bulletin is broadcasted. -2 /BROADCAST -This option is restricted to privileged users. If specified, bulletin -is both saved in the bulletin file and broadcasted to all users logged -in at the time. -2 /EDIT -Determines whether or not the EDT editor is invoked to edit the bulletin -you are sending. -2 /NODES=(nodes[,...]) -Specifies to send the bulletin to other DECNET nodes. The BULLETIN utility -must be installed properly on the other nodes. You will prompted for the -username to use at the other node. If you give a different username than -that of the local node, or if privileged qualifiers are specified, you will -be prompted for the password of your account on the other nodes. At -present, if the password is invalid, the bulletin will be rejected on the -node, but no error message will be displayed on the local node that this -happened. -2 /PERMANENT -This option is restricted to privileged users. If specified, bulletin -will be a permanent bulletin and will never expire. -2 /SHUTDOWN -This option is restricted to privileged users. If specified, bulletin -will be automatically deleted after a computer shutdown has occurred. -2 /SYSTEM -This option is restricted to privileged users. If specified, bulletin -is both saved in the bulletin file and displayed in full as a system -notice when a user logs in. System notices should be as brief as possible -to avoid the possibility that system notices could scroll off the screen. -1 BACK -Displays the bulletin preceding the current bulletin. -1 DELETE -Deletes the specified bulletin. If no bulletin is specified, the currentu -bulletin is deleted. Only the original owner or a privileged user can -delete a bulletin. - -Format - DELETE [bulletin-number] - -The bulletin's relative number is found by the DIRECTORY command.v -1 DIRECTORYP -Lists a summary of the bulletins. The bulletin number, submitter's name,0 -date, and subject of each bulletin is displayed. -1 EXIT -Exits the BULLETIN program. -1 FILE -Copies the current bulletin to the named file. The file-name parametero -is required, and consists of up to 9 alpha-numeric characters in length. - -Format:x - FILE file-name -2 /HEADER - -/[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the s -bulletin is written in the file. The default is to write the header.c -1 Bulletin -The BULLETIN utility permits a user to create a bulletin for reading by -all users. Users are notified upon logging in that new bulletins have -been added, and what the topic of the bulletins are. Actual reading oft -the bulletins is optional. (See the command SET READNEW for info oni -automatic reading.) Bulletins are automatically deleted when theirs -expiration date has passed.I - -1 HELP -To obtain help on any topic, type: - - HELP topic -1 NEXT -Skips to the next bulletin and displays it. This is useful when pagingt -through the bulletins and you encounter a particularly long bulletin -that you would like to skip over.t -1 READ -Displays the specified bulletin. If you do not specify a bulletin, then -the first time you enter the command, the oldest bulletin will beL -displayed. However, if there are new bulletins, the first new bulletino -will be displayed. Each time you enter the command, the next page, or if -there are no more pages, the next bulletin will be displayed. - -Format - READ [bulletin-number] - -The bulletin's relative number is found by the DIRECTORY command.S - -Pressing just performs the same as the READ command.a -1 REPLACEb -Replaces an existing bulletin in the bulletin file. This is for changing -part or all of a bulletin without causing users who have already seen thed -bulletin to be notified of it a second time. If the text of the bulletint -is to be changed, a file can be specified which contains the text. -Otherwise, BULLETIN will prompt for the text. The expiration date and -header can also be changed. If neither /EXPIRATION, /HEADER, nor /TEXTd -are specified, it is assumed the whole bulletin will be replaced.u - -Format - REPLACE [file-name]L -2 /EXPIRATIONY -Specifies that the bulletin expiration date is to be replaced. -2 /HEADERp -Specifies that the bulletin header is to be replaced. -2 /NUMBER=ni -Specifies the bulletin number to be replaced. If this qualifier is -omitted, the bulletin that is presently being read will be replaced. -2 /TEXTo -Specifies that the bulletin text is to be replaced.t -1 SETE -Defines or changes characteristics associated with automatic reading -of bulletins. - -Format:f - - SET option -2 READNEWt -Controls whether you will be prompted upon logging in if you wish to read -new non-system bulletins (if any exist). The default is that you are notn -prompted. (Previously this was done by including the BULLETIN/READNEW -command in one's login command procedure). - - Format:e - - SET [NO]READNEW - COMMON /BULL_DIR/ DESCRIP,FROM,DATE,TIME,BLOCK,LENGTH,EXDATE - & ,NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME,SYSTEM,NBULL,NBLOCKn - & ,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIMEn - CHARACTER*53 DESCRIPy - CHARACTER*12 FROM - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATEp - CHARACTER*8 TIME,NEWEST_TIME,SHUTDOWN_TIME/ - LOGICAL SYSTEMW -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, addingh -and deleting bulletins. Any user can submit a bulletin. Users areu -notified at login time that new bulletins have been added and the topics ofB -those bulletins are displayed. Reading of those bulletins is optional.n -(Use the command SET READNEW while in BULLETIN for setting automatic -reading.) Privileged users can add system bulletins that are displayeda -in full at login time. These bulletins are also saved, and can be readm -by BULLETIN. Bulletins are automatically deleted after a specified -expiration date, or they can manually be deleted by either the submitter -of the bulletin or a privileged user. - -BULLETIN has an interactive help available while using the utility.o - - Format: - - BULLETIN -$ LINK/NOTRACE BULLETIN,HPWD,BULLSUBS,BULLCOM,BULLMAIN,CLIDEF,USEROPEN,SETUSER,SETUIC,-w -SYS$SYSTEM:SYS.STB/SEL -This file describes the general operation of the BULLETIN utility. - -BULLETIN uses 3 files to store its data: BULLETIN.DAT, BULLDIR.DAT, & -BULLUSER.DAT. These files are opened with the shared attribute as much as -possible to allow simultaneous operations on the files. However, when a -bulletin is added or deleted, the file cannot be shared, as this might cause -the file to be corrupted. Because of this problem, files are closed as soon asD -possible so that it may be quickly opened for adding and deleting files. R -During read operations, the information is passed to temporary storage, theL -file is closed, and then the information is sent to the terminal. This avoids aB -possible problem where the terminal output is stopped by the user, therefore -delaying the closing of the file. Also, the use of CTRL-Y & CTRL-C is disabledI -while the file is opened to avoid lockout problems." - -BULLETIN.DAT stores the actual bulletins in a fixed 80 character length file.T -Bulletins are store sequentially datewise. New bulletins are appended to theA -end of the file. When a bulletin is deleted, all the following bulletins are -moved up in the file to remove the gap, and the file is then truncated to -remove the unused space. F - -BULLDIR.DAT is a fixed record length file storing directory entries for each -bulletin in BULLETIN.DAT. Each entry contains the header information, length,d -and starting record position in BULLETIN.DAT. The first line of BULLDIR.DAT isb -a header containing the date of the next expiration that will occur, the date -of the latest sumbitted bulletin, the number of bulletins, and the total sizet -of BULLETIN.DAT. The last two numbers make it easier to add bulletins. Thes -directory entries then follow, again stored sequentially datewise. r - -NOTE: There are several advantages to keeping a seperate directory file versus -storing the header information with the actual bulletin. Obviously, it avoids -having to scan through a large bulletin file just to extract header -information. This operation is done when a DIRECTORY listing is requested int -BULLETIN. More importantly when a login occurs, non-system bulletins just -require that the header information be displayed. Having a file with pointers -to where the bulletin is stored also avoids requiring the software to read all -the previous bulletins in order to arrive at the desired bulletin. The main -disadvantage is the extra time spent on locating the second file. This time -appears to be minimal. In all the software, the convention is to open theu -directory file first, and then if needed to open the bulletin file. Whent -adding and delete files, this becomes important, as files are opened unshared. e -A deadlock might occur if one user opens the bulletin file first while another -user opens the directory file, and then each try to open the alternate file. - -BULLUSER.DAT is a relative indexed file, where the keyword is the username ofs -the user. Each entry contains the latest time that the user logged in, plus -the latest time that the BULLETIN utility was used to read bulletins. A headert -entry with a blank username stores the latest bulletin date. The informationn -in this file is used for checking to see if the user should be alerted to newn -bulletins or not.h -Cd -C THE FIRST 3 FILES ARE FILES CREATED AND USED BY BULLETIN. -C SEE BULLETIN.TXT FOR MORE INFORMATION. SPECIFY THE DEVICE/DIRECTORY -C IN WHICH YOU DESIRE THAT THEY BE KEPT. THE FOURTH FILE IS SIMPLY -C THE MAIL FILE FROM WHICH MESSAGES ARE CONVERTED TO NON-SYSTEM -C BULLETINS (AFTER WHICH THE MAIL IS DELETED.) IF YOU DO NOT WISHi -C THE BBOARD OPTION, CHANGE THE DEFINITION FOR BBOARD TO BE: /'NONE'/.r -C IF IT IS NOT SELECTED, YOU DO NOT HAVE TO MODIFY THE REST OF THEf -C BBOARD VARIABLES. IF IT IS SELECTED, YOU MUST SPECIFY THE UIC -C NUMBER OF THE BBOARD ACCOUNT. YOU MUST ALSO SPECIFY BBOARD_FILE, -C WHICH IS A TEMPORARY FILE WHICH IS USED TO CONVERT THE BBOARD MAILe -C TO A SEQUENTIAL FILE. -CE - COMMON /FILES/ BULLDIR_FILE,BULLETIN_FILE,BULLUSER_FILE,BBOARD_USER - COMMON /FILES/ BBOARD_UIC,BBOARD_FILE,BBOARD_COMMANDS - CHARACTER*80 BULLDIR_FILE /'IML$EXE:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'IML$EXE:BULLETIN.DAT'/ - CHARACTER*80 BULLUSER_FILE /'IML$EXE:BULLUSER.DAT'/ - CHARACTER*12 BBOARD_USER /'BBOARD'/,BBOARD_UIC/'[330,5]'/ - CHARACTER*80 BBOARD_FILE/'USRD$:[BBOARD]BBOARD.MAI'/A -CF -C THE BBOARD.COM IS INCLUDED WITH THE SOURCES AND IS USED IF THE BBOARD -C FEATURE IS DESIRED. IT IS NOT CREATED, SO YOU MUST MOVE IT TO THEc -C DESIRED DIRECTORY. YOU MUST ALSO EDIT IT SO THAT THE FILE SPECIFIEDH -C IN THE 'EXTRACT' LINE MATCHES THE FILE SPECIFIED BY BBOARD_FILE.d -Ct - CHARACTER*80 BBOARD_COMMAND/'IML$EXE:BBOARD.COM'/ - PARAMETER ADD_FLAG = '1'X - PARAMETER BACK_FLAG = '2'Xu - PARAMETER DELETE_FLAG = '4'X - PARAMETER DIRECTORY_FLAG = '8'X - PARAMETER EXIT_FLAG = '10'X - PARAMETER FILE_FLAG = '20'X - PARAMETER HELP_FLAG = '40'X - PARAMETER NEXT_FLAG = '80'X - PARAMETER READ_FLAG = '100'Xn - PARAMETER SYSTEM_FLAG = '200'XE - PARAMETER BROADCAST_FLAG = '400'X - PARAMETER BADSWITCH_FLAG = '800'X - PARAMETER REPLACE_FLAG = '1000'Xt - PARAMETER EXPIRE_FLAG = '2000'X - PARAMETER HEADER_FLAG = '4000'X - PARAMETER TEXT_FLAG = '8000'X - PARAMETER NUMBER_FLAG = '10000'X - PARAMETER SHUTDOWN_FLAG = '20000'Xu - PARAMETER PERMANENT_FLAG = '40000'X - - COMMON /BULLPAR/ FLAGS,BULL_PARAMETER,LEN_P,NUMBER_PARAM - CHARACTER*64 BULL_PARAMETER - INTEGER FLAGS - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETINe - QUALIFIER READNEWb - QUALIFIER LOGINi -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/SHARE/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL). -/EXITt - - COMMON /BULL_USER/ USERNAME,LOGIN_DATE,LOGIN_TIME,READ_DATE,r - & READ_TIME,FLAGSn - CHARACTER*12 USERNAME - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIMEo - DIMENSION FLAGS(2)c - - .LIBRARY /SYS$LIBRARY:LIB.MLB/p - $CLIDEF GLOBALa - .ENDE -$ FORTRAN BULLETIN -$ FORTRAN BULLSUBS -$ MAC CLIDEF -$ MAC HPWD -$ MAC SETUIC -$ MAC SETUSERg -$ MAC USEROPEN -$ SET COMMAND/OBJ BULLCOMs -$ SET COMMAND/OBJ BULLMAIN -$ @BULLETIN.LNKn -.TITLE HPWD - hash user password -.IDENT 'V02-002' - -; This code was gotten by disassembling the AUTHORIZE program. -; It is quite shameful that DEC has not seen fit to providet -; this as a system service.e - -; If you want lots of good comments, see the fiche. - -; e _lib$code:_lib$code+68 - - -; Inputs: PWDDSC -- Addres of password descriptor -; ENCRYPT -- Encryption algorithm index (byte) -; SALT - random number (word)i -; USRDSC - Address of username descriptorf - -; output: OUTDSC -- Address of encrypted output descriptor - -OUTDSC=4 -PWDDSC=OUTDSC+4 -ENCRYPT=PWDDSC+4 -SALT=ENCRYPT+4 -USRDSC=SALT+4t - -.PSECT _LIB$CODE RD,NOWRT,PIC,SHR,BYTE,EXE - -; AUTODIN-II polynomial table used by CRC algorithm -AUTODIN: - .LONG ^X000000000,^X01DB71064,^X03B6E20C8,^X026D930AC,^X076DC4190 - .LONG ^X06B6B51F4,^X04DB26158,^X05005713C,^X0EDB88320,^X0F00F9344 - .LONG ^X0D6D6A3E8,^X0CB61B38C,^X09B64C2B0,^X086D3D2D4,^X0A00AE278 - .LONG ^X0BDBDF21C - -; Purdy polynomial coefficients. Prime, but don't need to be -Purdy_Poly:m -c: - .LONG -83,-1t - .LONG -179,-1 - .LONG -257,-1 - .LONG -323,-1 - .LONG -363,-1 - -.ENTRY LGI$HPWD,^M - MOVAQ @outdsc(AP),R4E - MOVAQ @4(R4),R4 - TSTB encrypt(AP) - BGTRU 10$ - MNEGL #1,R0 - MOVAQ @pwddsc(AP),R1E - CRC autodin,R0,(R1),@4(R1)N - CLRL R1& - MOVQ R0,(R4) - BRB 20$ - -10$: CLRQ (R4)5 - MOVAQ @pwddsc(AP),R3 - BSBB COLLAPSE_R2 - ADDW2 salt(AP),3(R4)E - MOVAQ @usrdsc(AP),R3 - BSBB COLLAPSE_R2 - PUSHAQ (R4)N - CALLS #1,PURDYS - -20$: MOVL #1,R0 - RET - - -COLLAPSE_R2: - MOVZWL (R3),R0 - BEQL 20$ - MOVAL @4(R3),R2 - PUSHR #^M - MOVL R0,R1n -5$: CMPB (R2)+,#32 - BNEQ 7$ - DECL R1 -7$: SOBGTR R0,5$. - MOVL R1,R0 - POPR #^M -10$: BICL3 #-8,R0,R1 - ADDB2 (R2)+,(R4)[R1] - SOBGTR R0,10$ -20$: RSB - -a=59 -n0=1@24-3d -n1=1@24-63 - - -.ENTRY PURDY,^M - MOVQ @4(AP),-(SP) - BSBW PQMOD_R0 - MOVAQ (SP),R4 - MOVAQ PURDY_POLY,R5 - MOVQ (R4),-(SP)d - PUSHL #n1 - BSBB PQEXP_R3a - MOVQ (R4),-(SP)n - PUSHL #n0-n1l - BSBB PQEXP_R3d - MOVQ (R5)+,-(SP) - BSBW PQADD_R0n - BSBW PQMUL_R2 - MOVQ (R5)+,-(SP) - MOVQ (R4),-(SP), - BSBW PQMUL_R2l - MOVQ (R5)+,-(SP) - BSBW PQADD_R0t - MOVQ (R4),-(SP)i - BSBB PQMUL_R2L - MOVQ (R5)+,-(SP) - BSBW PQADD_R0i - MOVQ (R4),-(SP)o - BSBB PQMUL_R2 - MOVQ (R5)+,-(SP) - BSBW PQADD_R0B - BSBW PQADD_R0L - MOVQ (SP)+,@4(AP)T - MOVL #1,R0 - RET - -PQEXP_R3:S - POPR #^M - MOVQ #1,-(SP)p - MOVQ 8+4(SP),-(SP) - TSTL 8+8(SP) - BEQL 30$ -10$: BLBC 8+8(SP),20$ - MOVQ (SP),-(SP) - MOVQ 8+8(SP),-(SP) - BSBB PQMUL_R2i - MOVQ (SP)+,8(SP) - CMPZV #1,#31,8+8(SP),#0 - BEQL 30$ -20$: MOVQ (SP),-(SP)s - BSBB PQMUL_R2 - EXTZV #1,#31,8+8(SP),8+8(SP) - BRB 10$ - -30$: MOVQ 8(SP),8+8+4(SP) - MOVAQ 8+8+4(SP),SP - JMP (R3)s - -u=0m -v=u+4 -y=u+8s -z=y+4o - -PQMOD_R0:b - POPR #^M - CMPL v(SP),#-1 - BLSSU 10$ - CMPL u(SP),#-a - BLSSU 10$ - ADDL2 #a,u(SP)t - ADWC #0,v(SP)m -10$: JMP (R0)L - -PQMUL_R2:s - POPR #^M - MOVL SP,R2 - PUSHL z(R2) - PUSHL v(R2) - BSBB EMULQ - BSBB PQMOD_R0i - BSBB PQLSH_R0e - PUSHL y(R2) - PUSHL v(R2) - BSBB EMULQ - BSBB PQMOD_R0t - PUSHL z(R2) - PUSHL u(R2) - BSBB EMULQ - BSBB PQMOD_R0 - BSBB PQADD_R0e - BSBB PQADD_R0T - BSBB PQLSH_R0 - PUSHL y(R2) - PUSHL u(R2) - BSBB EMULQ - BSBB PQMOD_R0r - BSBB PQADD_R0 - MOVQ (SP)+,Y(R2) - MOVAQ Y(R2),SP - JMP (R1)e - -EMULQ: - EMUL 4(SP),8(SP),#0,-(SP)h - CLRL -(SP) - TSTL 4+8+4(SP) - BGEQ 10$ - ADDL2 4+8+8(SP),(SP) -10$: TSTL 4+8+8(SP) - BGEQ 20$ - ADDL2 4+8+4(SP),(SP)I -20$: ADDL2 (SP)+,4(SP) - MOVQ (SP)+,4(SP) - RSB e - -PQLSH_R0:u -.ENABLE LSBL - POPR #^M - PUSHL v(SP) - PUSHL #aa - BSBB EMULQ - ASHQ #32,Y(SP),Y(SP) - BRB 10$ - -PQADD_R0:e - POPR #^M -10$: ADDL2 u(SP),y(SP) - ADWC v(SP),z(SP) - BLSSU 20$ - CMPL z(SP),#-1 - BLSSU 30$ - CMPL y(SP),#-a - BLSSU 30$ -20$: ADDL2 #a,y(SP)a - ADWC #0,z(SP) -30$: MOVAQ Y(SP),SPa - JMP (R0)m -.END -$ COPY BULLETIN.EXE SYS$SYSTEM:i -$ SET FILE SYS$SYSTEM:BULLETIN.EXE/OWN=[1,4] -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/SHARE/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL)y -/EXITe -$ LIB/CREATE/HELP SYS$HELP:BULLi -$ LIB/HELP SYS$HELP:BULL BULLCOMSu -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. System messages, such as thisn -one, are displayed in full. Only topics will be displayed for non-systemt -messages. Messages are submitted using the BULLETIN command. Any user maye -submit a non-system message. Only privileged users can submit a systemi -message. For more information, see the on-line help (via HELP BULLETIN). x -$ BULL*ETIN :== $SYS$SYSTEM:BULLETIN -$ BULLETIN/LOGIN -;e -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO)e -;h -; Author: M. R. London -; -; Date: May 31, 1983t -;b -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -;m -; Usage:i -; status = SETUIC(group number, user number) -;o -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group numberi -; user number - longword containing UIC user numberh -;s -; NOTES:n -; Must link with SS:SYS.STBt -; - - .Title SETUIC Set uic - .IDENT /830531/ -;t -; Libraries:l -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/a -;t -; Global variables: -;n - $PCBDEF -;e -; Executable: -;t - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable codee - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error coden - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel modeF -5$: RETA -10$: .WORD ^M<> ; Entry maskS - MOVL SCH$GL_CURPCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - .ENDT -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO)A -;T -; Author: M. R. London[ -;A -; Date: Jan 26, 1983 -;E -; Purpose: To set the Username of the current process (which turns outA -; to be the process running this program.) -;T -; Usage: -; status = SETUSER(username) -;M -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing usernameI -;d -; NOTES:A -; Must link with SS:SYS.STBX -;B - - .Title SETUSER Set uicF - .IDENT /830531/ -;R -; Libraries:' -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/P -;M -; Global variables: -;X - $PCBDEF - $JIBDEF -;= -; local variables:L -;L - - .PSECT SETUSER_DATA,NOEXEG - -NEWUSE: .BLKB 12 ; Contains new usernameT -OLDUSE: .BLKB 12 ; Contains old usernameG -;' -; Executable: -;B - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, changeS - MOVL #2,R0 ; to new username, else flagE - RET ; error and returnA -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RETE -10$: .WORD ^M<> ; Entry mask/ - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block0 - ; NOTE: MOVC destroys r0-r5a - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask+ - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block) - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIBO - RET - .ENDr -$ UIC := 'F$GETJPI("","UIC") -$ SET UIC [1,4] -$ SET PROTECT=(SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)/DEFAULT -$ RUN BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXTE -INFORMATION ON HOW TO USE THE BULLETIN UTILITY.a -EXIT -$ SET UIC 'UIC'O -$ DEFAULT := 'F$FILE("SYS$LOGIN:LOGIN.COM","PRO")^ -$ SET PROTECT=('DEFAULT')/DEFAULTD -;------------------------------------------------------------------------------4 -;0 -; Name: USER_OPEN -;8 -; Type: Multilple Function (MACRO)o -;l -; Author: T.W.Frediann -; MIT Plasma Fusion Center -; -; Date: January 26, 1983, -; -; Version:. -;G -; Purpose: Used to permit qio access to files with fortran. -; Returns channel and file size information and -; provides file truncation capability. Files opened -; with these useopens cannot be accessed using fortranV -; reads and writes and the dispose= keyword on theQ -; close of the file will have no effect. To make theP -; logical unit reuseable for normal RMS access you must -; deassign the channel using SYS$DASSGN(%VAL(channel))T -; and then use the close (unit= ) statement.$ -;M -; Types of useropens provided: -;n -; USER_OPEN$OLD - open old file -; USER_OPEN$NEW - open new file -; USER_OPEN$TRUNCATE - open old file and truncate it -; to the size specified by theQ -; INITIALSIZE keyword of the open -;1 -; To receive the channel, open RMS status and size of the fileR -; include a common USER_OPEN as follows:P -;L -; Common /USER_OPEN/ CHANNEL,STATUS,SIZE -; Integer*4 CHANNEL - I/O channel assigned to the file, -; Integer*4 STATUS - RMS status return of open -; Integer*4 SIZE - Size of the file opened in blocks -;B -;------------------------------------------------------------------------------T -; -; Call seqence: NONE - USEROPEN keyword of fortran OPEN statement- -; for example: -;0 -; External USER_OPEN$NEW -; . -; .) -; .L -; OPEN (UNIT=lun,FILE=filename,....,USEROPEN=USER_OPEN$NEW)0 -;M -;------------------------------------------------------------------------------ -;$ -; Description:8 -;) -; Entry mask for USER_OPEN$OLD -; Get the FAB address= -; Set the user file open bit -; Open old file -; Save the channel -; Save the sizeU -; Save the statusS -; Return - -; Entry mask for USER_OPEN$NEW -; Get the FAB addressJ -; Set the user file open bit -; Open new fileM -; Save the channel -; Save the size -; Save the statusU -; Return - -; Entry mask for USER_OPEN$TRUNCATEL -; Get the FAB address) -; Get the RAB address -; Save the sizeS -; Open old fileL -; Connect file to record stream -; Load the size of the file in the RAB -; Set the access mode to relative file address -; Find the last record in the file -; Place the end of file marker at this location -; Mark the file to be truncated on close -; Close the file -; Return - -; EndC -; -;+----------------------------------------------------------------------------- - - .TITLE USER_OPEN2 - .IDENT /V_830128/ - -;P -;------------------------------------------------------------------------------A -; -; Global variables:> -;P - .PSECT USER_OPEN LONG,PIC,OVR,GBL,SHR,NOEXE - -CHANNEL: .BLKL 1 ; Channel numberD -STATUS: .BLKL 1 ; Status return of open -SIZE: .BLKL 1 ; Size of fileS - -;2 -;------------------------------------------------------------------------------2 -;# -; Executable: -;# - .PSECT $CODE LONG,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVECB - - .ENTRY USER_OPEN$OLD,^M ; Entry mask for USER_OPEN$OLD - MOVL 4(AP),R2 ; Get the FAB addressL - INSV #1,#FAB$V_UFO,#1,FAB$L_FOP(R2) ; Set the user file open bitA - $OPEN FAB=(R2) ; Open old fileS - MOVL FAB$L_STV(R2),CHANNEL ; Save the channel - MOVL FAB$L_ALQ(R2),SIZE ; Save the sizee - MOVL R0,STATUS ; Save the statusC - RET ; Returns - - .ENTRY USER_OPEN$NEW,^M ; Entry mask for USER_OPEN$NEW - MOVL 4(AP),R2 ; Get the FAB address - INSV #1,#FAB$V_UFO,#1,FAB$L_FOP(R2) ; Set the user file open bit - INSV #0,#FAB$V_CBT,#1,FAB$L_FOP(R2) ; Disable contiguous best try - $CREATE FAB=(R2) ; Open new files - MOVL FAB$L_STV(R2),CHANNEL ; Save the channel - MOVL FAB$L_ALQ(R2),SIZE ; Save the sizeS - MOVL R0,STATUS ; Save the status - RET ; Return. - - .ENTRY USER_OPEN$TRUNCATE,^M ; Entry mask for USER_OPEN$TRUNCATE - MOVL 4(AP),R2 ; Get the FAB addresst - MOVL 8(AP),R3 ; Get the RAB address - MOVL FAB$L_ALQ(R2),R4 ; Save the sizep - INCL R4 ; Increment the size - INSV #0,#FAB$V_SQO,#1,FAB$L_FOP(R2) ; Clear the sequential only bit - $OPEN FAB=(R2) ; Open old fileu - BLBC R0,CLOSE ; If unsuccessful branch to close - $CONNECT RAB=@8(AP) ; Connect file to record stream - BLBC R0,CLOSE ; If unsuccessful branch to closeU - MOVL R4,RAB$L_RFA0(R3) ; Load the size of the file in the RABS - MOVW #0,RAB$W_RFA4(R3) - MOVB #RAB$C_RFA,RAB$B_RAC(R3) ; Set the access mode to relative file address, - $FIND RAB=(R3) ; Find the last record in the file - BLBC R0,CLOSE ; If unsuccessful branch to close - $TRUNCATE RAB=(R3) ; Place the end of file marker at this locationB - INSV #1,#FAB$V_TEF,#1,FAB$L_FOP(R2) ; Mark the file to be truncated on close, -CLOSE: PUSHL R0 ; Save error status - $CLOSE FAB=(R2) ; Close the filea - POPL R0 ; Restore error status - MOVL R0,STATUS ; Return the status - RET ; Returny - - .END ; EndL - diff --git a/decus/vax85c/bulletin/setuic.mar b/decus/vax85c/bulletin/setuic.mar deleted file mode 100644 index 9436202..0000000 --- a/decus/vax85c/bulletin/setuic.mar +++ /dev/null @@ -1,54 +0,0 @@ -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES:S -; Must link with SS:SYS.STBt -;4 - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries:y -;1 - .LIBRARY /SYS$LIBRARY:LIB.MLB/e -;o -; Global variables: -;t - $PCBDEF -;b -; Executable: -;h - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable codeI - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error coder - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel modeo -5$: RETa -10$: .WORD ^M<> ; Entry maskb - MOVL SCH$GL_CURPCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - .ENDG diff --git a/decus/vax85c/bulletin/setuser.mar b/decus/vax85c/bulletin/setuser.mar deleted file mode 100644 index 490004e..0000000 --- a/decus/vax85c/bulletin/setuser.mar +++ /dev/null @@ -1,83 +0,0 @@ -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uicS - .IDENT /830531/ -;p -; Libraries:t -;M - .LIBRARY /SYS$LIBRARY:LIB.MLB/n -; -; Global variables: -; - $PCBDEF - $JIBDEF -;t -; local variables:e -;o - - .PSECT SETUSER_DATA,NOEXEh - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old usernamet -; -; Executable: -;0 - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flagM - RET ; error and returnG -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RETB -10$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Blocki - ; NOTE: MOVC destroys r0-r5; - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIBu - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry maskl - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5M - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIBC - RET - .END diff --git a/decus/vax85c/bulletin/startup.com b/decus/vax85c/bulletin/startup.com deleted file mode 100644 index 37231d2..0000000 --- a/decus/vax85c/bulletin/startup.com +++ /dev/null @@ -1,10 +0,0 @@ -$ UIC := 'F$GETJPI("","UIC") -$ SET UIC [1,4] -$ SET PROTECT=(SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)/DEFAULT -$ RUN BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFORMATION ON HOW TO USE THE BULLETIN UTILITY. -EXIT -$ SET UIC 'UIC' -$ DEFAULT := 'F$FILE("SYS$LOGIN:LOGIN.COM","PRO") -$ SET PROTECT=('DEFAULT')/DEFAULT diff --git a/decus/vax85c/bulletin/useropen.mar b/decus/vax85c/bulletin/useropen.mar deleted file mode 100644 index eff725a..0000000 --- a/decus/vax85c/bulletin/useropen.mar +++ /dev/null @@ -1,154 +0,0 @@ -;------------------------------------------------------------------------------ -; -; Name: USER_OPEN -; -; Type: Multilple Function (MACRO) -; -; Author: T.W.Fredian -; MIT Plasma Fusion Center -; -; Date: January 26, 1983 -; -; Version: -; -; Purpose: Used to permit qio access to files with fortran. -; Returns channel and file size information and -; provides file truncation capability. Files opened -; with these useopens cannot be accessed using fortran- -; reads and writes and the dispose= keyword on the -; close of the file will have no effect. To make then -; logical unit reuseable for normal RMS access you must -; deassign the channel using SYS$DASSGN(%VAL(channel)) -; and then use the close (unit= ) statement.d -;e -; Types of useropens provided: -;s -; USER_OPEN$OLD - open old file -; USER_OPEN$NEW - open new file -; USER_OPEN$TRUNCATE - open old file and truncate it -; to the size specified by the -; INITIALSIZE keyword of the open -; -; To receive the channel, open RMS status and size of the filei -; include a common USER_OPEN as follows:e -;o -; Common /USER_OPEN/ CHANNEL,STATUS,SIZE- -; Integer*4 CHANNEL - I/O channel assigned to the filei -; Integer*4 STATUS - RMS status return of open -; Integer*4 SIZE - Size of the file opened in blocks -;i -;------------------------------------------------------------------------------h -;n -; Call seqence: NONE - USEROPEN keyword of fortran OPEN statements -; for example: -;a -; External USER_OPEN$NEW -; .C -; . -; .Z -; OPEN (UNIT=lun,FILE=filename,....,USEROPEN=USER_OPEN$NEW)i -; -;------------------------------------------------------------------------------r -;Z -; Description:f -;p -; Entry mask for USER_OPEN$OLD -; Get the FAB address- -; Set the user file open bit -; Open old file -; Save the channel -; Save the size -; Save the statusm -; Return - -; Entry mask for USER_OPEN$NEW -; Get the FAB addressE -; Set the user file open bit -; Open new file -; Save the channel -; Save the sizen -; Save the statusS -; Return - -; Entry mask for USER_OPEN$TRUNCATE- -; Get the FAB address- -; Get the RAB address- -; Save the sizes -; Open old file -; Connect file to record stream -; Load the size of the file in the RAB -; Set the access mode to relative file address -; Find the last record in the file -; Place the end of file marker at this locationN -; Mark the file to be truncated on close -; Close the file -; Return - -; Enda -;e -;+-----------------------------------------------------------------------------f - - .TITLE USER_OPEN - .IDENT /V_830128/ - -; -;------------------------------------------------------------------------------d -;a -; Global variables:f -;f - .PSECT USER_OPEN LONG,PIC,OVR,GBL,SHR,NOEXE - -CHANNEL: .BLKL 1 ; Channel numberi -STATUS: .BLKL 1 ; Status return of open -SIZE: .BLKL 1 ; Size of file - -;n -;------------------------------------------------------------------------------- -;- -; Executable:- -;- - .PSECT $CODE LONG,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVEC - - .ENTRY USER_OPEN$OLD,^M ; Entry mask for USER_OPEN$OLD - MOVL 4(AP),R2 ; Get the FAB addressa - INSV #1,#FAB$V_UFO,#1,FAB$L_FOP(R2) ; Set the user file open bitS - $OPEN FAB=(R2) ; Open old fileC - MOVL FAB$L_STV(R2),CHANNEL ; Save the channel - MOVL FAB$L_ALQ(R2),SIZE ; Save the size - MOVL R0,STATUS ; Save the status- - RET ; Return- - - .ENTRY USER_OPEN$NEW,^M ; Entry mask for USER_OPEN$NEW - MOVL 4(AP),R2 ; Get the FAB address - INSV #1,#FAB$V_UFO,#1,FAB$L_FOP(R2) ; Set the user file open bitD - INSV #0,#FAB$V_CBT,#1,FAB$L_FOP(R2) ; Disable contiguous best try - $CREATE FAB=(R2) ; Open new filee - MOVL FAB$L_STV(R2),CHANNEL ; Save the channel - MOVL FAB$L_ALQ(R2),SIZE ; Save the sizen - MOVL R0,STATUS ; Save the statust - RET ; ReturnS - - .ENTRY USER_OPEN$TRUNCATE,^M ; Entry mask for USER_OPEN$TRUNCATE - MOVL 4(AP),R2 ; Get the FAB address( - MOVL 8(AP),R3 ; Get the RAB address - MOVL FAB$L_ALQ(R2),R4 ; Save the size - INCL R4 ; Increment the size - INSV #0,#FAB$V_SQO,#1,FAB$L_FOP(R2) ; Clear the sequential only bit - $OPEN FAB=(R2) ; Open old fileL - BLBC R0,CLOSE ; If unsuccessful branch to close - $CONNECT RAB=@8(AP) ; Connect file to record stream - BLBC R0,CLOSE ; If unsuccessful branch to closeN - MOVL R4,RAB$L_RFA0(R3) ; Load the size of the file in the RAB - MOVW #0,RAB$W_RFA4(R3)A - MOVB #RAB$C_RFA,RAB$B_RAC(R3) ; Set the access mode to relative file address - $FIND RAB=(R3) ; Find the last record in the file - BLBC R0,CLOSE ; If unsuccessful branch to close - $TRUNCATE RAB=(R3) ; Place the end of file marker at this locationI - INSV #1,#FAB$V_TEF,#1,FAB$L_FOP(R2) ; Mark the file to be truncated on close -CLOSE: PUSHL R0 ; Save error status - $CLOSE FAB=(R2) ; Close the fileR - POPL R0 ; Restore error status - MOVL R0,STATUS ; Return the status - RET ; ReturnR - - .END ; Enda diff --git a/decus/vax86c/bulletin/aaareadme.txt b/decus/vax86c/bulletin/aaareadme.txt deleted file mode 100644 index 2ac7fe6..0000000 --- a/decus/vax86c/bulletin/aaareadme.txt +++ /dev/null @@ -1,12 +0,0 @@ -This is BULLETIN, a VAX based bulletin board facility which allows you -to create numerous topic folders and browse them, reply to selected -entries, handle private folders or messages, etc. Any user can send -bulletins or read them (if permitted), and public, private, and -semi-private folders are permitted. Mail can be sent to folders -and the system understands working across networks. Bulletins can -be sent to files, print queues, or mail to other users. - This system seems to do a lot that VAXNotes does, and a lot -that Tools Mail does, and some more besides. Read the BULLETIN.TXT -file for how to get started. - From Mark London, MIT. - diff --git a/decus/vax86c/bulletin/allmacs.mar b/decus/vax86c/bulletin/allmacs.mar deleted file mode 100644 index c19e702..0000000 --- a/decus/vax86c/bulletin/allmacs.mar +++ /dev/null @@ -1,348 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET -; -; Name: USER_OPEN -; -; Type: Multilple Function (MACRO) -; -; Author: T.W.Fredian -; MIT Plasma Fusion Center -; -; Date: January 26, 1983 -; -; Version: -; -; Purpose: Used to permit qio access to files with fortran. -; Returns channel and file size information and -; provides file truncation capability. Files opened -; with these useopens cannot be accessed using fortran -; reads and writes and the dispose= keyword on the -; close of the file will have no effect. To make the -; logical unit reuseable for normal RMS access you must -; deassign the channel using SYS$DASSGN(%VAL(channel)) -; and then use the close (unit= ) statement. -; -; Types of useropens provided: -; -; USER_OPEN$OLD - open old file -; USER_OPEN$NEW - open new file -; USER_OPEN$TRUNCATE - open old file and truncate it -; to the size specified by the -; INITIALSIZE keyword of the open -; -; To receive the channel, open RMS status and size of the file -; include a common USER_OPEN as follows: -; -; Common /USER_OPEN/ CHANNEL,STATUS,SIZE -; Integer*4 CHANNEL - I/O channel assigned to the file -; Integer*4 STATUS - RMS status return of open -; Integer*4 SIZE - Size of the file opened in blocks -; -; -; Call seqence: NONE - USEROPEN keyword of fortran OPEN statement -; for example: -; -; External USER_OPEN$NEW -; . -; . -; . -; OPEN (UNIT=lun,FILE=filename,....,USEROPEN=USER_OPEN$NEW) -; -; -; Description: -; -; Entry mask for USER_OPEN$OLD -; Get the FAB address -; Set the user file open bit -; Open old file -; Save the channel -; Save the size -; Save the status -; Return - -; Entry mask for USER_OPEN$NEW -; Get the FAB address -; Set the user file open bit -; Open new file -; Save the channel -; Save the size -; Save the status -; Return - -; Entry mask for USER_OPEN$TRUNCATE -; Get the FAB address -; Get the RAB address -; Save the size -; Open old file -; Connect file to record stream -; Load the size of the file in the RAB -; Set the access mode to relative file address -; Find the last record in the file -; Place the end of file marker at this location -; Mark the file to be truncated on close -; Close the file -; Return - -; End -; - - .TITLE USER_OPEN - .IDENT /V_830128/ - -; -; -; Global variables: -; - .PSECT USER_OPEN LONG,PIC,OVR,GBL,SHR,NOEXE - -CHANNEL: .BLKL 1 ; Channel number -STATUS: .BLKL 1 ; Status return of open -SIZE: .BLKL 1 ; Size of file - -; -; -; Executable: -; - .PSECT $CODE LONG,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVEC - - .ENTRY USER_OPEN$OLD,^M ; Entry mask for USER_OPEN$OLD - MOVL 4(AP),R2 ; Get the FAB address - INSV #1,#FAB$V_UFO,#1,FAB$L_FOP(R2) ; Set the user file open bit - $OPEN FAB=(R2) ; Open old file - MOVL FAB$L_STV(R2),CHANNEL ; Save the channel - MOVL FAB$L_ALQ(R2),SIZE ; Save the size - MOVL R0,STATUS ; Save the status - RET ; Return - - .ENTRY USER_OPEN$NEW,^M ; Entry mask for USER_OPEN$NEW - MOVL 4(AP),R2 ; Get the FAB address - INSV #1,#FAB$V_UFO,#1,FAB$L_FOP(R2) ; Set the user file open bit - INSV #0,#FAB$V_CBT,#1,FAB$L_FOP(R2) ; Disable contiguous best try - $CREATE FAB=(R2) ; Open new file - MOVL FAB$L_STV(R2),CHANNEL ; Save the channel - MOVL FAB$L_ALQ(R2),SIZE ; Save the size - MOVL R0,STATUS ; Save the status - RET ; Return - - .ENTRY USER_OPEN$TRUNCATE,^M ; Entry mask - MOVL 4(AP),R2 ; Get the FAB address - MOVL 8(AP),R3 ; Get the RAB address - MOVL FAB$L_ALQ(R2),R4 ; Save the size - INCL R4 ; Increment the size - INSV #0,#FAB$V_SQO,#1,FAB$L_FOP(R2) ; Clear the sequential only bit - $OPEN FAB=(R2) ; Open old file - BLBC R0,CLOSE ; If error branch to close - $CONNECT RAB=@8(AP) ; Connect file to record stream - BLBC R0,CLOSE ; If error branch to close - MOVL R4,RAB$L_RFA0(R3) ; Load size of the file in RAB - MOVW #0,RAB$W_RFA4(R3) - MOVB #RAB$C_RFA,RAB$B_RAC(R3) ; Set access mode to relative - $FIND RAB=(R3) ; Find the last record in file - BLBC R0,CLOSE ; If error branch to close - $TRUNCATE RAB=(R3) ; Put end of file marker here - INSV #1,#FAB$V_TEF,#1,FAB$L_FOP(R2) ; Mark file to be truncated -CLOSE: PUSHL R0 ; Save error status - $CLOSE FAB=(R2) ; Close the file - POPL R0 ; Restore error status - MOVL R0,STATUS ; Return the status - RET ; Return - - .END ; End - diff --git a/decus/vax86c/bulletin/bullet.com b/decus/vax86c/bulletin/bullet.com deleted file mode 100644 index 1e75dfc..0000000 --- a/decus/vax86c/bulletin/bullet.com +++ /dev/null @@ -1,1170 +0,0 @@ -$set nover -$copy sys$input AAAREADME.TXT -$deck -The following are instructions for creating the BULLETIN executable and -installation of the utility. A brief explanation of how the internals -of the BULLETIN utility works can be found in BULLETIN.TXT . None of -the command procedures included here are sophisticated, so it is likely -that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLFILES.INC must first - be modified before this procedure is run. It contains the names of data files - which BULLETIN creates. It also includes specifications of directories used - by the FOLDER and BBOARD features. There are also some parameters in - BULLFOLDER.INC which you may or may not want to modify. (If you are simply - receiving the objects, ignore this command procedure. Use the procedure - CREATE_NOFORT.COM. The objects have have been compiled to use the directory - BULLETIN$ for all data files. You should define this as a system logical - name pointing to the directory which you plan to use, i.e. $ DEFINE/SYSTEM - BULLETIN$ USRD$:[BULLETIN] . You should also include this definition in - BULLSTART.COM, which is mentioned below.) - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL$HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the comands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new bulletins. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - Also, if you want bulletins displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It simply installs the BULLETIN utility with correct privileges. - -5) BULLETIN.COM - If one wants the feature of using BULLETIN between DECNET nodes, - this file must be put in each node's DECNET default user's directory - (usually [DECNET]). Once this is done, the /NODE qualifer for the - ADD command can be used. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. - -6) INSTRUCT.COM - This procedure adds 2 permanent bulletins which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system bulletins (via SET NOREADNEW). - -7) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. -$eod -$copy sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET DEFAULT BULLETIN$: ! BULLETIN looks for text in BBOARD directory -$ DELETE MFENET.MSG;* ! Delete any leftover output files. -$ OUTNAME := 'F$GETJPI("","USERNAME")' -$ IF OUTNAME .NES. "INFOMFE" THEN GOTO END ! Did user remember to SET BBOARD - ! to user MFE in BULLETIN? If not, exit. -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * mfenet.msg -delete * -exit -$ OPEN/READ/ERROR=EXIT INPUT MFENET.MSG -$ OUTNAME := 'F$GETJPI("","USERNAME")' -$ OUTNAME := 'OUTNAME'".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ INPUT DATA ! Skip first line in MFENET output -$HEADER: -$ READ INPUT DATA ! Read FROM line in MFENET output -$ DATA := 'F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ LEN = F$LOCATE(" ",DATA) -$ IF LEN .GT. 12 THEN LEN = 12 -$ WRITE OUTPUT "From: " + "''F$EXTRACT(0,LEN,DATA)'" - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + "''F$GETJPI("","USERNAME")'" - ! Write To: + TAB + BBOARDUSERNAME -$ READ INPUT DATA -$ WRITE OUTPUT "Subj: " +- ! Write Subject: + TAB + mail subject -"''F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA)'" -$NEXT: -$ READ/END=END INPUT DATA ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFENET.MSG; -$EXIT: -$eod -$copy sys$input BULLCOM.CLD -$deck - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER BULLETIN_NUMBER - DISALLOW FOLDER AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER SEMIPRIVATE, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DEFINE VERB CURRENT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND NODES - DEFINE VERB DIRECTORY - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW START AND SINCE - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER FOLDER, DEFAULT - DEFINE VERB EXIT - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,TYPE=$REST_OF_LINE) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER BULLETIN_NUMBER - QUALIFIER NODES - DISALLOW FOLDER AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DEFINE VERB REPLACE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - DEFINE TYPE SET_OPTIONS - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOREADNEW, SYNTAX=SET_NOTIFY_READNEW - KEYWORD READNEW, SYNTAX=SET_NOTIFY_READNEW - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_NOTIFY_READNEW - KEYWORD NONOTIFY, SYNTAX=SET_NOTIFY_READNEW - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - DEFINE SYNTAX SET_NOTIFY_READNEW - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NOTIFY, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD READNEW, SYNTAX=SHOW_FLAGS - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER -$eod -$copy sys$input BULLCOMS.HLP -$deck -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users. If specified, message -is both stored and broadcasted to all users logged in at the time. -See also /ALL and /BELL. -2 /EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. -2 /NODES=(nodes[,...]) -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. -2 /PERMANENT -This option is restricted to privileged users for the GENERAL folder, -but available to all in other folders. If specified, message will be a -permanent message and will never expire. -2 /SHUTDOWN -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to the general message file. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the general folder and displayed in full as a system -message when a user logs in. System messages should be as brief as possible -to avoid the possibility that system messages could scroll off the screen. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 BACK -Displays the message preceding the current message. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped seperately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically selected. -(see information on SELECT command). The commands that can be used to -modify the folder's characteristics are: SET ACCESS, SET BBOARD, REMOVE. - - Format:p - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces orh -characters that are also invalid in filenames (this is because the folder. -is stored in a file name created with the folder name). -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder.F -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLss -and users who are granted access must be entered into the Rights Data Base.s -If the RDB does not exist on your system, you will need this to be created -by a privileged user. If the user is not in the RDB, this program wills -automatically enter the user into it (unless this feature was disabled s -during the compilation of this program). -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only withT -respect to adding or modifying messages. All users can read the folder. -1 CURRENTh - -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENTe -1 DELETE -Deletes the specified message. If no message is specified, the currentY -message is deleted. Only the original owner or a privileged user can -delete a message.e - - Format:e - DELETE [message-number]f - -The message's relative number is found by the DIRECTORY command. -2 /NODES=(nodes[,...]) -Specifies to delete the message at the listed DECNET nodes. The BULLETINl -utility must be installed properly on the other nodes. You can specifyf -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on theo -other nodes. The /SUBJECT must be specified to identify the specificI -message that is to be deleted. -2 /SUBJECT=subject -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message.B -It can be a substring of the subject. This is in case you have forgottenn -the exact subject that was specified. Case is not critical either. -You will be notified if the deletion was successful. -2 /USERNAMEa -Specifies username to be used at remote DECNET nodes when deleting messagess -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORYc -Lists a summary of the messages. The message number, submitter's name,p -date, and subject of each message is displayed.e -2 /FOLDERS -Lists the available message folders. -2 /SINCE=datel -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.t -2 /START=start-point -Indicates the first message number you want to display. For example,e -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -1 EXIT -Exits the BULLETIN program.e -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file. - - Format:! - FILE file-name -2 /HEADERa - - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -1 Folders -All messages are divided into separate folders. The default folder is -GENERAL, in which also is stored SYSTEM messages. New folders can bet -created by any user. As an example, the following creates a folder forw -GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMESm - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, thatl -user will be alerted of topics of new messages at login time, and will -then be given the option of reading them. Note, however, that the display -of topics of new GENERAL folders is not controlled by this command, ande -that READNEW is the default for the GENERAL folder. Additionally, a -user can be immediately alerted when a new message has been added to a -folder by the SET NOTIFY command. - -A folder can be restricted to only certain users, if desired. This is ! -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controller by the creator by the SET [NO]ACCESS command. -1 HELP -To obtain help on any topic, type: - - HELP topic -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format:' - - MAIL recipient-nameF - -The input for the recipient name is exactly the same format as used by -the MAIL utility.x -2 /SUBJECT - - /SUBJECT=text - -Specifies the subject of the message for the heading. If the text -consists of more than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used. -as the subject.E -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The PRINT command can take optional qualifiers. - - Format: - - PRINT -2 /HEADERS - - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFYT - - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when theT -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /QUEUE=queue-name -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder will -be displayed. However, if there are new messages, the first new message -will be displayed. Each time you enter the command, the next page, or ifE -there are no more pages, the next message will be displayed. L - - Format:E - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command,M -i.e. typing the command "2" is equivalent to "READ 2", and simply hittingF -the key is equivalent to "READ".T -2 /PAGEA - - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than oneL -screenful at a time, and that have a remote printer that can then printE -the contents of the terminal's memory. -2 /SINCE=date -Specifies to read the first message created on or after the specifiedR -date. If no date is specified, the default is TODAY.B -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged -user can remove the folder.E - - Format:R - REMOVE folder-name -1 REPLACE, -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen theB -message to be notified of it a second time. If the text of the messageI -is to be changed, a file can be specified which contains the text. -Otherwise, you will be promptted for the text. The expiration info andP -header can also be changed. If neither no qualifiers are added to the -command, it is assumed the whole message will be replaced. - - Format:R - REPLACE [file-name] -2 /EDIT -Determines whether or not the editor is invoked to edit the messageO -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified.E -2 /EXPIRATIONN -Specifies that the message expiration date is to be replaced.N -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. This only applies to the GENERAL folder. -2 /HEADERA -Specifies that the message header is to be replaced. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally( -new text is to be read in. -2 /NUMBER=nB -Specifies the message number to be replaced. If this qualifier is A -omitted, the message that is presently being read will be replaced.E -2 /PERMANENT -Specifies that the message is to be made permanent.M -2 /SHUTDOWNA -Specifies that the message is to expire after the next computerN -shutdown. This only applies to general or system messages.D -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is aI -privileged command and only applies to the GENERAL folder. -2 /TEXT -Specifies that the message text is to be replaced. -1 SEARCH -Searches the currently selected folder for the message containing -the first occurrence of the specified text string. - - Format: - - SEARCH [search-string]T - -message searches for the given search-string in the currently -selected folder. The search starts from the beginning of the -messages in the current folder. If a "search-string" is not -specified, a search is made for the previously specified string, -starting after the message you are currently reading (or have just -read). -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY,T -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [folder-name]A - -Omitting the folder name will select the default general messages. -1 SETE -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format:E - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be R -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format:A - - SET [NO]ACCESS id [folder-name], - -The parameter "id" is the id in the system Rights Database to whichA -access is being affected. For more infomation concerning usage of -private folders, see HELP CREATE /PRIVATE. -3 /ALL -Specifies that access to the folder is granted to all users, in otherA -words the folder is made no longer private. /ALL is specified inP -place of the id name after the SET ACCESS command: - SET ACCESS /ALL [folder-name] -3 /READE -Specifies that access to the folder will be limited to being able to -read the messages. -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which ist -sent to that user are converted into messages. This command will applyS -to the selected folder, and each folder can have it's own BBOARD. If -no folder is selected, the general message file is modified. Only P -privileged users or owners of the folders can set BBOARD. Note: TheA -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSTEM privileges, orO -the scratch bboard_directory (specified when compiling BULLETIN) mustG -have world rwed protection.W - - Format:P - - SET BBOARD [username]T -3 /[NO]EXPIRATION=days -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can beF -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. -3 /SPECIAL -Specifies that the input for incoming mail is not the normal VMS MAIL. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. SeeU -installation notes for how to use this feature.s -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format:c - - SET FOLDER [folder-name] -2 NOTIFY -Specifies whether you will be notified via a broadcast message when ap -message is added to the selected folder. - - Format:/ - - SET [NO]NOTIFY -3 /DEFAULT -Specifies that the SET [NO]NOTIFY command be applied to all users fort -the specified folder. This is a privileged qualifier. It will only -affect new users.j -2 PRIVILEGES -Specifies the privileges that are necessary to use privileged commands.n -Use the SHOW PRIVILEGES command to see what privileges are presently set.e -This is a privileged command.i - - Format: - - SET PRIVILEGES privilege-listl - -Privilege-list is the list of privileges seperated by commas. -To remove a privilege, specify the privilege preceeded by "NO".s -2 READNEWr -Controls whether you will be prompted upon logging in if you wish to read -new non-system or folder messages (if any exist). The default is that you -are prompted. In order to apply this to a specific folder, first select -the folder (using the SELECT command), and then enter the READNEW command. -For messages in folders other than the GENERAL folder, both prompting -and display of topics of new messages are controlled by this command.e - - Format:h - - SET [NO]READNEWR -3 /DEFAULT -Specifies that the SET [NO]READNEW command be applied to all users for -the specified folder. This is a privileged qualifier. It will only -affect new users -1 SHOW -The SHOW command displays information about certain characteristics. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected via -the SELECT command, information about that folder is shown.f - - Format:e - - SHOW FOLDER [folder-name]r -3 /FULL -Controls whether the access list and the BBOARD information for thet -folder is displayed. This infomation is only those who have access to -that message.e -2 NOTIFY -Shows whether NOTIFY has been set for this folder. (See HELP SET NOTIFY). -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. -2 READNEW -Shows whether READNEW has been set for this folder. (See HELP SET READNEW).N -$eod y -$copy sys$input BULLDIR.INCe -$decko - COMMON /BULL_DIR/ DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME - & ,SYSTEM,BLOCK,NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - CHARACTER*53 DESCRIPu - CHARACTER*12 FROM - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATEa - CHARACTER*8 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - LOGICAL SYSTEMe - - CHARACTER*116 BULLDIR_COM ! This value + 12 must be - EQUIVALENCE (DESCRIP,BULLDIR_COM) ! divisable by 4l -$eod h -$copy sys$input BULLETIN.COM -$deckF -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -$eod s -$copy sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, addingg -and deleting bulletins. Any user can submit a bulletin. Users areh -notified at login time that new bulletins have been added and the topics ofA -those bulletins are displayed. Reading of those bulletins is optional.o -(Use the command SET READNEW while in BULLETIN for setting automatic -reading.) Privileged users can add system bulletins that are displayed -in full at login time. These bulletins are also saved, and can be readc -by BULLETIN. Bulletins are automatically deleted after a specified -expiration date, or they can manually be deleted by either the submitter -of the bulletin or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility.m -Type HELP after invoking the BULLETIN command. -2 Descriptionc -The BULLETIN utility is a utility to display bulletins to users when -logging in. Users are notified of bulletins only once. They're not -forced into reading them every time they log in. Submitting and reading -bulletins is easy to do via a utility similar to the VMS MAIL utility. m -Privileged users can create bulletins which are displayed in full. -(known as SYSTEM bulletins). Non-privileged users can create non-SYSTEM -bulletins, but only topics are displayed at login. - -Folders can be created so that bulletins pertaining to a single topice -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited.m - -When new non-system bulletins are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes tod -read the new bulletins. The user can then read the bulletins (with the -ability to write any of the bulletins to a file). A user can enable theb -notification and prompting of new bulletins feature on a folder pern -folder basis. However, the exception is bulletins submitted to thes -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to giveo -non-privileged users some ability to force a notification of an importantd -message. 2 - -Bulletins have expiration dates and times, and are deleted automatically.i -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" bulletins, i.e.y -bulletins that get deleted after a system shutdown has occurred. -"PERMANENT" bulletins can also be created which never expire. - -Privileged users can broadcast their bulletin (to either all users or. -all terminals).u - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a newc -bulletin has been added. d - -An optional "Bulletin Board" feature allows bulletins to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -bulletins and stored in that folder. This feature originally was -designed to duplicate the bulletin board feature that exists on some -Arpanet sites. However, with the addition of folders, another possibleE -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, andA -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user.h -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -There is a feature which allows adding GENERAL non-system and system -bulletins to other DECNET nodes from within the BULLETIN the utility (seee -the ADD command). All information about the message, such as expiration -date, are transferred to the host, thus making it more flexible than the -BBOARD method of adding bulletins. Deletion of bulletins is alsoi -possible across DECNET.S - -Bulletins can be either sent to a file, to a print queue, or mailed to -another user.e -$eod f -$copy sys$input BULLETIN.LNK -$deck -$ LINK/NOTRACE BULLETIN,BULLSUB0,BULLSUB1,BULLSUB2,BULLSUB3,-r -BULLCOM,BULLMAIN,ALLMACS,SYS$SYSTEM:SYS.STB/SELs -$eod I -$copy sys$input BULLETIN.TXT -$deckf -This file describes the general operation of the BULLETIN utility. - -BULLETIN uses the following files to store its data: BULLETIN.DAT, BULLDIR.DAT,s -BULLUSER.DAT, & BULLFOLDER.DAT. Also, each folder has it's own corresponding, -equivalent of BULLETIN.DAT and BULLDIR.DAT, although they are named with the -folder name as the prefix, and the suffixes of BULLFIL and BULLDIR. -These files are opened with the shared attribute as much as possible to allowb -simultaneous operations on the files. However, when a bulletin is added ort -deleted, the file cannot be shared, as this might cause the file to be -corrupted. Because of this problem, files are closed as soon as possible so -that it may be quickly opened for adding and deleting files. During read -operations, the information is passed to temporary storage, the file is closed, -and then the information is sent to the terminal. This avoids a possible -problem where the terminal output is stopped by the user, therefore delaying -the closing of the file. Also, the use of CTRL-Y & CTRL-C is disabled while -the file is opened to avoid lockout problems. - -BULLETIN.DAT stores the actual bulletins in a fixed 81 character length file. -Bulletins are store sequentially datewise. New bulletins are appended to the= -end of the file. When a bulletin is deleted, all the following bulletins are -moved up in the file to remove the gap, and the file is then truncated to -remove the unused space. Each line is limited to 80 characters, with the 81st -character reservered to indicate the first line of each bulletin message.f -This is reduntant information since BULLDIR.DAT also stores this information.a -This is done to provide a means to recover from corrupted files due to a -crash. - -BULLDIR.DAT is a fixed record length file storing directory entries for each -bulletin in BULLETIN.DAT. Each entry contains the header information, length,] -and starting record position in BULLETIN.DAT. The first line of BULLDIR.DAT ise -a header containing the date of the next expiration that will occur, the date -of the latest sumbitted bulletin, the number of bulletins, and the total sizem -of BULLETIN.DAT. The last two numbers make it easier to add bulletins. Thee -directory entries then follow, again stored sequentially datewise. e - -BULLUSER.DAT is a relative indexed file, where the keyword is the username ofu -the user. Each entry contains the latest time that the user logged in, plus -the latest time that the BULLETIN utility was used to read bulletins. A headeri -entry with a blank username stores the latest bulletin date. The informationH -in this file is used for checking to see if the user should be alerted to newa -bulletins or not.h - -BULLFOLDER.DAT is a relative indexed file storing information about all thel -folders. It has 2 keywords, the folder number and the folder name.s -$eod e -$copy sys$input BULLFILES.INCI -$deck -Cm -C THE FIRST 4 FILES ARE FILES CREATED AND USED BY BULLETIN. -C SEE BULLETIN.TXT FOR MORE INFORMATION. SPECIFY THE DEVICE/DIRECTORY -C IN WHICH YOU DESIRE THAT THEY BE KEPT. -Co -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF IT IS UNDEFINED, FOLDERS WILL NOTt -C BE ABLE TO BE CREATED./ -C] -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED.a -C NOTE THAT EITHER THIS DIRECTORY MUST BE GIVEN WORLD READ/WRITE ACCESS,a -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SUREc -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. -Cc -C NOTE: DELETED SPACE IS PERIODICALLY RECLAIMED AUTOMATICALLY IN ALLE -C FILES EXCEPT FOR BULLUSER.DAT, AS EMPTY SPACE IN THAT FILE IS VERYc -C SLOWLY ACCUMULATED. EMPTY SPACE CAN BE RECLAIMED BY THE FOLLOWING, -C VMS COMMAND: $ CONVERT BULLUSER.DAT BULLUSER.DAT -C DOING THIS ABOUT ONCE A YEAR IS PROBABLY GOOD ENOUGH. HOWEVER, IFe -C YOU HAVE PERIODS OF HIGH TURNOVER OF USERS, I.E. AT THE END OF Ah -C SCHOOL YEAR, YOU SHOULD SCHEDULE IT TO BE DONE AT THAT TIME. -Cc - COMMON /FILES/ BULLDIR_FILE,BULLETIN_FILE,BULLUSER_FILE - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORYI - CHARACTER*80 BULLDIR_FILE /'BULLETIN$:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULLETIN$:BULLETIN.DAT'/ - CHARACTER*80 BULLUSER_FILE /'BULLETIN$:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULLETIN$:BULLFOLDER.DAT'/ - CHARACTER*80 FOLDER_DIRECTORY /'BULLETIN$:'/t - CHARACTER*80 BBOARD_DIRECTORY /'BULLETIN$:'/e -$eod E -$copy sys$input BULLFOLDER.INC -$decks -!e -! The following 2 parameters can be modified if desired before compilation. -!o - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days thatl - ! BBOARDS can be set to.. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - PARAMETER ADDID = .TRUE. ! Allows users who are not in theB - ! rights data base to be addedr - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8)' - PARAMETER FOLDER_RECORD = 153 - - COMMON /BULL_FOLDER/ FOLDER_SET,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER,FOLDER_NUMBER,FOLDER_FILE, - & FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBr - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/a - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8a - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - COMMON /BULL_FOLDER1/ FOLDER1_OWNER,FOLDER1_DESCRIP,r - & FOLDER1,FOLDER1_NUMBER,FOLDER1_FILE, - & FOLDER1_BBOARD,FOLDER1_BBEXPIREo - CHARACTER FOLDER1_OWNER*12,FOLDER1*25 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12g - - CHARACTER*120 FOLDER_COMc - EQUIVALENCE (FOLDER1_OWNER,FOLDER_COM) -$eod -$copy sys$input BULLMAIN.CLD -$decks - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - QUALIFIER BBOARD - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED), - QUALIFIER LOGINe - QUALIFIER READNEWe - QUALIFIER REVERSEe -$eod -$copy sys$input BULLSTART.COMd -$decke -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXITC -$eod -$copy sys$input BULLUSER.INC -$decke - PARAMETER USER_FMT = '(A12,A11,A8,A11,A8,6A4)'e - PARAMETER USER_HEADER = ' 'e - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_DATE,BBOARD_TIME - CHARACTER TEMP_USER*12,BBOARD_DATE*11,BBOARD_TIME*8 - - COMMON /BULL_USER/ USERNAME,LOGIN_DATE,LOGIN_TIME,READ_DATE,m - & READ_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - DIMENSION SET_FLAG(2) ! Bit set indicates READNEW set for folderR - DIMENSION NEW_FLAG(2) ! Bit set indicates new bulletin in folderf - DIMENSION NOTIFY_FLAG(2)! Bit set indicates to broadcast notification - ! when new bulletin is added.a -$eod i -$copy sys$input BULL_COMMAND.COM -$decke -$B:=$PFCVAX$DBC1:[LONDON.BULLETIN.NEW]BULLETIN.EXE -$ON ERROR THEN GOTO EXIT -$ON SEVERE THEN GOTO EXIT -$ON WARNING THEN GOTO EXIT -$B/'F$PROCESS()' -$EXIT: -$LOGOUTs -$eod d -$copy sys$input CREATE.COM -$deck -$ FORTRAN/EXTEND BULLETINi -$ FORTRAN/EXTEND BULLSUB0P -$ FORTRAN/EXTEND BULLSUB1r -$ FORTRAN/EXTEND BULLSUB2 -$ FORTRAN/EXTEND BULLSUB3a -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOMe -$ SET COMMAND/OBJ BULLMAIN -$ @BULLETIN.LNKd -$eod s -$copy sys$input CREATE_NOFORT.COMa -$decke -$! -$! CREATE_NOFORT.COM -$! Command procedure to create bulletin executable without fortran compiler. -$! -$ RUN ASC2BINo -BULLETIN.ASC -BULLETIN.BAK -$ BACKUP BULLETIN.BAK/SAVE */NEW -$ RUN ASC2BINe -BULLSUB0.ASC -BULLSUB0.BAK -$ BACKUP BULLSUB0.BAK/SAVE */NEW -$ RUN ASC2BINs -BULLSUB1.ASC -BULLSUB1.BAK -$ BACKUP BULLSUB1.BAK/SAVE */NEW -$ RUN ASC2BINh -BULLSUB2.ASC -BULLSUB2.BAK -$ BACKUP BULLSUB2.BAK/SAVE */NEW -$ RUN ASC2BINe -BULLSUB3.ASC -BULLSUB3.BAK -$ BACKUP BULLSUB3.BAK/SAVE */NEW -$ MAC ALLMACSe -$ SET COMMAND/OBJ BULLCOMm -$ SET COMMAND/OBJ BULLMAIN -$ @BULLETIN.LNKt -$ WRITE SYS$OUTPUT "You can now delete all the .BAK and .ASC files." -$eod r -$copy sys$input INSTALL.COMb -$deckB -$ COPY BULLETIN.EXE SYS$SYSTEM:f -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/DELp -SYS$SYSTEM:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXITi -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines andm -$! define the logical name BULL$HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL$HELP SYSD$:[NEWDIRECTORY]n -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMSd -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy sys$input INSTRUCT.COM -$decke -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod l -$copy sys$input INSTRUCT.TXT -$decke -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayeds -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). g -$eod o -$copy sys$input LOGIN.COML -$deck, -$! -$! Note: The command prompt when executing the utility is named afterh -$! the executable image. Thus, as it is presently set up, the prompte -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break.t -$! If you wish bulletins to be displayed upon logging in starting with -$! oldest rather than newest, change BULLETIN/LOGIN to BULLETIN/LOGIN/REVERSE. a -$! -$ BULL*ETIN :== $SYS$SYSTEM:BULLETIN -$ BULLETIN/LOGIN -$eod l -$copy sys$input NONSYSTEM.TXT -$deckc -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but onlyn -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have thes -subdirectory [.BULL] created, BULLETIN will use that directory as the defaultt -directory to write the file into.D - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod u diff --git a/decus/vax86c/bulletin/bulletin.for b/decus/vax86c/bulletin/bulletin.for deleted file mode 100644 index f349ccd..0000000 --- a/decus/vax86c/bulletin/bulletin.for +++ /dev/null @@ -1,1742 +0,0 @@ -C -C BULLETIN.FOR, Version 10/30/86 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C NOTES: See BULLETIN.TXT for general info. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*11 UPTIME_DATE - CHARACTER*8 UPTIME_TIME - CHARACTER*64 HELP_DIRECTORY - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT) - LEN = 1 - DO WHILE (LEN.GT.0) - LEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (LEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(LEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(1:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - -C -C Test for /LOGIN switch. -C NOTE: /READ has been replaced by the SET READNEW command. -C - - CALL LIB$GET_FOREIGN(INCMD) - - IER = CLI$DCL_PARSE('BULLETIN'//INCMD,BULLETIN_MAINCOMMANDS) - - READIT = 0 - LOGIT = 0 - IF (CLI$PRESENT('LOGIN')) LOGIT = 1 ! Test for /LOGIN switch. - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - END IF - -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - CALL OPEN_FILE_SHARED(2) ! Open directory file - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - CALL CLOSE_FILE(1) - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0) THEN ! Do shutdown bulletins exist? - CALL GET_UPTIME(UPTIME_DATE,UPTIME_TIME) - IER1 = COMPARE_DATE(SHUTDOWN_DATE,UPTIME_DATE) - IF (IER1.EQ.0) IER1 = COMPARE_TIME(SHUTDOWN_TIME,UPTIME_TIME) - IF (IER1.LE.0) SHUTDOWN = 0 - ELSE - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_FILE(4) ! Create user file to be able to set - CALL CLOSE_FILE(4) ! defaults, privileges, etc. - END IF - CALL CLOSE_FILE(2) - - CALL GETSTS(STS) ! Get process status word - - IF (LOGIT.GT.0) THEN ! If BULLETIN/LOGIN then - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - END IF - - IF ((STS.AND.PCB$M_NETWRK).GT.0) THEN - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - ELSE - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - END IF - - CALL ASSIGN_TERMINAL ! Assign terminal - -C -C Get page length for the terminal. -C - - CALL GETPAGLEN(PAGE_LENGTH) - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIT.GT.0) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL UPDATE_READ(NEW_GENERAL_BULL) ! Update last read time - DO FOLDER_NUMBER = 1,63 - F_POINT = FOLDER_NUMBER/32 + 1 - IF (BTEST(NEW_FLAG(F_POINT).AND.SET_FLAG(F_POINT), - & FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (BTEST(NEW_FLAG(F_POINT),FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE ! Can't select the folder - CALL CHANGE_FLAG(0,1) ! then clear SET_FLAG - END IF - END IF - END DO - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (NEW_GENERAL_BULL) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new general messages.'')') - ELSE - BULL_POINT = 0 - END IF - END IF - ELSE ! READNEW mode. - READ_DONE = -1 - DO FOLDER_NUMBER = 0,63 - F_POINT = FOLDER_NUMBER/32 + 1 - IF (BTEST(NEW_FLAG(F_POINT).AND.SET_FLAG(F_POINT), - & FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - SAVE_BULL_POINT = BULL_POINT - CALL READNEW - IF (BULL_POINT.NE.SAVE_BULL_POINT - & .AND.READ_DONE.EQ.-1) READ_DONE = FOLDER_NUMBER - END IF - ELSE ! Can't select the folder - CALL CHANGE_FLAG(0,1) ! then clear SET_FLAG - END IF - END IF - END DO - IF (READ_DONE.GE.0) THEN - IF (READ_DONE.EQ.0) CALL UPDATE_READ(NEW_GENERAL_BULL) - DO FOLDER_NUMBER = 0,63 - F_POINT = FOLDER_NUMBER/32 + 1 - IF (BTEST(NEW_FLAG(F_POINT).AND.SET_FLAG(F_POINT), - & FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(0,2) ! Clear NEW_FLAG - END IF - END DO - END IF - CALL EXIT - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - - MAIL_STATUS = 1 - - DO WHILE (1) - - IF (MAIL_STATUS) THEN - CALL GET_INPUT_PROMPT(INCMD,IER, - & COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - ELSE - CALL GET_INPUT_PROMPT(INCMD,IER, - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - MAIL_STATUS = 0 - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(1:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9') - IER = IER - 1 - END DO - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - - CALL CLI$GET_VALUE('$VERB',INCMD) ! Get the VERB command - IF (READ_ONLY.AND.(INCMD(1:3).EQ.'ADD'.OR.INCMD(1:3).EQ.'DEL' - & .OR.INCMD(1:3).EQ.'REP')) THEN ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(1:3).EQ.'ADD') THEN ! ADD bulletin command? - CALL ADD ! Go add bulletin - ELSE IF (INCMD(1:4).EQ.'BACK') THEN ! BACK command? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(1:4).EQ.'COPY') THEN ! COPY command? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(1:4).EQ.'CREA') THEN ! CREATE command? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(1:4).EQ.'CURR') THEN ! CURRENT command? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(1:4).EQ.'DELE') THEN ! DELETE command? - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(1:4).EQ.'DIRE') THEN ! DIRECTORY command? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(1:4).EQ.'EXIT') THEN ! EXIT command? - GO TO 999 ! Exit from program - ELSE IF (INCMD(1:4).EQ.'FILE') THEN ! FILE command? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(1:4).EQ.'HELP') THEN ! HELP command? - IER = LIB$SYS_TRNLOG('BULL$HELP',LEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - LEN = 9 - END IF - CALL HELP(HELP_DIRECTORY(1:LEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(1:4).EQ.'LAST') THEN ! LAST command? - READ_COUNT = -1 - BULL_READ = 99999 - CALL READ(READ_COUNT,BULL_READ) - ELSE IF (INCMD(1:4).EQ.'MAIL') THEN ! MAIL command? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(1:4).EQ.'MOVE') THEN ! MOVE command? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(1:4).EQ.'NEXT') THEN ! NEXT command? - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(1:4).EQ.'PRIN') THEN ! PRINT command? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(1:4).EQ.'READ') THEN ! READ command? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(1:3).EQ.'REM') THEN ! REMOVE command? - CALL REMOVE_FOLDER - ELSE IF (INCMD(1:4).EQ.'REPL') THEN ! REPLACE command? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(1:3).EQ.'SEA') THEN ! SEARCH command? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(1:3).EQ.'SEL') THEN ! SELECT command? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(1:3).EQ.'SET') THEN ! SET command? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(1:1).EQ.'B') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOT') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_NOTIFY_READNEW(1,-1) - ELSE - CALL CHANGE_FLAG(1,3) - END IF - ELSE IF (BULL_PARAMETER(1:3).EQ.'NON') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_NOTIFY_READNEW(0,-1) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(1:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_NOTIFY_READNEW(-1,1) - ELSE - CALL CHANGE_FLAG(1,1) - END IF - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_NOTIFY_READNEW(-1,0) - ELSE - CALL CHANGE_FLAG(0,1) - END IF - ELSE IF (BULL_PARAMETER(1:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(1:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(1:1).EQ.'P') THEN ! SET PRIVILEGES? - CALL SET_PRIV - END IF - ELSE IF (INCMD(1:4).EQ.'SHOW') THEN ! SHOW command? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(1:1).EQ.'F') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(1:1).EQ.'N') THEN ! SHOW NOTIFY? - CALL SHOW_NOTIFY - ELSE IF (BULL_PARAMETER(1:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(1:1).EQ.'R') THEN ! SHOW READNEW? - CALL SHOW_READNEW - END IF - END IF - -100 CONTINUE - - END DO - -999 DO FOLDER_NUMBER = 0,63 - F_POINT = FOLDER_NUMBER/32 + 1 - IF (BTEST(NEW_FLAG(F_POINT).AND.SET_FLAG(F_POINT), - & FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(0,2) ! Clear NEW_FLAG - END IF - END DO - - CALL EXIT - - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($BRKDEF)' - - CHARACTER INEXDATE*11,INEXTIME*8 - CHARACTER*80 INDESCRIP,INPUT - - INTEGER TIMADR(2) - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROADO - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - - CHARACTER*80 MAILEDIT,INLINE - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - EXTERNAL CLI$_ABSENTE - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN' - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying toM - END IF ! create new file.M - OPEN (UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET?S - USERNAME = DEFAULT_USERL - CALL CONFIRM_PRIV(USERNAME,ALLOW)T - END IF$ - - IF (FOLDER_SET.AND. ! If folder set and - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST switch present?C - & CLI$PRESENT('SHUTDOWN').OR. ! Is /SHUTDOWN switch present? - & CLI$PRESENT('NODES'))) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: Invalid parameter used with folder set.'')') - RETURN - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - RETURN ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSEn - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?= - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - RETURN ! and abort - END IF - END IFh - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?e - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privilegesb - WRITE(ERROR_UNIT,1081) ! Tell user - RETURN ! and abort - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privilegesO - WRITE(ERROR_UNIT,1082) ! Tell user - RETURN ! and abort - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bitP - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IF - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER)T - IF (.NOT.IER) GO TO 910s - INEXDATE = INPUT(1:11) - INEXTIME = INPUT(13:20) - END IFE - - LENDES = 54 - DO WHILE (LENDES.GT.53) ! Do until valid descriptionE - WRITE(6,1050) ! Request header for bulletinI - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fit - END IF - END DO_ - -CR -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.L -CI - - ICOUNT = 0 ! Line count for bulletin - - IF (CLI$PRESENT('EDIT')) THEN ! If /EDIT specified, then - LEN = 0 - IER = LIB$SYS_TRNLOG('MAIL$EDIT',LEN,MAILEDIT) - IF (IER.NE.SS$_NORMAL) MAILEDIT = 'SYS$SYSTEM:MAILEDIT'a - IF (LEN_P.EQ.0) THEN ! If no file param specifiedx - CALL LIB$SPAWN('$@'//MAILEDIT//' "" SYS$LOGIN:BULL.SCR')f - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',. - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')n - LEN_P = 1 - ELSE - CLOSE (UNIT=3)u - CALL LIB$SPAWN('$@'//MAILEDIT//' '//BULL_PARAMETER(1:LEN_P) - & //' SYS$LOGIN:BULL.SCR')u - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',s - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IF_ - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) LEN,INPUT ! get record countE - IF (LEN.GT.80) GO TO 950 - IF (INDEX(INPUT,CHAR(9)).GT.0) THEN - EXTRA = 0 - DO I=1,LEN - IF (INPUT(I:I).EQ.CHAR(9)) THEN - EXTRA = EXTRA + 8 - MOD(I+EXTRA,8)x - END IF - END DO - IF (LEN+EXTRA.GT.80) GO TO 950 - END IFS - ICOUNT = ICOUNT + 1 + MIN(LEN,80) - IF (LEN.EQ.0) ICOUNT = ICOUNT + 1 ! COPY_BULL writes line with. - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Sratch file to save bulletinP - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 81 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more inputt - CALL GET_LINE(INPUT,LEN) ! Get input lineg - IF (LEN.GT.80) THEN ! Input line too longE - WRITE(6,'('' ERROR: Input line length > 80. Reinput:'')') - ELSE IF (LEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + LEN ! Increment record count. - IF (LEN.EQ.0) ICOUNT = ICOUNT + 1 - WRITE(3,2010) INPUT(1:LEN) ! Save line in scratch file - END IFR - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outA - ENDIF - - REWIND (UNIT=3) - - IF (NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/SYSTEM'E - IF (CLI$PRESENT('BROADCAST'))C - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT'))u - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN'f - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1d - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes= - INLINE = INLINE(1:LEN_INLINE) - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolons) - LEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Are semicolon found?N - IF (LEN.GT.SEMI+1) THEN ! Is username found?' - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! YesF - LEN = SEMI - 1 ! Remove semicolonsC - ELSE ! No username found...E - TEMP_USER = DEFAULT_USER ! Set user to default - LEN = SEMI - 1 ! Remove semicolonsE - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons presentO - TEMP_USER = DEFAULT_USER ! Set user to defaultw - END IFe - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)')_ - & NODES(POINT_NODE),CHAR(10)F - CALL GET_INPUT_NOECHO(PASSWORD) - IF (STR$POSITION(PASSWORD,CHAR(13)).LE.1) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:LEN)//L - & '"'//TEMP_USER(1:TRIM(TEMP_USER))//' '// - & PASSWORD(1:STR$POSITION(PASSWORD,CHAR(13))-1)//'"::', - & TYPE='SCRATCH',IOSTAT=IER)I - CLOSE (UNIT=10+NODE_NUM)E - IF (IER.NE.0) THENR - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DOL - INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1) - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify dateO - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(1:LENDES)A - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) LEN,INPUT - LEN = MIN(LEN,80) - IF (IER.EQ.0) THENs - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(1:LEN)o - END IF - END DOi - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THENr - WRITE (6,'('' Message successfully sent to node '',A)')) - & NODES(POINT_NODE)_ - ELSEI - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE)D - WRITE (6,'(A)') INPUT - GO TO 940 - END IFP - REWIND (UNIT=3) - END DO - END IFF - - IF (.NOT.LOCAL_NODE_FOUND) GO TO 95 ! Was local node specified? - -C. -C Add bulletin to bulletin file and directory entry for to directory file.. -C. - - CALL OPEN_FILE(2) ! Prepare to add dir entryR - - DESCRIP=INDESCRIP(1:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration dateD - EXTIME=INEXTIME - LENGTH = (ICOUNT+127)/128 ! Number of recordsI - FROM = USERNAME ! Username - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0c - - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletino - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_FILE(2) ! Totally finished with addF - -CD -C Broadcast the bulletin if requested.i -C - - IF (CLI$PRESENT('BROADCAST')) THEN ! Should we broadcast the bull? - REWIND (UNIT=3) ! Yes, rewind the input file - IF (CLI$PRESENT('BELL')) THEN ! Include BELL in message? - BROAD(1:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROMG - START = 37 ! Start adding next line here - ELSE - BROAD(1:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROMV - START = 35 ! Start adding next line hereL - END IF - NBLANK = 0 - END = 0E - DO WHILE (ICOUNT.GT.0) ! Stuff bulletin into stringE - READ(3,'(Q,A)') LEN,INPUT ! Read input lines - ICOUNT = ICOUNT - LEN - 1 - IF (LEN.EQ.0) THEN. - NBLANK = NBLANK + 1 ! Count number of blank lines - ICOUNT = ICOUNT - 1 ! ICOUNT counts blank line as one space - ELSE ! Ignore blank liness at start or end of messageI - IF (NBLANK.GT.0.AND.END.GT.0) THENE - END = START + NBLANK*2 ! Check how long string will beF - IF (END.GT.BRDCST_LIMIT) GO TO 90 ! String too long?A - DO I=1,NBLANK - BROAD(START:START+1) = CR//LFo - START = START + 2 - END DO - END IFl - NBLANK = 0I - END = START + LEN - 1 + 2 ! Check how long string will be= - IF (END.GT.BRDCST_LIMIT) GO TO 90 ! String too long? - BROAD(START:END) = CR//LF//INPUT(1:LEN)! Else add new inputT - START = END + 1 ! Reset pointeru - END IFE - END DO -90 IF (CLI$PRESENT('ALL')) THEN ! Should we broadcast to ALL?F - CALL SYS$BRKTHRUs - & (,BROAD(1:START-1)//CR,,%VAL(BRK$C_ALLTERMS),,,,,,,) - ELSE ! Else just broadcast to users. - CALL SYS$BRKTHRUe - & (,BROAD(1:START-1)//CR,,%VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IFO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9L - CLOSE (UNIT=I) - END DOY - RETURN' - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100)N - GOTO 100R - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesD - GOTO 100L - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_FILE(1). - CALL CLOSE_FILE(2)S - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - CLOSE (UNIT=3)T - GO TO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3)E - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')) -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be% - & truncated to:') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system_ - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanent. - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -2010 FORMAT(A) -2020 FORMAT(1X,A)A - - END - - - SUBROUTINE DELETE -CL -C SUBROUTINE DELETE -C' -C FUNCTION: Deletes a bulletin entry from the bulletin file. -CE - IMPLICIT INTEGER (A - Z)H - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODER - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT. - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'L - - INCLUDE 'BULLFOLDER.INC'E - - EXTERNAL CLI$_ABSENTL - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53N - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER)E - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN)E - CALL OPEN_FILE(2)) - BULL_DELETE = 0R - IER = 1F - DO WHILE (BULL_DELETE+1.EQ.IER)C - BULL_DELETE = BULL_DELETE + 1 - CALL READDIR(BULL_DELETE,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP)) - IF (BULL_DELETE+1.EQ.IER.AND.REMOTE_USER.EQ.FROMU - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - GO TO 50L - END IF, - END DO - CALL CLOSE_FILE(2) ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IFE - -C) -C Get the bulletin number to be deleted.T -CC - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?B - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error.E - ELSE_ - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IFC - - IF (BULL_DELETE.LE.0) GO TO 920 - -CA -C Check to see if specified bulletin is present, and if the userL -C is permitted to delete the bulletin. -CW - - CALL OPEN_FILE(2) - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(ERROR_UNIT,1030) ! If not, then error out= - GOTO 100 - END IFO - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,I - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges orl - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(ERROR_UNIT,1040) ! Then error out. - GO TO 100 - ELSE - CALL CLOSE_FILE (2) - IF (.NOT.DECNET_PROC) THEN - WRITE (6,1050) ! Make sure user wants to delete itL - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') GO TO 900 - END IFA - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?U - WRITE(ERROR_UNIT,1030) ! If not, then error out - GOTO 100 - END IF' - END IF - END IFT - -CI -C Delete the bulletin directory entry. -C - -50 CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entrya - - CALL CLEANUP_DIRFILE(BULL_DELETE) ! Reorder directory fileg - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - CALL READDIR(0,IER) ! Get shutdown count - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown countB - END IFI - - CALL UPDATE ! Somewhat a kludgey way of updating latest1 - ! bulletin and expired dates.R - - IF (BULL_DELETE.LE.BULL_POINT) BULL_POINT = BULL_POINT - 12 - ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - -100 CALL CLOSE_FILE(2) - IF (DECNET_PROC) WRITE (5,'(''END'')')R - ! Tell DECNET that delete went ok. -900 RETURN - -910 WRITE(6,1010)r - GO TO 900 - -920 WRITE(6,1020)C - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.')R -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Specified message is not owned by you.')e -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -CI - IMPLICIT INTEGER (A - Z)o - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH - - DATA SCRATCH_D1/0/? - - COMMON /POINT/ BULL_POINT - - EXTERNAL CLI$_ABSENTS - - CHARACTER START_PARAMETER*4,DATETIME*23,TODAY*11) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenC - -CE -C Directory listing is first buffered into temporary memory storage beforev -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen,! -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.' -CT - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_COM) - SCRATCH_D = SCRATCH_D1V - - CALL OPEN_FILE_SHARED(2) ! Get directory fileI - - CALL READDIR(0,IER) ! Does directory header exist?N - IF (IER.EQ.1) THEN ! If so, there are messagesE - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified?e - IER = CLI$GET_VALUE('START',START_PARAMETER,LEN) - DECODE(LEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THENT - DIR_COUNT = NBULLI - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')')W - CALL CLOSE_FILE(2) - DIR_COUNT = 0! - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE')) THEN ! Date specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default.I - IER = SYS$ASCTIM(,TODAY,,) ! Need to get date. - DATETIME = TODAY//' 00:00:00.0' - END IF - TEMP_COUNT = 0 - IER = 1t - DO WHILE (IER.EQ.TEMP_COUNT+1) - TEMP_COUNT = TEMP_COUNT + 1 - CALL READDIR(TEMP_COUNT,IER)X - IF (IER.NE.TEMP_COUNT+1) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE(2) - RETURNs - ELSEr - DIFF = COMPARE_DATE(DATETIME(1:11),DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME). - IF (DIFF.LE.0) THEN - DIR_COUNT = TEMP_COUNT) - IER = IER + 1 - END IF2 - END IF - END DOo - ELSEu - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IFb - IF (CLI$PRESENT('SINCE')) THENt - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULLi - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-4) THEN - EBULL = NBULLF - SBULL = NBULL - (PAGE_LENGTH-4) + 1L - IF (SBULL.LT.1) SBULL = 1I - ELSEa - SBULL = DIR_COUNT$ - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1 - END IF, - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - DO I=SBULL,EBULL ! Copy messages from file - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - END DO - ELSE - NBULL = 0E - END IF, - - CALL CLOSE_FILE(2) ! We don't need file anymore - - IF (NBULL.EQ.0) THENa - WRITE (6,'('' There are no messages present.'')') - RETURN - END IFA - -C' -C Directory entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - WRITE(6,1000) ! Write header - DO I=SBULL,EBULLC - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - WRITE(6,2010) I,DESCRIP,FROM,DATE(1:7)//DATE(10:11)O - END DO - - DIR_COUNT = EBULL + 1 ! Update directory counter) - - IF (DIR_COUNT.GT.NBULL) THEN ! Outputted all entries?e - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are moreS - END IFR - - RETURN' - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/)t -1010 FORMAT(1X,/,' Press RETURN for more...',/)u - -2000 FORMAT(A53,A12,A11) -2010 FORMAT(1X,I3,1X,A53,1X,A12,1X,A9) - - END - E - - SUBROUTINE FILE -Cn -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENTN - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)U - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And returnC - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been readr - WRITE(6,1010) ! Write error - RETURN ! And returnT - END IF - - CALL OPEN_FILE_SHARED(2)L - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinN - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030)I - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF$ - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900,E - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSEI - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IF: - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATEe - END IF - - LEN = 81T - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0)e - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 90 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IFn - END DO - LEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completeds - - WRITE(6,1040) BULL_POINT,BULL_PARAMETER(1:LEN_P)R - ! Show name of file created.D -100 CALL CLOSE_FILE(1) - RETURNH - -900 WRITE(6,1000). - CALL ENABLE_PRIVS ! Reset BYPASS privilegesE - GO TO 100 - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' Message ',I3,' written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/)$ - - END - - - - - SUBROUTINE LOGIN: -C -C SUBROUTINE LOGINT -C, -C FUNCTION: Alerts user of new messages upon logging in.) -CE - IMPLICIT INTEGER (A - Z)O - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'D - - INCLUDE 'BULLFOLDER.INC'S - - COMMON /READIT/ READIT - - CHARACTER TODAY*23,INPUT*80,INREAD*1 - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /POINT/ BULL_POINT - - CHARACTER LOGIN_DATE_SAVE*11,LOGIN_TIME_SAVE*8t - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - - DATA PAGE/0/T - - DATA FIRST_WRITE/.TRUE./M - LOGICAL FIRST_WRITE - - DIMENSION H_NEW_FLAG(2),H_SET_FLAG(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -CI - - CALL OPEN_FILE_SHARED(4) ! Open user filee - - DO WHILE (REC_LOCK(IER))d - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) TEMP_USER, - & NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME,H_SET_FLAG, - & H_NEW_FLAG,NOTIFY_FLAG ! Get the header - END DO - - IF (IER.EQ.0) THEN ! Header is present. - DO WHILE (REC_LOCK(IER1))A - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER1) USERNAME,b - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,. - & NEW_FLAG,NOTIFY_FLAG ! Find if there is an entryR - END DO - IF (IER1.EQ.0) THEN ! There is a user entry - REWRITE (4,FMT=USER_FMT) USERNAME,TODAY(1:11),TODAY(13:20), - & READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG ! Update login date) - & ,NOTIFY_FLAG - IF ((SET_FLAG(1).OR.SET_FLAG(2)).NE.0) READIT = 1 - ELSE - READ_DATE = ' 5-NOV-1956' ! No entry, so make new one - READ_TIME = '11:05:56' ! Fake a read date. Set to the past. - READIT = 1 - WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,TODAY(1:11), - & TODAY(13:20),READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG, - & NOTIFY_FLAGt - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_FILE(4) ! Close the user file - CALL EXIT ! Go away...e - END IFR - CALL CLEANUP_LOGIN ! Good time to delete dead users1 - DIFF = -1 ! Force us to look at messages - END IF - DO WHILE (REC_LOCK(IER1))/ - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER1) TEMP_USER,E - & NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME,H_SET_FLAG,/ - & H_NEW_FLAG,NOTIFY_FLAG ! Reset read back to headeri - END DO - END IF - - IF (IER.EQ.0.AND.(BBOARD_DATE.NE.TODAY(1:11).OR.! Update BBOARD mail? - & COMPARE_TIME(TODAY(13:20),BBOARD_TIME)/60.GT.BBOARD_UPDATE)) THEN - REWRITE (4,FMT=USER_FMT) TEMP_USER,NEWEST_DATE, ! Rewrite headerN - & NEWEST_TIME,TODAY(1:11),TODAY(13:20),H_SET_FLAG,H_NEW_FLAG1 - & ,NOTIFY_FLAGn - CALL CLOSE_FILE(4) - CALL CREATE_BBOARD_PROCESS - ELSEe - CALL CLOSE_FILE(4) - IF (IER.NE.0) CALL EXIT ! If no header, no messages+ - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entryC -CL -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility.2 -C - DIFF = COMPARE_DATE(LOGIN_DATE,READ_DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,READ_TIME) - IF (DIFF.LT.0) THEN ! If read messages since last login, - LOGIN_TIME = READ_TIME ! then use the read date to compareu - LOGIN_DATE = READ_DATE ! with the latest bulletin dateE - END IF ! to see if should alert user.H - - DIFF = COMPARE_DATE(LOGIN_DATE,NEWEST_DATE)$ - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,NEWEST_TIME) - END IF - - LOGIN_TIME_SAVE = LOGIN_TIME ! These are destroyed in UPDATE_READ - LOGIN_DATE_SAVE = LOGIN_DATE, - - IF (DIFF.GT.0) THEN - BULL_POINT = -1D - RETURN - END IFT - -C -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible. -CD - - ENTRY LOGIN_FOLDERR - - LOGIN_TIME = LOGIN_TIME_SAVET - LOGIN_DATE = LOGIN_DATE_SAVE - - CALL OPEN_FILE_SHARED(2) ! Yes, so go get bulletin directoryG - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messagesS - CALL READDIR(0,IER) ! Get header infoT - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_COM) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_COM) - GEN_DIR = GEN_DIR1G - SYS_DIR = SYS_DIR1A - BULL_POINT = -1 - START = 1 - REVERSE = 0 - IF (CLI$PRESENT('REVERSE')) THENe - REVERSE = 1) - START = NBULL + 1 - IER = START + 1' - DIFF = 0 - IF (IER1.NE.0) THENp - START = 1 - ELSE - DO WHILE (START+1.EQ.IER.AND.DIFF.LE.0)) - START = START - 1 - IF (START.GT.0) CALL READDIR(START,IER) - IF (START+1.EQ.IER) THENe - DIFF = COMPARE_DATE(LOGIN_DATE,DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,TIME) - END IFt - END DO - START = START + 1i - END IF - END IFs - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THENP - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1R - END IF - CALL READDIR(ICOUNT,IER) - IF (IER1.EQ.0) THEN ! Is this a totally new user?p - ! No. Is bulletin system or from same user?) - IF (.NOT.REVERSE) THEN - DIFF = COMPARE_DATE(LOGIN_DATE,DATE) ! No, so compare date - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,TIME)E - IF (DIFF.GT.0) GO TO 100 - END IFL - IF (USERNAME.NE.FROM.OR.SYSTEM) THENN - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1E - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM)T - ELSE - NGEN = NGEN + 1O - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - END IF - SYSTEM = ICOUNTU - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM)$ - END IF - END IFE - ELSE ! Totally new user, save all messages - IF (SYSTEM) THENe - NSYS = NSYS + 1L - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM) - ELSEt - NGEN = NGEN + 1 - SYSTEM = ICOUNT ! Save bulletin number for display - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - END IF - END IF - END DO -100 CALL CLOSE_FILE(2) - IF (FOLDER_SET) NSYS = 0 -C -C Review new directory entries. If there are system messages,, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (NGEN.EQ.0.AND.NSYS.EQ.0) RETURN - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiese - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,1026) CTRL_G ! Yep... - PAGE = PAGE + 1a - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_FILE_SHARED(1) - CALL INIT_QUEUE(SYS_BUL1,INPUT)L - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM)I - INPUT = ' 'w - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - LEN = 81C - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin to SYS_BUL link liste - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - CALL CLOSE_FILE(1)f - RETURNI - ELSE IF (LEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - END IF - END DOO - LEN = 80I - END DON - END DO - CALL CLOSE_FILE(1) - SYS_BUL = SYS_BUL1 - DO WHILE (SYS_BUL.NE.0) ! Write out the system messagesl - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)A - IF (SYS_BUL.NE.0) THEND - IF (PAGE.EQ.PAGE_LENGTH-2) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO(INREAD) ! Get terminal input - CALL LIB$ERASE_PAGE(1,1) ! Clear the screeni - WRITE(6,1065) INPUT(1:TRIM(INPUT)) - PAGE = 1 - ELSEU - WRITE(6,1060) INPUT(1:TRIM(INPUT)) - PAGE = PAGE + 1 - END IF - END IFN - END DO - IF (NGEN.EQ.0) THENL - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IFf - GEN_DIR = GEN_DIR1T - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER) - S1 = (80-13-LENF)/2 - S2 = 80-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next pageL - CALL GET_INPUT_NOECHO(INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages',CTRL_GO - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesl - FIRST_WRITE = .FALSE. ! if this is first write to screen.L - END IFI - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages',CTRL_G - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025)( - PAGE = PAGE + 2 - DO I=1,NGEN' - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - IF (PAGE.EQ.PAGE_LENGTH-2) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO(INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1i - ELSEw - PAGE = PAGE + 1 - END IFO - WRITE(6,1040) DESCRIP,FROM,DATE(:6),SYSTEM - ! Bulletin number is stored in SYSTEM - END DO - IF (FOLDER_NUMBER.GT.0.OR.(FOLDER_NUMBER.EQ.0.AND. - & BTEST(SET_FLAG(1),0))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set for - END IF ! GENERAL, as no prompt to read is generated. - END IFO - WRITE(6,1030) - - RETURNT - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',33('*'),'System Messages',32('*'),A1)E -1027 FORMAT(/,' ',('*'),A,('*'),A1) -1028 FORMAT('+',('*'),A,('*'),A1)o -1030 FORMAT(' ',80('*')) -1040 FORMAT(' ',A53,1X,A12,1X,A6,1X,I4) -1060 FORMAT(1X,A)a -1065 FORMAT('+',A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.')n -1080 FORMAT(' ',/,' HIT any key for next page....')o - - END - - - SUBROUTINE GET_NODE_INFOu -C, -C SUBROUTINE GET_NODE_INFOh -Ce -C FUNCTION: Gets local node name and obtains node names fromf -C command line. -CC - - IMPLICIT INTEGER (A-Z)U - - EXTERNAL CLI$_ABSENTS - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE! - CHARACTER*32 NODES(10)i - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER*32 LOCAL_NODE - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE.E - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THENR - LOCAL_NODE = LOCAL_NODE(2:)R - L_NODE = L_NODE - 1 - END IFO - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - LEN = 0 ! GET_VALUE crashes if LEN<0 - DO WHILE (CLI$GET_VALUE('NODES',NODES(NODE_NUM+1),LEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - NODE_NUM = NODE_NUM + 1 - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - LEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addedd - END IF. - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:LEN)) THENE - NODE_NUM = NODE_NUM - 1N - LOCAL_NODE_FOUND = .TRUE.I - ELSEI - POINT_NODE = NODE_NUMT - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:LEN)//'""::') - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED',_ - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER)A - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IFR - END DO - ELSEU - LOCAL_NODE_FOUND = .TRUE.I - END IFE - - RETURN' - END - - - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE_ -CG -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODEE - CHARACTER*32 NODES(10)I - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940L - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IFL - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER)R - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - LEN = TRIM(NODES(POINT_NODE)) ! Length of node namet - IF (SEMI.GT.0) THEN ! Is semicolon present?e - IF (LEN.GT.SEMI+1) THEN ! Yes, is username after node? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - LEN = SEMI - 1 ! Remove semicolonO - ELSE ! No username after nodename) - TEMP_USER = DEFAULT_USER ! Set username to defaultU - LEN = SEMI - 1 ! Remove semicolonB - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolon present - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username was - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)')T - & NODES(POINT_NODE),CHAR(10)P - CALL GET_INPUT_NOECHO(PASSWORD)N - IF (STR$POSITION(PASSWORD,CHAR(13)).LE.1) GO TO 910E - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:LEN)R - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '// - & PASSWORD(1:STR$POSITION(PASSWORD,CHAR(13))-1)//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DOR - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINEi - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN0 - WRITE (6,'('' Message successfully deleted from node '',A)')E - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)')) - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DOy - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1E - END DO - - RETURN, - -1010 FORMAT (' ERROR: Deletion aborted.')& -1015 FORMAT (' ERROR: Unable to reach node ',A)' - - END - diff --git a/decus/vax86c/bulletin/bulletin.txt b/decus/vax86c/bulletin/bulletin.txt deleted file mode 100644 index 3833027..0000000 --- a/decus/vax86c/bulletin/bulletin.txt +++ /dev/null @@ -1,41 +0,0 @@ -From: MRL%PFCVAX%XX.LCS.MIT.EDU%MC.LCS.MIT.EDU@relay.cs.net 3-NOV-1986 22:43 -To: various... -Subj: BULLETIN - -You are about to receive a copy of the PFC BULLETIN. This software is -public domain. I will gladly accept reasonable suggestions for modifications, -and will attempt to fix bugs as quickly as possible. - -You will be receiving 7 files for the 10/1/86 version of BULLETIN facility. -They are: - 1) BULLETIN.FOR - 2) BULLSUB0.FOR - 3) BULLSUB1.FOR - 4) BULLSUB2.FOR - 5) BULLSUB3.FOR - 6) ALLMACS.MAR - 7) BULLET.COM - (They will be indentified in the SUBJECT header.) -BULLET.COM is a command procedure which when run, will create several small -files. This takes about a minutes. After you run it, you can delete it. -Read AAAREADME.TXT for installation instructions. - -NOTE: Remember to strip off any header that is created on these files that is -added when converting them from mail messages to files, including blank lines. - -SECOND NOTE: The feature which allows setting up folders to be publicly -readable but with limited access for writing requires at least VMS VERSION 4.4, -as the code uses a new system service $CHECK_ACCESS. The code is in -BULLSUB2.FOR, and instructions are there for how to comment it out if you are -running an earlier version. This will simply cause the feature to be disabled. -Creating fully private folders will still be possible (i.e. limited access for -both reading and writing). - -I've had various problems sending files to certain sites. I've had to reduce -file sizes in order to transfer the files, and more reduction may be necessary. -BITNET sites are being sent files without any TABs, as TABs were getting -converted to 4 spaces. Please let me know of any sites which have similar -problems (or any other type, for that matter). Thank you. - Mark London - MRL%PFCVAX@XX.LCS.MIT.EDU - diff --git a/decus/vax86c/bulletin/bullsub0.for b/decus/vax86c/bulletin/bullsub0.for deleted file mode 100644 index 3447d6f..0000000 --- a/decus/vax86c/bulletin/bullsub0.for +++ /dev/null @@ -1,1436 +0,0 @@ -C -C BULLSUB0.FOR, Version 10/1/86 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 90 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IF - END DO - LEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_FILE(1) - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',DESCRIP,LEN_D) - ELSE - LEN_D = TRIM(DESCRIP) - END IF - - IER = CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER,LEN_P) - - IF (DESCRIP(1:1).NE.'"') THEN - DESCRIP = '"'//DESCRIP(1:LEN_D) - LEN_D = LEN_D + 1 - END IF - - IF (DESCRIP(LEN_D:LEN_D).NE.'"') THEN - DESCRIP = DESCRIP(1:LEN_D)//'"' - LEN_D = LEN_D + 1 - END IF - - CALL LIB$SPAWN('$MAIL/SUBJECT='//DESCRIP(1:LEN_D)// - & ' SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(1:LEN_P),,,,,STATUS) - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - LOGICAL DELETE_ORIGINAL - - CHARACTER INPUT*80 - - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_FILE(2) - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - - SAVE_BULL_POINT = BULL_POINT - - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Scratch file to save bulletin - - CALL OPEN_FILE_SHARED(1) - - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 90 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IF - END DO - LEN = 80 - END DO - -90 REWIND (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER.OR.READ_ONLY) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - CLOSE (UNIT=3) - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - RETURN - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE(6,'('' ERROR: Message copy aborted.'')') - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CLOSE (UNIT=3) - END IF - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - IF (BTEST(SYSTEM,2)) THEN ! Shutdown message? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - - FROM = USERNAME ! New bulletin has new owner - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_FILE(2) ! Totally finished with add - - CLOSE (UNIT=3) ! Close the input file - - WRITE (6,'('' Message has been copied to folder '',A)') - & FOLDER(1:TRIM(FOLDER))//'.' - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL) CALL DELETE - - RETURN - - END - - - - - - SUBROUTINE READNEW -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER INREAD*1,INPUT*80,FILE_DEF*80 - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - -C -C This subroutine is executed due to the BULLETIN/LOGIN command which is -C normally executed by a command procedure during login. In order to use -C LIB$GET_INPUT, we must redefine SYS$INPUT to the terminal (temporarily -C using user mode). -C - IF (ICHAR(INREAD).EQ.0) THEN - CALL CRELNM('SYS$INPUT','TT') - CALL PURGE_TYPEAHEAD - SLOW = SLOW_TERMINAL() - END IF - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - INREAD = '0' - TEMP_READ = 0 - DO WHILE (INREAD.GE.'0'.AND.INREAD.LE.'9') - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Make input upper case - IF (TEMP_READ.GT.0.AND.(INREAD.LT.'0'.OR.INREAD.GT.'9').AND. - & INREAD.NE.CHAR(13)) THEN - GO TO 1 - ELSE IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+Quit'',$)') - ELSE - WRITE (6,'(''+No'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE IF (INREAD.GE.'0'.AND.INREAD.LE.'9') THEN - TEMP_READ = TEMP_READ*10 + ICHAR(INREAD) - ICHAR('0') - WRITE (6,'(''+'',A1,$)') INREAD - END IF - END DO - - IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.BULL_POINT+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_FILE_SHARED(2) ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND.(SYSTEM)) THEN - BULL_POINT = BULL_POINT + 1 ! If system bulletin, skip it. - GO TO 10 - END IF - CALL CLOSE_FILE(2) - END IF - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - IF (READ_COUNT.EQ.BLOCK) THEN - WRITE(6,1030) 'TEXT' - ELSE - WRITE(6,1030) 'MORE' - END IF - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',LEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:LEN-1)//'.BULL]' - LEN_FILE_DEF = LEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_FILE_SHARED(2) - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),IOSTAT=IER,ERR=18, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 18 - ELSE IF (LEN.GT.0) THEN - WRITE(3,'(A)') INPUT(1:TRIM(INPUT)) - END IF - END DO - LEN = 80 - END DO - WRITE(6,1040) BULL_PARAMETER(1:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_FILE_SHARED(2) ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_FILE(2) ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM) THEN ! Else if NEXT bulletin SYSTEM - BULL_POINT = BULL_POINT + 1 ! Skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_FILE(2) - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),Q(Quit),message - & number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,80('-'),/, - &' Type Q(Quit), F(File it) or any other key for next message: ',$) -1030 FORMAT(1X,80('-'),/,' Type Q(Quit), F(File it), N(Next message), - & or any other key for ',A4,'... ',$) -1040 FORMAT(' Message written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/) - - END - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: Replaces existing bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*8,MAILEDIT*80 - CHARACTER INDESCRIP*80,INPUT*80,TODAY*23 - CHARACTER*1 ANSWER - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT - - LOGICAL*1 DOALL - -C -C Get the bulletin number to be replaced. -C - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are reading - ELSE - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (FOLDER_SET.AND.CLI$PRESENT('SYSTEM')) THEN - WRITE (6,'( - & '' ERROR: Invalid parameter used with folder set.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (FOLDER_SET.AND.CLI$PRESENT('SHUTDOWN')) THEN - WRITE (6,'( - & '' ERROR: Invalid parameter used with folder set.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletin - - CALL CLOSE_FILE(2) - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person - RETURN ! and error out - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND. - & USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(1:11) - INEXTIME = INPUT(13:20) - END IF - -8 IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LEN,INDESCRIP - IF (LEN.EQ.0) GO TO 910 ! If no header, don't add bull - IF (LEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fit - GO TO 8 ! and re-request header - END IF - END IF - - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & CLI$PRESENT('EDIT')) THEN ! or /EDIT specified - - IF (CLI$PRESENT('EDIT')) THEN ! If /EDIT specified, then - IER = LIB$SYS_TRNLOG('MAIL$EDIT',LEN,MAILEDIT) - IF (IER.NE.SS$_NORMAL) MAILEDIT = 'SYS$SYSTEM:MAILEDIT' - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW',V - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy mesage into fileO - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN)t - IF (LEN.LT.0) THEN - GO TO 5 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IFR - END DOL - LEN = 80 - END DO -5 CALL CLOSE_FILE(1) - CLOSE (UNIT=3) ! Bulletin copy completed - END IFe - CALL LIB$SPAWN('$@'//MAILEDIT//' "" SYS$LOGIN:BULL.SCR') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVSC - CALL LIB$SPAWN('$@'//MAILEDIT//' '//BULL_PARAMETER(1:LEN_P)r - & //' SYS$LOGIN:BULL.SCR'). - END IFH - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1')f - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',f - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')L - ELSE IF (LEN_P.GT.0) THENL - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS' - OPEN (UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesD - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) LEN,INPUT ! get record count - IF (LEN.GT.80) GO TO 950G - CALL STR$TRIM(INPUT,INPUT,LEN)N - IF (INDEX(INPUT,CHAR(9)).GT.0) THEN - EXTRA = 0 - DO I=1,LEN - IF (INPUT(I:I).EQ.CHAR(9)) THEN - EXTRA = EXTRA + 8 - MOD(I+EXTRA,8)C - END IF - END DO - IF (LEN+EXTRA.GT.80) GO TO 950C - END IFS - IF (LEN.GT.0) THEN ! If good input line enteredT - ICOUNT = ICOUNT + LEN + 1 ! Increment record countR - LAST_NOBLANK = ICOUNT - ELSE IF (LEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line withC - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IFL - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 80 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more inputA - CALL GET_LINE(INPUT,LEN) ! Get input lineL - IF (LEN.GT.80) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > 80. Reinput::'')') - ELSE IF (LEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + LEN ! Increment character count - WRITE(3,'(A)') INPUT(1:LEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (LEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(1:LEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out? -10 ICOUNT = LAST_NOBLANKc - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outV - ENDIF - - REWIND (UNIT=3) - END IF= - -CT -C Add bulletin to bulletin file and directory entry for to directory file.h -Cl - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - INPUT = DESCRIP - CALL READDIR(NUMBER_PARAM,IER) ! Get info for messageE - - IF (IER.NE.NUMBER_PARAM+1.OR.INPUT.NE.DESCRIP) THEN - ! Message disappeared in the mean time?S - CALL CLOSE_FILE(2) - WRITE(6,'('' ERROR: Message file info invalidated. - & Find message and do REPLACE again.'')') - GO TO 100e - END IFc - - CALL READDIR(0,IER) ! Get directory headerN - - LENGTH_SAVE = LENGTH ! Copy BULL modifies LENGTHL - BLOCK_SAVE = BLOCKB - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN ! If text has been replacedL - CALL OPEN_FILE(1) ! Prepare to add bulletinN - ICOUNT = (ICOUNT+127)/128o - IF (ICOUNT.GT.LENGTH.AND.NBULL.GT.NUMBER_PARAM) THEN - BLOCK = NBLOCK + 1_ - NBLOCK = NBLOCK + ICOUNT - BLOCK_SAVE = BLOCKi - NEMPTY = NEMPTY + LENGTH - CALL WRITEDIR(0,IER) - ELSE IF (ICOUNT.LT.LENGTH) THENn - NEMPTY = NEMPTY + LENGTH - ICOUNT - CALL WRITEDIR(0,IER)( - END IF - CALL COPY_BULL(3,REC1,BLOCK,IER) ! Replace old bulletini - - CALL CLOSE_FILE(1) - - IF (ICOUNT.NE.LENGTH_SAVE) THEN ! If new bull different size - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entrya - LENGTH = ICOUNT ! Update size - BLOCK = BLOCK_SAVEL - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - END IFB - - CALL READDIR(NUMBER_PARAM,IER) - IF (CLI$PRESENT('HEADER').OR.DOALL) DESCRIP=INDESCRIP(1:53) - ! Update description header - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THENE - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME_ - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header inL - NEWEST_EXTIME = EXTIME ! the directory fileL - CALL WRITEDIR(0,IER) - END IF - ELSE IF (CLI$PRESENT('PERMANENT').AND. - & (.NOT.BTEST(SYSTEM,1))) THEN: - IF (BTEST(SYSTEM,2)) THENi - SYSTEM = IBCLR(SYSTEM,2). - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER)R - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00'C - ELSE IF (CLI$PRESENT('SHUTDOWN').AND. - & (.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000'u - EXTIME = '00:00:00'h - SHUTDOWN = SHUTDOWN + 1h - CALL SYS$ASCTIM(,TODAY,,) ! Get the present timeg - SHUTDOWN_DATE = TODAY(1:11)G - SHUTDOWN_TIME = TODAY(13:20) - CALL WRITEDIR(0,IER) - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - - CALL WRITEDIR(NUMBER_PARAM,IER) - - CALL CLOSE_FILE(2) ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURNT - -910 WRITE(6,1010)L - CLOSE (UNIT=3,ERR=100)A - GOTO 100 - -920 WRITE(6,1020)E - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100i - -950 WRITE (6,1030) - CLOSE (UNIT=3)0 - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be - & truncated to:') -1090 FORMAT(' ERROR: Specified message is not owned by you.')O -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A)L - - END - - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ -CI -C FUNCTION: Reads a specified bulletin. -CD -C PARAMETER:N -C READ_COUNT - Variable to store the record in the message fileO -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -CG - IMPLICIT INTEGER (A - Z)A - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - - COMMON /READIT/ READITl - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DATA SCRATCH_B1/0/) - - CHARACTER TODAY*11,DATETIME*23C - - LOGICAL SINCE,PAGER - - CALL LIB$ERASE_PAGE(1,1) ! Clear screenr - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this isE - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - IF (INCMD(1:4).EQ.'READ') THEN ! If READ command...m - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified?' - IER = CLI$GET_VALUE('SINCE',DATETIME)F - IF (DATETIME.EQ.'TODAY') THEN - IER = SYS$ASCTIM(,TODAY,,) ! Get today's dateF - DATETIME = TODAY//' 00:00:00.0' - END IF - CALL OPEN_FILE_SHARED(2) - TEMP_READ = 0D - IER = 1I - DO WHILE (IER.EQ.TEMP_READ+1) - TEMP_READ = TEMP_READ + 1 - CALL READDIR(TEMP_READ,IER) - IF (IER.NE.TEMP_READ+1) THENP - WRITE (6,'('' No messages found past specified date.'')') - CALL CLOSE(2) - RETURNR - ELSE - DIFF = COMPARE_DATE(DATETIME(1:11),DATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME) - IF (DIFF.LE.0) THENF - BULL_READ = TEMP_READ - IER = IER + 1H - END IFO - END IF( - END DO - IER = BULL_READ + 1p - SINCE = .TRUE. - END IF - END IF_ - - IF (.NOT.SINCE) THENS - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entryN - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0W - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN0 - BULL_READ = NBULLn - CALL READDIR(BULL_READ,IER)T - ELSE - IER = 0 - END IFN - END IF - CALL CLOSE_FILE(2) - ELSE - IER = 0. - END IF - END IFG - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IF( - - BULL_POINT = BULL_READ ! Update bulletin counter= - - WRITE(6,1040) BULL_POINT ! Output bulletin header info - WRITE(6,1050) DESCRIP - IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?M - WRITE(6,1065) FROM,DATE,'Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - WRITE(6,1065) FROM,DATE,'Permanent message'E - ELSEL - WRITE(6,1060) FROM,DATE,EXDATE//' '//EXTIME - END IFi - -Ce -C Each page of the bulletin is buffered into temporary memory storage beforeN -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memoryl -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.L -CO - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head) - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointerQ - END IFO - - END = 4 ! Outputted 4 lines to screen - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSEi - READ_COUNT = BLOCK ! Init bulletin record counterA - END IF- - -100 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to headern - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - CALL OPEN_FILE_SHARED(1) ! Get bulletin file - MORE_LINES = .TRUE. - READ_REC = READ_COUNT - IF (READ_ALREADY.EQ.0) LEN = 81 - DO WHILE (MORE_LINES.AND.READ_REC.LE.BLOCK+LENGTH-1)o - DO WHILE (LEN.GT.0.AND.MORE_LINES) - CALL GET_BULL(READ_REC,INPUT,LEN) - IF (LEN.LT.0) THEN ! Error, couldn't read record - READ_REC = BLOCK + LENGTH ! Fake end of reading fileR - MORE_LINES = .FALSE.O - ELSE IF (LEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)0 - READ_ALREADY = 1 - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IFe - END IFO - END DO - LEN = 80 - IF (MORE_LINES) THEN - READ_REC = READ_REC + 1 - READ_ALREADY = 0h - END IF - END DOW - - CALL CLOSE_FILE(1) ! End of bulletin file readR - -C -C Bulletin page is now in temporary memory, so output to terminal.u -C Note that if this is a /READ, the first line will have problems withM -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it mustg -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -Ce - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) ! Get queue recordn - IF (I.EQ.1.AND.READ_REC.NE.BLOCK.AND.READIT.GT.0) THEN - WRITE(6,2020) INPUT(1:TRIM(INPUT)) ! (See above comments) - ELSE - WRITE(6,2010) INPUT(1:TRIM(INPUT))u - END IF - END DO' - - READ_COUNT = READ_REC ! Update bull record counterE - - IF (READ_REC.EQ.BLOCK+LENGTH) THEN ! Last block?. - READ_COUNT = 0 ! init bulletin record counter - ELSE IF (READ_REC.EQ.BLOCK+LENGTH-1.AND..NOT.MORE_LINES) THEN - ! Possibly last block since end of page could be last line - CALL TEST_MORE_LINES(LEN) ! More lines to read? - IF (LEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin_ - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Else if this is not /READ - WRITE(6,1070) ! say there is more of bulletinl - END IF - - RETURN. - -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT('+Message number: ',I3). -1050 FORMAT(' Description: ',A53)A -1060 FORMAT(' From: ',A12,' Date: ',A11,' Expires: ',A20,/) -1065 FORMAT(' From: ',A12,' Date: ',A11,' ',A,/) -1070 FORMAT(1X,/,' Press RETURN for more...',/)o - -2000 FORMAT(A) -2010 FORMAT(1X,A)A -2020 FORMAT('+',A) - - END - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -Ca -C FUNCTION: Search for bulletin with specified string -Ct - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT. - - CHARACTER*132 SEARCH_STRING,SAVE_STRING - DATA SEARCH_STRING /' '/, SEARCH_LEN /1/R - - COMMON /POINT/ BULL_POINT - - CALL DISABLE_CTRL - - SAVE_STRING = SEARCH_STRING - SAVE_LEN = SEARCH_LEN - - IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - S - IF (.NOT.IER) THEN - SEARCH_STRING = SAVE_STRINGT - SEARCH_LEN = SAVE_LENU - END IFI - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper caseT - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(0,IER) - - IF (BULL_POINT+1.GT.NBULL) THEN - WRITE (6,'('' ERROR: No more messages.'')')I - CALL CLOSE_FILE(2) - CALL ENABLE_CTRL - RETURN - END IFN - - CALL OPEN_FILE_SHARED(1)s - - DO BULL_SEARCH = BULL_POINT+1, NBULL' - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1) THEN - LEN = 81 - DO J=BLOCK,BLOCK+LENGTH-1 - DO WHILE (LEN.GT.0) - CALL GET_BULL(J,INPUT,LEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(1:SEARCH_LEN)).GT.0) THENT - CALL CLOSE_FILE(1)d - CALL CLOSE_FILE(2)e - CALL ENABLE_CTRLs - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURNh - END IF - END DO - LEN = 80E - END DOL - END IF - END DO - - CALL CLOSE_FILE(1) ! End of bulletin file readA - CALL CLOSE_FILE(2)L - - CALL ENABLE_CTRLE - - WRITE (6,'('' No messages found with given search string.'')')D - - RETURNd - END - - - - - - SUBROUTINE UPDATE -CI -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -CP -C NOTE: Assumes directory file is already opened.O -CL - IMPLICIT INTEGER (A - Z) - CHARACTER*107 DIRLINE - - INCLUDE 'BULLDIR.INC' - - CHARACTER*11 TEMP_DATE,TEMP_EXDATER - CHARACTER*8 TEMP_TIME,TEMP_EXTIME - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00' ! bulletin date if deletion occurs - - CALL OPEN_FILE(1) ! Open both bulletin files - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deletede - - DO WHILE (1)W - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not foundA - IF (SYSTEM.LE.1.OR.(SHUTDOWN.EQ.0 ! If not permanent, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin?' - DIFF = 0 ! If so, delete it - ELSEE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF, - IF (DIFF.LE.0) THEN ! If so then delete bulletinN - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reorderingE - END IF ! directory file. - ELSE IF (SYSTEM.LE.1) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that.P - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest expn - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IFN - TEMP_DATE = DATE ! Keep date so when we quitN - TEMP_TIME = TIME ! search, we'll have the - END IF ! latest bulletin datea - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IFO - - DATE = NEWEST_DATEt - TIME = NEWEST_TIMEt - NEW_SHUTDOWN = SHUTDOWN - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER)L - CALL CLOSE_FILE(1)0 -CH -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to usersd -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THENu - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURNa - -1000 FORMAT(A11,A11,A8,A4,A4)T -1020 FORMAT(A107)E - - END - - - - SUBROUTINE UPDATE_READ(NEW_BULL)N -C( -C SUBROUTINE UPDATE_READc -Ci -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility.s -C If new bulletins have been added, alert user of the fact.9 -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC'c - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23F - -C -C Update user's latest read time in his entry in BULLUSER.DAT.e -Cd - - NEW_BULL = .FALSE. - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - DO WHILE (REC_LOCK(IER))= - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_DATE,NEWEST_TIME, ! Get newest bulletin - & BBOARD_DATE,BBOARD_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAGE - END DO - - IF (IER.NE.0) THEN ! If header not present, exit - CALL CLOSE_FILE(4) - RETURN - ELSE IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THENE - SET_FLAG(1) = 1 ! If header present, but noT - SET_FLAG(2) = 0 ! SET_FLAG and NOTIFY_FLAG - NOTIFY_FLAG(1) = 0 ! information, write defaultx - NOTIFY_FLAG(2) = 0 ! flags._ - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - NEW_FLAG(2) = 0T - REWRITE (4,FMT=USER_FMT) - & TEMP_USER,NEWEST_DATE,NEWEST_TIME,BBOARD_DATE, - & BBOARD_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAG - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - - DO WHILE (REC_LOCK(IER1)) - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER1) USERNAME, - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG - & ,NOTIFY_FLAG ! Find user's info - END DOC - - IF (IER1.EQ.0) THEN ! If entry found, update it - DIFF = COMPARE_DATE(READ_DATE,NEWEST_DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(READ_TIME,NEWEST_TIME)B - IF (DIFF.LE.0) NEW_BULL = .TRUE. ! If new bull set flagW -Ce -C No need to update read time/date if no new bulletins and no READNEW set, -C unless new bulletin is in general folder. -CD - IF ( ((NEW_FLAG(1).AND.SET_FLAG(1)).OR.e - & (NEW_FLAG(2).AND.SET_FLAG(2))).NE.0.OR.NEW_BULL) THEN - REWRITE (4,FMT=USER_FMT) USERNAME,LOGIN_DATE,LOGIN_TIME,T - & TODAY(1:11),TODAY(13:20),SET_FLAG,NEW_FLAG,NOTIFY_FLAG - END IF - ELSE ! If no entry create a new entry - NEW_BULL = .TRUE. - WRITE (4,FMT=USER_FMT) USERNAME,TODAY(1:11),TODAY(13:20), - & TODAY(1:11),TODAY(13:20),SET_FLAG,'FFFFFFFF'X,'FFFFFFFF'X,t - & NOTIFY_FLAG - END IFX - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -CT -C SUBROUTINE FIND_NEWEST_BULL -CT -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin.F -C -C OUTPUTS:S -C BULL_POINT - If -1, no new bulletins to read, else there are. -CS - - IMPLICIT INTEGER (A - Z). - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC'= - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'A -C= -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointerN -CG -C Following stores a "possible" new bulletin. That is, the user hasR -C READNEW set, but ignored reading the bulletins. The user then enters -C BULLETIN, and if new bulletins are added after logging in, we want to -C point to that bulletin. However, if there were none added since then,( -C we want to point to the first unread one. Thus, the first new unread -C bulletin is stored in BULL_POSSIBLE, and the search continues for -C new bulletins since logging in. -Cr - BULL_POSSIBLE = -1' - - CALL OPEN_FILE_SHARED(2) ! Yep, so get directory fileN - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN ! If header present - DO ICOUNT=1,NBULL ! Get each bulletin to compare - CALL READDIR(ICOUNT,IER) ! its date with last read dateA - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - DIFF = COMPARE_DATE(READ_DATE,DATE)c - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(READ_TIME,TIME) - IF (DIFF.LE.0) THEN ! If new bull or new user - IF (SYSTEM) THEN ! If system bulletin - DIFF = COMPARE_DATE(LOGIN_DATE,DATE)$ - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(LOGIN_TIME,TIME) - IF (DIFF.LE.0) THEN ! If system bull, make it - BULL_POINT = ICOUNT - 1 ! the first new bull onlyU - GO TO 100 ! if added since user logged inf - END IF ! else he's read it already. - ELSE - IF ((FOLDER_NUMBER.LE.31.AND. - & BTEST(SET_FLAG(1),FOLDER_NUMBER)).OR.a - & (FOLDER_NUMBER.GT.31.AND.r - & BTEST(SET_FLAG(2),FOLDER_NUMBER-32))) THEN - IF (BULL_POSSIBLE.EQ.-1) BULL_POSSIBLE = ICOUNT - 1 - DIFF = COMPARE_DATE(LOGIN_DATE,READ_DATE)I - IF (DIFF.EQ.0) - & DIFF = COMPARE_TIME(LOGIN_TIME,READ_TIME)O - IF (DIFF.GT.0) THEN - DIFF = COMPARE_DATE(LOGIN_DATE,DATE)/ - IF(DIFF.EQ.0) DIFF=COMPARE_TIME(LOGIN_TIME,TIME)A - END IF1 - END IF - IF (DIFF.LE.0) THEN - BULL_POINT = ICOUNT - 1 ! If not system bull then - GO TO 100 ! make it the new bullO - END IFn - END IF - END IF - END IFa - END DO - END IFN - - BULL_POINT = BULL_POSSIBLEI - -100 CALL CLOSE_FILE(2) ! Its time for this program - - RETURNI - END - - - - SUBROUTINE GET_EXPIRED(INPUT,IER) - - IMPLICIT INTEGER (A-Z)S - - CHARACTER*20 INPUTE - CHARACTER*23 TODAYN - - DIMENSION EXTIME(2),NOW(2)E - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date, - -5 WRITE(6,1030) TODAY ! Prompt for expiration date - CALL GET_LINE(INPUT,LEN) ! Get input line( - - IF (LEN.LE.0) THEN - IER = 0 - RETURN - END IFT - - INPUT = INPUT(1:LEN) ! Change trailing zeros 2 spaces - - IF (INDEX(INPUT,'-').EQ.0.AND.INDEX(INPUT,':').GT.0.AND. - & INDEX(INPUT(1:LEN),' ').EQ.0) THEN - INPUT = TODAY(1:INDEX(TODAY(2:),' ')+1)//INPUT - END IF - - CALL STR$UPCASE(INPUT,INPUT) ! Convert to upper case - IER = SYS$BINTIM(INPUT,EXTIME)F - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - GO TO 5R - END IF - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,)I - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - END IF - - IF (INPUT(2:2).EQ.'-') INPUT = '0'//INPUT - IER = COMPARE_DATE(INPUT(1:11),TODAY(1:11)) ! Compare date with today's - IF (IER.EQ.0) IER = COMPARE_TIME(INPUT(13:20),TODAY(13:20)) - IF (IER.LE.0) THEN ! If expiration date not futureL - WRITE(6,1045) ! tell user - GO TO 5 ! and re-request date - END IFT - - IER = 1 - - RETURN= - -1030 FORMAT (' It is ',A23, - &'. Specify when the message should expire:',/,1x,E - &'Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - &'or delta time: dddd hh:mm:ss')h -1040 FORMAT (' ERROR: Invalid date format specified.') -1045 FORMAT (' ERROR: Specified time has already passed.') - - END - diff --git a/decus/vax86c/bulletin/bullsub1.for b/decus/vax86c/bulletin/bullsub1.for deleted file mode 100644 index 607b8de..0000000 --- a/decus/vax86c/bulletin/bullsub1.for +++ /dev/null @@ -1,1454 +0,0 @@ -C -C BULLSUB1.FOR, Version 10/1/86 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*11 INEXDATE - CHARACTER*80 INDESCRIP,INFROM,INPUT - CHARACTER*8 ACCOUNT - CHARACTER NEWEST_DATE_SAVE*11,NEWEST_TIME_SAVE*8 - - NEWEST_DATE_SAVE = NEWEST_DATE ! ADD_ENTRY updates these - NEWEST_TIME_SAVE = NEWEST_TIME ! but LOGIN needs original. - - CALL DISABLE_CTRL - - CALL OPEN_FILE_SHARED(7) - -1 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - END DO - UNLOCK 7 - - IF (IER.NE.0) GO TO 900 - IF (FOLDER_BBOARD.EQ.'NONE') GO TO 1 - IF (FOLDER_NUMBER.EQ.0) THEN - FOLDER_SET = .FALSE. - ELSE - FOLDER_SET = .TRUE. - FOLDER_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - IF (GROUPB.NE.0.OR.USERB.NE.0) THEN ! If normal BBOARD user - CALL CHECK_MAIL(FOLDER_BBOARD,COUNT) ! Any new VMS mail? - IF (COUNT.EQ.0) GO TO 1 ! None. - END IF - -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME) ! Get present username - CALL GETACC(ACCOUNT) ! Get present account - CALL GETUIC(GROUP,USER) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(GROUPB,USERB) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(1:LEN_B)// - & FOLDER_BBOARD(1:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (GROUPB.NE.0.OR.USERB.NE.0) THEN ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B) - & //'BOARD.COM','NL:','NL:',,,,STATUS) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(1:LEN_B)//'BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(1:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B) - & //'BOARD.COM','NL:','NL:',,,,STATUS) - END IF - ELSE - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B)//FOLDER_BBOARD - & (1:TRIM(FOLDER_BBOARD))//'.COM','NL:','NL:',,,,STATUS) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',,,,STATUS) - END IF - END IF - ! Create sequential mail file - CALL SETACC(ACCOUNT) ! Reset to original account - CALL SETUSER(USERNAME) ! Reset to original username - CALL SETUIC(GROUP,USER) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_DIRECTORY(1:LEN_B)//FOLDER_BBOARD - & (1:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - -5 LEN = 1 - DO WHILE (LEN.GT.0) - READ (3,'(Q,A)',END=100) LEN,INPUT ! Read next line from mail - IF (INPUT(1:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(1:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - END IF - END DO - - -C -C Add bulletin to bulletin file and directory entry to directory file. -C - -10 CALL OPEN_FILE(2) ! Prepare to add dir entry - - READ (3,'(Q,A)',IOSTAT=IER) LEN,INPUT ! Read first line - IF (IER.NE.0) GO TO 100 ! If end of file, exit - IF (LEN.EQ.1.AND.INPUT(1:1).EQ.CHAR(12)) GO TO 5 - ! If line is just form feed, the message is empty - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - OCOUNT = NBLOCK + 1 ! Initialize line count - - SPACE = INDEX(INFROM,' ') - 1 ! Strip off the date - IF (SPACE.GT.0) INFROM = INFROM(1:SPACE)! From the "From:" line - - IF (TRIM(INFROM).GT.12) THEN ! Is length > allowable? - LEN_INFROM = TRIM(INFROM) - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(1:LEN_INFROM), - & OCOUNT) - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) - I = 12 ! Trim username to first non-alpha character - DO WHILE (I.GT.1.AND. - & ((INFROM(I:I).GE.'A'.AND.INFROM(I:I).LE.'Z').OR. - & (INFROM(I:I).GE.'a'.AND.INFROM(I:I).LE.'z')) ) - I = I - 1 - END DO - IF (I.GT.1) INFROM = INFROM(1:I-1) - END IF - - LEN_DESCRP = TRIM(INDESCRIP) - IF (LEN_DESCRP.GT.53) THEN ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//INDESCRIP(1:LEN_DESCRP), - & OCOUNT) - INDESCRIP = INDESCRIP(1:LEN_DESCRP) - DO I=1,LEN_DESCRP - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - ELSE - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - END IF - - ISTART = 0 - NBLANK = 0 - DO WHILE (INPUT(1:1).NE.CHAR(12)) ! Move text to bulletin file - IF (LEN.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - NBLANK = 0 - LEN = MIN(LEN,80) - CALL STORE_BULL(LEN,INPUT,OCOUNT) - END IF - READ (3,'(Q,A)',END=25) LEN,INPUT - END DO - -25 CALL FLUSH_BULL(OCOUNT) - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - DESCRIP = INDESCRIP(1:53) ! Description header - FROM = INFROM(1:12) ! Username - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - EXTIME = '00:00:00' - LENGTH = OCOUNT - NBLOCK ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - IF (FOLDER_NUMBER.EQ.0) THEN ! Update the newest date/time - NEWEST_DATE_SAVE = NEWEST_DATE ! that we're saving for LOGIN - NEWEST_TIME_SAVE = NEWEST_TIME ! only if we added general bull. - END IF - -30 CALL CLOSE_FILE(2) ! Totally finished with add - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - GOTO 1 - -900 FOLDER_NUMBER = 0 - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=0,KEYID=1) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - CALL CLOSE_FILE(7) - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - NEWEST_TIME = NEWEST_TIME_SAVE - NEWEST_DATE = NEWEST_DATE_SAVE - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - WRITE (6,1030) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:' - & ,,,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL EXE$GL_ABSTIM - INTEGER UPTIME(2),SYSTIME(2),UPSINCE(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - UPTIME(1) = GET_L_VAL(EXE$GL_ABSTIM) ! Up time (sec) - - CALL LIB$EMUL(10000000,UPTIME,0,UPTIME) ! 64 bit format - CALL SYS$GETTIM(SYSTIME) - CALL LIB$SUBX(SYSTIME,UPTIME,UPSINCE) - CALL SYS$ASCTIM(,ASCSINCE,UPSINCE,) ! Up since - - UPTIME_DATE = ASCSINCE(1:11) - UPTIME_TIME = ASCSINCE(13:20) - - RETURN - END - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(USER,NEW_MESSAGES) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*35,USER*(*) - EQUIVALENCE (INPUT(34:),COUNT) - - OPEN (UNIT=10,FILE='VMSMAIL',DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED) - READ(10,'(A)',KEY=USER,IOSTAT=IER) INPUT - CLOSE (10) - - NEW_MESSAGES = COUNT - - IF (IER.NE.0) COUNT = 0 - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C -C NOTE: These routines don't presently allow return length address -C in item list. -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entries in user file of users that no longer exist. -C - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CALL OPEN_FILE_SHARED(8) - - READ (4,'(A12)',ERR=20,KEYGE=USER_HEADER) LOGIN_USER - ! Move pointer to top of file - -5 READ (4,'(A12)',ERR=20) LOGIN_USER ! Get user entry - READ (8,KEY=LOGIN_USER,ERR=10) LOGIN_USER ! See if user exists - GO TO 5 ! If so, get next user entry - -10 DELETE(UNIT=4) ! Delete non-existant user - GO TO 5 ! Go get next user entry - -20 CALL CLOSE_FILE(8) ! All done... - -30 RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. Thee -C bulletin file is assumed to be opened on logical unit 1. -CB - - IMPLICIT INTEGER (A - Z)T - - INCLUDE 'BULLDIR.INC' - - CHARACTER INPUT*80A - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)')I - END DOE - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0I - LENGTH = 0I - DO WHILE (1)R - LEN = 0C - DO WHILE (LEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) LEN,INPUT - LEN = MIN(LEN,TRIM(INPUT),80) - IF (LEN.GT.1.AND.ICHAR(INPUT(LEN:LEN)).EQ.10) THENS - INPUT(LEN-1:LEN-1) = CHAR(32) ! Remove imbedded - INPUT(LEN:LEN) = CHAR(32) ! CR/LFs at end of file.M - LEN = LEN - 2 - END IF - IF (LEN.GT.0) THEN - ICOUNT = ICOUNT + 1 - ELSE IF (LEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THENT - NBLANK = NBLANK + 1 - END IFB - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DOI - LENGTH = LENGTH + NBLANK*2_ - NBLANK = 0O - END IF - CALL STORE_BULL(LEN,INPUT,OCOUNT)S - LENGTH = LENGTH + LEN + 1R - END DOR - -100 LENGTH = (LENGTH+127)/128R - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSEO - IER = 0 - END IFG - - CALL FLUSH_BULL(OCOUNT) - - RETURNm - END - - - - SUBROUTINE STORE_BULL(LEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*(BRECLEN) - - DATA POINT/0/ - - IF (LEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - WRITE (1'OCOUNT) OUTPUT(1:POINT). - OUTPUT = CHAR(LEN)//INPUT - POINT = LEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THENc - WRITE (1'OCOUNT) OUTPUT(1:POINT)//CHAR(LEN) - OUTPUT = INPUTR - POINT = LEN - ELSE - WRITE (1'OCOUNT) OUTPUT(1:POINT)//CHAR(LEN) - & //INPUT(1:BRECLEN-1-POINT) - OUTPUT = INPUT(BRECLEN-POINT:)e - POINT = LEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1S - ELSER - OUTPUT(POINT+1:) = CHAR(LEN)//INPUT(1:LEN) - POINT = POINT + LEN + 1 - END IFL - - RETURNI - - ENTRY FLUSH_BULL(OCOUNT)/ - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - WRITE (1'OCOUNT) OUTPUT - POINT = 0 - - RETURN - - END - - - SUBROUTINE GET_BULL(BLOCK,INPUT,LEN)O - - IMPLICIT INTEGER (A-Z)( - - PARAMETER BRECLEN=128,LINE_LENGTH=80 - - CHARACTER INPUT*(*),TEMP*(BRECLEN), LEFT*(BRECLEN)D - - DATA POINT /1/, LEFT_LEN /0/ - - IF (LEN.GT.LINE_LENGTH) THEN( - POINT = 1' - LEFT_LEN = 0 - END IFS - - IF (POINT.EQ.1) THEND - DO WHILE (REC_LOCK(IER)) - READ (1'BLOCK,IOSTAT=IER) TEMPP - END DO - ELSE IF (POINT.EQ.BRECLEN+1) THEN - LEN = 0. - POINT = 1 - RETURN - END IFC - - IF (IER.GT.0) THEN - LEN = -1 - POINT = 1O - LEFT_LEN = 0 - RETURN - END IFA - - IF (LEFT_LEN.GT.0) THEN - LEN = ICHAR(LEFT(1:1)) - INPUT = LEFT(2:LEN-LEFT_LEN+1)//TEMP(1:LEFT_LEN) - POINT = LEFT_LEN + 1 - LEFT_LEN = 0 - ELSE - LEN = ICHAR(TEMP(POINT:POINT)) - IF (LEN.GT.BRECLEN-POINT) THEN - LEFT = TEMP(POINT:) - LEFT_LEN = LEN - (BRECLEN-POINT)' - LEN = 0 - POINT = 1 - ELSE IF (LEN.EQ.0) THENe - POINT = 1 - ELSE - INPUT = TEMP(POINT+1:POINT+LEN) - POINT = POINT+LEN+1 - END IF - END IFT - - RETURNN - - ENTRY TEST_MORE_LINES(LEN)( - - IF (POINT.EQ.BRECLEN+1) THENF - LEN = 0 - ELSE - LEN = ICHAR(TEMP(POINT:POINT)) - END IF' - - RETURN - - END - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C& -C SUBROUTINE DELETE_ENTRY -C( -C FUNCTION: -C To delete a directory entry. -CS -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -CA - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THENi - CALL READDIR(0,IER)U - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IFE - - DELETE(UNIT=2,REC=BULL_ENTRY+1) - - NEMPTY = NEMPTY + LENGTHe - CALL WRITEDIR(0,IER)O - - RETURN, - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -CT -C FUNCTION: Computes expiration date giving number of days to expire.( -C( - IMPLICIT INTEGER (A-Z)! - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12)F - DIMENSION LENGTH(12)F - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP',' - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present datet - - DECODE(2,'(I2)',EXDATE(1:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DON - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSEL - LENGTH(2) = 27 - END IFt - - NUM_DAYS = NDAYS ! Put number of days into buffer variableC - - DO WHILE (NUM_DAYS.GT.0)i - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THENi - ! If expiration date exceeds end of montht - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in monthT - DAY = 1 ! Reset day to first of monthR - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year?F - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IFA - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exitL - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(1:2)) DAY ! Put day into new date( - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date1 - - RETURN - END - - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT)' -C -C SUBROUTINE GET_LINE -CI -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS:I -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C1 -C NOTES:( -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C, - - IMPLICIT INTEGER (A-Z)1 - - LOGICAL*1 DESCRIP(8),DTYPE,CLASSN - INTEGER*2 LENGTHL - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINEi - COMMON /TERM_CHAN/ TERM_CHANP - - INCLUDE '($RMSDEF)' - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITU - LOGICAL DECNET_PROC - - CHARACTER*(*) PROMPTo - LOGICAL*1 USE_PROMPTe - - CHARACTER TAB*1 - DATA TAB/9/ - - USE_PROMPT = .FALSE.u - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -CT -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1E -C! - - FLAG = 0 ! Yep, init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOE - & CTRLC_ROUTINE,FLAG,,,,) ! Enable the AST - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limit_ - POINTER = 0 ! during input. - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -CC - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = LIB$GET_INPUT(DESCRIP,PROMPT) ! Get line from terminal - ELSEI - IER = LIB$GET_INPUT(DESCRIP) ! Get line from terminal - END IFC - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - IER1 = SYS$CANCEL(%VAL(TERM_CHAN)) ! Cancel CTRL-C AST - IF (IER.NE.RMS$_EOF) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of lineI - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs, - MOVE = ((TAB_POINT-1)/8)*8 + 9t - ADD = MOVE - TAB_POINTO - IF (ADD+LEN_INPUT-1.LE.LIMIT) THENO - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1E - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1G - ELSEE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' '1 - END DO - LEN_INPUT = LIMIT+1I - END IF) - END DOH - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so, - END IF - ELSEC - LEN_INPUT = -1 ! If CTRL-C, say so - END IF! - RETURNf - END - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical& - CHARACTER*(*) OUTPUT ! byte to character valueL - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT)( - RETURNA - END - - SUBROUTINE CTRLC_ROUTINE(FLAG) ! CTRL-C AST routineP - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - FLAG = 1 ! to set flag - RETURNt - END - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -Ce -C SUBROUTINE GET_INPUT_NOECHO -Cr -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal and purgem -C type ahead buffer.L -C4 - IMPLICIT INTEGER (A-Z)L - - CHARACTER*(*) DATAE - - EXTERNAL IO$_READVBLK,IO$M_NOECHO,IO$M_PURGEe - - COMMON /TERM_CHAN/ TERM_CHANS - - DO I=1,LEN(DATA)T - DATA(I:I) = ' 't - END DOm - - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO)I - - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, - & %VAL(%LOC(DATA)),%VAL(LEN(DATA)),,,,) - - RETURNI - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminalN - - RETURNA - - ENTRY PURGE_TYPEAHEAD ! Purge type-ahead buffer - - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO)+%LOC(IO$M_PURGE) - - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, - & %VAL(%LOC(IER)),%VAL(0),,,,) ! Purge type ahead bufferP - - RETURNL - END - - - - - - SUBROUTINE GETPAGLEN(PAGE_LENGTH) -CM -C SUBROUTINE GETPAGLEN -CT -C FUNCTION: -C Gets page length of the terminal.T -CR -C OUTPUTS:_ -C PAGE_LENGTH - Page length of the terminal. -CD - IMPLICIT INTEGER (A-Z)_ - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1)))E - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,)& - - PAGE_LENGTH = DEVDEPEND(4)A - - RETURN( - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINALI -CI -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS:N -C SLOW_TERMINAL = .true. if slow, .false. if not.g -Ci - - IMPLICIT INTEGER (A-Z)O - - EXTERNAL IO$_SENSEMODEm - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)'P - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,)d - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE.C - END IF - - RETURNT - END - - - - - SUBROUTINE SHOW_PRIVi -Cl -C SUBROUTINE SHOW_PRIVW -C, -C FUNCTION: -C To show privileges necessary for managing bulletin board.S -CO - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLUSER.INC'e - - INCLUDE '($PRVDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - DO WHILE (REC_LOCK(IER))b - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_DATE,NEWEST_TIME, ! Get newest bulletin - & BBOARD_DATE,BBOARD_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAG - END DOw - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present) - CALL CLOSE_FILE(4)C - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_DATE,NEWEST_TIME, ! Get newest bulletin - & BBOARD_DATE,BBOARD_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAGN - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRVE - NEW_FLAG(2) = 0 - REWRITE (4,FMT=USER_FMT) - & TEMP_USER,NEWEST_DATE,NEWEST_TIME,BBOARD_DATE, - & BBOARD_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAG - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')')U - DO I=0,38! - IF ((I.LT.32.AND.BTEST(NEW_FLAG(1),I)).OR.0 - & (I.GT.31.AND.BTEST(NEW_FLAG(2),I-32))) THEN( - WRITE (6,'(1X,A)') PRIVS(I) - END IFT - END DO - ELSEo - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IFS - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURNc - - END - - - - - SUBROUTINE SET_PRIV -C6 -C SUBROUTINE SET_PRIV -Ct -C FUNCTION: -C To set privileges necessary for managing bulletin board. -CM - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'. - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVSL - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA',n - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/i - - EXTERNAL CLI$_ABSENTt - - DIMENSION ONPRIV(2),OFFPRIV(2)1 - - CHARACTER*8 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THENR - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - OFFPRIV(1) = 0r - OFFPRIV(2) = 0N - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,LEN)S - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - PRIV_FOUND = -1A - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1)E - IF (INPUT_PRIV(:LEN).EQ.PRIVS(I)) PRIV_FOUND = IE - IF (INPUT_PRIV(3:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(1:LEN) - RETURNS - ELSE IF (INPUT_PRIV(1:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THENV - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)E - END IFN - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSER - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32)I - END IFB - END IF - END DOT - - CALL OPEN_FILE(4) ! Get BULLUSER.DAT file - - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_DATE,NEWEST_TIME, ! Get newest bulletin - & BBOARD_DATE,BBOARD_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAGt - - IF (IER.EQ.0) THEN ! If header is present, exit - NEW_FLAG(1) = NEW_FLAG(1).OR.ONPRIV(1) - NEW_FLAG(2) = NEW_FLAG(2).OR.ONPRIV(2) - NEW_FLAG(1) = NEW_FLAG(1).AND.(.NOT.OFFPRIV(1)) - NEW_FLAG(2) = NEW_FLAG(2).AND.(.NOT.OFFPRIV(2))t - REWRITE (4,FMT=USER_FMT) - & TEMP_USER,NEWEST_DATE,NEWEST_TIME,BBOARD_DATE, - & BBOARD_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAG( - WRITE (6,'('' Privileges successfully modified.'')') - ELSEt - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN - - END - - - - - SUBROUTINE GETPRIVO -CT -C SUBROUTINE GETPRIVe -C -C FUNCTION: -C To get process privileges. -C OUTPUTS:e -C PROCPRIV - Returned privileges -Ci - - IMPLICIT INTEGER (A-Z)B - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlisth - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infol - - RETURNd - END - - - - - LOGICAL FUNCTION SETPRV_PRIVI - IMPLICIT INTEGER (A-Z)I - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'I - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_DATE,NEWEST_TIME, ! Get newest bulletin - & BBOARD_DATE,BBOARD_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAG) - END DO - CALL CLOSE_FILE(4) - NEEDPRIV(1) = NEW_FLAG(1) - NEEDPRIV(2) = NEW_FLAG(2) - END IF+ - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR.C - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IFL - - RETURN( - END - - - - LOGICAL FUNCTION OPER_PRIVN - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURNE - END - - - - 1 - SUBROUTINE GETUSER(USERNAME)N -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process.m -C OUTPUTS: -C USERNAME - Username owner of present process. -CE - - IMPLICIT INTEGER (A-Z)E - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistL - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoP - - RETURN/ - END - - - - SUBROUTINE GETACC(ACCOUNT) -CI -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS:R -C ACCOUNT - ACCOUNT owner of present process.: -C - - IMPLICIT INTEGER (A-Z)E - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT))U - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistA - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoD - - RETURNO - END - - - - - SUBROUTINE GETSTS(STS)P -CI -C SUBROUTINE GETSTS -CM -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS:O -C STS - Status word of present process.N -C) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoG - - RETURN - END - - - - - SUBROUTINE HELP(LIBRARY)N - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P) - & ,LIBRARY,,LIB$GET_INPUT) - - RETURN - END - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB)F - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS' - - END - diff --git a/decus/vax86c/bulletin/bullsub2.for b/decus/vax86c/bulletin/bullsub2.for deleted file mode 100644 index 209a419..0000000 --- a/decus/vax86c/bulletin/bullsub2.for +++ /dev/null @@ -1,1478 +0,0 @@ -C -C BULLSUB2.FOR, Version 9/3/86 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C NOTE: Subroutine CHECK_ACCESS which is used to see if user has only read -C access to a folder only works for VMS V4.4 or later. If you have an -C early version, modify as indicated. -C - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - CALL STR$TRIM(INPUT,INPUT,TRIM) - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) RETURN - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - LEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - LEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY & /READNEW are privileged - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW'))) THEN - WRITE (6,'( - & '' ERROR: No privs to change all NOTIFY or READNEW.'')') - RETURN - END IF - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - WRITE (6,'('' Enter one line description of folder.'')') - -10 CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(1:LENDES) ! End fill with spaces - IF (LENDES.LE.0) GO TO 910 - IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - GO TO 10 - END IF - - FOLDER_OWNER = USERNAME ! Get present username - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(1:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',IOSTAT=IER, - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.64) - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Limit of 63 folders has been reached.'')') - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER_NUMBER = LAST_NUMBER - 1 - END IF - - FOLDER_OWNER = USERNAME ! Get present username - FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = 14 - - WRITE (7,FMT=FOLDER_FMT) FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - CALL SET_FOLDER_NOTIFY_READNEW(NOTIFY,READNEW) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(1:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_FILE(7) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - - - SUBROUTINE SET_FOLDER_NOTIFY_READNEW(NOTIFY,READNEW) -C -C SUBROUTINE SET_FOLDER_NOTIFY_READNEW -C -C FUNCTION: Sets NOTIFY or READNEW defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (.NOT.SETPRV_PRIV().AND.INCMD(1:3).EQ.'SET') THEN - WRITE (6,'( - & '' ERROR: No privs to change all NOTIFY or READNEW.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(4) - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) ! Get header - & TEMP_USER,LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME, - & SET_FLAG,NEW_FLAG,NOTIFY_FLAG - END DO - F_POINT = FOLDER_NUMBER/32 + 1 - DO WHILE (IER.EQ.0) - IF (NOTIFY.EQ.0) NOTIFY_FLAG(F_POINT) = - & IBCLR(NOTIFY_FLAG(F_POINT),FOLDER_NUMBER) - IF (NOTIFY.EQ.1) NOTIFY_FLAG(F_POINT) = - & IBSET(NOTIFY_FLAG(F_POINT),FOLDER_NUMBER) - IF (READNEW.EQ.0) SET_FLAG(F_POINT) = - & IBCLR(SET_FLAG(F_POINT),FOLDER_NUMBER) - IF (READNEW.EQ.1) SET_FLAG(F_POINT) = - & IBSET(SET_FLAG(F_POINT),FOLDER_NUMBER) - REWRITE(4,FMT=USER_FMT) TEMP_USER,LOGIN_DATE,LOGIN_TIME, - & READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAG - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEYGT=TEMP_USER,IOSTAT=IER) TEMP_USER, - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG, - & NEW_FLAG,NOTIFY_FLAG ! Find if there is an entry - END DO - IF (TEMP_USER.NE.USER_HEADER.AND. - & (NOTIFY.EQ.-1.OR.READNEW.EQ.-1)) THEN - IER = 1 ! Modify READNEW and NOTIFY for all users - END IF ! only during folder creation or deletion. - END DO - CALL CLOSE_FILE(4) - - RETURN - END - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) FOLDER1, - & FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP ! See if it exists - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(1:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL OPEN_FILE(2) ! Remove directory file - CALL OPEN_FILE(1) ! Remove bulletin file - CALL CLOSE_FILE_DELETE(1) - CALL CLOSE_FILE_DELETE(2) - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_NOTIFY_READNEW(0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) FOLDER_SET = .FALSE. - -1000 CALL CLOSE_FILE(7) - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL CLI$_ABSENT - - DIMENSION FIRST_TIME(2) ! Bit set for folder if folder has - DATA FIRST_TIME /2*0/ ! been selected before this. - - IF (OUTPUT) IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1,LEN) - ! Get folder name - - CALL OPEN_FILE_SHARED(7) ! Go find folder - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.EQ.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER_SET = .FALSE. - DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,KEY=FOLDER_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE - END DO - IF (OUTPUT) THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(1:TRIM(FOLDER))//'.' - BULL_POINT = 0 ! Reset bulletin pointer to first bulletin - END IF - IER = 1 - CALL CLOSE_FILE(7) - READ_ONLY = .FALSE. - ELSE - DO WHILE (REC_LOCK(IER)) - IF (OUTPUT.OR.FOLDER_NUMBER.EQ.-1) THEN - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - READ (7,FMT=FOLDER_FMT,KEY=FOLDER_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE - END IF - END DO - - CALL CLOSE_FILE(7) - - IF (IER.EQ.0) THEN ! Folder found - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHKACL - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER) THEN - FOLDER_SET = .TRUE. - - FOLDER = FOLDER1 ! Folder successfully set - FOLDER_NUMBER = FOLDER1_NUMBER ! so update permanent folder - FOLDER_OWNER = FOLDER1_OWNER ! parameters. - FOLDER_DESCRIP = FOLDER1_DESCRIP - FOLDER_BBOARD = FOLDER1_BBOARD - FOLDER_BBEXPIRE = FOLDER1_BBEXPIRE - FOLDER_FILE = FOLDER1_FILE - - F_POINT = FOLDER_NUMBER/32 + 1 - IF (OUTPUT) THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(1:LEN)//'.' - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT) - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE. - END IF - END IF - - IF (.NOT.BTEST(FIRST_TIME(F_POINT),FOLDER_NUMBER)) THEN - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (IER.LE.0) CALL UPDATE ! Need to update - END IF - CALL CLOSE_FILE(2) - FIRST_TIME(F_POINT)=IBSET(FIRST_TIME(F_POINT),FOLDER_NUMBER) - END IF - IF (OUTPUT.AND.BTEST(NEW_FLAG(F_POINT),FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(0,2) - CALL FIND_NEWEST_BULL ! See if there are new bulletins - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - IER = 1 - ELSE IF (OUTPUT) THEN - IF (IER.EQ.RMS$_PRV) THEN - WRITE (6,'('' You are not allowed to access folder.'')') - WRITE (6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(1:TRIM(FOLDER1_OWNER))8 - ELSE - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - END IFP - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')')r - IER = 0 - END IF - END IFs - - RETURN. - - END - - - - SUBROUTINE SHOW_FOLDERv -Ci -C SUBROUTINE SHOW_FOLDER -CI -C FUNCTION: Shows the information on any folder.S -C) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'_ - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT - - CALL OPEN_FILE_SHARED(7) ! Open folder file - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).NE.%LOC(CLI$_ABSENT)) - & THEN -10 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPBB - END DO - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))//A - & FOLDER1i - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_FILE(7)n - RETURNc - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(1:TRIM(FOLDER1_DESCRIP)) - END IF - ELSE IF (FOLDER_SET) THEN - WRITE (6,1000) FOLDER,FOLDER_OWNER,C - & FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP)) - FOLDER1_FILE = FOLDER_FILE - FOLDER1_BBOARD = FOLDER_BBOARD - FOLDER1_BBEXPIRE = FOLDER_BBEXPIRE - FOLDER1_NUMBER = FOLDER_NUMBER - ELSE) - FOLDER1 = 'GENERAL'$ - GO TO 10 - END IFE - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL, - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.RMS$_PRV) THENA - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - WRITE (6,'('' Folder is not a private folder.'')') - ELSE) - CALL SHOWACL(FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IFN - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD.NE.'NONE') THEN_ - LEN = TRIM(FOLDER1_BBOARD)s - IF (LEN.GT.0) THENT - WRITE (6,'('' BBOARD for folder is '',A,''.'')')E - & FOLDER1_BBOARD(1:LEN)A - END IFT - IF (USERB.EQ.0.AND.GROUPB.EQ.0) THENS - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')L - END IFC - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' BBOARD expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIREC - ELSE - WRITE (6,'('' BBOARD messages will not expire.'')'): - END IFa - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IFi - CALL OPEN_FILE_SHARED(4) - DO WHILE (REC_LOCK(IER))p - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME, - & SET_FLAG,NEW_FLAG,NOTIFY_FLAG - END DOF - F_POINT = FOLDER1_NUMBER/32 + 1 - IF (BTEST(SET_FLAG(F_POINT),FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is READNEW.'')')E - ELSEA - WRITE (6,'('' Default is NOREADNEW.'')')A - END IF( - IF (BTEST(NOTIFY_FLAG(F_POINT),FOLDER1_NUMBER)) THEND - WRITE (6,'('' Default is NOTIFY.'')') - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF2 - CALL CLOSE_FILE(4), - END IF - END IFA - - CALL CLOSE_FILE(7)T - - RETURNr - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12,_ - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT)N -C -C SUBROUTINE DIRECTORY_FOLDERSL -C, -C FUNCTION: Display all FOLDER entries. -CD - IMPLICIT INTEGER (A - Z)L - - INCLUDE 'BULLFOLDER.INC'E - - COMMON /PAGE/ PAGE_LENGTH - - DATA SCRATCH_D1/0/d - - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - -C' -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory' -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.L -CP - - IF (SCRATCH_D1.EQ.0) THEN ! Is queue empty?E - CALL LIB$GET_VM(132,SCRATCH_D) ! If so, allocated memory - CALL MAKE_CHAR(%VAL(SCRATCH_D),120) ! Form a character stringl - SCRATCH_D1 = SCRATCH_D ! Init header pointer - ELSE ! Else queue is not emptyi - SCRATCH_D = SCRATCH_D1 ! so reinit queue pointerI - END IF ! to the header. - - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDER = 0I - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from filer - DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,KEYGT=FOLDER1,KEYID=0,IOSTAT=IER)F - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - END DO - IF (IER.EQ.0) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER_COM) - END IF - END DOh - - CALL CLOSE_FILE(7) ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IF' - -C -C Folder entries are now in queue. Output queue entries to screen. -CO - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*2,PAGE_LENGTH-4) - ! If more entries then page size, truncate output - DO I=FOLDER_COUNT,FOLDER_COUNT+DISPLAY/2-1E - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER_COM) - WRITE (6,1000) FOLDER1,FOLDER1_OWNER,FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counter' - END DOE - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0.E - ELSEa - WRITE(6,1010) ! Else say there are moreL - END IFD - - RETURN - -1000 FORMAT(' Folder: ',A25,' Owner: ',A12,' Description:',/,1X,A80) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -CO -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID.N -CS -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access, -CN - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLFOLDER.INC'C - - INCLUDE 'BULLUSER.INC'L - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'B - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT= - - CHARACTER ID*25,RESPONSE*1) - - IF (CLI$PRESENT('ALL')) THEN' - ALL = .TRUE. - ELSEF - ALL = .FALSE. - END IFE - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE.s - ELSEs - READONLY = .FALSE. - END IFR - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name1 - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THENT - IF (.NOT.FOLDER_SET) THENT - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN.GT.25) THENl - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')f - RETURN - END IF - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',ID,LEN) ! Get IDW - IF (LEN.GT.25) THENe - WRITE(6,'('' ERROR: ID name must be < 26 characters.'')') - RETURN= - END IF - END IFL - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP ! See if it existsI - CALL CLOSE_FILE(7)E - - IF ((.NOT.ALL).AND.(ID.EQ.FOLDER1_OWNER)) THEN_ - WRITE (6,'(R - & '' ERROR: Cannot modify access for owner of folder.'')')O - RETURN - END IF) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,L - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSEf - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))//O - & FOLDER1E - CALL CHKACL - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENl - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,S - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THENL - WRITE (6,'('' Folder access was not changed.'')')D - RETURN - ELSE - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)T - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)I - END IF - END IF - IF (ACCESS) THEN - IF (.NOT.ALL) THENF - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER)I - ELSE - CALL ADD_ACL(ID,'R+W',IER)N - END IF - ELSEQ - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL DEL_ACL(' ','R+W',IER) - END IF - END IF( - ELSE - IF (ALL) THEN - CALL DEL_ACL('*','R',IER) - ELSEL - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' ERROR: Cannot modify ACL of folder files.'')') - CALL SYS_GETMSG(IER) - ELSE - WRITE (6,'('' Access to folder has been modified.'')') - END IF - END IFE - - RETURND - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -CN -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check.C -C IERACL - Error returned for attempt to open file.N -CE - - IMPLICIT INTEGER (A-Z)T - - CHARACTER*(*) FILENAMEF - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)'I - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THENF - IERACL = SS$_NORMAL.OR.IERACLI - ELSE( - CALL DISABLE_PRIVS - IERACL = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,E - & %VAL(ACL_ITMLST),,,)F - CALL ENABLE_PRIVS - END IF, - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C) -C SUBROUTINE CHECK_ACCESS -CF -C FUNCTION: Checks ACL of given file. -CR -C PARAMETERS: -C FILENAME - Name of file to check.L -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -CN -C NOTE: SYS$CHECK_ACCESS is only available under V4.4 or later. -C If you have an earlier version, comment out the lines which call -C it and set both READ_ACCESS and WRITE_ACCESS to 1, which will -C allow program to run, but will not allow READONLY access feature.U -CR - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*) - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME,L - & %VAL(ACL_ITMLST))_ - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))D - - RETURNF - END - - - - - SUBROUTINE SHOWACL(FILENAME)F -Ce -C SUBROUTINE SHOWACL -CL -C FUNCTION: Shows users who are allowed to read private bulletin. -CT -C PARAMETERS: -C FILENAME - Name of file to check.R -C - IMPLICIT INTEGER (A-Z)F - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAMEe - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))C - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH)M - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURNT - END - - - / - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -CI -C SUBROUTINE READACLE -CF -C FUNCTION: Reads the ACL of a file.e -Ca -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -CP - IMPLICIT INTEGER (A-Z). - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*)H - CHARACTER NOT_ID*3 - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - DO ACCESS_TYPE=1,2P - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - IF ((ACCESS_TYPE.EQ.1.AND.INDEX(ACLSTR,'WRITE').GT.0).OR.E - & (ACCESS_TYPE.EQ.2.AND.INDEX(ACLSTR,'READ)').GT.0)) THENU - START_ID = INDEX(ACLSTR,'=') + 1D - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN1 - START_ID = END_ID - 1 - DO WHILER - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0)U - START_ID = START_ID - 1R - END DOL - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN& - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IFE - END IF - IF (OUTLEN.EQ.0) THEN - IF (ACCESS_TYPE.EQ.1) THEN - WRITE (6,'(& - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(I - & '' These users can only read this folder:'')') - END IF - OUTLEN = 1y - END IFO - LEN = END_ID - START_ID + 1 - IF (OUTLEN+LEN-1.GT.80) THENR - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = LEN + 2O - ELSE IF (OUTLEN+LEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)R - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + LEN + 1 - END IFT - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DOD - - RETURNH - END - - - - - SUBROUTINE PRINT -C -C SUBROUTINE PRINTT -C( -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($SJCDEF)' - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*80 INPUT. - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been readF - WRITE(6,1010) ! Write error - RETURN ! And return. - END IF - - CALL OPEN_FILE_SHARED(2)e - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinn - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030) - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF) - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATEn - END IFd - - LEN =81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0)' - CALL GET_BULL(I,INPUT,LEN)( - IF (LEN.GT.0) WRITE(3,'(A)') INPUT(1:TRIM(INPUT)) - END DO - LEN = 80 - END DOS - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1)n - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,LEN) ! Get queue name - IF (LEN.EQ.0) THENT - QUEUE = 'SYS$PRINT'n - LEN = 9r - END IF - - CALL ADD_2_ITMLST(LEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IFA - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - 7 - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)O - IF (IER.AND.(.NOT.JBC_ERROR)) THENS - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IFE - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURNC - -900 CALL ERRSNS(IDUMMY,IER)R - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - CLOSE (UNIT=3,STATUS='DELETE')R - CALL CLOSE_FILE(1)C - WRITE(6,1000) - CALL SYS_GETMSG(IER)T - - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.')R -1010 FORMAT(' ERROR: You have not read any message.')D -1030 FORMAT(' ERROR: Specified message was not found.')B -1040 FORMAT(' Message ',I3,' written to ',A) -1050 FORMAT('Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/)K - - END - - - - SUBROUTINE SET_BBOARD(BBOARD) -C/ -C SUBROUTINE SET_BBOARD -C. -C FUNCTION: Set username for BBOARD for selected folder.N -CA - IMPLICIT INTEGER (A-Z) - - PARAMETER UAF$V_DISACNT = 4 - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'A - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12V - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')')_ - RETURN - END IFN - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - - CALL OPEN_FILE(7) ! Open folder fileB - READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER)) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THENl - CALL GET_UAF: - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER)R - IF (IER.AND..NOT.BTEST(FLAGS,UAF$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'L - & ('' ERROR: BBOARD account needs DISUSER flag set.'')') - IER = 0 - END IFU - IF (IER) THEN - READ (7,FMT=FOLDER_FMT,KEY='GENERAL',KEYID=0,IOSTAT=IER)F - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIREE - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR.E - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - READ (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP' - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIREi - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_FILE(7)A - RETURNm - ELSE - READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER)B - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE - FOLDER_BBOARD = INPUT_BBOARDN - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = 0 ! Set UIC to [0,0] to indicate to useN - GROUPB = 0 ! special procedure to check BBOARD mailh - END IF - END IF - ELSEe - CALL CLOSE_FILE(7) - RETURN - END IFr - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = 0 - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD)o - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THENa - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')')u - END IFT - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THENP - IF (EX_LEN.GT.3) EX_LEN = 3e - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '',S - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_FILE(7) - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')')N - CALL CLOSE_FILE(7) - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE'F - END IF - - REWRITE (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - CALL CLOSE_FILE(7) - WRITE (6,'('' BBOARD has been modified for folder.'')')D - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')')L - END IF - - RETURNR - END - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z)e - - PARAMETER UAF$V_DISACNT = 4, UAF$L_UIC = '24'XD - PARAMETER UAF$L_ACCOUNT = 53i - PARAMETER UAF$L_FLAGS = '1D4'X - PARAMETER INPUT_LEN = UAF$L_FLAGS + 4 - - CHARACTER INPUT*(INPUT_LEN),USERNAME*(*),ACCOUNT*(*)= - - EQUIVALENCE (INPUT(UAF$L_UIC+1:),USER2) - EQUIVALENCE (INPUT(UAF$L_UIC+3:),GROUP2), - EQUIVALENCE (INPUT(UAF$L_FLAGS+1:),FLAGS2)O - - INTEGER*2 USER2,GROUP2R - - CALL OPEN_FILE_SHARED(8)A - - READ (8,KEY=USERNAME,IOSTAT=IER) INPUT - ! Move pointer to top of fileR - - CALL CLOSE_FILE(8) - - IF (IER.NE.0) THENe - CALL ERRSNS(IDUMMY,IER)O - WRITE (6,'() - & '' ERROR: Specified username cannot be verified.'')')o - CALL SYS_GETMSG(IER) - ELSE, - FLAGS = FLAGS2 - IER = 1L - USER = USER2 - GROUP = GROUP2 - ACCOUNT = INPUT(UAF$L_ACCOUNT:UAF$L_ACCOUNT+7) - END IF0 - - RETURN/ - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z)S - - INTEGER*4 EXBLK(4)E - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1l - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN. - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT. - - CALL INIT_ITMLSTS - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST)S - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - diff --git a/decus/vax86c/bulletin/bullsub3.for b/decus/vax86c/bulletin/bullsub3.for deleted file mode 100644 index 9d32f15..0000000 --- a/decus/vax86c/bulletin/bullsub3.for +++ /dev/null @@ -1,1638 +0,0 @@ -C -C BULLSUB3.FOR, Version 10/30/86 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE(INPUT) -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C -C INPUT: -C INPUT - Unit number of file to close out. -C 1 = BULLETIN.DAT -C 2 = BULLDIR.DAT -C 4 = BULLUSER.DAT -C 7 = BULLFOLDER.DAT -C 8 = SYS$SYSTEM:SYSUAF.DAT -C - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT) - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE(INPUT) - - IMPLICIT INTEGER (A-Z) - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT,STATUS='DELETE') - - RETURN - END - - - SUBROUTINE OPEN_FILE(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - EXTERNAL BULLDIR_ERR,BULLETIN_ERR,BULLUSER_ERR,BULLFOLDER_ERR - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2) - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - IF (TIMEEFN.EQ.0) CALL LIB$GET_EF(TIMEEFN) - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (INPUT.EQ.2) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - IF (FOLDER_SET) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='UNKNOWN',IOSTAT=IER, - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - ELSE - OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='UNKNOWN', - 1 IOSTAT=IER, - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFILES - END IF - END DO - END IF - - IF (INPUT.EQ.1) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - IF (FOLDER_SET) THEN - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - ELSE - OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='UNKNOWN', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFILE - END IF - END DO - END IF - - IF (INPUT.EQ.4) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=74, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=74, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER,NEWEST_DATE,NEWEST_TIME, - 1 BBOARD_DATE,BBOARD_TIME,0,0,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - 1 PRV$M_SETPRV,0,0,0 - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - END IF - END DO - END IF - - IF (INPUT.EQ.7) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLFOLDER_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED', - 1 RECORDSIZE=FOLDER_RECORD, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - 1 ACCESS='KEYED',RECORDTYPE='FIXED', - 1 RECORDSIZE=FOLDER_RECORD, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER1) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - END IF - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - IER = SYS$CANTIM(,) ! Successful, so cancel timer. - - RETURN - END - - SUBROUTINE TIMER_ERR - - IMPLICIT INTEGER (A-Z) - - ENTRY BULLDIR_ERR - WRITE(6,'('' ERROR: Unable to open directory file after 30 secs.'')') - GO TO 10 - - ENTRY BULLETIN_ERR - WRITE(6,'('' ERROR: Unable to open message file after 30 secs.'')') - GO TO 10 - - ENTRY BULLUSER_ERR - WRITE(6,'('' ERROR: Unable to open BULLUSER.DAT after 30 secs.'')') - GO TO 10 - - ENTRY BULLFOLDER_ERR - WRITE(6,'('' ERROR: Unable to open BULLFOLDER.DAT after 30 secs.'')') - GO TO 10 - -10 CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL LNM_MODE_EXEC - - CALL DISABLE_CTRL - - IF (INPUT.EQ.2) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (FOLDER_SET) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 SHARED,READONLY,IOSTAT=IER) - ELSE - OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 SHARED,READONLY,IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFILES - END IF - END DO - END IF - - IF (INPUT.EQ.1) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (FOLDER_SET) THEN - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - ELSE - OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='OLD', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFILE - END IF - END DO - END IF - - IF (INPUT.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=74,IOSTAT=IER, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED, - 1 KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - END IF - END DO - END IF - - IF (INPUT.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED', - 1 RECORDSIZE=FOLDER_RECORD,IOSTAT=IER, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED, - 1 KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - END IF - - IF (INPUT.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.INPUT.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - CALL OPEN_FILE(INPUT) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL ENABLE_CTRL_EXIT - END IF - - RETURN - END - - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 INPUT,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - IF (FOLDER_SET) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 SHARED,READONLY,IOSTAT=IER) - ELSE - EODIR = MAX(INDEX(BULLDIR_FILE,':'),INDEX(BULLDIR_FILE,']')) - SUFFIX = INDEX(BULLDIR_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLDIR_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLDIR_FILE,NEW_FILE) - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 SHARED,READONLY,IOSTAT=IER) - END IF - - IF (IER.NE.0) THEN ! Error. Why? - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IF (FOLDER_SET) THEN - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=80, - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - ELSE - EODIR = MAX(INDEX(BULLETIN_FILE,':'),INDEX(BULLETIN_FILE,']')) - SUFFIX = INDEX(BULLETIN_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLETIN_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLETIN_FILE,NEW_FILE) - OPEN (UNIT=10,FILE=NEW_FILE,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=80, - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - END IF - - IF (IER.NE.0) THEN ! Error. Why? - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - - IF (FOLDER_SET) THEN - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - 1 FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 IOSTAT=IER) - ELSE - OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=81, - 1 FORM='FORMATTED',IOSTAT=IER) - - OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 IOSTAT=IER) - END IF - - NEWEST_EXTIME = '00:00:00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 INPUT,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_FILE(2) - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - - CALL OPEN_FILE(7) - -100 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - END DO - - IF (FOLDER_NUMBER.GT.0) THEN - FOLDER_SET = .TRUE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - 1 ,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - ELSE - FOLDER_SET = .FALSE. - EODIR = MAX(INDEX(BULLETIN_FILE,':'),INDEX(BULLETIN_FILE,']')) - SUFFIX = INDEX(BULLETIN_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLETIN_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLETIN_FILE,NEW_FILE) - OPEN (UNIT=10,FILE=NEW_FILE,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - END IF - - IF (IER.NE.0) THEN ! Error. Why? - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IF (FOLDER_NUMBER.GT.0) THEN - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - ELSE - OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - END IF - - CALL OPEN_FILE(2) - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') INPUT - LEN = TRIM(INPUT) - IF (LEN.EQ.0) LEN = 1 - CALL STORE_BULL(LEN,INPUT,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_FILE(2) - GOTO 100 - -200 CALL OPEN_FILE_SHARED(2) - - FOLDER_SET = .FALSE. - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - DIMENSION ADD_USER(6) - DATA ADD_USER/0,0,2*ZFFFFFFFF,2*0/ - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'r - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - RECL = 42 - IER = 1 - DO WHILE (IER.NE.0.AND.RECL.NE.74)I - RECL = RECL + 8T - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=RECL, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,T - 1 KEY=(1:12:CHARACTER))4 - END DOE - - IF (IER.EQ.0) THENL - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)E - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',P - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=74,IOSTAT=IER, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',L - 1 KEY=(1:12:CHARACTER)) - END IFC - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)' - CALL SYS_GETMSG(IER1)L - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXITD - END IFT - - IF (RECL.LE.58) RECL = 50 - ADD_WORD = (74-RECL)/4I - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) WRITE (4,'(A,A4)') - & BUFFER,(ADD_USER(I),I=7-ADD_WORD,6) - END DO - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4)E - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection) - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR, -CO -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -CI -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1., -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS:E -C ICOUNT - The last record read by this routine. -CE - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /PROMPT/ COMMAND_PROMPTO - CHARACTER*39 COMMAND_PROMPT - - CHARACTER*2 CFOLDER_NUMBERA - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (2'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - END DO - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) - CALL CLEANUP_DIRFILE(1) - END IF - IF (NEMPTY.EQ.' ') NEMPTY = 0E -CI -C Check to see if cleanup of empty file space is necessary, which isK -C defined here as being 50 blocks (200 128byte records). Also checkE -C to see if cleanup was in progress but didn't properly finish. -CT - IF (NEMPTY.GT.200) THEN - WRITE (CFOLDER_NUMBER,'(I2)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX(' - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE= - DO WHILE (REC_LOCK(IER)) - READ(2'ICOUNT+1,1010,IOSTAT=IER)Y - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCK - END DO - END IF, - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - RETURN - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4)I -1010 FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4)0 - - END - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -CT -C SUBROUTINE WRITEDIR -CE -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file.R -CS -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.E -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z)E - - INCLUDE 'BULLDIR.INC' - - IF (BULLETIN_NUM.EQ.0) THEN - WRITE (2'1,1000,IOSTAT=IER) NEWEST_EXDATE,NEWEST_EXTIME, - & NEWEST_DATE,NEWEST_TIME,D - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - ELSE - WRITE(2'BULLETIN_NUM+1,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCK1 - END IF= - - RETURNe - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4)O - - END - - - SUBROUTINE TRUNCATE_FILE(TRUNC_SIZE) - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /USER_OPEN/ CHANNEL,STATUS,SIZEA - - EXTERNAL USER_OPEN$TRUNCATE - - CALL DISABLE_CTRL - - DO WHILE (FILE_LOCK(IER,IER1)) - IF (FOLDER_SET) THEN - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))I - 1 //'.BULLFIL',STATUS='OLD',I - 1 INITIALSIZE=TRUNC_SIZE,USEROPEN=USER_OPEN$TRUNCATE, - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER)M - ELSE - OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='OLD', - 1 INITIALSIZE=TRUNC_SIZE,USEROPEN=USER_OPEN$TRUNCATE, - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - END IF - END DOD - - CLOSE (1) - CALL ENABLE_CTRLl - - RETURNi - - END - - - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -CT -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deletedE -C or added._ -C - IMPLICIT INTEGER (A - Z)l - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'W - - INCLUDE '($BRKDEF)' - - CHARACTER*11 TEMP_DATEt - CHARACTER*8 TEMP_TIME - CHARACTER READ_DATE_SAVE*12,READ_TIME_SAVE*8h - - CHARACTER*160 OUTPUT - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - - DIMENSION SAVE_NEW_FLAG(2) - -CI -C We want to keep the last read date for comparison when selecting newR -C folders, so save it for later restoring.I -CL - - READ_DATE_SAVE = READ_DATE - READ_TIME_SAVE = READ_TIME, - - CALL OPEN_FILE_SHARED(4)T - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated,) -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - DO WHILE (REC_LOCK(IER))V - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,TEMP_DATE,TEMP_TIME,BBOARD_DATE,BBOARD_TIME_ - & ,SET_FLAG,NEW_FLAG,NOTIFY_FLAGR - END DO - - IF (IER.NE.0) THENF - CALL CLOSE_FILE(4) - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - REWRITE (4,FMT=USER_FMT) - & TEMP_USER,NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME - & ,SET_FLAG,NEW_FLAG,NOTIFY_FLAG, - END IFL - -C -C Set flags in all user entries that have SET READNEW on the particular -C folder to indicate that a new bulletin is present for the particular folder.= -C Also send broadcast if notify flag set. -C - OUTPUT = BELL//CR//LF//LF//'New bulletin added to folder '// - & FOLDER(1:TRIM(FOLDER))//'. From: '//FROM(1:TRIM(FROM))// - & CR//LF//'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IF (.NOT.ADD_BULL) THEN - SAVE_NEW_FLAG(1) = NEW_FLAG(1) - SAVE_NEW_FLAG(2) = NEW_FLAG(2) - END IF - - F_POINT = FOLDER_NUMBER/32 + 1) - IER = 0 - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,IOSTAT=IER) TEMP_USER, - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG - & ,NOTIFY_FLAG - END DO - SAVE_FLAG = NEW_FLAG(F_POINT) - IF ((IER.EQ.0).AND.(TEMP_USER.NE.FROM.OR..NOT.ADD_BULL)) THEN - IF (ADD_BULL) THENO - NEW_FLAG(F_POINT) = IBSET(NEW_FLAG(F_POINT),FOLDER_NUMBER) - IF (BTEST(NOTIFY_FLAG(F_POINT),FOLDER_NUMBER)) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR,TEMP_USER,O - & %VAL(BRK$C_USERNAME),,,,,,,)= - END IF - ELSEE - DIFF = COMPARE_DATE(NEWEST_DATE,READ_DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(NEWEST_TIME,READ_TIME)I - IF (DIFF.LT.0) THEN - NEW_FLAG(F_POINT) =F - & IBCLR(NEW_FLAG(F_POINT),FOLDER_NUMBER) - IF (TEMP_USER.EQ.USERNAME) THENO - SAVE_NEW_FLAG(F_POINT) = NEW_FLAG(F_POINT)E - END IF - END IF - END IFR - IF (SAVE_FLAG.NE.NEW_FLAG(F_POINT)) THEN - REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_DATE, - & LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAGR - & ,NOTIFY_FLAG - END IFE - END IF - END DOS - - NEW_FLAG(1) = SAVE_NEW_FLAG(1)e - NEW_FLAG(2) = SAVE_NEW_FLAG(2)E - - DO WHILE (REC_LOCK(IER))a - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,S - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAGE - & ,NOTIFY_FLAG ! Reobtain present owner's values - ! as calling programs still uses them - END DON - - READ_DATE = READ_DATE_SAVEt - READ_TIME = READ_TIME_SAVEi - - CALL CLOSE_FILE(4)y - - RETURNe - - END - - - - - i - SUBROUTINE ADD_ENTRYe -Cc -C SUBROUTINE ADD_ENTRYd -Cn -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z)I - U - INCLUDE 'BULLDIR.INC' - C - CHARACTER*23 TODAY_TIME - - CALL SYS$ASCTIM(,TODAY_TIME,,)E - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:20)w - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN( - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00' - NBULL = 0L - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF= - - NEWEST_DATE = DATE - NEWEST_TIME = TIMEV - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN) - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME)+ - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIMEF - END IFD - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1N - NBLOCK = NBLOCK + LENGTHF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1O - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IFT - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER), - - CALL WRITEDIR(0,IER)D - - RETURN - END - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -CA -C FUCTION: Compares dates to see which is farther in future., -CE -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date)I -C OUTPUT: -C Returns the difference in days between the two dates.E -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -CB - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2)L - - CALL SYS$BINTIM(DATE1,USER_TIME)N - CALL LIB$DAY(DAY1,USER_TIME)T - - IF (DATE2.NE.' ') THENL - CALL SYS$BINTIM(DATE2,USER_TIME) - ELSEI - CALL SYS$GETTIM(USER_TIME) - END IFT - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2r - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -CL -C FUNCTION COMPARE_TIME -C$ -C FUCTION: Compares times to see which is farther in future.M -CE -C INPUTS: -C TIME1 - First time (hh:mm:ss)E -C TIME2 - Second timeI -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C, - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*8 TEMP2 - - IF (TIME2.EQ.' ') THENL - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:20)5 - ELSE= - TEMP2 = TIME2 - END IFN - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - RETURNT - END - -C------------------------------------------------------------------------- -CX -C The following are subroutines to create a linked-list queue for T -C temporary buffer storage of data that is read from files to beD -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains( -C the address. The address is simply the address of the 3rd word ofT -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has aO -C zero link, it adds a new record for the next write operation. P -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA): - CHARACTER*(*) DATAn - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LENGTH) - RETURNC - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA, - LENGTH = LEN(DATA)f - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD)))L - NEXT = RECORD((LENGTH+12)/4)P - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),LENGTH) - RECORD((LENGTH+12)/4) = NEXT( - RETURNI - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATAR - INTEGER RECORD(1) - LENGTH = LEN(DATA)L - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - NEXT = RECORD((LENGTH+12)/4)G - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR) - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,LEN)E - DIMENSION IARRAY(1) - IARRAY(1) = LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(LEN/4+3) = 0 - RETURN, - END - - - - SUBROUTINE DISABLE_PRIVS= -CX -C SUBROUTINE DISABLE_PRIVSE -C, -C FUNCTION: Disable SYSPRV privileges.R -CA - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - SETPRV(1) = 0 - SETPRV(1) = IBSET(SETPRV(1),PRV$V_SYSPRV) - SETPRV(1) = IBSET(SETPRV(1),PRV$V_WORLD)E - SETPRV(1) = IBSET(SETPRV(1),PRV$V_OPER) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable SYSPRV - - RETURN' - END - - - - SUBROUTINE ENABLE_PRIVS -CE -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable SYSPRV privileges. -CE - - IMPLICIT INTEGER (A-Z)I - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable SYSPRV E - - RETURNI - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -CN -C SUBROUTINE CHECK_PRIV_IOF -CE -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -CT - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200)I - ERROR = 1N - ELSE) - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF0 - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')U - - RETURNL - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG)1 -C -C SUBROUTINE CHANGE_FLAGP -CN -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. I -C If FALSE, clear flag.E -C FLAG - If 1, modify SET_FLAG, if 2, modify NEW_FLAG -C If 3, modify NOTIFY_FLAG -CL - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'E - - DIMENSION FLAGS(2,3)p - EQUIVALENCE (SET_FLAG(1),FLAGS(1,1))O - - LOGICAL CMD - - CHARACTER*23 TODAYN - CHARACTER READ_DATE_SAVE*12,READ_TIME_SAVE*8s - -Cl -C Find user entry in BULLUSER.DAT to update information.N -CE - - CALL OPEN_FILE_SHARED(4) ! Open user fileT - - READ_DATE_SAVE = READ_DATEN - READ_TIME_SAVE = READ_TIMES - - DO WHILE (REC_LOCK(IER)) ! Read old entrye - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,R - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG - & ,NOTIFY_FLAGI - END DO+ - - F_POINT = FOLDER_NUMBER/32 + 1L - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS$ASCTIM(,TODAY,,) - READ_DATE = ' 5-NOV-1956' ! No entry, so make new one - READ_TIME = '11:05:56' ! Fake a read date. Set to the past.' - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) TEMP_USER - & NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME,SET_FLAG,R - & NEW_FLAG,NOTIFY_FLAG - IF (CMD) THENS - FLAGS(F_POINT,FLAG) = O - & IBSET(FLAGS(F_POINT,FLAG),FOLDER_NUMBER) - ELSE - FLAGS(F_POINT,FLAG) = S - & IBCLR(FLAGS(F_POINT,FLAG),FOLDER_NUMBER) - END IF - WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,TODAY(1:11),, - & TODAY(13:20),READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAG - ELSE. - IF (CMD) THEN - FLAGS(F_POINT,FLAG) = e - & IBSET(FLAGS(F_POINT,FLAG),FOLDER_NUMBER) - ELSE - FLAGS(F_POINT,FLAG) = S - & IBCLR(FLAGS(F_POINT,FLAG),FOLDER_NUMBER) - END IF - REWRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,R - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAGE - & ,NOTIFY_FLAG ! Write modified entry - READ_DATE = READ_DATE_SAVE - READ_TIME = READ_TIME_SAVE - END IF7 - - CALL CLOSE_FILE (4) - RETURN0 - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -CU -C SUBROUTINE CONFIRM_PRIV -Co -C FUNCTION: Confirms that given username has SETPRV.L -CN -C INPUTS: -C USERNAME - UsernameI -C OUTPUTS:N -C ALLOW - Returns 1 if account has SETPRV.n -C returns 0 if account has no SETPRV.a -Cn - - IMPLICIT INTEGER (A-Z)P - - CHARACTER*(*) USERNAMEl - - INCLUDE '($PRVDEF)' - - PARAMETER UAF$Q_DEF_PRIV = '1A4'X - - LOGICAL*1 UAF(0:583) - EQUIVALENCE (UAF(UAF$Q_DEF_PRIV),UAF_DEF_PRIV)U - - CALL OPEN_FILE_SHARED(8)e - ALLOW = 0 ! Set return falseI - READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read RecordC - IF (STATUS.EQ.0) THEN ! If username foundA - IF (BTEST(UAF_DEF_PRIV,PRV$V_SETPRV).OR. ! SETPRV or CMRKNLN - & BTEST(UAF_DEF_PRIV,PRV$V_CMKRNL)) THEN ! privileges? - ALLOW = 1 ! Yep - END IF - END IFI - CALL CLOSE_FILE(8)E - RETURN ! ReturnE - END ! EndM - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT,ACCESS)T - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUTN - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$PROCESS',INPUT,ACCESS,i - & %VAL(TRNLNM_ITMLST)) - - RETURNs - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1)E - - IMPLICIT INTEGER (A-Z)i - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN0 - FILE_LOCK = 1F - INIT = .FALSE. - ELSE_ - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)I - IF (IER1.EQ.RMS$_FLK) THEN' - FILE_LOCK = 1R - ELSE - FILE_LOCK = 0_ - INIT = .TRUE.F - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IFR - - RETURNA - END - - - - SUBROUTINE ENABLE_CTRL& - - IMPLICIT INTEGER (A-Z)E - - COMMON /CTRLY/ CTRLYT - - COMMON /CTRL_LEVEL/ LEVEL - - QUIT = 1E - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 04 - LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IFT - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -Cr - END IF - - IF (QUIT.EQ.0) CALL EXITM - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLYo - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/I - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURNT - END - - - - - SUBROUTINE CLEANUP_BULLFILE -CN -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it.R -C( - IMPLICIT INTEGER (A - Z)T - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'I - - CHARACTER FILENAME*132,INPUT*128A - - CALL OPEN_FILE(2) - - CALL READDIR(0,IER) - - IF (FOLDER_SET) THENO - FILENAME = FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL'I - ELSEE - FILENAME = BULLETIN_FILE - END IF - - IF (NEMPTY.GT.0) THEN - - IER = LIB$RENAME_FILE(FILENAME,FILENAME(1:TRIM(FILENAME))//';2') - ! Old file name to version number 2L - - IF (.NOT.IER) RETURN - - OPEN (UNIT=11,FILE=FILENAME(1:TRIM(FILENAME))//';1', - 1 STATUS='UNKNOWN',IOSTAT=IER,' - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - ! Compressed version is number 1 - - CALL OPEN_FILE(1) ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTHE - NBLOCK = NBLOCK + 1 - READ(1'ICOUNT) INPUTI - WRITE(11) INPUT - ICOUNT = ICOUNT + 1 - END DO - END DO - - CALL CLOSE_FILE(1) - CLOSE (UNIT=11)R - - NEMPTY = -1 ! Copying done, but not directory updating. - CALL WRITEDIR(0,IER) - END IFT - - IER = LIB$DELETE_FILE(FILENAME(1:TRIM(FILENAME))//';2') - ! Can safely delete old file, since NEMPTY = -1I - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULLL - CALL READDIR(I,IER)' - BLOCK = NBLOCK + 1 - CALL WRITEDIR(I,IER) - NBLOCK = NBLOCK + LENGTH - END DO* - - READ (2'1,1000,IOSTAT=IER) ! Read directory headerT - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - ! NOTE: Can't use READDIR since it'll call CLEANUP_BULLFILE - - NEMPTY = 0 - CALL WRITEDIR(0,IER) ! Update header to show no empty spaces - - CALL CLOSE_FILE(2)s - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4)b - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)W -Ce -C SUBROUTINE CLEANUP_DIRFILEe -Co -C FUNCTION: Reorder directory file after deletions.t -C Is called either directly after a deletion, or isA -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting processe -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z)U - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER)N - IF (IER.NE.I+1) THEN ! Have we found a deleted entry?s - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in filef - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)t - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entriesM - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER)_ - RETURN - END IFA - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entryR - FIRST_DELETE = I ! with negative length4 - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletionT - FIRST_DELETE = I ! was previously in progressA - J = I ! Try to find where entry came from - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)D - BLOCK_SAVE = BLOCK( - K = J + 1 ! Search for duplicate entries - DO WHILE (MOVE_FROM.EQ.0.AND.K.LE.NBULL)( - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO=J+1 - MOVE_FROM=K+1 - ELSE - K = K + 1 - END IFP - END IF - END DO_ - J = J + 1 ! If no duplicate entry found for this - CALL READDIR(J,IER) ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DOG - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessaryI - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER)N - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DOW - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - DELETE(UNIT=2,REC=J+1,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - CALL READDIR(FIRST_DELETE,IER) - LENGTH = -LENGTH ! Fix entry which has negative length' - CALL WRITEDIR(FIRST_DELETE,IER)t - END IFt - - CALL WRITEDIR(0,IER)A - - RETURNA - END - - - SUBROUTINE SHOW_FLAGS -Ci -C SUBROUTINE SHOW_FLAGS -CR -C FUNCTION: Show READNEW and NOTIFY flags.N -Ce - IMPLICIT INTEGER (A - Z)R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC't - - INCLUDE 'BULLFOLDER.INC'I - - LOGICAL SKIP,FLAG_NOTIFY,FLAG_READNEW - DATA SKIP /.FALSE./ - - ENTRY SHOW_NOTIFY - IF (.NOT.SKIP) THEN - FLAG_NOTIFY = .TRUE. - FLAG_READNEW =.FALSE.1 - SKIP = .TRUE.D - END IF) - - ENTRY SHOW_READNEW( - IF (.NOT.SKIP) THEN - FLAG_NOTIFY = .FALSE.T - FLAG_READNEW =.TRUE. - SKIP = .TRUE.= - END IFH - - SKIP = .FALSE.P - -C0 -C Find user entry in BULLUSER.DAT to obtain flags.M -C - - CALL OPEN_FILE_SHARED(4) ! Open user fileI - - DO WHILE (REC_LOCK(IER)) ! Read old entry - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME, - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG - & ,NOTIFY_FLAGI - END DOU - - WRITE (6,'('' For the selected folder '',A,$)') FOLDER(1:TRIM(FOLDER))Y - - F_POINT = FOLDER_NUMBER/32 + 1N - - IF (FLAG_READNEW) THENO - IF (BTEST(SET_FLAG(F_POINT),FOLDER_NUMBER)) THEN - WRITE (6,'(''+, READNEW is set.'')')N - ELSE - WRITE (6,'(''+, READNEW is not set.'')') - END IF - ELSE IF (FLAG_NOTIFY) THENT - IF (BTEST(NOTIFY_FLAG(F_POINT),FOLDER_NUMBER)) THEN - WRITE (6,'(''+, NOTIFY is set.'')') - ELSE - WRITE (6,'(''+, NOTIFY is not set.'')') - END IF - END IFd - - CALL CLOSE_FILE(4), - - RETURNr - END - diff --git a/decus/vax87a/bulletin/bulletin.for b/decus/vax87a/bulletin/bulletin.for deleted file mode 100644 index 8c253c7..0000000 --- a/decus/vax87a/bulletin/bulletin.for +++ /dev/null @@ -1,898 +0,0 @@ -C -C BULLETIN.FOR, Version 1/27/87 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C NOTES: See BULLETIN.TXT for general info. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*11 UPTIME_DATE - CHARACTER*8 UPTIME_TIME - CHARACTER*64 HELP_DIRECTORY - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT) - LEN = 1 - DO WHILE (LEN.GT.0) - LEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (LEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(LEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(1:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - -C -C Test for /LOGIN switch. -C NOTE: /READ has been replaced by the SET READNEW command. -C - - CALL LIB$GET_FOREIGN(INCMD) - - IER = CLI$DCL_PARSE('BULLETIN'//INCMD,BULLETIN_MAINCOMMANDS) - - READIT = 0 - LOGIT = 0 - IF (CLI$PRESENT('LOGIN')) LOGIT = 1 ! Test for /LOGIN switch. - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - END IF - -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - CALL OPEN_FILE_SHARED(2) ! Open directory file - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - CALL CLOSE_FILE(1) - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0) THEN ! Do shutdown bulletins exist? - CALL GET_UPTIME(UPTIME_DATE,UPTIME_TIME) - IER1 = COMPARE_DATE(SHUTDOWN_DATE,UPTIME_DATE) - IF (IER1.EQ.0) IER1 = COMPARE_TIME(SHUTDOWN_TIME,UPTIME_TIME) - IF (IER1.LE.0) SHUTDOWN = 0 - ELSE - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_FILE(4) ! Create user file to be able to set - CALL CLOSE_FILE(4) ! defaults, privileges, etc. - END IF - CALL CLOSE_FILE(2) - - CALL GETSTS(STS) ! Get process status word - - IF (LOGIT.GT.0) THEN ! If BULLETIN/LOGIN then - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - END IF - - IF ((STS.AND.PCB$M_NETWRK).GT.0) THEN - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - ELSE - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - END IF - - CALL ASSIGN_TERMINAL ! Assign terminal - -C -C Get page length for the terminal. -C - - CALL GETPAGLEN(PAGE_LENGTH) - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIT.GT.0) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL UPDATE_READ(NEW_GENERAL_BULL) ! Update last read time - DO FOLDER_NUMBER = 1,63 - IF (TEST2(NEW_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (TEST2(NEW_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE ! Can't select the folder - CALL CHANGE_FLAG(0,2) ! then clear SET_FLAG - END IF - END IF - END DO - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (NEW_GENERAL_BULL) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new general messages.'')') - ELSE - BULL_POINT = 0 - END IF - END IF - ELSE ! READNEW mode. - READ_DONE = -1 - DO FOLDER_NUMBER = 0,63 - IF (TEST2(NEW_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - IF (FOLDER_NUMBER.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE - SAVE_BULL_POINT = BULL_POINT - CALL READNEW - IF (BULL_POINT.NE.SAVE_BULL_POINT - & .AND.READ_DONE.EQ.-1) READ_DONE = FOLDER_NUMBER - END IF - END IF - ELSE ! Can't select the folder - CALL CHANGE_FLAG(0,2) ! then clear SET_FLAG - END IF - END IF - END DO - IF (READ_DONE.GE.0) THEN - IF (READ_DONE.EQ.0) CALL UPDATE_READ(NEW_GENERAL_BULL) - DO FOLDER_NUMBER = 0,63 - IF (TEST2(NEW_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(0,1) ! Clear NEW_FLAG - END IF - END DO - END IF - CALL EXIT - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - - MAIL_STATUS = 1 - - DO WHILE (1) - - IF (MAIL_STATUS) THEN - CALL GET_INPUT_PROMPT(INCMD,IER, - & COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - ELSE - CALL GET_INPUT_PROMPT(INCMD,IER, - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - MAIL_STATUS = 0 - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(1:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9') - IER = IER - 1 - END DO - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - - CALL CLI$GET_VALUE('$VERB',INCMD) ! Get the VERB command - IF (READ_ONLY.AND.(INCMD(1:3).EQ.'ADD'.OR.INCMD(1:3).EQ.'DEL' - & .OR.INCMD(1:3).EQ.'REP')) THEN ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(1:3).EQ.'ADD') THEN ! ADD bulletin command? - CALL ADD ! Go add bulletin - ELSE IF (INCMD(1:4).EQ.'BACK') THEN ! BACK command? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(1:4).EQ.'COPY') THEN ! COPY command? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(1:4).EQ.'CREA') THEN ! CREATE command? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(1:4).EQ.'CURR') THEN ! CURRENT command? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(1:4).EQ.'DELE') THEN ! DELETE command? - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(1:4).EQ.'DIRE') THEN ! DIRECTORY command? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(1:4).EQ.'EXIT'.OR. - & INCMD(1:4).EQ.'QUIT') THEN ! EXIT command? - GO TO 999 ! Exit from program - ELSE IF (INCMD(1:4).EQ.'FILE') THEN ! FILE command? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(1:4).EQ.'HELP') THEN ! HELP command? - IER = LIB$SYS_TRNLOG('BULL$HELP',LEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - LEN = 9 - END IF - CALL HELP(HELP_DIRECTORY(1:LEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(1:4).EQ.'LAST') THEN ! LAST command? - READ_COUNT = -1 - BULL_READ = 99999 - CALL READ(READ_COUNT,BULL_READ) - ELSE IF (INCMD(1:4).EQ.'MAIL') THEN ! MAIL command? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(1:3).EQ.'MOD') THEN ! MODIFY command? - CALL MODIFY_FOLDER - ELSE IF (INCMD(1:4).EQ.'MOVE') THEN ! MOVE command? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(1:4).EQ.'NEXT') THEN ! NEXT command? - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(1:4).EQ.'PRIN') THEN ! PRINT command? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(1:4).EQ.'READ') THEN ! READ command? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(1:3).EQ.'REM') THEN ! REMOVE command? - CALL REMOVE_FOLDER - ELSE IF (INCMD(1:3).EQ.'REP') THEN ! REPLACE command? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(1:3).EQ.'RES') THEN ! RESPOND command? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(1:3).EQ.'SEA') THEN ! SEARCH command? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(1:3).EQ.'SEL') THEN ! SELECT command? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(1:3).EQ.'SET') THEN ! SET command? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(1:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(1:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOT') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL CHANGE_FLAG(1,4) - END IF - ELSE IF (BULL_PARAMETER(1:3).EQ.'NON') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (BULL_PARAMETER(1:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(1:2).EQ.'BR') THEN ! SET BRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET BRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(1,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(1:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOBRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(1:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(1:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(1:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(1:3).EQ.'NOL') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(1:1).EQ.'P') THEN ! SET PRIVILEGES? - CALL SET_PRIV - END IF - ELSE IF (INCMD(1:4).EQ.'SHOW') THEN ! SHOW command? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(1:1).EQ.'B') THEN ! SHOW BRIEF? - CALL SHOW_BRIEF - ELSE IF (BULL_PARAMETER(1:1).EQ.'F') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(1:1).EQ.'N') THEN ! SHOW NOTIFY? - CALL SHOW_NOTIFY - ELSE IF (BULL_PARAMETER(1:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(1:1).EQ.'R') THEN ! SHOW READNEW? - CALL SHOW_READNEW - END IF - END IF - -100 CONTINUE - - END DOu - -999 DO FOLDER_NUMBER = 0,63 - IF (TEST2(NEW_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THENm - CALL CHANGE_FLAG(0,1) ! Clear NEW_FLAG - END IF - END DO. - - CALL EXIT - - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - SUBROUTINE ADDI -CU -C SUBROUTINE ADD -CI -C FUNCTION: Adds bulletin to bulletin file. -CM - IMPLICIT INTEGER (A - Z)U - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODET - CHARACTER*32 NODES(10)_ - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITC - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'N - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE '($SSDEF)', - - INCLUDE '($BRKDEF)' - - CHARACTER INEXDATE*11,INEXTIME*8P - CHARACTER*80 INDESCRIP,INPUTM - - INTEGER TIMADR(2) - -C0 -C The largest message that can be broadcasted is dependent on systemT -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway.f -C, - - PARAMETER BRDCST_LIMIT = 82*12 + 2b - CHARACTER*(BRDCST_LIMIT) BROADn - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - - CHARACTER*80 MAILEDIT,INLINEp - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - EXTERNAL CLI$_ABSENTo - - CALL DISABLE_CTRL ! Disable CTRL-Y & -Ct - - ALLOW = SETPRV_PRIV() - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)C - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRVl - CALL DISABLE_PRIVS ! privileges when trying toi - END IF ! create new file.R - OPEN (UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesX - END IFO - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER)A - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET?N - USERNAME = DEFAULT_USER - CALL CONFIRM_PRIV(USERNAME,ALLOW)N - END IFN - - IF (FOLDER_SET.AND. ! If folder set and - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST switch present?C - & CLI$PRESENT('SHUTDOWN').OR. ! Is /SHUTDOWN switch present? - & CLI$PRESENT('NODES'))) THEN ! Decnet nodes specified?P - WRITE (6,'('' ERROR: Invalid parameter used with folder set.'')')P - RETURN - END IF_ - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privilegesm - WRITE(ERROR_UNIT,1070) ! Tell user - RETURN ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSET - SYSTEM = 0 ! Clear system bit - END IFs - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?L - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - RETURN ! and abort - END IF - END IFR - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?p - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privilegesL - WRITE(ERROR_UNIT,1081) ! Tell user - RETURN ! and abort - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present?E - IF (.NOT.ALLOW) THEN ! If no privilegesf - WRITE(ERROR_UNIT,1082) ! Tell user - RETURN ! and abort - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IF - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER)o - IF (.NOT.IER) GO TO 910_ - INEXDATE = INPUT(1:11) - INEXTIME = INPUT(13:20)1 - END IFb - - LENDES = 54 - DO WHILE (LENDES.GT.53) ! Do until valid description - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fit - END IF - END DOA - -CU -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.0 -CH - O - ICOUNT = 0 ! Line count for bulletin - - IF (CLI$PRESENT('EDIT')) THEN ! If /EDIT specified, then - LEN = 0 - IER = LIB$SYS_TRNLOG('MAIL$EDIT',LEN,MAILEDIT) - IF (IER.NE.SS$_NORMAL) MAILEDIT = 'SYS$SYSTEM:MAILEDIT'e - IF (LEN_P.EQ.0) THEN ! If no file param specifiedL - CALL LIB$SPAWN('$@'//MAILEDIT//' "" SYS$LOGIN:BULL.SCR')O - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',S - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')s - LEN_P = 1 - ELSE - CLOSE (UNIT=3)I - CALL LIB$SPAWN('$@'//MAILEDIT//' '//BULL_PARAMETER(1:LEN_P) - & //' SYS$LOGIN:BULL.SCR')_ - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',= - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')T - END IF - END IFL - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) LEN,INPUT ! get record countd - IF (LEN.GT.80) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(LEN,80) - IF (LEN.EQ.0) ICOUNT = ICOUNT + 1 ! COPY_BULL writes line withT - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Sratch file to save bulletin, - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 81 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,LEN) ! Get input line - IF (LEN.GT.80) THEN ! Input line too longt - WRITE(6,'('' ERROR: Input line length > 80. Reinput:'')')2 - ELSE IF (LEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + LEN ! Increment record countI - IF (LEN.EQ.0) ICOUNT = ICOUNT + 1 - WRITE(3,2010) INPUT(1:LEN) ! Save line in scratch filem - END IFe - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error outS -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outn - ENDIF - - REWIND (UNIT=3) - - IF (NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/SYSTEM'L - IF (CLI$PRESENT('BROADCAST')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT'))E - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodesF - INLINE = INLINE(1:LEN_INLINE) - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolonsa - LEN = TRIM(NODES(POINT_NODE)) ! Length of node name) - IF (SEMI.GT.0) THEN ! Are semicolon found?I - IF (LEN.GT.SEMI+1) THEN ! Is username found?L - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes - LEN = SEMI - 1 ! Remove semicolonsN - ELSE ! No username found... - TEMP_USER = DEFAULT_USER ! Set user to defaultE - LEN = SEMI - 1 ! Remove semicolonsN - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons present - TEMP_USER = DEFAULT_USER ! Set user to default - END IFS - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)')e - & NODES(POINT_NODE),CHAR(10)C - CALL GET_INPUT_NOECHO(PASSWORD) - IF (STR$POSITION(PASSWORD,CHAR(13)).LE.1) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:LEN)//e - & '"'//TEMP_USER(1:TRIM(TEMP_USER))//' '//S - & PASSWORD(1:STR$POSITION(PASSWORD,CHAR(13))-1)//'"::', - & TYPE='SCRATCH',IOSTAT=IER)O - CLOSE (UNIT=10+NODE_NUM)O - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IFR - END DOA - INLINE = INLINE(1:STR$POSITION(INLINE,' ')-1) - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify date( - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(1:LENDES)E - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) LEN,INPUTD - LEN = MIN(LEN,80) - IF (IER.EQ.0) THENI - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(1:LEN) - END IF. - END DOE - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THENc - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE)L - ELSEI - WRITE (6,'('' Error while sending message to node '',A)'). - & NODES(POINT_NODE)i - WRITE (6,'(A)') INPUT - GO TO 940 - END IFo - REWIND (UNIT=3) - END DO - END IFr - - IF (.NOT.LOCAL_NODE_FOUND) GO TO 95 ! Was local node specified? - -Cd -C Add bulletin to bulletin file and directory entry for to directory file.E -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - DESCRIP=INDESCRIP(1:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - LENGTH = (ICOUNT+127)/128 ! Number of recordsE - FROM = USERNAME ! Username - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCKO - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletinb - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_FILE(2) ! Totally finished with addW - -C6 -C Broadcast the bulletin if requested.A -CO - - IF (CLI$PRESENT('BROADCAST')) THEN ! Should we broadcast the bull?I - REWIND (UNIT=3) ! Yes, rewind the input file - IF (CLI$PRESENT('BELL')) THEN ! Include BELL in message? - BROAD(1:36) = ! Say who the bulletin is froma - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROMR - START = 37 ! Start adding next line herer - ELSE - BROAD(1:34) = ! Say who the bulletin is fromN - & CR//LF//LF//'NEW BULLETIN FROM: '//FROML - START = 35 ! Start adding next line heret - END IF - NBLANK = 0 - END = 0E - DO WHILE (ICOUNT.GT.0) ! Stuff bulletin into stringT - READ(3,'(Q,A)') LEN,INPUT ! Read input lineF - ICOUNT = ICOUNT - LEN - 1 - IF (LEN.EQ.0) THENI - NBLANK = NBLANK + 1 ! Count number of blank lines - ICOUNT = ICOUNT - 1 ! ICOUNT counts blank line as one space - ELSE ! Ignore blank liness at start or end of messagep - IF (NBLANK.GT.0.AND.END.GT.0) THENE - END = START + NBLANK*2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) GO TO 90 ! String too long? - DO I=1,NBLANKL - BROAD(START:START+1) = CR//LF - START = START + 2 - END DO - END IF - NBLANK = 0 - END = START + LEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) GO TO 90 ! String too long? - BROAD(START:END) = CR//LF//INPUT(1:LEN)! Else add new input - START = END + 1 ! Reset pointerI - END IF - END DO -90 IF (CLI$PRESENT('ALL')) THEN ! Should we broadcast to ALL?a - CALL SYS$BRKTHRUO - & (,BROAD(1:START-1)//CR,,%VAL(BRK$C_ALLTERMS),,,,,,,) - ELSE ! Else just broadcast to users. - CALL SYS$BRKTHRUN - & (,BROAD(1:START-1)//CR,,%VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IFL - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9( - CLOSE (UNIT=I) - END DOT - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100)s - GOTO 100 - -920 WRITE(6,1020), - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100= - -930 WRITE (ERROR_UNIT,1025)L - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2)T - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3). - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would beR - & truncated to:') -1070 FORMAT (' ERROR: SETPRV privileges are needed for systemA - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanentN - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END diff --git a/decus/vax87a/bulletin/bulletin0.for b/decus/vax87a/bulletin/bulletin0.for deleted file mode 100644 index 15d337a..0000000 --- a/decus/vax87a/bulletin/bulletin0.for +++ /dev/null @@ -1,911 +0,0 @@ -C -C BULLETIN0.FOR, Version 1/27/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER) - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL OPEN_FILE(2) - BULL_DELETE = 0 - IER = 1 - DO WHILE (BULL_DELETE+1.EQ.IER) - BULL_DELETE = BULL_DELETE + 1 - CALL READDIR(BULL_DELETE,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (BULL_DELETE+1.EQ.IER.AND.REMOTE_USER.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - GO TO 50 - END IF - END DO - CALL CLOSE_FILE(2) ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_FILE(2) - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(ERROR_UNIT,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(ERROR_UNIT,1040) ! Then error out. - GO TO 100 - ELSE - CALL CLOSE_FILE (2) - IF (.NOT.DECNET_PROC) THEN - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') GO TO 900 - END IF - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(ERROR_UNIT,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - -50 CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - CALL CLEANUP_DIRFILE(BULL_DELETE) ! Reorder directory file - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - CALL READDIR(0,IER) ! Get shutdown count - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - - CALL UPDATE ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (BULL_DELETE.LE.BULL_POINT) BULL_POINT = BULL_POINT - 1 - ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - -100 CALL CLOSE_FILE(2) - IF (DECNET_PROC) WRITE (5,'(''END'')') - ! Tell DECNET that delete went ok. -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - EXTERNAL CLI$_ABSENT - - CHARACTER START_PARAMETER*4,DATETIME*23,TODAY*11 - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_COM) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_FILE_SHARED(2) ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1) THEN ! If so, there are messages - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified? - IER = CLI$GET_VALUE('START',START_PARAMETER,LEN) - DECODE(LEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEN - DIR_COUNT = NBULL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_FILE(2) - DIR_COUNT = 0 - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE')) THEN ! Date specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$ASCTIM(,TODAY,,) ! Need to get date. - DATETIME = TODAY//' 00:00:00.0' - END IF - TEMP_COUNT = 0 - IER = 1 - DO WHILE (IER.EQ.TEMP_COUNT+1) - TEMP_COUNT = TEMP_COUNT + 1 - CALL READDIR(TEMP_COUNT,IER) - IF (IER.NE.TEMP_COUNT+1) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE(2) - RETURN - ELSE - DIFF = COMPARE_DATE(DATETIME(1:11),DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME) - IF (DIFF.LE.0) THEN - DIR_COUNT = TEMP_COUNT - IER = IER + 1 - END IF - END IF - END DO - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - IF (CLI$PRESENT('SINCE')) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-4) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-4) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1 - END IF - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - DO I=SBULL,EBULL ! Copy messages from file - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - END DO - ELSE - NBULL = 0 - END IF - - CALL CLOSE_FILE(2) ! We don't need file anymore - - IF (NBULL.EQ.0) THEN - WRITE (6,'('' There are no messages present.'')') - RETURN - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - WRITE(6,1000) ! Write header - DO I=SBULL,EBULL - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - WRITE(6,2010) I,DESCRIP,FROM,DATE(1:7)//DATE(10:11) - END DO - - DIR_COUNT = EBULL + 1 ! Update directory counter - - IF (DIR_COUNT.GT.NBULL) THEN ! Outputted all entries? - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A53,A12,A11) -2010 FORMAT(1X,I3,1X,A53,1X,A12,1X,A9) - - END - - - SUBROUTINE FILE -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And return - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,1010) ! Write error - RETURN ! And return - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030) - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE - END IF - - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 90 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IF - END DO - LEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_POINT,BULL_PARAMETER(1:LEN_P) - ! Show name of file created. -100 CALL CLOSE_FILE(1) - RETURN - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 100 - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' Message ',I3,' written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/) - - END - - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - CHARACTER TODAY*23,INPUT*80,INREAD*1 - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - DIMENSION H_NEW_FLAG(2),H_SET_FLAG(2),H_BRIEF_FLAG(2) - DIMENSION NOLOGIN_BTIM(2),LOGIN_BTIM_SAVE(2),TODAY_BTIM(2) - DIMENSION DIR_BTIM(2),NEW_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS$BINTIM(TODAY,TODAY_BTIM) - - CALL SYS$BINTIM('5-NOV-2956',NOLOGIN_BTIM) - CALL SYS$BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_FILE_SHARED(4) ! Open user file - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) TEMP_USER, - & NEWEST_BTIM,BBOARD_BTIM,H_NEW_FLAG,H_SET_FLAG, - & H_BRIEF_FLAG,NOTIFY_FLAG ! Get the header - END DO - - IF (IER.EQ.0) THEN ! Header is present. - DO WHILE (REC_LOCK(IER1)) - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER1) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG, - & BRIEF_FLAG,NOTIFY_FLAG ! Find if there is an entry - END DO - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).EQ.0) RETURN ! DISMAIL set - IF (IER1.EQ.0) THEN ! There is a user entry - REWRITE (4,FMT=USER_FMT) USERNAME,TODAY_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG ! Update login date - & ,NOTIFY_FLAG - IF ((SET_FLAG(1).OR.SET_FLAG(2)).NE.0) READIT = 1 - ELSE - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry - READ_BTIM(2) = NEW_BTIM(2) - NEW_FLAG(1) = 'FFFFFFFF'X - NEW_FLAG(2) = 'FFFFFFFF'X - SET_FLAG(1) = H_SET_FLAG(1) - SET_FLAG(2) = H_SET_FLAG(2) - BRIEF_FLAG(1) = H_BRIEF_FLAG(1) - BRIEF_FLAG(2) = H_BRIEF_FLAG(2) - CALL CHECK_DISMAIL(USERNAME,DISMAIL) - IF (DISMAIL.EQ.1) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,NOLOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - ELSE - WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,TODAY_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - IF ((SET_FLAG(1).OR.SET_FLAG(2)).NE.0) READIT = 1 - END IF - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_FILE(4) ! Close the user file - CALL EXIT ! Go away... - END IF - CALL CLEANUP_LOGIN ! Good time to delete dead users - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - END IF - DO WHILE (REC_LOCK(IER2)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER2) TEMP_USER, - & NEWEST_BTIM,BBOARD_BTIM,H_NEW_FLAG,H_SET_FLAG, - & H_BRIEF_FLAG,NOTIFY_FLAG ! Reset read back to header - END DO - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - REWRITE (4,FMT=USER_FMT) TEMP_USER,NEWEST_BTIM, ! Rewrite header - & TODAY_BTIM,H_NEW_FLAG,H_SET_FLAG,H_BRIEF_FLAG,NOTIFY-FLAG - CALL CLOSE_FILE(4) - CALL CREATE_BBOARD_PROCESS - ELSE - CALL CLOSE_FILE(4) - IF (IER.NE.0) CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compare - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user. - - DIFF = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - - IF (DIFF.GT.0) THEN - BULL_POINT = -1 - RETURN - END IF - -C -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible. -C - - ENTRY LOGIN_FOLDER - - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - - CALL OPEN_FILE_SHARED(2) ! Yes, so go get bulletin directory - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - CALL READDIR(0,IER) ! Get header info - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_COM) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_COM) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - BULL_POINT = -1 - START = 1 - REVERSE = 0 - IF (CLI$PRESENT('REVERSE').AND. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - REVERSE = 1l - START = NBULL + 1g - IER = START + 1 - DIFF = 0 - IF (IER1.NE.0) THEN: - START = 1 - ELSE - DO WHILE (START+1.EQ.IER.AND.DIFF.LE.0)F - START = START - 1 - IF (START.GT.0) CALL READDIR(START,IER) - IF (START+1.EQ.IER) THENT - CALL SYS$BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - END IF, - END DO - START = START + 1O - END IF - END IF - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THENO - ICOUNT = NBULL + START - ICOUNT1E - ELSE - ICOUNT = ICOUNT1 - END IF - CALL READDIR(ICOUNT,IER) - IF (IER1.EQ.0) THEN ! Is this a totally new user?$ - ! No. Is bulletin system or from same user?E - IF (.NOT.REVERSE) THEN - CALL SYS$BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF( - IF (USERNAME.NE.FROM.OR.SYSTEM) THENA - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM) - ELSE - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)) GO TO 100U - END IF - NGEN = NGEN + 1E - SYSTEM = ICOUNTT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM)L - END IF - END IFg - ELSE ! Totally new user, save all messages - IF (SYSTEM) THENI - NSYS = NSYS + 1i - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM) - ELSE' - SYSTEM = ICOUNT ! Save bulletin number for displayT - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THENP - BULL_POINT = ICOUNT - 1_ - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)) GO TO 100 - END IFT - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - END IFU - END IF - END DOT -100 CALL CLOSE_FILE(2) - IF (FOLDER_SET) NSYS = 0 -CL -C Review new directory entries. If there are system messages,e -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (NGEN.EQ.0.AND.NSYS.EQ.0) RETURN - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN0 - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesm - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,1026) CTRL_G ! Yep... - PAGE = PAGE + 1N - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_FILE_SHARED(1) - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - DO J=1,NSYSI - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM)e - INPUT = ' 'e - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - LEN = 81R - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin to SYS_BUL link listE - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - CALL CLOSE_FILE(1)I - RETURNL - ELSE IF (LEN.GT.0) THENd - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - END IF - END DO0 - LEN = 80I - END DO - END DO - CALL CLOSE_FILE(1) - SYS_BUL = SYS_BUL1 - DO WHILE (SYS_BUL.NE.0) ! Write out the system messages - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)r - IF (SYS_BUL.NE.0) THENM - IF (PAGE.EQ.PAGE_LENGTH-2) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next pageD - CALL GET_INPUT_NOECHO(INREAD) ! Get terminal input - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenu - WRITE(6,1065) INPUT(1:TRIM(INPUT)) - PAGE = 1 - ELSEP - WRITE(6,1060) INPUT(1:TRIM(INPUT)) - PAGE = PAGE + 1a - END IF - END IFa - END DO - IF (NGEN.EQ.0) THENL - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - GEN_DIR = GEN_DIR1T - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER)a - S1 = (80-13-LENF)/2e - S2 = 80-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next pageR - CALL GET_INPUT_NOECHO(INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages',CTRL_Gt - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesd - FIRST_WRITE = .FALSE. ! if this is first write to screen.U - END IFC - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages',CTRL_GT - PAGE = PAGE + 1 - END IF - WRITE(6,1020)A - WRITE(6,1025)T - PAGE = PAGE + 2C - DO I=1,NGENE - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM)i - IF (PAGE.EQ.PAGE_LENGTH-2) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO(INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - ELSEi - PAGE = PAGE + 1 - END IFp - WRITE(6,1040) DESCRIP,FROM,DATE(:6),SYSTEM - ! Bulletin number is stored in SYSTEM - END DO - IF (FOLDER_NUMBER.GT.0.OR.(FOLDER_NUMBER.EQ.0.AND. - & BTEST(SET_FLAG(1),0))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set ford - END IF ! GENERAL, as no prompt to read is generated. - END IFi - IF (NGEN.EQ.0.OR. - & READIT.NE.0.OR.COMPARE_BTIM(READ_BTIM,NEW_BTIM).NE.0) THEN - WRITE(6,1030)' - ELSE) - LEN = 27 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (80-LEN)/2A - S2 = 80 - S1 - LEN - WRITE(6,1035)L - & 'Type '//COMMAND_PROMPT(:LEN-27)//' to read new messages.' - END IF - - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',33('*'),'System Messages',32('*'),A1) -1027 FORMAT(/,' ',('*'),A,('*'),A1)p -1028 FORMAT('+',('*'),A,('*'),A1)T -1030 FORMAT(' ',80('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(' ',A53,1X,A12,1X,A6,1X,I4)Y -1060 FORMAT(1X,A)d -1065 FORMAT('+',A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/,' HIT any key for next page....')T - - END - - - SUBROUTINE GET_NODE_INFOE -CI -C SUBROUTINE GET_NODE_INFOI -CN -C FUNCTION: Gets local node name and obtains node names fromc -C command line. -C - - IMPLICIT INTEGER (A-Z)T - - EXTERNAL CLI$_ABSENTD - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODEI - CHARACTER*32 NODES(10)I - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER*32 LOCAL_NODE - - NODE_ERROR = .FALSE.F - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:)L - L_NODE = L_NODE - 1G - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - LEN = 0 ! GET_VALUE crashes if LEN<0B - DO WHILE (CLI$GET_VALUE('NODES',NODES(NODE_NUM+1),LEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - NODE_NUM = NODE_NUM + 1 - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - LEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addedd - END IF- - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:LEN)) THENg - NODE_NUM = NODE_NUM - 1( - LOCAL_NODE_FOUND = .TRUE.L - ELSE( - POINT_NODE = NODE_NUMI - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:LEN)//'""::'_ - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED',T - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER)E - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE.E - RETURN - END IF - END IFL - END DO - ELSEU - LOCAL_NODE_FOUND = .TRUE.U - END IF) - - RETURN( - END - - - SUBROUTINE DELETE_NODEA -C1 -C SUBROUTINE DELETE_NODEU -C= -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C) - - IMPLICIT INTEGER (A-Z)i - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE( - CHARACTER*32 NODES(10)3 - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFOI - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999- - END IFC - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP)E - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - LEN = TRIM(NODES(POINT_NODE)) ! Length of node nameW - IF (SEMI.GT.0) THEN ! Is semicolon present? - IF (LEN.GT.SEMI+1) THEN ! Yes, is username after node? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - LEN = SEMI - 1 ! Remove semicolonL - ELSE ! No username after nodename - TEMP_USER = DEFAULT_USER ! Set username to default? - LEN = SEMI - 1 ! Remove semicolon - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolon presentR - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username wasR - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)')N - & NODES(POINT_NODE),CHAR(10)P - CALL GET_INPUT_NOECHO(PASSWORD)s - IF (STR$POSITION(PASSWORD,CHAR(13)).LE.1) GO TO 910n - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:LEN)e - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '//= - & PASSWORD(1:STR$POSITION(PASSWORD,CHAR(13))-1)//'"::', - & TYPE='SCRATCH',IOSTAT=IER)L - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINEn - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THENa - WRITE (6,'('' Message successfully deleted from node '',A)'), - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE): - WRITE (6,'(A)') INLINE. - END IF - END DOO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 10 - END DOF - - RETURN' - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A): - - END diff --git a/decus/vax87a/bulletin/bulletin1.for b/decus/vax87a/bulletin/bulletin1.for deleted file mode 100644 index 65a12a9..0000000 --- a/decus/vax87a/bulletin/bulletin1.for +++ /dev/null @@ -1,1043 +0,0 @@ -C -C BULLETIN1.FOR, Version 12/30/86 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - LEN_I = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN_I.GT.0) - CALL GET_BULL(I,INPUT,LEN_I) - IF (LEN_I.LT.0) THEN - GO TO 90 - ELSE IF (LEN_I.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN_I) - END IF - END DO - LEN_I = 80 - END DO - -90 CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_FILE(1) - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - IF (MAIL_SUBJECT(1:1).NE.'"') THEN - MAIL_SUBJECT = '"'//MAIL_SUBJECT(1:LEN_D) - LEN_D = LEN_D + 1 - END IF - - IF (MAIL_SUBJECT(LEN_D:LEN_D).NE.'"') THEN - MAIL_SUBJECT = MAIL_SUBJECT(1:LEN_D)//'"' - LEN_D = LEN_D + 1 - END IF - - IER = CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER,LEN_P) - - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(1:LEN_P) - & //'/SUBJECT='//MAIL_SUBJECT(1:LEN_D),,,,,,STATUS) - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(1:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(1:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_FILE(7) ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - END IF - - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=FOLDER,KEYID=0) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE - - IF (IER.EQ.0) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_FILE(7) - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - LOGICAL DELETE_ORIGINAL - - CHARACTER INPUT*80,SAVE_USERNAME*12 - - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_FILE(2) - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - - SAVE_BULL_POINT = BULL_POINT - - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Scratch file to save bulletin - - CALL OPEN_FILE_SHARED(1) - - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 90 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IF - END DO - LEN = 80 - END DO - -90 REWIND (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - SAVE_USERNAME = USERNAME - IF (CLI$PRESENT('ORIGINAL')) THEN - IF (SETPRV_PRIV()) THEN - USERNAME = FROM - ELSE - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - END IF - END IF - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER.OR.READ_ONLY) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - CLOSE (UNIT=3) - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - USERNAME = SAVE_USERNAME - RETURN - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE(6,'('' ERROR: Message copy aborted.'')') - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CLOSE (UNIT=3) - END IF - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - IF (BTEST(SYSTEM,2)) THEN ! Shutdown message? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND. - & .NOT.SETPRV_PRIV()) THEN ! Permanent? - WRITE (6,'('' ERROR: No privileges to add permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') FOLDER_BBEXPIRE - END IF - - FROM = USERNAME ! Specify owner - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_FILE(2) ! Totally finished with add - - CLOSE (UNIT=3) ! Close the input file - - WRITE (6,'('' Message has been copied to folder '',A)') - & FOLDER(1:TRIM(FOLDER))//'.' - - USERNAME = SAVE_USERNAME - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL) CALL DELETE - - RETURN - - END - - - - - SUBROUTINE PRINT -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*80 INPUT - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,1010) ! Write error - RETURN ! And return - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030) - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE - END IF - - LEN =81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.GT.0) WRITE(3,'(A)') INPUT(1:TRIM(INPUT)) - END DO - LEN = 80 - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,LEN) ! Get queue name - IF (LEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - LEN = 9 - END IF - - CALL ADD_2_ITMLST(LEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_FILE(1) - WRITE(6,1000) - CALL SYS_GETMSG(IER) - - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' Message ',I3,' written to ',A) -1050 FORMAT('Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/) - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*11,DATETIME*23 - - LOGICAL SINCE,PAGE - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - IF (INCMD(1:4).EQ.'READ') THEN ! If READ command... - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - DATETIME = TODAY//' 00:00:00.0' - END IF - CALL OPEN_FILE_SHARED(2) - TEMP_READ = 0 - IER = 1 - DO WHILE (IER.EQ.TEMP_READ+1) - TEMP_READ = TEMP_READ + 1 - CALL READDIR(TEMP_READ,IER) - IF (IER.NE.TEMP_READ+1) THEN - WRITE (6,'('' No messages found past specified date.'')') - CALL CLOSE(2) - RETURN - ELSE - DIFF = COMPARE_DATE(DATETIME(1:11),DATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME) - IF (DIFF.LE.0) THEN - BULL_READ = TEMP_READ - IER = IER + 1 - END IF - END IF - END DO - IER = BULL_READ + 1 - SINCE = .TRUE. - END IF - END IF - - IF (.NOT.SINCE) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - CALL CLOSE_FILE(2) - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IF - - BULL_POINT = BULL_READ ! Update bulletin counter - - WRITE(6,1040) BULL_POINT ! Output bulletin header info - WRITE(6,1050) DESCRIP - IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - WRITE(6,1065) FROM,DATE,'Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - WRITE(6,1065) FROM,DATE,'Permanent message' - ELSE - WRITE(6,1060) FROM,DATE,EXDATE//' '//EXTIME - END IF - -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - END = 4 ! Outputted 4 lines to screen - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSE - READ_COUNT = BLOCK ! Init bulletin record countert - END IFo - -100 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - CALL OPEN_FILE_SHARED(1) ! Get bulletin file - MORE_LINES = .TRUE. - READ_REC = READ_COUNT - IF (READ_ALREADY.EQ.0) LEN = 81 - DO WHILE (MORE_LINES.AND.READ_REC.LE.BLOCK+LENGTH-1)L - DO WHILE (LEN.GT.0.AND.MORE_LINES) - CALL GET_BULL(READ_REC,INPUT,LEN) - IF (LEN.LT.0) THEN ! Error, couldn't read record - READ_REC = BLOCK + LENGTH ! Fake end of reading fileo - MORE_LINES = .FALSE. - ELSE IF (LEN.GT.0) THEN - LEN_TEMP = LENg - CALL CONVERT_TABS(INPUT,LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)C - READ_ALREADY = 1 - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IFl - END IFa - END DO - LEN = 80 - IF (MORE_LINES) THEN - READ_REC = READ_REC + 1 - READ_ALREADY = 0I - END IF - END DOe - - CALL CLOSE_FILE(1) ! End of bulletin file readW - -Cl -C Bulletin page is now in temporary memory, so output to terminal.. -C Note that if this is a /READ, the first line will have problems withD -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at theT -C end of the previous page. The output gets confused and thinks it mustU -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C. - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) ! Get queue record - IF (I.EQ.1.AND.READ_REC.NE.BLOCK.AND.READIT.GT.0) THEN - WRITE(6,2020) INPUT(1:TRIM(INPUT)) ! (See above comments) - ELSE - WRITE(6,2010) INPUT(1:TRIM(INPUT))B - END IF - END DOa - - READ_COUNT = READ_REC ! Update bull record counterI - - IF (READ_REC.EQ.BLOCK+LENGTH) THEN ! Last block?/ - READ_COUNT = 0 ! init bulletin record counterI - ELSE IF (READ_REC.EQ.BLOCK+LENGTH-1.AND..NOT.MORE_LINES) THEN - ! Possibly last block since end of page could be last line - CALL TEST_MORE_LINES(LEN) ! More lines to read? - IF (LEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletinC - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Else if this is not /READ - WRITE(6,1070) ! say there is more of bulletin - END IF - - RETURN- - -1030 FORMAT(' ERROR: Specified message was not found.')6 -1040 FORMAT('+Message number: ',I3)D -1050 FORMAT(' Description: ',A53) -1060 FORMAT(' From: ',A12,' Date: ',A11,' Expires: ',A20,/) -1065 FORMAT(' From: ',A12,' Date: ',A11,' ',A,/) -1070 FORMAT(1X,/,' Press RETURN for more...',/)N - -2000 FORMAT(A) -2010 FORMAT(1X,A)E -2020 FORMAT('+',A) - - END - - - - - - SUBROUTINE READNEW. -C' -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -CF - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER INREAD*1,INPUT*80,FILE_DEF*80 - - DATA LEN_FILE_DEF /0/, INREAD/0/p - - LOGICAL SLOW,SLOW_TERMINAL - -C -C This subroutine is executed due to the BULLETIN/LOGIN command which is -C normally executed by a command procedure during login. In order to use -C LIB$GET_INPUT, we must redefine SYS$INPUT to the terminal (temporarilyh -C using user mode). -C' - IF (ICHAR(INREAD).EQ.0) THEN< - CALL CRELNM('SYS$INPUT','TT') - CALL PURGE_TYPEAHEAD - SLOW = SLOW_TERMINAL() - END IFh - - LEN_P = 0 ! Tells read subroutine there isO - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletinsC - - INREAD = '0'E - TEMP_READ = 0 - DO WHILE (INREAD.GE.'0'.AND.INREAD.LE.'9')) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Make input upper case - IF (TEMP_READ.GT.0.AND.(INREAD.LT.'0'.OR.INREAD.GT.'9').AND. - & INREAD.NE.CHAR(13)) THENE - GO TO 1 - ELSE IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q') THENT - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+Quit'',$)')I - ELSES - WRITE (6,'(''+No'',$)')Q - END IF - RETURN ! If NO, exitn - ! Include QUIT to be consistent with next question - ELSE IF (INREAD.GE.'0'.AND.INREAD.LE.'9') THEN - TEMP_READ = TEMP_READ*10 + ICHAR(INREAD) - ICHAR('0') - WRITE (6,'(''+'',A1,$)') INREAD - END IF - END DOR - - IF (TEMP_READ.GT.0) THENR - IF (TEMP_READ.LT.BULL_POINT+1.OR.TEMP_READ.GT.NBULL) THEN$ - WRITE (6,'('' ERROR: Specified new message not found.'')')) - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1D - END IF - END IF( - - READ_COUNT = 0 ! Initialize display pointerL - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletinI - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed?S - CALL OPEN_FILE_SHARED(2) ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND.(SYSTEM)) THEN - BULL_POINT = BULL_POINT + 1 ! If system bulletin, skip it.s - GO TO 10) - END IF - CALL CLOSE_FILE(2) - END IFT - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSET - IF (READ_COUNT.EQ.BLOCK) THENS - WRITE(6,1030) 'TEXT'O - ELSE - WRITE(6,1030) 'MORE't - END IF - END IFN - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper caseR - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)')E - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to fileE - WRITE (6,'(''+ '')') ! Move cursor from end of prompt lineP - ! to beginning of next line._ - IF (LEN_FILE_DEF.EQ.0) THENh - CALL LIB$SYS_TRNLOG('SYS$LOGIN',LEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:LEN-1)//'.BULL]' - LEN_FILE_DEF = LEN + 5I - ELSEI - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10e - END IFo - END IF - - LEN_FOLDER = TRIM(FOLDER)_ - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,' - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_FILE_SHARED(2) - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRVR - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),IOSTAT=IER,ERR=18,E - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATEB - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THENe - GO TO 18l - ELSE IF (LEN.GT.0) THEN - WRITE(3,'(A)') INPUT(1:TRIM(INPUT)) - END IFV - END DO - LEN = 80 - END DO - WRITE(6,1040) BULL_PARAMETER(1:LEN_P)t - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privilegesu - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THENA - ! If NEXT and last bulletins not finishedL - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_FILE_SHARED(2) ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin) - CALL CLOSE_FILE(2) ! ExitG - WRITE(6,1010) - RETURNE - ELSE IF (SYSTEM) THEN ! Else if NEXT bulletin SYSTEM& - BULL_POINT = BULL_POINT + 1 ! Skip it - GO TO 20 ! Look for more bulletinsa - END IF - CALL CLOSE_FILE(2) - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010)E - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),Q(Quit),messageT - & number, or any other key for yes: ',$)M -1010 FORMAT(' No more messages.'), -1020 FORMAT(1X,80('-'),/,( - &' Type Q(Quit), F(File it) or any other key for next message: ',$) -1030 FORMAT(1X,80('-'),/,' Type Q(Quit), F(File it), N(Next message),_ - & or any other key for ',A4,'... ',$) -1040 FORMAT(' Message written to ',A)N -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/) - - END - - - - - SUBROUTINE SET_BBOARD(BBOARD) -C' -C SUBROUTINE SET_BBOARD -CI -C FUNCTION: Set username for BBOARD for selected folder.B -C, - IMPLICIT INTEGER (A-Z)8 - - PARAMETER UAF$V_DISACNT = 4 - - INCLUDE 'BULLFOLDER.INC'N - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT0 - - CHARACTER EXPIRE*3,INPUT_BBOARD*12t - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')')i - RETURN - END IFU - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - - CALL OPEN_FILE(7) ! Open folder filer - READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER)L - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN, - CALL GET_UAF' - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER)C - IF (IER.AND..NOT.BTEST(FLAGS,UAF$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'e - & ('' ERROR: BBOARD account needs DISUSER flag set.'')') - IER = 0H - END IFu - IF (IER) THEN - READ (7,FMT=FOLDER_FMT,KEY='GENERAL',KEYID=0,IOSTAT=IER)I - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIREl - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR.L - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0)J - READ (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIPu - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRES - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND._ - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THENF - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_FILE(7). - RETURNI - ELSE - READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER)e - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE - FOLDER_BBOARD = INPUT_BBOARDT - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = 0 ! Set UIC to [0,0] to indicate to useN - GROUPB = 0 ! special procedure to check BBOARD mailE - END IF - END IF - ELSEL - CALL CLOSE_FILE(7) - RETURN - END IFS - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = 0Y - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IFN - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THENO - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '',A - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_FILE(7) - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')')f - CALL CLOSE_FILE(7) - RETURN - ELSEo - FOLDER_BBEXPIRE = TEMP - END IFe - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1s - END IFd - ELSE - FOLDER_BBOARD = 'NONE'e - END IF - - REWRITE (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - CALL CLOSE_FILE(7) - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSED - WRITE (6,'('' You are not authorized to modify BBOARD.'')')A - END IFD - - RETURNI - END diff --git a/decus/vax87a/bulletin/bulletin2.for b/decus/vax87a/bulletin/bulletin2.for deleted file mode 100644 index 3596bae..0000000 --- a/decus/vax87a/bulletin/bulletin2.for +++ /dev/null @@ -1,913 +0,0 @@ -C -C BULLETIN2.FOR, Version 1/27/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: Replaces existing bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*8,MAILEDIT*80 - CHARACTER INDESCRIP*80,INPUT*80,TODAY*23 - CHARACTER*1 ANSWER - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT - - LOGICAL*1 DOALL - -C -C Get the bulletin number to be replaced. -C - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are reading - ELSE - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (FOLDER_SET.AND.CLI$PRESENT('SYSTEM')) THEN - WRITE (6,'( - & '' ERROR: Invalid parameter used with folder set.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (FOLDER_SET.AND.CLI$PRESENT('SHUTDOWN')) THEN - WRITE (6,'( - & '' ERROR: Invalid parameter used with folder set.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletin - - CALL CLOSE_FILE(2) - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person - RETURN ! and error out - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND. - & USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(1:11) - INEXTIME = INPUT(13:20) - END IF - -8 IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LEN,INDESCRIP - IF (LEN.EQ.0) GO TO 910 ! If no header, don't add bull - IF (LEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fit - GO TO 8 ! and re-request header - END IF - END IF - - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & CLI$PRESENT('EDIT')) THEN ! or /EDIT specified - - IF (CLI$PRESENT('EDIT')) THEN ! If /EDIT specified, then - IER = LIB$SYS_TRNLOG('MAIL$EDIT',LEN,MAILEDIT) - IF (IER.NE.SS$_NORMAL) MAILEDIT = 'SYS$SYSTEM:MAILEDIT' - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy mesage into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 5 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IF - END DO - LEN = 80 - END DO -5 CALL CLOSE_FILE(1) - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL LIB$SPAWN('$@'//MAILEDIT//' "" SYS$LOGIN:BULL.SCR') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - CALL LIB$SPAWN('$@'//MAILEDIT//' '//BULL_PARAMETER(1:LEN_P) - & //' SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) LEN,INPUT ! get record count - IF (LEN.GT.80) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,LEN) - IF (LEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + LEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (LEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 80 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,LEN) ! Get input line - IF (LEN.GT.80) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > 80. Reinput::'')') - ELSE IF (LEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + LEN ! Increment character count - WRITE(3,'(A)') INPUT(1:LEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (LEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(1:LEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - INPUT = DESCRIP - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.INPUT.NE.DESCRIP) THEN - ! Message disappeared in the mean time? - CALL CLOSE_FILE(2) - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Message file info invalidated. - & Find message and do REPLACE again.'')') - GO TO 100 - END IF - - CALL READDIR(0,IER) ! Get directory header - - LENGTH_SAVE = LENGTH ! Copy BULL modifies LENGTH - BLOCK_SAVE = BLOCK - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN ! If text has been replaced - CALL OPEN_FILE(1) ! Prepare to add bulletin - ICOUNT = (ICOUNT+127)/128 - IF (ICOUNT.GT.LENGTH) THEN - IF (NBULL.GT.NUMBER_PARAM) THEN - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - NBLOCK = NBLOCK + ICOUNT - ELSE - NBLOCK = NBLOCK + ICOUNT - LENGTH - END IF - CALL WRITEDIR(0,IER) - ELSE IF (ICOUNT.LT.LENGTH) THEN - NEMPTY = NEMPTY + LENGTH - ICOUNT - CALL WRITEDIR(0,IER) - END IF - CALL COPY_BULL(3,REC1,BLOCK,IER) ! Replace old bulletin - - CALL CLOSE_FILE(1) - - IF (ICOUNT.NE.LENGTH_SAVE) THEN ! If new bull different size - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = ICOUNT ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - END IF - - CALL READDIR(NUMBER_PARAM,IER) - IF (CLI$PRESENT('HEADER').OR.DOALL) DESCRIP=INDESCRIP(1:53) - ! Update description header - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (CLI$PRESENT('PERMANENT').AND. - & (.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00' - ELSE IF (CLI$PRESENT('SHUTDOWN').AND. - & (.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00' - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(1:11) - SHUTDOWN_TIME = TODAY(13:20) - CALL WRITEDIR(0,IER) - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - - CALL WRITEDIR(NUMBER_PARAM,IER) - - CALL CLOSE_FILE(2) ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be - & truncated to:') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - - - SUBROUTINE RESPOND(STATUS) -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER INPUT*80,FROM_TEST*5 - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - BULL_PARAMETER = 'RE: '//DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P) - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - LEN_P = TRIM(BULL_PARAMETER) - - IF (BULL_PARAMETER(1:1).NE.'"') THEN - BULL_PARAMETER = '"'//BULL_PARAMETER(1:LEN_P) - LEN_P = LEN_P + 1 - END IF - - IF (BULL_PARAMETER(LEN_P:LEN_P).NE.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(1:LEN_P)//'"' - LEN_P = LEN_P + 1 - END IF - - IF (CONFIRM_USER(FROM).EQ.0) THEN - CALL LIB$SPAWN('$MAIL SYS$INPUT '//FROM//'/SUBJECT='// - & BULL_PARAMETER,,,,,,STATUS) - ELSE - FROM_TEST = ' ' - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - L_INPUT = 81 - I = BLOCK - DO WHILE (I.LT.BLOCK+LENGTH.AND.L_INPUT.GT.0) - CALL GET_BULL(I,INPUT,L_INPUT) - IF (L_INPUT.GT.0) THEN - CALL STR$UPCASE(FROM_TEST,INPUT(1:5)) - IF (FROM_TEST.EQ.'FROM:') THEN - IF (INDEX(INPUT,'.').GT.0.OR.INDEX(INPUT,'@').GT.0 - & .OR.INDEX(INPUT,'%').GT.0) THEN - L_INPUT = 0 - END IF - END IF - ELSE IF (L_INPUT.EQ.0) THEN - L_INPUT = 80 - I = I + 1 - END IF - END DO - CALL CLOSE_FILE(1) - IF (FROM_TEST.EQ.'FROM:') THEN - L_B = INDEX(INPUT,'<') - R_B = INDEX(INPUT,'>') - IF (L_B.GT.0.AND.R_B.GT.0) THEN - INPUT = INPUT(L_B+1:R_B-1) - L_INPUT = R_B - 1 - L_B - ELSE - L_INPUT = TRIM(INPUT) - I = 6 - DO WHILE (INPUT(I:I).EQ.' '.AND.I.GT.0) - I = I + 1 - IF (I.GT.L_INPUT) I = 0 - END DO - INPUT = INPUT(I:L_INPUT) - L_INPUT = L_INPUT - I + 1 - END IF - CALL LIB$SPAWN('$CHMAIL/I '//INPUT(:L_INPUT)// - & '@XX/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSE - WRITE (6,'('' ERROR: Cannot respond to mail.'')') - END IF - END IF - - RETURN - - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_FILE_SHARED(8) - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_FILE(8) - - RETURN - END - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - - CHARACTER*132 SEARCH_STRING,SAVE_STRING - DATA SEARCH_STRING /' '/, SEARCH_LEN /1/ - - COMMON /POINT/ BULL_POINT - - CALL DISABLE_CTRL - - SAVE_STRING = SEARCH_STRING - SAVE_LEN = SEARCH_LEN - - IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - - IF (.NOT.IER) THEN - SEARCH_STRING = SAVE_STRING - SEARCH_LEN = SAVE_LEN - END IF - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(0,IER) - - IF (BULL_POINT+1.GT.NBULL) THEN - WRITE (6,'('' ERROR: No more messages.'')') - CALL CLOSE_FILE(2) - CALL ENABLE_CTRL - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) - - DO BULL_SEARCH = BULL_POINT+1, NBULL - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1) THEN - LEN = 81 - DO J=BLOCK,BLOCK+LENGTH-1 - DO WHILE (LEN.GT.0) - CALL GET_BULL(J,INPUT,LEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(1:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2)I - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1b - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURNr - END IF - END DO - LEN = 80 - END DOL - END IF - END DO: - - CALL CLOSE_FILE(1) ! End of bulletin file readI - CALL CLOSE_FILE(2)Z - - CALL ENABLE_CTRL - - WRITE (6,'('' No messages found with given search string.'')') - - RETURNT - END - - - - - - SUBROUTINE UPDATE -CE -C SUBROUTINE UPDATE -CU -C FUNCTION: Searches for bulletins that have expired and deletes them. -CA -C NOTE: Assumes directory file is already opened.S -C - IMPLICIT INTEGER (A - Z)E - CHARACTER*107 DIRLINE - - INCLUDE 'BULLDIR.INC' - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE. - CHARACTER*8 TEMP_TIME,TEMP_EXTIME - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00' ! bulletin date if deletion occursP - - CALL OPEN_FILE(1) ! Open both bulletin filesU - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted( - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not foundE - IF (SYSTEM.LE.1.OR.(SHUTDOWN.EQ.0 ! If not permanent, or timet - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin?_ - DIFF = 0 ! If so, delete it - ELSER - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF, - IF (DIFF.LE.0) THEN ! If so then delete bulletinl - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted fileT - UPDATE_DONE = BULL_ENTRY ! store it to use for reorderingr - END IF ! directory file. - ELSE IF (SYSTEM.LE.1) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latestb - ! expiration date. The following does that.C - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest expN - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IFh - TEMP_DATE = DATE ! Keep date so when we quitN - TEMP_TIME = TIME ! search, we'll have the - END IF ! latest bulletin dateR - END IF - BULL_ENTRY = BULL_ENTRY + 1f - END DOe - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IFt - - DATE = NEWEST_DATEA - TIME = NEWEST_TIME - NEW_SHUTDOWN = SHUTDOWN - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - CALL CLOSE_FILE(1) -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users' -CA - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4)D -1020 FORMAT(A107). - - END - - - - SUBROUTINE UPDATE_READ(NEW_BULL)U -C -C SUBROUTINE UPDATE_READT -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility.L -C If new bulletins have been added, alert user of the fact.N -CA - - IMPLICIT INTEGER (A - Z)E - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23s - - DIMENSION TODAY_BTIM(2) - -C5 -C Update user's latest read time in his entry in BULLUSER.DAT. -C - - NEW_BULL = .FALSE.a - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DOL - - IF (IER.NE.0) THEN ! If header not present, exitr - CALL CLOSE_FILE(4) - RETURN - ELSE IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THENN - SET_FLAG(1) = 1 ! If header present, but no - SET_FLAG(2) = 0 ! SET_FLAG and NOTIFY_FLAG - NOTIFY_FLAG(1) = 0 ! information, write default - NOTIFY_FLAG(2) = 0 ! flags. - BRIEF_FLAG(1) = 0m - BRIEF_FLAG(2) = 0N - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - NEW_FLAG(2) = 0T - REWRITE (4,FMT=USER_FMT) - & TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFI - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS$BINTIM(TODAY,TODAY_BTIM) - - DO WHILE (REC_LOCK(IER1)) - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER1) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG ! Find user's info - END DOg - - IF (IER1.EQ.0) THEN ! If entry found, update it - DIFF = COMPARE_BTIM(READ_BTIM,NEWEST_BTIM) - IF (DIFF.LE.0) NEW_BULL = .TRUE. ! If new bull set flagE -C -C No need to update read time/date if no new bulletins and no READNEW set,( -C unless new bulletin is in general folder. -CL - IF ( ((NEW_FLAG(1).AND.SET_FLAG(1)).OR.E - & (NEW_FLAG(2).AND.SET_FLAG(2))).NE.0.OR.NEW_BULL) THEN - REWRITE (4,FMT=USER_FMT) USERNAME,LOGIN_BTIM,TODAY_BTIM,C - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! If no entry create a new entry - NEW_BULL = .TRUE.1 - WRITE (4,FMT=USER_FMT) USERNAME,TODAY_BTIM,TODAY_BTIM, - & 'FFFFFFFF'X,'FFFFFFFF'X,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF, - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN ! to go home...M - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -CI -C SUBROUTINE FIND_NEWEST_BULL -C_ -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -Cn -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z)n - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC'g - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER READ_DATE_TIME*20,LOGIN_DATE_TIME*20G - - CALL SYS$ASCTIM(,READ_DATE_TIME,READ_BTIM,) - CALL SYS$ASCTIM(,LOGIN_DATE_TIME,LOGIN_BTIM,) -C -C Now see if bulletins have been added since the user's previousN -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in.n -C - BULL_POINT = -1 ! Init bulletin pointer' -C$ -C Following stores a "possible" new bulletin. That is, the user hasl -C READNEW set, but ignored reading the bulletins. The user then enters -C BULLETIN, and if new bulletins are added after logging in, we want to -C point to that bulletin. However, if there were none added since then, -C we want to point to the first unread one. Thus, the first new unread -C bulletin is stored in BULL_POSSIBLE, and the search continues for -C new bulletins since logging in. -C1 - BULL_POSSIBLE = -1a - - CALL OPEN_FILE_SHARED(2) ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN ! If header present3 - DO ICOUNT=1,NBULL ! Get each bulletin to compare - CALL READDIR(ICOUNT,IER) ! its date with last read date - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - DIFF = COMPARE_DATE(READ_DATE_TIME(1:11),DATE) - IF (DIFF.EQ.0) ) - & DIFF = COMPARE_TIME(READ_DATE_TIME(13:20),TIME) - IF (DIFF.LE.0) THEN ! If new bull or new user - IF (SYSTEM) THEN ! If system bulletin - DIFF = COMPARE_DATE(LOGIN_DATE_TIME(1:11),DATE) - IF (DIFF.EQ.0) - & DIFF = COMPARE_TIME(LOGIN_DATE_TIME(13:20),TIME) - IF (DIFF.LE.0) THEN ! If system bull, make it - BULL_POINT = ICOUNT - 1 ! the first new bull only( - GO TO 100 ! if added since user logged ine - END IF ! else he's read it already. - ELSE - IF ((FOLDER_NUMBER.LE.31.AND. - & BTEST(SET_FLAG(1),FOLDER_NUMBER)).OR.e - & (FOLDER_NUMBER.GT.31.AND.L - & BTEST(SET_FLAG(2),FOLDER_NUMBER-32))) THEN - IF (BULL_POSSIBLE.EQ.-1) BULL_POSSIBLE = ICOUNT - 1 - DIFF = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF.GT.0) THEN - DIFF = COMPARE_DATE(LOGIN_DATE_TIME(1:11),DATE) - IF(DIFF.EQ.0) - & DIFF=COMPARE_TIME(LOGIN_DATE_TIME(13:20),TIME) - END IFY - END IFH - IF (DIFF.LE.0) THEN - BULL_POINT = ICOUNT - 1 ! If not system bull then - GO TO 100 ! make it the new bull - END IF. - END IF - END IFN - END IF+ - END DO - END IF - - BULL_POINT = BULL_POSSIBLEN - -100 CALL CLOSE_FILE(2) ! Its time for this program - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(INPUT,IER) - - IMPLICIT INTEGER (A-Z)l - - CHARACTER*20 INPUT - CHARACTER*23 TODAYP - - DIMENSION EXTIME(2),NOW(2) - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's dateO - -5 WRITE(6,1030) TODAY ! Prompt for expiration date - CALL GET_LINE(INPUT,LEN) ! Get input lineD - - IF (LEN.LE.0) THENU - IER = 0R - RETURN - END IF' - - INPUT = INPUT(1:LEN) ! Change trailing zeros 2 spaces - - IF (INDEX(INPUT,'-').EQ.0.AND.INDEX(INPUT,':').GT.0.AND.T - & INDEX(INPUT(1:LEN),' ').EQ.0) THEN - INPUT = TODAY(1:INDEX(TODAY(2:),' ')+1)//INPUT - END IFo - - CALL STR$UPCASE(INPUT,INPUT) ! Convert to upper case - IER = SYS$BINTIM(INPUT,EXTIME)a - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - GO TO 5l - END IFr - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - END IF( - - IF (INPUT(2:2).EQ.'-') INPUT = '0'//INPUT - IER = COMPARE_DATE(INPUT(1:11),TODAY(1:11)) ! Compare date with today's - IF (IER.EQ.0) IER = COMPARE_TIME(INPUT(13:20),TODAY(13:20)) - IF (IER.LE.0) THEN ! If expiration date not futureA - WRITE(6,1045) ! tell user' - GO TO 5 ! and re-request date - END IFN - - IER = 1 - - RETURNT - -1030 FORMAT (' It is ',A23,= - &'. Specify when the message should expire:',/,1x,E - &'Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ',N - &'or delta time: dddd hh:mm:ss')T -1040 FORMAT (' ERROR: Invalid date format specified.') -1045 FORMAT (' ERROR: Specified time has already passed.') - - END diff --git a/decus/vax87a/bulletin/bulletin3.for b/decus/vax87a/bulletin/bulletin3.for deleted file mode 100644 index f4d5c58..0000000 --- a/decus/vax87a/bulletin/bulletin3.for +++ /dev/null @@ -1,1262 +0,0 @@ -C -C BULLETIN3.FOR, Version 12/24/86 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*11 INEXDATE - CHARACTER*80 INDESCRIP,INFROM,INPUT - CHARACTER*8 ACCOUNT - - CALL DISABLE_CTRL - - CALL OPEN_FILE_SHARED(7) - -1 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - END DO - UNLOCK 7 - - IF (IER.NE.0) GO TO 900 - IF (FOLDER_BBOARD.EQ.'NONE') GO TO 1 - IF (FOLDER_NUMBER.EQ.0) THEN - FOLDER_SET = .FALSE. - ELSE - FOLDER_SET = .TRUE. - FOLDER_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - IF (GROUPB.NE.0.OR.USERB.NE.0) THEN ! If normal BBOARD user - CALL CHECK_MAIL(FOLDER_BBOARD,COUNT) ! Any new VMS mail? - IF (COUNT.EQ.0) GO TO 1 ! None. - END IF - -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME) ! Get present username - CALL GETACC(ACCOUNT) ! Get present account - CALL GETUIC(GROUP,USER) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(GROUPB,USERB) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(1:LEN_B)// - & FOLDER_BBOARD(1:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (GROUPB.NE.0.OR.USERB.NE.0) THEN ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B) - & //'BOARD.COM','NL:','NL:',,,,STATUS) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(1:LEN_B)//'BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(1:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B) - & //'BOARD.COM','NL:','NL:',,,,STATUS) - END IF - ELSE - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B)//FOLDER_BBOARD - & (1:TRIM(FOLDER_BBOARD))//'.COM','NL:','NL:',,,,STATUS) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',,,,STATUS) - END IF - END IF - ! Create sequential mail file - CALL SETACC(ACCOUNT) ! Reset to original account - CALL SETUSER(USERNAME) ! Reset to original username - CALL SETUIC(GROUP,USER) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_DIRECTORY(1:LEN_B)//FOLDER_BBOARD - & (1:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - -5 LEN = 1 - DO WHILE (LEN.GT.0) - READ (3,'(Q,A)',END=100) LEN,INPUT ! Read next line from mail - IF (INPUT(1:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(1:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - END IF - END DO - - -C -C Add bulletin to bulletin file and directory entry to directory file. -C - -10 CALL OPEN_FILE(2) ! Prepare to add dir entry - - READ (3,'(Q,A)',IOSTAT=IER) LEN,INPUT ! Read first line - IF (IER.NE.0) GO TO 100 ! If end of file, exit - IF (LEN.EQ.1.AND.INPUT(1:1).EQ.CHAR(12)) GO TO 5 - ! If line is just form feed, the message is empty - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - OCOUNT = NBLOCK + 1 ! Initialize line count - - SPACE = INDEX(INFROM,' ') - 1 ! Strip off the date - IF (SPACE.GT.0) INFROM = INFROM(1:SPACE)! From the "From:" line - - IF (TRIM(INFROM).GT.12) THEN ! Is length > allowable? - LEN_INFROM = TRIM(INFROM) - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(1:LEN_INFROM), - & OCOUNT) - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) - I = 12 ! Trim username to first non-alpha character - DO WHILE (I.GT.1.AND. - & ((INFROM(I:I).GE.'A'.AND.INFROM(I:I).LE.'Z').OR. - & (INFROM(I:I).GE.'a'.AND.INFROM(I:I).LE.'z')) ) - I = I - 1 - END DO - IF (I.GT.1) INFROM = INFROM(1:I-1) - END IF - - LEN_DESCRP = TRIM(INDESCRIP) - IF (LEN_DESCRP.GT.53) THEN ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//INDESCRIP(1:LEN_DESCRP), - & OCOUNT) - INDESCRIP = INDESCRIP(1:LEN_DESCRP) - DO I=1,LEN_DESCRP - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - ELSE - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - END IF - - ISTART = 0 - NBLANK = 0 - DO WHILE (INPUT(1:1).NE.CHAR(12)) ! Move text to bulletin file - IF (LEN.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - NBLANK = 0 - LEN = MIN(LEN,80) - CALL STORE_BULL(LEN,INPUT,OCOUNT) - END IF - READ (3,'(Q,A)',END=25) LEN,INPUT - END DO - -25 CALL FLUSH_BULL(OCOUNT) - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - DESCRIP = INDESCRIP(1:53) ! Description header - FROM = INFROM(1:12) ! Username - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - EXTIME = '00:00:00' - LENGTH = OCOUNT - NBLOCK ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - -30 CALL CLOSE_FILE(2) ! Totally finished with add - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - GOTO 1 - -900 FOLDER_NUMBER = 0 - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=0,KEYID=1) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - CALL CLOSE_FILE(7) - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - WRITE (6,1030) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:' - & ,,,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL EXE$GL_ABSTIM - INTEGER UPTIME(2),SYSTIME(2),UPSINCE(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - UPTIME(1) = GET_L_VAL(EXE$GL_ABSTIM) ! Up time (sec) - - CALL LIB$EMUL(10000000,UPTIME,0,UPTIME) ! 64 bit format - CALL SYS$GETTIM(SYSTIME) - CALL LIB$SUBX(SYSTIME,UPTIME,UPSINCE) - CALL SYS$ASCTIM(,ASCSINCE,UPSINCE,) ! Up since - - UPTIME_DATE = ASCSINCE(1:11) - UPTIME_TIME = ASCSINCE(13:20) - - RETURN - END - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(USER,NEW_MESSAGES) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*35,USER*(*) - EQUIVALENCE (INPUT(34:),COUNT) - - OPEN (UNIT=10,FILE='VMSMAIL',DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED) - READ(10,'(A)',KEY=USER,IOSTAT=IER) INPUT - CLOSE (10) - - NEW_MESSAGES = COUNT - - IF (IER.NE.0) COUNT = 0 - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C -C NOTE: These routines don't presently allow return length address -C in item list. -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entries in user file of users that no longer exist. -C - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CALL OPEN_FILE_SHARED(8) - - READ (4,'(A12)',ERR=20,KEYGE=USER_HEADER) LOGIN_USER - ! Move pointer to top of file - -5 READ (4,'(A12)',ERR=20) LOGIN_USER ! Get user entry - READ (8,KEY=LOGIN_USER,ERR=10) LOGIN_USER ! See if user exists - GO TO 5 ! If so, get next user entry - -10 DELETE(UNIT=4) ! Delete non-existant user - GO TO 5 ! Go get next user entry - -20 CALL CLOSE_FILE(8) ! All done... - -30 RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER INPUT*80 - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - LEN = 0 - DO WHILE (LEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) LEN,INPUT - LEN = MIN(LEN,TRIM(INPUT),80) - IF (LEN.GT.1.AND.ICHAR(INPUT(LEN:LEN)).EQ.10) THEN1 - INPUT(LEN-1:LEN-1) = CHAR(32) ! Remove imbedded - INPUT(LEN:LEN) = CHAR(32) ! CR/LFs at end of file.O - LEN = LEN - 2 - END IFo - IF (LEN.GT.0) THEN - ICOUNT = ICOUNT + 1 - ELSE IF (LEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN' - NBLANK = NBLANK + 1 - END IFE - END DO - IF (NBLANK.GT.0) THENF - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT)P - END DO8 - LENGTH = LENGTH + NBLANK*2C - NBLANK = 0D - END IF - CALL STORE_BULL(LEN,INPUT,OCOUNT)= - LENGTH = LENGTH + LEN + 1 - END DOL - -100 LENGTH = (LENGTH+127)/128S - IF (LENGTH.EQ.0) THEN - IER = 1B - ELSEU - IER = 0C - END IFE - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - SUBROUTINE STORE_BULL(LEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*(BRECLEN)R - - DATA POINT/0/ - - IF (LEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - WRITE (1'OCOUNT) OUTPUT(1:POINT)l - OUTPUT = CHAR(LEN)//INPUT - POINT = LEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THENO - WRITE (1'OCOUNT) OUTPUT(1:POINT)//CHAR(LEN) - OUTPUT = INPUT - POINT = LEN - ELSE - WRITE (1'OCOUNT) OUTPUT(1:POINT)//CHAR(LEN) - & //INPUT(1:BRECLEN-1-POINT) - OUTPUT = INPUT(BRECLEN-POINT:)m - POINT = LEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - ELSEs - OUTPUT(POINT+1:) = CHAR(LEN)//INPUT(1:LEN) - POINT = POINT + LEN + 1E - END IFE - - RETURNO - - ENTRY FLUSH_BULL(OCOUNT)u - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - WRITE (1'OCOUNT) OUTPUT - POINT = 0 - - RETURN - - END - - - SUBROUTINE GET_BULL(BLOCK,INPUT,LEN) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128,LINE_LENGTH=80R - - CHARACTER INPUT*(*),TEMP*(BRECLEN), LEFT*(BRECLEN) - - DATA POINT /1/, LEFT_LEN /0/D - - IF (LEN.GT.LINE_LENGTH) THENT - POINT = 1u - LEFT_LEN = 0 - END IF. - - IF (POINT.EQ.1) THEN! - DO WHILE (REC_LOCK(IER)) - READ (1'BLOCK,IOSTAT=IER) TEMPN - END DO - ELSE IF (POINT.EQ.BRECLEN+1) THEN - LEN = 0T - POINT = 1' - RETURN - END IF - - IF (IER.GT.0) THEN' - LEN = -1 - POINT = 1' - LEFT_LEN = 0 - RETURN - END IFT - - IF (LEFT_LEN.GT.0) THEN - LEN = ICHAR(LEFT(1:1)) - INPUT = LEFT(2:LEN-LEFT_LEN+1)//TEMP(1:LEFT_LEN) - POINT = LEFT_LEN + 1 - LEFT_LEN = 0 - ELSE - LEN = ICHAR(TEMP(POINT:POINT)) - IF (LEN.GT.BRECLEN-POINT) THEN - LEFT = TEMP(POINT:) - LEFT_LEN = LEN - (BRECLEN-POINT)R - LEN = 0 - POINT = 1 - ELSE IF (LEN.EQ.0) THEN/ - POINT = 1 - ELSE - INPUT = TEMP(POINT+1:POINT+LEN) - POINT = POINT+LEN+1 - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(LEN)P - - IF (POINT.EQ.BRECLEN+1) THEN' - LEN = 0/ - ELSE - LEN = ICHAR(TEMP(POINT:POINT)) - END IFD - - RETURN - - END - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -CA -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C_ - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THENF - CALL READDIR(0,IER)E - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF( - - DELETE(UNIT=2,REC=BULL_ENTRY+1) - - NEMPTY = NEMPTY + LENGTHR - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -Cn -C FUNCTION: Computes expiration date giving number of days to expire. -CU - IMPLICIT INTEGER (A-Z) - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12)e - DIMENSION LENGTH(12)O - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/N - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present datee - - DECODE(2,'(I2)',EXDATE(1:2)) DAY ! Get day: - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1j - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IFd - - NUM_DAYS = NDAYS ! Put number of days into buffer variablei - - DO WHILE (NUM_DAYS.GT.0)O - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN. - ! If expiration date exceeds end of monthi - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in monthD - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27M - END IF - END IFE - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exitt - END IF - END DOT - - ENCODE(2,'(I2)',EXDATE(1:2)) DAY ! Put day into new dateE - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURNF - END - - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -CI -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal.O -CB -C OUTPUTS:C -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES:N -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST.' -C - - IMPLICIT INTEGER (A-Z)N - - LOGICAL*1 DESCRIP(8),DTYPE,CLASSN - INTEGER*2 LENGTHI - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE)N - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN_ - - INCLUDE '($RMSDEF)' - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT= - LOGICAL DECNET_PROC - - CHARACTER*(*) PROMPTO - LOGICAL*1 USE_PROMPT - - USE_PROMPT = .FALSE.E - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT)_ - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE ande -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1e -C - - FLAG = 0 ! Yep, init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO0 - & CTRLC_ROUTINE,FLAG,,,,) ! Enable the AST - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limitI - POINTER = 0 ! during input. - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line.W -C, - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTB - IF (IER.NE.0) LEN_INPUT = -2 E - RETURN - ELSE IF (USE_PROMPT) THEN - IER = LIB$GET_INPUT(DESCRIP,PROMPT) ! Get line from terminal - ELSEI - IER = LIB$GET_INPUT(DESCRIP) ! Get line from terminal - END IFR - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT)l - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - IER1 = SYS$CANCEL(%VAL(TERM_CHAN)) ! Cancel CTRL-C AST - IF (IER.NE.RMS$_EOF) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of lineA - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DOT - CALL CONVERT_TABS(INPUT,LEN_INPUT)T - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so0 - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF: - RETURNR - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT)C - - IMPLICIT INTEGER (A-Z)S - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT)1 - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THENF - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DOR - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DOM - LEN_INPUT = LIMIT+1 - END IF - END DO% - - RETURNO - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT)b - RETURNT - END - - SUBROUTINE CTRLC_ROUTINE(FLAG) ! CTRL-C AST routineb - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -CC -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal and purgeP -C type ahead buffer., -C! - IMPLICIT INTEGER (A-Z)T - - CHARACTER*(*) DATAB - - EXTERNAL IO$_READVBLK,IO$M_NOECHO,IO$M_PURGE - - COMMON /TERM_CHAN/ TERM_CHANF - - DO I=1,LEN(DATA) - DATA(I:I) = ' 'I - END DON - - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO) - - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, - & %VAL(%LOC(DATA)),%VAL(LEN(DATA)),,,,)T - - RETURNT - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal) - - RETURN - - ENTRY PURGE_TYPEAHEAD ! Purge type-ahead buffer - - IO_READ = %LOC(IO$_READVBLK)+%LOC(IO$M_NOECHO)+%LOC(IO$M_PURGE) - - IER = SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_READ),,,, - & %VAL(%LOC(IER)),%VAL(0),,,,) ! Purge type ahead buffer( - - RETURNR - END - - - - - - SUBROUTINE GETPAGLEN(PAGE_LENGTH) -CH -C SUBROUTINE GETPAGLENS -C -C FUNCTION: -C Gets page length of the terminal.S -C( -C OUTPUTS:N -C PAGE_LENGTH - Page length of the terminal. -CA - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1)))E - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = DEVDEPEND(4)L - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINALT -C: -C FUNCTION SLOW_TERMINALo -Cs -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -Cg -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -CA - - IMPLICIT INTEGER (A-Z)L - - EXTERNAL IO$_SENSEMODEi - - COMMON /TERM_CHAN/ TERM_CHANl - - COMMON CHAR_BUF(2)T - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)'& - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSER - SLOW_TERMINAL = .FALSE.O - END IFL - - RETURN - END - - - - - SUBROUTINE SHOW_PRIVo -Cs -C SUBROUTINE SHOW_PRIVt -Cl -C FUNCTION: -C To show privileges necessary for managing bulletin board.a -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'g - - INCLUDE '($PRVDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - DO WHILE (REC_LOCK(IER))t - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DOI - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not presentu - CALL CLOSE_FILE(4) - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER)M - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - NEW_FLAG(2) = 0 - REWRITE (4,FMT=USER_FMT)( - & TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')')M - DO I=0,38M - IF ((I.LT.32.AND.BTEST(NEW_FLAG(1),I)).OR.l - & (I.GT.31.AND.BTEST(NEW_FLAG(2),I-32))) THENM - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSEc - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IFd - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -Cn -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C1 - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'f - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVSf - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA',E - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/e - - EXTERNAL CLI$_ABSENTL - - DIMENSION ONPRIV(2),OFFPRIV(2)L - - CHARACTER*8 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THENN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IFN - - OFFPRIV(1) = 0r - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,LEN)T - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - PRIV_FOUND = -1R - I = 0a - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:LEN).EQ.PRIVS(I)) PRIV_FOUND = IL - IF (INPUT_PRIV(3:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(1:LEN) - RETURNa - ELSE IF (INPUT_PRIV(1:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THENE - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')')P - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSED - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)R - END IFI - ELSE - IF (PRIV_FOUND.LT.32) THENU - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSED - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DOU - - CALL OPEN_FILE(4) ! Get BULLUSER.DAT file - - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER)a - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - - IF (IER.EQ.0) THEN ! If header is present, exit - NEW_FLAG(1) = NEW_FLAG(1).OR.ONPRIV(1) - NEW_FLAG(2) = NEW_FLAG(2).OR.ONPRIV(2) - NEW_FLAG(1) = NEW_FLAG(1).AND.(.NOT.OFFPRIV(1))i - NEW_FLAG(2) = NEW_FLAG(2).AND.(.NOT.OFFPRIV(2))n - REWRITE (4,FMT=USER_FMT) - & TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - WRITE (6,'('' Privileges successfully modified.'')') - ELSEN - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IFO - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN - - END diff --git a/decus/vax87a/bulletin/bulletin4.for b/decus/vax87a/bulletin/bulletin4.for deleted file mode 100644 index 7c6b5bf..0000000 --- a/decus/vax87a/bulletin/bulletin4.for +++ /dev/null @@ -1,1115 +0,0 @@ -C -C BULLETIN4.FOR, Version 1/27/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C NOTE: Subroutine CHECK_ACCESS which is used to see if user has only read -C access to a folder only works for VMS V4.4 or later. If you have an -C early version, modify as indicated. -C - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) RETURN - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - LEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - LEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY & /READNEW are privileged - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW'))) THEN - WRITE (6,'( - & '' ERROR: No privs to change all NOTIFY or READNEW.'')') - RETURN - END IF - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - WRITE (6,'('' Enter one line description of folder.'')') - -10 CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(1:LENDES) ! End fill with spaces - IF (LENDES.LE.0) GO TO 910 - IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - GO TO 10 - END IF - - FOLDER_OWNER = USERNAME ! Get present username - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(1:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',IOSTAT=IER, - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.64) - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Limit of 63 folders has been reached.'')') - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER_NUMBER = LAST_NUMBER - 1 - END IF - - FOLDER_OWNER = USERNAME ! Get present username - FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = 14 - - WRITE (7,FMT=FOLDER_FMT) FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('BRIEF')) BRIEF = 1 - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(1:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_FILE(7) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - - - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets NOTIFY or READNEW defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (.NOT.SETPRV_PRIV().AND.INCMD(1:3).EQ.'SET') THEN - WRITE (6,'( - & '' ERROR: No privs to change all defaults.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(4) - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) ! Get header - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG, - & BRIEF_FLAG,NOTIFY_FLAG - END DO - DO WHILE (IER.EQ.0) - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEYGT=TEMP_USER,IOSTAT=IER) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG, - & BRIEF_FLAG,NOTIFY_FLAG ! Find if there is an entry - END DO - IF (TEMP_USER.NE.USER_HEADER.AND. - & (BRIEF.EQ.-1.OR.NOTIFY.EQ.-1.OR.READNEW.EQ.-1)) THEN - IER = 1 ! Modify READNEW and NOTIFY for all users - END IF ! only during folder creation or deletion. - END DO - CALL CLOSE_FILE(4) - - RETURN - END - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) FOLDER1, - & FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP ! See if it exists - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(1:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL OPEN_FILE(2) ! Remove directory file - CALL OPEN_FILE(1) ! Remove bulletin file - CALL CLOSE_FILE_DELETE(1) - CALL CLOSE_FILE_DELETE(2) - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) FOLDER_SET = .FALSE. - -1000 CALL CLOSE_FILE(7) - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL CLI$_ABSENT - - DIMENSION FIRST_TIME(2) ! Bit set for folder if folder has - DATA FIRST_TIME /2*0/ ! been selected before this. - - IF (OUTPUT) IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1,LEN) - ! Get folder name - - CALL OPEN_FILE_SHARED(7) ! Go find folder - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.EQ.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER_SET = .FALSE. - DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,KEY=FOLDER_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB - END DO - IF (OUTPUT) THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(1:TRIM(FOLDER))//'.' - BULL_POINT = 0 ! Reset bulletin pointer to first bulletin - END IF - IER = 1 - CALL CLOSE_FILE(7) - READ_ONLY = .FALSE. - ELSE - DO WHILE (REC_LOCK(IER)) - IF (OUTPUT.OR.FOLDER_NUMBER.EQ.-1) THEN - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB1,GROUPB1 - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - READ (7,FMT=FOLDER_FMT,KEY=FOLDER_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB1,GROUPB1 - END IF - END DO - - CALL CLOSE_FILE(7) - - IF (IER.EQ.0) THEN ! Folder found - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHKACL - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER) THEN - CALL CHECK_ACCESS - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(1:TRIM(FOLDER1_OWNER)) - RETURN - END IF - END IF - IF (IER) THEN - FOLDER_SET = .TRUE. - - FOLDER = FOLDER1 ! Folder successfully set - FOLDER_NUMBER = FOLDER1_NUMBER ! so update permanent folder - FOLDER_OWNER = FOLDER1_OWNER ! parameters. - FOLDER_DESCRIP = FOLDER1_DESCRIP - FOLDER_BBOARD = FOLDER1_BBOARD - FOLDER_BBEXPIRE = FOLDER1_BBEXPIRE - FOLDER_FILE = FOLDER1_FILE - USERB = USERB1 - GROUPB = GROUPB1 - - IF (OUTPUT) THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(1:LEN)//'.' - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT) - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (OUTPUT.AND. ! If first select, look for expired messages. - & .NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (IER.LE.0) CALL UPDATE ! Need to update - END IF - CALL CLOSE_FILE(2) - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - - IF (OUTPUT.AND.TEST2(NEW_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(0,1) - CALL FIND_NEWEST_BULL ! See if there are new bulletins - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - IER = 1 - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - END IF - - RETURN - - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDERR -Ce -C FUNCTION: Shows the information on any folder.r -Ce - - IMPLICIT INTEGER (A-Z)g - - INCLUDE 'BULLUSER.INC'F - - INCLUDE 'BULLFOLDER.INC'm - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'_ - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT - - CALL OPEN_FILE_SHARED(7) ! Open folder file - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).NE.%LOC(CLI$_ABSENT)) - & THEN -10 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER). - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPBi - END DO - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER1N - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_FILE(7)R - RETURN( - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(1:TRIM(FOLDER1_DESCRIP))' - END IF - ELSE IF (FOLDER_SET) THEN - WRITE (6,1000) FOLDER,FOLDER_OWNER,. - & FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP))_ - FOLDER1_FILE = FOLDER_FILE - FOLDER1_BBOARD = FOLDER_BBOARD - FOLDER1_BBEXPIRE = FOLDER_BBEXPIRE - FOLDER1_NUMBER = FOLDER_NUMBER - ELSE) - FOLDER1 = 'GENERAL' - GO TO 10 - END IF_ - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - WRITE (6,'('' Folder is not a private folder.'')') - ELSE - CALL CHECK_ACCESSA - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD.NE.'NONE') THEN - LEN = TRIM(FOLDER1_BBOARD)T - IF (LEN.GT.0) THENE - WRITE (6,'('' BBOARD for folder is '',A,''.'')')i - & FOLDER1_BBOARD(1:LEN)D - END IFr - IF (USERB.EQ.0.AND.GROUPB.EQ.0) THENC - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' BBOARD expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIREE - ELSE - WRITE (6,'('' BBOARD messages will not expire.'')')D - END IF* - ELSEU - WRITE (6,'('' No BBOARD has been defined.'')') - END IFI - CALL OPEN_FILE_SHARED(4) - DO WHILE (REC_LOCK(IER))( - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER)l - & TEMP_USER,LOGIN_BTIM,READ_BTIM,C - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DOi - IF (TEST2(SET_FLAG,FOLDER1_NUMBER)) THENz - IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is BRIEF.'')')C - ELSE - WRITE (6,'('' Default is READNEW.'')')T - END IF - ELSES - WRITE (6,'('' Default is NOREADNEW.'')')/ - END IFU - IF (TEST2(NOTIFY_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY.'')') - ELSE/ - WRITE (6,'('' Default is NONOTIFY.'')') - END IF) - CALL CLOSE_FILE(4) - END IF - END IFE - - CALL CLOSE_FILE(7)T - - RETURNF - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT)f -Ce -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -Cc - IMPLICIT INTEGER (A - Z)N - - INCLUDE 'BULLFOLDER.INC'V - - COMMON /PAGE/ PAGE_LENGTH - - DATA SCRATCH_D1/0/ - - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - -Cp -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memoryI -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.D -CR - - IF (SCRATCH_D1.EQ.0) THEN ! Is queue empty?. - CALL LIB$GET_VM(132,SCRATCH_D) ! If so, allocated memory - CALL MAKE_CHAR(%VAL(SCRATCH_D),120) ! Form a character string) - SCRATCH_D1 = SCRATCH_D ! Init header pointerE - ELSE ! Else queue is not empty_ - SCRATCH_D = SCRATCH_D1 ! so reinit queue pointerT - END IF ! to the header. - - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDER = 0i - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,KEYGT=FOLDER1,KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - END DO - IF (IER.EQ.0) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER_COM), - END IF - END DOT - - CALL CLOSE_FILE(7) ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IFy - -C. -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen2 - - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*2,PAGE_LENGTH-4)E - ! If more entries then page size, truncate output - DO I=FOLDER_COUNT,FOLDER_COUNT+DISPLAY/2-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER_COM)C - WRITE (6,1000) FOLDER1,FOLDER1_OWNER,FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counterE - END DO_ - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0., - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURND - -1000 FORMAT(' Folder: ',A25,' Owner: ',A12,' Description:',/,1X,A80) -1010 FORMAT(1X,/,' Press RETURN for more...',/)L - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -CF -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID.F -CN -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny accesss -C - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLFOLDER.INC'0 - - INCLUDE 'BULLUSER.INC'I - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'A - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENTE - - CHARACTER ID*25,RESPONSE*1T - - IF (CLI$PRESENT('ALL')) THEND - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IFm - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE.n - ELSE - READONLY = .FALSE. - END IFO - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder nameL - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THENe - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')')O - RETURNB - ELSE - FOLDER1 = FOLDERE - END IF - ELSE IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')B - RETURN - END IFE - - IF (.NOT.ALL) THEN= - IER = CLI$GET_VALUE('ACCESS_ID',ID,LEN) ! Get IDP - IF (LEN.GT.25) THEN1 - WRITE(6,'('' ERROR: ID name must be < 26 characters.'')') - RETURNs - END IF - END IF& - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP ! See if it existsD - CALL CLOSE_FILE(7) - - IF ((.NOT.ALL).AND.(ID.EQ.FOLDER1_OWNER)) THEN! - WRITE (6,'(p - & '' ERROR: Cannot modify access for owner of folder.'')')F - RETURN - END IF, - - IF (IER.NE.0) THENN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,' - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSEA - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))//T - & FOLDER1T - CALL CHKACL - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENL - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,D - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THENG - WRITE (6,'('' Folder access was not changed.'')')F - RETURN - ELSE - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)S - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)U - END IF - END IF - IF (ACCESS) THEN - IF (.NOT.ALL) THENG - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER)U - ELSET - CALL ADD_ACL(ID,'R+W',IER)R - END IFW - ELSEG - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSEO - CALL DEL_ACL(' ','R+W',IER)A - END IF& - END IFO - ELSE - IF (ALL) THEN - CALL DEL_ACL('*','R',IER) - ELSEd - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IFI - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' ERROR: Cannot modify ACL of folder files.'')') - CALL SYS_GETMSG(IER)o - ELSE - WRITE (6,'('' Access to folder has been modified.'')')I - END IF - END IF - - RETURNE - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL)A -CR -C SUBROUTINE CHKACL -CI -C FUNCTION: Checks ACL of given file. -CL -C PARAMETERS: -C FILENAME - Name of file to check.E -C IERACL - Error returned for attempt to open file.E -C, - - IMPLICIT INTEGER (A-Z)f - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)'F - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THENS - IERACL = SS$_NORMAL.OR.IERACLO - END IFC - - RETURN( - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -CO -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -CW -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C, -C NOTE: SYS$CHECK_ACCESS is only available under V4.4 or later. -C If you have an earlier version, comment out the lines which call -C it and set both READ_ACCESS and WRITE_ACCESS to 1, which willn -C allow program to run, but will not allow READONLY access feature.E -CI - - IMPLICIT INTEGER (A-Z)T - - CHARACTER FILENAME*(*),USERNAME*(*) - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME,. - & %VAL(ACL_ITMLST))I - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))l - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME)D -CI -C SUBROUTINE SHOWACLI -C. -C FUNCTION: Shows users who are allowed to read private bulletin. -C' -C PARAMETERS: -C FILENAME - Name of file to check.U -CP - IMPLICIT INTEGER (A-Z)R - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAMEN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))s - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)P - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH)1 - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN. - END - - - Q - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C. -C SUBROUTINE READACLl -C -C FUNCTION: Reads the ACL of a file.O -CR -C PARAMETERS: -C FILENAME - Name of file to check.R -C ACLENT - String which will be large enough to hold ACL information.O -CR - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*) - CHARACTER NOT_ID*3 - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)O - - DO ACCESS_TYPE=1,2 - POINT = 1T - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)D - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - IF ((ACCESS_TYPE.EQ.1.AND.INDEX(ACLSTR,'WRITE').GT.0).OR.E - & (ACCESS_TYPE.EQ.2.AND.INDEX(ACLSTR,'READ)').GT.0)) THENR - START_ID = INDEX(ACLSTR,'=') + 1) - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEND - START_ID = END_ID - 1 - DO WHILED - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0)Q - START_ID = START_ID - 1 - END DOF - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THENF - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IFD - END IF - IF (OUTLEN.EQ.0) THEN - IF (ACCESS_TYPE.EQ.1) THEN - WRITE (6,'(I - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(D - & '' These users can only read this folder:'')') - END IF - OUTLEN = 1 - END IF( - LEN = END_ID - START_ID + 1 - IF (OUTLEN+LEN-1.GT.80) THENO - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = LEN + 2S - ELSE IF (OUTLEN+LEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)e - OUTLEN = 1 - ELSEO - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + LEN + 1 - END IFO - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)R - END DOO - - RETURN - END diff --git a/decus/vax87a/bulletin/bulletin5.for b/decus/vax87a/bulletin/bulletin5.for deleted file mode 100644 index 172eb2c..0000000 --- a/decus/vax87a/bulletin/bulletin5.for +++ /dev/null @@ -1,1111 +0,0 @@ -C -C BULLETIN5.FOR, Version 12/25/86 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_FILE_SHARED(4) - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEYEQ=TEMP_USER,IOSTAT=IER) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG, - & BRIEF_FLAG,NOTIFY_FLAG ! Find if there is an entry - END DO - - CALL SYS$BINTIM('5-NOV-2956',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).EQ.0) THEN - CALL SYS$BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER UAF$V_DISACNT = 4, UAF$L_UIC = '24'X - PARAMETER UAF$L_ACCOUNT = 53 - PARAMETER UAF$L_FLAGS = '1D4'X - PARAMETER INPUT_LEN = UAF$L_FLAGS + 4 - - CHARACTER INPUT*(INPUT_LEN),USERNAME*(*),ACCOUNT*(*) - - EQUIVALENCE (INPUT(UAF$L_UIC+1:),USER2) - EQUIVALENCE (INPUT(UAF$L_UIC+3:),GROUP2) - EQUIVALENCE (INPUT(UAF$L_FLAGS+1:),FLAGS2) - - INTEGER*2 USER2,GROUP2 - - CALL OPEN_FILE_SHARED(8) - - READ (8,KEY=USERNAME,IOSTAT=IER) INPUT - ! Move pointer to top of file - - CALL CLOSE_FILE(8) - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - ELSE - FLAGS = FLAGS2 - IER = 1 - USER = USER2 - GROUP = GROUP2 - ACCOUNT = INPUT(UAF$L_ACCOUNT:UAF$L_ACCOUNT+7) - END IF - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - CALL CLOSE_FILE(4) - NEEDPRIV(1) = NEW_FLAG(1) - NEEDPRIV(2) = NEW_FLAG(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P) - & ,LIBRARY,,LIB$GET_INPUT) - - RETURN - END - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - CALL STR$TRIM(INPUT,INPUT,TRIM) - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - -C -C BULLSUB3.FOR, Version 12/18/86 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE(INPUT) -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C -C INPUT: -C INPUT - Unit number of file to close out. -C 1 = BULLETIN.DAT -C 2 = BULLDIR.DAT -C 4 = BULLUSER.DAT -C 7 = BULLFOLDER.DAT -C 8 = SYS$SYSTEM:SYSUAF.DAT -C - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT) - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE(INPUT) - - IMPLICIT INTEGER (A-Z) - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT,STATUS='DELETE') - - RETURN - END - - - SUBROUTINE OPEN_FILE(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - EXTERNAL BULLDIR_ERR,BULLETIN_ERR,BULLUSER_ERR,BULLFOLDER_ERR - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2) - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - IF (TIMEEFN.EQ.0) CALL LIB$GET_EF(TIMEEFN) - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (INPUT.EQ.2) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - IF (FOLDER_SET) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='UNKNOWN',IOSTAT=IER, - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - ELSE - OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='UNKNOWN', - 1 IOSTAT=IER, - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFILES - END IF - END DO - END IF - - IF (INPUT.EQ.1) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - IF (FOLDER_SET) THEN - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - ELSE - OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='UNKNOWN', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFILE - END IF - END DO - END IF - - IF (INPUT.EQ.4) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=60, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=60, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER,NEWEST_BTIM, - 1 BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - 1 PRV$M_SETPRV,0,0,0,0,0,0 - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - END IF - END DO - END IF - - IF (INPUT.EQ.7) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLFOLDER_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED', - 1 RECORDSIZE=FOLDER_RECORD, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - 1 ACCESS='KEYED',RECORDTYPE='FIXED', - 1 RECORDSIZE=FOLDER_RECORD, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER1) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - END IF - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - IER = SYS$CANTIM(,) ! Successful, so cancel timer. - - RETURN - END - - SUBROUTINE TIMER_ERR - - IMPLICIT INTEGER (A-Z) - - ENTRY BULLDIR_ERR - WRITE(6,'('' ERROR: Unable to open directory file after 30 secs.'')') - GO TO 10 - - ENTRY BULLETIN_ERR - WRITE(6,'('' ERROR: Unable to open message file after 30 secs.'')') - GO TO 10 - - ENTRY BULLUSER_ERR - WRITE(6,'('' ERROR: Unable to open BULLUSER.DAT after 30 secs.'')') - GO TO 10 - - ENTRY BULLFOLDER_ERR - WRITE(6,'('' ERROR: Unable to open BULLFOLDER.DAT after 30 secs.'')') - GO TO 10 - -10 CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL LNM_MODE_EXEC - - CALL DISABLE_CTRL - - IF (INPUT.EQ.2) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (FOLDER_SET) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 SHARED,READONLY,IOSTAT=IER) - ELSE - OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 SHARED,READONLY,IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFILES - END IF - END DO - END IF - - IF (INPUT.EQ.1) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (FOLDER_SET) THEN - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - ELSE - OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='OLD', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFILE - END IF - END DO - END IF - - IF (INPUT.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=60,IOSTAT=IER, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED, - 1 KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - END IF - END DO - END IF - - IF (INPUT.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED', - 1 RECORDSIZE=FOLDER_RECORD,IOSTAT=IER, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED, - 1 KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - END IF - - IF (INPUT.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.INPUT.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - CALL OPEN_FILE(INPUT) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL ENABLE_CTRL_EXIT - END IF - - RETURN - END - - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs).5 -CR - - IMPLICIT INTEGER (A-Z)o - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 INPUT,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')')N - - IF (FOLDER_SET) THENT - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',U - 1 RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',) - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',P - 1 SHARED,READONLY,IOSTAT=IER) - ELSE' - EODIR = MAX(INDEX(BULLDIR_FILE,':'),INDEX(BULLDIR_FILE,']')) - SUFFIX = INDEX(BULLDIR_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLDIR_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLDIR_FILE,NEW_FILE) - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - 1 RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',i - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',_ - 1 SHARED,READONLY,IOSTAT=IER) - END IFP - - IF (IER.NE.0) THEN ! Error. Why?H - CALL ERRSNS(IDUMMY,IER)D - CALL SYS_GETMSG(IER) - CALL EXITT - END IF - - IF (FOLDER_SET) THENN - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',R - 1 RECORDTYPE='FIXED',RECORDSIZE=80, - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)R - ELSEe - EODIR = MAX(INDEX(BULLETIN_FILE,':'),INDEX(BULLETIN_FILE,']')) - SUFFIX = INDEX(BULLETIN_FILE(EODIR:),'.') + EODIR - 1, - NEW_FILE = BULLETIN_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLETIN_FILE,NEW_FILE) - OPEN (UNIT=10,FILE=NEW_FILE,STATUS='OLD',T - 1 RECORDTYPE='FIXED',RECORDSIZE=80, - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)* - END IF* - - IF (IER.NE.0) THEN ! Error. Why?, - CALL ERRSNS(IDUMMY,IER)A - CALL SYS_GETMSG(IER) - CALL EXIT( - END IFG - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)I - - IF (FOLDER_SET) THEN - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - 1 FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))R - 1 //'.BULLDIR',STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',D - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 IOSTAT=IER) - ELSE - OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=81, - 1 FORM='FORMATTED',IOSTAT=IER)U - - OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='NEW',' - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - 1 IOSTAT=IER) - END IF - - NEWEST_EXTIME = '00:00:00'' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIMEO - NEMPTY = 0p - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00' - ICOUNT = 2I - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') INPUTR - WRITE(1,'(A)') INPUT(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT - END DOR - CALL WRITEDIR(ICOUNT-1,IER1)O - ICOUNT = ICOUNT + 1 - END IF - END DOO - - CLOSE (UNIT=9)P - CLOSE (UNIT=2)) - CLOSE (UNIT=10) - CLOSE (UNIT=1)' - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionN - RETURNV - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C, -C SUBROUTINE CONVERT_BULLFILE -C& -C FUNCTION: Converts bulletin data file to new format file. -CI -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -CE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'R - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 INPUT,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_FILE(2)R - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)I - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)E - - CALL OPEN_FILE(7) - -100 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,ERR=200)A - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - END DOm - - IF (FOLDER_NUMBER.GT.0) THEN - FOLDER_SET = .TRUE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))C - & //FOLDER(:TRIM(FOLDER))M - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD'I - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - 1 ,STATUS='OLD',S - 1 RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - ELSE - FOLDER_SET = .FALSE. - EODIR = MAX(INDEX(BULLETIN_FILE,':'),INDEX(BULLETIN_FILE,']')) - SUFFIX = INDEX(BULLETIN_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLETIN_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLETIN_FILE,NEW_FILE) - OPEN (UNIT=10,FILE=NEW_FILE,STATUS='OLD',C - 1 RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - 1 FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)L - END IFT - - IF (IER.NE.0) THEN ! Error. Why? - CALL ERRSNS(IDUMMY,IER)S - CALL SYS_GETMSG(IER) - CALL EXITT - END IFo - - IF (FOLDER_NUMBER.GT.0) THENh - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))T - & //'.BULLFIL;-1',NEW_FILE)R - ELSEG - OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='NEW',R - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - END IFP - - CALL OPEN_FILE(2) - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER)E - NBLOCK = NBLOCK + 1, - SBLOCK = NBLOCKU - DO J=BLOCK,LENGTH+BLOCK-1P - READ(10'J,'(A)') INPUTB - LEN = TRIM(INPUT) - IF (LEN.EQ.0) LEN = 1 - CALL STORE_BULL(LEN,INPUT,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK)F - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IFN - - CLOSE (UNIT=10) - CLOSE (UNIT=1)N - - CALL CLOSE_FILE(2)X - GOTO 100 - -200 CALL OPEN_FILE_SHARED(2) - - FOLDER_SET = .FALSE.U - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN= - - END - - SUBROUTINE CONVERT_USERFILE -C. -C SUBROUTINE CONVERT_USERFILE -CR -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'P - - CHARACTER BUFFER*74,NEW_FILE*80 - DIMENSION ADD_USER(6) - DATA ADD_USER/0,0,2*ZFFFFFFFF,2*0/ - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIMES - - WRITE (6,'('' Converting data files to new format. Please wait.'')')O - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))e - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - RECL = 42 - IER = 1 - DO WHILE (IER.NE.0.AND.RECL.NE.82)n - RECL = RECL + 8L - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=RECL, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - 1 KEY=(1:12:CHARACTER)) - END DON - - IF (IER.EQ.0) THENN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)L - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',' - 1 ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=60,IOSTAT=IER, - 1 FORM='FORMATTED',ORGANIZATION='INDEXED',U - 1 KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN) - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1)0 - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXIT. - END IFI - - IF (RECL.LT.74) THENL - IF (RECL.LE.58) RECL = 50l - ADD_WORD = (74-RECL)/4 - IER = 0 - DO WHILE (IER.EQ.0)( - READ (9,'(A)',IOSTAT=IER) BUFFERI - IF (IER.EQ.0) WRITE (4,'(A,A4)')E - & BUFFER,(ADD_USER(I),I=7-ADD_WORD,6) - END DO - ELSE' - IER = 0T - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,A11,A8,A11,A8,6A4)',IOSTAT=IER) TEMP_USER, - & LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG, - & NOTIFY_FLAG= - IF (IER.EQ.0) THENS - CALL SYS$BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM)= - CALL SYS$BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,O - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,0,0,NOTIFY_FLAG - END IF= - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection% - - RETURN) - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -CE -C SUBROUTINE READDIRE -CT -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS:S -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z)I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /PROMPT/ COMMAND_PROMPTR - CHARACTER*39 COMMAND_PROMPT - - CHARACTER*2 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (2'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - END DO - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) - CALL CLEANUP_DIRFILE(1) - END IF1 - IF (NEMPTY.EQ.' ') NEMPTY = 0R -CR -C Check to see if cleanup of empty file space is necessary, which is= -C defined here as being 50 blocks (200 128byte records). Also checkU -C to see if cleanup was in progress but didn't properly finish. -CM - IF (NEMPTY.GT.200) THEN - WRITE (CFOLDER_NUMBER,'(I2)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP')$ - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IFE - END IF - ELSEI - DO WHILE (REC_LOCK(IER)) - READ(2'ICOUNT+1,1010,IOSTAT=IER)C - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCK - END DO - END IFN - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - RETURN1 - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4)F -1010 FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4)E - - END - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.1 -C If 0, write the header of the directory file. -C OUTPUTS:R -C IER - Error status from WRITE. -CF - - IMPLICIT INTEGER (A - Z)' - - INCLUDE 'BULLDIR.INC' - - IF (BULLETIN_NUM.EQ.0) THEN - WRITE (2'1,1000,IOSTAT=IER) NEWEST_EXDATE,NEWEST_EXTIME, - & NEWEST_DATE,NEWEST_TIME,_ - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTYN - ELSE - WRITE(2'BULLETIN_NUM+1,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCKL - END IFI - - RETURN - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4)L -1010 FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4) - - END diff --git a/decus/vax87a/bulletin/bulletin6.for b/decus/vax87a/bulletin/bulletin6.for deleted file mode 100644 index fb8d525..0000000 --- a/decus/vax87a/bulletin/bulletin6.for +++ /dev/null @@ -1,1034 +0,0 @@ -C -C BULLETIN6.FOR, Version 1/27/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - CHARACTER*160 OUTPUT - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - - DIMENSION SAVE_NEW_FLAG(2) - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_FILE_SHARED(4) - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,TEMP_BTIM,BBOARD_BTIM,NEW_FLAG, - & SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_FILE(4) - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS$BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,FMT=USER_FMT) TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - -C -C Set flags in all user entries that have SET READNEW on the particular -C folder to indicate that a new bulletin is present for the particular folder. -C Also send broadcast if notify flag set. -C - OUTPUT = BELL//CR//LF//LF//'New bulletin added to folder '// - & FOLDER(1:TRIM(FOLDER))//'. From: '//FROM(1:TRIM(FROM))// - & CR//LF//'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IF (.NOT.ADD_BULL) THEN - SAVE_NEW_FLAG(1) = NEW_FLAG(1) - SAVE_NEW_FLAG(2) = NEW_FLAG(2) - END IF - - F_POINT = FOLDER_NUMBER/32 + 1 - IER = 0 - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,IOSTAT=IER) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - SAVE_FLAG = NEW_FLAG(F_POINT) - IF ((IER.EQ.0).AND.(TEMP_USER.NE.FROM.OR..NOT.ADD_BULL)) THEN - IF (ADD_BULL) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR,TEMP_USER, - & %VAL(BRK$C_USERNAME),,,,,,,) - END IF - ELSE - DIFF = COMPARE_BTIM(NEWEST_BTIM,READ_BTIM) - IF (DIFF.LT.0) THEN - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - IF (TEMP_USER.EQ.USERNAME) THEN - SAVE_NEW_FLAG(F_POINT) = NEW_FLAG(F_POINT) - END IF - END IF - END IF - IF (SAVE_FLAG.NE.NEW_FLAG(F_POINT)) THEN - REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END IF - END DO - - NEW_FLAG(1) = SAVE_NEW_FLAG(1) - NEW_FLAG(2) = SAVE_NEW_FLAG(2) - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG - ! Reobtain present values as calling programs still uses them - END DO - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_FILE(4) - - RETURN - - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 TODAY_TIME - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:20) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GT.0) THEN - COMPARE_BTIM = +1 - ELSE - IF (DIFF(1).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(1).GT.0) THEN - COMPARE_BTIM = +1 - ELSE - COMPARE_BTIM = 0 - END IF - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*3600 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS$BINTIM(DATE1,USER_TIME) - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS$BINTIM(DATE2,USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*8 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:20) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = LEN(DATA) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = LEN(DATA) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,LEN) - DIMENSION IARRAY(1) - IARRAY(1) = LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable SYSPRV privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - SETPRV(1) = 0 - SETPRV(1) = IBSET(SETPRV(1),PRV$V_SYSPRV) - SETPRV(1) = IBSET(SETPRV(1),PRV$V_WORLD) - SETPRV(1) = IBSET(SETPRV(1),PRV$V_OPER) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable SYSPRV - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable SYSPRV privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable SYSPRV - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(2,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - CHARACTER*23 TODAY - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_FILE_SHARED(4) ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - DO WHILE (REC_LOCK(IER)) ! Read old entry - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS$ASCTIM(,TODAY,,) - CALL SYS$BINTIM(TODAY,LOGIN_BTIM) - CALL SYS$BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) TEMP_USER - & NEWEST_BTIM,BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - REWRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME, ! Write modified entry - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -C -C SUBROUTINE CONFIRM_PRIV -C -C FUNCTION: Confirms that given username has SETPRV. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C ALLOW - Returns 1 if account has SETPRV. -C returns 0 if account has no SETPRV. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INCLUDE '($PRVDEF)' - - PARAMETER UAF$Q_DEF_PRIV = '1A4'X - - LOGICAL*1 UAF(0:583) - EQUIVALENCE (UAF(UAF$Q_DEF_PRIV),UAF_DEF_PRIV) - - CALL OPEN_FILE_SHARED(8) - ALLOW = 0 ! Set return false - READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Record - IF (STATUS.EQ.0) THEN ! If username found - IF (BTEST(UAF_DEF_PRIV,PRV$V_SETPRV).OR. ! SETPRV or CMRKNL - & BTEST(UAF_DEF_PRIV,PRV$V_CMKRNL)) THEN ! privileges? - ALLOW = 1 ! Yep - END IF - END IF - CALL CLOSE_FILE(8) - RETURN ! Return - END ! End - - - - - - SUBROUTINE CHECK_DISMAIL(USERNAME,DISMAIL) -C -C SUBROUTINE CHECK_DISMAIL -C -C FUNCTION: Checks that given username has DISMAIL. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - PARAMETER UAF$V_DISMAIL = '7'X - PARAMETER UAF$L_FLAGS = '1D4'X - - LOGICAL*1 UAF(0:583) - EQUIVALENCE (UAF(UAF$L_FLAGS),UAF_L_FLAGS) - - CALL OPEN_FILE_SHARED(8) - DISMAIL = 0 ! Set return false - READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Record - IF (STATUS.EQ.0) THEN ! If username found - IF (BTEST(UAF_L_FLAGS,UAF$V_DISMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - CALL CLOSE_FILE(8) - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT,ACCESS) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$PROCESS',INPUT,ACCESS, - & %VAL(TRNLNM_ITMLST)) - - RETURN - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0o - LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THENg - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IFr - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -CN - END IFF - - IF (QUIT.EQ.0) CALL EXITi - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z). - - COMMON /CTRLY/ CTRLYR - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/E - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURNU - END - - - - - SUBROUTINE CLEANUP_BULLFILE -CN -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it.l -Cs - IMPLICIT INTEGER (A - Z)o - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FILENAME*132,INPUT*128 - - CALL OPEN_FILE(2) - - CALL READDIR(0,IER) - - IF (FOLDER_SET) THEN - FILENAME = FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL' - ELSEn - FILENAME = BULLETIN_FILE - END IFr - - IF (NEMPTY.GT.0) THEN - - IER = LIB$RENAME_FILE(FILENAME,FILENAME(1:TRIM(FILENAME))//';2') - ! Old file name to version number 2 - - IF (.NOT.IER) RETURN - - OPEN (UNIT=11,FILE=FILENAME(1:TRIM(FILENAME))//';1', - 1 STATUS='UNKNOWN',IOSTAT=IER, - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - ! Compressed version is number 1 - - CALL OPEN_FILE(1) ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER)N - ICOUNT = BLOCK - DO J=1,LENGTH/ - NBLOCK = NBLOCK + 1 - READ(1'ICOUNT) INPUTM - WRITE(11) INPUT - ICOUNT = ICOUNT + 1 - END DO - END DO - - CALL CLOSE_FILE(1) - CLOSE (UNIT=11) - - NEMPTY = -1 ! Copying done, but not directory updating. - CALL WRITEDIR(0,IER) - END IFe - - IER = LIB$DELETE_FILE(FILENAME(1:TRIM(FILENAME))//';2') - ! Can safely delete old file, since NEMPTY = -1F - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULLO - CALL READDIR(I,IER)1 - BLOCK = NBLOCK + 1 - CALL WRITEDIR(I,IER) - NBLOCK = NBLOCK + LENGTH - END DOD - - READ (2'1,1000,IOSTAT=IER) ! Read directory headerA - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - ! NOTE: Can't use READDIR since it'll call CLEANUP_BULLFILE_ - - NEMPTY = 0 - CALL WRITEDIR(0,IER) ! Update header to show no empty spaces - - CALL CLOSE_FILE(2)G - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4). - - RETURNT - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)L -CT -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions.A -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -CE - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL)D - CALL READDIR(I,IER)V - IF (IER.NE.I+1) THEN ! Have we found a deleted entry?L - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in fileR - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DOD - IF (MOVE_FROM.EQ.0) THEN ! There are no more entriesD - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER)N - RETURN - END IFT - LENGTH = -LENGTH ! Indicate starting point by writingn - CALL WRITEDIR(I,IER) ! next entry into deleted entryC - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletionT - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)P - BLOCK_SAVE = BLOCKE - K = J + 1 ! Search for duplicate entries - DO WHILE (MOVE_FROM.EQ.0.AND.K.LE.NBULL) - CALL READDIR(K,IER)I - IF (IER.EQ.K+1) THEN - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO=J+1 - MOVE_FROM=K+1 - ELSEO - K = K + 1 - END IFK - END IF - END DOM - J = J + 1 ! If no duplicate entry found for this - CALL READDIR(J,IER) ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1R - END DOI - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessaryB - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1b - END IFt - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - DELETE(UNIT=2,REC=J+1,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - CALL READDIR(FIRST_DELETE,IER) - LENGTH = -LENGTH ! Fix entry which has negative length= - CALL WRITEDIR(FIRST_DELETE,IER) - END IF_ - - CALL WRITEDIR(0,IER)F - - RETURNT - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show READNEW and NOTIFY flags.C -CA - IMPLICIT INTEGER (A - Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - LOGICAL SKIP,FLAG_NOTIFY,FLAG_READNEW,FLAG_BRIEFe - DATA SKIP /.FALSE./ - - ENTRY SHOW_BRIEF - IF (.NOT.SKIP) THEN - FLAG_BRIEF = .TRUE.T - FLAG_NOTIFY = .FALSE.$ - FLAG_READNEW =.FALSE.C - SKIP = .TRUE.A - END IF2 - - ENTRY SHOW_NOTIFY - IF (.NOT.SKIP) THEN - FLAG_BRIEF = .FALSE. - FLAG_NOTIFY = .TRUE. - FLAG_READNEW =.FALSE.A - SKIP = .TRUE. - END IFT - - ENTRY SHOW_READNEW - IF (.NOT.SKIP) THEN - FLAG_BRIEF = .FALSE. - FLAG_NOTIFY = .FALSE.: - FLAG_READNEW =.TRUE. - SKIP = .TRUE. - END IFd - - SKIP = .FALSE.t - -C, -C Find user entry in BULLUSER.DAT to obtain flags.i -Cr - - CALL OPEN_FILE_SHARED(4) ! Open user fileD - - DO WHILE (REC_LOCK(IER)) ! Read old entrys - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,Z - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO1 - - WRITE (6,'('' For the selected folder '',A,$)') FOLDER(1:TRIM(FOLDER)) - - IF (FLAG_READNEW) THENR - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND. - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'(''+, READNEW is set.'')') - ELSE - WRITE (6,'(''+, READNEW is not set.'')')F - END IF - ELSE IF (FLAG_NOTIFY) THENp - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'(''+, NOTIFY is set.'')') - ELSE - WRITE (6,'(''+, NOTIFY is not set.'')') - END IF - ELSE IF (FLAG_BRIEF) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THENu - WRITE (6,'(''+, BRIEF is set.'')')E - ELSE - WRITE (6,'(''+, BRIEF is not set.'')')_ - END IF - END IFM - - CALL CLOSE_FILE(4)) - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN( - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z)I - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN( - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z)A - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))- - - RETURN - END diff --git a/decus/vax87a/bulletin/bulletinv2.doc b/decus/vax87a/bulletin/bulletinv2.doc deleted file mode 100644 index 7d6e010..0000000 --- a/decus/vax87a/bulletin/bulletinv2.doc +++ /dev/null @@ -1,150 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%XX.LCS.MIT.EDU%relay.cs.net@rca.com" 2-FEB-1987 23:22 -To: TENCATI , -Subj: BULLETIN - -You are about to receive the 1/28/87 copy of the PFC BULLETIN. This software is -public domain. I will gladly accept reasonable suggestions for modifications, -and will attempt to fix bugs as quickly as possible. - -(The latest feature and bug fixes for this new version are listed later.) - -You will be receiving 11 files: - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) ALLMACS.MAR - 10) BULLCOMS.HLP - 11) BULLET.COM - (They will be indentified in the SUBJECT header.) -BULLET.COM is a command procedure which when run, will create several small -files. After you run it, you can delete it. -Read AAAREADME.TXT for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS MAIL -utility, you will have to strip off any mail headers that are present, including -blank lines. A command procedure is included at this end of this message which -can be run which uses EDT to do this for you. - -SECOND NOTE: The feature which allows setting up folders to be publicly -readable but with limited access for writing requires at least VMS VERSION 4.4, -as the code uses a new system service $CHECK_ACCESS. The code is in -BULLETIN4.FOR, and instructions are there for how to comment it out if you are -running an earlier version. This will simply cause the feature to be disabled. -Creating fully private folders will still be possible (i.e. limited access for -both reading and writing). - -I've had various problems sending files to certain sites. I've had to reduce -file sizes in order to transfer the files, and more reduction may be necessary. -BITNET sites are being sent files without any TABs, as TABs were getting -converted to 4 spaces. Please let me know of any sites which have similar -problems (or any other type, for that matter). Thank you. - Mark London - MRL%PFCVAX@XX.LCS.MIT.EDU ------------------------------------------------------------------------------- -The following are new features and bug fixes for the 1/28/87 version. Note -that when you run the new version, it will convert the user file to a new -(and smaller) format. - -New features are: - -MODIFY - Allows modification of the folder database, i.e. folder name, - description, and owner. -MOVE/ORIGINAL - Specifies that when moving a message, the original owner of the - will remain as the owner. The default is that ownership is changed to - the mover of the message. (/ORIGINAL also added to COPY command.) -QUIT - Similar to EXIT (for compatibility with other VMS utilities). -RESPOND - Prompts for input which will be sent via VMS MAIL to the owner of - the currently read message. (Similar to REPLY in MAIL, but can't - use that command since it conflicts with REPLACE). -SET BRIEF - Setting brief for a folder will cause a user to be notified upon - logging in that there are new messages in a particular folder. With - no prompting to read them (which wipes out the typeahead buffer). -SET LOGIN - Disables all notifications of messages. This is automatically - set for a BRAND NEW user if the user has the DISMAIL flag set in the - authorization file. This is a privileged command. - -Additionally, the following bugs have been fixed: - -Creating more than 32 folders would result in crashes. - -The REPLACE command would corrupt the data file line count if the text of the -last message in the folder was replaced with text that was larger than the -original. This would cause corruption of the message when another message was -added afterwards. - -The COPY command used to be able to copy a permanent message and make the new -message permanent without checking to see that the copier had privileges to -create a permanent message. - -Using the SELECT command to access a read-only folder would cause all -subsequent selections of folder to be incorrectly perceived as being read-only -also, even if they weren't. (The exception being the GENERAL folder). - -The MAIL command occasionally entered the MAIL utility, giving the user the -MAIL> prompt. - -Previously, when adding a message via the ADD command by specifying a file, -tabs were expanded, and if the 80 character limit was exceeded, the file was -rejected (i.e. the line would have wrapped around if displayed, but the actual -character count may have been less than 80). However, files sent via the -BBOARD feature did not have tab expansion included before checking line limit. -This inconsistency has been fixed and the algorithm modified. Tab expansion is -no longer done for files submitted for messages. However, when these messages -are displayed, lines which are too long will be truncated. (NOTE: This means -that a message could have appeared via BBOARD with long lines that would wrap -and be displayed incorrectly due to inconsistent line count). - -The private folder option would not work properly if the directory storing the -data files did not allow read access by the users. Users authorized to access -the folder (who did not have privileges) would still not be able to access them. -------------------------------------------------------------------------------- -$ set nover -$ edit/edt/nocommand allmacs.mar -'; Name: SETACC.MAR' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin0.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin1.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin2.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin3.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin4.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin5.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin6.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bullcoms.hlp -'1 ADD' -d 1:.-1 -exit -$ edit/edt/nocommand bullet.com -'$set nover' -d 1:.-1 -exit diff --git a/decus/vax87d/bulletin/bulletin.for b/decus/vax87d/bulletin/bulletin.for deleted file mode 100644 index 6019d2f..0000000 --- a/decus/vax87d/bulletin/bulletin.for +++ /dev/null @@ -1,1045 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU@SMTP 23-DEC-1987 15:46 -To: ARISIA::EVERHART -Subj: BULLETIN.FOR - - -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 23 Dec 87 15:04-EST -Date: 23 Dec 87 15:05:37 EST -From: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -To: EVERHART%ARISIA.DECNET@CRD.GE.COM@XX -Subject: BULLETIN.FOR - -C -C BULLETIN.FOR, Version 12/14/87 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*11 UPTIME_DATE - CHARACTER*8 UPTIME_TIME - CHARACTER*64 HELP_DIRECTORY - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT) - LEN = 1 - DO WHILE (LEN.GT.0) - LEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (LEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(LEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - -C -C Test for /LOGIN switch. -C NOTE: /READ has been replaced by the SET READNEW command. -C - - CALL LIB$GET_FOREIGN(INCMD) - - IER = CLI$DCL_PARSE('BULLETIN '//INCMD,BULLETIN_MAINCOMMANDS) - - READIT = 0 - LOGIT = 0 - IF (CLI$PRESENT('LOGIN').OR.CLI$PRESENT('SYSTEM')) LOGIT = 1 - ! Test for /LOGIN or /SYSTEM switch. - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP')) THEN ! Create bulletin control - CALL CREATE_BULLCP ! subprocess at startup - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - CALL RUN_BULLCP ! doing what BULLCP does! - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (LOGIT.GT.0) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - CALL DELETE_EXPIRED ! Delete expired messages - -C -C Get page length for the terminal. -C - - CALL GETPAGLEN(PAGE_LENGTH) - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (CLI$PRESENT('SYSTEM')) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - CALL SHOW_SYSTEM - CALL EXIT - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIT.GT.0) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - CALL NEW_MESSAGE_NOTIFICATION - ELSE - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - - MAIL_STATUS = 1 - - DO WHILE (1) - - IF (MAIL_STATUS) THEN - CALL GET_INPUT_PROMPT(INCMD,IER, - & COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - ELSE - CALL GET_INPUT_PROMPT(INCMD,IER, - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - MAIL_STATUS = 0 - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9') - IER = IER - 1 - END DO - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - - CALL CLI$GET_VALUE('$VERB',INCMD) ! Get the VERB command - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL'e - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THENe - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD bulletin command?E - CALL ADD ! Go add bulletine - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK command? - IF (BULL_POINT.LE.1) THENn - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE command?I - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY command? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE command?P - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT command? - READ_COUNT = -1 ! Reread current message from beginning.L - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE command?L - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY command? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified?P - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders0 - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folderP - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messagess - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE command? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT command? - GO TO 999 ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP command?A - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY)Y - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THENo - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':'o - HLEN = HLEN + 1h - END IF - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST command? - READ_COUNT = -1 - BULL_READ = 99999n - CALL READ(READ_COUNT,BULL_READ)M - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL command?A - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY command? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE command?1 - CALL MOVE(.TRUE.)P - ELSE IF (INCMD(:4).EQ.'NEXT') THEN ! NEXT command?T - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT command? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ command?T - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)/ - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1D - CALL READ(READ_COUNT,BULL_READ)N - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE command? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY command?E - IF (BULL_POINT.LT.1) THENL - WRITE (6,'('' ERROR: No bulletin currently read.'')')A - ELSE - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (DESCRIP(:3).NE.'RE:') THEN - WRITE (6,'(1X,A)') 'RE: '//DESCRIP - ELSE - WRITE (6,'(1X,A)') DESCRIP - END IF - CALL ADDL - END IF - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND command?S - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH command? - CALL SEARCH(READ_COUNT)! - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT command? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET command?L - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.)r - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD?r - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP')n - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP?T - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:3).EQ.'NOT') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1)S - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(1,-2,-2) - ELSEe - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:3).EQ.'NON') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1)r - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(0,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')O - END IF - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'(e - & '' ERROR: SET SHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THENu - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE IF (CLI$PRESENT('ALL')) THENM - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,1)= - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(1,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THENr - WRITE (6,'(= - & '' ERROR: SET NOSHOWNEW not allowed for GENERAL folder.'')')U - ELSE IF (CLI$PRESENT('DEFAULT')) THENM - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THENI - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSES - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')O - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE IF (CLI$PRESENT('ALL')) THENI - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,0)C - ELSE' - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')$ - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW?T - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THENl - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0)t - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')L - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF?! - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'(t - & '' ERROR: SET BRIEF not allowed for GENERAL folder.'')')r - ELSE - IF (CLI$PRESENT('DEFAULT')) THENn - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,1) - ELSEE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')) - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(1,3) - END IFR - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN. - WRITE (6,'(t - & '' ERROR: SET NOBRIEF not allowed for GENERAL folder.'')')D - ELSE - IF (CLI$PRESENT('DEFAULT')) THENF - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0)F - ELSEI - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')A - END IF - ELSEl - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS?m - CALL SET_ACCESS(.TRUE.)O - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.)N - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN?F - CALL SET_LOGIN(.FALSE.)C - ELSE IF (BULL_PARAMETER(:2).EQ.'PR') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE.F - WRITE (6,'('' PAGE has been set.'')')_ - ELSE IF (BULL_PARAMETER(:3).EQ.'NOP') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')')m - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW command?) - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGSL - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SHOW NEW?N - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - DO FOLDER_NUMBER = 0,FOLDER_MAXL - IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR.R - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER)R - IF (NBULL.GT.0) THEN - DIFF = COMPARE_BTIM( - & LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER))A - END IF - END IF - END IFD - END DO - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER)V - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES?I - CALL SHOW_PRIV - END IF - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE command?n - CALL UNDELETEE - END IF - -100 CONTINUE - - END DOm - -999 CALL EXITP - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - SUBROUTINE ADDE -CA -C SUBROUTINE ADDR -CU -C FUNCTION: Adds bulletin to bulletin file. -CA - IMPLICIT INTEGER (A - Z)e - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODEN - CHARACTER*32 NODES(10): - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITD - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULTL - DATA EDIT_DEFAULT/.FALSE./6 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'h - - INCLUDE 'BULLFOLDER.INC'C - - INCLUDE '($BRKDEF)' - - CHARACTER INEXDATE*11,INEXTIME*8/ - CHARACTER*80 INDESCRIP,INPUTR - -C6 -C The largest message that can be broadcasted is dependent on systemE -C and user quotas. The following limit is 12 lines of ( 80 characters +_ -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -CC - - PARAMETER BRDCST_LIMIT = 82*12 + 2? - CHARACTER*(BRDCST_LIMIT) BROAD, - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - - CHARACTER*80 INLINE - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - EXTERNAL CLI$_ABSENTU - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - IF (CLI$PRESENT('SELECT_FOLDER')) THENO - OLD_FOLDER_NUMBER = FOLDER_NUMBERB - CALL SELECT_FOLDER(.TRUE.,IER) - IF (.NOT.IER) GO TO 910! - END IF? - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to( - END IF ! create new file.C - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privileges/ - END IFp - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET?T - USERNAME = DEFAULT_USERG - CALL CONFIRM_PRIV(USERNAME,ALLOW)N - END IFF - - IF (FOLDER_SET.AND. ! If folder set and - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST switch present? - & CLI$PRESENT('SHUTDOWN').OR. ! Is /SHUTDOWN switch present? - & CLI$PRESENT('NODES'))) THEN ! Decnet nodes specified?( - WRITE (6,'('' ERROR: Invalid parameter used with folder set.'')') - GO TO 910O - END IFU - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges( - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abortn - END IF - SYSTEM = 1 ! Set system bit - ELSE, - SYSTEM = 0 ! Clear system bit - END IF. - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abortC - END IF - END IFT - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privileges - WRITE(ERROR_UNIT,1081) ! Tell user - GO TO 910 ! and abortL - ELSE IF (F_EXPIRE_LIMIT.GT.0.AND..NOT.ALLOW ! Expiration limit - & .AND.USERNAME.NE.FOLDER_OWNER) THEN ! is present - WRITE(ERROR_UNIT,1083)_ - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present?I - IF (.NOT.ALLOW) THEN ! If no privilegesT - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abortp - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bitH - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IF( - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER)I - IF (.NOT.IER) GO TO 910N - INEXDATE = INPUT(:11)E - INEXTIME = INPUT(13:20) - END IFT - - IF (INCMD(:3).EQ.'REP'.AND.TRIM(DESCRIP).GT.0) THEN - ! REPLY command and subject present?, - IF (DESCRIP(:4).NE.'RE: ') THEN ! Fill in subject to be_ - INDESCRIP = 'RE: '//DESCRIP ! RE: the subject of theS - END IF ! message just read. - LENDES = TRIM(INDESCRIP) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fitF - GO TO 910 - END IF - ELSEQ - LENDES = 54T - DO WHILE (LENDES.GT.53) ! Do until valid description - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input lineE - IF (LENDES.LE.0) GO TO 910R - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell userL - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - END IFp - END DO - END IF' - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.B -C_ - A - ICOUNT = 0 ! Line count for bulletin - - IF (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified' - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',N - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')N - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',F - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')A - END IF - END IFH - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) LEN,INPUT ! get record countE - IF (LEN.GT.80) GO TO 950R - ICOUNT = ICOUNT + 1 + MIN(LEN,80) - IF (LEN.EQ.0) ICOUNT = ICOUNT + 1 ! COPY_BULL writes line withG - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Sratch file to save bulletinN - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 81 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more inputS - CALL GET_LINE(INPUT,LEN) ! Get input lineA - IF (LEN.GT.80) THEN ! Input line too long. - WRITE(6,'('' ERROR: Input line length > 80. Reinput:'')') - ELSE IF (LEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + LEN ! Increment record count - IF (LEN.EQ.0) ICOUNT = ICOUNT + 1 - WRITE(3,2010) INPUT(:LEN) ! Save line in scratch file - END IF_ - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error outG -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out) - ENDIF - - REWIND (UNIT=3) - - IF (NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST'))F - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT'))I - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT'& - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1D - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodesV - INLINE = INLINE(:LEN_INLINE)Q - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolons - LEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Are semicolon found?E - IF (LEN.GT.SEMI+1) THEN ! Is username found?( - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! YesB - LEN = SEMI - 1 ! Remove semicolonsO - ELSE ! No username found...P - TEMP_USER = DEFAULT_USER ! Set user to default - LEN = SEMI - 1 ! Remove semicolons6 - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons presentN - TEMP_USER = DEFAULT_USER ! Set user to defaultO - END IFM - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0). - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10)' - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910A - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:LEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER)c - CLOSE (UNIT=10+NODE_NUM)b - IF (IER.NE.0) THENo - WRITE (6,'('' ERROR: Password is invalid.'')') - END IFw - END DOR - INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)L - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify dateL - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) LEN,INPUTR - LEN = MIN(LEN,80) - IF (IER.EQ.0) THENN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:LEN) - END IFT - END DOT - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THENF - WRITE (6,'('' Message successfully sent to node '',A)'), - & NODES(POINT_NODE)r - ELSE - WRITE (6,'('' Error while sending message to node '',A)')I - & NODES(POINT_NODE), - WRITE (6,'(A)') INPUT - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IFT - - IF (.NOT.LOCAL_NODE_FOUND) GO TO 95 ! Was local node specified? - -CE -C Add bulletin to bulletin file and directory entry for to directory file.' -CT - - CALL OPEN_FILE(2) ! Prepare to add dir entryC - - DESCRIP=INDESCRIP(:LENDES) ! Description headere - EXDATE=INEXDATE ! Expiration dateN - EXTIME=INEXTIME - LENGTH = (ICOUNT+127)/128 ! Number of recordsE - FROM = USERNAME ! Username - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0s - - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - CALL ADD_ENTRY ! Add the new directory entry - - CALL UPDATE_FOLDER ! Update info in folder file -CA -C If user is adding message, update that user's last read time forR -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)D - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)N - - CALL CLOSE_FILE(2) ! Totally finished with addD - -CT -C Broadcast the bulletin if requested.E -CR - - IF (CLI$PRESENT('BROADCAST')) THEN ! Should we broadcast the bull? - REWIND (UNIT=3) ! Yes, rewind the input file - IF (CLI$PRESENT('BELL')) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - START = 37 ! Start adding next line here0 - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROMW - START = 35 ! Start adding next line hereI - END IF - NBLANK = 0 - END = 0 - DO WHILE (ICOUNT.GT.0) ! Stuff bulletin into strings - READ(3,'(Q,A)') LEN,INPUT ! Read input lineI - ICOUNT = ICOUNT - LEN - 1 - IF (LEN.EQ.0) THENI - NBLANK = NBLANK + 1 ! Count number of blank lines - ICOUNT = ICOUNT - 1 ! ICOUNT counts blank line as one space - ELSE ! Ignore blank liness at start or end of messageE - IF (NBLANK.GT.0.AND.END.GT.0) THENT - END = START + NBLANK*2 ! Check how long string will beY - IF (END.GT.BRDCST_LIMIT) GO TO 90 ! String too long? - DO I=1,NBLANKb - BROAD(START:START+1) = CR//LFe - START = START + 2 - END DO - END IF - NBLANK = 0I - END = START + LEN - 1 + 2 ! Check how long string will bef - IF (END.GT.BRDCST_LIMIT) GO TO 90 ! String too long? - BROAD(START:END) = CR//LF//INPUT(:LEN)! Else add new input - START = END + 1 ! Reset pointer: - END IFm - END DO -90 IF (CLI$PRESENT('ALL')) THEN ! Should we broadcast to ALL?W - IF (CLI$PRESENT('CLUSTER')) THENc - CALL SYS$BRKTHRU(,BROAD(:START-1)//CR,,o - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:START-1)//CR,,. - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF( - ELSE ! Else just broadcast to users. - IF (CLI$PRESENT('CLUSTER')) THENt - CALL SYS$BRKTHRU(,BROAD(:START-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSEr - CALL SYS$BRKTHRU(,BROAD(:START-1)//CR,,N - & %VAL(BRK$C_ALLUSERS),,,,,,,)I - END IF' - END IF - END IFT - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9R - CLOSE (UNIT=I) - END DOS - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER( - CALL SELECT_FOLDER(.TRUE.,IER) - END IF( - - RETURNS - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100): - GOTO 100T - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100E - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_FILE(1)A - CALL CLOSE_FILE(2)I - CLOSE (UNIT=3)n - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - CLOSE (UNIT=3)c - GO TO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')_ -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A)i -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would bel - & truncated to:') -1070 FORMAT (' ERROR: SETPRV privileges are needed for systeml - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcaste - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanentO - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -2010 FORMAT(A) -2020 FORMAT(1X,A)9 - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER)) - - IMPLICIT INTEGER (A-Z)N - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*20 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM)F - IF (.NOT.IER) RETURNT - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN) - END diff --git a/decus/vax87d/bulletin/bulletin.txt b/decus/vax87d/bulletin/bulletin.txt deleted file mode 100644 index 1162b78..0000000 --- a/decus/vax87d/bulletin/bulletin.txt +++ /dev/null @@ -1,206 +0,0 @@ -From: HENRY::IN%"MRL%PFCVAX%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 15-JUL-1987 05:22 -To: MHG <@xx:MHG@MITRE-BEDFORD.ARPA>, -Subj: BULLETIN - -You are about to receive version 1.32 of the PFC BULLETIN. This software is -public domain. (I will gladly accept recommendations for new features, not -for changes that are due to "personal" preference.) - -(The latest feature and bug fixes for this new version are listed later.) - -You will be receiving 11 files: - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) ALLMACS.MAR - 10) BULLCOMS.HLP - 11) BULLET.COM - (They will be indentified in the SUBJECT header.) -BULLET.COM is a command procedure which when run, will create several small -files. After you run it, you can delete it. -Read AAAREADME.TXT for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS MAIL -utility, you will have to strip off any mail headers that are present, including -blank lines. A command procedure is included at this end of this message which -can be run which uses EDT to do this for you. - -SECOND NOTE: The feature which allows setting up folders to be publicly -readable but with limited access for writing requires at least VMS VERSION 4.4, -as the code uses a new system service $CHECK_ACCESS. The code is in -BULLETIN4.FOR, and instructions are there for how to comment it out if you are -running an earlier version. This will simply cause the feature to be disabled. -Creating fully private folders will still be possible (i.e. limited access for -both reading and writing). - -I've had various problems sending files to certain sites. I've had to reduce -file sizes in order to transfer the files, and more reduction may be necessary. -BITNET sites are being sent files without any TABs, as TABs were getting -converted to 4 spaces. Please let me know of any sites which have similar -problems (or any other type, for that matter). Thank you. - Mark London - MRL%PFCVAX@XX.LCS.MIT.EDU ------------------------------------------------------------------------------- -The following is a description of recent new features and bug fixes. - -V1.0 - -One is now able to increase the limit of the number folders to whatever you -want rather than the previous limit of 64. However, changing the limit -requires rebuilding the executable. - -/VMSMAIL added to use with SET BBOARD/SPECIAL to check if there is VMS MAIL -before running special command procedure. This saves time and avoids -needless subprocess creation. - -EXTRACT command added as synonym command to FILE (for compatibility). Also -/NEW qualifier added to create new file rather than appending to existing file. - -CREATE/BRIEF did not work properly. Although SHOW BRIEF would show that BRIEF -was set, in reality it was not. Note that help for these two commands were -also omitted. - -V1.1 - -Removed restriction that prevented GENERAL folder from being set to PRIVATE -or SEMIPRIVATE. - -Fixed bugs with regards to PRIVATE folders. If it had /BRIEF or /READNEW -defaults, a user without the ability to access that folder would get access -violation when logging in. Also, if /NOTIFY was a default, the user would get -notified. These have been fixed. Also, a bug which caused a crash when -attempting to MOVE a message to a PRIVATE folder has been fixed. - -Access to private folders besides being allowed via SET ACCESS commands, -is now allowed based on process privileges. Previously, access was allowed -based on the UAF authorized privileges rather than process privileges. - -Made MODIFY/OWNER a privileged command. Also, modifying ownership of a private -bulletin has been corrected. Previously, it did not change access correctly. -It now removes access from the old user and adds access to the new user. - -Allow the CREATE command to become privileged command via change in BULLCOM.CLD. - -Add /FOLDER qualifier to ADD command. - -Modified algorithm which deleted non-existant users from user data file when -new user logged in. For large databases, this was taking a long time, and -in fact was not very useful. - -Add /EDIT qualifier to BULLETIN command, similar to MAIL/EDIT, to cause /EDIT -to be the default for ADD & REPLACE commands. - -EX command is equal to EXIT, and is not flagged as being ambiguous (due to -conflict with EXTRACT command added in V1.0). - -Fixed bug which caused incorrect notification of new messages in folders. -Situation occurred if new message expired after user logged in. BULLETIN -would notify user that new message existed, and would place user at a -message that the user had already read. - -In login display, add line of minus signs to separate SYSTEM messages. -(This can be disabled if desired by modifying BULLMAIN.CLD). - -Fixed (?) bugs which prevented proper file conversion from older versions of -BULLETIN (circa 1985). - -V1.2 - -Added SHOW NEW command to show folders with unread new messages. This is -useful if you enter BULLETIN and are notified that there are new messages -in certain folder, and later in the session which to show which folders -still have unread messages. - -CREATE/BRIEF should have been a privileged command, but was not. It is -now privileged. - -The /ALL qualifier has been added to the SET BRIEF/NOTIFY/READNEW command. -It will modify the option for the selected option for all users. This is -in contrast to /DEFAULT, which would only modify the default for new users. -This is a privileged command. - -When reading messages, the name of the folder is displayed on the top line -at the upper right hand corner (similar to MAIL). - -V1.3 - -Fixed bug introduced in V1.1 that would put wrong subject in MOVED message. - -/EDIT feature now correctly recognizes MAIL$EDIT definitions of CALLABLE_EDT -and CALLABLE_TPU. - -Messages sent via BBOARD that have lines containing greater than 80 characters -are now broken into separate lines rather than truncated. - -V1.31 - -SEARCH did not work as advertised. It would start the search at the currently -read message rather than at the beginning of the folder. This has been fixed. -Additionally, a /START qualifier has been added to the command. - -V1.32 - -The change in V1.3 to wrap lines rather than truncate them in BBOARD had a bug -which could occasionally add messages with lines > 80 characters, which cannot -be read by BULLETIN. This has been fixed. - -The change in V1.3 which allowed /EDIT to use the CALLABLE feature to call -editors directly broke the ability to use command procedures to call editors. -This has been fixed. - -When there were new messages in the general folder, SHOW NEW would always show -new messages in that folder. This has been fixed. - -A "SEARCH" can now be stopped by typing a CTRL-C. Previously it could not be -stopped until it found a match or read the last message in the folder. -------------------------------------------------------------------------------- -$ set nover -$ edit/edt/nocommand allmacs.mar -'; Name: SETACC.MAR' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin0.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin1.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin2.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin3.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin4.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin5.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin6.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bullcoms.hlp -'1 ADD' -d 1:.-1 -exit -$ edit/edt/nocommand bullet.com -'$set nover' -d 1:.-1 -exit diff --git a/decus/vax87d/bulletin/bulletin0.for b/decus/vax87d/bulletin/bulletin0.for deleted file mode 100644 index 1c4d208..0000000 --- a/decus/vax87d/bulletin/bulletin0.for +++ /dev/null @@ -1,1136 +0,0 @@ -From: HENRY::IN%"MRL%PFC-VAX.MIT.EDU%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 29-OCT-1987 03:53 -To: "EVERHART%ARISIA%RCA.COM" , -Subj: BULLETIN0.FOR - -C -C BULLETIN0.FOR, Version 10/30/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53,INPUT*20 - - INTEGER EXBTIM(2),NOW(2) - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER) - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL OPEN_FILE(2) - BULL_DELETE = 0 - IER = 1 - DO WHILE (BULL_DELETE+1.EQ.IER) - BULL_DELETE = BULL_DELETE + 1 - CALL READDIR(BULL_DELETE,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (BULL_DELETE+1.EQ.IER.AND.REMOTE_USER.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - GO TO 50 - END IF - END DO - CALL CLOSE_FILE(2) ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_FILE(2) - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(ERROR_UNIT,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(ERROR_UNIT,1040) ! Then error out. - GO TO 100 - ELSE - CALL CLOSE_FILE (2) - IF (.NOT.DECNET_PROC) THEN - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') GO TO 900 - END IF - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(ERROR_UNIT,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - -50 IF (CLI$PRESENT('IMMEDIATE')) THEN ! Delete it immediately - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - CALL CLEANUP_DIRFILE(BULL_DELETE) ! Reorder directory file - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - CALL READDIR(0,IER) ! Get shutdown count - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (BULL_DELETE.LE.BULL_POINT) BULL_POINT = BULL_POINT - 1 - ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EXBTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EXBTIM,EXBTIM) - IER = SYS$ASCTIM(,INPUT,EXBTIM,) - - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:20) - - CALL WRITEDIR(0,IER) - END IF - -100 CALL CLOSE_FILE(2) - IF (DECNET_PROC) WRITE (5,'(''END'')') - ! Tell DECNET that delete went ok. -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH, PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT - - CHARACTER START_PARAMETER*16,DATETIME*23,TODAY*11 - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_COM) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_FILE_SHARED(2) ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1) THEN ! If so, there are messages - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified? - IER = CLI$GET_VALUE('START',START_PARAMETER,LEN) - DECODE(LEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEN - DIR_COUNT = NBULL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_FILE(2) - DIR_COUNT = 0 - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$ASCTIM(,TODAY,,) ! Need to get date. - DATETIME = TODAY//' 00:00:00.0' - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - CALL CLOSE_FILE(2) - RETURN - ELSEM - CALL SYS$ASCTIM - & (,DATETIME,LAST_READ_BTIM(1,FOLDER_NUMBER+1),)1 - END IFo - END IF% - TEMP_COUNT = 0E - IER = 1 - DO WHILE (IER.EQ.TEMP_COUNT+1)u - TEMP_COUNT = TEMP_COUNT + 1 - CALL READDIR(TEMP_COUNT,IER)o - IF (IER.NE.TEMP_COUNT+1) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_FILE(2)M - RETURN - ELSET - DIFF = COMPARE_DATE(DATETIME(1:11),DATE)T - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME)I - IF (DIFF.LT.0) THEN - DIR_COUNT = TEMP_COUNTC - IER = IER + 1 - END IFN - END IFR - END DOR - ELSEM - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IFA - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1' - IF (EBULL.GE.NBULL-2) EBULL = NBULLC - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-4) THEN - EBULL = NBULL* - SBULL = NBULL - (PAGE_LENGTH-4) + 1W - IF (SBULL.LT.1) SBULL = 1E - ELSEs - SBULL = DIR_COUNTA - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1T - END IFs - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 6) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THEN - EBULL = NBULL - END IF - DO I=SBULL,EBULL ! Copy messages from file - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - END DO - ELSEE - NBULL = 0 - END IF - - CALL CLOSE_FILE(2) ! We don't need file anymore - - IF (NBULL.EQ.0) THEN - WRITE (6,'('' There are no messages present.'')')o - RETURN - END IFR - -CN -C Directory entries are now in queue. Output queue entries to screen. -Cb - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - WRITE(6,1000) ! Write header - DO I=SBULL,EBULLT - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,2010) I,DESCRIP(:52),FROM,'(DELETED)' - ELSE - WRITE(6,2010) I,DESCRIP(:52),FROM,DATE(1:7)//DATE(10:11) - END IF - END DOh - - DIR_COUNT = EBULL + 1 ! Update directory counter. - - IF (DIR_COUNT.GT.NBULL) THEN ! Outputted all entries?s - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are moreL - END IF( - - RETURN, - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/)_ - -2010 FORMAT(1X,I4,1X,A52,1X,A12,1X,A9) - - END - E - - SUBROUTINE FILE -C. -C SUBROUTINE FILE -Cn -C FUNCTION: Copies a bulletin to a file. -CP - IMPLICIT INTEGER (A - Z)E - - CHARACTER INPUT*80o - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENTe - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)_ - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And return, - END IFR - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,1010) ! Write error - RETURN ! And returnN - END IF - - CALL OPEN_FILE_SHARED(2)T - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinL - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030)n - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IFD - - CALL CLOSE_FILE(2)h - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900,b - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSEc - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900,o - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IFu - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATEs - END IF - - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0)a - CALL GET_BULL(I,INPUT,LEN)a - IF (LEN.LT.0) THENl - GO TO 90s - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IFl - END DO - LEN = 80 - END DOm - -90 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_POINT,BULL_PARAMETER(1:LEN_P) - ! Show name of file created.D -100 CALL CLOSE_FILE(1) - RETURN - -900 WRITE(6,1000)I - CALL ENABLE_PRIVS ! Reset BYPASS privileges= - GO TO 100 - -1000 FORMAT(' ERROR: Error in opening file.')E -1010 FORMAT(' ERROR: You have not read any bulletin.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/)S - - END - - - - - SUBROUTINE LOGINA -CR -C SUBROUTINE LOGINr -C -C FUNCTION: Alerts user of new messages upon logging in. -Ce - IMPLICIT INTEGER (A - Z)( - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'A - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING0 - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT( - CHARACTER*39 COMMAND_PROMPT - - CHARACTER TODAY*23,INPUT*80,INREAD*1( - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list headers - DATA SYS_BUL1/0/ ! System bulletin link list header - - DATA PAGE/0/t - - DATA FIRST_WRITE/.TRUE./T - LOGICAL FIRST_WRITE - - DIMENSION H_NEW_FLAG(FLONG),H_SET_FLAG(FLONG),H_BRIEF_FLAG(FLONG) - DIMENSION NOLOGIN_BTIM(2),LOGIN_BTIM_SAVE(2),TODAY_BTIM(2)L - DIMENSION DIR_BTIM(2),NEW_BTIM(2) - - CHARACTER*1 SEPARATEI - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956',NOLOGIN_BTIM)N - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -CT -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -Cu - - CALL OPEN_FILE_SHARED(4) ! Open user file - - DO WHILE (REC_LOCK(IER))n - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) TEMP_USER,, - & NEWEST_BTIM,BBOARD_BTIM,H_NEW_FLAG,H_SET_FLAG,e - & H_BRIEF_FLAG,NOTIFY_FLAG ! Get the header - END DO - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - DO WHILE (REC_LOCK(IER1))e - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER1) USERNAME,t - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,O - & BRIEF_FLAG,NOTIFY_FLAG ! Find if there is an entryr - END DO - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).EQ.0) RETURN ! DISMAIL setA - IF (IER1.EQ.0) THEN ! There is a user entry_ - REWRITE (4,FMT=USER_FMT) USERNAME,TODAY_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG ! Update login date - & ,NOTIFY_FLAG - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DOU - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead usersW - READ_BTIM(1) = NEW_BTIM(1) ! Make new entryI - READ_BTIM(2) = NEW_BTIM(2)V - DO I = 1,FLONG - SET_FLAG(I) = H_SET_FLAG(I) - BRIEF_FLAG(I) = H_BRIEF_FLAG(I)S - END DOY - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_DISMAIL(USERNAME,DISMAIL)$ - IF (DISMAIL.EQ.1) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,NOLOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - ELSE - WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,TODAY_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 11 - END DO - END IFT - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_FILE(4) ! Close the user file - CALL EXIT ! Go away...E - END IFs - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - END IF - DO WHILE (REC_LOCK(IER2))Q - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER2) TEMP_USER,0 - & NEWEST_BTIM,BBOARD_BTIM,H_NEW_FLAG,H_SET_FLAG, - & H_BRIEF_FLAG,NOTIFY_FLAG ! Reset read back to headerN - END DO - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail?U - REWRITE (4,FMT=USER_FMT) TEMP_USER,NEWEST_BTIM, ! Rewrite header - & TODAY_BTIM,H_NEW_FLAG,H_SET_FLAG,H_BRIEF_FLAG,NOTIFY_FLAG- - CALL CLOSE_FILE(4) - IF (.NOT.TEST_BULLCP()) CALL CREATE_BBOARD_PROCESS - ELSE - CALL CLOSE_FILE(4) - IF (IER.NE.0) CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility.E -CL - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compare - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user.S - - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IFT - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)e - w - IF (NEW_FLAG(2).NE.0) THENi - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1L - RETURN - END IF, - -CI -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible.D -C( - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.FOLDER_SET) THEN! - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IF - - ENTRY SHOW_SYSTEM - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages( - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) RETURN' - ! Don't overwhelm new user with lots of non-general msgs - - CALL OPEN_FILE_SHARED(2) ! Get bulletin directory - CALL READDIR(0,IER) ! Get header infoE - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_COM) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_COM) - GEN_DIR = GEN_DIR18 - SYS_DIR = SYS_DIR1 - START = 1 - REVERSE = 0 - IF (CLI$PRESENT('REVERSE').AND. - & (.NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THENE - REVERSE = 1T - START = NBULL + 1E - IER = START + 1T - DIFF = 0 - IF (IER1.NE.0) THEN - START = 1 - ELSE - DO WHILE (START+1.EQ.IER.AND.DIFF.LE.0) - START = START - 1 - IF (START.GT.0) CALL READDIR(START,IER) - IF (START+1.EQ.IER) THENd - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - END IFi - END DO - START = START + 1W - END IF - END IF - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THENh - ICOUNT = NBULL + START - ICOUNT1L - ELSE - ICOUNT = ICOUNT1_ - END IF - CALL READDIR(ICOUNT,IER) - IF (IER1.EQ.0) THEN ! Is this a totally new user? - ! No. Is bulletin system or from same user? - IF (.NOT.REVERSE) THEN - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IFA - IF (USERNAME.NE.FROM.OR.SYSTEM) THENN - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1P - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM)R - ELSE IF (.NOT.CLI$PRESENT('SYSTEM')) THENI - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1E - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM): - END IF - END IF - ELSE ! Totally new user, save only Permanent system msgso - IF (SYSTEM.EQ.3) THEN - NSYS = NSYS + 1N - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM) - ELSE IF (NGEN.EQ.0) THEN ! And save only the first non-system msg - SYSTEM = ICOUNT ! Save bulletin number for displayr - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THENh - BULL_POINT = ICOUNT - 10 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF0 - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - END IFF - END IF - END DOA -100 CALL CLOSE_FILE(2) - IF (FOLDER_SET) NSYS = 0S -CO -C Review new directory entries. If there are system messages,o -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -CL - IF (NGEN.EQ.0.AND.NSYS.EQ.0) RETURN - - IF (NSYS.GT.0) THEN ! Are there any system messages? - CALL CLI$GET_VALUE('SEPARATE',SEPARATE)T - IF (FIRST_WRITE) THEND - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesD - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,1026) CTRL_G ! Yep... - PAGE = PAGE + 1d - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_FILE_SHARED(1) - CALL INIT_QUEUE(SYS_BUL1,INPUT)U - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - DO J=1,NSYSF - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM)L - INPUT = ' 'A - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - LEN = 81I - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin to SYS_BUL link listM - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - CALL CLOSE_FILE(1)I - RETURN - ELSE IF (LEN.GT.0) THENp - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - END IF - END DOL - LEN = 80H - END DO - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)O - DO I=1,80 - INPUT(I:I) = SEPARATEH - END DO, - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - END IF - END DO - CALL CLOSE_FILE(1) - SYS_BUL = SYS_BUL1 - DO WHILE (SYS_BUL.NE.0) ! Write out the system messages - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)A - IF (SYS_BUL.NE.0) THENE - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THENr - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....')( - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenI - PAGE = 1 - WRITE(6,1060) '+'//INPUT(1:TRIM(INPUT)) - ELSEE - PAGE = PAGE + 1A - WRITE(6,1060) ' '//INPUT(1:TRIM(INPUT))G - END IFR - END IFt - END DO - IF (NGEN.EQ.0) THENL - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1L - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1W - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER)M - S1 = (80-13-LENF)/2N - S2 = 80-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next pageA - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....')U - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages',CTRL_G - PAGE = 1F - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesN - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages',CTRL_G - PAGE = PAGE + 1 - END IF - WRITE(6,1020)r - WRITE(6,1025)I - PAGE = PAGE + 2e - I = 0C - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screenE - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, - & 'HIT Q(Quit listing) or any other key for next page....')_ - CALL STR$UPCASE(INREAD,INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1M - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')')M - ELSEi - WRITE(6,1040) '+'//DESCRIP,FROM,DATE(:6),SYSTEMB - END IFO - ! Bulletin number is stored in SYSTEM - ELSEL - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP,FROM,DATE(:6),SYSTEM - END IFL - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0)t - & .OR.(FOLDER_SET.AND.TEST2(SET_FLAG,FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IFT - IF (COMPARE_BTIM(READ_BTIM,NEW_BTIM).NE.0) THEN - WRITE(6,1030)s - ELSE IF (NGEN.EQ.0) THENL - LEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (80-LEN)/2 - S2 = 80 - S1 - LEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:LEN-57)//F - & '/SYSTEM command can be used to reread these messages.'G - ELSE, - LEN = 48 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (80-LEN)/2s - S2 = 80 - S1 - LEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:LEN-48)// - & ' command can be used to read these messages.') - END IFL - - RETURN) - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',33('*'),'System Messages',32('*'),A1)B -1027 FORMAT(/,' ',('*'),A,('*'),A1)N -1028 FORMAT('+',('*'),A,('*'),A1)c -1030 FORMAT(' ',80('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A54,1X,A12,1X,A6,1X,I4)E -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.')_ -1080 FORMAT(' ',/) - - END - - - SUBROUTINE GET_NODE_INFO -Cu -C SUBROUTINE GET_NODE_INFOY -C -C FUNCTION: Gets local node name and obtains node names from. -C command line.U -CR - - IMPLICIT INTEGER (A-Z)v - - EXTERNAL CLI$_ABSENTs - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE( - CHARACTER*32 NODES(10)E - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256 - - NODE_ERROR = .FALSE.S - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THENA - LOCAL_NODE = LOCAL_NODE(2:)E - L_NODE = L_NODE - 1L - END IF - - NODE_NUM = 0 ! Initialize number of nodes. - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - LEN = 0 ! GET_VALUE crashes if LEN<0T - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN1 - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1)B - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF. - NLEN = TRIM(NODES(NODE_NUM)) - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - NLEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addeddR - END IF - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:NLEN)) THEN - NODE_NUM = NODE_NUM - 10 - LOCAL_NODE_FOUND = .TRUE.M - ELSES - POINT_NODE = NODE_NUME - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:NLEN)//'""::' - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED',$ - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER)T - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM)E - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IFM - END DO - END DO - ELSEE - LOCAL_NODE_FOUND = .TRUE.C - END IF - - RETURNF - END - - - SUBROUTINE DELETE_NODEl -Ce -C SUBROUTINE DELETE_NODE -Ct -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10). - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940U - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IFF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER)E - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP)o - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Is semicolon present? - IF (NLEN.GT.SEMI+1) THEN ! Yes, is username after node?T - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - NLEN = SEMI - 1 ! Remove semicoloni - ELSE ! No username after nodename - TEMP_USER = DEFAULT_USER ! Set username to defaultd - NLEN = SEMI - 1 ! Remove semicolont - SEMI = 0 ! Indicate no username - END IF_ - ELSE ! No semicolon present - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username wasY - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10)T - CALL GET_INPUT_NOECHO(PASSWORD)L - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:NLEN) - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '//E - & PASSWORD(1:TRIM(PASSWORD))//'"::',, - & TYPE='SCRATCH',IOSTAT=IER)D - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO. - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINEE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN_ - WRITE (6,'('' Message successfully deleted from node '',A)')( - & NODES(POINT_NODE)o - ELSE - WRITE (6,'('' Error while deleting message to node '',A)')i - & NODES(POINT_NODE)o - WRITE (6,'(A)') INLINE - END IF - END DO1 - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1D - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.')W -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG. -C0 -C FUNCTION: Sets or clears specified flag for folder= -CI - IMPLICIT INTEGER (A-Z)1 - - INCLUDE 'BULLFOLDER.INC'- - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FLAGNAME - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_FILE(7) ! Open folder filel - - READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER)L - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT - - IF (SETTING) THENO - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - REWRITE (7,FMT=FOLDER_FMT,IOSTAT=IER)R - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMITE - - CALL CLOSE_FILE(7) - - WRITE (6,'(1X,A,'' has been modified for folder.'')')E - & FLAGNAME - ELSE - WRITE (6,'(1X,A,'' You are not authorized to modify.'')')L - & FLAGNAME - END IFN - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C_ -C SUBROUTINE SET_FOLDER_EXPIRE_LIMITA -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'l - - INCLUDE 'BULLFILES.INC' - - IF (LIMIT.LT.0) THEN. - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THENM - CALL OPEN_FILE(7) ! Open folder fileE - - READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMITc - - F_EXPIRE_LIMIT = LIMIT - - REWRITE (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT - - CALL CLOSE_FILE(7) - WRITE (6,'('' Folder expiration date modified.'')') - ELSEM - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF+ - - RETURNA - END diff --git a/decus/vax87d/bulletin/bulletin1.for b/decus/vax87d/bulletin/bulletin1.for deleted file mode 100644 index 0a75e8f..0000000 --- a/decus/vax87d/bulletin/bulletin1.for +++ /dev/null @@ -1,1235 +0,0 @@ -From: HENRY::IN%"MRL%PFC-VAX.MIT.EDU%xx.lcs.mit.edu%zermatt.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 13-DEC-1987 08:49 -To: MHG , -Subj: BULLETIN1.FOR - -C -C BULLETIN1.FOR, Version 11/24/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - LEN_I = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN_I.GT.0) - CALL GET_BULL(I,INPUT,LEN_I) - IF (LEN_I.LT.0) THEN - GO TO 90 - ELSE IF (LEN_I.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN_I) - END IF - END DO - LEN_I = 80 - END DO - -90 CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_FILE(1) - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - IF (MAIL_SUBJECT(1:1).NE.'"') THEN - MAIL_SUBJECT = '"'//MAIL_SUBJECT(1:LEN_D) - LEN_D = LEN_D + 1 - END IF - - IF (MAIL_SUBJECT(LEN_D:LEN_D).NE.'"') THEN - MAIL_SUBJECT = MAIL_SUBJECT(1:LEN_D)//'"' - LEN_D = LEN_D + 1 - END IF - - IER = CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER,LEN_P) - - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(1:LEN_P) - & //'/SUBJECT='//MAIL_SUBJECT(1:LEN_D),,,,,,STATUS) - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(1:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder owner.'')') - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(1:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_FILE(7) ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - END IF - - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=FOLDER,KEYID=0) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT - - IF (IER.EQ.0) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_FILE(7) - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - LOGICAL DELETE_ORIGINAL - - CHARACTER INPUT*80,SAVE_USERNAME*12 - - CHARACTER*116 BULLDIR_COM_SAVE - - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_FILE(2) - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - - CALL LIB$MOVC3(116,%REF(BULLDIR_COM),%REF(BULLDIR_COM_SAVE)) - SAVE_BULL_POINT = BULL_POINT - - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Scratch file to save bulletin - - CALL OPEN_FILE_SHARED(1) - - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 90 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IF - END DO - LEN = 80 - END DO - -90 REWIND (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - SAVE_USERNAME = USERNAME - IF (CLI$PRESENT('ORIGINAL')) THEN - IF (SETPRV_PRIV()) THENU - USERNAME = FROM - ELSE - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - END IF - END IF> - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER.OR.READ_ONLY) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - CLOSE (UNIT=3) - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - USERNAME = SAVE_USERNAME - RETURN - END IF - -Ct -C Add bulletin to bulletin file and directory entry for to directory file. -CC - - CALL OPEN_FILE(2) ! Prepare to add dir entryP - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCKU - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0. - - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE(6,'('' ERROR: Message copy aborted.'')') - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CLOSE (UNIT=3) - END IF, - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - CALL LIB$MOVC3(116,%REF(BULLDIR_COM_SAVE),%REF(BULLDIR_COM))a - - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - IF (BTEST(SYSTEM,2)) THEN ! Shutdown message?U - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bitI - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)o - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND. - & .NOT.SETPRV_PRIV()) THEN ! Permanent? - WRITE (6,'('' ERROR: No privileges to add permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') FOLDER_BBEXPIRE - END IFL - - FROM = USERNAME ! Specify ownerR - CALL ADD_ENTRY ! Add the new directory entry - - CALL UPDATE_FOLDER ! Update folder info -CR -C If user is adding message, update that user's last read time for1 -C folder, so user is not alerted of new message which is owned by user. -CI - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)9 - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)3 - - CALL CLOSE_FILE(2) ! Totally finished with add - - CLOSE (UNIT=3) ! Close the input file - - WRITE (6,'('' Message has been copied to folder '',A)') - & FOLDER(1:TRIM(FOLDER))//'.'. - - USERNAME = SAVE_USERNAME' - - FOLDER_NUMBER = SAVE_FOLDER_NUMBERI - CALL SELECT_FOLDER(.FALSE.,IER) - - BULL_POINT = SAVE_BULL_POINTA - - IF (DELETE_ORIGINAL) CALL DELETED - - RETURN_ - - END - - - - - SUBROUTINE PRINTI -CU -C SUBROUTINE PRINT. -C) -C FUNCTION: Print header to queue. -C: - - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($SJCDEF)' - - CHARACTER*32 QUEUEI - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*80 INPUT_ - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been readR - WRITE(6,1010) ! Write error - RETURN ! And returnO - END IFI - - CALL OPEN_FILE_SHARED(2)M - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030)C - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IFE - - CALL CLOSE_FILE(2)S - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE - END IFR - - LEN =81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0)T - CALL GET_BULL(I,INPUT,LEN)i - IF (LEN.GT.0) WRITE(3,'(A)') INPUT(1:TRIM(INPUT)) - END DO - LEN = 80 - END DOE - - CLOSE (UNIT=3) ! Bulletin copy completedI - - CALL CLOSE_FILE(1) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS'))T - - IER = CLI$GET_VALUE('QUEUE',QUEUE,LEN) ! Get queue name - IF (LEN.EQ.0) THEND - QUEUE = 'SYS$PRINT'C - LEN = 9! - END IF - - CALL ADD_2_ITMLST(LEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IFL - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - , - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THENL - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IFD - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURN - -900 CALL ERRSNS(IDUMMY,IER)R - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_FILE(1) - WRITE(6,1000) - CALL SYS_GETMSG(IER)F - - RETURN= - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.')E -1010 FORMAT(' ERROR: You have not read any message.')U -1030 FORMAT(' ERROR: Specified message was not found.')E -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT('Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/)F - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -CT -C SUBROUTINE READ -C -C FUNCTION: Reads a specified bulletin. -CE -C PARAMETER:_ -C READ_COUNT - Variable to store the record in the message file) -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z)O - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'P - - INCLUDE 'BULLUSER.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUTO - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGING, - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DATA SCRATCH_B1/0/F - - DIMENSION MSG_BTIM(2) - - CHARACTER TODAY*11,DATETIME*23s - - LOGICAL SINCE,PAGEE - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen' - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this isO - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - s - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(1:4).EQ.'READ') THEN ! If READ command...U - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified?N - IER = CLI$GET_VALUE('SINCE',DATETIME). - IF (DATETIME.EQ.'TODAY') THEN - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - DATETIME = TODAY//' 00:00:00.0' - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified?B - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - RETURN - ELSE - CALL SYS$ASCTIM - & (,DATETIME,LAST_READ_BTIM(1,FOLDER_NUMBER+1),) - END IF - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - CALL OPEN_FILE_SHARED(2) - TEMP_READ = 0 - IER = 1O - DO WHILE (IER.EQ.TEMP_READ+1)D - TEMP_READ = TEMP_READ + 1 - CALL READDIR(TEMP_READ,IER) - IF (IER.NE.TEMP_READ+1) THEN - WRITE (6,'('' No messages found past specified date.'')') - CALL CLOSE_FILE(2)D - RETURNN - ELSE= - DIFF = COMPARE_DATE(DATETIME(1:11),DATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME) - IF (DIFF.LT.0) THENT - BULL_READ = TEMP_READ' - IER = IER + 1 - END IF - END IF - END DO - IER = BULL_READ + 1I - SINCE = .TRUE. - CALL CLOSE_FILE(2) - END IF - END IFV - - IF (.NOT.SINCE) THENN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entryN - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THENY - READ_COUNT = 0o - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN_ - BULL_READ = NBULLe - CALL READDIR(BULL_READ,IER)E - ELSEL - IER = 0 - END IFR - END IF - CALL CLOSE_FILE(2) - ELSE - IER = 0s - END IF - END IF' - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IF - - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1)L - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2)C - END IFI - - BULL_POINT = BULL_READ ! Update bulletin counter1 - - FLEN = TRIM(FOLDER) - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header info( - WRITE(6,1050) DESCRIP - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,1060) FROM,DATE,'(DELETED)'S - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?B - WRITE(6,1060) FROM,DATE,'Expires on shutdown'B - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - WRITE(6,1060) FROM,DATE,'Permanent'E - ELSE - WRITE(6,1060) FROM,DATE,'Expires: '//EXDATE//' '//EXTIME - END IFS - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - WRITE(6,'(''+ / System'',/)') - ELSEn - WRITE(6,'(''+'',/)') - END IFi -Ce -C Each page of the bulletin is buffered into temporary memory storage beforea -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memoryd -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue._ -CD - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?C - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headN - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer. - END IFE - - END = 4 ! Outputted 4 lines to screen - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSEB - READ_COUNT = BLOCK ! Init bulletin record counter - END IFP - -100 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to headerU - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - IF (READ_COUNT.GT.BLOCK.AND.READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header info - END = END + 1 ! Increase display counter - END IFO - CALL OPEN_FILE_SHARED(1) ! Get bulletin file - MORE_LINES = .TRUE. - READ_REC = READ_COUNT - IF (READ_ALREADY.EQ.0) LEN = 81 - DO WHILE (MORE_LINES.AND.READ_REC.LE.BLOCK+LENGTH-1)C - DO WHILE (LEN.GT.0.AND.MORE_LINES) - CALL GET_BULL(READ_REC,INPUT,LEN) - IF (LEN.LT.0) THEN ! Error, couldn't read record - READ_REC = BLOCK + LENGTH ! Fake end of reading filer - MORE_LINES = .FALSE.S - ELSE IF (LEN.GT.0) THEN - LEN_TEMP = LEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)' - READ_ALREADY = 1 - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IFl - END IFo - END DO - LEN = 80 - IF (MORE_LINES) THEN - READ_REC = READ_REC + 1 - READ_ALREADY = 0 - END IF - END DOT - - CALL CLOSE_FILE(1) ! End of bulletin file readG - -CW -C Bulletin page is now in temporary memory, so output to terminal.E -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at theV -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -CO - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) ! Get queue recordo - IF (I.EQ.1.AND.READ_REC.NE.BLOCK.AND.READIT.GT.0) THEN - WRITE(6,2020) INPUT(1:TRIM(INPUT)) ! (See above comments) - ELSE - WRITE(6,2010) INPUT(1:TRIM(INPUT)) - END IF - END DOR - - READ_COUNT = READ_REC ! Update bull record counterE - - IF (READ_REC.EQ.BLOCK+LENGTH) THEN ! Last block? - READ_COUNT = 0 ! init bulletin record counterD - ELSE IF (READ_REC.EQ.BLOCK+LENGTH-1.AND..NOT.MORE_LINES) THEN - ! Possibly last block since end of page could be last line - CALL TEST_MORE_LINES(LEN) ! More lines to read? - IF (LEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Else if this is not /READ - WRITE(6,1070) ! say there is more of bulletinD - END IFn - - RETURN0 - -1030 FORMAT(' ERROR: Specified message was not found.')S -1040 FORMAT('+Message number: ',I4,<60-FLEN>X,A) -1050 FORMAT(' Description: ',A53)a -1060 FORMAT(' From: ',A12,' Date: ',A11,' ',A,$) -1070 FORMAT(1X,/,' Press RETURN for more...',/)e - -2000 FORMAT(A) -2010 FORMAT(1X,A) -2020 FORMAT('+',A) - - END - - - - - - SUBROUTINE READNEW(REDO) -Cs -C SUBROUTINE READNEWi -Cs -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -Cd - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'' - - COMMON /POINT/ BULL_POINT - - CHARACTER INREAD*1,INPUT*80,FILE_DEF*80,NUMREAD*5 - - DATA LEN_FILE_DEF /0/, INREAD/0/R - - LOGICAL SLOW,SLOW_TERMINAL/ - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first timeD - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is$ - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletinsA - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get inputs - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case. - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN. - INREAD = NUMREAD(1:1)c - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THENF - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THENF - WRITE (6,'(''+xit'',$)') - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF: - RETURN ! If NO, exitI - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1)_ - END IF - END IF - - IF (TEMP_READ.GT.0) THEN( - IF (TEMP_READ.LT.BULL_POINT+1.OR.TEMP_READ.GT.NBULL) THENe - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IFS - - READ_COUNT = 0 ! Initialize display pointerO - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletinW - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed?P - CALL OPEN_FILE_SHARED(2) ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND.(SYSTEM)) THEN - BULL_POINT = BULL_POINT + 1 ! If system bulletin, skip it.a - GO TO 10F - END IF - CALL CLOSE_FILE(2) - END IF2 - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSEI - WRITE(6,1030) - END IFL - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper caseE - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)')A - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay direcotyr - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE.Y - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to fileT - WRITE (6,'(''+ '')') ! Move cursor from end of prompt lineE - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THENA - CALL LIB$SYS_TRNLOG('SYS$LOGIN',LEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:LEN-1)//'.BULL]' - LEN_FILE_DEF = LEN + 5 - ELSEM - FILE_DEF = 'SYS$LOGIN:'U - LEN_FILE_DEF = 10N - END IF_ - END IF - - LEN_FOLDER = TRIM(FOLDER)A - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,E - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS'X - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_FILE_SHARED(2) - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRVe - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),IOSTAT=IER,ERR=18, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATEg - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 18l - ELSE IF (LEN.GT.0) THEN - WRITE(3,'(A)') INPUT(1:TRIM(INPUT)) - END IFw - END DO - LEN = 80d - END DO - WRITE(6,1040) BULL_PARAMETER(1:LEN_P)t - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)e - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THENR - ! If NEXT and last bulletins not finisheds - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_FILE_SHARED(2) ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletinN - CALL CLOSE_FILE(2) ! Exito - WRITE(6,1010) - RETURNN - ELSE IF (SYSTEM) THEN ! Else if NEXT bulletin SYSTEM - BULL_POINT = BULL_POINT + 1 ! Skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_FILE(2) - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THENE - WRITE(6,1010)E - RETURN - END IFR - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),messageI - & number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,80('-'),/,' Type Q(Quit), - & F(File it), D(Dir) or any other key for next message: ',$) -1030 FORMAT(1X,80('-'),/,' Type Q(Quit), F(File it), N(Next message),P - & D(Dir), or other key for MORE: ',$) -1040 FORMAT(' Message written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/)D - - END - - - - - SUBROUTINE SET_BBOARD(BBOARD) -CE -C SUBROUTINE SET_BBOARD -CN -C FUNCTION: Set username for BBOARD for selected folder.E -C - IMPLICIT INTEGER (A-Z)_ - - PARAMETER UAF$V_DISACNT = 4 - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12h - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IFd - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - - CALL OPEN_FILE(7) ! Open folder file. - READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER)p - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMITq - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THENr - CALL GET_UAF. - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER)I - IF (IER.AND..NOT.BTEST(FLAGS,UAF$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'I - & ('' ERROR: BBOARD account needs DISUSER flag set.'')') - IER = 0o - END IFI - IF (IER) THEN - READ (7,FMT=FOLDER_FMT,KEY='GENERAL',KEYID=0,IOSTAT=IER)r - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIPE - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIREn - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR.N - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0)s - READ (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIPs - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE - END DOd - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND.T - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_FILE(7)n - RETURN - ELSE - READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER)' - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,DUMMY,DUMMY,DUMMY - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMITB - FOLDER_BBOARD = INPUT_BBOARDO - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIALE - IF (CLI$PRESENT('VMSMAIL')) THENM - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IFU - END IF' - END IF - ELSEU - CALL CLOSE_FILE(7) - RETURN - END IFE - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIALE - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD)W - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THENN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')')m - END IF( - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THENL - IF (EX_LEN.GT.3) EX_LEN = 3p - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '',N - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_FILE(7) - RETURN - ELSE IF (TEMP.LE.0) THENE - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_FILE(7) - RETURN - ELSE) - FOLDER_BBEXPIRE = TEMP - END IF, - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF_ - ELSE - FOLDER_BBOARD = 'NONE'T - END IF - - REWRITE (7,FMT=FOLDER_FMT,IOSTAT=IER)R - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT - CALL CLOSE_FILE(7) - WRITE (6,'('' BBOARD has been modified for folder.'')')N - ELSER - WRITE (6,'('' You are not authorized to modify BBOARD.'')')0 - END IF - - RETURNl - END - - - - - SUBROUTINE RESPOND(STATUS)( -C -C SUBROUTINE RESPONDw -Cl -C FUNCTION: Sends a mail message in reply to a posted message.T -C. -C NOTE: Modify the last SPAWN statement to specify the command+ -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands.H -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER INPUT*80,FROM_TEST*5E - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been reade - WRITE(6,'('' ERROR: You have not read any message.'')')( - RETURN ! And return, - END IFi - - BULL_PARAMETER = 'RE: '//DESCRIPi - IF (CLI$PRESENT('SUBJECT')) THENE - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P)e - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')')e - RETURN_ - END IF - END IF - - LEN_P = TRIM(BULL_PARAMETER)O - - IF (BULL_PARAMETER(1:1).NE.'"') THEN_ - BULL_PARAMETER = '"'//BULL_PARAMETER(1:LEN_P), - LEN_P = LEN_P + 1R - END IF - - IF (BULL_PARAMETER(LEN_P:LEN_P).NE.'"') THENL - BULL_PARAMETER = BULL_PARAMETER(1:LEN_P)//'"'E - LEN_P = LEN_P + 1 - END IFE - - IF (CONFIRM_USER(FROM).EQ.0) THEN - CALL LIB$SPAWN('$MAIL SYS$INPUT '//FROM//'/SUBJECT='// - & BULL_PARAMETER,,,,,,STATUS)& - ELSE - FROM_TEST = ' 'F - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - L_INPUT = 81 - I = BLOCKH - DO WHILE (I.LT.BLOCK+LENGTH.AND.L_INPUT.GT.0)/ - CALL GET_BULL(I,INPUT,L_INPUT)X - IF (L_INPUT.GT.0) THEN - CALL STR$UPCASE(FROM_TEST,INPUT(1:5)) - IF (FROM_TEST.EQ.'FROM:') THENH - IF (INDEX(INPUT,'.').GT.0.OR.INDEX(INPUT,'@').GT.0 - & .OR.INDEX(INPUT,'%').GT.0) THEN - L_INPUT = 0 - END IF - END IFH - ELSE IF (L_INPUT.EQ.0) THEN - L_INPUT = 80 - I = I + 1t - END IFN - END DO - CALL CLOSE_FILE(1) - IF (FROM_TEST.EQ.'FROM:') THEN - L_B = INDEX(INPUT,'<')T - R_B = INDEX(INPUT,'>')' - IF (L_B.GT.0.AND.R_B.GT.0) THEN - INPUT = INPUT(L_B+1:R_B-1)a - L_INPUT = R_B - 1 - L_B - ELSE - L_INPUT = TRIM(INPUT) - I = 6 - DO WHILE (INPUT(I:I).EQ.' '.AND.I.GT.0) - I = I + 1 - IF (I.GT.L_INPUT) I = 0, - END DO - INPUT = INPUT(I:L_INPUT)1 - L_INPUT = L_INPUT - I + 1 - END IFW - CALL LIB$SPAWN('$CHMAIL/I "'//INPUT(:L_INPUT)// - & '@XX"/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSE - WRITE (6,'('' ERROR: Cannot respond to mail.'')') - END IF - END IF - - RETURN - - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -Cl -C FUNCTION: Confirms that username is valid user. -CC - IMPLICIT INTEGER (A-Z)= - - CHARACTER*(*) USERNAMEL - - CALL OPEN_FILE_SHARED(8)V - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_FILE(8). - - RETURNU - END - - diff --git a/decus/vax87d/bulletin/bulletin2.for b/decus/vax87d/bulletin/bulletin2.for deleted file mode 100644 index 43b6327..0000000 --- a/decus/vax87d/bulletin/bulletin2.for +++ /dev/null @@ -1,1221 +0,0 @@ -From: HENRY::IN%"MRL%PFC-VAX.MIT.EDU%xx.lcs.mit.edu%zermatt.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 13-DEC-1987 08:52 -To: MHG , -Subj: BULLETIN2.FOR - -C -C BULLETIN2.FOR, Version 12/11/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: Replaces existing bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*8 - CHARACTER INDESCRIP*80,INPUT*80,TODAY*23 - CHARACTER*1 ANSWER - - CHARACTER DATE_SAVE*11,TIME_SAVE*8 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT - - LOGICAL*1 DOALL - -C -C Get the bulletin number to be replaced. -C - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are reading - ELSE - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (FOLDER_SET.AND.CLI$PRESENT('SYSTEM')) THEN - WRITE (6,'( - & '' ERROR: Invalid parameter used with folder set.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (FOLDER_SET.AND.CLI$PRESENT('SHUTDOWN')) THEN - WRITE (6,'( - & '' ERROR: Invalid parameter used with folder set.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletin - - CALL CLOSE_FILE(2) - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person - RETURN ! and error out - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND. - & USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(1:11) - INEXTIME = INPUT(13:20) - END IF - -8 IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) DESLEN,INDESCRIP - IF (DESLEN.EQ.0) GO TO 910 ! If no header, don't add bull - IF (DESLEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fit - GO TO 8 ! and re-request header - END IF - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,DESLEN) - IF (DESLEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(1:53) ! Show how much would fit - GO TO 910 ! and abort - END IF - END IF - - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & CLI$PRESENT('EDIT').OR.EDIT_DEFAULT) THEN ! or /EDIT specified - - IF (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - LEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy mesage into file - DO WHILE (LEN.GT.0) - CALL GET_BULL(I,INPUT,LEN) - IF (LEN.LT.0) THEN - GO TO 5 - ELSE IF (LEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:LEN) - END IF - END DO - LEN = 80 - END DO -5 CALL CLOSE_FILE(1) - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) LEN,INPUT ! get record count - IF (LEN.GT.80) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,LEN) - IF (LEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + LEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (LEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED', - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - LEN = 80 ! Length of input line - DO WHILE (LEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,LEN) ! Get input line - IF (LEN.GT.80) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > 80. Reinput::'')') - ELSE IF (LEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + LEN ! Increment character count - WRITE(3,'(A)') INPUT(1:LEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (LEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(1:LEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (LEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out. -10 ICOUNT = LAST_NOBLANK8 - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outN - ENDIF - - REWIND (UNIT=3) - END IF2 - -C7 -C Add bulletin to bulletin file and directory entry for to directory file. -Cv - - DATE_SAVE = DATE- - TIME_SAVE = TIMEo - INPUT = DESCRIP - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for messagel - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it.E - IF (IER.NE.NUMBER_PARAM+1) DATE = ' '' - NUMBER_PARAM = 0 - IER = 1C - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER)T - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_FILE(2). - CLOSE (UNIT=3,STATUS='SAVE')e - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')')W - IF (DOALL.OR.CLI$PRESENT('TEXT')) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')')n - END IF - GO TO 100 - END IF - END IFR - - CALL READDIR(0,IER) ! Get directory headerN - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN ! If text has been replacedM - - LENGTH_SAVE = LENGTH ! Copy BULL modifies LENGTH - - CALL OPEN_FILE(1) ! Prepare to add bulletina - ICOUNT = (ICOUNT+127)/128R - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - NBLOCK = NBLOCK + ICOUNT - - CALL WRITEDIR(0,IER) - - CALL COPY_BULL(3,REC1,BLOCK,IER) ! Replace old bulletinE - - CALL CLOSE_FILE(1) - - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = ICOUNT ! Update sizea - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry) - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IFl - - IF (CLI$PRESENT('HEADER').OR.CLI$PRESENT('SUBJECT').OR.DOALL) THEND - DESCRIP=INDESCRIP(1:53) ! Update description header - END IF_ - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIMEd - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in! - NEWEST_EXTIME = EXTIME ! the directory filee - CALL WRITEDIR(0,IER)! - END IF - ELSE IF (CLI$PRESENT('PERMANENT').AND.E - & (.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THENN - SYSTEM = IBCLR(SYSTEM,2)l - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER)R - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000'I - EXTIME = '00:00:00'n - ELSE IF (CLI$PRESENT('SHUTDOWN').AND. - & (.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000'L - EXTIME = '00:00:00'R - SHUTDOWN = SHUTDOWN + 1e - CALL SYS$ASCTIM(,TODAY,,) ! Get the present timex - SHUTDOWN_DATE = TODAY(1:11) - SHUTDOWN_TIME = TODAY(13:20) - CALL WRITEDIR(0,IER) - END IF= - - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - - CALL WRITEDIR(NUMBER_PARAM,IER) - - CALL CLOSE_FILE(2) ! Totally finished with replace - - CLOSE (UNIT=3)L - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURNS - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100)P - GOTO 100) - -920 WRITE(6,1020)T - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3). - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')N -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be - & truncated to:') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$)r -2020 FORMAT(1X,A)E - - END - - - - SUBROUTINE SEARCH(READ_COUNT) -CS -C SUBROUTINE SEARCH -Ch -C FUNCTION: Search for bulletin with specified string -CE - IMPLICIT INTEGER (A - Z)T - - INCLUDE 'BULLDIR.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - - CHARACTER*132 SEARCH_STRING,SAVE_STRING - DATA SEARCH_STRING /' '/, SEARCH_LEN /1/O - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAGC - - CALL DISABLE_CTRL - - IF (CLI$PRESENT('START')) THEN ! Starting message specifiedm - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_POINT - BULL_POINT = BULL_POINT - 1s - END IF - - SAVE_STRING = SEARCH_STRING - SAVE_LEN = SEARCH_LEN - - IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - I - IF (.NOT.IER) THEN ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - SEARCH_LEN = SAVE_LEN1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN ! If string entered but no - BULL_POINT = 0 ! starting message, use firstL - END IF - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - CALL OPEN_FILE_SHARED(2)T - - CALL READDIR(0,IER) - - IF (BULL_POINT+1.GT.NBULL) THEN - WRITE (6,'('' ERROR: No more messages.'')') - CALL CLOSE_FILE(2) - CALL ENABLE_CTRL - RETURN - END IFe - - CALL OPEN_FILE_SHARED(1) - - CALL DECLARE_CTRLC_ASTI - - DO BULL_SEARCH = BULL_POINT+1, NBULLO - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1) THEN - LEN = 81 - DO J=BLOCK,BLOCK+LENGTH-1 - DO WHILE (LEN.GT.0) - CALL GET_BULL(J,INPUT,LEN)' - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(1:SEARCH_LEN)).GT.0) THENC - CALL CLOSE_FILE(1)E - CALL CLOSE_FILE(2)( - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLM - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletinW - RETURN - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')')o - CALL CLOSE_FILE(1)O - CALL CLOSE_FILE(2)M - CALL ENABLE_CTRLI - RETURN - END IF - END DO - LEN = 80C - END DO! - END IF - END DOn - - CALL CANCEL_CTRLC_AST - - CALL CLOSE_FILE(1) ! End of bulletin file read0 - CALL CLOSE_FILE(2)= - - CALL ENABLE_CTRLU - - WRITE (6,'('' No messages found with given search string.'')') - - RETURNC - END - - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message., -CE - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'i - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENTi - -C -C Get the bulletin number to be undeleted. -Cu - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?p - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error.S - ELSEe - BULL_DELETE = BULL_POINT ! Delete the file we are reading. - END IFI - - IF (BULL_DELETE.LE.0) GO TO 920 - -C( -C Check to see if specified bulletin is present, and if the userB -C is permitted to delete the bulletin.! -Cs - - CALL OPEN_FILE(2) - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?G - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IFI - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,e - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges oro - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out.P - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?A - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IFA - END IF - END IF( - - IF (SYSTEM.LE.1) THEN ! General or System messageP - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(1:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(1:7)//'20'//EXDATE(10:) - END IF - END IF6 - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - WRITE (6,'('' Message was undeleted.'')') - -100 CALL CLOSE_FILE(2) - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020)' - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.')D -1020 FORMAT(' ERROR: Specified message number has incorrect format.')L -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.')p - - END - - - - SUBROUTINE UPDATE -CC -C SUBROUTINE UPDATE -CC -C FUNCTION: Searches for bulletins that have expired and deletes them. -CO -C NOTE: Assumes directory file is already opened. -CA - IMPLICIT INTEGER (A - Z)E - - INCLUDE 'BULLDIR.INC' - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE! - CHARACTER*8 TEMP_TIME,TEMP_EXTIME - - IF (TEST_BULLCP()) RETURN ! BULLCP cleans up expired bulletinsU - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00' ! are no more bulletins, this is the valueU - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest, - TEMP_TIME = '00:00:00' ! bulletin date if deletion occursa - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleteda - - DO WHILE (1)F - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not foundW - IF (SYSTEM.LE.3.OR.(SHUTDOWN.EQ.0 ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - DIFF = 0 ! If so, delete it - ELSEM - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed?N - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IFS - IF (DIFF.LE.0) THEN ! If so then delete bulletin0 - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted fileC - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF (SYSTEM.LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latestE - ! expiration date. The following does that.M - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND.M - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest expp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IFR - TEMP_DATE = DATE ! Keep date so when we quitT - TEMP_TIME = TIME ! search, we'll have the - END IF ! latest bulletin date5 - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - END IF - BULL_ENTRY = BULL_ENTRY + 1h - END DON - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IFe - - DATE = NEWEST_DATE. - TIME = NEWEST_TIMER - NEW_SHUTDOWN = SHUTDOWN - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER)R - CALL UPDATE_FOLDERe -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to userso -C, - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THENi - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURNN - - END - - - - SUBROUTINE UPDATE_READ -CR -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility.I -C If new bulletins have been added, alert user of the fact.C -CA - - IMPLICIT INTEGER (A - Z)T - - INCLUDE 'BULLUSER.INC'' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23U - - DIMENSION TODAY_BTIM(2) - -C -C Update user's latest read time in his entry in BULLUSER.DAT.L -C - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - DO WHILE (REC_LOCK(IER))L - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletinB - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DOE - - IF (IER.NE.0) THEN ! If header not present, exit_ - CALL CLOSE_FILE(4) - RETURN - ELSE IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THENN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG(I) = 0 ! information, write defaulto - NOTIFY_FLAG(I) = 0 ! flags.s - BRIEF_FLAG(I) = 0 - NEW_FLAG(I) = 0 - END DO - SET_FLAG(1) = 1u - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - REWRITE (4,FMT=USER_FMT) - & TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFL - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - DO WHILE (REC_LOCK(IER1)) - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER1) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,= - & NOTIFY_FLAG ! Find user's info - END DO - - IF (IER1.EQ.0) THEN ! If entry found, update it - REWRITE (4,FMT=USER_FMT) USERNAME,LOGIN_BTIM,TODAY_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0T - WRITE (4,FMT=USER_FMT) USERNAME,TODAY_BTIM,TODAY_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAGO - END IFR - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN ! to go home...( - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C_ -C SUBROUTINE FIND_NEWEST_BULL -C2 -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin.D -Cn -C OUTPUTS:C -C BULL_POINT - If -1, no new bulletins to read, else there are. -CL - - IMPLICIT INTEGER (A - Z)B - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC'e - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'N - - CHARACTER READ_DATE_TIME*20,LOGIN_DATE_TIME*20T - - CALL SYS$ASCTIM(,READ_DATE_TIME,LAST_READ_BTIM(1,FOLDER_NUMBER+1),) - CALL SYS$ASCTIM(,LOGIN_DATE_TIME,LOGIN_BTIM,) -CR -C Now see if bulletins have been added since the user's previous' -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in.E -C) - BULL_POINT = -1 ! Init bulletin pointeru - - CALL OPEN_FILE_SHARED(2) ! Yep, so get directory file2 - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN ! If header present - DO ICOUNT=1,NBULL ! Get each bulletin to compare - CALL READDIR(ICOUNT,IER) ! its date with last read daten - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - DIFF = COMPARE_DATE(READ_DATE_TIME(1:11),DATE) - IF (DIFF.EQ.0) h - & DIFF = COMPARE_TIME(READ_DATE_TIME(13:20),TIME) - IF (DIFF.LT.0) THEN ! If new bull or new user - IF (SYSTEM) THEN ! If system bulletin - DIFF = COMPARE_DATE(LOGIN_DATE_TIME(1:11),DATE) - IF (DIFF.EQ.0)N - & DIFF = COMPARE_TIME(LOGIN_DATE_TIME(13:20),TIME) - END IF - IF (DIFF.LE.0) THEN_ - BULL_POINT = ICOUNT - 1 - CALL CLOSE_FILE(2). - RETURNO - END IF - END IFF - END IFN - END DO - END IF - - CALL CLOSE_FILE(2)n - - RETURNP - END - - - - SUBROUTINE GET_EXPIRED(INPUT,IER) - - IMPLICIT INTEGER (A-Z)f - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC') - - CHARACTER*20 INPUTu - CHARACTER*23 TODAY( - - DIMENSION EXTIME(2),NOW(2)u - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's dateE - - IERC = CLI$GET_VALUE('EXPIRATION',INPUT,ILEN) - - PROMPT = .TRUE. - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE./ - ELSE - WRITE(6,1030) TODAY ! Prompt for expiration date - CALL GET_LINE(INPUT,ILEN) ! Get input line - END IF - ELSEa - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0d - RETURN - END IFA - - INPUT = INPUT(1:ILEN) ! Change trailing zeros 2 spaces9 - - IF (INDEX(INPUT,'-').EQ.0.AND.INDEX(INPUT,':').GT.0.AND.Y - & INDEX(INPUT(1:ILEN),' ').EQ.0) THENA - INPUT = TODAY(1:INDEX(TODAY(2:),' ')+1)//INPUT - END IF - - CALL STR$UPCASE(INPUT,INPUT) ! Convert to upper case - IER = SYS_BINTIM(INPUT,EXTIME)n - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - GO TO 5N - END IFe - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,)d - IF (TIMLEN.EQ.16) THENT - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - END IFR - - IF (INPUT(2:2).EQ.'-') INPUT = '0'//INPUT - IER = COMPARE_DATE(INPUT(1:11),TODAY(1:11)) ! Compare date with today's - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND.A - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limit' - GO TO 5! - END IFo - IF (IER.EQ.0) IER = COMPARE_TIME(INPUT(13:20),TODAY(13:20)) - IF (IER.LE.0) THEN ! If expiration date not futureo - WRITE(6,1045) ! tell user_ - GO TO 5 ! and re-request date - END IFo - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A23, - &'. Specify when the message should expire:',/,1x, - &'Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ',e - &'or delta time: dddd hh:mm:ss')B -1040 FORMAT(' ERROR: Invalid date format specified.')M -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large. - & Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)'T - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILEI - - CHARACTER*80 MAIL_EDIT,OUTe - - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - IF (IER.NE.SS$_NORMAL) MAIL_EDIT = 'SYS$SYSTEM:MAILEDIT'E - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IFL - - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0) THENe - CALL EDT$EDIT(INFILE,OUT)t - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THENO - CALL TPU$EDIT(INFILE,OUT) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)P - ! TPU does CLI$ stuff which wipes our parsed command lineT - END IFE - - RETURN - END - - - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($JPIDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15_ - - DIMENSION SAVEPRIV(2) - - CALL DISABLE_PRIVS ! Just let real privileged people do a /STARTUP - - CALL SYS$SETPRV(%VAL(1),PROCPRIV,,SAVEPRIV) ! Enable original privN - - IF (TEST_BULLCP()) THEN - WRITE (6,'('' BULLCP process running.E - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWERW - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXIT - - WILDCARD = -1I - - CALL INIT_ITMLST ! Initialize item listM - ! Now add items to listR - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM))n - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID))a - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1T - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP') - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER)d - CALL EXIT - END IF - END IFI - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY). - - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE')S - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)G - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')E - IF (IER.NE.0) RETURNL - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:'n - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11)N - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection_ - - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0))a - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM','NL:' - & ,,,,'BULLCP',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)). - END DOP - - CALL SYS$SETPRV(%VAL(0),SAVEPRIV,,) ! Reset privs - - CALL ENABLE_PRIVS - - IF (.NOT.IER) THENF - CALL SYS_GETMSG(IER) - ELSEI - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IFD - CALL EXIT - - END - - - - SUBROUTINE FIND_BULLCP) - - IMPLICIT INTEGER (A-Z)K - - COMMON /BCP/ BULLCP - LOGICAL BULLCP /.FALSE./N - - CHARACTER*1 DUMMY - - IER = SYS_TRNLNM('BULL_BULLCP',DUMMY) - IF (IER) BULLCP = .TRUE.o - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCPd - - IMPLICIT INTEGER (A-Z)U - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP, - - RETURNN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'T - - COMMON /BCP/ BULLCP - LOGICAL BULLCPB - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - BULLCP = .FALSE. ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit.d - CALL SYS_GETMSG(IER) - CALL EXITe - END IFi - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - DO WHILE (1) ! Loop once every 15 minutes - CALL BBOARD ! Look for BBOARD messages.M - DO FOLDER_NUMBER=0,FOLDER_MAX' - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - IF (NEMPTY.GT.200) THEN_ - CALL CLEANUP_BULLFILE ! Cleanup empty blocks( - END IF - CALL DELETE_EXPIRED ! Delete expired messages - END IFl - END DO - CALL WAIT('15') ! Wait for 15 minutes - END DOI - - RETURN, - END - - - - SUBROUTINE WAIT(MIN)e -C. -C SUBROUTINE WAITl -Cn -C FUNCTION: Waits for 15 minutes.t -Cn - IMPLICIT INTEGER (A-Z)b - PARAMETER WAITEFN=1 ! Event flag to wait on.L - INTEGER TIMADR(2) ! Buffer containing timeL - ! in desired system format.t - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/f - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,,)! Set timer.e - IER=SYS$WAITFR(%VAL(WAITEFN)) ! Wait for EFN to be set.d - - RETURN - END - - - - - SUBROUTINE DELETE_EXPIRED - -Co -C SUBROUTINE DELETE_EXPIRED -CM -C FUNCTION: -CT -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files,e -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed andF -C was replaced with a 128 byte record compressed format). -CS - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CALL OPEN_FILE_SHARED(2) ! Open directory fileU - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - CALL CLOSE_FILE(1) - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present?G - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')L - IF (SHUTDOWN.GT.0.AND.FOLDER_NUMBER.EQ.0) THEN - ! Do shutdown bulletins exist? - CALL GET_UPTIME(UPTIME_DATE,UPTIME_TIME) - IER1 = COMPARE_DATE(SHUTDOWN_DATE,UPTIME_DATE) - IF (IER1.EQ.0) IER1 = COMPARE_TIME(SHUTDOWN_TIME,UPTIME_TIME) - IF (IER1.LE.0) SHUTDOWN = 0 - ELSE - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN. - CALL CLOSE_FILE(2)T - CALL OPEN_FILE(2) ! Reopen without sharing - CALL UPDATE ! Need to update, - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_FILE(4) ! Create user file to be able to set - CALL CLOSE_FILE(4) ! defaults, privileges, etc. - END IFs - CALL CLOSE_FILE(2) - - RETURNI - END - diff --git a/decus/vax87d/bulletin/bulletin3.for b/decus/vax87d/bulletin/bulletin3.for deleted file mode 100644 index 2b627cc..0000000 --- a/decus/vax87d/bulletin/bulletin3.for +++ /dev/null @@ -1,1416 +0,0 @@ -From: HENRY::IN%"MRL%PFC-VAX.MIT.EDU%xx.lcs.mit.edu%zermatt.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 13-DEC-1987 08:37 -To: MHG , -Subj: BULLETIN3.FOR - -C -C BULLETIN3.FOR, Version 11/18/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*74,INFROM*74,INPUT*132 - CHARACTER*8 ACCOUNT - - CALL DISABLE_CTRL - - CALL OPEN_FILE_SHARED(7) - -1 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT - END DO - UNLOCK 7 - - IF (IER.NE.0) GO TO 900 - IF (FOLDER_BBOARD.EQ.'NONE') GO TO 1 - IF (FOLDER_NUMBER.EQ.0) THEN - FOLDER_SET = .FALSE. - ELSE - FOLDER_SET = .TRUE. - FOLDER_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - IF ((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)) THEN ! If normal BBOARD or /VMSMAIL - CALL CHECK_MAIL(FOLDER_BBOARD,COUNT) ! Any new VMS mail? - IF (COUNT.EQ.0) GO TO 1 ! None. - END IF - -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME) ! Get present username - CALL GETACC(ACCOUNT) ! Get present account - CALL GETUIC(GROUP,USER) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(1:LEN_B)// - & FOLDER_BBOARD(1:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B) - & //'BOARD.COM','NL:','NL:',,,,STATUS) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(1:LEN_B)//'BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(1:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B) - & //'BOARD.COM','NL:','NL:',,,,STATUS) - END IF - ELSE - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B)//FOLDER_BBOARD - & (1:TRIM(FOLDER_BBOARD))//'.COM','NL:','NL:',,,,STATUS) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(1:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',,,,STATUS) - END IF - END IF - ! Create sequential mail file - CALL SETACC(ACCOUNT) ! Reset to original account - CALL SETUSER(USERNAME) ! Reset to original username - CALL SETUIC(GROUP,USER) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_DIRECTORY(1:LEN_B)//FOLDER_BBOARD - & (1:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=110) - -5 LEN_INPUT = 1 - DO WHILE (LEN_INPUT.GT.0) - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - IF (INPUT(1:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(1:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - END IF - END DO - - -C -C Add bulletin to bulletin file and directory entry to directory file. -C - -10 CALL OPEN_FILE(2) ! Prepare to add dir entry - - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - IF (IER.NE.0) GO TO 100 ! If end of file, exit - IF (LEN_INPUT.EQ.1.AND.INPUT(1:1).EQ.CHAR(12)) GO TO 5 - ! If line is just form feed, the message is empty - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - OCOUNT = NBLOCK + 1 ! Initialize line count - - SPACE = INDEX(INFROM,' ') - 1 ! Strip off the date - IF (SPACE.GT.0) INFROM = INFROM(1:SPACE)! From the "From:" line - - IF (TRIM(INFROM).GT.12) THEN ! Is length > allowable? - LEN_INFROM = TRIM(INFROM) - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(1:LEN_INFROM), - & OCOUNT) - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) - I = 12 ! Trim username to first non-alpha character - DO WHILE (I.GT.1.AND. - & ((INFROM(I:I).GE.'A'.AND.INFROM(I:I).LE.'Z').OR. - & (INFROM(I:I).GE.'a'.AND.INFROM(I:I).LE.'z')) ) - I = I - 1 - END DO - IF (I.GT.1) INFROM = INFROM(1:I-1) - END IF - - LEN_DESCRP = TRIM(INDESCRIP) - IF (LEN_DESCRP.GT.53) THEN ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//INDESCRIP(1:LEN_DESCRP), - & OCOUNT) - INDESCRIP = INDESCRIP(1:LEN_DESCRP) - DO I=1,LEN_DESCRP - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - ELSE - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - END IF - - ISTART = 0 - NBLANK = 0 - DO WHILE (INPUT(1:1).NE.CHAR(12)) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - NBLANK = 0 - CALL STORE_BULL(MIN(LEN_INPUT,80),INPUT,OCOUNT) - IF (LEN_INPUT.GT.80) THEN ! Breakup line if > 80 chars - CALL STORE_BULL(MIN(LEN_INPUT,132)-80,INPUT(81:),OCOUNT) - END IF - END IF - READ (3,'(Q,A)',END=25) LEN_INPUT,INPUT - END DO - -25 CALL FLUSH_BULL(OCOUNT) - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - DESCRIP = INDESCRIP(1:53) ! Description header - FROM = INFROM(1:12) ! Username - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - EXTIME = '00:00:00' - LENGTH = OCOUNT - NBLOCK ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - -30 CALL CLOSE_FILE(2) ! Totally finished with add - - GO TO 5 ! See if there is more mail - -100 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEYID=1,KEY=FOLDER_NUMBER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT - END DO - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - REWRITE (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT - -110 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - GOTO 1I - -900 FOLDER_NUMBER = 0. - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=0,KEYID=1)e - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMITs - CALL CLOSE_FILE(7)r - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_FILE(1)N - CALL CLOSE_FILE(2)T - WRITE (6,1030)l - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.')L -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESS - - IMPLICIT INTEGER (A-Z)C - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE')C - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)_ - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')S - IF (IER.NE.0) RETURNR - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT'N - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT'f - WRITE(11,'(A)') '$B/'//'''F$PROCESS()'''M - WRITE(11,'(A)') '$EXIT:'A - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectioni - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',n - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:' - & ,,,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURNU - END - - - - SUBROUTINE GETUIC(GRP,MEM)G -CP -C SUBROUTINE GETUIC(UIC) -CI -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC2 -CO - - IMPLICIT INTEGER (A-Z)e - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listU - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURNl - END - - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)N -C. -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C( - - IMPLICIT INTEGER (A-Z)N - - EXTERNAL EXE$GL_ABSTIM, - INTEGER UPTIME(2),SYSTIME(2),UPSINCE(2)' - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - UPTIME(1) = GET_L_VAL(EXE$GL_ABSTIM) ! Up time (sec)' - - CALL LIB$EMUL(10000000,UPTIME,0,UPTIME) ! 64 bit format - CALL SYS$GETTIM(SYSTIME) - CALL LIB$SUBX(SYSTIME,UPTIME,UPSINCE) - CALL SYS$ASCTIM(,ASCSINCE,UPSINCE,) ! Up sinceC - - UPTIME_DATE = ASCSINCE(1:11)( - UPTIME_TIME = ASCSINCE(13:20) - - RETURN - END - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(USER,NEW_MESSAGES) - - IMPLICIT INTEGER (A-Z)E - - CHARACTER INPUT*35,USER*(*) - EQUIVALENCE (INPUT(34:),COUNT)A - - OPEN (UNIT=10,FILE='VMSMAIL',DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT',1 - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED) - READ(10,'(A)',KEY=USER,IOSTAT=IER) INPUTB - CLOSE (10)/ - - NEW_MESSAGES = COUNT, - - IF (IER.NE.0) COUNT = 0 - - RETURNI - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN)B -CD -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN). -C' -C FUNCTION: -C To get image name of process.F -C OUTPUT: -C IMAGNAME - Image name of processF -C ILEN - Length of imagename) -CT - - IMPLICIT INTEGER (A-Z)' - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAMER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURNO - END - - -C -C SUBROUTINE ITMLST_SUBS' -CT -C FUNCTION: -C A set of routines to easily create item lists. It allows oneE -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C1 -C Here is an example of how to use the routines (prints file to a queue): -CF -C CALL INIT_ITMLST ! Initialize item liste -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE))I -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,)T -C -C NOTE: These routines don't presently allow return length addressF -C in item list. -C - SUBROUTINE ITMLST_SUBSD - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/O - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0a - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXITO - END IF( - - RETURNR - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -CM -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -CR - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0). - ! Store data in itemlist formatO - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER))t - ! Insert entry into queueT - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR)t -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -CI - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,M - & RETADR) - ! Store data in itemlist formatH - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER))L - ! Insert entry into queueT - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN_ - - - ENTRY END_ITMLST(ITMLST_ADDRESS)_ - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS)n - ! Get memory for itemlistP - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memoryF - - DO I=1,NUM_ITEMS ! Place entries into itemlisti - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8),a - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST)F - END DOX - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURNN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR,i - & RETADR) - - IMPLICIT INTEGER (A-Z)m - - STRUCTURE /ITMLST/E - UNIONK - MAP - INTEGER*2 BUFLEN,CODEI - INTEGER BUFADR,RETADRR - END MAP - END UNIONF - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN_ - END - - - SUBROUTINE CLEANUP_LOGIN -CR -C SUBROUTINE CLEANUP_LOGINA -CE -C FUNCTION: Removes entry in user file of user that no longer exist -C if it creates empty space for new user. -CO - INCLUDE 'BULLUSER.INC'W - - CHARACTER*12 LOGIN_USER - - CALL OPEN_FILE_SHARED(8), - - READ (4,'(A12)',IOSTAT=IER1,KEYGT=USERNAME) TEMP_USER ! Look forward one - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user existsF - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER) THEN - DELETE(UNIT=4) ! Delete non-existant userN - END IFW - - CALL CLOSE_FILE(8) ! All done...C - - RETURNI - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULLG -CO -C FUNCTION: To copy data to the bulletin file. -CL -C INPUT:E -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start ats -C OBLOCK - Output block number in output file to start at. -Ct -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -CI -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. TheE -C bulletin file is assumed to be opened on logical unit 1. -CI - - IMPLICIT INTEGER (A - Z)D - - INCLUDE 'BULLDIR.INC' - - CHARACTER INPUT*80R - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)')C - END DOE - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0O - DO WHILE (1): - LEN = 0 - DO WHILE (LEN.EQ.0)_ - READ(INLUN,'(Q,A)',END=100) LEN,INPUT - LEN = MIN(LEN,TRIM(INPUT),80) - IF (LEN.GT.1.AND.ICHAR(INPUT(LEN:LEN)).EQ.10) THEN= - INPUT(LEN-1:LEN-1) = CHAR(32) ! Remove imbedded - INPUT(LEN:LEN) = CHAR(32) ! CR/LFs at end of file.E - LEN = LEN - 2 - END IFN - IF (LEN.GT.0) THEN1 - ICOUNT = ICOUNT + 1 - ELSE IF (LEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN) - NBLANK = NBLANK + 1 - END IFY - END DO - IF (NBLANK.GT.0) THENu - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DOD - LENGTH = LENGTH + NBLANK*2' - NBLANK = 0, - END IF - CALL STORE_BULL(LEN,INPUT,OCOUNT)) - LENGTH = LENGTH + LEN + 1O - END DOU - -100 LENGTH = (LENGTH+127)/128E - IF (LENGTH.EQ.0) THEN - IER = 1t - ELSE - IER = 0t - END IFj - - CALL FLUSH_BULL(OCOUNT) - - RETURNm - END - - - - SUBROUTINE STORE_BULL(LEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*(BRECLEN) - - DATA POINT/0/ - - IF (LEN+POINT+1.GT.BRECLEN) THENR - IF (POINT.EQ.BRECLEN) THEN - WRITE (1'OCOUNT) OUTPUT(1:POINT)G - OUTPUT = CHAR(LEN)//INPUT - POINT = LEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THENI - WRITE (1'OCOUNT) OUTPUT(1:POINT)//CHAR(LEN) - OUTPUT = INPUTU - POINT = LEN - ELSE - WRITE (1'OCOUNT) OUTPUT(1:POINT)//CHAR(LEN) - & //INPUT(1:BRECLEN-1-POINT) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = LEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1A - ELSEA - OUTPUT(POINT+1:) = CHAR(LEN)//INPUT(1:LEN) - POINT = POINT + LEN + 1L - END IFL - - RETURNP - - ENTRY FLUSH_BULL(OCOUNT)m - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - WRITE (1'OCOUNT) OUTPUT - POINT = 0 - - RETURN - - END - - - SUBROUTINE GET_BULL(BLOCK,INPUT,LEN)T - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128,LINE_LENGTH=80_ - - CHARACTER INPUT*(*),TEMP*(BRECLEN), LEFT*(BRECLEN) - - DATA POINT /1/, LEFT_LEN /0/E - - IF (LEN.GT.LINE_LENGTH) THEN - POINT = 1A - LEFT_LEN = 0 - END IFU - - IF (POINT.EQ.1) THENT - DO WHILE (REC_LOCK(IER)) - READ (1'BLOCK,IOSTAT=IER) TEMPA - END DO - ELSE IF (POINT.EQ.BRECLEN+1) THEN - LEN = 0O - POINT = 1 - RETURN - END IFD - - IF (IER.GT.0) THENA - LEN = -1 - POINT = 1R - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN - LEN = ICHAR(LEFT(1:1)) - INPUT = LEFT(2:LEN-LEFT_LEN+1)//TEMP(1:LEFT_LEN) - POINT = LEFT_LEN + 1 - LEFT_LEN = 0 - ELSE - LEN = ICHAR(TEMP(POINT:POINT)) - IF (LEN.GT.BRECLEN-POINT) THEN - LEFT = TEMP(POINT:) - LEFT_LEN = LEN - (BRECLEN-POINT)E - LEN = 0 - POINT = 1 - ELSE IF (LEN.EQ.0) THEN - POINT = 1 - ELSE - INPUT = TEMP(POINT+1:POINT+LEN) - POINT = POINT+LEN+1 - END IF - END IFP - - RETURN, - - ENTRY TEST_MORE_LINES(LEN)C - - IF (POINT.EQ.BRECLEN+1) THEN_ - LEN = 0 - ELSE - LEN = ICHAR(TEMP(POINT:POINT)) - END IFT - - RETURN, - - END - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -CS -C SUBROUTINE DELETE_ENTRY -CF -C FUNCTION: -C To delete a directory entry. -Ce -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -Ct - - IMPLICIT INTEGER (A-Z)s - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'a - - CHARACTER*80 INPUTt - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER)w - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IFA - - IF (BTEST(FOLDER_FLAG,1)) THENs - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - WRITE (3,1050) DESCRIP ! Output bulletin header info - WRITE (3,1060) FROM,DATE - - CALL OPEN_FILE(1)I - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file0 - DO WHILE (ILEN.GT.0)I - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THENA - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:ILEN) - END IF - END DO - ILEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - END IFo - -900 DELETE(UNIT=2,REC=BULL_ENTRY+1)_ - - NEMPTY = NEMPTY + LENGTHS - CALL WRITEDIR(0,IER)! - -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/)l - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -Ce -C SUBROUTINE GET_EXDATE -CT -C FUNCTION: Computes expiration date giving number of days to expire.I -C - IMPLICIT INTEGER (A-Z)D - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12)e - DIMENSION LENGTH(12)i - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present dateD - - DECODE(2,'(I2)',EXDATE(1:2)) DAY ! Get dayr - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1t - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSEr - LENGTH(2) = 27 - END IFt - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0)_ - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN_ - ! If expiration date exceeds end of monthU - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month, - DAY = 1 ! Reset day to first of monthu - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27E - END IF - END IFV - ELSE ! If expiration date is within the monthR - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exitI - END IF - END DOM - - ENCODE(2,'(I2)',EXDATE(1:2)) DAY ! Put day into new dateT - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new dateN - - RETURNm - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT)E -C* -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal.C -CE -C OUTPUTS:I -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -CS -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST.B -CT - - IMPLICIT INTEGER (A-Z)F - - LOGICAL*1 DESCRIP(8),DTYPE,CLASSf - INTEGER*2 LENGTHr - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE)I - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITR - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGI - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPT - - USE_PROMPT = .FALSE.l - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C: -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1n -Cp - - CALL DECLARE_CTRLC_ASTO - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limits - POINTER = 0 ! during input. - -Ca -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line.I -CI - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTD - IF (IER.NE.0) LEN_INPUT = -2 ' - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt, - ELSE) - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompt1 - END IF3 - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT)D - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DOA - CALL CONVERT_TABS(INPUT,LEN_INPUT)H - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSEE - LEN_INPUT = -1 ! If CTRL-C, say so - END IFT - RETURND - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT)P - - IMPLICIT INTEGER (A-Z)R - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT)/ - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN- - INPUT(MOVE:) = INPUT(TAB_POINT+1:)P - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT) - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - RETURN= - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT)L - RETURN) - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routineP - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 1 ! to set flag - RETURNR - END - - - - SUBROUTINE DECLARE_CTRLC_ASTI -CT -C SUBROUTINE DECLARE_CTRLC_ASTN -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES:E -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -CI - IMPLICIT INTEGER (A-Z)I - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINET - COMMON /TERM_CHAN/ TERM_CHANN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Yep, init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURNE - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -CT -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C1 - IMPLICIT INTEGER (A-Z)= - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHANF - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/T - - DATA PURGE/.TRUE./R - - DO I=1,LEN(DATA) - DATA(I:I) = ' 'T - END DON - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),t - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.r - ELSEe - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),. - & TRM$M_TM_NOECHO) - END IF - - RETURNR - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT)R - - DO I=1,LEN(DATA)B - DATA(I:I) = ' 'L - END DO( - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),_ - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.I - ELSEE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),= - & TRM$M_TM_NOECHO) - END IF& - - RETURNE - - ENTRY GET_INPUT_NUM(DATA,NLEN)E - - DO I=1,LEN(DATA)) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),F - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE.O - ELSEK - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,,E - & TERMSET,NLEN,TERM) - END IFN - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(1:1) = CHAR(TERM) - END IFF - - RETURND - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminalt - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20)= - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)N - - IER = SMG$CREATE_KEY_TABLE (KEY_TABLE_ID) - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32)E - END DOD - - RETURN - END - - - - - - SUBROUTINE GETPAGLEN(PAGE_LENGTH) -Cr -C SUBROUTINE GETPAGLENo -Ca -C FUNCTION: -C Gets page length of the terminal.A -CT -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C - IMPLICIT INTEGER (A-Z)' - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1)))E - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = DEVDEPEND(4)H - - RETURN( - END - - - - - - LOGICAL FUNCTION SLOW_TERMINALO -C -C FUNCTION SLOW_TERMINALY -C, -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less).l -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z)v - - EXTERNAL IO$_SENSEMODED - - COMMON /TERM_CHAN/ TERM_CHANG - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)'U - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSEN - SLOW_TERMINAL = .FALSE.m - END IFt - - RETURNI - END - - - - - SUBROUTINE SHOW_PRIVx -Ce -C SUBROUTINE SHOW_PRIVs -Cm -C FUNCTION: -C To show privileges necessary for managing bulletin board.O -CE - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($PRVDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - DO WHILE (REC_LOCK(IER))w - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not presentd - CALL CLOSE_FILE(4) - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER)e - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - NEW_FLAG(2) = 0 - REWRITE (4,FMT=USER_FMT)A - & TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')')) - DO I=0,38P - IF ((I.LT.32.AND.BTEST(NEW_FLAG(1),I)).OR.E - & (I.GT.31.AND.BTEST(NEW_FLAG(2),I-32))) THENM - WRITE (6,'(1X,A)') PRIVS(I) - END IFC - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')')P - END IFE - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURNE - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -CG -C FUNCTION: -C To set privileges necessary for managing bulletin board. -CI - - IMPLICIT INTEGER (A-Z)S - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'. - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVSt - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/_ - - EXTERNAL CLI$_ABSENT - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*8 INPUT_PRIVY - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IFC - - OFFPRIV(1) = 0e - OFFPRIV(2) = 0n - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,LEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - PRIV_FOUND = -1- - I = 0r - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1)C - IF (INPUT_PRIV(:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(1:LEN) - RETURNH - ELSE IF (INPUT_PRIV(1:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN- - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')')a - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSEA - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)L - END IFT - ELSE - IF (PRIV_FOUND.LT.32) THENN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSEv - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IFB - END IF - END DO1 - - CALL OPEN_FILE(4) ! Get BULLUSER.DAT fileA - - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - - IF (IER.EQ.0) THEN ! If header is present, exit - NEW_FLAG(1) = NEW_FLAG(1).OR.ONPRIV(1) - NEW_FLAG(2) = NEW_FLAG(2).OR.ONPRIV(2) - NEW_FLAG(1) = NEW_FLAG(1).AND.(.NOT.OFFPRIV(1))O - NEW_FLAG(2) = NEW_FLAG(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4,FMT=USER_FMT) - & TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - WRITE (6,'('' Privileges successfully modified.'')') - ELSEt - WRITE (6,'('' ERROR: Cannot modify privileges.'')')L - END IFT - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURNa - - END - diff --git a/decus/vax87d/bulletin/bulletin4.for b/decus/vax87d/bulletin/bulletin4.for deleted file mode 100644 index 3af2d55..0000000 --- a/decus/vax87d/bulletin/bulletin4.for +++ /dev/null @@ -1,1219 +0,0 @@ -From: HENRY::IN%"MRL%PFC-VAX.MIT.EDU%xx.lcs.mit.edu%zermatt.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 13-DEC-1987 08:38 -To: MHG , -Subj: BULLETIN4.FOR - -C -C BULLETIN4.FOR, Version 12/7/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C NOTE: Subroutine CHECK_ACCESS which is used to see if user has only read -C access to a folder only works for VMS V4.4 or later. If you have an -C early version, modify as indicated. -C - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) RETURN - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - LEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - LEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privileged - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF'))) THEN - WRITE (6,'( - & '' ERROR: No privs to change all NOTIFY, BRIEF or READNEW.'')') - RETURN - END IF - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - WRITE (6,'('' Enter one line description of folder.'')') - -10 CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(1:LENDES) ! End fill with spaces - IF (LENDES.LE.0) GO TO 910 - IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - GO TO 10 - END IF - - FOLDER_OWNER = USERNAME ! Get present username - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(1:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',IOSTAT=IER, - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER_NUMBER = LAST_NUMBER - 1 - END IF - - FOLDER_OWNER = USERNAME ! Get present username - FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = 14 - NBULL = 0 - - WRITE (7,FMT=FOLDER_FMT) FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB, - & GROUPB,ACCOUNTB,NBULL,0,0,FOLDER_FLAG,0 - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(1:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE')E - CLOSE (UNIT=2,STATUS='DELETE'). - -1000 CALL CLOSE_FILE(7). - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectiona - - RETURN> - - END - - - - - - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -Co -C SUBROUTINE SET_FOLDER_DEFAULT -Ce -C FUNCTION: Sets NOTIFY or READNEW defaults for specified folder -C - IMPLICIT INTEGER (A-Z)o - - INCLUDE 'BULLFOLDER.INC'H - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (.NOT.SETPRV_PRIV().AND.INCMD(1:3).EQ.'SET') THENv - WRITE (6,'( - & '' ERROR: No privs to change all defaults.'')')B - RETURN - END IF - - CALL OPEN_FILE_SHARED(4)e - DO WHILE (REC_LOCK(IER))R - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) ! Get header - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG, - & BRIEF_FLAG,NOTIFY_FLAGe - END DO - DO WHILE (IER.EQ.0) - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER)E - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER)N - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER)U - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER)/ - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER)O - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,E - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEYGT=TEMP_USER,IOSTAT=IER) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,& - & BRIEF_FLAG,NOTIFY_FLAG ! Find if there is an entry - END DO - IF (TEMP_USER.NE.USER_HEADER.AND.S - & (BRIEF.EQ.-1.OR.NOTIFY.EQ.-1.OR.READNEW.EQ.-1)) THEN - IER = 1 ! Modify READNEW and NOTIFY for all usersS - END IF ! only during folder creation or deletion. - END DOR - CALL CLOSE_FILE(4)L - - RETURND - END - - - - - SUBROUTINE REMOVE_FOLDERA -CC -C SUBROUTINE REMOVE_FOLDER) -CT -C FUNCTION: Removes a bulletin folder.O -CR - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENTE - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder namea - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THENa - IF (.NOT.FOLDER_SET) THENr - WRITE (6,'('' ERROR: No folder specified.'')')E - RETURNr - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THENb - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF, - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) FOLDER1, - & FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP ! See if it existsN - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER1C - - IF (IER.NE.0) THENE - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IFE - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR.D - & FOLDER1_NUMBER.EQ.0) THENN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IFR - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(1:TRIM(FOLDER1))//' (Y/N with N as default): ')A - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - TEMP = FOLDER_FILEF - FOLDER_FILE = FOLDER1_FILEA - TEMPSET = FOLDER_SETT - FOLDER_SET = .TRUE. - CALL OPEN_FILE(2) ! Remove directory file - CALL OPEN_FILE(1) ! Remove bulletin fileU - CALL CLOSE_FILE_DELETE(1) - CALL CLOSE_FILE_DELETE(2) - FOLDER_FILE = TEMPR - FOLDER_SET = TEMPSET - - DELETE (7)( - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBERI - CALL SET_FOLDER_DEFAULT(0,0,0)E - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) FOLDER_SET = .FALSE. - -1000 CALL CLOSE_FILE(7)N - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER)B -CF -C SUBROUTINE SELECT_FOLDER$ -CS -C FUNCTION: Selects the specified folder. -C - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'U - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)'l - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_ABSENTe - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder hasE - DATA FIRST_TIME /FLONG*0/ ! been selected before this._ - - IF (OUTPUT) IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1) - ! Get folder name - - CALL OPEN_FILE_SHARED(7) ! Go find folder - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND.R - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND.E - & FOLDER_NUMBER.EQ.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL_ - FOLDER_NUMBER = 0Y - FOLDER1 = 'GENERAL'E - END IF - - DO WHILE (REC_LOCK(IER)) - IF (OUTPUT.OR.FOLDER_NUMBER.EQ.-1) THEN - IF (INCMD(:2).EQ.'SE') THEND - READ (7,FMT=FOLDER_FMT,KEYEQ=FOLDER1(:TRIM(FOLDER1)), - & KEYID=0,IOSTAT=IER)T - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB1,GROUPB1,ACCOUNTB1R - & ,F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMITL - ELSE - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER)O - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB1,GROUPB1,ACCOUNTB1I - & ,F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMITr - END IF - ELSEA - FOLDER1_NUMBER = FOLDER_NUMBER - READ (7,FMT=FOLDER_FMT,KEY=FOLDER_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB1,GROUPB1,ACCOUNTB1M - & ,F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - END IFn - END DO - - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!!S - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - REWRITE (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB1,GROUPB1,ACCOUNTB1 - & ,F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT* - END IF - - CALL CLOSE_FILE(7) - - IF (IER.EQ.0) THEN ! Folder found - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1E - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Is folder protected?N - CALL CHKACLF - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER) THENp - CALL CHECK_ACCESS - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS)E - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN. - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(1:TRIM(FOLDER1_OWNER)) - END IFh - IER = 0 - RETURN - END IF - END IF - ELSE ! Folder not protectedd - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IFL - IF (IER) THEN - - FOLDER = FOLDER1 ! Folder successfully set - FOLDER_NUMBER = FOLDER1_NUMBER ! so update permanent folderL - FOLDER_OWNER = FOLDER1_OWNER ! parameters. - FOLDER_DESCRIP = FOLDER1_DESCRIP - FOLDER_BBOARD = FOLDER1_BBOARD - FOLDER_BBEXPIRE = FOLDER1_BBEXPIRE - FOLDER_FILE = FOLDER1_FILE - USERB = USERB1 - GROUPB = GROUPB1 - FOLDER_FLAG = FOLDER1_FLAG - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NBULL = F1_NBULL - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - IF (FOLDER_NUMBER.GT.0) THEN - FOLDER_SET = .TRUE.R - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (OUTPUT.AND.INCMD(1:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') N - & FOLDER(1:TRIM(FOLDER))//'.'_ - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(1:3).NE.'DIR') - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE.L - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE.I - END IF - - IF (FOLDER_NUMBER.GT.0) THEN - IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get header info from BULLDIR.DATa - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (IER.LE.0) CALL UPDATE ! Need to update - ELSE_ - NBULL = 0R - END IF( - CALL CLOSE_FILE(2)N - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IFR - - IF (OUTPUT.AND.INCMD(1:3).NE.'DIR') THENL - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it_ - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0I - DO WHILE (NEW_COUNT.GT.0)G - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1a - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins1 - ELSE - BULL_POINT = 0 - END IF - END IFF - END IF - END IF - IER = 1. - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IFT - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - RETURNE - - END - - - - SUBROUTINE UPDATE_FOLDERE -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'r - - CALL OPEN_FILE_SHARED(7) ! Open folder file - - DO WHILE (REC_LOCK(IER))L - READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER)T - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - END DOO - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)1 - - REWRITE (7,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMITI - - CALL CLOSE_FILE(7)E - - RETURNN - END - - - - SUBROUTINE SHOW_FOLDERO -CR -C SUBROUTINE SHOW_FOLDERR -C -C FUNCTION: Shows the information on any folder.r -C) - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLUSER.INC'R - - INCLUDE 'BULLFOLDER.INC'o - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'R - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENTA - - CALL OPEN_FILE_SHARED(7) ! Open folder file - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).NE.%LOC(CLI$_ABSENT)) - & THEN -10 DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER)P - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMITD - END DO - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER1D - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_FILE(7)R - RETURN - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(1:TRIM(FOLDER1_DESCRIP))N - END IF - ELSE IF (FOLDER_SET) THEN - WRITE (6,1000) FOLDER,FOLDER_OWNER, - & FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP))I - FOLDER1_FILE = FOLDER_FILE - FOLDER1_BBOARD = FOLDER_BBOARD - FOLDER1_BBEXPIRE = FOLDER_BBEXPIRE - FOLDER1_NUMBER = FOLDER_NUMBER - FOLDER1_FLAG = FOLDER_FLAG - F1_EXPIRE_LIMIT = F_EXPIRE_LIMIT - ELSED - FOLDER1 = 'GENERAL'1 - GO TO 10 - END IFL - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACLt - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THENT - WRITE (6,'('' Folder is not a private folder.'')') - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - IF (WRITE_ACCESS)' - & CALL SHOWACL(FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD.NE.'NONE') THENU - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(1:FLEN) - END IF& - IF ((USERB.EQ.0.AND.GROUPB.EQ.0).OR.BTEST(USERB,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')')7 - END IF - END IFD - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' BBOARD expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIREX - ELSEB - WRITE (6,'('' BBOARD messages will not expire.'')')L - END IF1 - ELSEr - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IFR - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF1 - CALL OPEN_FILE_SHARED(4)D - DO WHILE (REC_LOCK(IER))( - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER)L - & TEMP_USER,LOGIN_BTIM,READ_BTIM,M - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG& - END DOR - IF (TEST2(SET_FLAG,FOLDER1_NUMBER)) THENF - IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is BRIEF.'')')L - ELSE - WRITE (6,'('' Default is READNEW.'')')F - END IF - ELSEH - IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is SHOWNEW.'')') - ELSE - WRITE (6,'('' Default is NOREADNEW.'')')d - END IF - END IFK - IF (TEST2(NOTIFY_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY.'')') - ELSE_ - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_FILE(4) - END IF - END IF1 - - CALL CLOSE_FILE(7). - - RETURNE - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12,o - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -Ca -C SUBROUTINE DIRECTORY_FOLDERSE -CO -C FUNCTION: Display all FOLDER entries. -CI - IMPLICIT INTEGER (A - Z)F - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGINGM - LOGICAL PAGINGd - - DATA SCRATCH_D1/0/D - - CHARACTER*17 DATETIME - - EXTERNAL CLI$_NEGATED,CLI$_PRESENT - - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE specified - ELSE_ - NLINE = 1 - END IFE - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.D -C3 - - IF (SCRATCH_D1.EQ.0) THEN ! Is queue empty?e - LSCR = LEN(FOLDER_COM) ! Length of input to store - CALL LIB$GET_VM(LSCR+12,SCRATCH_D) ! If so, allocated memory - CALL MAKE_CHAR(%VAL(SCRATCH_D),LSCR) ! Form a character string - SCRATCH_D1 = SCRATCH_D ! Init header pointerI - ELSE ! Else queue is not emptyO - SCRATCH_D = SCRATCH_D1 ! so reinit queue pointer' - END IF ! to the header. - - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDER = 0. - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - DO WHILE (REC_LOCK(IER)) - READ (7,FMT=FOLDER_FMT,KEYGT=FOLDER1,KEYID=0,IOSTAT=IER)d - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMITY - END DO - IF (IER.EQ.0) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER_COM) - END IF - END DO, - - CALL CLOSE_FILE(7) ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IF, - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screens - - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - - IF (.NOT.PAGING) THEN - DISPLAY = (NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2, - ELSEe - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2,PAGE_LENGTH-4) - ! If more entries than page size, truncate output - END IF - - DO I=FOLDER_COUNT,FOLDER_COUNT+(DISPLAY-2)/NLINE-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER_COM)a - DIFF = COMPARE_BTIMd - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THENI - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,)s - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counterD - END DOY - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0.E - ELSEI - WRITE(6,1010) ! Else say there are moreW - END IFF - - RETURNF - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12)M -1010 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -CW -C FUNCTION: Set access on folder for specified ID.X -CE -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny accessL -CL - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC'L - - INCLUDE 'BULLUSER.INC'W - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT' - - CHARACTER ID*25,RESPONSE*1L - - IF (CLI$PRESENT('ALL')) THENE - ALL = .TRUE. - ELSEE - ALL = .FALSE.$ - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE.n - ELSE - READONLY = .FALSE. - END IFF - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder nameE - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN_ - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THEND - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')B - RETURN - END IFE - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',ID,LEN) ! Get ID_ - IF (LEN.GT.25) THENO - WRITE(6,'('' ERROR: ID name must be < 26 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_FILE(7) ! Open folder file - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER)R - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP ! See if it existsD - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMITL - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_FILE(7)= - - IF ((.NOT.ALL).AND.(ID.EQ.FOLDER1_OWNER)) THEN - WRITE (6,'(I - & '' ERROR: Cannot modify access for owner of folder.'')')R - RETURN - END IFG - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,F - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSEO - FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))// - & FOLDER1d - CALL CHKACLE - & (FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENE - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THENf - WRITE (6,'('' Folder access was not changed.'')')1 - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)a - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)F - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')')X - GOTO 100 - END IF - END IF - END IF - IF (ACCESS) THEN - IF (.NOT.ALL) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSEE - CALL ADD_ACL(ID,'R+W',IER)' - END IFe - ELSE - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSET - CALL DEL_ACL(' ','R+W',IER) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IFN - END IFD - ELSE - IF (ALL) THEN - CALL DEL_ACL('*','R',IER) - ELSEH - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IFL - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' ERROR: Cannot modify ACL of folder files.'')') - CALL SYS_GETMSG(IER)M - ELSE - WRITE (6,'('' Access to folder has been modified.'')')I -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - CALL OPEN_FILE(7) ! Open folder fileE - READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F1_NBULL,F1_NEWEST_BTIM,DUMMY,F1_EXPIRE_LIMITE - REWRITE (7,FMT=FOLDER_FMT,IOSTAT=IER)I - & FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIPI - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB, - & ,F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT - CALL CLOSE_FILE(7) - END IFo - END IF - END IF - - RETURNN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL)N -CI -C SUBROUTINE CHKACL -CF -C FUNCTION: Checks ACL of given file. -CI -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file.G -CP - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAMEA - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)'C - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THENf - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURNu - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -Co -C SUBROUTINE CHECK_ACCESS -Cs -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -CR -C NOTE: SYS$CHECK_ACCESS is only available under V4.4 or later. -C If you have an earlier version, comment out the lines which call -C it and set both READ_ACCESS and WRITE_ACCESS to 1, which willC -C allow program to run, but will not allow READONLY access feature.e -Co - - IMPLICIT INTEGER (A-Z)e - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1R - WRITE_ACCESS = 1 - RETURN - END IF' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))+ - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(1:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - END IFr - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(1:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF' - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME)A -CG -C SUBROUTINE SHOWACLN -CF -C FUNCTION: Shows users who are allowed to read private bulletin. -CO -C PARAMETERS: -C FILENAME - Name of file to check.t -Cs - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME+ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))E - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,), - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN0 - END - diff --git a/decus/vax87d/bulletin/bulletin5.for b/decus/vax87d/bulletin/bulletin5.for deleted file mode 100644 index 21c073e..0000000 --- a/decus/vax87d/bulletin/bulletin5.for +++ /dev/null @@ -1,1300 +0,0 @@ -From: HENRY::IN%"MRL%PFC-VAX.MIT.EDU%xx.lcs.mit.edu%zermatt.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 13-DEC-1987 08:50 -To: MHG , -Subj: BULLETIN5.FOR - -C -C BULLETIN5.FOR, Version 12/10/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_FILE_SHARED(4) - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEYEQ=TEMP_USER,IOSTAT=IER) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG, - & BRIEF_FLAG,NOTIFY_FLAG ! Find if there is an entry - END DO - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_FILE_SHARED(4) - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEYEQ=TEMP_USER,IOSTAT=IER) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG, - & BRIEF_FLAG,NOTIFY_FLAG ! Find if there is an entry - END DO - - CALL SYS_BINTIM('5-NOV-2956',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).EQ.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER UAF$V_DISACNT = 4, UAF$L_UIC = '24'X - PARAMETER UAF$L_ACCOUNT = 53 - PARAMETER UAF$L_FLAGS = '1D4'X - PARAMETER INPUT_LEN = UAF$L_FLAGS + 4 - - CHARACTER INPUT*(INPUT_LEN),USERNAME*(*),ACCOUNT*(*) - - EQUIVALENCE (INPUT(UAF$L_UIC+1:),USER2) - EQUIVALENCE (INPUT(UAF$L_UIC+3:),GROUP2) - EQUIVALENCE (INPUT(UAF$L_FLAGS+1:),FLAGS2) - - INTEGER*2 USER2,GROUP2 - - CALL OPEN_FILE_SHARED(8) - - READ (8,KEY=USERNAME,IOSTAT=IER) INPUT - ! Move pointer to top of file - - CALL CLOSE_FILE(8) - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - ELSE - FLAGS = FLAGS2 - IER = 1 - USER = USER2 - GROUP = GROUP2 - ACCOUNT = INPUT(UAF$L_ACCOUNT:UAF$L_ACCOUNT+7) - END IF - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,NEWEST_BTIM, ! Get newest bulletin - & BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - CALL CLOSE_FILE(4) - NEEDPRIV(1) = NEW_FLAG(1) - NEEDPRIV(2) = NEW_FLAG(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P) - & ,LIBRARY,,LIB$GET_INPUT) - - RETURN - END - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUSc - - END - - - - INTEGER FUNCTION REC_LOCK(IER)M - - INCLUDE '($FORIOSDEF)'H - - DATA INIT /.TRUE./p - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSEo - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0r - INIT = .TRUE. - END IF - END IFm - - RETURN. - END - - INTEGER FUNCTION TRIM(INPUT)E - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURNe - END DOt - RETURNn - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGEC - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE CLOSE_FILE(INPUT) -C' -C SUBROUTINE CLOSE_FILE -Cp -C FUNCTION: To close out the bulletin files and enable CTRL-C & -YV -CE -C INPUT:, -C INPUT - Unit number of file to close out. -C 1 = BULLETIN.DAT -C 2 = BULLDIR.DAT -C 4 = BULLUSER.DAT) -C 7 = BULLFOLDER.DAT -C 8 = SYS$SYSTEM:SYSUAF.DAT -CL - - CALL ENABLE_CTRLE - - CLOSE (UNIT=INPUT)i - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE(INPUT) - - IMPLICIT INTEGER (A-Z) - - CALL ENABLE_CTRLA - - CLOSE (UNIT=INPUT,STATUS='DELETE')U - - RETURNL - END - - - SUBROUTINE OPEN_FILE(INPUT) - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLUSER.INC'F - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - EXTERNAL BULLDIR_ERR,BULLETIN_ERR,BULLUSER_ERR,BULLFOLDER_ERR - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2)d - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - IF (TIMEEFN.EQ.0) CALL LIB$GET_EF(TIMEEFN)B - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (INPUT.EQ.2) THENs - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))) - & //'.BULLDIR',STATUS='UNKNOWN',IOSTAT=IER, - & RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',' - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED')C - IF (IER.EQ.FOR$IOS_INCRECLEN) THENL - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - END IFR - END DO - END IF_ - - IF (INPUT.EQ.1) THENE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,)r - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THENN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - END IF, - END DO - END IFE - - IF (INPUT.EQ.4) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR,)' - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16,M - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,U - & KEY=(1:12:CHARACTER))' - IF (IER.EQ.FOR$IOS_FILNOTFOU) THENS - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN',* - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER,NEWEST_BTIM,I - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1)r - CALL CONVERT_USERFILE - END IFS - END DO - END IF - - IF (INPUT.EQ.7) THENE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLFOLDER_ERR,)N - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,B - & KEY=(1:25:CHARACTER,26:29:INTEGER))1 - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM'F - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',T - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER1) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIPI - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,0,0 - END IF - END IFL - - IF (IER.NE.0) THENL - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)R - CALL SYS_GETMSG(IER1)C - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXITC - END IFI - - IER = SYS$CANTIM(,) ! Successful, so cancel timer. - - RETURN' - END - - SUBROUTINE TIMER_ERRR - - IMPLICIT INTEGER (A-Z)E - - ENTRY BULLDIR_ERR - WRITE(6,'('' ERROR: Unable to open directory file after 30 secs.'')') - GO TO 10_ - - ENTRY BULLETIN_ERR - WRITE(6,'('' ERROR: Unable to open message file after 30 secs.'')') - GO TO 10t - - ENTRY BULLUSER_ERR& - WRITE(6,'('' ERROR: Unable to open BULLUSER.DAT after 30 secs.'')') - GO TO 10E - - ENTRY BULLFOLDER_ERR - WRITE(6,'('' ERROR: Unable to open BULLFOLDER.DAT after 30 secs.'')') - GO TO 10E - -10 CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC'Z - - INCLUDE 'BULLUSER.INC'O - - EXTERNAL LNM_MODE_EXECU - - CALL DISABLE_CTRL - - IF (INPUT.EQ.2) THENP - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))E - & //'.BULLDIR',STATUS='OLD',f - & RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',U - & SHARED,IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0i - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - END IFI - END DO - END IF - - IF (INPUT.EQ.1) THENT - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))t - & //'.BULLFIL',STATUS='OLD',C - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED) - IF (IER.EQ.FOR$IOS_INCRECLEN) THENE - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILEp - END IFs - END DO - END IF - - IF (INPUT.EQ.4) THENS - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & IOSTAT=IER,FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THENt - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILEI - END IFA - END DO - END IFU - - IF (INPUT.EQ.7) THENC - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',A - & RECORDSIZE=FOLDER_RECORD,IOSTAT=IER,U - & FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THENN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDERF - END IFR - END DO - END IF - - IF (INPUT.EQ.8) THENT - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC). - END DO - END IF. - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.INPUT.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)T - CALL OPEN_FILE(INPUT)R - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)A - CALL SYS_GETMSG(IER1)G - CALL ENABLE_CTRL_EXITI - END IFG - - RETURN( - END - - - - - SUBROUTINE CONVERT_BULLFILESB -CT -C SUBROUTINE CONVERT_BULLFILESB -CT -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletine -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs).L -CE - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 INPUT - - WRITE (6,'('' Converting data files to new format. Please wait.'')')L - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',L - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',$ - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) THEN ! Error. Why?_ - CALL ERRSNS(IDUMMY,IER)T - CALL SYS_GETMSG(IER) - CALL EXITN - END IF2 - - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD',L - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)) - - IF (IER.NE.0) THEN ! Error. Why?E - CALL ERRSNS(IDUMMY,IER)U - CALL SYS_GETMSG(IER) - CALL EXIT) - END IF& - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)E - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)D - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))' - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))_ - & //'.BULLDIR',STATUS='NEW',$ - & RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',L - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & IOSTAT=IER) - - NEWEST_EXTIME = '00:00:00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIMEN - NEMPTY = 0M - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00' - ICOUNT = 2E - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCKF - IF (IER.EQ.0) THEN - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT - END DOM - CALL WRITEDIR(ICOUNT-1,IER1)I - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9)N - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1)T - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionR - RETURN= - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8), -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C4 -C SUBROUTINE CONVERT_BULLFILE -CT -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 INPUT,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')')E - - CALL CLOSE_FILE(2) - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)I - - CALL OPEN_FILE(7) - -100 READ (7,FMT=FOLDER_FMT,ERR=200)N - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER))E - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY): - - IF (IER.NE.0) THEN ! Error. Why?E - CALL ERRSNS(IDUMMY,IER)1 - CALL SYS_GETMSG(IER) - CALL EXITR - END IFI - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)), - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER,N - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,n - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE)L - - CALL OPEN_FILE(2) - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER)B - NBLOCK = NBLOCK + 1P - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1' - READ(10'J,'(A)') INPUTt - LEN = TRIM(INPUT) - IF (LEN.EQ.0) LEN = 1 - CALL STORE_BULL(LEN,INPUT,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1)U - - CALL CLOSE_FILE(2)e - GOTO 100G - -200 CALL OPEN_FILE_SHARED(2) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionN - - RETURND - - END - - - - SUBROUTINE CONVERT_BULLFOLDER -C' -C SUBROUTINE CONVERT_BULLFOLDER -C. -C FUNCTION: Converts bulletin folder file to new format.C -C - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'O - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'E - - CHARACTER*80 NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')')P - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - - EODIR = MAX(INDEX(BULLFOLDER_FILE,':'),INDEX(BULLFOLDER_FILE,']')) - SUFFIX = INDEX(BULLFOLDER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLFOLDER_FILE(:SUFFIX)//'OLD'. - IER = LIB$RENAME_FILE(BULLFOLDER_FILE,NEW_FILE) - - DO WHILE (FILE_LOCK(IER,IER1))L - OPEN (UNIT=7,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',= - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO) - - IF (IER.NE.0) THEN ! Error. Why? - CALL ERRSNS(IDUMMY,IER)E - CALL SYS_GETMSG(IER) - CALL EXITT - END IFE - - OPEN (UNIT=9,FILE=BULLFOLDER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',& - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE')R - - IF (IER.NE.0) THEN ! Error. Why?I - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL EXITp - END IFD - - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)= - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPR - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER))) - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0)A - END IF - CALL OPEN_FILE_SHARED(2)' - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN= - IF (NBULL.GT.0) THEN' - CALL READDIR(NBULL,IER)Y - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF= - END IFI - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)D - WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBN - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0A - CALL CLOSE_FILE(2)E - F_NUMBER = F_NUMBER + 1 - END IF - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=9,STATUS='SAVE')N - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURNr - END - - SUBROUTINE CONVERT_USERFILE -CR -C SUBROUTINE CONVERT_USERFILE -C) -C FUNCTION: Converts user file to new format which has 8 bytes added. -C( - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIMEm - - WRITE (6,'('' Converting data files to new format. Please wait.'')')e - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'U - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',n - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL)I - - IF (IER.EQ.0) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)S - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IFL - - IF (IER.NE.0) THENP - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)R - CALL SYS_GETMSG(IER1)y - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXIT - END IFP - - DO I=1,FLONGE - NEW_FLAG(I) = 'FFFFFFFF'Xo - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0U - SET_FLAG(I) = 0E - END DOO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0R - DO WHILE (IER.EQ.0), - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THENE - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23)C - LOGIN_TIME = BUFFER(24:31)T - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))D - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,' - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFP - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flagI - DO WHILE (IER.EQ.0)e - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,y - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THENI - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFe - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9)D - CLOSE (UNIT=4)_ - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionO - - RETURNL - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIRU -CR -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -CI -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS:L -C ICOUNT - The last record read by this routine. -CP - - IMPLICIT INTEGER (A - Z)S - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'A - - COMMON /PROMPT/ COMMAND_PROMPTE - CHARACTER*39 COMMAND_PROMPT - - CHARACTER*2 CFOLDER_NUMBERS - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (2'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - END DO - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_FILE(2)E - CALL OPEN_FILE(2) - CALL CLEANUP_DIRFILE(1) - END IFB - IF (NEMPTY.EQ.' ') NEMPTY = 0N -CC -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also checkU -C to see if cleanup was in progress but didn't properly finish. -CE - IF (NEMPTY.GT.200.AND..NOT.TEST_BULLCP()) THENL - WRITE (CFOLDER_NUMBER,'(I2)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX(( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP')E - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IFO - END IF - ELSE' - DO WHILE (REC_LOCK(IER)) - READ(2'ICOUNT+1,1010,IOSTAT=IER)n - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCK - END DO - END IFC - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - RETURN' - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4)E -1010 FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4)e - - END - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C0 -C SUBROUTINE WRITEDIR -CR -C FUNCTION: Writes the entry for the specified bulletin in theS -C directory file.O -CR -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.I -C If 0, write the header of the directory file. -C OUTPUTS:D -C IER - Error status from WRITE. -CP - - IMPLICIT INTEGER (A - Z)U - - INCLUDE 'BULLDIR.INC' - S - IF (BULLETIN_NUM.EQ.0) THEN - WRITE (2'1,1000,IOSTAT=IER) NEWEST_EXDATE,NEWEST_EXTIME, - & NEWEST_DATE,NEWEST_TIME,A - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTYy - ELSE - WRITE(2'BULLETIN_NUM+1,1010,IOSTAT=IER)( - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCKS - END IFW - - RETURN - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4)& -1010 FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4) - - END - - - A - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACLR -C: -C FUNCTION: Reads the ACL of a file.I -CN -C PARAMETERS: -C FILENAME - Name of file to check.I -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*)I - CHARACTER NOT_ID*3F - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - DO ACCESS_TYPE=1,2& - POINT = 1E - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER). - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - IF ((ACCESS_TYPE.EQ.1.AND.INDEX(ACLSTR,'WRITE').GT.0).OR.W - & (ACCESS_TYPE.EQ.2.AND.INDEX(ACLSTR,'READ)').GT.0)) THENR - START_ID = INDEX(ACLSTR,'=') + 1A - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - DO WHILES - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0)A - START_ID = START_ID - 1_ - END DOE - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN& - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF+ - END IF - IF (OUTLEN.EQ.0) THEN - IF (ACCESS_TYPE.EQ.1) THEN - WRITE (6,'(_ - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(Y - & '' These users can only read this folder:'')') - END IF - OUTLEN = 1O - END IFS - LEN = END_ID - START_ID + 1 - IF (OUTLEN+LEN-1.GT.80) THENr - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)e - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = LEN + 2 - ELSE IF (OUTLEN+LEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)N - OUTLEN = 1 - ELSEC - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + LEN + 1 - END IFU - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)L - END DO_ - - RETURNE - END - diff --git a/decus/vax87d/bulletin/bulletin6.for b/decus/vax87d/bulletin/bulletin6.for deleted file mode 100644 index deba151..0000000 --- a/decus/vax87d/bulletin/bulletin6.for +++ /dev/null @@ -1,1431 +0,0 @@ -From: HENRY::IN%"MRL%PFC-VAX.MIT.EDU%xx.lcs.mit.edu%zermatt.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 13-DEC-1987 08:46 -To: MHG , -Subj: BULLETIN6.FOR - -C -C BULLETIN6.FOR, Version 11/16/87 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - INCLUDE '($SSDEF)' - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - CHARACTER OUTPUT*160,TERMINAL*8 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_FILE_SHARED(4) - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) - & TEMP_USER,TEMP_BTIM,BBOARD_BTIM,NEW_FLAG, - & SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_FILE(4) - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,FMT=USER_FMT) TEMP_USER,NEWEST_BTIM,BBOARD_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - -C -C Set flags in all user entries that have SET READNEW on the particular -C folder to indicate that a new bulletin is present for the particular folder. -C Also send broadcast if notify flag set. -C - OUTPUT = BELL//CR//LF//LF//'New bulletin added to folder '// - & FOLDER(1:TRIM(FOLDER))//'. From: '//FROM(1:TRIM(FROM))// - & CR//LF//'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IF (ADD_BULL) THEN - IF (FOLDER_NUMBER.GT.0) THEN - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - END IF - - IF (ADD_BULL) THEN - IER = 1 - DO WHILE (GETUSERS(TEMP_USER,TERMINAL)) - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,IOSTAT=IER,KEY=TEMP_USER) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG - END DO - IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TERMINAL(:TRIM(TERMINAL)),%VAL(BRK$C_DEVICE),,,,,,,) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END IF - END DO - END IF - - DO WHILE (REC_LOCK(IER)) - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG - ! Reobtain present values as calling programs still uses them - END DO - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_FILE(4) - - RETURN - - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 TODAY_TIME - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:20) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*3600 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*8 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:20) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to closet -C the file as soon as possible. -C. -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second containsg -C the address. The address is simply the address of the 3rd word ofL -C the record. The last word in the record contains the address of theL -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. ' -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -CU -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA)w - CHARACTER*(*) DATA - IF (HEADER.NE.0) RETURN ! Queue already initialized_ - LENGTH = LEN(DATA)T - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LENGTH) - RETURNN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA)b - INTEGER RECORD(1) - CHARACTER*(*) DATAd - LENGTH = LEN(DATA). - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD)))r - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),LENGTH) - RECORD((LENGTH+12)/4) = NEXTb - RETURNe - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = LEN(DATA)E - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - NEXT = RECORD((LENGTH+12)/4)D - RETURN_ - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHARE - OUTCHAR = INCHAR(:LENGTH) - RETURNN - END - - SUBROUTINE MAKE_CHAR(IARRAY,LEN)A - DIMENSION IARRAY(1) - IARRAY(1) = LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(LEN/4+3) = 0 - RETURNS - END - - - - SUBROUTINE DISABLE_PRIVS, -C_ -C SUBROUTINE DISABLE_PRIVS -CD -C FUNCTION: Disable SYSPRV privileges.i -Ct - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - SETPRV(1) = 0 - SETPRV(1) = IBSET(SETPRV(1),PRV$V_SYSPRV) - SETPRV(1) = IBSET(SETPRV(1),PRV$V_WORLD)l - SETPRV(1) = IBSET(SETPRV(1),PRV$V_OPER) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable SYSPRV - - RETURN/ - END - - - - SUBROUTINE ENABLE_PRIVS -C) -C SUBROUTINE ENABLE_PRIVS -CF -C FUNCTION: Enable SYSPRV privileges. -CA - - IMPLICIT INTEGER (A-Z)T - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable SYSPRV C - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -CD -C SUBROUTINE CHECK_PRIV_IO_ -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -CR - - IMPLICIT INTEGER (A-Z)C - - CALL DISABLE_PRIVS ! Disable SYSPRV O - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE')G - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200)C - ERROR = 1 - ELSEL - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0_ - END IF. - - CALL ENABLE_PRIVS ! Enable SYSPRV A - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')I - - RETURN/ - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG)A -CR -C SUBROUTINE CHANGE_FLAG -CL -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag.E -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z)U - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'M - - INCLUDE 'BULLFOLDER.INC'B - - DIMENSION FLAGS(FLONG,4)Y - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))c - - LOGICAL CMD - - CHARACTER*23 TODAYD - DIMENSION READ_BTIM_SAVE(2) - -CE -C Find user entry in BULLUSER.DAT to update information.E -C - - CALL OPEN_FILE_SHARED(4) ! Open user fileD - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2)e - - DO WHILE (REC_LOCK(IER)) ! Read old entryI - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,T - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DOT - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS$ASCTIM(,TODAY,,) - CALL SYS_BINTIM(TODAY,LOGIN_BTIM): - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry0 - READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) TEMP_USER - & NEWEST_BTIM,BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,E - & NOTIFY_FLAG - IF (CMD) THENI - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)A - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)_ - END IF - NEW_FLAG(1) = 143L - NEW_FLAG(2) = 0= - WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)R - END IF - NEW_FLAG(1) = 143T - REWRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME, ! Write modified entryN - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAGT - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IFT - - CALL CLOSE_FILE (4) - RETURNi - - END - - - - - SUBROUTINE SET_VERSIONo -Ct -C SUBROUTINE SET_VERSION -Cu -C FUNCTION: Sets version number. -CE - IMPLICIT INTEGER (A - Z)B - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'2 - - INCLUDE 'BULLFOLDER.INC'T - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))R - - LOGICAL CMD - - CHARACTER*23 TODAYD - DIMENSION READ_BTIM_SAVE(2) - -CE -C Find user entry in BULLUSER.DAT to update information.N -CO - - CALL OPEN_FILE_SHARED(4) ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1)Z - READ_BTIM_SAVE(2) = READ_BTIM(2) - - DO WHILE (REC_LOCK(IER)) ! Read old entry$ - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,0 - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DOR - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143A - REWRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME, ! Write modified entry - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG, - & NOTIFY_FLAG - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IFt - - CALL CLOSE_FILE (4) - RETURNt - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -Cv -C SUBROUTINE CONFIRM_PRIV -CZ -C FUNCTION: Confirms that given username has SETPRV. -C -C INPUTS: -C USERNAME - UsernameC -C OUTPUTS:A -C ALLOW - Returns 1 if account has SETPRV.L -C returns 0 if account has no SETPRV.L -CS - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME_ - - INCLUDE '($PRVDEF)' - - PARAMETER UAF$Q_DEF_PRIV = '1A4'X - - LOGICAL*1 UAF(0:583)P - EQUIVALENCE (UAF(UAF$Q_DEF_PRIV),UAF_DEF_PRIV)I - - CALL OPEN_FILE_SHARED(8)t - ALLOW = 0 ! Set return falseu - READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Record - IF (STATUS.EQ.0) THEN ! If username found - IF (BTEST(UAF_DEF_PRIV,PRV$V_SETPRV).OR. ! SETPRV or CMRKNLt - & BTEST(UAF_DEF_PRIV,PRV$V_CMKRNL)) THEN ! privileges? - ALLOW = 1 ! Yep - END IF - END IF2 - CALL CLOSE_FILE(8)T - RETURN ! Return2 - END ! End - - - - - - SUBROUTINE CHECK_DISMAIL(USERNAME,DISMAIL)E -C: -C SUBROUTINE CHECK_DISMAILE -C -C FUNCTION: Checks that given username has DISMAIL. -CH -C INPUTS: -C USERNAME - Username6 -C OUTPUTS:E -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C - - IMPLICIT INTEGER (A-Z)C - - CHARACTER*(*) USERNAME - - PARAMETER UAF$V_DISMAIL = '7'XA - PARAMETER UAF$L_FLAGS = '1D4'X - - LOGICAL*1 UAF(0:583)C - EQUIVALENCE (UAF(UAF$L_FLAGS),UAF_L_FLAGS)- - - CALL OPEN_FILE_SHARED(8)- - DISMAIL = 0 ! Set return false - READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Recordi - IF (STATUS.EQ.0) THEN ! If username foundd - IF (BTEST(UAF_L_FLAGS,UAF$V_DISMAIL)) THEN ! DISMAIL SET?l - DISMAIL = 1 ! Yepb - END IF - END IFf - CALL CLOSE_FILE(8)l - RETURN ! Returni - END ! Endh - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z)r - - CHARACTER*(*) INPUT,OUTPUTc - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemliste - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - - RETURN - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1)e - - IMPLICIT INTEGER (A-Z)a - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./t - - IF (INIT) THEN, - FILE_LOCK = 1k - INIT = .FALSE. - ELSEc - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)- - IF (IER1.EQ.RMS$_FLK) THEN- - FILE_LOCK = 1 - ELSEA - FILE_LOCK = 0) - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IFA - - RETURNE - END - - - - SUBROUTINE ENABLE_CTRLO - - IMPLICIT INTEGER (A-Z)X - - COMMON /CTRLY/ CTRLY( - - COMMON /CTRL_LEVEL/ LEVEL - - QUIT = 1A - - ENTRY ENABLE_CTRL_EXITD - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF/ - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IFR - - IF (QUIT.EQ.0) THEN - CALL UPDATE_USERINFO - CALL EXITR - END IFA - QUIT = 0 ! Reinitialize - - RETURNR - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z)C - - COMMON /CTRLY/ CTRLYA - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURNR - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -CI -C FUNCTION: Searches for empty space in bulletin file and deletes it.S -CR - IMPLICIT INTEGER (A - Z)I - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - CHARACTER FILENAME*132,INPUT*128= - - CALL OPEN_FILE_SHARED(2)) - -CT -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -CV - - DO WHILE (REC_LOCK(IER))S - READ (2'1,1000,IOSTAT=IER) S - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - END DOM - - FILENAME = FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL' - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_FILE(2) - RETURN - ELSE IF (NEMPTY.GT.0) THENN - - IER = LIB$RENAME_FILE(FILENAME,FILENAME(1:TRIM(FILENAME))//';2') - ! Rename old file name to version number 2 - - IF (.NOT.IER) RETURN - - OPEN (UNIT=11,FILE=FILENAME(1:TRIM(FILENAME))//';1', - 1 STATUS='UNKNOWN',IOSTAT=IER,N - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - ! Compressed version is number 1 - - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTHP - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) INPUT - END DOb - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100T - END IF - WRITE(11) INPUT - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_FILE(1)F - CLOSE (UNIT=11) - - NEMPTY = -1 ! Copying done, but not directory updating. - DO WHILE (REC_LOCK(IER)) - WRITE (2'1,1000,IOSTAT=IER) ! Write new directory header' - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - END DO - END IFG - - IER = LIB$DELETE_FILE(FILENAME(1:TRIM(FILENAME))//';2') - ! Can safely delete old file, since NEMPTY = -1e - - FILENAME = FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLDIR' - - OPEN (UNIT=12,FILE=FILENAME(1:TRIM(FILENAME)),_ - 1 STATUS='NEW',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',I - 1 ORGANIZATION='RELATIVE',FORM='FORMATTED') - - WRITE (12'1,1000,IOSTAT=IER) ! Write directory header - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULLE - CALL READDIR(I,IER)E - BLOCK = NBLOCK + 1 - WRITE (12'I+1,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCK - NBLOCK = NBLOCK + LENGTH - END DO1 - - DO WHILE (REC_LOCK(IER))L - READ (2'1,1000,IOSTAT=IER) ! Read directory header - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - END DOW - - NEMPTY = 0B - WRITE (12'1,1000,IOSTAT=IER) ! Write directory header - & NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - - CLOSE (UNIT=12,STATUS='KEEP') - CALL CLOSE_FILE(2)A - - IER = LIB$DELETE_FILE(FILENAME(1:TRIM(FILENAME))//';-1')M - ! Delete old directory file - - IER = LIB$RENAME_FILE(FILENAME,FILENAME(1:TRIM(FILENAME))//';') - ! Rename old file name to minimize version number - -1000 FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4) - - RETURNT - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)B -C -C SUBROUTINE CLEANUP_DIRFILEU -C' -C FUNCTION: Reorder directory file after deletions.I -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting processr -C was abnormally terminated. -C4 - IMPLICIT INTEGER (A - Z)A - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL)T - CALL READDIR(I,IER)m - IF (IER.NE.I+1) THEN ! Have we found a deleted entry?E - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in fileA - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entriesa - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN1 - END IF - LENGTH = -LENGTH ! Indicate starting point by writingI - CALL WRITEDIR(I,IER) ! next entry into deleted entryE - FIRST_DELETE = I ! with negative lengthX - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletionU - FIRST_DELETE = I ! was previously in progressn - J = I ! Try to find where entry came from - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)_ - BLOCK_SAVE = BLOCK - K = J + 1 ! Search for duplicate entries - DO WHILE (MOVE_FROM.EQ.0.AND.K.LE.NBULL) - CALL READDIR(K,IER)D - IF (IER.EQ.K+1) THEN - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO=J+1 - MOVE_FROM=K+1 - ELSEC - K = K + 1 - END IFM - END IF - END DOS - J = J + 1 ! If no duplicate entry found for this - CALL READDIR(J,IER) ! entry, see if one exists for anya - END DO ! of the other entries - END IF - I = I + 1R - END DON - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessaryS - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL$ - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF0 - END DOu - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of fileT - DELETE(UNIT=2,REC=J+1,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - CALL READDIR(FIRST_DELETE,IER) - LENGTH = -LENGTH ! Fix entry which has negative lengthA - CALL WRITEDIR(FIRST_DELETE,IER)A - END IFN - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -CT -C SUBROUTINE SHOW_FLAGS -C% -C FUNCTION: Show user flags.T -CN - IMPLICIT INTEGER (A - Z)i - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'I - - INCLUDE 'BULLFOLDER.INC' - -CT -C Find user entry in BULLUSER.DAT to obtain flags.T -C - - CALL OPEN_FILE_SHARED(4) ! Open user filea - - DO WHILE (REC_LOCK(IER)) ! Read old entryt - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,. - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END DOR - - WRITE (6,'('' For the selected folder '',A)') FOLDER(1:TRIM(FOLDER))I - L - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEND - WRITE (6,'('' NOTIFY is set.'')') - END IF - - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND.D - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THENT - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (.NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - CALL CLOSE_FILE(4) - - RETURNR - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z)T - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1))E - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER)R - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1))e - - RETURNe - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))N - - RETURNU - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL)e -CA -C FUNCTION GETUSERS -Ci -C FUNCTION: -C To get names of all users that are logged in. -CC - - IMPLICIT INTEGER (A-Z), - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) USERNAME,TERMINAL - - DATA WILDCARD /-1/ - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistE - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,)1 - ! Get next process.K - END DOT - - IF (.NOT.IER) WILDCARD = -1 - - GETUSERS = IERE - - RETURN1 - END - - - - - - SUBROUTINE OPEN_USERINFOd -Cr -C SUBROUTINE OPEN_USERINFOE -CI -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -Cb - IMPLICIT INTEGER (A - Z)A - - INCLUDE 'BULLUSER.INC'U - - INTEGER NEW_BTIM(2) - - COMMON /USERINFO/ READ_IN - DATA READ_IN /.FALSE./C - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)I - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)h - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN (UNIT=9,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD',U - & RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2,SHARED,t - & FORM='UNFORMATTED',IOSTAT=IER)( - - IF (IER.NE.0) THENW - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM)E - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - OPEN (UNIT=9,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD',N - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER)/ - INQUIRE (UNIT=9,RECORDSIZE=RECL,IOSTAT=IER) - RECL = RECL/8 - IF (IER.EQ.0) THEN_ - READ (9,IOSTAT=IER) ((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - END IFS - IF (IER.EQ.0) THENO - DO I=RECL+1,FOLDER_MAX - LAST_READ_BTIM(1,I) = NEW_BTIM(1) - LAST_READ_BTIM(2,I) = NEW_BTIM(2) - END DO - CLOSE (UNIT=9,STATUS='DELETE') - OPEN (UNIT=9,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='NEW', - & RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2, - & FORM='UNFORMATTED',IOSTAT=IER)D - END IF - END IF - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='NEW',I - & RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2,K - & FORM='UNFORMATTED',IOSTAT=IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - DO WHILE (REC_LOCK(IER1)) - READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER1) USERNAME, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,d - & NOTIFY_FLAG ! Find user's info - END DOT - CALL CLOSE_FILE(4)S - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO( - END IF - IF (IER.EQ.0) THEN - WRITE (9) LAST_READ_BTIM= - ELSE - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: SYS$LOGIN:BULLETIN.INF cannot be opened.'')') - CALL SYS_GETMSG(IER), - END IF - ELSE5 - READ (9) LAST_READ_BTIM - END IFR - - CLOSE (UNIT=9)S - - READ_IN = .TRUE.F - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionN - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURNc - END - - - - SUBROUTINE UPDATE_USERINFOr -C -C SUBROUTINE UPDATE_USERINFOt -Ct -C FUNCTION: Updates the latest message read times for each folder. -Cd - IMPLICIT INTEGER (A - Z)a - - INCLUDE 'BULLUSER.INC'4 - - COMMON /USERINFO/ READ_IN - - IF (.NOT.READ_IN) RETURN - - OPEN (UNIT=9,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2,SHARED,t - & FORM='UNFORMATTED',IOSTAT=IER)d - - IF (IER.EQ.0) THENe - WRITE (9) LAST_READ_BTIM - CLOSE (UNIT=9) - ELSEt - CALL ERRSNS(IDUMMY,IER)O - WRITE (6,'(U - & '' ERROR: SYS$LOGIN:BULLETIN.INF cannot be opened.'')') - CALL SYS_GETMSG(IER) - END IFV - - RETURNI - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z)l - - INTEGER BTIM(2) - - CHARACTER*(*) TIMEE - - IF (TRIM(TIME).EQ.20) THEN) - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM)1 - ELSE - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -Cb -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -CR -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit.e -Ci - - IMPLICIT INTEGER (A-Z)0 - - INCLUDE 'BULLFOLDER.INC'o - - INCLUDE 'BULLUSER.INC'T - - COMMON /READIT/ READITl - - COMMON /POINT/ BULL_POINT - - CALL UPDATE_READ ! Update login time - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURNa - END IFs - - CALL OPEN_FILE_SHARED(7) ! Go find folders - - DO FOLDER_NUMBER = 0,FOLDER_MAX - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND.= - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(0,3) - CALL SET_VERSIONa - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THENE - DO WHILE (REC_LOCK(IER))e - READ (7,FMT=FOLDER_FMT,KEY=FOLDER_NUMBER,O - & KEYID=1,IOSTAT=IER)A - & FOLDER,FOLDER_NUMBER_DUMMY,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMITM - END DO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),J - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messagesR - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DOS - - CALL CLOSE_FILE(7)N - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - DO FOLDER_NUMBER = 1,FOLDER_MAX - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_MSG,FOLDER_NUMBER) - END IF - ELSE ! Can't select the folder - CALL CHANGE_FLAG(0,2) ! then clear SET_FLAG - CALL CLR2(NEW_MSG,FOLDER_NUMBER) - END IF - END IF - END DO - FOLDER_NUMBER = 0I - CALL SELECT_FOLDER(.FALSE.,IER)D - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THENs - WRITE(6,'('' Type READ to read new general messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0)t - NEW_COUNT = NEW_COUNT / 10F - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins, - ELSEI - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)I - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) - END IFE - END IF - ELSE ! READNEW mode. - DO FOLDER_NUMBER = 0,FOLDER_MAXI - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THENR - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),T - & F_NEWEST_BTIM)B - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERG - IF (BULL_POINT.NE.-1) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.g - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (FOLDER_NUMBER.GT.0) THEN - WRITE (6,'('' There are new messages in folder '',D - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE IF (FOLDER_NUMBER.EQ.0.OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THENL - SAVE_BULL_POINT = BULL_POINTN - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORYE - BULL_POINT = SAVE_BULL_POINTc - END DO - END IFI - END IF - ELSEI - CALL CLR2(NEW_MSG,FOLDER_NUMBER) - END IF - ELSE ! Can't select the folder - CALL CHANGE_FLAG(0,2) ! then clear SET_FLAG - CALL CLR2(NEW_MSG,FOLDER_NUMBER) - END IFI - END IF - END DO - CALL EXIT - END IFt - - RETURNn - END - diff --git a/decus/vax87d/bulletin/bulletinann.txt b/decus/vax87d/bulletin/bulletinann.txt deleted file mode 100644 index 7c7b3cf..0000000 --- a/decus/vax87d/bulletin/bulletinann.txt +++ /dev/null @@ -1,24 +0,0 @@ -From: HENRY::IN%"MRL%PFC-VAX.MIT.EDU%xx.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 13-DEC-1987 08:36 -To: JFISHER , MHG , -Subj: BULLETIN - -There is one major and several minor bugs in V1.44 that I have corrected. -Unless I hear from otherwise, I will be sending out the sources to V1.45 -Friday afternoon. - Mark -------------------------------------------------------------------------- -V1.45 - -Cleanup algorithm was not cleaning up empty blocks in bulletin files. -Bulletin files will grow indefinetly. - -Attempts to add a new message while BULLCP was adding BBOARD message would -result in "unable to open BULLFOLDER.DAT after 30 seconds" error. This -has been fixed. - -SET NOLOGIN feature was not working properly, and has been fixed. - -Folder name abbreviation algorithm changed so that if given letters don't -match any folder name, an error message is returned, rather than selecting -nearest name (the problem with the way it was before is that the nearest -folder name could be very far away, and the user problem doesn't want it). diff --git a/decus/vax88a2/bulletin/aaareadme.1st b/decus/vax88a2/bulletin/aaareadme.1st deleted file mode 100644 index 3e4bebd..0000000 --- a/decus/vax88a2/bulletin/aaareadme.1st +++ /dev/null @@ -1,111 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLFILES.INC must first - be modified before this procedure is run. It contains the names of data files - which BULLETIN creates. It also includes specifications of directories used - by the FOLDER and BBOARD features. (In relation to the FOLDER feature, you - can restrict FOLDER creation to privileged users. See BULLCOM.CLD). - You should also look at BULLFOLDER.INC, as there may be some parameters in - that you may or may not want to modify. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, and wish the RESPOND command to be able - to send messages to the originators of these messages, you must modify - the subroutine RESPOND in BULLETIN2.FOR in order to specify the mail - utility which you use to send mail over those networks. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. (WARNING: Finding the newest unread - message is quicker than finding the oldest unread message. This - is not a problem if the number of messages is small. However, - if you plan on having lots of messages, and your system is heavily - loaded, you may want to avoid /REVERSE. Trial & error is the only - way to find out if this is a problem!) Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - (This is a new feature added as of Version 1.5). - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - -5) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. - -6) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -7) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. diff --git a/decus/vax88a2/bulletin/allmacs.mar b/decus/vax88a2/bulletin/allmacs.mar deleted file mode 100644 index b0ebbb7..0000000 --- a/decus/vax88a2/bulletin/allmacs.mar +++ /dev/null @@ -1,203 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask - MOVL SCH$GL_CURPCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $UAFDEF GLOBAL - .END diff --git a/decus/vax88a2/bulletin/board_digest.com b/decus/vax88a2/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vax88a2/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vax88a2/bulletin/board_special.com b/decus/vax88a2/bulletin/board_special.com deleted file mode 100644 index 1513033..0000000 --- a/decus/vax88a2/bulletin/board_special.com +++ /dev/null @@ -1,107 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vax88a2/bulletin/bull_command.com b/decus/vax88a2/bulletin/bull_command.com deleted file mode 100644 index 4405af2..0000000 --- a/decus/vax88a2/bulletin/bull_command.com +++ /dev/null @@ -1,7 +0,0 @@ -$B:=$PFCVAX$DBC1:[MRL.BULLETIN]BULLETIN.EXE;13 -$ON ERROR THEN GOTO EXIT -$ON SEVERE THEN GOTO EXIT -$ON WARNING THEN GOTO EXIT -$B/'F$PROCESS()' -$EXIT: -$LOGOUT diff --git a/decus/vax88a2/bulletin/bullcom.cld b/decus/vax88a2/bulletin/bullcom.cld deleted file mode 100644 index 6362d47..0000000 --- a/decus/vax88a2/bulletin/bullcom.cld +++ /dev/null @@ -1,312 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 2/1/88 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER BULLETIN_NUMBER - QUALIFIER ORIGINAL - DISALLOW FOLDER AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER RESTART - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,TYPE=$REST_OF_LINE) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER BULLETIN_NUMBER - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW FOLDER AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) diff --git a/decus/vax88a2/bulletin/bullcoms1.hlp b/decus/vax88a2/bulletin/bullcoms1.hlp deleted file mode 100644 index d0e4289..0000000 --- a/decus/vax88a2/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,462 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the folders into which the message is to be added. Does not -change the current selected folder. Folders can be either local or -remote folders. If the the foldername is specified with only a nodename, -i.e. FOO::, the foldername is assumed to be GENERAL. NOTE: Specifying -remote nodes is only possible if that remote node is running a special -BULLCP process. If it isn't, the only way to add messages to that remote -node is via the /NODE command. However, /FOLDER is a much quicker method, -and much more versatile. - -You can specify logical names which translate to one or more folder names. -I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify /NODES= -ALL_FOLDERS. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL - -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See installation -notes). You can specify a different username to use at the other nodes by -either using the USERNAME qualifier, or by specifying the nodename with 2 -semi-colons followed by the username, i.e. nodename::username. If you -specify a username, you will be prompted for the password of the account -on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /PERMANENT -This option is restricted to privileged users for the GENERAL folder, -but available to all in other folders. If specified, message will be a -permanent message and will never expire. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 BACK -Displays the message preceding the current message. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. If the text of the message -is to be changed, a file can be specified which contains the text. -Otherwise, you will be prompted for the text. The expiration info and -header can also be changed. If neither no qualifiers are added to the -command, it is assumed the whole message will be replaced. - - Format: - CHANGE [file-name] -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. This only applies to the GENERAL folder. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number - -Specifies the message number to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically selected -(see information on SELECT command). The commands that can be used to -modify the folder's characteristics are: MODIFY, REMOVE, SET ACCESS, -SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the folder -is stored in a file name created with the folder name). -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /NODE - /NODE=nodename -Specifies that the folder is a remote folder at the specified nodename. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified nodename is checked -to see if a folder of the same name is located on that node. If so, the -folder will point to that folder. This capability is only present if the -BULLCP process is created on the remote node via the BULL/STARTUP command. - -NOTE: If one node add a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -That information is only updated every 15 minutes (same algorithm for -updating BBOARD messages), or if a user accesses that folder. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. By default, -the GENERAL folder is a SYSTEM folder. This is a privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 CURRENT - -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -it's expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message. -It can be a substring of the subject. This is in case you have forgotten -the exact subject that was specified. Case is not critical either. -You will be notified if the deletion was successful. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting messages -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of folder. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. -2 /NEW -Specifies to start the listing of messages with the first unread message. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified. - - Format: - FILE file-name -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 Folders -All messages are divided into separate folders. The default folder is -GENERAL. New folders can be created by any user. As an example, the -following creates a folder for GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that -user will be alerted of topics of new messages at login time, and will -then be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in the -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote DECNET -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP) -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. By default, the GENERAL folder -is a SYSTEM folder (and cannot be changed). One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the GENERAL -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, and -giving access to that UIC group. Only users in that UIC group will see -the messages in that folder when they log in. -1 HELP -To obtain help on any topic, type: - - HELP topic - -CTRL-Y only breaks out of a command when no files are open. Otherwise, -use CTRL-C, which will abort the program. However, unlike CTRL-Y, you -can not resume execution using the VMS CONTINUE command. Also note that -CTRL-C will not abort if BULLETIN is waiting for input from the terminal. -1 INDEX -Gives directory listing of all folders in alphabetical order. If the -INDEX command is re-entered while the listing is in progress, the listing -will skip to the next folder. This is useful for skipping a particular -folder. It also can be used to continue the listing from where one left -off after one has read a message. - - Format: - INDEX -2 /NEW -Specifies to start the listing of each folder with the first unread message. -Otherwise, the listing will start with the first message in the folder. -If the INDEX command is re-entered for continuing the listing, /NEW must -be respecified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name - -The input for the recipient name is exactly the same format as used by -the MAIL utility. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MODIFY -Modifies the database information for the current folder. Only the owner -of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. diff --git a/decus/vax88a2/bulletin/bullcoms2.hlp b/decus/vax88a2/bulletin/bullcoms2.hlp deleted file mode 100644 index 97d7efe..0000000 --- a/decus/vax88a2/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,491 +0,0 @@ -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The PRINT command can take optional qualifiers. - - Format: - - PRINT -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder will -be displayed. However, if there are new messages, the first new message -will be displayed. Each time you enter the command, the next page, or if -there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply hitting -the key is equivalent to "READ". -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged -user can remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. If the owner of the -message is not a valid user, it is assumed that the message was from -a network, and the message is searched for a line starting with "From:". -The username is then extracted from that line, and the necessary mail -routine to send over the network is invoked. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -2 /TEXT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing -the first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header. -If a "search-string" is not specified, a search is made using the -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /START - /START=message_number - -Specifies the message number to start the search at. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default general messages. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id [folder-name] - -The parameter "id" is the id in the system Rights Database to which -access is being affected. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created -by use of ACLs. If a user is able to set his process's privileges -to override ACLs, that user will be able to access the folder even if -access has not been granted via BULLETIN. Also note that if a user -logs in after a private folder has been created but before being -given access, and then is given access, any defaults that the folder -has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that user. -This is because if the id is not a username, it becomes an extremely -lengthy operation to check each user to see if have that id assigned -to them. The alternative is to set the defaults for all users after -every SET ACCESS, but that might cause problems with users who have -manually reset those defaults. The correct solution requires a large -programming modification, which will be done in a later version. -3 /ALL -Specifies that access to the folder is granted to all users, in other -words the folder is made no longer private. /ALL is specified in -place of the id name after the SET ACCESS command: - SET ACCESS /ALL [folder-name] -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have it's own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSTEM privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, for BBOARD to work, make sure -that the subprocess limit for users is at least 2. You also may have -to increase some subprocess system parameters: PQL_DPGFLQUOTA and -PQL_DWSQUOTA defaults are usually too low (10000 and 500 will work). - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. - -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -/SPECIAL set on their BBOARD accounts cannot have their mail forwarded -to BBOARD accounts that don't have /SPECIAL set. Folders of the same -type, i.e. that use the same /SPECIAL command procedure, must be grouped -separately. - -FYI, the above works due to the fact that forwarded mail still keeps the -original username in the "To:" header of the message. -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes it's input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time and -avoids creating subprocesses. (Useful if input is digest format.) -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. This cannot be specified for -the GENERAL folder. The BRIEF setting contrasts with the READNEW -setting, which causes a listing of the description of the new messages -to be displayed and prompts the user to read the messages. Setting -BRIEF will clear a READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory. - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. -(NOTE: SHOW FOLDER/FULL is a privileged command.) -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one exists. -(NOTE: SHOW FOLDER/FULL is a privileged command.) -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by many -different people. If an account is specified as GENERIC, new messages -placed in the GENERAL folder will be displayed upon logging in for a -specific number of days, rather than only once. The default period is 7 -days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new GENERAL messages will be displayed -for upon logging in. -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will -not occur if DISMAIL is set for an old account. Additionally, removing -the DISMAIL flag will not automatically enable LOGIN. (The reason for -the above was to avoid extra overhead for constant checking for the -DISMAIL flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NODE -Modifies the selected folder from a local folder to a remote folder. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. When the SET NODE command is -executed, the remote node is checked to see if a folder of the same -name is located on that node. If so, the selected folder will then -point to that folder. If are any messages stored in the local folder, -they will be deleted. This capability is only present if the BULLCP -process is created on the remote node via the BULL/STARTUP command. - - Format: - - SET NODE nodename - SET NONODE - -NOTE: If one node add a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -That information is only updated every 15 minutes (same algorithm for -updating BBOARD messages), or if a user accesses that folder. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -This command does not presently work for remote folders. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 PRIVILEGES -Specifies the privileges that are necessary to use privileged commands. -Use the SHOW PRIVILEGES command to see what privileges are presently set. -This is a privileged command. - - Format: - - SET PRIVILEGES privilege-list - -Privilege-list is the list of privileges separated by commas. -To remove a privilege, specify the privilege preceeded by "NO". -2 READNEW -Controls whether you will be prompted upon logging in if you wish to read -new non-system or folder messages (if any exist). The default is dependent -on how the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. -For messages in folders other than the GENERAL folder, both prompting -and display of topics of new messages are controlled by this command. -For the GENERAL folder, the display of topics cannot be disabled. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP -SET SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. -This command cannot be used for the GENERAL folder. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -By default, the GENERAL folder is a SYSTEM folder, and the setting for -that folder cannot be removed. - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected via -the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. -1 UNDELETE -Undeletes the specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have their -expiration date set to 15 minutes in the future and are deleted then. -Undeleting the message will reset the expiration date back to it's original -value. Deleted messages will be indicated as such by the string (DELETED) -when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] diff --git a/decus/vax88a2/bulletin/bulldir.inc b/decus/vax88a2/bulletin/bulldir.inc deleted file mode 100644 index 4d1fd5a..0000000 --- a/decus/vax88a2/bulletin/bulldir.inc +++ /dev/null @@ -1,19 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = 115 - - COMMON /BULL_DIR/ DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME - & ,SYSTEM,BLOCK,NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*8 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - LOGICAL SYSTEM - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (DESCRIP,BULLDIR_ENTRY) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_HEADER - EQUIVALENCE (NEWEST_EXDATE,BULLDIR_HEADER) - - CHARACTER*116 BULLDIR_COM ! This value + 12 must be - EQUIVALENCE (DESCRIP,BULLDIR_COM) ! divisable by 4 diff --git a/decus/vax88a2/bulletin/bullet1.com b/decus/vax88a2/bulletin/bullet1.com deleted file mode 100644 index d1edc7d..0000000 --- a/decus/vax88a2/bulletin/bullet1.com +++ /dev/null @@ -1,698 +0,0 @@ -$set nover -$copy sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLFILES.INC must first - be modified before this procedure is run. It contains the names of data files - which BULLETIN creates. It also includes specifications of directories used - by the FOLDER and BBOARD features. (In relation to the FOLDER feature, you - can restrict FOLDER creation to privileged users. See BULLCOM.CLD). - You should also look at BULLFOLDER.INC, as there may be some parameters in - that you may or may not want to modify. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, and wish the RESPOND command to be able - to send messages to the originators of these messages, you must modify - the subroutine RESPOND in BULLETIN2.FOR in order to specify the mail - utility which you use to send mail over those networks. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. (WARNING: Finding the newest unread - message is quicker than finding the oldest unread message. This - is not a problem if the number of messages is small. However, - if you plan on having lots of messages, and your system is heavily - loaded, you may want to avoid /REVERSE. Trial & error is the only - way to find out if this is a problem!) Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - (This is a new feature added as of Version 1.5). - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - -5) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. - -6) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -7) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. -$eod -$copy sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = 115 - - COMMON /BULL_DIR/ DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME - & ,SYSTEM,BLOCK,NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*8 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - LOGICAL SYSTEM - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (DESCRIP,BULLDIR_ENTRY) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_HEADER - EQUIVALENCE (NEWEST_EXDATE,BULLDIR_HEADER) - - CHARACTER*116 BULLDIR_COM ! This value + 12 must be - EQUIVALENCE (DESCRIP,BULLDIR_COM) ! divisable by 4 -$eod -$copy sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -There is a feature which allows adding GENERAL non-system and system -messages to other DECNET nodes from within the BULLETIN the utility (see -the ADD command). All information about the message, such as expiration -date, are transferred to the host, thus making it more flexible than the -BBOARD method of adding messages. Deletion of messages is also -possible across DECNET. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in it's memory. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -$eod -$copy sys$input BULLETIN.LNK -$deck -$ LINK/NOTRACE BULLETIN,BULLETIN0,BULLETIN1,BULLETIN2,BULLETIN3,- -BULLETIN4,BULLETIN5,BULLETIN6,BULLETIN7,BULLETIN8,- -BULLCOM,BULLMAIN,ALLMACS,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB -$eod -$copy sys$input BULLFILES.INC -$deck -C -C THE FIRST 2 FILES ARE FILES CREATED AND USED BY BULLETIN. -C SPECIFY THE DEVICE/DIRECTORY IN WHICH YOU DESIRE THAT THEY BE KEPT. -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNT MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU ALSO MAY HAVE -C TO INCREASE SOME SUBPROCESS SYSTEM PARAMETERS: PQL_DPGFLQUOTA AND -C PQL_DWSQUOTA MAY HAVE TO BE CHANGED. (10000 AND 500 ARE TYPICAL). -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNT USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLDIR_FILE,BULLETIN_FILE,BULLUSER_FILE - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLINF_FILE - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C THE FOLLOWING 2 FILES ARE OBSOLETE AS OF V1.1 AND NO LONGER HAVE TO -C BE SPECIFIED. BULLETIN NOW TREATS THE GENERAL FOLDER AS ANY OTHER -C FOLDER. NEW USERS SHOULD JUST LEAVE THEM ALONE. HOWEVER, USERS -C USING OLDER VERSIONS STILL HAVE TO SPECIFY THEM IN ORDER THAT -C BULLETIN KNOWS THE NAMES IN ORDER TO RENAME THEM. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ -$eod -$copy sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,5A4)' - PARAMETER FOLDER_RECORD = 173 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - CHARACTER*20 REMOTE_FOLDER_COM - EQUIVALENCE (F_NBULL,REMOTE_FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - CHARACTER*20 REMOTE_FOLDER_COM1 - EQUIVALENCE (F1_NBULL,REMOTE_FOLDER_COM1) -C -C Following is used for folder directory display. Must be multiple of 4. -C The next time the the folder file is modified, it should be made a -C multiple of 4, and then this variable can be deleted. -C - CHARACTER*240 FOLDER1_INFO - EQUIVALENCE (FOLDER1_INFO,FOLDER1_COM) -$eod -$copy sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Last read times for each folder as stored in SYS$LOGIN:BULLETIN.INF - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod diff --git a/decus/vax88a2/bulletin/bullet2.com b/decus/vax88a2/bulletin/bullet2.com deleted file mode 100644 index c0dd97b..0000000 --- a/decus/vax88a2/bulletin/bullet2.com +++ /dev/null @@ -1,687 +0,0 @@ -$set nover -$copy sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 2/1/88 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER BULLETIN_NUMBER - QUALIFIER ORIGINAL - DISALLOW FOLDER AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER RESTART - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,TYPE=$REST_OF_LINE) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER BULLETIN_NUMBER - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW FOLDER AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) -$eod -$copy sys$input BULLETIN.COM -$deck -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -$eod -$copy sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER LOGIN - QUALIFIER PAGE, DEFAULT - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER,DEFAULT="7") -$eod -$copy sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXIT -$ BULL*ETIN :== $SYS$SYSTEM:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy sys$input BULL_COMMAND.COM -$deck -$B:=$PFCVAX$DBC1:[MRL.BULLETIN]BULLETIN.EXE;13 -$ON ERROR THEN GOTO EXIT -$ON SEVERE THEN GOTO EXIT -$ON WARNING THEN GOTO EXIT -$B/'F$PROCESS()' -$EXIT: -$LOGOUT -$eod -$copy sys$input CREATE.COM -$deck -$ FORTRAN/EXTEND BULLETIN -$ FORTRAN/EXTEND BULLETIN0 -$ FORTRAN/EXTEND BULLETIN1 -$ FORTRAN/EXTEND BULLETIN2 -$ FORTRAN/EXTEND BULLETIN3 -$ FORTRAN/EXTEND BULLETIN4 -$ FORTRAN/EXTEND BULLETIN5 -$ FORTRAN/EXTEND BULLETIN6 -$ FORTRAN/EXTEND BULLETIN7 -$ FORTRAN/EXTEND BULLETIN8 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ @BULLETIN.LNK -$eod -$copy sys$input INSTALL.COM -$deck -$ COPY BULLETIN.EXE SYS$SYSTEM: -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/DEL -SYS$SYSTEM:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy sys$input LOGIN.COM -$deck -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! If you wish bulletins to be displayed upon logging in starting with -$! oldest rather than newest, change BULLETIN/LOGIN to BULLETIN/LOGIN/REVERSE. -$! -$ BULL*ETIN :== $SYS$SYSTEM:BULLETIN -$ BULLETIN/LOGIN -$eod -$copy sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Link /NoTrace Bulletin.Obj,Bulletin0.Obj,Bulletin1.Obj,Bulletin2.Obj, - - Bulletin3.Obj,Bulletin4.Obj,Bulletin5.Obj,Bulletin6.Obj, - - Bulletin7.Obj,Bulletin8.Obj, - - Bullcom.Obj,Bullmain.Obj,Allmacs.Obj, - - Sys$System:Sys.Stb /Sel /NoUserlib - Purge /Log /Keep:2 - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* - -$eod diff --git a/decus/vax88a2/bulletin/bulletin.com b/decus/vax88a2/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vax88a2/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vax88a2/bulletin/bulletin.for b/decus/vax88a2/bulletin/bulletin.for deleted file mode 100644 index a0c2e8a..0000000 --- a/decus/vax88a2/bulletin/bulletin.for +++ /dev/null @@ -1,1123 +0,0 @@ -C -C BULLETIN.FOR, Version 3/25/88 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) ! Get command line - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - -C -C Test for /LOGIN switch. -C NOTE: /READ has been replaced by the SET READNEW command. -C - - CALL LIB$GET_FOREIGN(INCMD) - - IER = CLI$DCL_PARSE('BULLETIN '//INCMD,BULLETIN_MAINCOMMANDS) - - READIT = 0 - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP')) THEN ! Create bulletin control - CALL CREATE_BULLCP ! subprocess at startup - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - CALL RUN_BULLCP ! doing what BULLCP does! - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - CALL DELETE_EXPIRED ! Delete expired messages - - CALL MODIFY_SYSTEM_LIST - -C -C Get page length for the terminal. -C - - CALL GETPAGLEN(PAGE_LENGTH) - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL SHOW_SYSTEM - CALL EXIT - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - CALL NEW_MESSAGE_NOTIFICATION - ELSE - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - MAIL_STATUS = 1 - - DO WHILE (1) - - IF (MAIL_STATUS) THEN - CALL GET_INPUT_PROMPT(INCMD,IER, - & COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - ELSE - CALL GET_INPUT_PROMPT(INCMD,IER, - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - MAIL_STATUS = 0 - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9') - IER = IER - 1 - END DO - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - - CALL CLI$GET_VALUE('$VERB',INCMD) ! Get the VERB command - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD bulletin command? - CALL ADD ! Go add bulletin - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK command? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE command? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY command? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE command? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT command? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE command? - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY command? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE command? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT command? - GO TO 999 ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP command? - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX command? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST command? - READ_COUNT = -1 - BULL_READ = 99999 - CALL READ(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL command? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY command? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE command? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEXT') THEN ! NEXT command? - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT command? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ command? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE command? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY command? - IF (BULL_POINT.LT.1) THEN - WRITE (6,'('' ERROR: No bulletin currently read.'')') - ELSE - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (DESCRIP(:3).NE.'RE:') THEN - WRITE (6,'(1X,A)') 'RE: '//DESCRIP - ELSE - WRITE (6,'(1X,A)') DESCRIP - END IF - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND command? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH command? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT command? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET command? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'PR') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:3).EQ.'NOP') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:3).EQ.'NOT') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(1,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(0,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET SHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,1) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(1,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOSHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET BRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,1) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(1,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOBRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW command? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - DO FOLDER_NUMBER = 0,FOLDER_MAX - IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (NBULL.GT.0) THEN - DIFF = COMPARE_BTIM( - & LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - END IF - END IF - END DO - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - END IF - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE command? - CALL UNDELETE - END IF - -100 CONTINUE - - END DO - -999 CALL EXIT - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*8 - CHARACTER*80 INDESCRIP,INPUT - - CHARACTER INLINE*80,OLD_FOLDER*25 - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET? - USERNAME = DEFAULT_USER - CALL CONFIRM_PRIV(USERNAME,ALLOW) - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privileges - WRITE(ERROR_UNIT,1081) ! Tell user - GO TO 910 ! and abort - ELSE IF (F_EXPIRE_LIMIT.GT.0.AND..NOT.ALLOW ! Expiration limit - & .AND.USERNAME.NE.FOLDER_OWNER) THEN ! is present - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:20) - END IF - - IF (INCMD(:3).EQ.'REP'.AND.TRIM(DESCRIP).GT.0) THEN - ! REPLY command and subject present? - IF (DESCRIP(:4).NE.'RE: ') THEN ! Fill in subject to be - INDESCRIP = 'RE: '//DESCRIP ! RE: the subject of the - END IF ! message just read. - LENDES = TRIM(INDESCRIP) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - GO TO 910 - END IF - ELSE - LENDES = 54 - DO WHILE (LENDES.GT.53) ! Do until valid description - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - END IF - END DO - END IF - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IF - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.80) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Sratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = 81 ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.80) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > 80. Reinput:'')') - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment record count - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolons - ILEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Are semicolon found? - IF (ILEN.GT.SEMI+1) THEN ! Is username found? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes - ILEN = SEMI - 1 ! Remove semicolons - ELSE ! No username found... - TEMP_USER = DEFAULT_USER ! Set user to default - ILEN = SEMI - 1 ! Remove semicolons - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons present - TEMP_USER = DEFAULT_USER ! Set user to default - END IF - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:ILEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - INLINE = INLINE(:STR$POSITION(INLINE,' ')-1) - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,80) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - BRDCST = .FALSE. - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER) THEN - CALL OPEN_FILE(2) ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - LENGTH = (ICOUNT+127)/128 ! Number of records - FROM = USERNAME ! Username - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF - CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - CALL ADD_ENTRY ! Add the new directory entry - - IF (FOLDER_NUMBER.GE.0) THEN - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_FILE(2) ! Totally finished with add - ELSE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be - & truncated to:') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanent - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*20 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*8 LOCALNODE - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_FILE_SHARED(4) - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE(4) - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE (4) - - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - END IF - - CLOSE (UNIT=17) - - RETURN - END diff --git a/decus/vax88a2/bulletin/bulletin.hlp b/decus/vax88a2/bulletin/bulletin.hlp deleted file mode 100644 index 5aed414..0000000 --- a/decus/vax88a2/bulletin/bulletin.hlp +++ /dev/null @@ -1,109 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -There is a feature which allows adding GENERAL non-system and system -messages to other DECNET nodes from within the BULLETIN the utility (see -the ADD command). All information about the message, such as expiration -date, are transferred to the host, thus making it more flexible than the -BBOARD method of adding messages. Deletion of messages is also -possible across DECNET. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in it's memory. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) diff --git a/decus/vax88a2/bulletin/bulletin.lnk b/decus/vax88a2/bulletin/bulletin.lnk deleted file mode 100644 index 4b1a4dd..0000000 --- a/decus/vax88a2/bulletin/bulletin.lnk +++ /dev/null @@ -1,3 +0,0 @@ -$ LINK/NOTRACE BULLETIN,BULLETIN0,BULLETIN1,BULLETIN2,BULLETIN3,- -BULLETIN4,BULLETIN5,BULLETIN6,BULLETIN7,BULLETIN8,- -BULLCOM,BULLMAIN,ALLMACS,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB diff --git a/decus/vax88a2/bulletin/bulletin.tex b/decus/vax88a2/bulletin/bulletin.tex deleted file mode 100644 index 699dcce..0000000 --- a/decus/vax88a2/bulletin/bulletin.tex +++ /dev/null @@ -1,234 +0,0 @@ -\chapter{The BULLETIN Utility} -\section{Introduction} - -The Electronic Bulletin Board Utility (BULLETIN) can be used to post -bulletins on the computer for other users on your system to see. This -utility also allows you to file, print, and reply to messages that other -users have posted. - -When a new bulletin has been posted you will be notified at login of the -new message. If the message is a system message, the text of the entire -message will be displayed. If the message is not a system message, then -you will be notified of the new message and the header of the message -will be displayed. - -Users can set parameters within BULLETIN to be notified of new messages -immediately, when logged on, or to have the BULLETIN system prompt them -at login to read new messages. - -\section{Command Summary} - -Following is a summary of BULLETIN commands, items in brackets are optional: -\\[6pt] -\smaller -\begin{tabular} {lp{3.0in}} -\bf{}Command & \bf{}Description\rm{} -\\[3pt] -\makebox[1.75in][l]{ADD [\it{}File] [/NOEDIT]\rm{}} & Add a bulletin to current folder. -Specify either a file containing the message. The editor is used to compose a -new message or change the specified file by default. Specify /NOEDIT to -deactivate the editor. If you use /NOEDIT with a specified file, the file is -added to the folder as is.\\ -BACK & Back up to previous message.\\ -DELETE [\it{}Msg-number] \rm{} & Delete current (last-read)message or -designated message. -You can only delete a message if you are the owner or have system privileges.\\ -DIRECTORY & List a summary of bulletin messages in -the current folder.\\ -EXIT & Exits from BULLETIN.\\ -\end{tabular} -\begin{tabular} {lp{3.0in}} -\makebox[1.75in][l]{FILE }& Copies current (last-read) message into a VMS - file. \\ -HELP & Displays information on using BULLETIN.\\ -INDEX [/NEW] [/RESTART] & Index of Folders and messages.\\ -NEXT & Skips to next bulletin message and displays it.\\ -PRINT & Queues the current (last-read) message for printing.\\ -READ [\it{}Msg-number\rm{}] & Displays next page of - message, the next message, or the designated message. -Pressing the \CR{} key performs the same function.\\ -\end{tabular} -\begin{tabular} {lp{3.0in}} -\makebox[1.75in][l]{RESPOND } & Sends a reply to the sender of the current - (last read) message.\\ -SEARCH \it{}Search-string\rm{} & Searches for a - message that contains the specified text string.\\ -SELECT \it{}Foldername\rm{} & To move from one folder - to another within BULLETIN.\\ -\end{tabular} -\begin{tabular} {lp{3.0in}} -\makebox[1.75in][l]{SET NOTIFY }& Specifies that you will be notified when -new messages are added to current folder when you are logged on.\\ -SET READNEW & Specifies that you will be prompted upon -logging in if you wish to read new non-system messages.\\ -SET LOGIN & Specifies that you wish to be notified - of any new messages at login.\\ -\end{tabular} -\begin{tabular} {lp{3.0in}} -\makebox[1.75in][l]{SET ACCESS} & Specifies access to a folder to certain -users. Only the creator of a folder or a privileged account can set or change -the access.\\ -SET FOLDER \it{}Foldername\rm{} & To move from one - folder to another.\\ -SHOW \it{}Parameter\rm{} & Displays information about - the parameter that was established by one of the previous set commands.\\ -QUIT & Exits from BULLETIN (Same as EXIT).\\ -\end{tabular} -\normalsize - -\section{Preset BULLETIN Folders} - -The following folders have already been created within the BULLETIN system: -\smaller -\\[8pt] -\begin{tabular} {lp{5.5in}} -\bf{}Folder & \bf{}Description\\[3pt] -APUPI\_NEWS & The Day's News From AP and UPI\\ -Community & News of Community Events\\ -Computers & Computer information\\ -Contracts & Contract information\\ -CVNET\_ARPA & Messages from CVNET (Color Vision) on ARPANet\\ -GENERAL & General purpose bulletins for system.\\ -HACKERS & Computer Hackers Questions and Answer\\ -HE\_ADMIN & HE Division administration bulletins.\\ -HEA\_ADMIN & HEA Branch administration Bulletins.\\ -HED\_ADMIN & HED Branch administration Bulletins.\\ -HEF\_ADMIN & HEF Branch administration Bulletins.\\ -HEG\_ADMIN & HEG Branch administration Bulletins.\\ -HET\_ADMIN & HET Branch administration Bulletins.\\ -HEX & HEX Branch administration Bulletins.\\ -HEX-CAT\_ADMIN & HEX-CAT Branch administration Bulletins.\\ -Military & Messages for Military Personnel\\ -N-Language\_ARPA & Messages from NL-KR (Natural Language) on ARPANet\\ -Neuron\_ARPA & Messages from NEURON on ARPANet\\ -Psychnet\_ARPA & Messages from PSYCHNET on ARPANet\\ -RCB & Resource Control Board and Secretaries Information\\ -Secretaries & Secretaries Bulletin Board\\ -System & \Computer System Bulletins\\ -Training & Training news\\ -Vision\_ARPA & Messages from VISION on ARPANet\\ -\end{tabular} -\normalsize - -Users may post bulletins in the GENERAL folder. Branch Chiefs and -secretaries may also post messages in their respective ADMIN folder. -The Division chief and secretary may post messages in the HE\_ADMIN folder. - -Users may read any bulletin in GENERAL, HACKERS, SYSTEM, and APUPI\_NEWS -folders and any of the \_\_ARPA folders. HE Division members may read the -bulletins within HE\_ADMIN and their respective branch's ADMIN folder. - -\section{Examples Using BULLETIN} - -The following examples illustrate the use of the BULLETIN utility for common -applications. -\begin{enumerate} -\item User invokes the BULLETIN utility and reads the two messages.\\[2pt] - -\smaller -\tt -\begin{quote} -\$ {\it{}BULLETIN }\\ -Type READ to read new general messages.\\ -BULLETIN\tt{}>{\it{} READ }\\ -Message number:\mbox{ }1\\ -Description: INFO ON HOW TO USE THE BULLETIN UTILITY.\\ -From: SYSTEM\mbox{ }Date: 6-MAR-1987 Permanent message\\[4pt] -This message is being displayed by the BULLETIN facility. -This is a non-DEC facility, so it is not described in the manuals. -Messages can be submitted by using the BULLETIN command. System -messages, such as this one, are displayed in full, but can only be -entered by privileged users. Non-system messages can be entered by -anyone, but only their topics will be displayed at login time, and -will be prompted to optionally read them. (This prompting feature -can be disabled). All bulletins can be reread at any time unless -they are deleted or expire. For more information, see the on-line -help (via HELP BULLETIN).\\ - -BULLETIN\tt{}> {\it{}READ} \\ -Message number:\mbox{ }2\\ -Description: INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS.\\ -From: SYSTEM \mbox{ }Date: 6-MAR-1987 Permanent message\\ -Non-system bulletins (such as this) can be submitted by an -user. Users are alerted at login time that new non-system bulletins have -been added, but only their topics are listed. -Optionally, users can be prompted at login time to see if they wish to -read the bulletins. When reading the bulletins in this manner, the -bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as -the default directory to write the file into.\\ - -\normalsize -\rm A user can disable the READNEW prompting featuring by using BULLETIN as -follows: \\[1em] -\smaller -\$ {\it{} BULLETIN }\\ -\tt BULLETIN \tt{}> {\it{} SET NOREADNEW }\\ -BULLETIN \tt{}> {\it{} EXIT }\\[3pt] -\rm Afterwards, the user will only be alerted of the bulletins, and -will have to use the BULLETIN utility in order to read the messages. \\ -\tt BULLETIN \tt{}> {\it{} EXIT }\\ -\end{quote} -\normalsize -\item Login Prompt using SET READNEW:\\ - -\nopagebreak{} -\smaller\tt -\begin{tabular} { l l l c } -\multicolumn{4}{l} -{************************New GENERAL messages***********************}\\[2pt] -\underline{Description} & \underline{From} & \underline{Date} -& \underline{Number}\\ -Testing of bulletin system SET READNEW & SYSTEM & 10-MAR & 3\\ -\multicolumn{4}{l} -{*******************************************************************}\\[2pt] -\multicolumn{4}{l} -{Read messages? Type N, Q, message number, or any other key for yes:}\\ -\end{tabular}\\[2pt] -\end{enumerate} -\normalsize\rm - -\subsection{Defering notification of BULLETIN Messages} - -You can defer the notification of BULLETIN message that is normally done at -login time by placing the following line in your {\tt LOGIN.COM} file: - -\begin{center} \$ CHECK\_BULL :== OFF \end{center} - -This turns ``off'' the BULLETIN notification system. You can then -check for bulletins at any time by entering the command: - -\begin{center} \$ BULLETIN/LOGIN \end{center} - -and the system will prompt you to read any new bulletins. -You should make sure to check for bulletins regularly or some important -messages could be missed. - -\subsection{Adding Messages} - -To add a message to any bulletin folder, first select the folder to which the -message is to be added. Then enter the command {\bf ADD}. The system will -then ask for an expiration date and a description of the message. After the -description has been added, the system will activate the editor (unless /NOEDIT -was specified) and you can compose the message. If a file was specified -with the {\bf ADD} command, then the specified file will be pulled into the -editor to be edited (unless /NOEDIT was specified, in which case the file will -be posted immediately to the bulletin board). - -The following is an example of posting a message to the GENERAL folder of the -bulletin board with an expiration date of 10 days from the current time.\\[1em] -\noindent -{\smaller \tt -\$ {\it BULLETIN}\CR \\[.5em] -Folder has been set to GENERAL.\\ -BULLETIN$>$ {\it Add/NOEDIT} \CR \\ -It is 7-MAR-1988 16:21:44.20. Specify when the message should expire:\\ -Enter absolute time: [dd-mmm-yyyy] hh:mm:ss or delta time: dddd hh:mm:ss\\ -{\it 10}\CR \\ -Enter description header. Limit header to 53 characters.\\ -{\it Test message}\CR \\ -Enter message: End with ctrl-z, cancel with ctrl-c\\ -{\it This is a test message.}\CR \\ -{\bf CTRL-Z }\\ -BULLETIN$>$ {\it exit}\CR \\ -} diff --git a/decus/vax88a2/bulletin/bulletin0.for b/decus/vax88a2/bulletin/bulletin0.for deleted file mode 100644 index f2abf95..0000000 --- a/decus/vax88a2/bulletin/bulletin0.for +++ /dev/null @@ -1,1221 +0,0 @@ -C -C BULLETIN0.FOR, Version 3/19/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - CHARACTER*128 INPUT - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = 81 - DO I=NBLOCK+1,NBLOCK+LENGTH ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL(I,INPUT,ILEN) - END IF - IF (ILEN.LT.0) THEN ! End of bulletin? - RETURN - ELSE IF (ILEN.GT.0) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - ILEN = 80 - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IF - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - - - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53,INPUT*20 - - INTEGER EXBTIM(2),NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER) - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_FILE(2) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.REMOTE_USER.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_FILE(2) - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_FILE(2) ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,DESCRIP - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(1:11) - NEWEST_EXTIME = INPUT(13:20) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_FILE(2) - - DO BULL_DELETE = SBULL,EBULL - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_FILE(2) - RETURN - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_FILE(2) - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - CALL CLOSE_FILE(2) - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') RETURN - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_FILE(2) - RETURN - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - END DO - - CALL CLOSE_FILE(2) - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER INPUT*20 - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - CALL READDIR(0,IER) ! Get shutdown count - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EXBTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EXBTIM,EXBTIM) - IER = SYS$ASCTIM(,INPUT,EXBTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:20) - - CALL WRITEDIR(0,IER) - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH, PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT - - CHARACTER START_PARAMETER*16,DATETIME*23,TODAY*11 - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_COM) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_FILE_SHARED(2) ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1) THEN ! If so, there are messages - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified? - IER = CLI$GET_VALUE('START',START_PARAMETER,ILEN) - DECODE(ILEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEN - DIR_COUNT = NBULL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_FILE(2) - DIR_COUNT = 0 - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.(FOLDER_NUMBER.GE.0.AND. - & CLI$PRESENT('NEW'))) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$ASCTIM(,TODAY,,) ! Need to get date. - DATETIME = TODAY//' 00:00:00.0' - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_FILE(2) - RETURN - ELSE - CALL SYS$ASCTIM - & (,DATETIME,LAST_READ_BTIM(1,FOLDER_NUMBER+1),) - END IF - END IF - TEMP_COUNT = 0 - IER = 1 - DO WHILE (IER.EQ.TEMP_COUNT+1) - TEMP_COUNT = TEMP_COUNT + 1 - CALL READDIR(TEMP_COUNT,IER) - IF (IER.NE.TEMP_COUNT+1) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_FILE(2) - RETURN - ELSE - DIFF = COMPARE_DATE(DATETIME(1:11),DATE) - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME) - IF (DIFF.LT.0) THEN - DIR_COUNT = TEMP_COUNT - IER = IER + 1 - END IF - END IF - END DO - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - END IF - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THEN - EBULL = NBULL - END IF - IF (.NOT.REMOTE_SET) THEN - DO I=SBULL,EBULL ! Copy messages from file - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - END DO - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,SBULL,EBULL - IF (IER.EQ.0) THEN - I = SBULL - DO WHILE (IER.EQ.0.AND.I.LE.EBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_COM - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_FILE(2) - CALL DISCONNECT_REMOTE - RETURN - END IF - END IF - ELSE - NBULL = 0 - END IF - - CALL CLOSE_FILE(2) ! We don't need file anymore - - IF (NBULL.EQ.0) THEN - WRITE (6,'('' There are no messages present.'')') - RETURN - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER) - WRITE(6,'(<81-FLEN>X,A)') FOLDER(:FLEN) - WRITE(6,1000) ! Write header - DO I=SBULL,EBULL - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,2010) I,DESCRIP(:52),FROM,'(DELETED)' - ELSE - WRITE(6,2010) I,DESCRIP(:52),FROM,DATE(1:7)//DATE(10:11) - END IF - END DO - - DIR_COUNT = EBULL + 1 ! Update directory counter - - IF (DIR_COUNT.GT.NBULL) THEN ! Outputted all entries? - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - -2010 FORMAT(1X,I4,1X,A52,1X,A12,1X,A9) - - END - - - SUBROUTINE FILE -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And return - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,1010) ! Write error - RETURN ! And return - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030) - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE - END IF - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:ILEN) - END IF - END DO - ILEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_POINT,BULL_PARAMETER(1:LEN_P) - ! Show name of file created. -100 CALL CLOSE_FILE(1) - RETURN - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 100 - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/) - - END - - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*23,INPUT*80,INREAD*1 - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - DIMENSION NOLOGIN_BTIM(2),LOGIN_BTIM_SAVE(2),TODAY_BTIM(2) - DIMENSION DIR_BTIM(2),NEW_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_FILE_SHARED(4) - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) RETURN ! DISMAIL set - IF (IER1.EQ.0) THEN ! There is a user entry - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry - READ_BTIM(2) = NEW_BTIM(2) - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_DISMAIL(USERNAME,DISMAIL) - IF (DISMAIL.EQ.1) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - ELSE - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_FILE(4) ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_FILE_SHARED(9) - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_FILE(9) - END IF - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - BBOARD_BTIM(1) = TODAY_BTIM(1) - BBOARD_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_FILE(4) - IF (.NOT.TEST_BULLCP()) CALL CREATE_BBOARD_PROCESS - ELSE - CALL CLOSE_FILE(4) - IF (IER.NE.0) CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compare - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - - IF (NEW_FLAG(2).NE.0) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - RETURN - END IF - -C -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible. -C - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.FOLDER_SET) THEN - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (FOLDER_NUMBER.GT.0.AND.BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST2(SET_FLAG,FOLDER_NUMBER) - & .AND..NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) RETURN - ! Don't overwhelm new user with lots of non-general msgs - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - LOGIN_BTIM(1) = SYSTEM_LOGIN_BTIM(1) ! Use specified login time - LOGIN_BTIM(2) = SYSTEM_LOGIN_BTIM(2) ! for system messages. - END IF - - CALL OPEN_FILE_SHARED(2) ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_COM) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_COM) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF (REVERSE_SWITCH.AND.(.NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - REVERSE = 1 - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL - START = START + 1 - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_COM) - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,NBULL - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,NBULL,START - END IF - IF (IER.EQ.0) THEN - ALL_DIR = ALL_DIR1 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.NBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_COM - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_COM) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_FILE(2) - CALL DISCONNECT_REMOTE - RETURN - END IF - ALL_DIR = ALL_DIR1 - END IF - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_COM) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - ! No. Is bulletin system or from same user? - IF (.NOT.REVERSE) THEN - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (SYSTEM_SWITCH) THEN - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,DIR_BTIM) - ELSE - DIFF = -1 - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF (SYSTEM.EQ.3) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0) THEN ! And save only the first non-system msg - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - END IF - END IF - END DO -100 CALL CLOSE_FILE(2) -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (NGEN.EQ.0.AND.NSYS.EQ.0) RETURN - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER) - S1 = (80-(LENF+16))/2 - S2 = 80 - S1 - (LENF + 16) - WRITE (6,1026) FOLDER(:LENF),CTRL_G ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_FILE_SHARED(1) - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_FILE(1) - RETURN - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin to SYS_BUL link list - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - CALL CLOSE_FILE(1) - RETURN - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - END IF - END DO - ILEN = 80 - END DO - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,80 - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_FILE(1) - SYS_BUL = SYS_BUL1 - DO I = 1,NSYS_LINE ! Write out the system messages - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - WRITE(6,1060) '+'//INPUT(1:TRIM(INPUT)) - ELSE - PAGE = PAGE + 1 - WRITE(6,1060) ' '//INPUT(1:TRIM(INPUT)) - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER) - S1 = (80-13-LENF)/2 - S2 = 80-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages',CTRL_G - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages',CTRL_G - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD,INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP,FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP,FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST2(SET_FLAG,FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF - IF (COMPARE_BTIM(READ_BTIM,NEW_BTIM).NE.0) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (80-ILEN)/2 - S2 = 80 - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - ELSE - ILEN = 48 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (80-ILEN)/2 - S2 = 80 - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-48)// - & ' command can be used to read these messages.' - END IF - - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'),A1) -1027 FORMAT(/,' ',('*'),A,('*'),A1) -1028 FORMAT('+',('*'),A,('*'),A1) -1030 FORMAT(' ',80('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A54,1X,A12,1X,A6,1X,I4) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END diff --git a/decus/vax88a2/bulletin/bulletin1.for b/decus/vax88a2/bulletin/bulletin1.for deleted file mode 100644 index 4e3291f..0000000 --- a/decus/vax88a2/bulletin/bulletin1.for +++ /dev/null @@ -1,1326 +0,0 @@ -C -C BULLETIN1.FOR, Version 3/16/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - NLEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addedd - END IF - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:NLEN)//'""::' - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Is semicolon present? - IF (NLEN.GT.SEMI+1) THEN ! Yes, is username after node? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - NLEN = SEMI - 1 ! Remove semicolon - ELSE ! No username after nodename - TEMP_USER = DEFAULT_USER ! Set username to default - NLEN = SEMI - 1 ! Remove semicolon - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolon present - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username was - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:NLEN) - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '// - & PASSWORD(1:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FLAGNAME - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_FILE(7) ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_FILE(7) - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,A,'' You are not authorized to modify.'')') - & FLAGNAME - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_FILE(7) ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_FILE(7) - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - LEN_I = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN_I.GT.0) - CALL GET_BULL(I,INPUT,LEN_I) - IF (LEN_I.LT.0) THEN - GO TO 90 - ELSE IF (LEN_I.GT.0) THEN - WRITE (3,'(A)') INPUT(:LEN_I) - END IF - END DO - LEN_I = 80 - END DO - -90 CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_FILE(1) - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - IF (MAIL_SUBJECT(:1).NE.'"') THEN - MAIL_SUBJECT = '"'//MAIL_SUBJECT(:LEN_D) - LEN_D = LEN_D + 1 - END IF - - IF (MAIL_SUBJECT(LEN_D:LEN_D).NE.'"') THEN - MAIL_SUBJECT = MAIL_SUBJECT(:LEN_D)//'"' - LEN_D = LEN_D + 1 - END IF - - IER = CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER,LEN_P) - - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) - & //'/SUBJECT='//MAIL_SUBJECT(:LEN_D),,,,,,STATUS) - CALL ENABLE_PRIVS - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder owner.'')') - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_FILE(7) ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_FILE(7) - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - LOGICAL DELETE_ORIGINAL - - CHARACTER INPUT*80,SAVE_USERNAME*12,SAVE_FOLDER*25 - - CHARACTER*116 BULLDIR_COM_SAVE - - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_FILE(2) - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - - CALL LIB$MOVC3(116,%REF(BULLDIR_COM),%REF(BULLDIR_COM_SAVE)) - SAVE_BULL_POINT = BULL_POINT - - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Scratch file to save bulletin - - CALL OPEN_FILE_SHARED(1) - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - ILEN = 80 - END DO - -90 REWIND (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - SAVE_USERNAME = USERNAME - IF (CLI$PRESENT('ORIGINAL')) THEN - IF (SETPRV_PRIV()) THEN - USERNAME = FROM - ELSE - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - END IF - END IF - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER.OR.READ_ONLY) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - CLOSE (UNIT=3) - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER = SAVE_FOLDER - USERNAME = SAVE_USERNAME - RETURN - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE(6,'('' ERROR: Message copy aborted.'')') - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CLOSE (UNIT=3) - END IF - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - CALL LIB$MOVC3(116,%REF(BULLDIR_COM_SAVE),%REF(BULLDIR_COM)) - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND. - & .NOT.SETPRV_PRIV()) THEN ! Permanent? - WRITE (6,'('' ERROR: No privileges to add permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') FOLDER_BBEXPIRE - END IF - - FROM = USERNAME ! Specify owner - CALL ADD_ENTRY ! Add the new directory entry - - IF (FOLDER_NUMBER.GE.0) THEN - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_FILE(2) ! Totally finished with add - - CLOSE (UNIT=3) ! Close the input file - - WRITE (6,'('' Message has been copied to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - USERNAME = SAVE_USERNAME - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL) CALL DELETE - - RETURN - - END - - - - - SUBROUTINE PRINT -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*80 INPUT - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,1010) ! Write error - RETURN ! And return - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030) - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE - END IF - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END DO - ILEN = 80 - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) ! Get queue name - IF (ILEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - ILEN = 9 - END IF - - CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_FILE(1) - WRITE(6,1000) - CALL SYS_GETMSG(IER) - - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT('Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/) - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DATA SCRATCH_B1/0/ - - DIMENSION MSG_BTIM(2) - - CHARACTER TODAY*11,DATETIME*23 - - LOGICAL SINCE,PAGE - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - DATETIME = TODAY//' 00:00:00.0' - END IF - ELSE IF (CLI$PRESENT('NEW').AND.FOLDER_NUMBER.GE.0) THEN - ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - RETURN - ELSE - CALL SYS$ASCTIM - & (,DATETIME,LAST_READ_BTIM(1,FOLDER_NUMBER+1),) - END IF - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - CALL OPEN_FILE_SHARED(2) - TEMP_READ = 0 - IER = 1 - DO WHILE (IER.EQ.TEMP_READ+1) - TEMP_READ = TEMP_READ + 1 - CALL READDIR(TEMP_READ,IER) - IF (IER.NE.TEMP_READ+1) THEN - WRITE (6,'('' No messages found past specified date.'')') - CALL CLOSE_FILE(2) - RETURN - ELSE - DIFF = COMPARE_DATE(DATETIME(:11),DATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME) - IF (DIFF.LT.0) THEN - BULL_READ = TEMP_READ - IER = IER + 1 - END IF - END IF - END DO - IER = BULL_READ + 1 - SINCE = .TRUE. - CALL CLOSE_FILE(2) - END IF - END IF - - IF (.NOT.SINCE) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - CALL CLOSE_FILE(2) - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IF - - IF (FOLDER_NUMBER.GE.0) THEN - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2) - END IF - END IF - - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'CURR') THEN - IF (CLI$PRESENT('EDIT')) THEN - CALL READ_EDIT - RETURN - END IF - END IF - - FLEN = TRIM(FOLDER) - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header info - WRITE(6,1050) DESCRIP - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,1060) FROM,DATE,'(DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - WRITE(6,1060) FROM,DATE,'Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - WRITE(6,1060) FROM,DATE,'Permanent' - ELSE - WRITE(6,1060) FROM,DATE,'Expires: '//EXDATE//' '//EXTIME - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - WRITE(6,'(''+ / System'',/)') - ELSE - WRITE(6,'(''+'',/)') - END IF -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - END = 4 ! Outputted 4 lines to screen - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - -100 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - IF (READ_COUNT.GT.BLOCK.AND.READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header info - END = END + 1 ! Increase display counter - END IF - CALL OPEN_FILE_SHARED(1) ! Get bulletin file - MORE_LINES = .TRUE. - READ_REC = READ_COUNT - IF (READ_ALREADY.EQ.0) ILEN = 81 - DO WHILE (MORE_LINES.AND.READ_REC.LE.BLOCK+LENGTH-1) - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - CALL GET_BULL(READ_REC,INPUT,ILEN) - IF (ILEN.LT.0) THEN ! Error, couldn't read record - READ_REC = BLOCK + LENGTH ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - READ_ALREADY = 1 - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - ILEN = 80 - IF (MORE_LINES) THEN - READ_REC = READ_REC + 1 - READ_ALREADY = 0 - END IF - END DO - - CALL CLOSE_FILE(1) ! End of bulletin file read - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) ! Get queue record - IF (I.EQ.1.AND.READ_REC.NE.BLOCK.AND.READIT.GT.0) THEN - WRITE(6,2020) INPUT(:TRIM(INPUT)) ! (See above comments) - ELSE - WRITE(6,2010) INPUT(:TRIM(INPUT)) - END IF - END DO - - READ_COUNT = READ_REC ! Update bull record counter - - IF (READ_REC.EQ.BLOCK+LENGTH) THEN ! Last block? - READ_COUNT = 0 ! init bulletin record counter - ELSE IF (READ_REC.EQ.BLOCK+LENGTH-1.AND..NOT.MORE_LINES) THEN - ! Possibly last block since end of page could be last line - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Else if this is not /READ - WRITE(6,1070) ! say there is more of bulletin - END IF - - RETURN - -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT('+Message number: ',I4,<60-FLEN>X,A) -1050 FORMAT(' Description: ',A53) -1060 FORMAT(' From: ',A12,' Date: ',A11,' ',A,$) -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) -2010 FORMAT(1X,A) -2020 FORMAT('+',A) - - END - - - - - SUBROUTINE READ_EDIT - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*128 INPUT - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE - - CALL OPEN_FILE_SHARED(1) - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - ILEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/) - - RETURN - END - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - CHARACTER INREAD*1,INPUT*80,FILE_DEF*80,NUMREAD*5 - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - - IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.BULL_POINT+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_FILE_SHARED(2) ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_FILE(2) - END IF - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay direcotyr - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',LEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:LEN-1)//'.BULL]' - LEN_FILE_DEF = LEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_FILE_SHARED(2) - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,ERR=18, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 18 - ELSE IF (ILEN.GT.0) THEN - WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END IF - END DO - ILEN = 80 - END DO - WRITE(6,1040) BULL_PARAMETER(:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_FILE_SHARED(2) ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_FILE(2) ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_FILE(2) - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message - & number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,80('-'),/,' Type Q(Quit), - & F(File it), D(Dir) or any other key for next message: ',$) -1030 FORMAT(1X,80('-'),/,' Type Q(Quit), F(File it), N(Next message), - & D(Dir), or other key for MORE: ',$) -1040 FORMAT(' Message written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/) - - END diff --git a/decus/vax88a2/bulletin/bulletin2.for b/decus/vax88a2/bulletin/bulletin2.for deleted file mode 100644 index e23f49b..0000000 --- a/decus/vax88a2/bulletin/bulletin2.for +++ /dev/null @@ -1,1269 +0,0 @@ -C -C BULLETIN2.FOR, Version 3/28/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - PARAMETER UAF$V_DISACNT = 4 - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_FILE(7) - IF (IER1.AND..NOT.BTEST(FLAGS,UAF$V_DISACNT)) THEN ! DISUSER? - WRITE (6,' - & ('' ERROR: BBOARD account needs DISUSER flag set.'')') - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_FILE(7) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - IF (.NOT.IER1) THEN - WRITE (6,'('' WARNING: BBOARD account not in SYSUAF'', - & '' file. Assuming mail forwarding entry.'')') - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_FILE(4) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_FILE(4) - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_FILE(7) - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_FILE(7) - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE - CALL CLOSE_FILE(7) - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL MODIFY_SYSTEM_LIST - CALL CLOSE_FILE(7) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME,DUMMY - CHARACTER NODENAME*8 - - CALL OPEN_FILE(4) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,DUMMY,NEW_FLAG,SYSTEM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - CALL CLOSE_FILE(4) - RETURN - END IF - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM',NODENAME,DUMMY,NEW_FLAG,SYSTEM_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,DUMMY,NEW_FLAG,SYSTEM_FLAG - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,FOLDER_SAVE*25 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_FILE_SHARED(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_FILE(7) - RETURN - END IF - CALL CLOSE_FILE(7) - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for GENERAL folder.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - IF (.NOT.NODE_SET) THEN - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - FOLDER1 = FOLDER - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_FILE(2) ! Remove directory file - CALL OPEN_FILE(1) ! Remove bulletin file - CALL CLOSE_FILE_DELETE(1) - CALL CLOSE_FILE_DELETE(2) - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_FILE(7) - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_FILE_SHARED(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_FILE(7) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND(STATUS) -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - CHARACTER INPUT*80,FROM_TEST*5 - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_NEGATED - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - BULL_PARAMETER = 'RE: '//DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P) - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - LEN_P = TRIM(BULL_PARAMETER) - - IF (BULL_PARAMETER(:1).NE.'"') THEN - BULL_PARAMETER = '"'//BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + 1 - END IF - - IF (BULL_PARAMETER(LEN_P:LEN_P).NE.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'"' - LEN_P = LEN_P + 1 - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - ELSE - EDIT = .FALSE. - END IF - - IF (EDIT.AND.CLI$PRESENT('TEXT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - ILEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - END IF - - IF (CONFIRM_USER(FROM).EQ.0) THEN - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//FROM - & //'/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT '//FROM//'/SUBJECT='// - & BULL_PARAMETER,,,,,,STATUS) - END IF - CALL ENABLE_PRIVS - ELSE - FROM_TEST = ' ' - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - L_INPUT = 81 - I = BLOCK - DO WHILE (I.LT.BLOCK+LENGTH.AND.L_INPUT.GT.0) - CALL GET_BULL(I,INPUT,L_INPUT) - IF (L_INPUT.GT.0) THEN - CALL STR$UPCASE(FROM_TEST,INPUT(:5)) - IF (FROM_TEST.EQ.'FROM:') THEN - IF (INDEX(INPUT,'.').GT.0.OR.INDEX(INPUT,'@').GT.0 - & .OR.INDEX(INPUT,'%').GT.0) THEN - L_INPUT = 0 - END IF - END IF - ELSE IF (L_INPUT.EQ.0) THEN - L_INPUT = 80 - I = I + 1 - END IF - END DO - CALL CLOSE_FILE(1) - IF (FROM_TEST.EQ.'FROM:') THEN - L_B = INDEX(INPUT,'<') - R_B = INDEX(INPUT,'>') - IF (L_B.GT.0.AND.R_B.GT.0) THEN - INPUT = INPUT(L_B+1:R_B-1) - L_INPUT = R_B - 1 - L_B - ELSE - L_INPUT = TRIM(INPUT) - I = 6 - DO WHILE (INPUT(I:I).EQ.' '.AND.I.GT.0) - I = I + 1 - IF (I.GT.L_INPUT) I = 0 - END DO - INPUT = INPUT(I:L_INPUT) - L_INPUT = L_INPUT - I + 1 - END IF - CALL DISABLE_PRIVS -C -C The commented lines contain modifications to interace with PMDF -C using the in% syntax - Jim Gerland 29-Dec-1987 -C -C K = INDEX (Input, '%') -C If (K .GT. 0) Then -C Input = Input (K+1:L_Input) -C L_Input = l_Input - K -C End If -C - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') -C -C For PMDF, uncomment the following lines and deleted the 3 lines -C in the actual code. -C -C CALL LIB$SPAWN ('$MAIL SYS$LOGIN:BULL.SCR "IN%"' -C & //INPUT(:L_INPUT)// -C & '""/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) -C - CALL LIB$SPAWN('$CHMAIL SYS$LOGIN:BULL.SCR "' - & //INPUT(:L_INPUT)// - & '@XX"/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSE -C -C For PMDF, uncomment the following lines and deleted the 2 lines -C in the actual code. -C -C CALL LIB$SPAWN ('$MAIL SYS$INPUT "IN%"' -C & //INPUT(:L_INPUT)// -C & '""/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) -C - CALL LIB$SPAWN('$CHMAIL/I "'//INPUT(:L_INPUT)// - & '@XX"/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - END IF - CALL ENABLE_PRIVS - ELSE - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//FROM - & //'/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT '//FROM//'/SUBJECT=' - & //BULL_PARAMETER,,,,,,STATUS) - END IF - CALL ENABLE_PRIVS - END IF - END IF - - IF (EDIT) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_FILE_SHARED(8) - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_FILE(8) - - RETURN - END - - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: Replaces existing bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*8 - CHARACTER INDESCRIP*80,INPUT*80 - CHARACTER*1 ANSWER - - CHARACTER DATE_SAVE*11,TIME_SAVE*8 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL*1 DOALL - -C -C Get the bulletin number to be replaced. -C - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are reading - ELSE - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletin - - CALL CLOSE_FILE(2) - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person - RETURN ! and error out - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND. - & USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:20) - END IF - -8 IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) DESLEN,INDESCRIP - IF (DESLEN.EQ.0) GO TO 910 ! If no header, don't add bull - IF (DESLEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - GO TO 8 ! and re-request header - END IF - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,DESLEN) - IF (DESLEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - GO TO 910 ! and abort - END IF - END IF - - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy mesage into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 5 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - ILEN = 80 - END DO -5 CALL CLOSE_FILE(1) - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.80) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED', - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = 80 ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.80) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > 80. Reinput::'')') - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_FILE(2) - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.CLI$PRESENT('TEXT')) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN ! If text has been replaced - - LENGTH_SAVE = LENGTH ! Copy BULL modifies LENGTH - - CALL OPEN_FILE(1) ! Prepare to add bulletin - ICOUNT = (ICOUNT+127)/128 - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - NBLOCK = NBLOCK + ICOUNT - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL COPY_BULL(3,REC1,BLOCK,IER) ! Replace old bulletin - - CALL CLOSE_FILE(1) - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = ICOUNT ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (CLI$PRESENT('HEADER').OR.CLI$PRESENT('SUBJECT') - & .OR.DOALL) THEN - DESCRIP=INDESCRIP(:53) ! Update description header - END IF - CALL UPDATE_DIR_HEADER(CLI$PRESENT('EXPIRATION').OR.DOALL, - & CLI$PRESENT('PERMANENT'),CLI$PRESENT('SHUTDOWN'), - & INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT')) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (.NOT.CLI$PRESENT('HEADER').AND..NOT. - & CLI$PRESENT('SUBJECT').AND..NOT.DOALL) INDESCRIP = DESCRIP - IF (CLI$PRESENT('EXPIRATION')) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(:53),MSGTYPE,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - - CALL CLOSE_FILE(2) ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be - & truncated to:') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER TODAY*23,INEXDATE*11,INEXTIME*8 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00' - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:20) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - - CHARACTER*132 SEARCH_STRING,SAVE_STRING - DATA SEARCH_STRING /' '/, SEARCH_LEN /1/ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL DISABLE_CTRL - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_POINT - BULL_POINT = BULL_POINT - 1 - END IF - - SAVE_STRING = SEARCH_STRING - SAVE_LEN = SEARCH_LEN - - IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - - IF (.NOT.IER) THEN ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - SEARCH_LEN = SAVE_LEN - ELSE IF (.NOT.CLI$PRESENT('START')) THEN ! If string entered but no - BULL_POINT = 0 ! starting message, use first - END IF - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(0,IER) - - IF (BULL_POINT+1.GT.NBULL) THEN - WRITE (6,'('' ERROR: No more messages.'')') - CALL CLOSE_FILE(2) - CALL ENABLE_CTRL - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) - - CALL DECLARE_CTRLC_AST - - DO BULL_SEARCH = BULL_POINT+1, NBULL - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1) THEN - CALL STR$UPCASE(DESCRIP,DESCRIP) ! Make upper case - IF (INDEX(DESCRIP,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - END IF - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_POINT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = 81 - DO J=BLOCK,BLOCK+LENGTH-1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL(J,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CALL ENABLE_CTRL - RETURN - END IF - END DO - ILEN = 80 - END DO - END IF - END DO - -900 CALL CANCEL_CTRLC_AST - - CALL CLOSE_FILE(1) ! End of bulletin file read - CALL CLOSE_FILE(2) - - CALL ENABLE_CTRL - - WRITE (6,'('' No messages found with given search string.'')') - - RETURN - END - - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_FILE(2) - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')') - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_FILE(2) - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END diff --git a/decus/vax88a2/bulletin/bulletin3.for b/decus/vax88a2/bulletin/bulletin3.for deleted file mode 100644 index 2e2eac2..0000000 --- a/decus/vax88a2/bulletin/bulletin3.for +++ /dev/null @@ -1,1346 +0,0 @@ -C -C BULLETIN3.FOR, Version 3/28/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE - CHARACTER*8 TEMP_TIME,TEMP_EXTIME - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00' ! bulletin date if deletion occurs - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF (SYSTEM.LE.3.OR.(SHUTDOWN.EQ.0 ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - DIFF = 0 ! If so, delete it - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF (SYSTEM.LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date so when we quit - TEMP_TIME = TIME ! search, we'll have the - END IF ! latest bulletin date - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - NEW_SHUTDOWN = SHUTDOWN - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - CALL UPDATE_FOLDER -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - CALL CLOSE_FILE(4) - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_FILE_SHARED(2) ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_FILE(2) - RETURN - ELSE - START = START + 1 - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_FILE(2) - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(INPUT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*20 INPUT - CHARACTER*23 TODAY - - DIMENSION EXTIME(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',INPUT,ILEN) - - PROMPT = .TRUE. - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - WRITE(6,1030) TODAY ! Prompt for expiration date - CALL GET_LINE(INPUT,ILEN) ! Get input line - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - INPUT = INPUT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(INPUT,'-').EQ.0.AND.INDEX(INPUT,':').GT.0.AND. - & INDEX(INPUT(:ILEN),' ').EQ.0) THEN - INPUT = TODAY(:INDEX(TODAY(2:),' ')+1)//INPUT - END IF - - CALL STR$UPCASE(INPUT,INPUT) ! Convert to upper case - IER = SYS_BINTIM(INPUT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - GO TO 5 - END IF - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - END IF - - IF (INPUT(2:2).EQ.'-') INPUT = '0'//INPUT - IER = COMPARE_DATE(INPUT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limit - GO TO 5 - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(INPUT(13:20),TODAY(13:20)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - GO TO 5 ! and re-request date - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A23, - &'. Specify when the message should expire:',/,1x, - &'Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - &'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large. - & Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - IF (IER.NE.SS$_NORMAL) MAIL_EDIT = 'SYS$SYSTEM:MAILEDIT' - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - CALL ENABLE_PRIVS - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0) THEN - CALL EDT$EDIT(INFILE,OUT) - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN - CALL TPU$EDIT(INFILE,OUT) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - ! TPU does CLI$ stuff which wipes our parsed command line - END IF - - RETURN - END - - - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($JPIDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15 - - DIMENSION SAVEPRIV(2) - - CALL DISABLE_PRIVS ! Just let real privileged people do a /STARTUP - - CALL SYS$SETPRV(%VAL(1),PROCPRIV,,SAVEPRIV) ! Enable original priv - - IF (TEST_BULLCP()) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXIT - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1 - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP') - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0)) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM','NL:' - & ,,,,'BULLCP',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - CALL SYS$SETPRV(%VAL(0),SAVEPRIV,,) ! Reset privs - - CALL ENABLE_PRIVS - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP /.FALSE./ - - CHARACTER*1 DUMMY - - IER = SYS_TRNLNM('BULL_BULLCP',DUMMY) - IF (IER) BULLCP = .TRUE. - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - BULLCP = .FALSE. ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL START_DECNET - - DO WHILE (1) ! Loop once every 15 minutes - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connectiosn - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - CALL DELETE_EXPIRED ! Delete expired messages - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL WAIT('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME,DUMMY(2) - CHARACTER NODENAME*8 - - CALL OPEN_FILE(4) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,DUMMY,NEW_FLAG,SYSTEM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - END IF - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM',NODENAME,DUMMY,NEW_FLAG,SYSTEM_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,DUMMY,NEW_FLAG,SYSTEM_FLAG - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - - - - SUBROUTINE WAIT(PARAM) -C -C SUBROUTINE WAIT -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(6:7) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(2)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(9:10) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - - SUBROUTINE DELETE_EXPIRED - -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER UPTIME_DATE*11,UPTIME_TIME*8 - - CALL OPEN_FILE_SHARED(2) ! Open directory file - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - CALL CLOSE_FILE(1) - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2))) THEN - ! Do shutdown bulletins exist? - CALL GET_UPTIME(UPTIME_DATE,UPTIME_TIME) - IER1 = COMPARE_DATE(SHUTDOWN_DATE,UPTIME_DATE) - IF (IER1.EQ.0) IER1 = COMPARE_TIME(SHUTDOWN_TIME,UPTIME_TIME) - IF (IER1.LE.0) SHUTDOWN = 0 - ELSE - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_FILE(4) ! Create user file to be able to set - CALL CLOSE_FILE(4) ! defaults, privileges, etc. - END IF - CALL CLOSE_FILE(2) - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*74,INFROM*74,INTO*76,INPUT*132 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL SYS$SETAST(%VAL(0)) - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_FILE(7) ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD.EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=110) - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - LEN_INPUT = 1 - DO WHILE (LEN_INPUT.GT.0) - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - IF (INDEX(INTO,FOLDER_BBOARD(:FLEN)).EQ.0.AND. - & INTO.NE.FOLDER_BBOARD) THEN - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOLDER1_BBOARD = FOLDER_BBOARD - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - FOLDER_Q2_SAVE = FOLDER_Q2 - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - FLEN = TRIM(FOLDER1_BBOARD) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD.NE.'NONE') THEN - IF (INTO.EQ.FOLDER1_BBOARD) THEN - FOUND = .TRUE. - ELSE - FIND_TO = INDEX(INTO,FOLDER1_BBOARD(:FLEN)) - IF (FIND_TO.GT.0) THEN - END_TO = FLEN+FIND_TO - IF (TRIM(INTO).LT.END_TO.OR. - & INTO(END_TO:END_TO).LT.'A'.OR. - & INTO(END_TO:END_TO).GT.'Z') THEN - IF (FIND_TO.EQ.1) THEN - FOUND = .TRUE. - ELSE IF (INTO(FIND_TO-1:FIND_TO-1).LT.'A'.OR. - & INTO(FIND_TO-1:FIND_TO-1).GT.'Z') THEN - FOUND = .TRUE. - END IF - END IF - END IF - END IF - END IF - END DO - IF (FOUND) THEN - IF (F_NBULL.NE.NBULL) CALL UPDATE_FOLDER - FOLDER_COM = FOLDER1_COM - FOLDER_Q_SAVE = FOLDER_Q2_SAVE - END IF - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - FOLDER_SET = .FALSE. - ELSE - FOLDER_SET = .TRUE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - -C -C Add bulletin to bulletin file and directory entry to directory file. -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - IF (IER.NE.0) GO TO 100 ! If end of file, exit - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) GO TO 5 - ! If line is just form feed, the message is empty - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - OCOUNT = NBLOCK + 1 ! Initialize line count - - SPACE = INDEX(INFROM,' ') - 1 ! Strip off the date - IF (SPACE.GT.0) INFROM = INFROM(:SPACE)! From the "From:" line - - IF (TRIM(INFROM).GT.12) THEN ! Is length > allowable? - LEN_INFROM = TRIM(INFROM) - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & OCOUNT) - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) - I = 12 ! Trim username to first non-alpha character - DO WHILE (I.GT.1.AND. - & ((INFROM(I:I).GE.'A'.AND.INFROM(I:I).LE.'Z').OR. - & (INFROM(I:I).GE.'a'.AND.INFROM(I:I).LE.'z')) ) - I = I - 1 - END DO - IF (I.GT.1) INFROM = INFROM(:I-1) - END IF - - LEN_DESCRP = TRIM(INDESCRIP) - IF (LEN_DESCRP.GT.53) THEN ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//INDESCRIP(:LEN_DESCRP), - & OCOUNT) - INDESCRIP = INDESCRIP(:LEN_DESCRP) - DO I=1,LEN_DESCRP - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - ELSE - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - END IF - - ISTART = 0 - NBLANK = 0 - DO WHILE (INPUT(:1).NE.CHAR(12)) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - NBLANK = 0 - CALL STORE_BULL(MIN(LEN_INPUT,80),INPUT,OCOUNT) - IF (LEN_INPUT.GT.80) THEN ! Breakup line if > 80 chars - CALL STORE_BULL(MIN(LEN_INPUT,132)-80,INPUT(81:),OCOUNT) - END IF - END IF - READ (3,'(Q,A)',END=25) LEN_INPUT,INPUT - END DO - -25 CALL FLUSH_BULL(OCOUNT) - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - DESCRIP = INDESCRIP(:53) ! Description header - FROM = INFROM(:12) ! Username - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - EXTIME = '00:00:00' - LENGTH = OCOUNT - NBLOCK ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - -30 CALL CLOSE_FILE(2) ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CALL UPDATE_FOLDER - -110 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GOTO 1 - -900 FOLDER_NUMBER = 0 - - CALL OPEN_FILE_SHARED(7) - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_FILE(7) - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_FILE(4) - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_FILE(4) - END IF - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - WRITE (6,1030) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:' - & ,,,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL EXE$GL_ABSTIM - INTEGER UPTIME(2),SYSTIME(2),UPSINCE(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - UPTIME(1) = GET_L_VAL(EXE$GL_ABSTIM) ! Up time (sec) - - CALL LIB$EMUL(10000000,UPTIME,0,UPTIME) ! 64 bit format - CALL SYS$GETTIM(SYSTIME) - CALL LIB$SUBX(SYSTIME,UPTIME,UPSINCE) - CALL SYS$ASCTIM(,ASCSINCE,UPSINCE,) ! Up since - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:20) - - RETURN - END - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*35 - EQUIVALENCE (INPUT(34:),COUNT) - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL',DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF ((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)) THEN ! If normal BBOARD or /VMSMAIL - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER) INPUT - IF (IER.EQ.0.AND.COUNT.GT.0) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2),DIR_BTIM(2) - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE - CALL READDIR(1,IER) - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFFB = COMPARE_BTIM(IN_BTIM,DIR_BTIM) - IF (DIFFB.LE.0) THEN - START = 0 - RETURN - END IF - CALL READDIR(NBULL,IER) - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFFT = COMPARE_BTIM(IN_BTIM,DIR_BTIM) - IF (DIFFT.GT.0.OR.IER.EQ.NBULL) THEN - START = -1 - RETURN - END IF - BOT = 0 - TOP = NBULL + 1 - DIFFB = 0 - NCHECKS = 0 - DO WHILE (DIFFB.LE.0.OR.DIFFT.GT.0) - START = (TOP+BOT) / 2 - CALL READDIR(START,IER) - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFFB = COMPARE_BTIM(IN_BTIM,DIR_BTIM) - CALL READDIR(START+1,IER) - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFFT = COMPARE_BTIM(IN_BTIM,DIR_BTIM) - IF (DIFFB.GT.0) THEN - BOT = START + 1 - ELSE - TOP = START - END IF - NCHECKS = NCHECKS + 1 -C -C It should never happen, but test to see if can't find -C newest message, to avoid looping forever. -C - IF (NCHECKS.GT.NBULL) RETURN - END DO - END IF - - RETURN - END diff --git a/decus/vax88a2/bulletin/bulletin4.for b/decus/vax88a2/bulletin/bulletin4.for deleted file mode 100644 index f3331cf..0000000 --- a/decus/vax88a2/bulletin/bulletin4.for +++ /dev/null @@ -1,1446 +0,0 @@ -C -C BULLETIN4.FOR, Version 3/24/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist -C if it creates empty space for new user. -C - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CALL OPEN_FILE_SHARED(8) - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_FILE(9) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_FILE(9) - END IF - - CALL CLOSE_FILE(8) ! All done... - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - CHARACTER INPUT*80 - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),80) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*(BRECLEN) - - DATA POINT/0/ - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT) - POINT = 0 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,INPUT,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128,LINE_LENGTH=80 - - CHARACTER INPUT*(*),TEMP*(BRECLEN), LEFT*(BRECLEN) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (ILEN.GT.LINE_LENGTH) THEN - POINT = 1 - LEFT_LEN = 0 - END IF - - IF (POINT.EQ.1) THEN - IF (REMOTE_SET) THEN - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) - ELSE - DO WHILE (REC_LOCK(IER)) - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN - ILEN = 0 - POINT = 1 - RETURN - END IF - - IF (IER.GT.0) THEN - ILEN = -1 - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN - ILEN = ICHAR(LEFT(:1)) - INPUT = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) - POINT = LEFT_LEN + 1 - LEFT_LEN = 0 - ELSE - ILEN = ICHAR(TEMP(POINT:POINT)) - IF (ILEN.GT.BRECLEN-POINT) THEN - LEFT = TEMP(POINT:) - LEFT_LEN = ILEN - (BRECLEN-POINT) - ILEN = 0 - POINT = 1 - ELSE IF (ILEN.EQ.0) THEN - POINT = 1 - ELSE - INPUT = TEMP(POINT+1:POINT+ILEN) - POINT = POINT+ILEN+1 - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(ILEN) - - IF (POINT.EQ.BRECLEN+1) THEN - ILEN = 0 - ELSE - ILEN = ICHAR(TEMP(POINT:POINT)) - END IF - - RETURN - - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*128 INPUT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) THEN - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*80 INPUT - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - IF (BTEST(FOLDER_FLAG,1)) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - WRITE (3,1050) DESCRIP ! Output bulletin header info - WRITE (3,1060) FROM,DATE - - CALL OPEN_FILE(1) - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - ILEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - END IF - -900 DELETE(UNIT=2,REC=BULL_ENTRY+1) - - NEMPTY = NEMPTY + LENGTH - CALL WRITEDIR(0,IER) - -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/) - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limit - POINTER = 0 ! during input. - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10)) - & .OR.INCHAR(I:I).GT.'~') INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLC_FLAG/ FLAG - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$CREATE_KEY_TABLE (KEY_TABLE_ID) - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGLEN(PAGE_LENGTH) -C -C SUBROUTINE GETPAGLEN -C -C FUNCTION: -C Gets page length of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = DEVDEPEND(4) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($PRVDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_FILE(4) - CALL OPEN_FILE(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*8 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,LEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:LEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_FILE(4) ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN - - END - - - - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privileged - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'( - & '' ERROR: No privs for SYSTEM, NOTIFY, BRIEF or READNEW.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - FOLDER1 = FOLDER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - WRITE (6,'('' Enter one line description of folder.'')') - -10 CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - GO TO 10 - END IF - - CALL OPEN_FILE(7) ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - FOLDER_OWNER = USERNAME ! Get present username - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',IOSTAT=IER, - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - REMOTE_SET = .TRUE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - FOLDER_OWNER = USERNAME ! Get present username - - IF (CLI$PRESENT('SYSTEM')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_FILE(7) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - diff --git a/decus/vax88a2/bulletin/bulletin5.for b/decus/vax88a2/bulletin/bulletin5.for deleted file mode 100644 index 67264d3..0000000 --- a/decus/vax88a2/bulletin/bulletin5.for +++ /dev/null @@ -1,1438 +0,0 @@ -C -C BULLETIN5.FOR, Version 3/27/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (.NOT.SETPRV_PRIV().AND.INCMD(:3).EQ.'SET') THEN - WRITE (6,'( - & '' ERROR: No privs to change all defaults.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_HEADER(IER) - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - - IF (BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - CALL CLOSE_FILE(4) - - RETURN - END - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL OPEN_FILE(2) ! Remove directory file - CALL OPEN_FILE(1) ! Remove bulletin file - CALL CLOSE_FILE_DELETE(1) - CALL CLOSE_FILE_DELETE(2) - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) FOLDER_SET = .FALSE. - -1000 CALL CLOSE_FILE(7) - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - EXTERNAL CLI$_ABSENT - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1,FLEN) - IF (IER.AND.FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - ENDIF - - CALL OPEN_FILE_SHARED(7) ! Go find folder - - REMOTE_TEST = 0 - - IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP - END IF - - CALL CLOSE_FILE(7) - - IF (IER.EQ.0.AND.FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to connect to folder.'')') - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! & local flag info - CALL OPEN_FILE(7) ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE - CALL CLOSE_FILE(7) - END IF - REMOTE_SET = .TRUE. - END IF - - IF (IER.EQ.0) THEN ! Folder found - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::' - & .AND..NOT.SETPRV_PRIV()) THEN - ! Is folder protected and not remote? - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER) THEN - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - REWRITE (4) USER_ENTRY - CALL CLOSE_FILE(4) - END IF - IER = 0 - RETURN - END IF - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (FOLDER1_BBOARD(:2).NE.'::') THEN - IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - END IF - - IF (IER) THEN - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0) THEN - IF (TEST_BULLCP()) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (IER.LE.0) CALL UPDATE ! Need to update - ELSE - NBULL = 0 - END IF - CALL CLOSE_FILE(2) - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (FOLDER_NUMBER.NE.0) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - RETURN - - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - - DIMENSION DUMMY(2) - - REMOTE_UNIT = 31 - REMOTE_UNIT - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD)) - & //'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - REWRITE (4) USER_ENTRY - CALL CLOSE_FILE(4) - END IF - END IF - IER = 2 - ELSE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - CLOSE (UNIT=31-REMOTE_UNIT) - IF ((FOLDER_NUMBER.NE.FOLDER1_NUMBER.AND.(DUMMY(1).NE.0 - & .OR.DUMMY(2).NE.0)).OR.FOLDER1_NUMBER.EQ.-1) THEN - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - END IF - IER = 0 - END IF - - RETURN - END - - - - - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_FILE_SHARED(7) ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_FILE(7) - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT - - CALL OPEN_FILE_SHARED(7) ! Open folder file - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).NE.%LOC(CLI$_ABSENT)) - & THEN -10 CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_FILE(7) - RETURN - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - ELSE IF (FOLDER_SET) THEN - WRITE (6,1000) FOLDER,FOLDER_OWNER, - & FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - FOLDER1_FILE = FOLDER_FILE - FOLDER1_BBOARD = FOLDER_BBOARD - FOLDER1_BBEXPIRE = FOLDER_BBEXPIRE - FOLDER1_NUMBER = FOLDER_NUMBER - FOLDER1_FLAG = FOLDER_FLAG - F1_EXPIRE_LIMIT = F_EXPIRE_LIMIT - ELSE - FOLDER1 = 'GENERAL' - GO TO 10 - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - WRITE (6,'('' Folder is not a private folder.'')') - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB.EQ.0.AND.GROUPB.EQ.0).OR.BTEST(USERB,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' BBOARD expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE - WRITE (6,'('' BBOARD messages will not expire.'')') - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_HEADER(IER) - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is BRIEF.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is SHOWNEW.'')') - ELSE - WRITE (6,'('' Default is NOREADNEW.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY.'')') - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_FILE(4) - END IF - END IF - - CALL CLOSE_FILE(7) - - RETURN - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - CHARACTER*17 DATETIME - - EXTERNAL CLI$_NEGATED,CLI$_PRESENT - - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE specified - ELSE - NLINE = 1 - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_INFO) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDER = 0 - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_INFO) - END IF - END DO - - CALL CLOSE_FILE(7) ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - - IF (.NOT.PAGING) THEN - DISPLAY = (NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2 - ELSE - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2,PAGE_LENGTH-4) - ! If more entries than page size, truncate output - END IF - - DO I=FOLDER_COUNT,FOLDER_COUNT+(DISPLAY-2)/NLINE-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_INFO) - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counter - END DO - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*25,RESPONSE*1 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',ID,LEN) ! Get ID - IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: ID name must be < 26 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_FILE(7) - - IF ((.NOT.ALL).AND.(ID.EQ.FOLDER1_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Cannot modify access for owner of folder.'')') - RETURN - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - IF (ACCESS) THEN - IF (.NOT.ALL) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL DEL_ACL(' ','R+W',IER) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - END IF - ELSE - IF (ALL) THEN - CALL DEL_ACL('*','R',IER) - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' ERROR: Cannot modify ACL of folder files.'')') - CALL SYS_GETMSG(IER) - ELSE - WRITE (6,'('' Access to folder has been modified.'')') -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - CALL OPEN_FILE(7) ! Open folder file - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_FILE(7) - END IF - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C -C NOTE: SYS$CHECK_ACCESS is only available under V4.4 or later. -C If you have an earlier version, comment out the lines which call -C it and set both READ_ACCESS and WRITE_ACCESS to 1, which will -C allow program to run, but will not allow READONLY access feature. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - ENTRY WRITE_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE - - REWRITE (7) FOLDER_COM - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP - - REWRITE (7) FOLDER1_COM - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END DO - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - SET_FLAG(1) = SET_FLAG_DEF(1) - SET_FLAG(2) = SET_FLAG_DEF(2) - BRIEF_FLAG(1) = BRIEF_FLAG_DEF(1) - BRIEF_FLAG(2) = BRIEF_FLAG_DEF(2) - NOTIFY_FLAG(1) = NOTIFY_FLAG_DEF(1) - NOTIFY_FLAG(2) = NOTIFY_FLAG_DEF(2) - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_FILE_SHARED(4) - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_FILE_SHARED(4) - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).EQ.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER UAF$V_DISACNT = 4, UAF$L_UIC = '24'X - PARAMETER UAF$L_ACCOUNT = 53 - PARAMETER UAF$L_FLAGS = '1D4'X - PARAMETER INPUT_LEN = UAF$L_FLAGS + 4 - - CHARACTER INPUT*(INPUT_LEN),USERNAME*(*),ACCOUNT*(*) - - EQUIVALENCE (INPUT(UAF$L_UIC+1:),USER2) - EQUIVALENCE (INPUT(UAF$L_UIC+3:),GROUP2) - EQUIVALENCE (INPUT(UAF$L_FLAGS+1:),FLAGS2) - - INTEGER*2 USER2,GROUP2 - - CALL OPEN_FILE_SHARED(8) - - READ (8,KEY=USERNAME,IOSTAT=IER) INPUT - ! Move pointer to top of file - - CALL CLOSE_FILE(8) - - IF (IER.EQ.0) THEN - FLAGS = FLAGS2 - IER = 1 - USER = USER2 - GROUP = GROUP2 - ACCOUNT = INPUT(UAF$L_ACCOUNT:UAF$L_ACCOUNT+7) - END IF - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. Added per request of a faculty member for his private -C board. Changes to BULLETIN.FOR should be fairly obvious. -C -C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2) -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - DATA FOLDER_Q1/0/ - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END DO - - CALL CLOSE_FILE(7) ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - WRITE (6,1000) - WRITE (6,1020) - DO J = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - WRITE (6,1030) - & FOLDER1(:15),F1_NBULL,FOLDER1_DESCRIP(:61) - END DO - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - IF (DIR_COUNT.EQ.0) THEN - F1_NBULL = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - CALL DIRECTORY(DIR_COUNT) - - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1020 FORMAT (' Name Count Description'/) -1030 FORMAT (1X,A15,I3,1X,A) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') - - END diff --git a/decus/vax88a2/bulletin/bulletin6.for b/decus/vax88a2/bulletin/bulletin6.for deleted file mode 100644 index bae3f8c..0000000 --- a/decus/vax88a2/bulletin/bulletin6.for +++ /dev/null @@ -1,1328 +0,0 @@ -C -C BULLETIN6.FOR, Version 3/1/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_FILE(4) - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE '($HLPDEF)' - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P) - & ,LIBRARY,HLP$M_HELP.OR.HLP$M_PROMPT,LIB$GET_INPUT) - - RETURN - END - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE CLOSE_FILE(INPUT) -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C -C INPUT: -C INPUT - Unit number of file to close out. -C 1 = BULLETIN.DAT -C 2 = BULLDIR.DAT -C 4 = BULLUSER.DAT -C 7 = BULLFOLDER.DAT -C 8 = SYS$SYSTEM:SYSUAF.DAT -C - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT) - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE(INPUT) - - IMPLICIT INTEGER (A-Z) - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT,STATUS='DELETE') - - RETURN - END - - - SUBROUTINE OPEN_FILE(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLDIR_ERR,BULLETIN_ERR,BULLUSER_ERR,BULLFOLDER_ERR - EXTERNAL BULLINF_ERR - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2) - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - IER = 0 - - IF (TIMEEFN.EQ.0) CALL LIB$GET_EF(TIMEEFN) - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (INPUT.EQ.2.AND..NOT.REMOTE_SET) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,%VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',IOSTAT=IER, - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW', - & RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & FORM='FORMATTED',IOSTAT=IER2) - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_BULLFILES - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR, - & %VAL(4)) - END IF - END IF - END DO - END IF - - IF (INPUT.EQ.1.AND..NOT.REMOTE_SET) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,%VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_BULLFILE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR, - & %VAL(4)) - END IF - END DO - END IF - - IF (INPUT.EQ.4) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR,%VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_USERFILE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR, - & %VAL(4)) - END IF - END DO - END IF - - IF (INPUT.EQ.7) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLFOLDER_ERR, - & %VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0 ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - END DO - END IF - - IF (INPUT.EQ.9) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLINF_ERR,%VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_INFFILE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLINF_ERR, - & %VAL(4)) - END IF - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - IER = SYS$CANTIM(%VAL(4),) ! Successful, so cancel timer. - - RETURN - END - - SUBROUTINE TIMER_ERR - - IMPLICIT INTEGER (A-Z) - - ENTRY BULLDIR_ERR - WRITE(6,'('' ERROR: Unable to open directory file after 30 secs.'')') - GO TO 10 - - ENTRY BULLETIN_ERR - WRITE(6,'('' ERROR: Unable to open message file after 30 secs.'')') - GO TO 10 - - ENTRY BULLUSER_ERR - WRITE(6,'('' ERROR: Unable to open BULLUSER.DAT after 30 secs.'')') - GO TO 10 - - ENTRY BULLFOLDER_ERR - WRITE(6,'('' ERROR: Unable to open BULLFOLDER.DAT after 30 secs.'')') - GO TO 10 - - ENTRY BULLINF_ERR - WRITE(6,'('' ERROR: Unable to open BULLINF.DAT after 30 secs.'')') - GO TO 10 - -10 CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2) - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - CHARACTER*25 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - IER = 0 - - IF (TIMEEFN.EQ.0) CALL LIB$GET_EF(TIMEEFN) - - CALL DISABLE_CTRL - - IF (INPUT.EQ.2.AND..NOT.REMOTE_SET) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & SHARED,IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_BULLFILES - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - END IF - END IF - END DO - END IF - - IF (INPUT.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_POINT - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (INPUT.EQ.1.AND..NOT.REMOTE_SET) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_BULLFILE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - END IF - END DO - END IF - - IF (INPUT.EQ.4) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_USERFILE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - END IF - END DO - END IF - - IF (INPUT.EQ.7) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - - IF (IER.EQ.0) THEN - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.FOLDER_RECORD/4) THEN - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_BULLFOLDER - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - END IF - END IF - END DO - END IF - - IF (INPUT.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (INPUT.EQ.9) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,%VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_INFFILE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - END IF - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.INPUT.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - CALL OPEN_FILE(INPUT) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL ENABLE_CTRL_EXIT - END IF - - IER = SYS$CANTIM(%VAL(4),) ! Successful, so cancel timer. - - RETURN - END - - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 INPUT - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW', - & RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & IOSTAT=IER) - - NEWEST_EXTIME = '00:00:00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 INPUT,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_FILE(2) - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - - CALL OPEN_FILE(7) - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_FILE(2) - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') INPUT - ILEN = TRIM(INPUT) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,INPUT,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_FILE(2) - GOTO 100 - -200 CALL OPEN_FILE_SHARED(2) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - CHARACTER*80 NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - - EODIR = MAX(INDEX(BULLFOLDER_FILE,':'),INDEX(BULLFOLDER_FILE,']')) - SUFFIX = INDEX(BULLFOLDER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLFOLDER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLFOLDER_FILE,NEW_FILE) - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=9,FILE=BULLFOLDER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - CALL OPEN_FILE_SHARED(2) - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0 - CALL CLOSE_FILE(2) - F_NUMBER = F_NUMBER + 1 - END IF - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=9,STATUS='SAVE') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLFOLDER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*2 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ (2'1,IOSTAT=IER) BULLDIR_HEADER - END DO - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,0 - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - RETURN - END IF - END IF - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) - CALL CLEANUP_DIRFILE(1) - END IF - IF (NEMPTY.EQ.' ') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND..NOT.TEST_BULLCP()) THEN - WRITE (CFOLDER_NUMBER,'(I2)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ(2'ICOUNT+1,IOSTAT=IER) BULLDIR_ENTRY - END DO - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - RETURN - END IF - END IF - END IF - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - UNLOCK 2 - - RETURN - - END - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - IF (BULLETIN_NUM.EQ.0) THEN - WRITE (2'1,IOSTAT=IER) BULLDIR_HEADER - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - END IF - ELSE - WRITE (2'BULLETIN_NUM+1,IOSTAT=IER) BULLDIR_ENTRY - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRY - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - RETURN - - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*) - CHARACTER NOT_ID*3 - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - DO ACCESS_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - IF ((ACCESS_TYPE.EQ.1.AND.INDEX(ACLSTR,'WRITE').GT.0).OR. - & (ACCESS_TYPE.EQ.2.AND.INDEX(ACLSTR,'READ)').GT.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - DO WHILE - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0) - START_ID = START_ID - 1 - END DO - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (ACCESS_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - RECL = RECL/8 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - diff --git a/decus/vax88a2/bulletin/bulletin7.for b/decus/vax88a2/bulletin/bulletin7.for deleted file mode 100644 index 19a0242..0000000 --- a/decus/vax88a2/bulletin/bulletin7.for +++ /dev/null @@ -1,1460 +0,0 @@ -C -C BULLETIN7.FOR, Version 3/28/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - INCLUDE '($SSDEF)' - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - CHARACTER OUTPUT*160,TERMINAL*8 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_FILE_SHARED(4) - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_FILE(4) - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -C -C Set flags in all user entries that have SET READNEW on the particular -C folder to indicate that a new bulletin is present for the particular folder. -C Also send broadcast if notify flag set. -C - OUTPUT = BELL//CR//LF//LF//'New bulletin added to folder '// - & FOLDER(1:TRIM(FOLDER))//'. From: '//FROM(1:TRIM(FROM))// - & CR//LF//'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IF (ADD_BULL) THEN - IF (FOLDER_NUMBER.GT.0) THEN - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - END IF - - IF (ADD_BULL) THEN - IER = 1 - DO WHILE (GETUSERS(TEMP_USER,TERMINAL)) - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TERMINAL(:TRIM(TERMINAL)),%VAL(BRK$C_DEVICE),,,,,,,) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - END DO - END IF - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_FILE(4) - - RETURN - - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(1:11) - NEWEST_TIME = TODAY_TIME(13:20) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:20) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*3600 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*8 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:20) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.PROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - CHARACTER*23 TODAY - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_FILE_SHARED(7) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_FILE(7) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_FILE_SHARED(4) ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS$ASCTIM(,TODAY,,) - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - CHARACTER*23 TODAY - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_FILE_SHARED(4) ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -C -C SUBROUTINE CONFIRM_PRIV -C -C FUNCTION: Confirms that given username has SETPRV. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C ALLOW - Returns 1 if account has SETPRV. -C returns 0 if account has no SETPRV. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INCLUDE '($PRVDEF)' - - PARAMETER UAF$Q_DEF_PRIV = '1A4'X - - LOGICAL*1 UAF(0:583) - EQUIVALENCE (UAF(UAF$Q_DEF_PRIV),UAF_DEF_PRIV) - - CALL OPEN_FILE_SHARED(8) - ALLOW = 0 ! Set return false - READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Record - IF (STATUS.EQ.0) THEN ! If username found - IF (BTEST(UAF_DEF_PRIV,PRV$V_SETPRV).OR. ! SETPRV or CMRKNL - & BTEST(UAF_DEF_PRIV,PRV$V_CMKRNL)) THEN ! privileges? - ALLOW = 1 ! Yep - END IF - END IF - CALL CLOSE_FILE(8) - RETURN ! Return - END ! End - - - - - - SUBROUTINE CHECK_DISMAIL(USERNAME,DISMAIL) -C -C SUBROUTINE CHECK_DISMAIL -C -C FUNCTION: Checks that given username has DISMAIL. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - PARAMETER UAF$V_DISMAIL = '7'X - PARAMETER UAF$L_FLAGS = '1D4'X - - LOGICAL*1 UAF(0:583) - EQUIVALENCE (UAF(UAF$L_FLAGS),UAF_L_FLAGS) - - CALL OPEN_FILE_SHARED(8) - DISMAIL = 0 ! Set return false - READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Record - IF (STATUS.EQ.0) THEN ! If username found - IF (BTEST(UAF_L_FLAGS,UAF$V_DISMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - CALL CLOSE_FILE(8) - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - - RETURN - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - CALL UPDATE_USERINFO - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FILENAME*132,INPUT*128 - - CALL OPEN_FILE_SHARED(2) - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2'1,IOSTAT=IER) BULLDIR_HEADER - END DO - - FILENAME = FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL' - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_FILE(2) - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - IER = LIB$RENAME_FILE(FILENAME,FILENAME(1:TRIM(FILENAME))//';2') - ! Rename old file name to version number 2 - - IF (.NOT.IER) RETURN - - OPEN (UNIT=11,FILE=FILENAME(1:TRIM(FILENAME))//';1', - 1 STATUS='UNKNOWN',IOSTAT=IER, - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - ! Compressed version is number 1 - - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) INPUT - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) INPUT - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_FILE(1) - CLOSE (UNIT=11) - - NEMPTY = -1 ! Copying done, but not directory updating. - DO WHILE (REC_LOCK(IER)) - WRITE (2'1,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - END DO - END IF - - IER = LIB$DELETE_FILE(FILENAME(1:TRIM(FILENAME))//';2') - ! Can safely delete old file, since NEMPTY = -1 - - FILENAME = FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLDIR' - - OPEN (UNIT=12,FILE=FILENAME(1:TRIM(FILENAME)), - 1 STATUS='NEW',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', - 1 ORGANIZATION='RELATIVE',FORM='FORMATTED') - - WRITE (12'1,'(A)',IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - WRITE (12'I+1,'(A)',IOSTAT=IER) BULLDIR_ENTRY - NBLOCK = NBLOCK + LENGTH - END DO - - DO WHILE (REC_LOCK(IER)) - READ (2'1,IOSTAT=IER) BULLDIR_HEADER ! Read directory header - END DO - - NEMPTY = 0 - WRITE (12'1,'(A)',IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - CLOSE (UNIT=12,STATUS='KEEP') - CALL CLOSE_FILE(2) - - IER = LIB$DELETE_FILE(FILENAME(1:TRIM(FILENAME))//';-1') - ! Delete old directory file - - IER = LIB$RENAME_FILE(FILENAME,FILENAME(1:TRIM(FILENAME))//';') - ! Rename old file name to minimize version number - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - BLOCK_SAVE = BLOCK - K = J + 1 ! Search for duplicate entries - DO WHILE (MOVE_FROM.EQ.0.AND.K.LE.NBULL) - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO=J+1 - MOVE_FROM=K+1 - ELSE - K = K + 1 - END IF - END IF - END DO - J = J + 1 ! If no duplicate entry found for this - CALL READDIR(J,IER) ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - DELETE(UNIT=2,REC=J+1,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - CALL READDIR(FIRST_DELETE,IER) - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - - CALL OPEN_FILE_SHARED(4) ! Open user file - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - WRITE (6,'('' For the selected folder '',A)') FOLDER(1:TRIM(FOLDER)) - - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - END IF - - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND. - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (.NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) USERNAME,TERMINAL - - DATA WILDCARD /-1/ - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) WILDCARD = -1 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ - DATA USERINFO_READ /.FALSE./ - - CALL OPEN_FILE_SHARED(9) - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_FILE(4) - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - IF (IER.EQ.0) WRITE (9) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - - CALL CLOSE_FILE(9) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - COMMON /USERINFO/ USERINFO_READ - - INCLUDE 'BULLUSER.INC' - - IF (.NOT.USERINFO_READ) RETURN - - CALL OPEN_FILE_SHARED(9) - - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - CALL CLOSE_FILE(9) - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - IF (TRIM(TIME).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - DIMENSION LOGIN_BTIM_SAVE(2) - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ ! Update login time - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_FILE_SHARED(7) ! Go find folders - - DO FOLDER_NUMBER = 0,FOLDER_MAX - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (IER.NE.0) THEN - CALL CHANGE_FLAG_NOCMD(0,2) - CALL CHANGE_FLAG_NOCMD(0,3) - CALL CHANGE_FLAG_NOCMD(0,4) - ELSE IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - END IF - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END DO - - CALL CLOSE_FILE(7) - - FOLDER_Q = FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - DO FOLDER_NUMBER = 1,FOLDER_MAX - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - CALL SET2(NEW_MSG,FOLDER_NUMBER) - END IF - END IF - END DO - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new general messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) - END IF - END IF - ELSE ! READNEW mode. - DO FOLDER_NUMBER = 0,FOLDER_MAX - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (FOLDER_NUMBER.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE IF (FOLDER_NUMBER.EQ.0.OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - ELSE ! Can't select the folder - CALL CHANGE_FLAG_NOCMD(0,2) ! then clear SET_FLAG - CALL CHANGE_FLAG_NOCMD(0,3) - END IF - END IF - END DO - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = -1 - FOLDER1 = 'GENERAL' - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to GENERAL folder.'')') - - RETURN - END diff --git a/decus/vax88a2/bulletin/bulletin8.for b/decus/vax88a2/bulletin/bulletin8.for deleted file mode 100644 index 873fb2e..0000000 --- a/decus/vax88a2/bulletin/bulletin8.for +++ /dev/null @@ -1,1246 +0,0 @@ -C -C BULLETIN8.FOR, Version 3/28/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - CHARACTER NAMEDESC*9 /'BULLETIN1'/ - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - CALL SETDDIR('DECNET') - - CALL SETUSER('DECNET') - -C CALL SET_TIMER('02') - - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE SETDDIR(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - CHARACTER SYSUAF*181,USERNAME*(*),DIRECTORY*64 - - EXTERNAL UAF$T_DEFDEV,UAF$T_DEFDIR - - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED) - - READ (8,KEY=USERNAME) SYSUAF - - CLOSE (8) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - DEV = %LOC(UAF$T_DEFDEV) + 1 - LDEV = ICHAR(SYSUAF(DEV:DEV)) - CALL ADD_2_ITMLST - & (LDEV,LNM$_STRING,%LOC(SYSUAF(DEV+1:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - DIR = %LOC(UAF$T_DEFDIR) + 1 - CALL SYS$SETDDIR(SYSUAF(DIR+1:ICHAR(SYSUAF(DIR:DIR))+DIR),,) - - RETURN - END - - - - SUBROUTINE READ_MBX - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN),IO$_READVBLK,MBX_IOSB, - & MBX_AST,,MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*6,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER).NE.' ') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL CONNECT(NODENAME,USERNAME,FROMNAME) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(200),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - CHARACTER*128 INPUT - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - - IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL EXECUTE_COMMAND(UNIT_INDEX) - - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - - RETURN - END - - - - - - SUBROUTINE CONNECT(NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/ - - CHARACTER*(*) USERNAME,FROMNAME - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IF (REJECT.NE.IO_REJECT) THEN - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - EXTERNAL UAF$Q_PRIV - - PARAMETER UAF$K_LENGTH = '584'X - - CHARACTER SYSUAF*(UAF$K_LENGTH),USERNAME*(*) - - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - READ (8,KEY=USERNAME,FMT='(Q,A)',IOSTAT=IER) LUAF,SYSUAF(:LUAF) - - IF (IER.NE.0) THEN - USERNAME = 'DECNET' - READ(8,KEY=USERNAME,FMT='(Q,A)',IOSTAT=IER)LUAF,SYSUAF(:LUAF) - END IF - - CALL LIB$MOVC3(8,%REF(SYSUAF(%LOC(UAF$Q_PRIV)+1:)),PRIV) - - CLOSE (8) - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - END DO - - USERNAME = 'DECNET' - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*100 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF) - - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER) NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - - EXTERNAL ENABLE_CTRL_EXIT,SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2) - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - CHARACTER INPUT*(FOLDER_RECORD+16),DESCRIP_TEMP*53 - CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (INPUT,CMD_TYPE),(INPUT,INQUEUE) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(INPUT)) - - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDER_NAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - NODENAME = NODE_SAVE(UNIT_INDEX) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - IF (OUT_HEAD(UNIT_INDEX).EQ.0) THEN - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - END IF - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15) THEN ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USERNAME,PRIV_SAVE(1,UNIT_INDEX)) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - END IF - END IF - - IF (CMD_TYPE.EQ.1) THEN ! Select folder - FOLDER1 = INPUT(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(INPUT(1:1))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(INPUT(5:5))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(INPUT(9:9))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - ELSE - CALL LIB$MOVC3(4,0,%REF(INPUT(9:9))) - CALL LIB$MOVC3(4,0,%REF(INPUT(13:13))) - END IF - INPUT = INPUT(:16)//FOLDER_COM - CALL WRITE_CHAN(16+LEN(FOLDER_COM),INPUT,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - FOLDER_NAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(53,%REF(INPUT(5:5)),%REF(DESCRIP)) - CALL LIB$MOVC3(11,%REF(INPUT(58:58)),%REF(EXDATE)) - CALL LIB$MOVC3(8,%REF(INPUT(69:69)),%REF(EXTIME)) - CALL LIB$MOVC3(4,%REF(INPUT(77:77)),SYSTEM) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - INPUT = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - RETURN - ELSE IF (SYSTEM.NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF (SYSTEM.NE.0.AND..NOT.SETPRV_PRIV()) THEN ! Priv test - IF (FOLDER_OWNER.NE.USERNAME) THEN - SYSTEM = 0 - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - END IF - CALL LIB$MOVC3(4,%REF(INPUT(81:81)),BROAD) - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(INPUT(85:85)),BELL) - CALL LIB$MOVC3(4,%REF(INPUT(89:89)),ALL) - CALL LIB$MOVC3(4,%REF(INPUT(93:93)),CLUSTER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_FILE(1) - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INPUT) - WRITE (1'NBLOCK+I) INPUT(:128) - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_FILE(1) ! Finished adding bulletin - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_FILE(2) ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) RETURN - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_FILE_SHARED(4) ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND.(TEMP_USER(2:).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_FILE(4) - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - RETURN - END IF - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(1)) - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - IER = SYS$CANTIM(%VAL(1),) - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE_SHARED(2) - CALL READDIR(ICOUNT,IER) - CALL CLOSE_FILE(2) - CALL LIB$MOVC3(4,IER,%REF(INPUT(1:1))) - IF (ICOUNT.GT.0) THEN - INPUT(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,INPUT,UNIT_INDEX,IER) - ELSE - INPUT(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,INPUT,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),SBULL) - CALL LIB$MOVC3(4,%REF(INPUT(9:9)),EBULL) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE_SHARED(2) - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_COM - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_FILE(2) - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_COM) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE(2) - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = INPUT(9:) - CALL WRITEDIR(ICOUNT,IER) - ELSE - BULLDIR_HEADER = INPUT(9:) - CALL WRITEDIR(ICOUNT,IER) - END IF - CALL CLOSE_FILE(2) - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(INPUT(9:9)),IMMEDIATE) - DESCRIP_TEMP = INPUT(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - RETURN - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - RETURN - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE_SHARED(2) - CALL READDIR(ICOUNT,IER) - CALL OPEN_FILE_SHARED(1) - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE(2) - CALL LIB$MOVC3(53,%REF(INPUT(5:5)),%REF(DESCRIP_TEMP)) - CALL LIB$MOVC3(4,%REF(INPUT(58:58)),ICOUNT) - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - RETURN - END IF - CALL LIB$MOVC3(53,%REF(INPUT(62:62)),%REF(DESCRIP)) - CALL LIB$MOVC3(4,%REF(INPUT(115:115)),%REF(MSGTYPE)) - CALL LIB$MOVC3(11,%REF(INPUT(119:119)),%REF(EXDATE)) - CALL LIB$MOVC3(8,%REF(INPUT(130:130)),%REF(EXTIME)) - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - RETURN - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_FILE(1) - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_FILE(1) ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BULL_DELETE) - DESCRIP_TEMP = INPUT(9:61) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - RETURN - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - RETURN - END IF - CALL LIB$MOVC3(11,%REF(INPUT(62:62)),%REF(EXDATE)) - CALL LIB$MOVC3(8,%REF(INPUT(73:73)),%REF(EXTIME)) - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE_SHARED(2) - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(INPUT(5:5)),BULL_POINT) - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_FILE_SHARED(4) - NODENAME = INPUT(9:) - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_FILE(4) - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BLENGTH) - CALL LIB$MOVC3(4,%REF(INPUT(9:9)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(INPUT(13:13)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:1))) - CALL LIB$MOVC3(4,%REF(INPUT(13:13)),ALL) - CALL LIB$MOVC3(4,%REF(INPUT(17:17)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(INPUT(21:21)),FOLDER_NUMBER) - FOLDER = INPUT(25:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.GE.0) RETURN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END diff --git a/decus/vax88a2/bulletin/bullfiles.inc b/decus/vax88a2/bulletin/bullfiles.inc deleted file mode 100644 index e46ef9a..0000000 --- a/decus/vax88a2/bulletin/bullfiles.inc +++ /dev/null @@ -1,37 +0,0 @@ -C -C THE FIRST 2 FILES ARE FILES CREATED AND USED BY BULLETIN. -C SPECIFY THE DEVICE/DIRECTORY IN WHICH YOU DESIRE THAT THEY BE KEPT. -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNT MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU ALSO MAY HAVE -C TO INCREASE SOME SUBPROCESS SYSTEM PARAMETERS: PQL_DPGFLQUOTA AND -C PQL_DWSQUOTA MAY HAVE TO BE CHANGED. (10000 AND 500 ARE TYPICAL). -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNT USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLDIR_FILE,BULLETIN_FILE,BULLUSER_FILE - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLINF_FILE - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C THE FOLLOWING 2 FILES ARE OBSOLETE AS OF V1.1 AND NO LONGER HAVE TO -C BE SPECIFIED. BULLETIN NOW TREATS THE GENERAL FOLDER AS ANY OTHER -C FOLDER. NEW USERS SHOULD JUST LEAVE THEM ALONE. HOWEVER, USERS -C USING OLDER VERSIONS STILL HAVE TO SPECIFY THEM IN ORDER THAT -C BULLETIN KNOWS THE NAMES IN ORDER TO RENAME THEM. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ diff --git a/decus/vax88a2/bulletin/bullfolder.inc b/decus/vax88a2/bulletin/bullfolder.inc deleted file mode 100644 index 64c83a1..0000000 --- a/decus/vax88a2/bulletin/bullfolder.inc +++ /dev/null @@ -1,54 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,5A4)' - PARAMETER FOLDER_RECORD = 173 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - CHARACTER*20 REMOTE_FOLDER_COM - EQUIVALENCE (F_NBULL,REMOTE_FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - CHARACTER*20 REMOTE_FOLDER_COM1 - EQUIVALENCE (F1_NBULL,REMOTE_FOLDER_COM1) -C -C Following is used for folder directory display. Must be multiple of 4. -C The next time the the folder file is modified, it should be made a -C multiple of 4, and then this variable can be deleted. -C - CHARACTER*240 FOLDER1_INFO - EQUIVALENCE (FOLDER1_INFO,FOLDER1_COM) diff --git a/decus/vax88a2/bulletin/bullmain.cld b/decus/vax88a2/bulletin/bullmain.cld deleted file mode 100644 index 02dad8f..0000000 --- a/decus/vax88a2/bulletin/bullmain.cld +++ /dev/null @@ -1,22 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER LOGIN - QUALIFIER PAGE, DEFAULT - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER,DEFAULT="7") diff --git a/decus/vax88a2/bulletin/bullstart.com b/decus/vax88a2/bulletin/bullstart.com deleted file mode 100644 index 7c32393..0000000 --- a/decus/vax88a2/bulletin/bullstart.com +++ /dev/null @@ -1,5 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXIT -$ BULL*ETIN :== $SYS$SYSTEM:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vax88a2/bulletin/bulluser.inc b/decus/vax88a2/bulletin/bulluser.inc deleted file mode 100644 index 7332d91..0000000 --- a/decus/vax88a2/bulletin/bulluser.inc +++ /dev/null @@ -1,42 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Last read times for each folder as stored in SYS$LOGIN:BULLETIN.INF - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vax88a2/bulletin/create.com b/decus/vax88a2/bulletin/create.com deleted file mode 100644 index 21e1cfa..0000000 --- a/decus/vax88a2/bulletin/create.com +++ /dev/null @@ -1,14 +0,0 @@ -$ FORTRAN/EXTEND BULLETIN -$ FORTRAN/EXTEND BULLETIN0 -$ FORTRAN/EXTEND BULLETIN1 -$ FORTRAN/EXTEND BULLETIN2 -$ FORTRAN/EXTEND BULLETIN3 -$ FORTRAN/EXTEND BULLETIN4 -$ FORTRAN/EXTEND BULLETIN5 -$ FORTRAN/EXTEND BULLETIN6 -$ FORTRAN/EXTEND BULLETIN7 -$ FORTRAN/EXTEND BULLETIN8 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ @BULLETIN.LNK diff --git a/decus/vax88a2/bulletin/handout.txt b/decus/vax88a2/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vax88a2/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vax88a2/bulletin/help.com b/decus/vax88a2/bulletin/help.com deleted file mode 100644 index e28ab2f..0000000 --- a/decus/vax88a2/bulletin/help.com +++ /dev/null @@ -1,5 +0,0 @@ -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN - diff --git a/decus/vax88a2/bulletin/install.com b/decus/vax88a2/bulletin/install.com deleted file mode 100644 index f79c375..0000000 --- a/decus/vax88a2/bulletin/install.com +++ /dev/null @@ -1,17 +0,0 @@ -$ COPY BULLETIN.EXE SYS$SYSTEM: -$ RUN SYS$SYSTEM:INSTALL -SYS$SYSTEM:BULLETIN/DEL -SYS$SYSTEM:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vax88a2/bulletin/instruct.com b/decus/vax88a2/bulletin/instruct.com deleted file mode 100644 index 49627f6..0000000 --- a/decus/vax88a2/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vax88a2/bulletin/instruct.txt b/decus/vax88a2/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vax88a2/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vax88a2/bulletin/login.com b/decus/vax88a2/bulletin/login.com deleted file mode 100644 index db24d40..0000000 --- a/decus/vax88a2/bulletin/login.com +++ /dev/null @@ -1,10 +0,0 @@ -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! If you wish bulletins to be displayed upon logging in starting with -$! oldest rather than newest, change BULLETIN/LOGIN to BULLETIN/LOGIN/REVERSE. -$! -$ BULL*ETIN :== $SYS$SYSTEM:BULLETIN -$ BULLETIN/LOGIN diff --git a/decus/vax88a2/bulletin/makefile b/decus/vax88a2/bulletin/makefile deleted file mode 100644 index cf1d76d..0000000 --- a/decus/vax88a2/bulletin/makefile +++ /dev/null @@ -1,71 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Link /NoTrace Bulletin.Obj,Bulletin0.Obj,Bulletin1.Obj,Bulletin2.Obj, - - Bulletin3.Obj,Bulletin4.Obj,Bulletin5.Obj,Bulletin6.Obj, - - Bulletin7.Obj,Bulletin8.Obj, - - Bullcom.Obj,Bullmain.Obj,Allmacs.Obj, - - Sys$System:Sys.Stb /Sel /NoUserlib - Purge /Log /Keep:2 - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* - diff --git a/decus/vax88a2/bulletin/nonsystem.txt b/decus/vax88a2/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vax88a2/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vax88a3/bulletin/bulletin.for b/decus/vax88a3/bulletin/bulletin.for deleted file mode 100644 index 8e53a0f..0000000 --- a/decus/vax88a3/bulletin/bulletin.for +++ /dev/null @@ -1,1180 +0,0 @@ -From: KBSVAX::KANE "Joseph Kane" 31-MAR-1988 21:57 -To: everhart@arisia.DECNET -Subj: forwarded mail from steinmetz - -From uunet!rutgers.edu!Postmaster Thu Mar 31 21:20:53 1988 -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA11569; Thu, 31 Mar 88 21:20:34 est -Received: from RUTGERS.EDU by uunet.UU.NET (5.54/1.14) - id AA01744; Thu, 31 Mar 88 20:45:36 EST -Received: by rutgers.edu (5.54/1.15) - id AB01654; Thu, 31 Mar 88 19:39:28 EST -Date: Thu, 31 Mar 88 19:39:28 EST -From: uunet!rutgers.edu!Postmaster (Mail Delivery Subsystem) -Subject: Returned mail: Host unknown -Message-Id: <8804010039.AB01654@rutgers.edu> -To: -Status: R - - ----- Transcript of session follows ----- -550 ... Host unknown - - ----- Unsent message follows ----- -Received: by rutgers.edu (5.54/1.15) - id AA28952; Thu, 31 Mar 88 15:26:43 EST -Received: from steinmetz.UUCP by uunet.UU.NET (5.54/1.14) with UUCP - id AA11794; Thu, 31 Mar 88 15:23:18 EST -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA06419; Thu, 31 Mar 88 14:45:09 est -Date: 31 Mar 88 10:14:55 EST -From: steinmetz!MAILER-DAEMON@uunet.uu.net (Mail Delivery Subsystem) -Subject: Returned mail: User unknown -Message-Id: <8803311945.AA06419@kbsvax.steinmetz> -To: MRL@pfc-vax.mit.edu - - ----- Transcript of session follows ----- -mail11: %MAIL-E-SYNTAX, error parsing 'CRD' -550 crd.ge.com!EVERHART%ARISIA.DECNET... User unknown - - ----- Unsent message follows ----- -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA06406; Thu, 31 Mar 88 14:45:09 est -Received: by ge-dab.GE.COM (smail2.5) - id AA11476; 31 Mar 88 14:23:58 EST (Thu) -Received: by ge-rtp.GE.COM (smail2.5) - id AA05637; 31 Mar 88 14:00:32 EST (Thu) -Received: by mcnc.mcnc.org (5.54/MCNC/10-20-87) - id AA19593; Thu, 31 Mar 88 12:43:23 EST -From: -Received: by rutgers.edu (5.54/1.15) - id AA19849; Thu, 31 Mar 88 10:20:54 EST -Message-Id: <8803311520.AA19849@rutgers.edu> -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 31 Mar 88 10:16-EST -Date: 31 Mar 88 10:14:55 EST -To: crd.ge.com!xx!EVERHART@ARISIA.DECNET -Subject: BULLETIN.FOR - -C -C BULLETIN.FOR, Version 3/25/88 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) ! Get command line - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - -C -C Test for /LOGIN switch. -C NOTE: /READ has been replaced by the SET READNEW command. -C - - CALL LIB$GET_FOREIGN(INCMD) - - IER = CLI$DCL_PARSE('BULLETIN '//INCMD,BULLETIN_MAINCOMMANDS) - - READIT = 0 - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP')) THEN ! Create bulletin control - CALL CREATE_BULLCP ! subprocess at startup - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - CALL RUN_BULLCP ! doing what BULLCP does! - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - CALL DELETE_EXPIRED ! Delete expired messages - - CALL MODIFY_SYSTEM_LIST - -C -C Get page length for the terminal. -C - - CALL GETPAGLEN(PAGE_LENGTH) - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL SHOW_SYSTEM - CALL EXIT - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder.8 -C: - - CALL OPEN_USERINFO - -Cj -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C2 - 0 - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - 0 -C: -C If new bulletins have been added since the last time bulletins have been9 -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C0 - 0 - CALL NEW_MESSAGE_NOTIFICATIONE - ELSEN - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IFo - - -C- -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from( - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from9 - INDEX_COUNT = 0 - 2 - MAIL_STATUS = 1 - b - DO WHILE (1)e - ( - IF (MAIL_STATUS) THENA - CALL GET_INPUT_PROMPT(INCMD,IER,e - & COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - ELSE - CALL GET_INPUT_PROMPT(INCMD,IER,c - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - MAIL_STATUS = 0 - END IF - . - IF (IER.EQ.-2) THENa - IER = RMS$_EOFo - ELSE IF (IER.LE.0) THENT - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ')- - INCMD = INCMD(2:IER) - IER = IER - 1 - END DOn - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9'). - IER = IER - 1 - END DO3 - IF (IER.EQ.0) INCMD = 'READ '//INCMD- - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - n - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN enterede - LEN_P = 0 ! Indicate no parameter in commandE - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletint - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command$ - END IF - C - DIR_COUNT = 0 ! Reinit display pointersR - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - A - CALL CLI$GET_VALUE('$VERB',INCMD) ! Get the VERB command - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL'P - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THENC - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD bulletin command?L - CALL ADD ! Go add bulletinE - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK command? - IF (BULL_POINT.LE.1) THENN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE command?I - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY command?C - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE command?R - CALL CREATE_FOLDER ! Go create the folderL - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT command? - READ_COUNT = -1 ! Reread current message from beginning.i - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE command?i - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY command? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified?y - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all foldersL - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folderV - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE command? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR.L - & INCMD(:4).EQ.'QUIT') THEN ! EXIT command? - GO TO 999 ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP command?_ - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY)M - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEND - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':') - HLEN = HLEN + 1. - END IF - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get helpD - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX command?) - INDEX_COUNT = 1C - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST command? - READ_COUNT = -1 - BULL_READ = 99999O - CALL READ(READ_COUNT,BULL_READ)P - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL command?T - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY command? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE command?D - CALL MOVE(.TRUE.)L - ELSE IF (INCMD(:4).EQ.'NEXT') THEN ! NEXT command?T - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT command? - CALL PRINT ! Printout bulletinR - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ command? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)s - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified?C - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1' - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE command? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY command? - IF (BULL_POINT.LT.1) THENT - WRITE (6,'('' ERROR: No bulletin currently read.'')') - ELSE - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (DESCRIP(:3).NE.'RE:') THEN - WRITE (6,'(1X,A)') 'RE: '//DESCRIP - ELSE - WRITE (6,'(1X,A)') DESCRIP - END IF - CALL ADDt - END IF - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND command?E - CALL RESPOND(MAIL_STATUS)w - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH command? - CALL SEARCH(READ_COUNT)F - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT command? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET command?$ - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER)R - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'PR') THEN ! SET PRIVS?R - CALL SET_PRIVe - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')')s - ELSE IF (BULL_PARAMETER(:3).EQ.'NOP') THEN ! SET NOPAGE?g - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')')Y - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM?) - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD?E - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:3).EQ.'NOT') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1)? - ELSE IF (CLI$PRESENT('ALL')) THENM - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(1,-2,-2) - ELSEN - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')t - END IF - ELSE - CALL CHANGE_FLAG(1,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)0 - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE?l - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE?O - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0)_ - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1)) - ELSE IF (CLI$PRESENT('ALL')) THEN) - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(0,-2,-2) - ELSE= - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')N - END IF - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'(' - & '' ERROR: SET SHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,1)d - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')e - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(1,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW?i - IF (FOLDER_NUMBER.EQ.0) THENN - WRITE (6,'( - & '' ERROR: SET NOSHOWNEW not allowed for GENERAL folder.'')')T - ELSE IF (CLI$PRESENT('DEFAULT')) THENE - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THENs - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0)o - ELSEd - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')a - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE IF (CLI$PRESENT('ALL')) THEN' - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,0)D - ELSE: - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')' - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THENo - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')l - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF?P - IF (FOLDER_NUMBER.EQ.0) THENM - WRITE (6,'(I - & '' ERROR: SET BRIEF not allowed for GENERAL folder.'')')_ - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,1)O - ELSEL - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')D - END IF - ELSEl - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(1,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (FOLDER_NUMBER.EQ.0) THENd - WRITE (6,'(I - & '' ERROR: SET NOBRIEF not allowed for GENERAL folder.'')')E - ELSE - IF (CLI$PRESENT('DEFAULT')) THENV - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0)( - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')O - END IF - ELSE4 - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IFt - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS?' - CALL SET_ACCESS(.TRUE.)? - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC?I - CALL SET_GENERIC(.FALSE.). - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN?E - CALL SET_LOGIN(.FALSE.)H - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW command?d - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS- - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER) - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SHOW NEW?U - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - DO FOLDER_NUMBER = 0,FOLDER_MAXI - IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER)R - IF (NBULL.GT.0) THEN - DIFF = COMPARE_BTIM( - & LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER))M - END IFs - END IF - END IFA - END DO - FOLDER1 = SAVE_FOLDERC - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER)E - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES?A - CALL SHOW_PRIV - END IF - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE command?V - CALL UNDELETEL - END IF - -100 CONTINUED - ) - END DO) - E -999 CALL EXITa - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - r - END - a - ' - - - SUBROUTINE ADD -CI -C SUBROUTINE ADDE -C -C FUNCTION: Adds bulletin to bulletin file. -C. - IMPLICIT INTEGER (A - Z) - T - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - D - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODEL - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - A - COMMON /DECNET/ DECNET_PROC,ERROR_UNITT - LOGICAL DECNET_PROC - ) - COMMON /EDIT/ EDIT_DEFAULTm - DATA EDIT_DEFAULT/.FALSE./R - R - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - c - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - L - INCLUDE 'BULLDIR.INC' - L - INCLUDE 'BULLUSER.INC'E - ! - INCLUDE 'BULLFOLDER.INC'_ - D - CHARACTER INEXDATE*11,INEXTIME*8_ - CHARACTER*80 INDESCRIP,INPUTS - P - CHARACTER INLINE*80,OLD_FOLDER*25 - CHARACTER PASSWORD*31,DEFAULT_USER*12 - G - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CALL DISABLE_CTRL ! Disable CTRL-Y & -CL - A - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - s - SELECT_FOLDERS = .FALSE.E - IF (CLI$PRESENT('SELECT_FOLDER')) THENW - CALL GET_FOLDER_INFO(IER)m - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE.( - ELSE' - NODE_NUM = 1 - NODES(1) = OLD_FOLDER. - END IF - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)T - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRVS - CALL DISABLE_PRIVS ! privileges when trying toQ - END IF ! create new file.A - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',READONLY,E - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesO - END IF - L - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER)I - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET? - USERNAME = DEFAULT_USER1 - CALL CONFIRM_PRIV(USERNAME,ALLOW)) - END IF - I - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set andA - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IFE - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910O - END IF - E - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privilegesS - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abortP - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IFT - ? - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?- - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abortR - END IF - END IFL - s - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?F - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privilegesN - WRITE(ERROR_UNIT,1081) ! Tell user - GO TO 910 ! and abort' - ELSE IF (F_EXPIRE_LIMIT.GT.0.AND..NOT.ALLOW ! Expiration limit - & .AND.USERNAME.NE.FOLDER_OWNER) THEN ! is present - WRITE(ERROR_UNIT,1083)L - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IFi - e - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privilegesE - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort_ - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bitO - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00' - END IF - END IFA - ' - SELECT_NODES = .FALSE.O - IF (CLI$PRESENT('NODES')) THENC - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE.A - END IF0 - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910F - INEXDATE = INPUT(:11)F - INEXTIME = INPUT(13:20)E - END IF_ - A - IF (INCMD(:3).EQ.'REP'.AND.TRIM(DESCRIP).GT.0) THEN - ! REPLY command and subject present?D - IF (DESCRIP(:4).NE.'RE: ') THEN ! Fill in subject to be - INDESCRIP = 'RE: '//DESCRIP ! RE: the subject of theD - END IF ! message just read. - LENDES = TRIM(INDESCRIP) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified) - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit' - GO TO 910 - END IF - ELSE - LENDES = 54L - DO WHILE (LENDES.GT.53) ! Do until valid description' - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input lineN - IF (LENDES.LE.0) GO TO 910I - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - END IF' - END DO - END IFI - E -CT -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.V -C - N - ICOUNT = 0 ! Line count for bulletin - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THENC - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',6 - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')G - LEN_P = 1 - ELSE - CLOSE (UNIT=3)E - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')L - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IF/ - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count1 - IF (ILEN.GT.80) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80)L - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line withE - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Sratch file to save bulletin. - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = 81 ! Length of input lineI - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.80) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > 80. Reinput:'')')F - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredL - ICOUNT = ICOUNT + 1 + ILEN ! Increment record count - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1) - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch fileW - END IFE - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - T - REWIND (UNIT=3) - R - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN. - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST')). - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT'))F - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - : - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - L - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolons' - ILEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Are semicolon found? - IF (ILEN.GT.SEMI+1) THEN ! Is username found? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! YesM - ILEN = SEMI - 1 ! Remove semicolons - ELSE ! No username found...L - TEMP_USER = DEFAULT_USER ! Set user to defaultO - ILEN = SEMI - 1 ! Remove semicolons - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons present - TEMP_USER = DEFAULT_USER ! Set user to defaultM - END IFO - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0)A - WRITE(6,'('' Enter password for node '',2A)')N - & NODES(POINT_NODE),CHAR(10)L - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910N - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:ILEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER)' - CLOSE (UNIT=10+NODE_NUM)A - IF (IER.NE.0) THENm - WRITE (6,'('' ERROR: Password is invalid.'')') - END IFS - END DOM - INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)= - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,80) - IF (IER.EQ.0) THENe - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN)A - END IF - END DOD - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE)) - ELSEe - WRITE (6,'('' Error while sending message to node '',A)')t - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT - GO TO 940 - END IFF - REWIND (UNIT=3) - END DO - END IFT - Y - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95I - ! Exit if local node not specified. - i - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IFr - ) - -C -C Add bulletin to bulletin file and directory entry for to directory file.c -Cr - BRDCST = .FALSE.T - L - DO I = 1,NODE_NUM - i - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER) THEN - CALL OPEN_FILE(2) ! Prepare to add dir entryt - p - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - LENGTH = (ICOUNT+127)/128 ! Number of records - FROM = USERNAME ! Username/ - M - CALL OPEN_FILE(1) ! Prepare to add bulletin - R - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0b - ' - REWIND (UNIT=3) - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin -C0 -C Broadcast the bulletin if requested.S -CE - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THENi - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'),G - & CLI$PRESENT('CLUSTER')) - END IFS - CALL BROADCAST(u - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER'))E - END IF0 - - CALL CLOSE_FILE(1) ! Finished adding bulletin - I - CALL ADD_ENTRY ! Add the new directory entryF - O - IF (FOLDER_NUMBER.GE.0) THENS - CALL UPDATE_FOLDER ! Update info in folder file -Ce -C If user is adding message, update that user's last read time forO -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IFl - - CALL CLOSE_FILE(2) ! Totally finished with add - ELSE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - END DOB - T -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - h - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THENN - FOLDER_NUMBER = OLD_FOLDER_NUMBERW - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER)E - END IF - R - RETURNa - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100)! - GOTO 100l - N -920 WRITE(6,1020). - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100a - c -930 WRITE (ERROR_UNIT,1025), - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2)0 - CLOSE (UNIT=3)! - GO TO 100 - w -940 WRITE (6,1015) NODES(POINT_NODE) - CLOSE (UNIT=3) - GO TO 100 - i -950 WRITE (6,1030) - CLOSE (UNIT=3)a - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')! -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A)s -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be - & truncated to:') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcastE - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanentf - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -2010 FORMAT(A) -2020 FORMAT(1X,A)+ - + - END - , - L - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER)_ - L - IMPLICIT INTEGER (A-Z)N - O - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*20 - u - INTEGER BTIM(2),TODAY_BTIM(2) - R - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM)O - IF (.NOT.IER) RETURNc - i - BTIM(1) = -BTIM(1) ! Convert to negative delta timel - BTIM(2) = -BTIM(2)-1l - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - i - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - I - I - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - 6 - IMPLICIT INTEGER (A-Z)e - h - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'! - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - u - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - , - CHARACTER*8 LOCALNODE - T - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - E - CALL OPEN_FILE_SHARED(4) - - REMOTE_FOUND = .FALSE.E - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND)S - DO WHILE (REC_LOCK(IER)) N - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG& - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE(4) - RETURNN - END IF) - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO1 - ' - CALL CLOSE (4) - ( - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"')( - L - IF (IER.EQ.0) THENL - IER = 0: - I = 1N - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER)L - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - END IFS - I - CLOSE (UNIT=17) - f - RETURNe - END - I diff --git a/decus/vax88a3/bulletin/bulletin0.for b/decus/vax88a3/bulletin/bulletin0.for deleted file mode 100644 index c46a096..0000000 --- a/decus/vax88a3/bulletin/bulletin0.for +++ /dev/null @@ -1,1279 +0,0 @@ -From: KBSVAX::KANE "Joseph Kane" 31-MAR-1988 20:15 -To: everhart@arisia.DECNET -Subj: forwarded mail - -From uunet!rutgers.edu!Postmaster Thu Mar 31 19:58:35 1988 -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA10584; Thu, 31 Mar 88 19:58:15 est -Received: from RUTGERS.EDU by uunet.UU.NET (5.54/1.14) - id AA26808; Thu, 31 Mar 88 19:38:33 EST -Received: by rutgers.edu (5.54/1.15) - id AA00306; Thu, 31 Mar 88 19:39:25 EST -Date: Thu, 31 Mar 88 19:39:25 EST -From: uunet!rutgers.edu!Postmaster (Mail Delivery Subsystem) -Subject: Returned mail: Host unknown -Message-Id: <8804010039.AA00306@rutgers.edu> -To: -Status: R - - ----- Transcript of session follows ----- -550 ... Host unknown - - ----- Unsent message follows ----- -Received: by rutgers.edu (5.54/1.15) - id AA28973; Thu, 31 Mar 88 15:27:37 EST -Received: from steinmetz.UUCP by uunet.UU.NET (5.54/1.14) with UUCP - id AA11825; Thu, 31 Mar 88 15:24:17 EST -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA06442; Thu, 31 Mar 88 14:45:49 est -Date: 31 Mar 88 10:15:09 EST -From: steinmetz!MAILER-DAEMON@uunet.uu.net (Mail Delivery Subsystem) -Subject: Returned mail: User unknown -Message-Id: <8803311945.AA06442@kbsvax.steinmetz> -To: MRL@pfc-vax.mit.edu - - ----- Transcript of session follows ----- -mail11: %MAIL-E-SYNTAX, error parsing 'CRD' -550 crd.ge.com!EVERHART%ARISIA.DECNET... User unknown - - ----- Unsent message follows ----- -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA06433; Thu, 31 Mar 88 14:45:49 est -Received: by ge-dab.GE.COM (smail2.5) - id AA11506; 31 Mar 88 14:29:38 EST (Thu) -Received: by ge-rtp.GE.COM (smail2.5) - id AA05655; 31 Mar 88 14:00:53 EST (Thu) -Received: by mcnc.mcnc.org (5.54/MCNC/10-20-87) - id AA20091; Thu, 31 Mar 88 13:39:39 EST -From: -Received: by rutgers.edu (5.54/1.15) - id AA19988; Thu, 31 Mar 88 10:26:55 EST -Message-Id: <8803311526.AA19988@rutgers.edu> -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 31 Mar 88 10:16-EST -Date: 31 Mar 88 10:15:09 EST -To: crd.ge.com!xx!EVERHART@ARISIA.DECNET -Subject: BULLETIN0.FOR - -C -C BULLETIN0.FOR, Version 3/19/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - CHARACTER*128 INPUT - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = 81 - DO I=NBLOCK+1,NBLOCK+LENGTH ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL(I,INPUT,ILEN) - END IF - IF (ILEN.LT.0) THEN ! End of bulletin? - RETURN - ELSE IF (ILEN.GT.0) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - ILEN = 80 - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IF - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - - - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53,INPUT*20 - - INTEGER EXBTIM(2),NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER) - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_FILE(2) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.REMOTE_USER.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_FILE(2) - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_FILE(2) ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?" - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSEe - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULLE - IER = 0U - END IF4 - 1 - IF (SBULL.LE.0.OR.IER.NE.0) THEN9 - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.NBULL.AND..NOT.REMOTE_SET.AND.3 - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')')s - WRITE (6,'('' Do you want to delete to end of folder? '',$)'). - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') THEN- - WRITE (6,'('' Deletion aborted.'')')s - RETURN - ELSE - EBULL = NBULL - END IF - END IFr - e -Ce -C Check to see if specified bulletin is present, and if the userd -C is permitted to delete the bulletin.5 -C. - - IF (REMOTE_SET) THEN; - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025)e - RETURNx - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,DESCRIP - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COMb - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(1:11)S - NEWEST_EXTIME = INPUT(13:20) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE/ - WRITE (6,'(1X,A)') FOLDER1_COM(:I)a - END IFs - ELSE - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_FILE(2) - - - DO BULL_DELETE = SBULL,EBULL5 - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletino - ( - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out> - CALL CLOSE_FILE(2)( - RETURNi - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_FILE(2) - RETURNr - ELSE IF (SBULL.EQ.EBULL) THEN - CALL CLOSE_FILE(2) - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') RETURNM - CALL OPEN_FILE(2)T - CALL READDIR(BULL_DELETE,IER)a - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error outa - CALL CLOSE_FILE(2)T - RETURN - END IF - END IFs - END IF - t -C -C Delete the bulletin directory entry.= -CR - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - END DO - - CALL CLOSE_FILE(2)L - RETURNA - -1010 FORMAT(' ERROR: You are not reading any message.')R -1020 FORMAT(' ERROR: Specified message number has incorrect format.')R -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.')a -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.')b -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - l - END - - D - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z)G - ! - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - I - CHARACTER INPUT*20 - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - R - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entryN - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - CALL READDIR(0,IER) ! Get shutdown count - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventuallyR -C -C Change year of expiration date of message to 100 years less,L -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -Co - IF (SYSTEM.LE.1) THEN ! General or System message( - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEND - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - END IF) - END IF - C - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration dateS - , - IER = SYS$BINTIM('0 0:15',EXBTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW)% - IER = LIB$SUBX(NOW,EXBTIM,EXBTIM)F - IER = SYS$ASCTIM(,INPUT,EXBTIM,) - S - END IF - _ - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - r - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:20) - R - CALL WRITEDIR(0,IER) - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file - O - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates.i - l - IF (SBULL.LE.BULL_POINT) THENI - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1)n - ELSE - BULL_POINT = SBULLN - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IFC - A - RETURNE - END - D - N - _ - ) - N - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - ) - IMPLICIT INTEGER (A-Z)N - _ - CHARACTER*(*) INPUT - _ - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-'))D - N - IF (DELIM.EQ.0) THENN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVALS - ELSEU - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVALE - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IFO - ( - RETURN - END - R - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORYE -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z)F - T - INCLUDE 'BULLDIR.INC' - t - INCLUDE 'BULLUSER.INC'. - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH, PAGING - LOGICAL PAGINGU - P - DATA SCRATCH_D1/0/A - R - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - & - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT0 - - CHARACTER START_PARAMETER*16,DATETIME*23,TODAY*11 - E - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenC - -CI -C Directory listing is first buffered into temporary memory storage beforeI -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen,E -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -Cs - i - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_COM) - SCRATCH_D = SCRATCH_D1R - - CALL OPEN_FILE_SHARED(2) ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1) THEN ! If so, there are messages_ - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified? - IER = CLI$GET_VALUE('START',START_PARAMETER,ILEN)D - DECODE(ILEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THENR - DIR_COUNT = NBULLB - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')')E - CALL CLOSE_FILE(2) - DIR_COUNT = 0I - RETURN - END IFC - ELSE IF (CLI$PRESENT('SINCE').OR.(FOLDER_NUMBER.GE.0.AND. - & CLI$PRESENT('NEW'))) THENE - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$ASCTIM(,TODAY,,) ! Need to get date. - DATETIME = TODAY//' 00:00:00.0' - END IFE - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_FILE(2)3 - RETURNB - ELSEL - CALL SYS$ASCTIM - & (,DATETIME,LAST_READ_BTIM(1,FOLDER_NUMBER+1),)R - END IFo - END IFo - TEMP_COUNT = 0o - IER = 1 - DO WHILE (IER.EQ.TEMP_COUNT+1)N - TEMP_COUNT = TEMP_COUNT + 1 - CALL READDIR(TEMP_COUNT,IER)- - IF (IER.NE.TEMP_COUNT+1) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_FILE(2)e - RETURNe - ELSEi - DIFF = COMPARE_DATE(DATETIME(1:11),DATE)e - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME) - IF (DIFF.LT.0) THEN - DIR_COUNT = TEMP_COUNT - IER = IER + 1 - END IF( - END IF_ - END DO - ELSE, - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THENI - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1( - IF (EBULL.GE.NBULL-2) EBULL = NBULL, - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULLT - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1/ - ELSE( - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1T - END IF - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THENE - EBULL = NBULL - END IF - IF (.NOT.REMOTE_SET) THEN, - DO I=SBULL,EBULL ! Copy messages from fileR - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM)_ - END DO. - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,SBULL,EBULL - IF (IER.EQ.0) THEN - I = SBULL - DO WHILE (IER.EQ.0.AND.I.LE.EBULL)0 - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_COMT - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - I = I + 1T - END DO! - END IF - IF (IER.NE.0) THEN - CALL CLOSE_FILE(2) - CALL DISCONNECT_REMOTEC - RETURNA - END IF - END IF - ELSE) - NBULL = 0 - END IFO - _ - CALL CLOSE_FILE(2) ! We don't need file anymore - - IF (NBULL.EQ.0) THENE - WRITE (6,'('' There are no messages present.'')')6 - RETURN - END IF - o -Cu -C Directory entries are now in queue. Output queue entries to screen. -CE - I - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - y - FLEN = TRIM(FOLDER) - WRITE(6,'(<81-FLEN>X,A)') FOLDER(:FLEN) - WRITE(6,1000) ! Write header - DO I=SBULL,EBULL0 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_COM) - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,2010) I,DESCRIP(:52),FROM,'(DELETED)' - ELSE - WRITE(6,2010) I,DESCRIP(:52),FROM,DATE(1:7)//DATE(10:11)d - END IF - END DOR - : - DIR_COUNT = EBULL + 1 ! Update directory counterF - A - IF (DIR_COUNT.GT.NBULL) THEN ! Outputted all entries?o - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are moreE - END IFD - E - RETURNI - I -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/)I - I -2010 FORMAT(1X,I4,1X,A52,1X,A12,1X,A9) - y - END - - L - SUBROUTINE FILE -CL -C SUBROUTINE FILE -Ct -C FUNCTION: Copies a bulletin to a file. -CE - IMPLICIT INTEGER (A - Z)e - ? - CHARACTER INPUT*80( - E - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENTi - i - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)t - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And returnc - END IF - m - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,1010) ! Write error - RETURN ! And returnE - END IFX - E - CALL OPEN_FILE_SHARED(2) - L - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinE - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030) - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IFC - - CALL CLOSE_FILE(2)D - T - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - E - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - M - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSET - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IFU - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - S - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATEl - END IF( - L - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90I - ELSE IF (ILEN.GT.0) THENw - WRITE (3,'(A)') INPUT(1:ILEN)t - END IFa - END DO - ILEN = 80 - END DOR - -90 CLOSE (UNIT=3) ! Bulletin copy completedS - P - WRITE(6,1040) BULL_POINT,BULL_PARAMETER(1:LEN_P)N - ! Show name of file created.L -100 CALL CLOSE_FILE(1) - RETURNN - , -900 WRITE(6,1000)L - CALL ENABLE_PRIVS ! Reset BYPASS privilegesU - GO TO 100 - V -1000 FORMAT(' ERROR: Error in opening file.')1 -1010 FORMAT(' ERROR: You have not read any bulletin.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/)T - - END - E - - - N - SUBROUTINE LOGINc -Cy -C SUBROUTINE LOGINI -CI -C FUNCTION: Alerts user of new messages upon logging in.U -C' - IMPLICIT INTEGER (A - Z)E - U - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'G - L - INCLUDE 'BULLFOLDER.INC'C - C - COMMON /READIT/ READITI - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - R - COMMON /PAGE/ PAGE_LENGTH,PAGINGR - LOGICAL PAGINGA - R - COMMON /POINT/ BULL_POINT - , - COMMON /PROMPT/ COMMAND_PROMPTE - CHARACTER*39 COMMAND_PROMPT - I - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - e - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHl - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)r - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - a - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - h - CHARACTER TODAY*23,INPUT*80,INREAD*1 - i - LOGICAL*1 CTRL_G/7/ - R - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list headerC - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - H - DIMENSION NOLOGIN_BTIM(2),LOGIN_BTIM_SAVE(2),TODAY_BTIM(2)i - DIMENSION DIR_BTIM(2),NEW_BTIM(2) - S - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)B - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - ' -CR -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - E - CALL OPEN_FILE_SHARED(4)) - . - CALL READ_USER_FILE_HEADER(IER) ! Get the header - ) - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entryY - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) RETURN ! DISMAIL set1 - IF (IER1.EQ.0) THEN ! There is a user entry - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1)( - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)& - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONGo - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead usersI - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry - READ_BTIM(2) = NEW_BTIM(2)R - DO I = 1,FLONGD - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)E - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DOC - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_DISMAIL(USERNAME,DISMAIL) - IF (DISMAIL.EQ.1) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - ELSEG - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1)L - LOGIN_BTIM(2) = TODAY_BTIM(2)G - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_FILE(4) ! Close the user file - CALL EXIT ! Go away... - END IF) - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL setT - DIFF = -1 ! Force us to look at messages - CALL OPEN_FILE_SHARED(9)A - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DOW - WRITE (9,IOSTAT=IER) USERNAME,S - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_FILE(9). - END IF - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IFD - ! - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - BBOARD_BTIM(1) = TODAY_BTIM(1) - BBOARD_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_HEADER ! Rewrite headere - CALL CLOSE_FILE(4) - IF (.NOT.TEST_BULLCP()) CALL CREATE_BBOARD_PROCESS - ELSE - CALL CLOSE_FILE(4) - IF (IER.NE.0) CALL EXIT ! If no header, no messagese - END IF - e - IF (IER1.EQ.0) THEN ! Skip date comparison if new entryr -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -CA - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compare - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user.U - t - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM)0 - END IF - END IFa - m - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)/ - P - IF (NEW_FLAG(2).NE.0) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1P - RETURN - END IFe - ? -CC -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible.N -C - - ENTRY LOGIN_FOLDER' - E - IF (NEW_FLAG(2).EQ.0.OR.FOLDER_SET) THENE - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IFr - - ENTRY SHOW_SYSTEM - r - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (FOLDER_NUMBER.GT.0.AND.BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST2(SET_FLAG,FOLDER_NUMBER)N - & .AND..NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) - e - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messageso - BULL_POINT = -1 - 0 - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) RETURNr - ! Don't overwhelm new user with lots of non-general msgs - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN. - ! Can folder have SYSTEM messages and /SYSTEM specified?A - LOGIN_BTIM(1) = SYSTEM_LOGIN_BTIM(1) ! Use specified login timen - LOGIN_BTIM(2) = SYSTEM_LOGIN_BTIM(2) ! for system messages.E - END IFA - E - CALL OPEN_FILE_SHARED(2) ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULLW - END IFG - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_COM) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_COM) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1I - SYS_NUM = SYS_NUM1h - START = 1 - REVERSE = 0 - IF (REVERSE_SWITCH.AND.(.NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR.H - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN) - REVERSE = 1_ - CALL GET_NEWEST_MSG(LOGIN_BTIM,START)H - IF (START.EQ.-1) START = NBULL - START = START + 1 - END IF3 - A - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_COM)D - IF (REVERSE) THENT - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,NBULL - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,NBULL,START - END IF - IF (IER.EQ.0) THEN - ALL_DIR = ALL_DIR1B - I = START - DO WHILE (IER.EQ.0.AND.I.LE.NBULL)R - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_COM - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_COM)i - I = I + 1 - END DO0 - END IF - IF (IER.NE.0) THEN - CALL CLOSE_FILE(2)A - CALL DISCONNECT_REMOTE, - RETURN( - END IF - ALL_DIR = ALL_DIR1 - END IFA - ' - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THENN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1g - END IF - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_COM)U - IER = ICOUNT + 1E - ELSE - CALL READDIR(ICOUNT,IER)A - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user?M - ! No. Is bulletin system or from same user?R - IF (.NOT.REVERSE) THEN - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IFT - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THENE - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1C - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM)i - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THENe - IF (SYSTEM_SWITCH) THEN - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,DIR_BTIM) - ELSE - DIFF = -1 - END IF - IF (DIFF.LT.0) THENH - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN_ - BULL_POINT = ICOUNT - 1B - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IFO - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF (SYSTEM.EQ.3) THEN - NSYS = NSYS + 1E - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))r - ELSE IF (NGEN.EQ.0) THEN ! And save only the first non-system msg - SYSTEM = ICOUNT ! Save bulletin number for displaye - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THENb - BULL_POINT = ICOUNT - 1_ - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM) - END IF - END IF - END DOD -100 CALL CLOSE_FILE(2) -CI -C Review new directory entries. If there are system messages,S -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C) - IF (NGEN.EQ.0.AND.NSYS.EQ.0) RETURN - L - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN1 - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER)I - S1 = (80-(LENF+16))/2N - S2 = 80 - S1 - (LENF + 16) - WRITE (6,1026) FOLDER(:LENF),CTRL_G ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_FILE_SHARED(1) - CALL INIT_QUEUE(SYS_BUL1,INPUT)I - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0S - DO J=1,NSYSI - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_COM)I - IF (REMOTE_SET) THENV - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER)I - END IF - IF (IER.GT.0) THEN - CALL CLOSE_FILE(1) - RETURN - END IF - END IFI - INPUT = ' 'e - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin to SYS_BUL link list - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN)T - IF (ILEN.LT.0) THEN( - CALL CLOSE_FILE(1)2 - RETURN) - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - END IF - END DOF - ILEN = 80 - END DOT - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)! - DO I=1,80 - INPUT(I:I) = SEPARATEB - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2I - END IFD - END DO - CALL CLOSE_FILE(1) - SYS_BUL = SYS_BUL1 - DO I = 1,NSYS_LINE ! Write out the system messages - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)L - IF (SYS_BUL.NE.0) THEN0 - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THENI - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next pagei - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....')y - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - WRITE(6,1060) '+'//INPUT(1:TRIM(INPUT)) - ELSEB - PAGE = PAGE + 1 - WRITE(6,1060) ' '//INPUT(1:TRIM(INPUT))N - END IFR - END IFi - END DO - IF (NGEN.EQ.0) THEN - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1C - END IFI - Y - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1= - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER) - S1 = (80-13-LENF)/2r - S2 = 80-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next pageP - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....')= - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages',CTRL_Ge - PAGE = 1f - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesL - FIRST_WRITE = .FALSE. ! if this is first write to screen.I - END IFI - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages',CTRL_G - PAGE = PAGE + 1 - END IF - WRITE(6,1020)S - WRITE(6,1025)I - PAGE = PAGE + 2F - I = 0R - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_COM)T - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screens - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,G - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD,INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1s - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')')! - ELSEe - WRITE(6,1040) '+'//DESCRIP,FROM,DATE(:6),SYSTEM - END IFn - ! Bulletin number is stored in SYSTEM - ELSE0 - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP,FROM,DATE(:6),SYSTEM - END IFE - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0)E - & .OR.(FOLDER_SET.AND.TEST2(SET_FLAG,FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated.. - END IF - IF (COMPARE_BTIM(READ_BTIM,NEW_BTIM).NE.0) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN_ - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1L - S1 = (80-ILEN)/2 - S2 = 80 - S1 - ILENM - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.'T - ELSE - ILEN = 48 + INDEX(COMMAND_PROMPT,'>') - 1N - S1 = (80-ILEN)/2 - S2 = 80 - S1 - ILENF - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-48)// - & ' command can be used to read these messages.'L - END IF - - RETURNT - N -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'),A1) -1027 FORMAT(/,' ',('*'),A,('*'),A1)R -1028 FORMAT('+',('*'),A,('*'),A1) -1030 FORMAT(' ',80('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A54,1X,A12,1X,A6,1X,I4)U -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.')H -1080 FORMAT(' ',/) - E - END - L -.. diff --git a/decus/vax88a3/bulletin/bulletin1.for b/decus/vax88a3/bulletin/bulletin1.for deleted file mode 100644 index 5a49f17..0000000 --- a/decus/vax88a3/bulletin/bulletin1.for +++ /dev/null @@ -1,1385 +0,0 @@ -From: KBSVAX::KANE "Joseph Kane" 4-APR-1988 13:32 -To: everhart@arisia.DECNET -Subj: forwarded mail - -From uunet!rutgers.edu!Postmaster Mon Apr 4 14:24:10 1988 -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA18631; Mon, 4 Apr 88 14:23:44 edt -Received: from RUTGERS.EDU by uunet.UU.NET (5.54/1.14) - id AA05253; Mon, 4 Apr 88 13:44:28 EDT -Received: by rutgers.edu (5.54/1.15) - id AB18302; Mon, 4 Apr 88 12:52:10 EDT -Date: Mon, 4 Apr 88 12:52:10 EDT -From: uunet!rutgers.edu!Postmaster (Mail Delivery Subsystem) -Subject: Returned mail: Host unknown -Message-Id: <8804041652.AB18302@rutgers.edu> -To: -Status: R - - ----- Transcript of session follows ----- -550 ... Host unknown - - ----- Unsent message follows ----- -Received: by rutgers.edu (5.54/1.15) - id AA17180; Mon, 4 Apr 88 10:26:10 EDT -Received: from steinmetz.UUCP by uunet.UU.NET (5.54/1.14) with UUCP - id AA05371; Mon, 4 Apr 88 10:22:48 EDT -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA15927; Mon, 4 Apr 88 10:17:18 edt -Date: 2 Apr 88 20:16:21 EST -From: steinmetz!MAILER-DAEMON@uunet.uu.net (Mail Delivery Subsystem) -Subject: Returned mail: User unknown -Message-Id: <8804041417.AA15927@kbsvax.steinmetz> -To: MRL@pfc-vax.mit.edu - - ----- Transcript of session follows ----- -mail11: %MAIL-E-SYNTAX, error parsing 'CRD' -550 crd.ge.com!EVERHART%ARISIA.DECNET... User unknown - - ----- Unsent message follows ----- -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA15899; Mon, 4 Apr 88 10:17:18 edt -Received: by ge-dab.GE.COM (smail2.5) - id AA19167; 4 Apr 88 06:30:43 EDT (Mon) -Received: by ge-rtp.GE.COM (smail2.5) - id AA10804; 3 Apr 88 21:16:11 EST (Sun) -Received: by mcnc.mcnc.org (5.54/MCNC/10-20-87) - id AA14692; Sat, 2 Apr 88 21:04:44 EST -From: -Received: by rutgers.edu (5.54/1.15) - id AA00893; Sat, 2 Apr 88 20:30:57 EST -Message-Id: <8804030130.AA00893@rutgers.edu> -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 2 Apr 88 20:17-EST -Date: 2 Apr 88 20:16:21 EST -To: xx!TENCATI@vlsi.jpl.nasa.gov, xx!MHG@mitre-bedford.arpa, - crd.ge.com!xx!EVERHART@ARISIA.DECNET, xx!GAYMAN@ari-hq1.arpa, - radc-softvax!xx!BACH -Subject: BULLETIN1.FOR - -C -C BULLETIN1.FOR, Version 3/16/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - NLEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addedd - END IF - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:NLEN)//'""::' - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Is semicolon present? - IF (NLEN.GT.SEMI+1) THEN ! Yes, is username after node? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - NLEN = SEMI - 1 ! Remove semicolon - ELSE ! No username after nodename - TEMP_USER = DEFAULT_USER ! Set username to default - NLEN = SEMI - 1 ! Remove semicolon - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolon present - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username was - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:NLEN) - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '// - & PASSWORD(1:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FLAGNAME - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_FILE(7) ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - r - CALL REWRITE_FOLDER_FILE - 1 - CALL CLOSE_FILE(7) - - WRITE (6,'(1X,A,'' has been modified for folder.'')')4 - & FLAGNAME - ELSEe - WRITE (6,'(1X,A,'' You are not authorized to modify.'')')5 - & FLAGNAME - END IFD - - RETURN - END - s - u - . - 1 - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMITm -Cu -C FUNCTION: Sets folder expiration limit. -Cs - IMPLICIT INTEGER (A-Z)a - - INCLUDE 'BULLFOLDER.INC'8 - 0 - INCLUDE 'BULLUSER.INC'> - o - INCLUDE 'BULLFILES.INC' - - IF (LIMIT.LT.0) THENp - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_FILE(7) ! Open folder file - 7 - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)m - e - F_EXPIRE_LIMIT = LIMIT - 5 - CALL REWRITE_FOLDER_FILE - M - CALL CLOSE_FILE(7) - WRITE (6,'('' Folder expiration date modified.'')') - ELSE1 - WRITE (6,'('' You are not allowed to modify folder.'')') - END IFt - m - RETURNR - END - u - . - n - ( - l - SUBROUTINE MAIL(STATUS) -C: -C SUBROUTINE MAIL -Ck -C FUNCTION: Sends message which you have read to user via DEC mail. -C. - IMPLICIT INTEGER (A - Z)s - p - CHARACTER INPUT*80- - - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - w - INCLUDE 'BULLDIR.INC' - v - EXTERNAL CLI$_ABSENTS - n - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')')E - RETURN ! And returnt - END IF( - i - MAIL_SUBJECT = DESCRIPr - IF (CLI$PRESENT('SUBJECT')) THENy - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURNt - END IF - END IFS - - CALL OPEN_FILE_SHARED(2)0 - @ - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletina - a - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')'), - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2)! - H - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - s - IF (IER.NE.0) THENr - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF. - n - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - T - LEN_I = 81I - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN_I.GT.0)n - CALL GET_BULL(I,INPUT,LEN_I)A - IF (LEN_I.LT.0) THENN - GO TO 90O - ELSE IF (LEN_I.GT.0) THEN - WRITE (3,'(A)') INPUT(:LEN_I)N - END IFR - END DO - LEN_I = 80 - END DOO - , -90 CLOSE (UNIT=3) ! Message copy completed - P - CALL CLOSE_FILE(1) - F - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THENY - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - C - IF (MAIL_SUBJECT(:1).NE.'"') THEN - MAIL_SUBJECT = '"'//MAIL_SUBJECT(:LEN_D) - LEN_D = LEN_D + 1D - END IF - ! - IF (MAIL_SUBJECT(LEN_D:LEN_D).NE.'"') THENT - MAIL_SUBJECT = MAIL_SUBJECT(:LEN_D)//'"' - LEN_D = LEN_D + 1U - END IF, - E - IER = CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER,LEN_P)i - d - CALL DISABLE_PRIVSS - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) - & //'/SUBJECT='//MAIL_SUBJECT(:LEN_D),,,,,,STATUS) - CALL ENABLE_PRIVS - A - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR')1 - M - RETURN - D - END - N - _ - P - SUBROUTINE MODIFY_FOLDER -CD -C SUBROUTINE MODIFY_FOLDERN -C_ -C FUNCTION: Modifies a folder's information.N -CS - IMPLICIT INTEGER (A - Z)D - N - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - O - INCLUDE 'BULLFOLDER.INC'd - - INCLUDE 'BULLUSER.INC' - C - INCLUDE 'BULLFILES.INC' - D - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - U - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')')E - RETURN - ELSE IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENE - WRITE (6,'('' ERROR: No privileges to modify folder.'')')N - RETURN - END IFI - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IFF - END IF - ELSEl - FOLDER1 = FOLDER - END IF - t - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN_ - WRITE (6,'('' ERROR: Folder modification aborted.'')') - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LEN_P) ! End fill with spaces - END IFL - END DO - ELSEL - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IFE - I - IF (CLI$PRESENT('OWNER')) THENR - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P)o - IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THENT - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURNE - ELSE IF (.NOT.SETPRV_PRIV()) THENG - WRITE (6,'('' ERROR: No privileges to modify folder owner.'')') - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSEI - FOLDER1_OWNER = FOLDER_OWNER - END IFS - - CALL OPEN_FILE(7) ! Open folder file - N - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0)a - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_FILE(7) - RETURNS - END IF - END IFS - u - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - E - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN( - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)N - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)' - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF= - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - CALL WRITE_FOLDER_FILE(IER)P - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF9 - - IF (IER.NE.0) THENE - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IFr - n - CALL CLOSE_FILE(7) - O - RETURN_ - END - - L - - SUBROUTINE MOVE(DELETE_ORIGINAL)l -Cn -C SUBROUTINE MOVE -C' -C FUNCTION: Moves message from one folder to another. -CL - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - 1 - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - E - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - O - INCLUDE 'BULLDIR.INC' - D - INCLUDE 'BULLUSER.INC'0 - F - INCLUDE 'BULLFOLDER.INC'o - d - EXTERNAL CLI$_ABSENTR - - LOGICAL DELETE_ORIGINAL - - CHARACTER INPUT*80,SAVE_USERNAME*12,SAVE_FOLDER*25E - N - CHARACTER*116 BULLDIR_COM_SAVEN - E - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')')U - RETURN ! and returnE - END IFR - C - CALL OPEN_FILE_SHARED(2). - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_FILE(2)V - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')')( - RETURN - END IF - L - CALL LIB$MOVC3(116,%REF(BULLDIR_COM),%REF(BULLDIR_COM_SAVE))G - SAVE_BULL_POINT = BULL_POINT - - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR',L - & FORM='FORMATTED') ! Scratch file to save bulletin - ' - CALL OPEN_FILE_SHARED(1)S - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90) - ELSE IF (ILEN.GT.0) THENP - WRITE (3,'(A)') INPUT(:ILEN) - END IFi - END DO - ILEN = 80A - END DO - C -90 REWIND (UNIT=3) ! Bulletin copy completed - > - CALL CLOSE_FILE(1)I - . - SAVE_FOLDER = FOLDER. - SAVE_FOLDER_NUMBER = FOLDER_NUMBERv - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - S - SAVE_USERNAME = USERNAMEA - IF (CLI$PRESENT('ORIGINAL')) THEN - IF (SETPRV_PRIV()) THENr - USERNAME = FROM - ELSE - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - END IF - END IFA - C - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER' - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER.OR.READ_ONLY) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - CLOSE (UNIT=3) - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER = SAVE_FOLDER - USERNAME = SAVE_USERNAME - RETURN - END IF- - s -Cp -C Add bulletin to bulletin file and directory entry for to directory file. -CL - R - CALL OPEN_FILE(2) ! Prepare to add dir entryC - A - CALL OPEN_FILE(1) ! Prepare to add bulletin - v - CALL READDIR(0,IER) ! Get NBLOCKL - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - T - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE(6,'('' ERROR: Message copy aborted.'')') - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CLOSE (UNIT=3) - END IF_ - J - CALL CLOSE_FILE(1) ! Finished adding bulletin - t - CALL LIB$MOVC3(116,%REF(BULLDIR_COM_SAVE),%REF(BULLDIR_COM)) - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder?I - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges?. - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit( - END IFR - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bitG - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND.' - & .NOT.SETPRV_PRIV()) THEN ! Permanent? - WRITE (6,'('' ERROR: No privileges to add permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') FOLDER_BBEXPIRE - END IFI - P - FROM = USERNAME ! Specify ownerE - CALL ADD_ENTRY ! Add the new directory entry - - IF (FOLDER_NUMBER.GE.0) THENL - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IFL - B - CALL CLOSE_FILE(2) ! Totally finished with add - D - CLOSE (UNIT=3) ! Close the input file - ) - WRITE (6,'('' Message has been copied to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - E - USERNAME = SAVE_USERNAMEI - N - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - B - BULL_POINT = SAVE_BULL_POINT - / - IF (DELETE_ORIGINAL) CALL DELETE, - S - RETURNC - - END - I - - - L - SUBROUTINE PRINTS -CL -C SUBROUTINE PRINT -CT -C FUNCTION: Print header to queue. -CO - Y - IMPLICIT INTEGER (A-Z)N - O - INCLUDE '($SJCDEF)' - T - CHARACTER*32 QUEUEr - i - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - R - CHARACTER*80 INPUT - L - COMMON /POINT/ BULL_POINT - O - INCLUDE 'BULLDIR.INC' - U - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read$ - WRITE(6,1010) ! Write error - RETURN ! And return - END IFF - E - CALL OPEN_FILE_SHARED(2)R - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinE - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030)' - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2)E - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - ' - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - I - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - e - CALL ENABLE_PRIVS - U - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATEn - END IFs - p - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END DO - ILEN = 80) - END DOS - F - CLOSE (UNIT=3) ! Bulletin copy completeds - - CALL CLOSE_FILE(1)O - D - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) ! Get queue name - IF (ILEN.EQ.0) THEN - QUEUE = 'SYS$PRINT') - ILEN = 9 - END IFT - L - CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE))T - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - ( - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IFV - I - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - R - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)I - IF (IER.AND.(.NOT.JBC_ERROR)) THEND - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IFR - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - Y - RETURNE - E -900 CALL ERRSNS(IDUMMY,IER)$ - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - CLOSE (UNIT=3,STATUS='DELETE')F - CALL CLOSE_FILE(1): - WRITE(6,1000) - CALL SYS_GETMSG(IER)/ - * - RETURND - C -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Specified message was not found.')R -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT('Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/)$ - L - END - S - N - A - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C' -C SUBROUTINE READ -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER:N -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -CO - IMPLICIT INTEGER (A - Z) - S - COMMON /POINT/ BULL_POINT - l - INCLUDE 'BULLDIR.INC' - ' - INCLUDE 'BULLFOLDER.INC'e - o - INCLUDE 'BULLUSER.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - L - COMMON /READIT/ READITP - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGINGE - C - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - U - DATA SCRATCH_B1/0/ - C - DIMENSION MSG_BTIM(2) - I - CHARACTER TODAY*11,DATETIME*23T - A - LOGICAL SINCE,PAGEL - C - CALL LIB$ERASE_PAGE(1,1) ! Clear screen, - END = 0 ! Nothing outputted on screen - R - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this ism - ! not first page of bulletin - E - SINCE = .FALSE. - PAGE = .TRUE. - . - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN' - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - DATETIME = TODAY//' 00:00:00.0' - END IF - ELSE IF (CLI$PRESENT('NEW').AND.FOLDER_NUMBER.GE.0) THEN - ! was /NEW specified?& - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THENC - WRITE (6,'('' No new messages are present.'')') - RETURNC - ELSE - CALL SYS$ASCTIM - & (,DATETIME,LAST_READ_BTIM(1,FOLDER_NUMBER+1),) - END IF - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - CALL OPEN_FILE_SHARED(2) - TEMP_READ = 0= - IER = 1i - DO WHILE (IER.EQ.TEMP_READ+1)I - TEMP_READ = TEMP_READ + 1 - CALL READDIR(TEMP_READ,IER) - IF (IER.NE.TEMP_READ+1) THENE - WRITE (6,'('' No messages found past specified date.'')') - CALL CLOSE_FILE(2)V - RETURNE - ELSEM - DIFF = COMPARE_DATE(DATETIME(:11),DATE) ! Compare expiratione - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(DATETIME(13:20),TIME) - IF (DIFF.LT.0) THENh - BULL_READ = TEMP_READ - IER = IER + 1, - END IFI - END IFR - END DO - IER = BULL_READ + 1O - SINCE = .TRUE. - CALL CLOSE_FILE(2) - END IF - END IF - O - IF (.NOT.SINCE) THENE - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entryf - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THENP - READ_COUNT = 0C - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULLN - CALL READDIR(BULL_READ,IER) - ELSEO - IER = 0 - END IFL - END IF - CALL CLOSE_FILE(2) - ELSE - IER = 0) - END IF - END IFc - t - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IFS - U - IF (FOLDER_NUMBER.GE.0) THENS - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM)L - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)). - IF (DIFF.GT.0) THENO - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2) - END IF - END IF - D - BULL_POINT = BULL_READ ! Update bulletin counterg - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'CURR') THENf - IF (CLI$PRESENT('EDIT')) THEN) - CALL READ_EDITe - RETURN= - END IF - END IFe - e - FLEN = TRIM(FOLDER) - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header infoO - WRITE(6,1050) DESCRIP - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN( - WRITE(6,1060) FROM,DATE,'(DELETED)'m - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?) - WRITE(6,1060) FROM,DATE,'Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - WRITE(6,1060) FROM,DATE,'Permanent'A - ELSET - WRITE(6,1060) FROM,DATE,'Expires: '//EXDATE//' '//EXTIME - END IFa - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - WRITE(6,'(''+ / System'',/)')i - ELSEw - WRITE(6,'(''+'',/)') - END IFM -CF -C Each page of the bulletin is buffered into temporary memory storage beforeE -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memoryN -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.O -C - / - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?R - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headO - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointerA - END IFU - r - END = 4 ! Outputted 4 lines to screen - ) - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSEr - READ_COUNT = BLOCK ! Init bulletin record counterd - END IF - D -100 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to headerP - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - IF (READ_COUNT.GT.BLOCK.AND.READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header info - END = END + 1 ! Increase display counter - END IF. - CALL OPEN_FILE_SHARED(1) ! Get bulletin file - MORE_LINES = .TRUE. - READ_REC = READ_COUNT - IF (READ_ALREADY.EQ.0) ILEN = 81w - DO WHILE (MORE_LINES.AND.READ_REC.LE.BLOCK+LENGTH-1)9 - DO WHILE (ILEN.GT.0.AND.MORE_LINES)I - CALL GET_BULL(READ_REC,INPUT,ILEN) - IF (ILEN.LT.0) THEN ! Error, couldn't read record - READ_REC = BLOCK + LENGTH ! Fake end of reading file - MORE_LINES = .FALSE.n - ELSE IF (ILEN.GT.0) THEN= - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - READ_ALREADY = 1 - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IFL - END IFD - END DO - ILEN = 80a - IF (MORE_LINES) THEN - READ_REC = READ_REC + 1 - READ_ALREADY = 0O - END IF - END DO - R - CALL CLOSE_FILE(1) ! End of bulletin file reada - -C -C Bulletin page is now in temporary memory, so output to terminal.L -C Note that if this is a /READ, the first line will have problems withS -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -CD - N - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) ! Get queue recordF - IF (I.EQ.1.AND.READ_REC.NE.BLOCK.AND.READIT.GT.0) THEN - WRITE(6,2020) INPUT(:TRIM(INPUT)) ! (See above comments)D - ELSE - WRITE(6,2010) INPUT(:TRIM(INPUT)) - END IF - END DO3 - A - READ_COUNT = READ_REC ! Update bull record counterC - - IF (READ_REC.EQ.BLOCK+LENGTH) THEN ! Last block?R - READ_COUNT = 0 ! init bulletin record counterB - ELSE IF (READ_REC.EQ.BLOCK+LENGTH-1.AND..NOT.MORE_LINES) THEN - ! Possibly last block since end of page could be last line - CALL TEST_MORE_LINES(ILEN) ! More lines to read?, - IF (ILEN.GT.0) THEN ! Yes, there are still more: - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletinA - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Else if this is not /READ - WRITE(6,1070) ! say there is more of bulletin - END IFn - a - RETURNa - t -1030 FORMAT(' ERROR: Specified message was not found.')s -1040 FORMAT('+Message number: ',I4,<60-FLEN>X,A) -1050 FORMAT(' Description: ',A53)s -1060 FORMAT(' From: ',A12,' Date: ',A11,' ',A,$) -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) -2010 FORMAT(1X,A)C -2020 FORMAT('+',A) - - END - ' - L - D - I - SUBROUTINE READ_EDITL - R - IMPLICIT INTEGER (A-Z)_ - L - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'I - - CHARACTER*128 INPUT - E - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - A - IF (IER.NE.0) THENN - CALL ERRSNS(IDUMMY,IER)T - CALL SYS_GETMSG(IER) - RETURN - END IFG - - WRITE(3,1050) DESCRIP ! Output bulletin header info0 - WRITE(3,1060) FROM,DATE - c - CALL OPEN_FILE_SHARED(1)T - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90E - ELSE IF (ILEN.GT.0) THEN. - WRITE (3,'(A)') INPUT(:ILEN) - END IFF - END DO - ILEN = 80N - END DOS - E -90 CLOSE (UNIT=3) ! Bulletin copy completedA - CALL CLOSE_FILE(1)E - E - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - T - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')O - / -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/)0 - H - RETURN - END - W - e - SUBROUTINE READNEW(REDO)E -CI -C SUBROUTINE READNEWE -CU -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C, - ' - IMPLICIT INTEGER (A-Z)e - ' - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - E - INCLUDE 'BULLUSER.INC'N - E - INCLUDE 'BULLDIR.INC' - F - INCLUDE 'BULLFOLDER.INC') - . - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - CHARACTER INREAD*1,INPUT*80,FILE_DEF*80,NUMREAD*5 - T - DATA LEN_FILE_DEF /0/, INREAD/0/E - R - LOGICAL SLOW,SLOW_TERMINALE - R - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first timee - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - 1 - LEN_P = 0 ! Tells read subroutine there isI - ! no bulletin parameter - T -1 WRITE(6,1000) ! Ask if want to read new bulletins - L - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get inputD - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THENI - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THENA - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders= - IF (NEW_MSG(I).NE.0) RETURN - END DOF - CALL EXIT - ELSE) - WRITE (6,'(''+o'',$)') - END IF) - RETURN ! If NO, exit - ! Include QUIT to be consistent with next questionN - ELSE - CALL LIB$ERASE_PAGE(1,1)E - END IF - END IFI - A - IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.BULL_POINT+1.OR.TEMP_READ.GT.NBULL) THEN) - WRITE (6,'('' ERROR: Specified new message not found.'')')+ - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1M - END IF - END IFF - E - READ_COUNT = 0 ! Initialize display pointerl - i -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletinU - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed?= - CALL OPEN_FILE_SHARED(2) ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and systemX - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it.S - BULL_POINT = BULL_POINT + 1 - GO TO 10) - END IF - CALL CLOSE_FILE(2) - END IFt - n -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSEE - WRITE(6,1030)0 - END IFD - , - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)')F - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay direcotyrr - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE.t - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to filey - WRITE (6,'(''+ '')') ! Move cursor from end of prompt linen - ! to beginning of next line.m - IF (LEN_FILE_DEF.EQ.0) THENk - CALL LIB$SYS_TRNLOG('SYS$LOGIN',LEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:LEN-1)//'.BULL]' - LEN_FILE_DEF = LEN + 5o - ELSE - FILE_DEF = 'SYS$LOGIN:'A - LEN_FILE_DEF = 10) - END IF1 - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,) - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - ! - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS'n - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - END IF - ! - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_FILE_SHARED(2) - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRVO - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,ERR=18, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATEL - ILEN = 81C - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0)r - CALL GET_BULL(I,INPUT,ILEN)F - IF (ILEN.LT.0) THEN - GO TO 18 - ELSE IF (ILEN.GT.0) THENL - WRITE(3,'(A)') INPUT(:TRIM(INPUT))R - END IFT - END DO - ILEN = 80 - END DO - WRITE(6,1040) BULL_PARAMETER(:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privilegesr - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THENp - ! If NEXT and last bulletins not finishedA - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_FILE_SHARED(2) ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletinh - CALL CLOSE_FILE(2) ! Exito - WRITE(6,1010) - RETURNe - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletinsR - END IF - CALL CLOSE_FILE(2) - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THENA - WRITE(6,1010)H - RETURN - END IF! - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - R -1000 FORMAT(' Read messages? Type N(No),E(Exit),message) - & number, or any other key for yes: ',$)E -1010 FORMAT(' No more messages.')N -1020 FORMAT(1X,80('-'),/,' Type Q(Quit), - & F(File it), D(Dir) or any other key for next message: ',$)) -1030 FORMAT(1X,80('-'),/,' Type Q(Quit), F(File it), N(Next message),e - & D(Dir), or other key for MORE: ',$) -1040 FORMAT(' Message written to ',A)s -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/) - e - END - diff --git a/decus/vax88a3/bulletin/bulletin3.for b/decus/vax88a3/bulletin/bulletin3.for deleted file mode 100644 index c6743a3..0000000 --- a/decus/vax88a3/bulletin/bulletin3.for +++ /dev/null @@ -1,1407 +0,0 @@ -From: KBSVAX::KANE "Joseph Kane" 4-APR-1988 19:32 -To: everhart@arisia.DECNET -Subj: - -From uunet!rutgers.edu!Postmaster Mon Apr 4 16:45:27 1988 -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA20676; Mon, 4 Apr 88 16:43:20 edt -Received: from RUTGERS.EDU by uunet.UU.NET (5.54/1.14) - id AA07937; Mon, 4 Apr 88 15:11:10 EDT -Received: by rutgers.edu (5.54/1.15) - id AD20964; Mon, 4 Apr 88 15:12:07 EDT -Date: Mon, 4 Apr 88 15:12:07 EDT -From: uunet!rutgers.edu!Postmaster (Mail Delivery Subsystem) -Subject: Returned mail: Host unknown -Message-Id: <8804041912.AD20964@rutgers.edu> -To: -Status: R - - ----- Transcript of session follows ----- -550 ... Host unknown - - ----- Unsent message follows ----- -Received: by rutgers.edu (5.54/1.15) - id AA19854; Mon, 4 Apr 88 12:26:33 EDT -Received: from steinmetz.UUCP by uunet.UU.NET (5.54/1.14) with UUCP - id AA02086; Mon, 4 Apr 88 12:22:21 EDT -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA15958; Mon, 4 Apr 88 10:21:40 edt -Date: 2 Apr 88 20:16:54 EST -From: steinmetz!MAILER-DAEMON@uunet.uu.net (Mail Delivery Subsystem) -Subject: Returned mail: User unknown -Message-Id: <8804041421.AA15958@kbsvax.steinmetz> -To: MRL@pfc-vax.mit.edu - - ----- Transcript of session follows ----- -mail11: %MAIL-E-SYNTAX, error parsing 'CRD' -550 crd.ge.com!EVERHART%ARISIA.DECNET... User unknown - - ----- Unsent message follows ----- -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA15954; Mon, 4 Apr 88 10:21:40 edt -Received: by ge-dab.GE.COM (smail2.5) - id AA19175; 4 Apr 88 06:30:56 EDT (Mon) -Received: by ge-rtp.GE.COM (smail2.5) - id AA10834; 3 Apr 88 21:17:06 EST (Sun) -Received: by mcnc.mcnc.org (5.54/MCNC/10-20-87) - id AA14746; Sat, 2 Apr 88 21:13:41 EST -From: -Received: by rutgers.edu (5.54/1.15) - id AA01339; Sat, 2 Apr 88 20:47:04 EST -Message-Id: <8804030147.AA01339@rutgers.edu> -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 2 Apr 88 20:18-EST -Date: 2 Apr 88 20:16:54 EST -To: xx!TENCATI@vlsi.jpl.nasa.gov, xx!MHG@mitre-bedford.arpa, - crd.ge.com!xx!EVERHART@ARISIA.DECNET, xx!GAYMAN@ari-hq1.arpa, - radc-softvax!xx!BACH -Subject: BULLETIN3.FOR - -C -C BULLETIN3.FOR, Version 4/1/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE - CHARACTER*8 TEMP_TIME,TEMP_EXTIME - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00' ! bulletin date if deletion occurs - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF (SYSTEM.LE.3.OR.(SHUTDOWN.EQ.0 ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - DIFF = 0 ! If so, delete it - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF (SYSTEM.LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date so when we quit - TEMP_TIME = TIME ! search, we'll have the - END IF ! latest bulletin date - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - NEW_SHUTDOWN = SHUTDOWN - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - CALL UPDATE_FOLDER -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - CALL CLOSE_FILE(4) - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous8 -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in.t -Ce - BULL_POINT = -1 ! Init bulletin pointer4 - 1 - CALL OPEN_FILE_SHARED(2) ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THENe - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = STARTt - CALL CLOSE_FILE(2)0 - RETURNu - ELSE - START = START + 1 - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM)h - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER)e - ELSE ! SYSTEM bulletin was not seent - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSEs - START = START + 1 - CALL READDIR(START,IER) - END IF2 - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IFT - s - CALL CLOSE_FILE(2)o - - - RETURNl - END - - - Y - X - SUBROUTINE GET_EXPIRED(INPUT,IER) - E - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLUSER.INC's - - INCLUDE 'BULLFOLDER.INC'e - d - CHARACTER*20 INPUTz - CHARACTER*23 TODAY - - DIMENSION EXTIME(2),NOW(2)2 - 0 - EXTERNAL CLI$_ABSENTa - E - IER = SYS$ASCTIM(,TODAY,,) ! Get today's dateE - ( - IERC = CLI$GET_VALUE('EXPIRATION',INPUT,ILEN) - A - PROMPT = .TRUE. - : -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE.m - ELSE - WRITE(6,1030) TODAY ! Prompt for expiration date - CALL GET_LINE(INPUT,ILEN) ! Get input line - END IF - ELSE0 - RETURN - END IFr - d - IF (ILEN.LE.0) THEN - IER = 0b - RETURN - END IFC - s - INPUT = INPUT(:ILEN) ! Change trailing zeros 2 spaces - x - IF (INDEX(INPUT,'-').EQ.0.AND.INDEX(INPUT,':').GT.0.AND. - & INDEX(INPUT(:ILEN),' ').EQ.0) THEN - INPUT = TODAY(:INDEX(TODAY(2:),' ')+1)//INPUTH - END IF: - L - CALL STR$UPCASE(INPUT,INPUT) ! Convert to upper case - IER = SYS_BINTIM(INPUT,EXTIME)r - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - GO TO 5n - END IF - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,)A - IF (TIMLEN.EQ.16) THENr - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - END IF - P - IF (INPUT(2:2).EQ.'-') INPUT = '0'//INPUT - IER = COMPARE_DATE(INPUT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THENE - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limit - GO TO 5D - END IFS - IF (IER.EQ.0) IER = COMPARE_TIME(INPUT(13:20),TODAY(13:20)) - IF (IER.LE.0) THEN ! If expiration date not futureX - WRITE(6,1045) ! tell usere - GO TO 5 ! and re-request date - END IFn - t - IER = 1 - e - RETURN - e -1030 FORMAT(' It is ',A23, - &'. Specify when the message should expire:',/,1x,: - &'Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ',R - &'or delta time: dddd hh:mm:ss')T -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.')t -1050 FORMAT(' ERROR: Specified expiration period too large.R - & Limit is ',I3,' days.') - R - END - N - . - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z)) - E - INCLUDE '($SSDEF)'n - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - t - CHARACTER*(*) INFILE,OUTFILE= - M - CHARACTER*80 MAIL_EDIT,OUTx - a - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - IF (IER.NE.SS$_NORMAL) MAIL_EDIT = 'SYS$SYSTEM:MAILEDIT'F - E - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF_ - R - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - CALL ENABLE_PRIVSy - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0) THENp - CALL EDT$EDIT(INFILE,OUT) - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THENe - CALL TPU$EDIT(INFILE,OUT)t - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)A - ! TPU does CLI$ stuff which wipes our parsed command lineD - END IF& - O - RETURNE - END - E - E - M - L - ) - SUBROUTINE CREATE_BULLCPT - - IMPLICIT INTEGER (A-Z)l - s - INCLUDE '($PRCDEF)' - T - INCLUDE '($JPIDEF)' - - INCLUDE '($SSDEF)' - E - INCLUDE 'BULLFILES.INC' - T - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - E - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15I - - DIMENSION SAVEPRIV(2) - - CALL DISABLE_PRIVS ! Just let real privileged people do a /STARTUPF - - CALL SYS$SETPRV(%VAL(1),PROCPRIV,,SAVEPRIV) ! Enable original priv0 - H - IF (TEST_BULLCP()) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWERU - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXIT - _ - WILDCARD = -1X - E - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listW - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM))L - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID))c - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1i - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP')_ - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.T - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER)B - CALL EXIT - END IF - END IFh - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY)Z - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)' - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')T - IF (IER.NE.0) RETURNF - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11). - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - O - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0)) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM','NL:' - & ,,,,'BULLCP',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))$ - END DOO - R - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1)' - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IFD - E - CALL SYS$SETPRV(%VAL(0),SAVEPRIV,,) ! Reset privs - N - CALL ENABLE_PRIVS - d - IF (.NOT.IER) THEN_ - CALL SYS_GETMSG(IER) - ELSEB - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF= - CALL EXIT - - END - T - 4 - S - SUBROUTINE FIND_BULLCP) - R - IMPLICIT INTEGER (A-Z)D - I - COMMON /BCP/ BULLCP - LOGICAL BULLCP /.FALSE./ - a - CHARACTER*1 DUMMY - _ - IER = SYS_TRNLNM('BULL_BULLCP',DUMMY) - IF (IER) BULLCP = .TRUE.M - - RETURNI - END - - O - _ - M - LOGICAL FUNCTION TEST_BULLCPB - ( - IMPLICIT INTEGER (A-Z)D - B - COMMON /BCP/ BULLCP - LOGICAL BULLCPR - - TEST_BULLCP = BULLCPS - I - RETURN - END - h - w - - L - SUBROUTINE RUN_BULLCP - g - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'W - _ - INCLUDE 'BULLDIR.INC' - D - INCLUDE 'BULLUSER.INC'w - l - COMMON /BCP/ BULLCP - LOGICAL BULLCPh - a - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSh - i - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - b - BULLCP = .FALSE. ! Enable process to do BULLCP functions - A - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP')E - IF (.NOT.IER) THEN ! Can't create mailbox, so exit.U - CALL SYS_GETMSG(IER) - CALL EXITI - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - a - CALL REGISTER_BULLCPt - - CALL START_DECNET - w - DO WHILE (1) ! Loop once every 15 minutes - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connectiosnc - CALL BBOARD ! Look for BBOARD messages.1 - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))R - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folderT - IF (IER) THENW - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - CALL DELETE_EXPIRED ! Delete expired messages - END IF - END IFD - CALL SYS$SETAST(%VAL(1))P - END DO - CALL WAIT('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folderx -C which requires killing process. -C - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))L - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IFL - CALL SYS$SETAST(%VAL(1))N - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER)d - CALL SYS$SETAST(%VAL(1)) - END DOE - R - RETURNP - END - - - O - SUBROUTINE REGISTER_BULLCPT - H - IMPLICIT INTEGER (A-Z)C - _ - INCLUDE 'BULLUSER.INC' - c - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME,DUMMY(2)) - CHARACTER NODENAME*8p - t - CALL OPEN_FILE(4) - E - DO WHILE (REC_LOCK(IER))n - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,DUMMY,NEW_FLAG,SYSTEM_FLAG - END DOE - I - IF (IER.NE.0) THENT - DO I=1,FLONG - SYSTEM_FLAG(I) = 0x - END DO - CALL SET2(SYSTEM_FLAG,0) - END IFT - A - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)) - N - IF (IER.NE.0) THENC - WRITE (4,IOSTAT=IER) - & '*SYSTEM',NODENAME,DUMMY,NEW_FLAG,SYSTEM_FLAGI - ELSEI - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,DUMMY,NEW_FLAG,SYSTEM_FLAGw - END IF - T - CALL CLOSE_FILE(4)= - S - RETURNI - END - T - T - , - - - SUBROUTINE WAIT(PARAM) -CL -C SUBROUTINE WAIT -CA -C FUNCTION: Waits for specified time period in minutes.E -CN - IMPLICIT INTEGER (A-Z)P - INTEGER TIMADR(2) ! Buffer containing timeI - ! in desired system format.: - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/A - F - DATA WAIT_EF /0/A - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF)F - E - TIMBUF(6:7) = PARAM - ( - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(2)) ! Set timer.R - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set.T - - RETURNp - END - a - n - f - SUBROUTINE WAIT_SEC(PARAM) -Cl -C SUBROUTINE WAIT_SEC! -Cd -C FUNCTION: Waits for specified time period in seconds.e -C0 - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time: - ! in desired system format.e - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/m - DATA WAIT_EF /0/( - R - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF)F - A - TIMBUF(9:10) = PARAMm - a - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer.m - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set.T - F - RETURNL - END - I - I - - E - SUBROUTINE DELETE_EXPIRED - E -Cn -C SUBROUTINE DELETE_EXPIRED -CD -C FUNCTION: -CI -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files,S -C they get converted now. The directory file has had it's record sizeU -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed andy -C was replaced with a 128 byte record compressed format). -CI - N - IMPLICIT INTEGER (A-Z)E - A - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - CHARACTER UPTIME_DATE*11,UPTIME_TIME*8B - M - CALL OPEN_FILE_SHARED(2) ! Open directory filea - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - CALL CLOSE_FILE(1) - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present?I - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls?. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')E - IF (SHUTDOWN.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2))) THEN - ! Do shutdown bulletins exist? - CALL GET_UPTIME(UPTIME_DATE,UPTIME_TIME)( - IER1 = COMPARE_DATE(SHUTDOWN_DATE,UPTIME_DATE) - IF (IER1.EQ.0) IER1 = COMPARE_TIME(SHUTDOWN_TIME,UPTIME_TIME) - IF (IER1.LE.0) SHUTDOWN = 0 - ELSE - IER1 = 1E - END IF - IF (IER.LE.0.OR.IER1.LE.0) THENN - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Reopen without sharing - CALL UPDATE ! Need to updateo - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_FILE(4) ! Create user file to be able to setE - CALL CLOSE_FILE(4) ! defaults, privileges, etc. - END IFI - CALL CLOSE_FILE(2)) - . - RETURN_ - END - - - t - t - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -CA -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - Y - INCLUDE 'BULLDIR.INC' - T - INCLUDE 'BULLFILES.INC' - E - INCLUDE 'BULLUSER.INC'X - - INCLUDE 'BULLFOLDER.INC'C - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - U - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*74,INFROM*74,INTO*76,INPUT*132) - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - ' - DIMENSION NEW_MAIL(FOLDER_MAX)' - S - DATA SPAWN_EF/0/T - = - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF)) - ' - CALL DISABLE_CTRL - ( - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - ( - FOLDER_Q = FOLDER_Q11 - ( - CALL SYS$SETAST(%VAL(0)), - CALL OPEN_FILE_SHARED(7) ! Get folder file - E - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from fileR - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)L - END IF - END DO& - - CALL CLOSE_FILE(7) ! We don't need file anymore - CALL SYS$SETAST(%VAL(1))I - - CALL SYS$SETAST(%VAL(0))= - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1))T - ' - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - = - NBBOARD_FOLDERS = 0 - E - POINT_FOLDER = 0Y - E -1 POINT_FOLDER = POINT_FOLDER + 1i - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900) - E - CALL SYS$SETAST(%VAL(0))) - E - FOLDER_Q_SAVE = FOLDER_Qc - f - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - L - IF (FOLDER_BBOARD.EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - Z - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - C - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1I -C= -C The process is set to the BBOARD uic and username in order to createI -C a spawned process that is able to read the BBOARD mail (a real kludge). -CA - D - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD accounti - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IFS - E - LEN_B = TRIM(BBOARD_DIRECTORY)' - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errorse - d - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THENT - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF))1 - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THENC - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE'c - WRITE(11,'(A)') 'DELETE/ALL' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)U - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF))$ - CALL SYS$SETAST(%VAL(0)) - END IF - ELSEO - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD: - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//T - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1))L - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0))B - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THENA - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)E - CALL SYS$SETAST(%VAL(1)), - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - x - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM)C - - NBULL = F_NBULL - O - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account) - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=110) - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM)i - p - LEN_INPUT = 1 - DO WHILE (LEN_INPUT.GT.0) - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mails - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN) - INDESCRIP = INPUT(7:) ! Store subjectP - ELSE IF (INPUT(:3).EQ.'To:') THEN) - INTO = INPUT(5:) ! Store addressL - END IF - END DOI - S - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - IF (INDEX(INTO,FOLDER_BBOARD(:FLEN)).EQ.0.AND.I - & INTO.NE.FOLDER_BBOARD.AND.INDEX(INTO,'@').EQ.0) THEN - POINT_FOLDER1 = 0N - FOLDER_Q2 = FOLDER_Q1 - FOLDER1_BBOARD = FOLDER_BBOARD - FOUND = .FALSE.e - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - FOLDER_Q2_SAVE = FOLDER_Q2R - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM)0 - FLEN = TRIM(FOLDER1_BBOARD) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND.T - & FOLDER1_BBOARD.NE.'NONE') THEN - IF (INTO.EQ.FOLDER1_BBOARD) THEN - FOUND = .TRUE. - ELSEF - FIND_TO = INDEX(INTO,FOLDER1_BBOARD(:FLEN))a - IF (FIND_TO.GT.0) THEN - END_TO = FLEN+FIND_TO - IF (TRIM(INTO).LT.END_TO.OR.S - & INTO(END_TO:END_TO).LT.'A'.OR.f - & INTO(END_TO:END_TO).GT.'Z') THENe - IF (FIND_TO.EQ.1) THENd - FOUND = .TRUE. - ELSE IF (INTO(FIND_TO-1:FIND_TO-1).LT.'A'.OR. - & INTO(FIND_TO-1:FIND_TO-1).GT.'Z') THEN - FOUND = .TRUE. - END IFt - END IFv - END IF - END IF - END IFr - END DO - IF (FOUND) THENm - IF (F_NBULL.NE.NBULL) CALL UPDATE_FOLDERE - FOLDER_COM = FOLDER1_COM - FOLDER_Q_SAVE = FOLDER_Q2_SAVET - END IF - END IFI - T - IF (FOLDER_NUMBER.EQ.0) THENR - FOLDER_SET = .FALSE. - ELSEL - FOLDER_SET = .TRUE.p - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - R -C. -C Add bulletin to bulletin file and directory entry to directory file. -Ce - A - CALL OPEN_FILE(2) ! Prepare to add dir entryR - I - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - IF (IER.NE.0) GO TO 100 ! If end of file, exit - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) GO TO 5 - ! If line is just form feed, the message is empty - U - CALL OPEN_FILE(1) ! Prepare to add bulletin - 1 - CALL READDIR(0,IER) ! Get NBLOCKT - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - I - OCOUNT = NBLOCK + 1 ! Initialize line count - ) - SPACE = INDEX(INFROM,' ') - 1 ! Strip off the date - IF (SPACE.GT.0) INFROM = INFROM(:SPACE)! From the "From:" lineu - t - IF (TRIM(INFROM).GT.12) THEN ! Is length > allowable?t - LEN_INFROM = TRIM(INFROM)O - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM),E - & OCOUNT)l - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) - I = 12 ! Trim username to first non-alpha character - DO WHILE (I.GT.1.AND.m - & ((INFROM(I:I).GE.'A'.AND.INFROM(I:I).LE.'Z').OR.U - & (INFROM(I:I).GE.'a'.AND.INFROM(I:I).LE.'z')) )S - I = I - 1 - END DO - IF (I.GT.1) INFROM = INFROM(:I-1) - END IF - O - LEN_DESCRP = TRIM(INDESCRIP)R - IF (LEN_DESCRP.GT.53) THEN ! Is length > allowable subject length?R - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//INDESCRIP(:LEN_DESCRP), - & OCOUNT)D - INDESCRIP = INDESCRIP(:LEN_DESCRP) - DO I=1,LEN_DESCRP - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - ELSEL - DO I=1,LEN_DESCRP ! Remove control charactersO - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - END IFl - - ISTART = 0M - NBLANK = 0 - DO WHILE (INPUT(:1).NE.CHAR(12)) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1E - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO7 - NBLANK = 0 - CALL STORE_BULL(MIN(LEN_INPUT,80),INPUT,OCOUNT) - IF (LEN_INPUT.GT.80) THEN ! Breakup line if > 80 chars - CALL STORE_BULL(MIN(LEN_INPUT,132)-80,INPUT(81:),OCOUNT) - END IFB - END IF - READ (3,'(Q,A)',END=25) LEN_INPUT,INPUTD - END DOT - L -25 CALL FLUSH_BULL(OCOUNT) - N - CALL CLOSE_FILE(1) ! Finished adding bulletin - ) - DESCRIP = INDESCRIP(:53) ! Description headerQ - FROM = INFROM(:12) ! Username - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time?R - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)I - SYSTEM = 0 - END IFa - EXTIME = '00:00:00' - LENGTH = OCOUNT - NBLOCK ! Number of records - ( - CALL ADD_ENTRY ! Add the new directory entry - A -30 CALL CLOSE_FILE(2) ! Totally finished with addO - S - CALL SYS$SETAST(%VAL(1))t - c - GO TO 5 ! See if there is more mail - B -100 CALL UPDATE_FOLDER - -110 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GOTO 1' - e -900 FOLDER_NUMBER = 0s - ? - CALL OPEN_FILE_SHARED(7) - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_FILE(7)I - CALL ENABLE_CTRLe - FOLDER_SET = .FALSE.I - - IF (NBBOARD_FOLDERS.EQ.0) THENY - CALL OPEN_FILE(4)I - CALL READ_USER_FILE_HEADER(IER)& - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM)e - REWRITE (4) USER_HEADER ! Rewrite header. - CALL CLOSE_FILE(4) - END IF. - R - RETURNE - ) -910 WRITE (6,1010) - GO TO 100 - s -930 CLOSE (UNIT=3) - CALL CLOSE_FILE(1)O - CALL CLOSE_FILE(2)/ - WRITE (6,1030), - GO TO 100 - S -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.')1 -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - T - S - SUBROUTINE CREATE_BBOARD_PROCESS. - F - IMPLICIT INTEGER (A-Z)S - S - INCLUDE '($PRCDEF)' - P - INCLUDE 'BULLFILES.INC' - S - CHARACTER*132 IMAGENAME - W - CALL GETIMAGE(IMAGENAME,ILEN) - B - LEN_B = TRIM(BBOARD_DIRECTORY)M - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE')S - ' - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)E - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')_ - IF (IER.NE.0) RETURNA - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT'l - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT'' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()'''S - WRITE(11,'(A)') '$EXIT:'S - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11)( - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionO - : - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',O - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:' - & ,,,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - R - RETURNO - END - R - / - C - SUBROUTINE GETUIC(GRP,MEM), -CT -C SUBROUTINE GETUIC(UIC)$ -CA -C FUNCTION: -C To get UIC of process submitting the job.L -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC$ -CF - O - IMPLICIT INTEGER (A-Z). - F - INCLUDE '($JPIDEF)' - . - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list/ - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - C - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - ( - RETURNS - END - E - , - D - C - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)U -CS -C SUBROUTINE GET_UPTIME -Co -C FUNCTION: Gets time of last reboot. -C - o - IMPLICIT INTEGER (A-Z)E - C - EXTERNAL EXE$GL_ABSTIMR - INTEGER UPTIME(2),SYSTIME(2),UPSINCE(2)E - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - B - UPTIME(1) = GET_L_VAL(EXE$GL_ABSTIM) ! Up time (sec)A - ) - CALL LIB$EMUL(10000000,UPTIME,0,UPTIME) ! 64 bit format - CALL SYS$GETTIM(SYSTIME)D - CALL LIB$SUBX(SYSTIME,UPTIME,UPSINCE) - CALL SYS$ASCTIM(,ASCSINCE,UPSINCE,) ! Up sinceI - T - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:20) - - RETURN - END - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURNE - END - - D - R - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z): - T - INCLUDE 'BULLFOLDER.INC': - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERST - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*35B - EQUIVALENCE (INPUT(34:),COUNT)O - ( - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointerN - N - OPEN (UNIT=10,FILE='VMSMAIL',DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT',L - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED) - O - DO I=1,NUM_FOLDERS_ - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)Q - F - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR.I - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::') THEN - ! If normal BBOARD or /VMSMAILD - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER) INPUT - IF (IER.EQ.0.AND.COUNT.GT.0) THEN - NEW_MAIL(I) = .TRUE.E - ELSEI - NEW_MAIL(I) = .FALSE. - END IFa - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DOO - - CLOSE (10)I - N - RETURND - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN)E -C -C FUNCTION: -C To get image name of process.T -C OUTPUT: -C IMAGNAME - Image name of processO -C ILEN - Length of imagename_ -C1 - N - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - I - CHARACTER*(*) IMAGNAME - N - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN))A - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist_ - B - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - E - RETURNO - END - - O - R - R - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - D - IMPLICIT INTEGER (A-Z)A - b - INCLUDE 'BULLDIR.INC' - d - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2),DIR_BTIM(2) - r - IF (REMOTE_SET) THEN' - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSEI - CALL READDIR(1,IER) - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM)! - DIFFB = COMPARE_BTIM(IN_BTIM,DIR_BTIM) - IF (DIFFB.LE.0) THEN - START = 0 - RETURN - END IF - CALL READDIR(NBULL,IER)+ - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM)X - DIFFT = COMPARE_BTIM(IN_BTIM,DIR_BTIM) - IF (DIFFT.GT.0.OR.IER.EQ.NBULL) THEN - START = -1 - RETURNN - END IF - BOT = 0e - TOP = NBULL + 1 - DIFFB = 0T - NCHECKS = 0 - DO WHILE (DIFFB.LE.0.OR.DIFFT.GT.0)F - START = (TOP+BOT) / 2 - CALL READDIR(START,IER) - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFFB = COMPARE_BTIM(IN_BTIM,DIR_BTIM)r - CALL READDIR(START+1,IER) - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFFT = COMPARE_BTIM(IN_BTIM,DIR_BTIM)U - IF (DIFFB.GT.0) THENE - BOT = START + 1 - ELSE - TOP = START - END IF - NCHECKS = NCHECKS + 1 -C1 -C It should never happen, but test to see if can't findN -C newest message, to avoid looping forever.u -Cc - IF (NCHECKS.GT.NBULL) RETURN_ - END DO - END IFS - P - RETURNC - END - diff --git a/decus/vax88a3/bulletin/bulletin4.for b/decus/vax88a3/bulletin/bulletin4.for deleted file mode 100644 index 1002ed5..0000000 --- a/decus/vax88a3/bulletin/bulletin4.for +++ /dev/null @@ -1,1507 +0,0 @@ -From: KBSVAX::KANE "Joseph Kane" 4-APR-1988 19:33 -To: everhart@arisia.DECNET -Subj: forwarded mail - -From uunet!rutgers.edu!Postmaster Mon Apr 4 17:17:47 1988 -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA20994; Mon, 4 Apr 88 16:59:01 edt -Received: from RUTGERS.EDU by uunet.UU.NET (5.54/1.14) - id AA07874; Mon, 4 Apr 88 15:08:59 EDT -Received: by rutgers.edu (5.54/1.15) - id AB20964; Mon, 4 Apr 88 15:10:17 EDT -Date: Mon, 4 Apr 88 15:10:17 EDT -From: uunet!rutgers.edu!Postmaster (Mail Delivery Subsystem) -Subject: Returned mail: Host unknown -Message-Id: <8804041910.AB20964@rutgers.edu> -To: -Status: R - - ----- Transcript of session follows ----- -550 ... Host unknown - - ----- Unsent message follows ----- -Received: by rutgers.edu (5.54/1.15) - id AA19920; Mon, 4 Apr 88 12:28:50 EDT -Received: from steinmetz.UUCP by uunet.UU.NET (5.54/1.14) with UUCP - id AA02176; Mon, 4 Apr 88 12:23:27 EDT -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA16052; Mon, 4 Apr 88 10:25:43 edt -Date: 2 Apr 88 20:17:14 EST -From: steinmetz!MAILER-DAEMON@uunet.uu.net (Mail Delivery Subsystem) -Subject: Returned mail: User unknown -Message-Id: <8804041425.AA16052@kbsvax.steinmetz> -To: MRL@pfc-vax.mit.edu - - ----- Transcript of session follows ----- -mail11: %MAIL-E-SYNTAX, error parsing 'CRD' -550 crd.ge.com!EVERHART%ARISIA.DECNET... User unknown - - ----- Unsent message follows ----- -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA16049; Mon, 4 Apr 88 10:25:43 edt -Received: by ge-dab.GE.COM (smail2.5) - id AA19227; 4 Apr 88 06:43:03 EDT (Mon) -Received: by ge-rtp.GE.COM (smail2.5) - id AA10856; 3 Apr 88 21:17:41 EST (Sun) -Received: by mcnc.mcnc.org (5.54/MCNC/10-20-87) - id AA14769; Sat, 2 Apr 88 21:16:22 EST -From: -Received: by rutgers.edu (5.54/1.15) - id AA01509; Sat, 2 Apr 88 20:53:40 EST -Message-Id: <8804030153.AA01509@rutgers.edu> -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 2 Apr 88 20:18-EST -Date: 2 Apr 88 20:17:14 EST -To: xx!TENCATI@vlsi.jpl.nasa.gov, xx!MHG@mitre-bedford.arpa, - crd.ge.com!xx!EVERHART@ARISIA.DECNET, xx!GAYMAN@ari-hq1.arpa, - radc-softvax!xx!BACH -Subject: BULLETIN4.FOR - -C -C BULLETIN4.FOR, Version 3/24/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist -C if it creates empty space for new user. -C - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CALL OPEN_FILE_SHARED(8) - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_FILE(9) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_FILE(9) - END IF - - CALL CLOSE_FILE(8) ! All done... - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - CHARACTER INPUT*80 - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),80) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IFm - IF (ILEN.GT.0) THEN - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IFT - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT)e - END DO - LENGTH = LENGTH + NBLANK*21 - NBLANK = 04 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DOR - r -100 LENGTH = (LENGTH+127)/128- - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSEI - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - i - RETURNs - END - 5 - p - v - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - l - PARAMETER BRECLEN=128 - t - CHARACTER INPUT*(*),OUTPUT*(BRECLEN)n - - DATA POINT/0/ - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUTS - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THENr - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILENl - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)R - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:)1 - POINT = ILEN - (BRECLEN-1-POINT)5 - END IF - OCOUNT = OCOUNT + 1. - ELSEn - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF. - S - RETURN - - ENTRY FLUSH_BULL(OCOUNT)0 - : - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT) - POINT = 0 - E - RETURNi - 5 - END - A - 5 - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - n - IMPLICIT INTEGER (A-Z)2 - 7 - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUTa - i - IF (REMOTE_SET) THENy - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE3 - WRITE (1'OCOUNT) OUTPUT0 - END IF0 - u - RETURN> - END - d - r - SUBROUTINE GET_BULL(IBLOCK,INPUT,ILEN)C - s - IMPLICIT INTEGER (A-Z) - e - INCLUDE 'BULLDIR.INC' - o - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - d - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - - PARAMETER BRECLEN=128,LINE_LENGTH=80H - u - CHARACTER INPUT*(*),TEMP*(BRECLEN), LEFT*(BRECLEN)o - / - DATA POINT /1/, LEFT_LEN /0/b - t - IF (ILEN.GT.LINE_LENGTH) THEN - POINT = 1 - LEFT_LEN = 0 - END IF1 - 0 - IF (POINT.EQ.1) THENM - IF (REMOTE_SET) THEN - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 i - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) - ELSE - DO WHILE (REC_LOCK(IER))o - READ (1'IBLOCK,IOSTAT=IER) TEMPh - END DOn - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN - ILEN = 0 - POINT = 1x - RETURN - END IFh - o - IF (IER.GT.0) THENo - ILEN = -1 - POINT = 1L - LEFT_LEN = 0 - RETURN - END IFa - i - IF (LEFT_LEN.GT.0) THEN - ILEN = ICHAR(LEFT(:1)) - INPUT = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) - POINT = LEFT_LEN + 1 - LEFT_LEN = 0 - ELSE) - ILEN = ICHAR(TEMP(POINT:POINT))Y - IF (ILEN.GT.BRECLEN-POINT) THENL - LEFT = TEMP(POINT:) - LEFT_LEN = ILEN - (BRECLEN-POINT) - ILEN = 0 - POINT = 1 - ELSE IF (ILEN.EQ.0) THEN - POINT = 1 - ELSE - INPUT = TEMP(POINT+1:POINT+ILEN)N - POINT = POINT+ILEN+1r - END IF - END IFB - T - RETURNU - E - ENTRY TEST_MORE_LINES(ILEN) - - IF (POINT.EQ.BRECLEN+1) THEN0 - ILEN = 0 - ELSE! - ILEN = ICHAR(TEMP(POINT:POINT))4 - END IFU - _ - RETURN) - Z - END - e - r - E - SUBROUTINE GET_REMOTE_MESSAGE(IER)N -CC -C SUBROUTINE GET_REMOTE_MESSAGE -CF -C FUNCTION: -C Gets remote message. -CS - - IMPLICIT INTEGER (A-Z)a - o - INCLUDE 'BULLDIR.INC' - E - CHARACTER*128 INPUT - S - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - 6 - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - 6 - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to headI - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointeri - END IF - e - ILEN = 128t - IER = 0 - LENGTH = 0E - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) THEN - LENGTH = 0 - IER1 = IERr - CALL DISCONNECT_REMOTEU - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - RETURNS - END - - - t - l - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C, -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -CY - A - IMPLICIT INTEGER (A-Z)C - , - INCLUDE 'BULLDIR.INC' - D - INCLUDE 'BULLFOLDER.INC't - i - CHARACTER*80 INPUT$ - Q - IF (NBULL.GT.0) THENV - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - n - IF (BTEST(FOLDER_FLAG,1)) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - WRITE (3,'(A)') CHAR(12)V - END IF - ) - WRITE (3,1050) DESCRIP ! Output bulletin header info - WRITE (3,1060) FROM,DATE - 1 - CALL OPEN_FILE(1)E - M - ILEN = 81T - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file+ - DO WHILE (ILEN.GT.0)t - CALL GET_BULL(I,INPUT,ILEN)R - IF (ILEN.LT.0) THENO - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DOT - ILEN = 80 - END DO - E -90 CLOSE (UNIT=3) ! Bulletin copy completed - D - CALL CLOSE_FILE(1) - END IFE - -900 DELETE(UNIT=2,REC=BULL_ENTRY+1) - I - NEMPTY = NEMPTY + LENGTHL - CALL WRITEDIR(0,IER)D - -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/)R - R - RETURN - END - S - O - N - L - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -CO -C SUBROUTINE GET_EXDATE -Cs -C FUNCTION: Computes expiration date giving number of days to expire.s -Ce - IMPLICIT INTEGER (A-Z)U - ' - CHARACTER*11 EXDATE - A - CHARACTER*3 MONTHS(12)C - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP',E - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/8 - Y - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - l - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO. - 0 - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSED - LENGTH(2) = 27 - END IFL - N - NUM_DAYS = NDAYS ! Put number of days into buffer variableF - T - DO WHILE (NUM_DAYS.GT.0)l - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of monthm - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month: - DAY = 1 ! Reset day to first of monthl - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year?h - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IFT - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exitO - END IF - END DON - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date) - ) - RETURNI - END - T - A - I - SUBROUTINE GET_LINE(INPUT,LEN_INPUT)I -CT -C SUBROUTINE GET_LINE -C! -C FUNCTION: -C Gets line of input from terminal.C -CF -C OUTPUTS:i -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -CE -C NOTES:N -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST.. -CT - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE)O - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - 1 - EXTERNAL SMG$_EOF - G - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - I - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - U - COMMON /CTRLC_FLAG/ FLAGE - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPT - P - USE_PROMPT = .FALSE.l - P - GO TO 5 - L - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT)n - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - T -CT -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE andT -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1C -C - T - CALL DECLARE_CTRLC_AST( - I - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limitT - POINTER = 0 ! during input.- - N -C1 -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line.: -CN - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTL - IF (IER.NE.0) LEN_INPUT = -2 E - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSEP - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompt - END IF - M - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER)1 - O - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input?T - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line1 - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO1 - CALL CONVERT_TABS(INPUT,LEN_INPUT)G - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say soS - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - E - A - C - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT)D - H - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - E - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT)N - Q - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:)I - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO0 - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMITE - INPUT(I:I) = ' ' - END DO_ - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURNT - END - - E - SUBROUTINE FILTER (INCHAR, LENGTH)L - N - IMPLICIT INTEGER (A-Z)E - r - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10)) - & .OR.INCHAR(I:I).GT.'~') INCHAR(I:I) = '.' - END DO - - RETURNN - END - O - M - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logicalN - CHARACTER*(*) OUTPUT ! byte to character valueN - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURNA - END - I - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routineT - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLC_FLAG/ FLAGI - S - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH()o - CALL EXIT - END IFi - FLAG = 1 ! to set flag - RETURN( - END - , - U - - SUBROUTINE DECLARE_CTRLC_ASTn -Ch -C SUBROUTINE DECLARE_CTRLC_ASTE -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES:A -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/.T -C - IMPLICIT INTEGER (A-Z) - L - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINEE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAGE - E - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURNT - - ENTRY CANCEL_CTRLC_ASTT - : - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QION - & CTRLC_ROUTINE,,,,,) ! Enable the AST - N - RETURN - END - L - . - T - V - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -CE -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -CC - IMPLICIT INTEGER (A-Z)E - ' - CHARACTER*(*) DATA,PROMPT - N - COMMON /TERM_CHAN/ TERM_CHANR - L - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - R - COMMON /CTRLC_FLAG/ FLAGL - - INCLUDE '($TRMDEF)' - A - INTEGER TERMSET(2)) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/e - r - DATA PURGE/.TRUE./1 - ) - DO I=1,LEN(DATA) - DATA(I:I) = ' 'M - END DON - 8 - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),H - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSEL - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),. - & TRM$M_TM_NOECHO) - END IF( - ) - RETURNL - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT)E - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DOi - o - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),U - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.R - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),' - & TRM$M_TM_NOECHO) - END IFD - S - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN)Y - - DO I=1,LEN(DATA)E - DATA(I:I) = ' 'T - END DOp - s - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE.D - ELSEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,,' - & TERMSET,NLEN,TERM) - END IF - T - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN3 - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM)2 - END IF( - ) - RETURNt - y - ENTRY ASSIGN_TERMINAL - : - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal( - T - CALL DECLARE_CTRLC_ASTm - h - FLAG = 2 ! Indicates that a CTRLC will cause an exit - . - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - i - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)2 - - IER = SMG$CREATE_KEY_TABLE (KEY_TABLE_ID) - r - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - N - DO I=ICHAR('0'),ICHAR('9')A - MASK(2) = IBCLR(MASK(2),I-32) - END DOr - o - RETURNc - END - o - o - m - - - SUBROUTINE GETPAGLEN(PAGE_LENGTH) -C -C SUBROUTINE GETPAGLEN -Cf -C FUNCTION: -C Gets page length of the terminal.e -C -C OUTPUTS:o -C PAGE_LENGTH - Page length of the terminal. -Cn - IMPLICIT INTEGER (A-Z)N - E - INCLUDE '($DVIDEF)' - n - LOGICAL*1 DEVDEPEND(4) - R - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1)))H - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,)L - T - PAGE_LENGTH = DEVDEPEND(4) - - RETURNT - END - E - ! - - i - i - LOGICAL FUNCTION SLOW_TERMINAL -CD -C FUNCTION SLOW_TERMINAL -Ci -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -CC -C OUTPUTS:E -C SLOW_TERMINAL = .true. if slow, .false. if not.( -C' - D - IMPLICIT INTEGER (A-Z)r - t - EXTERNAL IO$_SENSEMODE= - N - COMMON /TERM_CHAN/ TERM_CHANw - t - COMMON CHAR_BUF(2)D - T - LOGICAL*1 IOSB(8) - E - INCLUDE '($TTDEF)'T - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - T - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE.. - END IFN - S - RETURNo - END - t - l - s - L - SUBROUTINE SHOW_PRIV -CU -C SUBROUTINE SHOW_PRIVi -Cg -C FUNCTION: -C To show privileges necessary for managing bulletin board.8 -CT - , - IMPLICIT INTEGER (A-Z) - C - INCLUDE 'BULLUSER.INC'V - N - INCLUDE '($PRVDEF)' - E - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - S - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - D - CALL READ_USER_FILE_HEADER(IER) - C - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not presentT - CALL CLOSE_FILE(4) - CALL OPEN_FILE(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRVp - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')')h - DO I=0,38, - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR.( - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THENN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSEe - WRITE (6,'('' ERROR: Cannot show privileges.'')')I - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURNn - - END - i - , - - - SUBROUTINE SET_PRIV -Ca -C SUBROUTINE SET_PRIV -Cx -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C_ - U - IMPLICIT INTEGER (A-Z)0 - E - INCLUDE '($PRVDEF)' - N - INCLUDE 'BULLUSER.INC'H - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - T - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVSh - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/) - E - EXTERNAL CLI$_ABSENT - L - DIMENSION ONPRIV(2),OFFPRIV(2). - t - CHARACTER*8 INPUT_PRIVD - = - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THENI - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IFL - I - OFFPRIV(1) = 0P - OFFPRIV(2) = 0L - ONPRIV(1) = 0 - ONPRIV(2) = 0 - R - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,LEN)! - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - PRIV_FOUND = -1I - I = 0P - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1)A - IF (INPUT_PRIV(:LEN).EQ.PRIVS(I)) PRIV_FOUND = I= - IF (INPUT_PRIV(3:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:LEN) - RETURNM - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN' - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)U - END IFT - ELSE - IF (PRIV_FOUND.LT.32) THENE - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSEI - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32): - END IF - END IF - END DOI - E - CALL OPEN_FILE(4) ! Get BULLUSER.DAT file& - - CALL READ_USER_FILE_HEADER(IER) - = - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1))P - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2))! - REWRITE (4) USER_HEADERI - WRITE (6,'('' Privileges successfully modified.'')') - ELSE/ - WRITE (6,'('' ERROR: Cannot modify privileges.'')')( - END IF - r - CALL CLOSE_FILE(4) ! All finished with BULLUSER - D - RETURNA - - END - - - g - R - R - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -CT -C SUBROUTINE ADD_ACLT -C -C FUNCTION: Adds ACL to bulletin files. -Cr -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.D -C IER - Return error from attempting to set ACL. -CE -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - _ - INCLUDE 'BULLFOLDER.INC'L - I - CHARACTER ACLENT*255,ID*(*),ACCESS*(*)O - % - INCLUDE '($ACLDEF)' - R - INCLUDE '($SSDEF)' - & - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS='T - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN( - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID) THENt - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16)m - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,)C - END IFO - END IF - END IFE - IF (.NOT.IER) RETURN - R - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLEN = TRIM(FOLDER1_FILE) - 8 - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//D - & '.BULLDIR',%VAL(ACL_ITMLST),,,). - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//R - & '.BULLFIL',%VAL(ACL_ITMLST),,,)N - IF (.NOT.IER) RETURNR - R - RETURNE - END - I - T - E - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -CE -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -CS -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.G -C IER - Return error from attempting to set ACL. -CM -C NOTE: The ID must be in the RIGHTS data base. -CT - IMPLICIT INTEGER (A-Z) - , - INCLUDE 'BULLFOLDER.INC' - T - CHARACTER ACLENT*255,ID*(*),ACCESS*(*)L - G - INCLUDE '($ACLDEF)' - D - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - , - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT))o - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistC - ELSEM - CALL INIT_ITMLST ! Initialize item list_ - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT))n - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistI - END IFt - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//i - & '.BULLDIR',%VAL(ACL_ITMLST),,,)0 - IF (.NOT.IER) RETURNT - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//T - & '.BULLFIL',%VAL(ACL_ITMLST),,,)H - IF (.NOT.IER) RETURN - L - RETURN, - END - E - D - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDERE -CN -C FUNCTION: Creates a new bulletin folder.N -CO - - IMPLICIT INTEGER (A-Z) - m - INCLUDE 'BULLFOLDER.INC' - E - INCLUDE 'BULLUSER.INC'f - e - INCLUDE 'BULLFILES.INC' - E - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - N - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THEN_ - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IFt - i - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - G - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IFW - R - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privilegedd - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR.. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'(S - & '' ERROR: No privs for SYSTEM, NOTIFY, BRIEF or READNEW.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified?) - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node nameS - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - FOLDER1 = FOLDER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)H - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURNt - ELSE IF (CLI$PRESENT('SYSTEM').AND.Z - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'',3 - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IFU - _ - WRITE (6,'('' Enter one line description of folder.'')')p - e -10 CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - GO TO 10 - END IF6 - ' - CALL OPEN_FILE(7) ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0)I - ! See if folder existsN - T - IF (IER.EQ.0) THENR - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF) - - FOLDER_OWNER = USERNAME ! Get present username - O - FOLDER_SET = .TRUE. - . - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY.T -C The file prefix is the name of the folder.g -Cl - i - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')')O - GO TO 910P - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER) - END IFR - h - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='NEW', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',IOSTAT=IER,T - 1 ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED') - L - IF (IER.NE.0) THEN' - WRITE(6,'('' ERROR: Cannot create folder directory file.'')')L - CALL ERRSNS(IDUMMY,IER)A - CALL SYS_GETMSG(IER) - GO TO 910S - END IF) - E - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,, - 1 FORM='UNFORMATTED',IOSTAT=IER) - O - IF (IER.NE.0) THENr - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER)I - CALL SYS_GETMSG(IER) - GO TO 910C - END IFL - ' - FOLDER_FLAG = 0 - V - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THENd - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)R - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))( - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1). - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))E - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1)V - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER)R - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IFP - _ - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DON - L - IF (IER.EQ.0) THEND - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAXe - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 9102 - ELSER - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IFV - . - IF (.NOT.CLI$PRESENT('NODE')) THEN2 - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0T - NBULL = 0: - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSEE - REMOTE_SET = .TRUE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF- - FOLDER_OWNER = USERNAME ! Get present usernamee - - IF (CLI$PRESENT('SYSTEM')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - END IF - t - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST - C - CLOSE (UNIT=1)I - CLOSE (UNIT=2)T - A - NOTIFY = 0( - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN( - BRIEF = 1Q - READNEW = 1. - END IFE - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - , - WRITE (6,'('' Folder is now set to '',A)')S - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000 - c -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE.I - CLOSE (UNIT=1,STATUS='DELETE')R - CLOSE (UNIT=2,STATUS='DELETE')E - I -1000 CALL CLOSE_FILE(7)I - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection/ - C - RETURN - & - END - - / -.. - / diff --git a/decus/vax88a3/bulletin/bulletin5.for b/decus/vax88a3/bulletin/bulletin5.for deleted file mode 100644 index f2edb44..0000000 --- a/decus/vax88a3/bulletin/bulletin5.for +++ /dev/null @@ -1,1495 +0,0 @@ -From: KBSVAX::KANE "Joseph Kane" 4-APR-1988 19:35 -To: everhart@arisia.DECNET -Subj: forwarded mail - -From uunet!rutgers.edu!Postmaster Mon Apr 4 16:47:17 1988 -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA20728; Mon, 4 Apr 88 16:45:44 edt -Received: from RUTGERS.EDU by uunet.UU.NET (5.54/1.14) - id AA08081; Mon, 4 Apr 88 15:17:06 EDT -Received: by rutgers.edu (5.54/1.15) - id AF20964; Mon, 4 Apr 88 15:18:34 EDT -Date: Mon, 4 Apr 88 15:18:34 EDT -From: uunet!rutgers.edu!Postmaster (Mail Delivery Subsystem) -Subject: Returned mail: Host unknown -Message-Id: <8804041918.AF20964@rutgers.edu> -To: -Status: R - - ----- Transcript of session follows ----- -550 ... Host unknown - - ----- Unsent message follows ----- -Received: by rutgers.edu (5.54/1.15) - id AA19947; Mon, 4 Apr 88 12:30:04 EDT -Received: from steinmetz.UUCP by uunet.UU.NET (5.54/1.14) with UUCP - id AA02246; Mon, 4 Apr 88 12:25:29 EDT -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA16180; Mon, 4 Apr 88 10:34:04 edt -Date: 2 Apr 88 20:17:35 EST -From: steinmetz!MAILER-DAEMON@uunet.uu.net (Mail Delivery Subsystem) -Subject: Returned mail: User unknown -Message-Id: <8804041434.AA16180@kbsvax.steinmetz> -To: MRL@pfc-vax.mit.edu - - ----- Transcript of session follows ----- -mail11: %MAIL-E-SYNTAX, error parsing 'CRD' -550 crd.ge.com!EVERHART%ARISIA.DECNET... User unknown - - ----- Unsent message follows ----- -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA16173; Mon, 4 Apr 88 10:34:04 edt -Received: by ge-dab.GE.COM (smail2.5) - id AA19231; 4 Apr 88 06:43:09 EDT (Mon) -Received: by ge-rtp.GE.COM (smail2.5) - id AA10867; 3 Apr 88 21:17:55 EST (Sun) -Received: by mcnc.mcnc.org (5.54/MCNC/10-20-87) - id AA14779; Sat, 2 Apr 88 21:17:45 EST -From: -Received: by rutgers.edu (5.54/1.15) - id AA02126; Sat, 2 Apr 88 21:01:12 EST -Message-Id: <8804030201.AA02126@rutgers.edu> -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 2 Apr 88 20:19-EST -Date: 2 Apr 88 20:17:35 EST -To: xx!TENCATI@vlsi.jpl.nasa.gov, xx!MHG@mitre-bedford.arpa, - crd.ge.com!xx!EVERHART@ARISIA.DECNET, xx!GAYMAN@ari-hq1.arpa, - radc-softvax!xx!BACH -Subject: BULLETIN5.FOR - -C -C BULLETIN5.FOR, Version 3/27/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (.NOT.SETPRV_PRIV().AND.INCMD(:3).EQ.'SET') THEN - WRITE (6,'( - & '' ERROR: No privs to change all defaults.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_HEADER(IER) - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - - IF (BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - CALL CLOSE_FILE(4) - - RETURN - END - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL OPEN_FILE(2) ! Remove directory file - CALL OPEN_FILE(1) ! Remove bulletin file - CALL CLOSE_FILE_DELETE(1) - CALL CLOSE_FILE_DELETE(2) - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) FOLDER_SET = .FALSE. - -1000 CALL CLOSE_FILE(7) - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - EXTERNAL CLI$_ABSENT - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1,FLEN) - IF (IER.AND.FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - CALL OPEN_FILE_SHARED(7) ! Go find folder - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND.- - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERALn - FOLDER_NUMBER = 0e - FOLDER1 = 'GENERAL'8 - END IFd - b - REMOTE_TEST = 0 - . - IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::')E - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1)d - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMPt - & (FOLDER1(:TRIM(FOLDER1)),IER)0 - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSEp - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - s - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0z - CALL REWRITE_FOLDER_FILE_TEMPi - END IF - - CALL CLOSE_FILE(7)8 - : - IF (IER.EQ.0.AND.FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allowe - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIPl - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)u - IF (IER.NE.0) THEN - IF (OUTPUT) THENe - WRITE (6,'('' ERROR: Unable to connect to folder.'')') - END IF- - RETURNI - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::". - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'//v - & FOLDER1 - FOLDER1_NUMBER = -1 - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! & local flag info - CALL OPEN_FILE(7) ! Update local folder informationo - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - FOLDER_COM = FOLDER1_COM! - CALL REWRITE_FOLDER_FILEy - CALL CLOSE_FILE(7) - END IF - REMOTE_SET = .TRUE.S - END IFg - d - IF (IER.EQ.0) THEN ! Folder founde - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1a - IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::' - & .AND..NOT.SETPRV_PRIV()) THEN. - ! Is folder protected and not remote?@ - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER)B - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAMEn - & .NE.FOLDER1_OWNER) THENr - CALL CHECK_ACCESSF - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS)E - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')')D - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_FILE_SHARED(4)I - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER)L - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - REWRITE (4) USER_ENTRYY - CALL CLOSE_FILE(4) - END IF - IER = 0L - RETURN - END IF - END IFE - ELSE ! Folder not protectedM - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - L - IF (FOLDER1_BBOARD(:2).NE.'::') THEN - IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE.) - END IF - L - IF (IER) THEN) - FOLDER_COM = FOLDER1_COM ! Folder successfully set soE - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - R - IF (FOLDER_NUMBER.NE.0) THENE - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE.L - END IFF - E - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - BULL_POINT = 0 ! Reset pointer to first bulletinE - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR')O - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE.o - ELSE - READ_ONLY = .FALSE. - END IFI - ELSEO - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0) THENR - IF (TEST_BULLCP()) THENA - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THENn - ! If first select, look for expired messages. - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (IER.LE.0) CALL UPDATE ! Need to update - ELSEI - NBULL = 0_ - END IFT - CALL CLOSE_FILE(2) - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IFD - END IFR - / - IF (FOLDER_NUMBER.NE.0) THENR - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)n - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find itF - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0)N - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1) - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins: - ELSE - BULL_POINT = 0 - END IF - END IFT - END IF - END IF, - IER = 1 - ELSE IF (OUTPUT) THENI - WRITE (6,'('' Cannot access specified folder.'')')F - CALL SYS_GETMSG(IER)e - END IF - ELSE ! Folder not foundA - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IFL - - RETURNI - = - END - F - - T - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -CN -C SUBROUTINE CONNECT_REMOTE_FOLDERC -C -C FUNCTION: Connects to folder that is located on other DECNET node.L -CL - IMPLICIT INTEGER (A-Z)E - I - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - L - INCLUDE 'BULLUSER.INC'R - F - INCLUDE 'BULLFOLDER.INC'O - R - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - I - DIMENSION DUMMY(2)o - . - REMOTE_UNIT = 31 - REMOTE_UNIT1 - O - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))R - & //'::"TASK=BULLETIN1"')E - - IF (IER.EQ.0) THENc - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1S - FOLDER_OWNER_SAVE = FOLDER1_OWNERt - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBERF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY,e - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IFe - d - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_KEYNAME(USERNAME,IER)U - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - REWRITE (4) USER_ENTRY - CALL CLOSE_FILE(4) - END IF - END IF - IER = 2E - ELSET - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVER - FOLDER1_OWNER = FOLDER_OWNER_SAVEI - CLOSE (UNIT=31-REMOTE_UNIT)r - IF ((FOLDER_NUMBER.NE.FOLDER1_NUMBER.AND.(DUMMY(1).NE.0e - & .OR.DUMMY(2).NE.0)).OR.FOLDER1_NUMBER.EQ.-1) THENm - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - END IF - IER = 0E - END IF/ - E - RETURN - END - - D - - - C - - N - L - H - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDERT -CR -C FUNCTION: Updates folder info due to new message. -C_ - B - IMPLICIT INTEGER (A-Z)E - A - INCLUDE 'BULLDIR.INC' - M - INCLUDE 'BULLFOLDER.INC') - H - IF (FOLDER_NUMBER.LT.0) RETURNN - E - CALL OPEN_FILE_SHARED(7) ! Open folder file - M - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - L - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)O - T - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2)E - = - CALL REWRITE_FOLDER_FILE( - D - CALL CLOSE_FILE(7)1 - M - RETURN - END - R - 0 - - SUBROUTINE SHOW_FOLDERS -C -C SUBROUTINE SHOW_FOLDERE -CI -C FUNCTION: Shows the information on any folder.) -CR - - IMPLICIT INTEGER (A-Z)D - L - INCLUDE 'BULLUSER.INC'D - , - INCLUDE 'BULLFOLDER.INC' - O - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'F - _ - INCLUDE '($RMSDEF)' - , - EXTERNAL CLI$_ABSENT - E - CALL OPEN_FILE_SHARED(7) ! Open folder file - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).NE.%LOC(CLI$_ABSENT)) - & THEN -10 CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)8 - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1Q - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_FILE(7) - RETURNM - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - ELSE IF (FOLDER_SET) THEN - WRITE (6,1000) FOLDER,FOLDER_OWNER, - & FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - FOLDER1_FILE = FOLDER_FILE - FOLDER1_BBOARD = FOLDER_BBOARD - FOLDER1_BBEXPIRE = FOLDER_BBEXPIRE - FOLDER1_NUMBER = FOLDER_NUMBER - FOLDER1_FLAG = FOLDER_FLAG - F1_EXPIRE_LIMIT = F_EXPIRE_LIMIT - ELSEs - FOLDER1 = 'GENERAL'F - GO TO 10 - END IFG - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACLp - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER)R - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - WRITE (6,'('' Folder is not a private folder.'')') - ELSE - CALL CHECK_ACCESSS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - IF (WRITE_ACCESS)/ - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THENE - FLEN = TRIM(FOLDER1_BBOARD) - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN)N - END IFU - IF ((USERB.EQ.0.AND.GROUPB.EQ.0).OR.BTEST(USERB,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')o - IF (BTEST(GROUPB,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')')S - END IF - END IFU - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' BBOARD expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIREE - ELSE, - WRITE (6,'('' BBOARD messages will not expire.'')')L - END IFF - ELSEU - WRITE (6,'('' No BBOARD has been defined.'')') - END IFF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IFR - IF (F1_EXPIRE_LIMIT.GT.0) THENR - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF) - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_HEADER(IER) - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is BRIEF.'')')F - ELSE - WRITE (6,'('' Default is READNEW.'')')3 - END IF - ELSE, - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is SHOWNEW.'')')e - ELSE - WRITE (6,'('' Default is NOREADNEW.'')')I - END IF - END IFN - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY.'')') - ELSE. - WRITE (6,'('' Default is NONOTIFY.'')') - END IFo - CALL CLOSE_FILE(4)' - END IF - END IF= - R - CALL CLOSE_FILE(7)R - _ - RETURNA - . -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12,L - & ' Description: ',/,1X,A) - END - - O - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERSp -Cd -C FUNCTION: Display all FOLDER entries. -CD - IMPLICIT INTEGER (A - Z)o - o - INCLUDE 'BULLFOLDER.INC'. - 1 - INCLUDE 'BULLUSER.INC'n - - COMMON /PAGE/ PAGE_LENGTH,PAGINGE - LOGICAL PAGING - - DATA SCRATCH_D1/0/I - L - CHARACTER*17 DATETIME - - EXTERNAL CLI$_NEGATED,CLI$_PRESENT - D - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE specified - ELSEC - NLINE = 1T - END IFM - F -CE -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.e -C, - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_INFO)U - SCRATCH_D = SCRATCH_D1s - i - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDER = 0D - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from file. - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_INFO)E - END IF - END DO - - CALL CLOSE_FILE(7) ! We don't need file anymore - D - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IFi - o -Ce -C Folder entries are now in queue. Output queue entries to screen. -CT - O - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - C - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen_ - E - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ' - IF (.NOT.PAGING) THEN - DISPLAY = (NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2R - ELSE& - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2,PAGE_LENGTH-4) - ! If more entries than page size, truncate output - END IFO - R - DO I=FOLDER_COUNT,FOLDER_COUNT+(DISPLAY-2)/NLINE-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_INFO)N - DIFF = COMPARE_BTIM, - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEND - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,)S - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counterL - END DO_ - G - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are moreD - END IF - O - RETURNB - = -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1010 FORMAT(1X,/,' Press RETURN for more...',/)T - - END - F - E - SUBROUTINE SET_ACCESS(ACCESS) -CM -C SUBROUTINE SET_ACCESS -C( -C FUNCTION: Set access on folder for specified ID._ -CD -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access( -C - - IMPLICIT INTEGER (A-Z)D - / - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLUSER.INC' - B - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'L - T - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT. - _ - CHARACTER ID*25,RESPONSE*1E - A - IF (CLI$PRESENT('ALL')) THENI - ALL = .TRUE. - ELSE - ALL = .FALSE.B - END IFR - R - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSEE - READONLY = .FALSE. - END IF) - L - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - N - IF (IER.EQ.%LOC(CLI$_ABSENT)) THENE - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THENL - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')D - RETURN - END IFT - - IF (.NOT.ALL) THENS - IER = CLI$GET_VALUE('ACCESS_ID',ID,LEN) ! Get IDr - IF (LEN.GT.25) THENR - WRITE(6,'('' ERROR: ID name must be < 26 characters.'')') - RETURNO - END IF - END IFU - ' - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it existsN - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_FILE(7)V - E - IF ((.NOT.ALL).AND.(ID.EQ.FOLDER1_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Cannot modify access for owner of folder.'')')E - RETURN - END IF( - I - IF (IER.NE.0) THEN/ - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - CALL CHKACL) - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER)D - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENR - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THENI - WRITE (6,'('' Folder access was not changed.'')')_ - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)_ - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)S - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')')O - GOTO 100 - END IF - END IF - END IF - IF (ACCESS) THEN - IF (.NOT.ALL) THEN( - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER)R - ELSE3 - CALL ADD_ACL(ID,'R+W',IER). - END IFN - ELSER - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSEr - CALL DEL_ACL(' ','R+W',IER) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF. - END IF. - ELSE - IF (ALL) THEN - CALL DEL_ACL('*','R',IER) - ELSEh - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF. - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' ERROR: Cannot modify ACL of folder files.'')') - CALL SYS_GETMSG(IER)& - ELSE - WRITE (6,'('' Access to folder has been modified.'')')t -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - CALL OPEN_FILE(7) ! Open folder file - OLD_FOLDER1_FLAG = FOLDER1_FLAGA - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAGA - CALL REWRITE_FOLDER_FILE_TEMPe - CALL CLOSE_FILE(7) - END IF_ - END IF - END IFE - - RETURN( - ( - END - T - - i - SUBROUTINE CHKACL(FILENAME,IERACL)_ -CI -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -CL -C PARAMETERS: -C FILENAME - Name of file to check.A -C IERACL - Error returned for attempt to open file.L -CD - F - IMPLICIT INTEGER (A-Z)W - E - CHARACTER*(*) FILENAME. - ' - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)'i - E - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - O - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - F - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL) - END IF - S - RETURNI - END - ' - f - t - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -CF -C SUBROUTINE CHECK_ACCESS -CE -C FUNCTION: Checks ACL of given file. -Cn -C PARAMETERS: -C FILENAME - Name of file to check.t -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C -C NOTE: SYS$CHECK_ACCESS is only available under V4.4 or later. -C If you have an earlier version, comment out the lines which call -C it and set both READ_ACCESS and WRITE_ACCESS to 1, which will_ -C allow program to run, but will not allow READONLY access feature.A -CR - - IMPLICIT INTEGER (A-Z)L - N - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - RETURN - END IFs - i - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - a - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME,D - & %VAL(ACL_ITMLST))o - h - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THENq - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - END IFF - E - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))R - _ - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THENN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF - d - RETURN - END - o - - - - SUBROUTINE SHOWACL(FILENAME)T -C6 -C SUBROUTINE SHOWACLe -C' -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check.= -CR - IMPLICIT INTEGER (A-Z)i - r - INCLUDE '($ACLDEF)' - O - CHARACTER*(*) FILENAMEu - r - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)), - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - 1 - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)L - - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH)A - L - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - c - RETURNt - END - O - R - D - SUBROUTINE FOLDER_FILE_ROUTINES - Y - IMPLICIT INTEGER (A-Z)A - U - CHARACTER*(*) KEY_NAMEC - , - INCLUDE 'BULLFOLDER.INC'C - A - ENTRY WRITE_FOLDER_FILE(IER)T - 1 - DO WHILE (REC_LOCK(IER))T - WRITE (7,IOSTAT=IER) FOLDER_COM - END DOL - Y - RETURN, - E - ENTRY REWRITE_FOLDER_FILE - E - REWRITE (7) FOLDER_COM - N - RETURNN - F - ENTRY REWRITE_FOLDER_FILE_TEMPQ - - REWRITE (7) FOLDER1_COM - - RETURN1 - T - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - F - ENTRY READ_FOLDER_FILE_TEMP(IER)L - 1 - DO WHILE (REC_LOCK(IER))= - READ (7,IOSTAT=IER) FOLDER1_COMn - END DOD - _ - RETURN - L - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - e - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - n - DO WHILE (REC_LOCK(IER))T - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COMR - END DO0 - F - FOLDER_NUMBER = SAVE_FOLDER_NUMBER0 - F - RETURN/ - P - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)O - N - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END DOc - e - RETURND - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - c - DO WHILE (REC_LOCK(IER))( - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN' - L - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER)I - U - DO WHILE (REC_LOCK(IER))L - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COMA - END DO* - R - RETURNE - A - END - I - E - SUBROUTINE USER_FILE_ROUTINES - . - IMPLICIT INTEGER (A-Z)E - - CHARACTER*(*) KEY_NAMEE - T - INCLUDE 'BULLUSER.INC'E - N - CHARACTER*12 SAVE_USERNAMED - Y - ENTRY READ_USER_FILE(IER) - = - SAVE_USERNAME = USERNAMEE - F - DO WHILE (REC_LOCK(IER))m - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAMER - ( - RETURNR - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - E - SAVE_USERNAME = USERNAMEO - L - DO WHILE (REC_LOCK(IER))_ - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY. - END DOE - - USERNAME = SAVE_USERNAMEI - TEMP_USER = KEY_NAMEr - e - RETURN - - ENTRY READ_USER_FILE_HEADER(IER)' - C - DO WHILE (REC_LOCK(IER))l - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - END DOi - t - RETURN - D - ENTRY WRITE_USER_FILE_NEW(IER)L - L - SET_FLAG(1) = SET_FLAG_DEF(1) - SET_FLAG(2) = SET_FLAG_DEF(2) - BRIEF_FLAG(1) = BRIEF_FLAG_DEF(1) - BRIEF_FLAG(2) = BRIEF_FLAG_DEF(2) - NOTIFY_FLAG(1) = NOTIFY_FLAG_DEF(1) - NOTIFY_FLAG(2) = NOTIFY_FLAG_DEF(2) - - ENTRY WRITE_USER_FILE(IER)' - ) - DO WHILE (REC_LOCK(IER))E - WRITE (4,IOSTAT=IER) USER_ENTRYN - END DOT - 6 - RETURN& - ' - END - Y - a - n - a - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERICF -CE -C FUNCTION: Enables or disables "GENERIC" display, i.e. displayingK -C general bulletins continually for a certain amount of days.R -C - IMPLICIT INTEGER (A-Z)P - O - INCLUDE 'BULLUSER.INC' - F - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - E - IF (.NOT.SETPRV_PRIV()) THENo - WRITE (6,'(U - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IFl - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - ) - CALL OPEN_FILE_SHARED(4). - . - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)' - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSEL - NEW_FLAG(2) = ' 7'_ - END IFF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSEt - WRITE (6,'('' ERROR: Specified username not found.'')')' - END IFO - 1 - CALL CLOSE_FILE(4) - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C. -C SUBROUTINE SET_LOGIN( -CD -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z)' - ' - INCLUDE 'BULLUSER.INC' - S - CHARACTER TODAY*23D - Y - DIMENSION NOLOGIN_BTIM(2) - C - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - I - IF (.NOT.SETPRV_PRIV()) THENR - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF( - , - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - I - CALL OPEN_FILE_SHARED(4)( - T - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER). - - CALL SYS_BINTIM('5-NOV-2956',NOLOGIN_BTIM)E - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).EQ.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IFL - = - CALL CLOSE_FILE(4) - - RETURNW - END - E - I - T - e - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z)T - - PARAMETER UAF$V_DISACNT = 4, UAF$L_UIC = '24'X - PARAMETER UAF$L_ACCOUNT = 53T - PARAMETER UAF$L_FLAGS = '1D4'XL - PARAMETER INPUT_LEN = UAF$L_FLAGS + 4 - - CHARACTER INPUT*(INPUT_LEN),USERNAME*(*),ACCOUNT*(*)o - - EQUIVALENCE (INPUT(UAF$L_UIC+1:),USER2) - EQUIVALENCE (INPUT(UAF$L_UIC+3:),GROUP2)' - EQUIVALENCE (INPUT(UAF$L_FLAGS+1:),FLAGS2)T - 2 - INTEGER*2 USER2,GROUP2L - N - CALL OPEN_FILE_SHARED(8) - t - READ (8,KEY=USERNAME,IOSTAT=IER) INPUT - ! Move pointer to top of fileG - a - CALL CLOSE_FILE(8)O - I - IF (IER.EQ.0) THEN, - FLAGS = FLAGS2 - IER = 1S - USER = USER2 - GROUP = GROUP2 - ACCOUNT = INPUT(UAF$L_ACCOUNT:UAF$L_ACCOUNT+7) - END IFR - R - RETURN - END - t - S - O - SUBROUTINE DCLEXH(EXIT_ROUTINE) - R - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4)C - S - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1l - EXBLK(4) = %LOC(EXBLK(4)) - A - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN- - END - u - - c - k - SUBROUTINE FULL_DIR(INDEX_COUNT) -Cu -C Add INDEX command to BULLETIN, display directories of ALL -C folders. Added per request of a faculty member for his private -C board. Changes to BULLETIN.FOR should be fairly obvious. -C -C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2)C -C - IMPLICIT INTEGER (A-Z)i - w - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC'R - INCLUDE 'BULLUSER.INC'A - L - COMMON /POINT/ BULL_POINT - S - DATA FOLDER_Q1/0/ - U - BULL_POINT = 0E - $ - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THENA - INDEX_COUNT = 2_ - DIR_COUNT = 0U - END IFI - - IF (INDEX_COUNT.EQ.1) THENa - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM)L - , - FOLDER_Q = FOLDER_Q1_ - CALL OPEN_FILE_SHARED(7) ! Get folder fileT - T - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from filei - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN_ - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IFA - END DOo - h - CALL CLOSE_FILE(7) ! We don't need file anymoreq - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - WRITE (6,1000) - WRITE (6,1020)T - DO J = 1,NUM_FOLDERSS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - WRITE (6,1030) - & FOLDER1(:15),F1_NBULL,FOLDER1_DESCRIP(:61) - END DO - WRITE (6,1060)) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - IF (DIR_COUNT.EQ.0) THEN - F1_NBULL = 0C - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THENl - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0C - END IF - END DOA - T - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0_ - RETURN - END IFH - END IF - , - CALL DIRECTORY(DIR_COUNT)) - G - IF (DIR_COUNT.GT.0) RETURN - = - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040)T - ELSE - INDEX_COUNT = 0 - END IF - END IF - L - RETURNA - V -1000 FORMAT (' The following folders are present'/)I -1020 FORMAT (' Name Count Description'/)D -1030 FORMAT (1X,A15,I3,1X,A) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') - - END - C diff --git a/decus/vax88a3/bulletin/bulletin6.for b/decus/vax88a3/bulletin/bulletin6.for deleted file mode 100644 index e51f171..0000000 --- a/decus/vax88a3/bulletin/bulletin6.for +++ /dev/null @@ -1,1385 +0,0 @@ -From: KBSVAX::KANE "Joseph Kane" 1-APR-1988 08:29 -To: everhart@arisia.DECNET -Subj: forwarded mail from steinmetz - -From uunet!rutgers.edu!Postmaster Thu Mar 31 22:10:55 1988 -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA12154; Thu, 31 Mar 88 22:10:25 est -Received: from RUTGERS.EDU by uunet.UU.NET (5.54/1.14) - id AA07548; Thu, 31 Mar 88 21:50:38 EST -Received: by rutgers.edu (5.54/1.15) - id AB05331; Thu, 31 Mar 88 21:50:59 EST -Date: Thu, 31 Mar 88 21:50:59 EST -From: uunet!rutgers.edu!Postmaster (Mail Delivery Subsystem) -Subject: Returned mail: Host unknown -Message-Id: <8804010250.AB05331@rutgers.edu> -To: -Status: R - - ----- Transcript of session follows ----- -550 ... Host unknown - - ----- Unsent message follows ----- -Received: by rutgers.edu (5.54/1.15) - id AA04731; Thu, 31 Mar 88 19:56:32 EST -Received: from steinmetz.UUCP by uunet.UU.NET (5.54/1.14) with UUCP - id AA27205; Thu, 31 Mar 88 19:51:49 EST -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA10010; Thu, 31 Mar 88 19:34:25 est -Date: 31 Mar 88 10:16:57 EST -From: steinmetz!MAILER-DAEMON@uunet.uu.net (Mail Delivery Subsystem) -Subject: Returned mail: User unknown -Message-Id: <8804010034.AA10010@kbsvax.steinmetz> -To: MRL@pfc-vax.mit.edu - - ----- Transcript of session follows ----- -mail11: %MAIL-E-SYNTAX, error parsing 'CRD' -550 crd.ge.com!EVERHART%ARISIA.DECNET... User unknown - - ----- Unsent message follows ----- -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA09993; Thu, 31 Mar 88 19:34:25 est -Received: by ge-dab.GE.COM (smail2.5) - id AA14447; 31 Mar 88 18:51:20 EST (Thu) -Received: by ge-rtp.GE.COM (smail2.5) - id AA05829; 31 Mar 88 15:26:29 EST (Thu) -Received: by mcnc.mcnc.org (5.54/MCNC/10-20-87) - id AA20697; Thu, 31 Mar 88 14:42:41 EST -From: -Received: by rutgers.edu (5.54/1.15) - id AA20468; Thu, 31 Mar 88 10:47:59 EST -Message-Id: <8803311547.AA20468@rutgers.edu> -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 31 Mar 88 10:18-EST -Date: 31 Mar 88 10:16:57 EST -To: crd.ge.com!xx!EVERHART@ARISIA.DECNET -Subject: BULLETIN6.FOR - -C -C BULLETIN6.FOR, Version 3/1/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_FILE(4) - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE '($HLPDEF)' - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P) - & ,LIBRARY,HLP$M_HELP.OR.HLP$M_PROMPT,LIB$GET_INPUT) - - RETURN - END - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE CLOSE_FILE(INPUT) -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C -C INPUT: -C INPUT - Unit number of file to close out. -C 1 = BULLETIN.DAT -C 2 = BULLDIR.DAT -C 4 = BULLUSER.DAT -C 7 = BULLFOLDER.DAT -C 8 = SYS$SYSTEM:SYSUAF.DAT -C - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT) - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE(INPUT) - - IMPLICIT INTEGER (A-Z) - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT,STATUS='DELETE') - - RETURN - END - - - SUBROUTINE OPEN_FILE(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLDIR_ERR,BULLETIN_ERR,BULLUSER_ERR,BULLFOLDER_ERR - EXTERNAL BULLINF_ERR - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2) - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - 1 - IER = 0 - 8 - IF (TIMEEFN.EQ.0) CALL LIB$GET_EF(TIMEEFN)e - e - CALL DISABLE_CTRL ! No breaks while file is open - v - IF (INPUT.EQ.2.AND..NOT.REMOTE_SET) THEN1 - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,%VAL(4))t - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))5 - & //'.BULLDIR',STATUS='OLD',IOSTAT=IER, - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP') - M - IF (IER.EQ.FOR$IOS_FILNOTFOU) THENT - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',- - & RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',) - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & FORM='FORMATTED',IOSTAT=IER2) - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THENu - CLOSE (UNIT=2)e - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop@ - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_BULLFILESp - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR, - & %VAL(4))c - END IF - END IFU - END DO - END IF- - - - IF (INPUT.EQ.1.AND..NOT.REMOTE_SET) THENb - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,%VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))S - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THENn - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_BULLFILE1 - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR, - & %VAL(4))s - END IF8 - END DO - END IFM - 8 - IF (INPUT.EQ.4) THEN. - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR,%VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4,r - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THENC - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN',C - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM,O - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR.O - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_USERFILE_ - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR, - & %VAL(4))r - END IFs - END DO - END IFT - W - IF (INPUT.EQ.7) THEN, - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLFOLDER_ERR, - & %VAL(4))I - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER))E - IF (IER.EQ.FOR$IOS_FILNOTFOU) THENR - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM'R - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2,P - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIPB - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0 ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loopi - END IFr - END DO - END IFP - F - IF (INPUT.EQ.9) THENS - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLINF_ERR,%VAL(4))S - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN',R - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))O - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_INFFILE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLINF_ERR,M - & %VAL(4)) - END IF - END DO - END IFT - P - IF (IER.NE.0) THENN - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)G - CALL SYS_GETMSG(IER1)f - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXITS - END IF - - IER = SYS$CANTIM(%VAL(4),) ! Successful, so cancel timer.e - t - RETURN - END - s - SUBROUTINE TIMER_ERR. - - IMPLICIT INTEGER (A-Z)t - s - ENTRY BULLDIR_ERR - WRITE(6,'('' ERROR: Unable to open directory file after 30 secs.'')') - GO TO 10I - S - ENTRY BULLETIN_ERRi - WRITE(6,'('' ERROR: Unable to open message file after 30 secs.'')') - GO TO 10e - d - ENTRY BULLUSER_ERR - WRITE(6,'('' ERROR: Unable to open BULLUSER.DAT after 30 secs.'')') - GO TO 10 - - ENTRY BULLFOLDER_ERR - WRITE(6,'('' ERROR: Unable to open BULLFOLDER.DAT after 30 secs.'')') - GO TO 10T - C - ENTRY BULLINF_ERR - WRITE(6,'('' ERROR: Unable to open BULLINF.DAT after 30 secs.'')')M - GO TO 10I - U -10 CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - E - E - ) - SUBROUTINE OPEN_FILE_SHARED(INPUT)U - T - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)'. - H - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - I - INCLUDE 'BULLUSER.INC'E - ( - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - $ - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - / - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT - M - PARAMETER TIMEOUT = -10*1000*1000*30A - DIMENSION TIMEBUF(2)I - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - L - CHARACTER*25 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - R - IER = 0 - _ - IF (TIMEEFN.EQ.0) CALL LIB$GET_EF(TIMEEFN) - T - CALL DISABLE_CTRL - I - IF (INPUT.EQ.2.AND..NOT.REMOTE_SET) THEN= - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',T - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & SHARED,IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0Z - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL')T - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE)o - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THENL - CLOSE (UNIT=2). - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loopC - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_BULLFILES - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4))R - END IF - END IFA - END DO - END IFR - R - IF (INPUT.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_POINT - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCKR - SAVE_FOLDER = FOLDERO - CALL GET_REMOTE_MESSAGE(IER)T - IER = 0 - END IF - ELSE IF (INPUT.EQ.1.AND..NOT.REMOTE_SET) THEN - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4))I - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))e - & //'.BULLFIL',STATUS='OLD',l - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN, - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_BULLFILET - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - END IFE - END DO - END IFT - T - IF (INPUT.EQ.4) THENF - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_USERFILE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4))o - END IF - END DO - END IFA - ) - IF (INPUT.EQ.7) THENV - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',R - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - F - IF (IER.EQ.0) THENF - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE)N - IF (ASK_SIZE.NE.FOLDER_RECORD/4) THENR - CLOSE (UNIT=7)E - IDUMMY = FILE_LOCK(IER,IER1) - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_BULLFOLDER - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4))B - END IF - END IFE - END DO - END IFM - F - IF (INPUT.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC)F - END DO - END IFO - 4 - IF (INPUT.EQ.9) THENA - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,%VAL(4)) - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',E - & RECORDSIZE=FOLDER_MAX*2+3,F - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - IER = SYS$CANTIM(%VAL(4),) - CALL CONVERT_INFFILE - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(4)) - END IF - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.INPUT.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - CALL OPEN_FILE(INPUT)I - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1)R - CALL ENABLE_CTRL_EXIT - END IFI - I - IER = SYS$CANTIM(%VAL(4),) ! Successful, so cancel timer.2 - N - RETURN - END - I - E - O - O - SUBROUTINE CONVERT_BULLFILESE -C= -C SUBROUTINE CONVERT_BULLFILES= -CY -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - A - IMPLICIT INTEGER (A-Z)' - E - INCLUDE 'BULLDIR.INC' - S - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - I - CHARACTER*81 INPUTE - P - WRITE (6,'('' Converting data files to new format. Please wait.'')')M - O - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))E - & //'.BULLDIR',STATUS='OLD',R - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',_ - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - I - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD',E - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)R - R - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - O - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)N - H - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))k - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',' - & RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',S - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & IOSTAT=IER) - E - NEWEST_EXTIME = '00:00:00'( - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME, - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIMED - NEMPTY = 0E - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - i - EXTIME = '00:00:00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCKY - IF (IER.EQ.0) THEN - READ(10,'(A)') INPUTU - WRITE(1,'(A)') INPUT(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT - END DOG - CALL WRITEDIR(ICOUNT-1,IER1)I - ICOUNT = ICOUNT + 1 - END IF - END DO - s - CLOSE (UNIT=9)O - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - e - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionU - RETURNP - I -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)E -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - U - END - O - SUBROUTINE CONVERT_BULLFILE -CR -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -CE -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - T - IMPLICIT INTEGER (A-Z)I - F - INCLUDE 'BULLDIR.INC' - E - INCLUDE 'BULLFOLDER.INC'- - - INCLUDE 'BULLFILES.INC' - N - CHARACTER*80 INPUT,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_FILE(2)( - E - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)% - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)I - , - CALL OPEN_FILE(7) - ( -100 READ (7,FMT=FOLDER_FMT,ERR=200)D - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER))Z - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL'B - & ,STATUS='OLD',N - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - I - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))N - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,) - & FORM='UNFORMATTED')I - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE)( - R - CALL OPEN_FILE(2) - E - CALL READDIR(0,IER) - I - IF (IER.EQ.1) THEN. - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1H - SBLOCK = NBLOCK_ - DO J=BLOCK,LENGTH+BLOCK-1P - READ(10'J,'(A)') INPUT - ILEN = TRIM(INPUT) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,INPUT,NBLOCK)L - END DO - CALL FLUSH_BULL(NBLOCK)0 - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - F - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF) - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_FILE(2)L - GOTO 100T - ( -200 CALL OPEN_FILE_SHARED(2) - B - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection= - X - RETURND - E - END - - - - SUBROUTINE CONVERT_BULLFOLDER -CE -C SUBROUTINE CONVERT_BULLFOLDER -C) -C FUNCTION: Converts bulletin folder file to new format.n -Cu - IMPLICIT INTEGER (A-Z) - Y - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - ) - INCLUDE '($SSDEF)'E - , - CHARACTER*80 NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')')Y - E - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT), - - EODIR = MAX(INDEX(BULLFOLDER_FILE,':'),INDEX(BULLFOLDER_FILE,']'))I - SUFFIX = INDEX(BULLFOLDER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLFOLDER_FILE(:SUFFIX)//'OLD', - IER = LIB$RENAME_FILE(BULLFOLDER_FILE,NEW_FILE) - , - DO WHILE (FILE_LOCK(IER,IER1))) - OPEN (UNIT=7,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',Y - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO% - ( - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - T - OPEN (UNIT=9,FILE=BULLFOLDER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE')S - E - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - F_NUMBER = 0. - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)C - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP1 - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER))E - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0)S - END IFD - CALL OPEN_FILE_SHARED(2) - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THENE - IF (NBULL.GT.0) THEN% - CALL READDIR(NBULL,IER)L - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IFA - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)= - WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB_ - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0 - CALL CLOSE_FILE(2)) - F_NUMBER = F_NUMBER + 1 - END IF - END DOE - R - CLOSE (UNIT=7)M - CLOSE (UNIT=9,STATUS='SAVE') - % - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionO - O - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - O - RETURN - END - _ - SUBROUTINE CONVERT_USERFILE -CR -C SUBROUTINE CONVERT_USERFILE -Cr -C FUNCTION: Converts user file to new format which has 8 bytes added. -C, - ) - IMPLICIT INTEGER (A-Z)) - L - INCLUDE 'BULLFILES.INC' - A - INCLUDE 'BULLUSER.INC' - L - CHARACTER BUFFER*74,NEW_FILE*80 - R - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - D - WRITE (6,'('' Converting data files to new format. Please wait.'')')V - _ - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))t - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'e - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - c - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',A - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER))n - INQUIRE (UNIT=9,RECORDSIZE=RECL)w - . - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLFOLDER.INC.'')')S - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')' - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)E - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF= - F - IF (IER.EQ.0) THENM - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',D - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IFO - - IF (IER.NE.0) THENI - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)S - CALL SYS_GETMSG(IER1)D - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXITO - END IF) - - DO I=1,FLONG' - NEW_FLAG(I) = 'FFFFFFFF'X& - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0= - SET_FLAG(I) = 0 - END DOZ - O - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR.S - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0E - DO WHILE (IER.EQ.0)E - READ (9,'(A)',IOSTAT=IER) BUFFERN - IF (IER.EQ.0) THENT - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23)0 - LOGIN_TIME = BUFFER(24:31). - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1))) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,t - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF0 - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flagU - DO WHILE (IER.EQ.0), - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,Y - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN0 - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IFE - I - IER = 0 - ( - CLOSE (UNIT=9)) - CLOSE (UNIT=4)R - R - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionL - L - RETURNE - END - 0 - L - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -CB -C SUBROUTINE READDIR' -C' -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.U -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS:S -C ICOUNT - The last record read by this routine. -C - M - IMPLICIT INTEGER (A - Z)B - N - INCLUDE 'BULLDIR.INC' - F - INCLUDE 'BULLFOLDER.INC'U - I - COMMON /PROMPT/ COMMAND_PROMPTF - CHARACTER*39 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - U - CHARACTER*2 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - B - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THENR - DO WHILE (REC_LOCK(IER))E - READ (2'1,IOSTAT=IER) BULLDIR_HEADER1 - END DOT - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,0 - IF (IER.EQ.0) THENL - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - END IF - IF (IER.GT.0) THEN( - CALL ERROR_AND_EXIT - ELSE) - RETURNN - END IFL - END IF - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_FILE(2)E - CALL OPEN_FILE(2) - CALL CLEANUP_DIRFILE(1) - END IFT - IF (NEMPTY.EQ.' ') NEMPTY = 0C -Ce -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also checkE -C to see if cleanup was in progress but didn't properly finish. -CE - IF (NEMPTY.GT.200.AND..NOT.TEST_BULLCP()) THENt - WRITE (CFOLDER_NUMBER,'(I2)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX(I - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IFW - END IF - ELSEL - IF (.NOT.REMOTE_SET) THENP - DO WHILE (REC_LOCK(IER))O - READ(2'ICOUNT+1,IOSTAT=IER) BULLDIR_ENTRY' - END DO - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - IF (IER.EQ.0) THEN: - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF? - IF (IER.GT.0) THENL - CALL ERROR_AND_EXIT - ELSE - RETURN= - END IFY - END IF - END IF - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - UNLOCK 2F - A - RETURNA - A - END - E - ' - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -CA -C SUBROUTINE WRITEDIR -C= -C FUNCTION: Writes the entry for the specified bulletin in the? -C directory file.. -CD -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1., -C If 0, write the header of the directory file. -C OUTPUTS:N -C IER - Error status from WRITE. -C - & - IMPLICIT INTEGER (A - Z)X - E - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - I - IF (BULLETIN_NUM.EQ.0) THEN - WRITE (2'1,IOSTAT=IER) BULLDIR_HEADER= - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - END IF - ELSEL - WRITE (2'BULLETIN_NUM+1,IOSTAT=IER) BULLDIR_ENTRYI - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRYD - END IF - END IFL - H - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXITW - _ - RETURN5 - V - END - T - E - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -CR -C SUBROUTINE READACL -CE -C FUNCTION: Reads the ACL of a file.W -CE -C PARAMETERS: -C FILENAME - Name of file to check.Y -C ACLENT - String which will be large enough to hold ACL information., -C= - IMPLICIT INTEGER (A-Z) - & - INCLUDE '($ACLDEF)' - F - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*), - CHARACTER NOT_ID*3, - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - T - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)t - f - DO ACCESS_TYPE=1,2 - POINT = 1L - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)& - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - IF ((ACCESS_TYPE.EQ.1.AND.INDEX(ACLSTR,'WRITE').GT.0).OR.n - & (ACCESS_TYPE.EQ.2.AND.INDEX(ACLSTR,'READ)').GT.0)) THENI - START_ID = INDEX(ACLSTR,'=') + 1. - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - DO WHILEN - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0)t - START_ID = START_ID - 1V - END DOR - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN. - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IFF - END IF - IF (OUTLEN.EQ.0) THEN - IF (ACCESS_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(Q - & '' These users can only read this folder:'')') - END IF - OUTLEN = 1: - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN. - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)c - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)E - OUTLEN = 1 - ELSEC - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IFF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)I - END DOE - I - RETURN, - END - - K - ( - 2 - SUBROUTINE CONVERT_INFFILEI - I - IMPLICIT INTEGER (A-Z) - ' - INCLUDE 'BULLUSER.INC'i - ' - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - F - RECL = RECL/8 - E - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))E - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)E - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX)U - END DO1 - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9)= - F - RETURN) - END - - - SUBROUTINE ERROR_AND_EXIT - B - IMPLICIT INTEGER (A-Z)) - T - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)A - CALL ENABLE_CTRL_EXIT - 5 - RETURNF - END - - diff --git a/decus/vax88a3/bulletin/bulletin7.for b/decus/vax88a3/bulletin/bulletin7.for deleted file mode 100644 index c43e9ac..0000000 --- a/decus/vax88a3/bulletin/bulletin7.for +++ /dev/null @@ -1,1513 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU@SMTP 16-MAY-1988 14:57 -To: ARISIA::EVERHART -Subj: BULLETIN7.FOR - - -Received: from PFC-VAX.MIT.EDU by MC.LCS.MIT.EDU via Chaosnet; 16 MAY 88 14:24:48 EDT -Date: 16 May 88 14:23:00 EDT -From: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@MC, MHG@MITRE-BEDFORD.ARPA@MC, - EVERHART%ARISIA.DECNET@CRD.GE.COM@MC, GAYMAN@ARI-HQ1.ARPA@MC, - BACH@RADC-SOFTVAX@MC -Subject: BULLETIN7.FOR - -C -C BULLETIN7.FOR, Version 4/27/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - INCLUDE '($SSDEF)' - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - CHARACTER OUTPUT*160,TERMINAL*8 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_FILE_SHARED(4) - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_FILE(4) - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -C -C Set flags in all user entries that have SET READNEW on the particular -C folder to indicate that a new bulletin is present for the particular folder. -C Also send broadcast if notify flag set. -C - OUTPUT = BELL//CR//LF//LF//'New bulletin added to folder '// - & FOLDER(1:TRIM(FOLDER))//'. From: '//FROM(1:TRIM(FROM))// - & CR//LF//'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IF (ADD_BULL) THEN - IF (FOLDER_NUMBER.GT.0) THEN - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - END IF - - IF (ADD_BULL) THEN - IER = 1 - DO WHILE (GETUSERS(TEMP_USER,TERMINAL)) - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TERMINAL(:TRIM(TERMINAL)),%VAL(BRK$C_DEVICE),,,,,,,) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - END DO - END IF - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_FILE(4) - - RETURN - - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(1:11) - NEWEST_TIME = TODAY_TIME(13:20) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:20) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*3600 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2001 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1)V - BTIM(2) = TEMP(2)T - END IFC - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalidL - BTIM(1) = TEMP(1)- - BTIM(2) = TEMP(2) - END IFA - - RETURNT - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2)O -CA -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future.s -Co -C INPUTS: -C TIME1 - First time (hh:mm:ss) -C TIME2 - Second timeA -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*8 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:20)E - ELSED - TEMP2 = TIME2$ - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1)))* - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - RETURNi - END - -C------------------------------------------------------------------------- -Cl -C The following are subroutines to create a linked-list queue for e -C temporary buffer storage of data that is read from files to bet -C outputted to the terminal. This is done so as to be able to closet -C the file as soon as possible. -Ce -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains( -C the address. The address is simply the address of the 3rd word ofF -C the record. The last word in the record contains the address of theT -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. t -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -Ce -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA): - CHARACTER*(*) DATAS - IF (HEADER.NE.0) RETURN ! Queue already initializedT - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURNE - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA)L - INTEGER RECORD(1) - CHARACTER*(*) DATAE - LENGTH = RECORD(1)L - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD)))S - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4)U - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURNO - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATAI - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA)S - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4)E - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHART - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN)D - IMPLICIT INTEGER (A-Z)M - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LENg - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0A - RETURNR - END - - - - SUBROUTINE DISABLE_PRIVSL -CL -C SUBROUTINE DISABLE_PRIVSE -C -C FUNCTION: Disable image high privileges.B -CT - - IMPLICIT INTEGER (A-Z)T - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privilegesE - - SETPRV(1) = SETPRV(1).AND..NOT.PROCPRIV(1)* - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN) - END - - - - SUBROUTINE ENABLE_PRIVS -C( -C SUBROUTINE ENABLE_PRIVS -CN -C FUNCTION: Enable image high privileges. -C( - - IMPLICIT INTEGER (A-Z)E - - COMMON /PRIVS/ SETPRV - DIMENSION SETPRV(2) - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs) - - RETURN, - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -CS -C SUBROUTINE CHECK_PRIV_IOL -C, -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -CR - - IMPLICIT INTEGER (A-Z)T - - CALL DISABLE_PRIVS ! Disable SYSPRV ( - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE')E - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1I - ELSE( - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IFL - - CALL ENABLE_PRIVS ! Enable SYSPRV L - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')T - - RETURN_ - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG)I -CN -C SUBROUTINE CHANGE_FLAGT -C -C FUNCTION: Sets flags for specified folder. -CB -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. D -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -CA - IMPLICIT INTEGER (A - Z)I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'M - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4)= - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))1 - - LOGICAL CMD - - CHARACTER*23 TODAYK - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./U - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1)L - IF (IER) THENE - FOLDER_NUMBER_SAVE = FOLDER_NUMBERR - CALL OPEN_FILE_SHARED(7) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_FILE(7) - IF (IER.NE.0) THENm - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - END IFe - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF1 - -Ci -C Find user entry in BULLUSER.DAT to update information. -Cf - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_FILE_SHARED(4) ! Open user fileN - - READ_BTIM_SAVE(1) = READ_BTIM(1)L - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry. - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS$ASCTIM(,TODAY,,) - CALL SYS_BINTIM(TODAY,LOGIN_BTIM)O - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entryb - CALL READ_USER_FILE_HEADER(IER)E - IF (CMD) THENI - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)E - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)_ - END IF - NEW_FLAG(1) = 143- - NEW_FLAG(2) = 0R - CALL WRITE_USER_FILE_NEW(IER)N - ELSEO - IF (CMD) THENT - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)I - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143e - REWRITE (4,IOSTAT=IER) USER_ENTRYI - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IFa - - CALL CLOSE_FILE (4) - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN- - - END - - - - - SUBROUTINE SET_VERSIONG -CU -C SUBROUTINE SET_VERSIONI -CM -C FUNCTION: Sets version number.D -C( - IMPLICIT INTEGER (A - Z)c - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'w - - DIMENSION FLAGS(FLONG,4)e - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))$ - - LOGICAL CMD - - CHARACTER*23 TODAY - DIMENSION READ_BTIM_SAVE(2) - -C, -C Find user entry in BULLUSER.DAT to update information.A -CS - - CALL OPEN_FILE_SHARED(4) ! Open user file( - - READ_BTIM_SAVE(1) = READ_BTIM(1)A - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entryD - - IF (IER.EQ.0) THEN) - NEW_FLAG(1) = 1435 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IFT - - CALL CLOSE_FILE (4) - RETURN5 - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -C -C SUBROUTINE CONFIRM_PRIV -Cn -C FUNCTION: Confirms that given username has SETPRV. -CD -C INPUTS: -C USERNAME - UsernameR -C OUTPUTS:P -C ALLOW - Returns 1 if account has SETPRV.E -C returns 0 if account has no SETPRV. -Cf - - IMPLICIT INTEGER (A-Z)I - - CHARACTER*(*) USERNAMEi - - INCLUDE '($PRVDEF)' - - PARAMETER UAF$Q_DEF_PRIV = '1A4'X - - LOGICAL*1 UAF(0:583)s - EQUIVALENCE (UAF(UAF$Q_DEF_PRIV),UAF_DEF_PRIV)t - - CALL OPEN_FILE_SHARED(8)g - ALLOW = 0 ! Set return falseZ - READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Record - IF (STATUS.EQ.0) THEN ! If username found - IF (BTEST(UAF_DEF_PRIV,PRV$V_SETPRV).OR. ! SETPRV or CMRKNLE - & BTEST(UAF_DEF_PRIV,PRV$V_CMKRNL)) THEN ! privileges? - ALLOW = 1 ! Yep - END IF - END IF - CALL CLOSE_FILE(8)E - RETURN ! Return) - END ! End - - - - - - SUBROUTINE CHECK_DISMAIL(USERNAME,DISMAIL) -C -C SUBROUTINE CHECK_DISMAIL- -CA -C FUNCTION: Checks that given username has DISMAIL. -C- -C INPUTS: -C USERNAME - Username -C OUTPUTS:I -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C- - - IMPLICIT INTEGER (A-Z)T - - CHARACTER*(*) USERNAMEs - - PARAMETER UAF$V_DISMAIL = '7'Xe - PARAMETER UAF$L_FLAGS = '1D4'Xd - - LOGICAL*1 UAF(0:583)e - EQUIVALENCE (UAF(UAF$L_FLAGS),UAF_L_FLAGS) - - CALL OPEN_FILE_SHARED(8)l - DISMAIL = 0 ! Set return false. - READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF ! Read Recordt - IF (STATUS.EQ.0) THEN ! If username foundg - IF (BTEST(UAF_L_FLAGS,UAF$V_DISMAIL)) THEN ! DISMAIL SET?o - DISMAIL = 1 ! Yep - END IF - END IFt - CALL CLOSE_FILE(8)e - RETURN ! Returns - END ! Endo - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUTe - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - - RETURN- - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1)- - - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./E - - IF (INIT) THENu - FILE_LOCK = 1i - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1), - IF (IER1.EQ.RMS$_FLK) THENE - FILE_LOCK = 1H - CALL WAIT_SEC('01') - ELSEE - FILE_LOCK = 0_ - INIT = .TRUE. - END IF( - ELSE - FILE_LOCK = 0 - IER1 = 0C - INIT = .TRUE. - END IF - END IF) - - RETURND - END - - - - SUBROUTINE ENABLE_CTRL- - - IMPLICIT INTEGER (A-Z)O - - COMMON /CTRLY/ CTRLYN - - COMMON /CTRL_LEVEL/ LEVEL - - QUIT = 12 - - ENTRY ENABLE_CTRL_EXITL - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1D - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN) - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -CD - END IF) - - IF (QUIT.EQ.0) THEN - CALL UPDATE_USERINFO - CALL EXITO - END IFE - QUIT = 0 ! Reinitialize - - RETURNC - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z)B - - COMMON /CTRLY/ CTRLYC - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/D - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN( - END - - - - - SUBROUTINE CLEANUP_BULLFILE -CO -C SUBROUTINE CLEANUP_BULLFILE -CT -C FUNCTION: Searches for empty space in bulletin file and deletes it. -CI - IMPLICIT INTEGER (A - Z)I - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'I - - CHARACTER FILENAME*132,INPUT*128L - - CALL OPEN_FILE_SHARED(2)) - -Ct -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C! - - DO WHILE (REC_LOCK(IER))R - READ (2'1,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_FILE(2) - RETURN - ELSE IF (NEMPTY.GT.0) THENM - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER)C - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) INPUT - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100L - END IFE - WRITE(11) INPUT - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_FILE(1)R - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',e - & '*.BULLFIL') - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR',o - & '*.BULLDIR') - CALL CLOSE_FILE_DELETE(2) - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IFM - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR',L - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',R - 1 ORGANIZATION='RELATIVE',FORM='FORMATTED', - 1 INITIALSIZE=(((NBULL+1)*115)/512)+1 ) - - NEMPTY = 0 - WRITE (12'1,'(A)',IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULLm - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - WRITE (12'I+1,'(A)',IOSTAT=IER) BULLDIR_ENTRYN - NBLOCK = NBLOCK + LENGTH - END DOR - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_FILE(2)e - CALL OPEN_FILE(2) ! Open with no sharingC - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2'1,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_FILE_DELETE(2) - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*',_ - & '*.*;1') - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)L -C1 -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions.E -C Is called either directly after a deletion, or isE -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z)S - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL)C - CALL READDIR(I,IER)I - IF (IER.NE.I+1) THEN ! Have we found a deleted entry?U - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)e - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO) - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN1 - END IFE - LENGTH = -LENGTH ! Indicate starting point by writingE - CALL WRITEDIR(I,IER) ! next entry into deleted entryS - FIRST_DELETE = I ! with negative length5 - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progressi - J = I ! Try to find where entry came from - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - BLOCK_SAVE = BLOCKM - K = J + 1 ! Search for duplicate entries - DO WHILE (MOVE_FROM.EQ.0.AND.K.LE.NBULL) - CALL READDIR(K,IER)_ - IF (IER.EQ.K+1) THEN - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO=J+1 - MOVE_FROM=K+1 - ELSEU - K = K + 1 - END IFU - END IF - END DOn - J = J + 1 ! If no duplicate entry found for this - CALL READDIR(J,IER) ! entry, see if one exists for anyV - END DO ! of the other entries - END IF - I = I + 1 - END DOI - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessaryn - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER)- - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1I - END IF - END DOc - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of fileI - DELETE(UNIT=2,REC=J+1,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - CALL READDIR(FIRST_DELETE,IER) - LENGTH = -LENGTH ! Fix entry which has negative lengthP - CALL WRITEDIR(FIRST_DELETE,IER)! - END IFr - - CALL WRITEDIR(0,IER)E - - RETURNT - END - - - SUBROUTINE SHOW_FLAGS -CA -C SUBROUTINE SHOW_FLAGS -Cm -C FUNCTION: Show user flags.L -C, - IMPLICIT INTEGER (A - Z)A - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC' - -CR -C Find user entry in BULLUSER.DAT to obtain flags.N -CO - - CALL OPEN_FILE_SHARED(4) ! Open user file - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry$ - - WRITE (6,'('' For the selected folder '',A)') FOLDER(1:TRIM(FOLDER))T - T - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - END IFs - - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND.E - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (.NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THENI - WRITE (6,'('' No flags are set.'')') - END IFI - - CALL CLOSE_FILE(4)L - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z)R - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1))R - - RETURNV - END - - - SUBROUTINE CLR2(FLAG,NUMBER)I - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN' - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z)N - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))U - - RETURNN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL)R -CR -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in.L -C - - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) USERNAME,TERMINAL - - DATA WILDCARD /-1/L - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listO - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,)L - ! Get next process. - END DOC - - IF (.NOT.IER) WILDCARD = -1 - - GETUSERS = IERD - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFOc -Ca -C SUBROUTINE OPEN_USERINFOE -CN -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C_ - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC'T - - COMMON /USERINFO/ USERINFO_READ - DATA USERINFO_READ /.FALSE./3 - - CALL OPEN_FILE_SHARED(9)A - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX)p - - IF (IER.NE.0) THENB - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2)s - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_FILE(4) - IF (IER.EQ.0) THENA - DO I=1,FOLDER_MAX_ - LAST_READ_BTIM(1,I) = READ_BTIM(1)E - LAST_READ_BTIM(2,I) = READ_BTIM(2)e - END DO - END IF - END IF - IF (IER.EQ.0) WRITE (9) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX)O - END IF) - - CALL CLOSE_FILE(9) - - USERINFO_READ = .TRUE.E - - RETURNE - END - - - - SUBROUTINE UPDATE_USERINFO( -CI -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -CO - IMPLICIT INTEGER (A - Z) - - COMMON /USERINFO/ USERINFO_READ - - INCLUDE 'BULLUSER.INC'1 - - IF (.NOT.USERINFO_READ) RETURNE - - CALL OPEN_FILE_SHARED(9)1 - - READ (9,KEY=USERNAME,IOSTAT=IER)F - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,1 - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX)H - - CALL CLOSE_FILE(9) - - RETURNN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM)= - - IMPLICIT INTEGER (A-Z)I - - INTEGER BTIM(2) - - CHARACTER*(*) TIME1 - - IF (TRIM(TIME).EQ.20) THEN_ - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM) - ELSEE - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IF' - - RETURNC - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -Ch -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -Ci -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have beenh -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit.F -CE - - IMPLICIT INTEGER (A-Z)/ - - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLUSER.INC'T - - COMMON /READIT/ READITE - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHS - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)r - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATEe - - DIMENSION LOGIN_BTIM_SAVE(2)l - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1)s - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)t - CALL UPDATE_READ ! Update login time - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN' - END IFN - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - FOLDER_Q = FOLDER_Q1g - - CALL OPEN_FILE_SHARED(7) ! Go find folders - - DO FOLDER_NUMBER = 0,FOLDER_MAX - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flagh - IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND.. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.( - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSIONJ - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.C - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN_ - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (IER.NE.0) THENm - CALL CHANGE_FLAG_NOCMD(0,2) - CALL CHANGE_FLAG_NOCMD(0,3) - CALL CHANGE_FLAG_NOCMD(0,4) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THENC - FOLDER_FLAG = 0e - CALL MODIFY_SYSTEM_LIST - END IFD - ELSE IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM)N - ELSEe - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)I - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IFK - END IFr - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END DO1 - - CALL CLOSE_FILE(7) - - FOLDER_Q = FOLDER_Q1J - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - DO FOLDER_NUMBER = 1,FOLDER_MAXT - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),o - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - CALL SET2(NEW_MSG,FOLDER_NUMBER) - END IFN - END IFS - END DO - FOLDER_NUMBER = 0O - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THENS - WRITE(6,'('' Type READ to read new general messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins) - ELSEn - BULL_POINT = 0r - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)T - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)Y - CALL CLR2(NEW_MSG,FOLDER_NUMBER) - END IFD - END IF - ELSE ! READNEW mode. - DO FOLDER_NUMBER = 0,FOLDER_MAX - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN( - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)L - CALL CLR2(NEW_MSG,FOLDER_NUMBER)6 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM)B - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)E - END IFO - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN= - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.R - & TEST2(SET_FLAG,FOLDER_NUMBER)) THENI - IF (FOLDER_NUMBER.GT.0) THEN - WRITE (6,'('' There are new messages in folder '',R - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE IF (FOLDER_NUMBER.EQ.0.OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THENF - SAVE_BULL_POINT = BULL_POINTF - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORYO - BULL_POINT = SAVE_BULL_POINTt - END DO - END IF - END IF - END IF' - ELSE ! Can't select the folder - CALL CHANGE_FLAG_NOCMD(0,2) ! then clear SET_FLAGn - CALL CHANGE_FLAG_NOCMD(0,3)t - END IFO - END IFT - END DO - CALL EXITR - END IF( - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTEL - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLFOLDER.INC'd - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = -1H - FOLDER1 = 'GENERAL' - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to GENERAL folder.'')') - - RETURNt - END - diff --git a/decus/vax88a3/bulletin/bulletin7bugbug.txt b/decus/vax88a3/bulletin/bulletin7bugbug.txt deleted file mode 100644 index b7f2772..0000000 --- a/decus/vax88a3/bulletin/bulletin7bugbug.txt +++ /dev/null @@ -1,19 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU@SMTP 25-MAY-1988 15:43 -To: ARISIA::EVERHART -Subj: BULLETIN - - -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 25 May 88 14:59-EDT -Date: 25 May 88 14:59:09 EDT -From: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@XX, MHG@MITRE-BEDFORD.ARPA@XX, - EVERHART%ARISIA.DECNET@CRD.GE.COM@XX, GAYMAN@ARI-HQ1.ARPA@XX, - BACH@RADC-SOFTVAX@XX -Subject: BULLETIN - -Apparently, there is another small bug in BULLETIN7.FOR which has been there -for a while which didn't cause any problems until I modified the cleanup -algorithm. There are 2 lines in the subroutine NEW_MESSAGE_NOTIFICATION which -contain the string "0,FOLDER_MAX" which should be changed to "0,FOLDER_MAX-1". -This bug apparently will cause the SET NOTIFY flag to disappear for the -GENERAL folder. MRL diff --git a/decus/vax88a3/bulletin/bulletinann.txt b/decus/vax88a3/bulletin/bulletinann.txt deleted file mode 100644 index 533d0d8..0000000 --- a/decus/vax88a3/bulletin/bulletinann.txt +++ /dev/null @@ -1,245 +0,0 @@ -From: KBSVAX::KANE "Joseph Kane" 5-APR-1988 18:20 -To: everhart@arisia.DECNET -Subj: forwarded mail - -From uunet!rutgers.edu!Postmaster Mon Apr 4 21:45:34 1988 -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA25990; Mon, 4 Apr 88 21:45:24 edt -Received: from RUTGERS.EDU by uunet.UU.NET (5.54/1.14) - id AA27965; Mon, 4 Apr 88 20:41:32 EDT -Received: by rutgers.edu (5.54/1.15) - id AD29798; Mon, 4 Apr 88 20:42:52 EDT -Date: Mon, 4 Apr 88 20:42:52 EDT -From: uunet!rutgers.edu!Postmaster (Mail Delivery Subsystem) -Subject: Returned mail: Host unknown -Message-Id: <8804050042.AD29798@rutgers.edu> -To: -Status: RO - - ----- Transcript of session follows ----- -550 ... Host unknown - - ----- Unsent message follows ----- -Received: by rutgers.edu (5.54/1.15) - id AA28843; Mon, 4 Apr 88 18:27:10 EDT -Received: from steinmetz.UUCP by uunet.UU.NET (5.54/1.14) with UUCP - id AA17005; Mon, 4 Apr 88 18:23:25 EDT -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA21534; Mon, 4 Apr 88 17:59:48 edt -Date: 2 Apr 88 20:15:30 EST -From: steinmetz!MAILER-DAEMON@uunet.uu.net (Mail Delivery Subsystem) -Subject: Returned mail: User unknown -Message-Id: <8804042159.AA21534@kbsvax.steinmetz> -To: MRL@pfc-vax.mit.edu - - ----- Transcript of session follows ----- -mail11: %MAIL-E-SYNTAX, error parsing 'CRD' -550 crd.ge.com!EVERHART%ARISIA.DECNET... User unknown - - ----- Unsent message follows ----- -Received: by kbsvax.steinmetz (1.2/1.1x Steinmetz) - id AA21526; Mon, 4 Apr 88 17:59:48 edt -Received: by ge-dab.GE.COM (smail2.5) - id AA19407; 4 Apr 88 07:30:44 EDT (Mon) -Received: by ge-rtp.GE.COM (smail2.5) - id AA10949; 3 Apr 88 21:20:10 EST (Sun) -Received: by mcnc.mcnc.org (5.54/MCNC/10-20-87) - id AA15418; Sat, 2 Apr 88 23:08:27 EST -From: -Received: by rutgers.edu (5.54/1.15) - id AA03601; Sat, 2 Apr 88 21:50:33 EST -Message-Id: <8804030250.AA03601@rutgers.edu> -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 2 Apr 88 20:17-EST -Date: 2 Apr 88 20:15:30 EST -To: xx!TENCATI@vlsi.jpl.nasa.gov, xx!MHG@mitre-bedford.arpa, - crd.ge.com!xx!EVERHART@ARISIA.DECNET, xx!GAYMAN@ari-hq1.arpa, - radc-softvax!xx!BACH -Subject: BULLETIN - -You are about to receive version 1.51 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -The previous announcement of a feature that could allow one to eliminate -BBOARD accounts unfortunately does not work with mail received via PMDF, -and probably other packages. See HELP SET BBOARD MORE_INFORMATION. If -your site uses a mailing method that will allow the feature to be used, -you should be aware that there has been a minor change in BOARD_DIGEST.COM -which is related to that feature, so that file should be updated. - -NOTE: If you are upgrading from a version older than 1.4, you should be -aware that the logical names BULLETIN$ and BULL$HELP are no longer being -used in the sources. Also, BULLFOLDER.DAT is converted to a new format -when it is run. This will cause problems in a cluster where each node -must have the executable reinstalled. It is best to deinstall the old -executable on all nodes before installing the new executable. - -(The latest feature and bug fixes for this new version are listed later.) - -You will be receiving 13 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) ALLMACS.MAR - 12) BULLCOMS1.HLP - 13) BULLCOMS2.HLP - 14) BULLET1.COM - 15) BULLET2.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run it, you can delete it. Read AAAREADME.TXT -for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. A command procedure is included at this -end of this message which can be run which uses EDT to do this for you. - - MRL%PFCVAX@XX.LCS.MIT.EDU ------------------------------------------------------------------------------- -The following is a description of recent new features and bug fixes. -V1.46 was a minor upgrade which was not distributed to all. V1.5 is a -major upgrade with many new features. - -V1.46 - -The times of the last message read for each folder is now stored in a -global file BULLINF.DAT rather than individually in -SYS$LOGIN:BULLETIN.INF. This was due to conflicts with accounts that -shared the same directory. - -Made several modifications to optimize program running time. Changed -all formatted disk reads to unformatted reads. Changed search algorithm -for latest message in a folder from sequential to binary. Made changes -to speed up BULLCP. - -V1.5 - -Sharing of folders over DECNET is now possible via the BULLCP process -created by BULLETIN/STARTUP. It is now possible to SELECT, READ, -DELETE, etc. a folder on another node. It is also possible to create a -folder that "points" to a folder on another node (i.e. by selecting FOO, -it automatically selects VAX1::FOO). - -Any folder can be made a SYSTEM folder, i.e. a folder than can have -SYSTEM/SHUTDOWN/BROADCAST messages added to it. This allows the -possibility of having a local SYSTEM folder and a shared GLOBAL SYSTEM -folder. One can also use this to easily display SYSTEM messages meant -for only certain UIC groups. This could be done by creating a SYSTEM -PRIVATE folder, with access limited to one UIC group. - -CTRL-C will now abort BULLETIN if BULLETIN is not waiting for input from -the terminal. This is to allow breaking out of a slow or hung -operations (particularly possible with remote folders). CTRL-Y will -continue to work as normal, i.e. to break out but be able to continue if -desired. - -The /SYSTEM qualifier on the BULLETIN command can now be used with -/LOGIN to cause system messages to be continually displayed for a -certain time period rather than just once. - -New qualifiers in commands: - READ/EDIT & CURRENT/EDIT - Uses editor to read message. - RESPOND/EDIT/TEXT - Uses editor to create reply message, and - allows text of message to be read in. - -The DELETE command can now delete a range of messages, i.e. DELETE n-m. - -The /FOLDER qualifier on the ADD command will now accept more than one -folder name. Folders on other nodes can be specified as long as BULLCP -is running on that other node, i.e. /FOLDER=PFCVAX::GENERAL. Prompting -for password for privileged is not necessary, unlike /NODE, since proxy -logins are used. It is also much faster than /NODE. - -Entering BULLETIN should be faster due to optimization (removed code which -unnecessarily was opening folder files). - -Non-ascii characters are removed in messages. This avoids funny escape -sequences which a user might have in a text file. - -V1.51 - -INDEX command added (from Brian@uoft02.bitnet). Gives directory listing -of all folders in sequence. Messages can be read during the listing, and -then the listing can be continued. /NEW will cause the listing of each -folder to start with the first unread message. - -Includes MAKEFILE for MAKE command for assembling executable. - -Modify SEARCH command to search description of message also (MAIL does this.) - -Includes many bug fixes and optimization changes. - -------------------------------------------------------------------------------- -$ set nover -$ edit/edt/nocommand allmacs.mar -'; Name: SETACC.MAR' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin0.for -'C BULLETIN'8 -d 1:.-2o -exit -$ edit/edt/nocommand bulletin1.for -'C BULLETIN'n -d 1:.-2s -exit -$ edit/edt/nocommand bulletin2.for -'C BULLETIN'b -d 1:.-2n -exit -$ edit/edt/nocommand bulletin3.for -'C BULLETIN'1 -d 1:.-2t -exit -$ edit/edt/nocommand bulletin4.for -'C BULLETIN' -d 1:.-27 -exit -$ edit/edt/nocommand bulletin5.for -'C BULLETIN'u -d 1:.-21 -exit -$ edit/edt/nocommand bulletin6.for -'C BULLETIN', -d 1:.-2 -exit -$ edit/edt/nocommand bulletin7.for -'C BULLETIN'l -d 1:.-2s -exit -$ edit/edt/nocommand bulletin8.for -'C BULLETIN' -d 1:.-24 -exit -$ edit/edt/nocommand bullcoms1.hlp -'1 ADD's -d 1:.-1 -exit -$ edit/edt/nocommand bullcoms2.hlp -'1 ADD'p -d 1:.-1t -exit -$ edit/edt/nocommand bullet1.com -'$set nover' -d 1:.-1s -exit -$ edit/edt/nocommand bullet2.com -'$set nover' -d 1:.-1 -exit - M diff --git a/decus/vax88b1/bulletin/aaareadme.1st b/decus/vax88b1/bulletin/aaareadme.1st deleted file mode 100644 index 9fffe7c..0000000 --- a/decus/vax88b1/bulletin/aaareadme.1st +++ /dev/null @@ -1,121 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLFILES.INC must first - be modified before this procedure is run. It contains the names of data files - which BULLETIN creates. It also includes specifications of directories used - by the FOLDER and BBOARD features. (In relation to the FOLDER feature, you - can restrict FOLDER creation to privileged users. See BULLCOM.CLD). - You should also look at BULLFOLDER.INC, as there may be some parameters in - that you may or may not want to modify. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, and wish the RESPOND command to be able - to send messages to the originators of these messages, you must modify - the subroutine RESPOND in BULLETIN2.FOR in order to specify the mail - utility which you use to send mail over those networks. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. (WARNING: Finding the newest unread - message is quicker than finding the oldest unread message. This - is not a problem if the number of messages is small. However, - if you plan on having lots of messages, and your system is heavily - loaded, you may want to avoid /REVERSE. Trial & error is the only - way to find out if this is a problem!) Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - (This is a new feature added as of Version 1.5). - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. NOTE: BULLCP requires that the system - has a DECNET account! - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - -5) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. - -6) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -7) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -8) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. diff --git a/decus/vax88b1/bulletin/allmacs.mar b/decus/vax88b1/bulletin/allmacs.mar deleted file mode 100644 index ed798a7..0000000 --- a/decus/vax88b1/bulletin/allmacs.mar +++ /dev/null @@ -1,201 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL CTL$GL_PCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask - MOVL CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .END diff --git a/decus/vax88b1/bulletin/board_digest.com b/decus/vax88b1/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vax88b1/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vax88b1/bulletin/board_special.com b/decus/vax88b1/bulletin/board_special.com deleted file mode 100644 index 1513033..0000000 --- a/decus/vax88b1/bulletin/board_special.com +++ /dev/null @@ -1,107 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vax88b1/bulletin/bullcom.cld b/decus/vax88b1/bulletin/bullcom.cld deleted file mode 100644 index 83dc7ca..0000000 --- a/decus/vax88b1/bulletin/bullcom.cld +++ /dev/null @@ -1,342 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 2/1/88 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER ALL - QUALIFIER BULLETIN_NUMBER - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW FOLDER AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER RESTART - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER HEADER - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER ALL - QUALIFIER BULLETIN_NUMBER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW FOLDER AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER SUBJECT - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_FLAGS - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) diff --git a/decus/vax88b1/bulletin/bullcoms1.hlp b/decus/vax88b1/bulletin/bullcoms1.hlp deleted file mode 100644 index cadd75c..0000000 --- a/decus/vax88b1/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,539 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does not -change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this assumes -that the remote node is capable of supporting this feature, i.e. the BULLCP -process is running on that node. If it is not, you will receive an error -message). If the the foldername is specified with only a nodename, -i.e. FOO::, the foldername is assumed to be GENERAL. NOTE: Specifying -remote nodes is only possible if that remote node is running a special -BULLCP process. If it isn't, the only way to add messages to that remote -node is via the /NODE command. However, /FOLDER is a much quicker method, -and much more versatile. - -You can specify logical names which translate to one or more folder names. -I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify /NODES= -ALL_FOLDERS. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL - -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See installation -notes). You can specify a different username to use at the other nodes by -either using the USERNAME qualifier, or by specifying the nodename with 2 -semi-colons followed by the username, i.e. nodename::username. If you -specify a username, you will be prompted for the password of the account -on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /PERMANENT -This option is restricted to privileged users for the GENERAL folder, -but available to all in other folders. If specified, message will be a -permanent message and will never expire. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -NOTE: If the bulletin files are shared between cluster nodes, the -message will be deleted after the node on which the message was -submitted from is rebooted. If the folder is a remote folder, the -message will be deleted after the remote node reboots, not the node -from which the message was added. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /TEXT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 BACK -Displays the message preceding the current message. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. If the text of the message -is to be changed, a file can be specified which contains the text. -Otherwise, you will be prompted for the text. The expiration info and -header can also be changed. If neither no qualifiers are added to the -command, it is assumed the whole message will be replaced. - - Format: - CHANGE [file-name] -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. This only applies to the GENERAL folder. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number - -Specifies the message number to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name -2 /ALL -Specifies to copy all the messages in the old folder. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically selected -(see information on SELECT command). The commands that can be used to -modify the folder's characteristics are: MODIFY, REMOVE, SET ACCESS, -SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the folder -is stored in a file name created with the folder name). -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. -2 /NODE - /NODE=nodename -Specifies that the folder is a remote folder at the specified nodename. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified nodename is checked -to see if a folder of the same name is located on that node. If so, the -folder will point to that folder. This capability is only present if the -BULLCP process is created on the remote node via the BULL/STARTUP command. - -NOTE: If one node add a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -That information is only updated every 15 minutes (same algorithm for -updating BBOARD messages), or if a user accesses that folder. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. By default, -the GENERAL folder is a SYSTEM folder. This is a privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 CURRENT - -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -it's expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message. -It can be a substring of the subject. This is in case you have forgotten -the exact subject that was specified. Case is not critical either. -You will be notified if the deletion was successful. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting messages -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of folder. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. -2 /NEW -Specifies to start the listing of messages with the first unread message. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified. - - Format: - FILE file-name -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 Folders -All messages are divided into separate folders. The default folder is -GENERAL. New folders can be created by any user. As an example, the -following creates a folder for GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that -user will be alerted of topics of new messages at login time, and will -then be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in the -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote DECNET -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP) -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. By default, the GENERAL folder -is a SYSTEM folder (and cannot be changed). One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the GENERAL -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, and -giving access to that UIC group. Only users in that UIC group will see -the messages in that folder when they log in. -1 HELP -To obtain help on any topic, type: - - HELP topic - -CTRL-Y only breaks out of a command when no files are open. Otherwise, -use CTRL-C, which will abort the program. However, unlike CTRL-Y, you -can not resume execution using the VMS CONTINUE command. Also note that -CTRL-C will not abort if BULLETIN is waiting for input from the terminal. -1 INDEX -Gives directory listing of all folders in alphabetical order. If the -INDEX command is re-entered while the listing is in progress, the listing -will skip to the next folder. This is useful for skipping a particular -folder. It also can be used to continue the listing from where one left -off after one has read a message. - - Format: - INDEX -2 /NEW -Specifies to start the listing of each folder with the first unread message. -Otherwise, the listing will start with the first message in the folder. -If the INDEX command is re-entered for continuing the listing, /NEW must -be respecified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/TE|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/TE| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name - -The input for the recipient name is exactly the same format as used by -the MAIL utility. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MODIFY -Modifies the database information for the current folder. Only the owner -of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. diff --git a/decus/vax88b1/bulletin/bullcoms2.hlp b/decus/vax88b1/bulletin/bullcoms2.hlp deleted file mode 100644 index 1ef9640..0000000 --- a/decus/vax88b1/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,538 +0,0 @@ -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The PRINT command can take optional qualifiers. - - Format: - - PRINT -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder will -be displayed. However, if there are new messages, the first new message -will be displayed. Each time you enter the command, the next page, or if -there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply hitting -the key is equivalent to "READ". -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged -user can remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /TEXT. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /TEXT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. If the owner of the -message is not a valid user, it is assumed that the message was from -a network, and the message is searched for a line starting with "From:". -The username is then extracted from that line, and the necessary mail -routine to send over the network is invoked. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -2 /TEXT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing -the first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header. -If a "search-string" is not specified, a search is made using the -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default general messages. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id [folder-name] - -The parameter "id" is the id in the system Rights Database to which -access is being affected. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created -by use of ACLs. If a user is able to set his process's privileges -to override ACLs, that user will be able to access the folder even if -access has not been granted via BULLETIN. -3 id -The id can be anything in the system Rights Database. This includes -3 /ALL -Specifies that access to the folder is granted to all users. -If /READ is not specified, the folder will no longer be private. -If /READ is specified, all users will have read access, but only -privileged users will have write access (of course non-privileged -users can gain access via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have it's own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSTEM privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, you may have to increase some -subprocess system parameters: PQL_DPGFLQUOTA and PQL_DWSQUOTA are often -too low (10000 and 500 will work). In some cases, PQL_DFILLIM will have -to be increased (but this is rare). If you are not using the BULLCP -process, the subprocess limit for users must be at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. - -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes it's input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time and -avoids creating subprocesses. (Useful if input is digest format.) -3 More_information - -The following is relevant only if the messages in the BBOARD accounts -are sent via a method that causes the name of the account to be placed -in the TO: line of the VMS MAIL. The normal MAIL utility, of course, -does this. However, packages such as PMDF (and probably many others) -will not always do this. (I.e. if the mail was sent to the account -using CC:, the address of the person to whom the mail was sent will be -placed in the TO: line rather than the CC: address.) - -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail forwarded -to BBOARD accounts that don't have /SPECIAL set. Folders of the same -type, i.e. that use the same /SPECIAL command procedure, must be grouped -separately. -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. This cannot be specified for -the GENERAL folder. The BRIEF setting contrasts with the READNEW -setting, which causes a listing of the description of the new messages -to be displayed and prompts the user to read the messages. Setting -BRIEF will clear a READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory. - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. -(NOTE: SHOW FOLDER/FULL is a privileged command.) -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one exists. -(NOTE: SHOW FOLDER/FULL is a privileged command.) -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by many -different people. If an account is specified as GENERIC, new messages -placed in the GENERAL folder will be displayed upon logging in for a -specific number of days, rather than only once. The default period is 7 -days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new GENERAL messages will be displayed -for upon logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will -not occur if DISMAIL is set for an old account. Additionally, removing -the DISMAIL flag will not automatically enable LOGIN. (The reason for -the above was to avoid extra overhead for constant checking for the -DISMAIL flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NODE -Modifies the selected folder from a local folder to a remote folder. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. When the SET NODE command is -executed, the remote node is checked to see if a folder of the same -name is located on that node. If so, the selected folder will then -point to that folder. If are any messages stored in the local folder, -they will be deleted. This capability is only present if the BULLCP -process is created on the remote node via the BULL/STARTUP command. - - Format: - - SET NODE nodename - SET NONODE - -NOTE: If one node add a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -That information is only updated every 15 minutes (same algorithm for -updating BBOARD messages), or if a user accesses that folder. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -This command does not presently work for remote folders. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 PRIVILEGES -Specifies the privileges that are necessary to use privileged commands. -Use the SHOW PRIVILEGES command to see what privileges are presently set. -This is a privileged command. - - Format: - - SET PRIVILEGES privilege-list - -Privilege-list is the list of privileges separated by commas. -To remove a privilege, specify the privilege preceeded by "NO". -2 READNEW -Controls whether you will be prompted upon logging in if you wish to read -new non-system or folder messages (if any exist). The default is dependent -on how the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. -For messages in folders other than the GENERAL folder, both prompting -and display of topics of new messages are controlled by this command. -For the GENERAL folder, the display of topics cannot be disabled. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP -SET SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. -This command cannot be used for the GENERAL folder. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -By default, the GENERAL folder is a SYSTEM folder, and the setting for -that folder cannot be removed. - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected via -the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 KEYPAD -Displays the keypad command definitions. If the keypad has been enabled -by either the SET KEYPAD COMMAND, or /KEYPAD is specified on the command -line, the keypad keys will be defined as commands. SHOW KEYPAD is the -equivalent of HELP KEYPAD. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -2 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. -1 UNDELETE -Undeletes the specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have their -expiration date set to 15 minutes in the future and are deleted then. -Undeleting the message will reset the expiration date back to it's original -value. Deleted messages will be indicated as such by the string (DELETED) -when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] diff --git a/decus/vax88b1/bulletin/bulldir.inc b/decus/vax88b1/bulletin/bulldir.inc deleted file mode 100644 index 9ad357a..0000000 --- a/decus/vax88b1/bulletin/bulldir.inc +++ /dev/null @@ -1,28 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) diff --git a/decus/vax88b1/bulletin/bullet1.com b/decus/vax88b1/bulletin/bullet1.com deleted file mode 100644 index fa1efb5..0000000 --- a/decus/vax88b1/bulletin/bullet1.com +++ /dev/null @@ -1,745 +0,0 @@ -$set nover -$copy sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLFILES.INC must first - be modified before this procedure is run. It contains the names of data files - which BULLETIN creates. It also includes specifications of directories used - by the FOLDER and BBOARD features. (In relation to the FOLDER feature, you - can restrict FOLDER creation to privileged users. See BULLCOM.CLD). - You should also look at BULLFOLDER.INC, as there may be some parameters in - that you may or may not want to modify. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, and wish the RESPOND command to be able - to send messages to the originators of these messages, you must modify - the subroutine RESPOND in BULLETIN2.FOR in order to specify the mail - utility which you use to send mail over those networks. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. (WARNING: Finding the newest unread - message is quicker than finding the oldest unread message. This - is not a problem if the number of messages is small. However, - if you plan on having lots of messages, and your system is heavily - loaded, you may want to avoid /REVERSE. Trial & error is the only - way to find out if this is a problem!) Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - (This is a new feature added as of Version 1.5). - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. NOTE: BULLCP requires that the system - has a DECNET account! - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - -5) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. - -6) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -7) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -8) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. -$eod -$copy sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) -$eod -$copy sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD - Qualifier LOGIN - Qualifier PAGE, Default - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") -$eod -$copy sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in it's memory. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -$eod -$copy sys$input BULLETIN.LNK -$deck -$ LINK/NOTRACE BULLETIN,BULLETIN0,BULLETIN1,BULLETIN2,BULLETIN3,- -BULLETIN4,BULLETIN5,BULLETIN6,BULLETIN7,BULLETIN8,BULLETIN9,- -BULLCOM,BULLMAIN,ALLMACS,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB -$eod -$copy sys$input BULLFILES.INC -$deck -C -C THE FIRST 2 FILES ARE FILES CREATED AND USED BY BULLETIN. -C SPECIFY THE DEVICE/DIRECTORY IN WHICH YOU DESIRE THAT THEY BE KEPT. -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNT MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU ALSO MAY HAVE -C TO INCREASE SOME SUBPROCESS SYSTEM PARAMETERS: PQL_DPGFLQUOTA AND -C PQL_DWSQUOTA MAY HAVE TO BE CHANGED. (10000 AND 500 ARE TYPICAL). -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNT USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLDIR_FILE,BULLETIN_FILE,BULLUSER_FILE - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLINF_FILE - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C THE FOLLOWING 2 FILES ARE OBSOLETE AS OF V1.1 AND NO LONGER HAVE TO -C BE SPECIFIED. BULLETIN NOW TREATS THE GENERAL FOLDER AS ANY OTHER -C FOLDER. NEW USERS SHOULD JUST LEAVE THEM ALONE. HOWEVER, USERS -C USING OLDER VERSIONS STILL HAVE TO SPECIFY THEM IN ORDER THAT -C BULLETIN KNOWS THE NAMES IN ORDER TO RENAME THEM. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ -$eod -$copy sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,FILLER, - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) -$eod -$copy sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Last read times for each folder as stored in SYS$LOGIN:BULLETIN.INF - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod diff --git a/decus/vax88b1/bulletin/bullet2.com b/decus/vax88b1/bulletin/bullet2.com deleted file mode 100644 index d743dd0..0000000 --- a/decus/vax88b1/bulletin/bullet2.com +++ /dev/null @@ -1,972 +0,0 @@ -$set nover -$copy sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 2/1/88 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER ALL - QUALIFIER BULLETIN_NUMBER - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW FOLDER AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER RESTART - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER HEADER - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - QUALIFIER ALL - QUALIFIER BULLETIN_NUMBER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW FOLDER AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER SUBJECT - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_FLAGS - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) -$eod -$copy sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD - Qualifier LOGIN - Qualifier PAGE, Default - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") -$eod -$copy sys$input BULLETIN.COM -$deck -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -$eod -$copy sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD - QUALIFIER LOGIN - QUALIFIER PAGE, DEFAULT - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER,DEFAULT="7") -$eod -$copy sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy sys$input CREATE.COM -$deck -$ FORTRAN/EXTEND BULLETIN -$ FORTRAN/EXTEND BULLETIN0 -$ FORTRAN/EXTEND BULLETIN1 -$ FORTRAN/EXTEND BULLETIN2 -$ FORTRAN/EXTEND BULLETIN3 -$ FORTRAN/EXTEND BULLETIN4 -$ FORTRAN/EXTEND BULLETIN5 -$ FORTRAN/EXTEND BULLETIN6 -$ FORTRAN/EXTEND BULLETIN7 -$ FORTRAN/EXTEND BULLETIN8 -$ FORTRAN/EXTEND BULLETIN9 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ @BULLETIN.LNK -$eod -$copy sys$input DCLREMOTE.COM -$deck -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET -$eod -$copy sys$input INSTALL.COM -$deck -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy sys$input INSTALL_REMOTE.COM -$deck -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,KLEIN,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,KLEIN,MOLVAX,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,KLEIN,MOLVAX,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL -$eod -$copy sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy sys$input LOGIN.COM -$deck -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! If you wish bulletins to be displayed upon logging in starting with -$! oldest rather than newest, change BULLETIN/LOGIN to BULLETIN/LOGIN/REVERSE. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/LOGIN -$eod -$copy sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Link /NoTrace Bulletin.Obj,Bulletin0.Obj,Bulletin1.Obj,Bulletin2.Obj, - - Bulletin3.Obj,Bulletin4.Obj,Bulletin5.Obj,Bulletin6.Obj, - - Bulletin7.Obj,Bulletin8.Obj,Bulletin9.Obj, - - Bullcom.Obj,Bullmain.Obj,Allmacs.Obj, - - Sys$System:Sys.Stb /Sel /NoUserlib - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin9.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* - -$eod -$copy sys$input REMOTE.COM -$deck -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP -$eod diff --git a/decus/vax88b1/bulletin/bulletin.cld b/decus/vax88b1/bulletin/bulletin.cld deleted file mode 100644 index cae5700..0000000 --- a/decus/vax88b1/bulletin/bulletin.cld +++ /dev/null @@ -1,34 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD - Qualifier LOGIN - Qualifier PAGE, Default - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") diff --git a/decus/vax88b1/bulletin/bulletin.com b/decus/vax88b1/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vax88b1/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vax88b1/bulletin/bulletin.for b/decus/vax88b1/bulletin/bulletin.for deleted file mode 100644 index 3cccbe6..0000000 --- a/decus/vax88b1/bulletin/bulletin.for +++ /dev/null @@ -1,1182 +0,0 @@ -C -C BULLETIN.FOR, Version 8/3/88 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$GET_FOREIGN(INCMD) - CALL CLI$DCL_PARSE('BULLETIN '//INCMD,BULLETIN_MAINCOMMANDS) - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - END IF - CALL LIB$REVERT - - READIT = 0 - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP')) THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - CALL RUN_BULLCP ! doing what BULLCP does! - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - -C -C Get page length for the terminal. -C - - CALL GETPAGLEN(PAGE_LENGTH) - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL SHOW_SYSTEM - CALL EXIT - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - CALL NEW_MESSAGE_NOTIFICATION - ELSE - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - - DO WHILE (1) - - CALL GET_INPUT_PROMPT(INCMD,IER, - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9') - IER = IER - 1 - END DO - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - - CALL CLI$GET_VALUE('$VERB',INCMD) ! Get the VERB command - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD bulletin command? - CALL ADD ! Go add bulletin - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK command? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE command? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY command? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE command? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT command? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE command? - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY command? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE command? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT command? - GO TO 999 ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP command? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX command? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST command? - READ_COUNT = -1 - BULL_READ = 99999 - CALL READ(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL command? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY command? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE command? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEXT') THEN ! NEXT command? - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT command? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ command? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE command? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY command? - IF (BULL_POINT.LT.1) THEN - WRITE (6,'('' ERROR: No bulletin currently read.'')') - ELSE - WRITE (6,'('' Adding REPLY message with the subject:'')') - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP) - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - DESCRIP = 'RE: '//DESCRIP - ELSE - DESCRIP = 'RE:'//DESCRIP(4:) - END IF - WRITE (6,'(1X,A)') DESCRIP - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND command? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH command? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT command? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET command? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'PR') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'KE') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOP') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:3).EQ.'NOT') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(1,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(0,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET SHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,1) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(1,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOSHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET BRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,1) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(1,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOBRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW command? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:2).EQ.'KE') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (NBULL.GT.0) THEN - DIFF = COMPARE_BTIM( - & LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - END IF - END IF - END DO - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - END IF - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE command? - CALL UNDELETE - END IF - -100 CONTINUE - - END DO - -999 CALL EXIT - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER*80 INDESCRIP,INPUT - - CHARACTER INLINE*80,OLD_FOLDER*25 - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - ELSE IF (CLI$PRESENT('TEXT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_FILE_SHARED(1) - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:MIN(79,ILEN)) - IF (ILEN.EQ.80) WRITE (3,'(A)') '>'//INPUT(80:) - END IF - END IF - END DO - ILEN = 80 - END DO - -90 CALL CLOSE_FILE(1) - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET? - USERNAME = DEFAULT_USER - CALL CONFIRM_PRIV(USERNAME,ALLOW) - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privileges - WRITE(ERROR_UNIT,1081) ! Tell user - GO TO 910 ! and abort - ELSE IF (F_EXPIRE_LIMIT.GT.0.AND..NOT.ALLOW ! Expiration limit - & .AND.USERNAME.NE.FOLDER_OWNER) THEN ! is present - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (INEXTIME,'(I4)') NODE_NUMBER - WRITE (INEXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY command? - INDESCRIP = DESCRIP ! Use descrption with RE:, - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - GO TO 910 - END IF - ELSE - LENDES = 54 - DO WHILE (LENDES.GT.53) ! Do until valid description - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - END IF - END DO - END IF - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IF - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.80) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Sratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = 81 ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.80) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > 80. Reinput:'')') - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment record count - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolons - ILEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Are semicolon found? - IF (ILEN.GT.SEMI+1) THEN ! Is username found? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes - ILEN = SEMI - 1 ! Remove semicolons - ELSE ! No username found... - TEMP_USER = DEFAULT_USER ! Set user to default - ILEN = SEMI - 1 ! Remove semicolons - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons present - TEMP_USER = DEFAULT_USER ! Set user to default - END IF - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:ILEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - INLINE = INLINE(:STR$POSITION(INLINE,' ')-1) - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,80) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - BRDCST = .FALSE. - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER) THEN - CALL OPEN_FILE(2) ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - LENGTH = (ICOUNT+127)/128 ! Number of records - FROM = USERNAME ! Username - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF - CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - CALL ADD_ENTRY ! Add the new directory entry - - IF (FOLDER_NUMBER.GE.0) THEN - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_FILE(2) ! Totally finished with add - ELSE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (CLI$PRESENT('TEXT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be - & truncated to:') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanent - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*23 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*8 LOCALNODE - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_FILE_SHARED(4) - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE(4) - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE (4) - - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END diff --git a/decus/vax88b1/bulletin/bulletin.hlp b/decus/vax88b1/bulletin/bulletin.hlp deleted file mode 100644 index b3e6d24..0000000 --- a/decus/vax88b1/bulletin/bulletin.hlp +++ /dev/null @@ -1,108 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in it's memory. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) diff --git a/decus/vax88b1/bulletin/bulletin.lnk b/decus/vax88b1/bulletin/bulletin.lnk deleted file mode 100644 index 0a04371..0000000 --- a/decus/vax88b1/bulletin/bulletin.lnk +++ /dev/null @@ -1,3 +0,0 @@ -$ LINK/NOTRACE BULLETIN,BULLETIN0,BULLETIN1,BULLETIN2,BULLETIN3,- -BULLETIN4,BULLETIN5,BULLETIN6,BULLETIN7,BULLETIN8,BULLETIN9,- -BULLCOM,BULLMAIN,ALLMACS,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB diff --git a/decus/vax88b1/bulletin/bulletin.message b/decus/vax88b1/bulletin/bulletin.message deleted file mode 100644 index 47f35f3..0000000 --- a/decus/vax88b1/bulletin/bulletin.message +++ /dev/null @@ -1,21 +0,0 @@ - -Return-path: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -Received: from EAGLE by FALCON; Wed, 10 Aug 88 06:56 EDT -Received: from XX.LCS.MIT.EDU by WPAFB-AAMRL.ARPA; Wed, 10 Aug 88 06:54 EDT -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 10 Aug 88 - 06:39-EDT -Date: 10 Aug 88 06:40:16 EDT -From: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -Subject: BULLETIN - -WARNING: After upgrading to V5, you MUST reassemble ALLMACS.MAR before -relinking BULLETIN. If you don't do this, running BULLCP will cause your -machine to crash. (Luckily, you are forced to relink BULLETIN, since it uses -shared libraries, and these have changed so you will be unable to INSTALL it. -This will probably jog your memory to assemble ALLMACS, and thus avoid -rebooting under V5 and then have your machine crash repeatedly since BULLCP is -created by the system startup procedure, which is what happened to me!) - -Also, I discovered more changes that were needed to allow the remote folder -feature to work under V5. It requires a new BULLETIN8.FOR, which I will be -distributing shortly. diff --git a/decus/vax88b1/bulletin/bulletin.message2 b/decus/vax88b1/bulletin/bulletin.message2 deleted file mode 100644 index d006951..0000000 --- a/decus/vax88b1/bulletin/bulletin.message2 +++ /dev/null @@ -1,251 +0,0 @@ - -Return-path: MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU -Received: from EAGLE by FALCON; Tue, 16 Aug 88 12:27 EDT -Received: from EDDIE.MIT.EDU by WPAFB-AAMRL.ARPA; Tue, 16 Aug 88 12:24 EDT -Received: from deep-thought.mit.edu by EDDIE.MIT.EDU via Chaosnet with MAIL - with sendmail-5.45/4.7 id ; Tue, 16 Aug 88 12:01:52 EDT -Received: from PFC-VAX.MIT.EDU by DEEP-THOUGHT.MIT.EDU via Chaosnet; 16 Aug 88 - 11:56-EDT -Date: 16 Aug 88 11:56:01 EDT -From: MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU -Subject: BULLETIN - -You are about to receive version 1.52C of the PFC BULLETIN. This -version includes all necessary modifications to work under VMS V5.0. -However, it will still be necessary to reassemble the ALLMACS.MAR source -under V5 and relink. The V4 version will not be installable under V5 -due to a change in a shared library which BULLETIN uses. However, -relinking by itself will not be enough. You MUST also reassemble -ALLMACS.MAR. If you only relink, BULLETIN can cause your system to -crash (the BULLCP process will do this because it uses the routins in -ALLMACS.MAR). - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -If you are running a version of BULLETIN older than 1.52, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). This can cause problems if -the old version of BULLETIN is run after the data files have been -modified. Such a situation is possible on a cluster where each node has -installed the executable separately. To help installation, a new -command procedure INSTALL_REMOTE.COM has been included. This can be -used to install BULLETIN on several nodes from a single node. Read the -comments in the file for information on how to use it. - -NOTE: The BULLCP process should be stopped using the BULLETIN/STOP -command before the new version of BULLETIN is installed. It can then be -restarted using the BULLETIN/STARTUP command. (The INSTALL_REMOTE.COM -command procedure does this automatically for remote nodes.) - -(The format of the .BULLDIR will change for pre V1.52 versions. After -successful installation, the older versions of these files can be -removed. This format change can take a significant amount of time if -the folder is large. If your site has large folders, it is suggested -that the new version be installed during off peak hours.) - -(The latest feature and bug fixes for this new version are listed later.) - -You will be receiving 14 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) ALLMACS.MAR - 13) BULLCOMS1.HLP - 14) BULLCOMS2.HLP - 15) BULLET1.COM - 16) BULLET2.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run it, you can delete it. Read AAAREADME.TXT -for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. A command procedure is included at this -end of this message which can be run which uses EDT to do this for you. - - MRL%PFCVAX@XX.LCS.MIT.EDU ------------------------------------------------------------------------------- -V1.52C - -Modified code to allow remote folder feature to work under VMS V5. - -Corrected minor bugs in BULLCP (which would cause remote folder -connection to break). NOTE: If an error occurs when BULLCP is running, -it will restart itself after waiting one minute. It will also write out -a file with the error, either named BULLCP.ERR or BULLCP.LOG. - -The algorithm in BULLCP to cleanup empty space in the folder files -(caused by deleted messages) was not working properly. It should be -triggered when the empty space reaches a limit, but it was not reading -that limit properly. This has been fixed. Also, it will now only check -that limit after it turns 3 a.m. This is avoid the cleanup process from -occurring during the middle of the day, when it would needlessly use the -cpu during prime time. - -V1.52B - -Made minor modifications to decrease execution time of BULLETIN when -logging in. - -Added the BULLETIN.CLD file to allow BULLETIN command to be installed -using CDU if desired. - -V1.52A - -Made modifications so it would work with VMS V5.0. - -V1.52 - -Modified structure of directory files for folders. The files are now -keyed files, the keys being message number and message date. This speeds -up the process of searching for a message using a date. Thus, BULLETIN is -now more efficient when it has to find the latest message in a folder. - -Modified cleanup algorithm. Old code could cause file corruption. - -Add /SUBJECT in SEARCH command to search only the description of messages. - -Add /DESCRIPTION and /OWNER in CREATE command. - -Corrected problem that would cause invalid notification of new messages -in a remote SYSTEM folder. If a new SYSTEM message was added, and a person -entered BULLETIN, it would notify the user that there was a new message in -the folder even though the SYSTEM message had been displayed during logging -in. To correct this, the BULLFOLDER.DAT format had to be changed to store -the date of the last non-SYSTEM message in each folder. - -Added logical name BULL_DISABLE to disable use of BULLETIN. Useful during -installation (or debugging) of BULLETIN. Also added command procedure -INSTALL_REMOTE.COM. These two should make it easier to install a new version -of BULLETIN in a cluster, where INSTALL must be run on each node to install -the new executable. This is especially important when the new executable -changes the format of the data file, so that the old version must not be run -after the data format has been changed. - -Fixed bug which caused NOTIFY flag for GENERAL folder to be cleared. - -Fixed bug which would cause /SUBJECT not to work in MAIL command if placed -after the username. Also added /HEADER qualifier to MAIL to include the -message header with the message. - -Fixed bug which prevented messages with expiration years > 1999 from being -deleted (without /IMMEDITATE). - -Fixed bug which was causing expired messages from not being deleted. - -Fixed bug which allows non-privileged user to copy a permanent message such -that the copy messaged kept the permanent designation. - -Fixed BBOARD algorithm which required the username in the "To:" mail message -field to be uppercase. Some non-DEC mail systems use lowercase. - -When creating a remote folder, i.e. CREATE/NODE, and the actual folder on -the remote node is PRIVATE, this information will now be displayed via the -SHOW FOLDER command. - -Fixed bug in BULLCP which resulted in subprocess BULL_CLEANUP to be spawned. -This should only occur if BULLCP is not running. BULLCP itself does the -cleanup of empty space in folders, so this was redundant and time consuming. - -Added /TEXT qualifier to REPLY command (and, as a consequence, also to the -ADD command). This is present in the RESPOND command, and includes the text -of the previously read message into the new message. Also, the text of the -old message is indented using ">"s, which can be suppressed with /NOINDENT. - -If files are shared between nodes in a cluster, SHUTDOWN messages were not -deleted at the appropriate times, as there was no way of knowing from -which node the messages were submitted from. This has been fixed so that -SHUTDOWN messages will be deleted when the node they were submitted from -is rebooted. - -KEYPAD mode has been added. Keypad can be enabled so that keys are assigned -to BULLETIN commands. This canenabled either by the SET KEYPAD command, or by -adding /KEYPAD to the command line. SHOW KEYPAD shows the definitions. - -Fixed bug which caused BULLCP not to be able to update a private folder after -BULLCP was used by a remote user. (During a remote access, BULLCP sets it's -privileges to that of the user's proxy login who is doing the access. It was -not getting set back to BULLCP's actual privileges.) - -Did you know that access to a folder can be resticted to a particular DECNET -node? This is because interactive processes are assigned the SYS$NODE_nodename -id, and that id can be specified via a SET ACCESS command. - -------------------------------------------------------------------------------- -$ set nover -$ edit/edt/nocommand allmacs.mar -'; Name: SETACC.MAR' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin0.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin1.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin2.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin3.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin4.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin5.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin6.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin7.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin8.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin9.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bullcoms1.hlp -'1 ADD' -d 1:.-1 -exit -$ edit/edt/nocommand bullcoms2.hlp -'1 ADD' -d 1:.-1 -exit -$ edit/edt/nocommand bullet1.com -'$set nover' -d 1:.-1 -exit -$ edit/edt/nocommand bullet2.com -'$set nover' -d 1:.-1 -exit diff --git a/decus/vax88b1/bulletin/bulletin.message3 b/decus/vax88b1/bulletin/bulletin.message3 deleted file mode 100644 index 4508755..0000000 --- a/decus/vax88b1/bulletin/bulletin.message3 +++ /dev/null @@ -1,24 +0,0 @@ -Return-path: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -Received: from EAGLE by FALCON; Tue, 23 Aug 88 08:23 EDT -Received: from XX.LCS.MIT.EDU by WPAFB-AAMRL.ARPA; Tue, 23 Aug 88 08:21 EDT -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 23 Aug 88 - 15:38-EDT -Date: 22 Aug 88 15:39:00 EDT -From: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -Subject: BULLETIN - -BULLETIN USERS: -A bug was recently brought to my attention. If a new user logs in, and the -/REVERSE switch is on the BULLETIN/LOGIN command, the code does not display -the appropriate new messages. The problem is in BULLETIN0.FOR, so I'm -sending a new copy of that to everyone. - -(A brand new user should see all permanent SYSTEM messages and the first -non-system message in the GENERAL folder. I limit it to that, since otherwise -if there are a lot of messages in the GENERAL folder, a new user might end up -getting page fulls of messages.) - -The LOGIN.COM that I distribute didn't used to have /REVERSE as the default, -but I just changed that. To me, it makes more sense to see the oldest -messages first, since the new messages might refer to older messages. - Mark diff --git a/decus/vax88b1/bulletin/bulletin0.for b/decus/vax88b1/bulletin/bulletin0.for deleted file mode 100644 index 81093e1..0000000 --- a/decus/vax88b1/bulletin/bulletin0.for +++ /dev/null @@ -1,1249 +0,0 @@ -C -C BULLETIN0.FOR, Version 8/22/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - CHARACTER*128 INPUT - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = 81 - DO I=NBLOCK+1,NBLOCK+LENGTH ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL(I,INPUT,ILEN) - END IF - IF (ILEN.LT.0) THEN ! End of bulletin? - RETURN - ELSE IF (ILEN.GT.0) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - ILEN = 80 - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IF - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - - - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53,INPUT*23 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER) - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_FILE(2) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.REMOTE_USER.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_FILE(2) - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_FILE(2) ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,DESCRIP - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(1:11) - NEWEST_EXTIME = INPUT(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_FILE(2) - - DO BULL_DELETE = SBULL,EBULL - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_FILE(2) - RETURN - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_FILE(2) - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - CALL CLOSE_FILE(2) - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') RETURN - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_FILE(2) - RETURN - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - END DO - - CALL CLOSE_FILE(2) - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER INPUT*23 - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM) - IER = SYS$ASCTIM(,INPUT,EX_BTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:) - - CALL WRITEDIR(0,IER) - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH, PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT - - CHARACTER START_PARAMETER*16,DATETIME*23 - - INTEGER TODAY(2) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_FILE_SHARED(2) ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1) THEN ! If so, there are messages - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified? - IER = CLI$GET_VALUE('START',START_PARAMETER,ILEN) - DECODE(ILEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEN - DIR_COUNT = NBULL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_FILE(2) - DIR_COUNT = 0 - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_FILE(2) - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - END IF - - CALL READDIR_KEYGE(IER) - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_FILE(2) - RETURN - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - END IF - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THEN - EBULL = NBULL - END IF - IF (.NOT.REMOTE_SET) THEN - DO I=SBULL,EBULL ! Copy messages from file - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - END DO - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,SBULL,EBULL - IF (IER.EQ.0) THEN - I = SBULL - DO WHILE (IER.EQ.0.AND.I.LE.EBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_FILE(2) - CALL DISCONNECT_REMOTE - RETURN - END IF - END IF - ELSE - NBULL = 0 - END IF - - CALL CLOSE_FILE(2) ! We don't need file anymore - - IF (NBULL.EQ.0) THEN - WRITE (6,'('' There are no messages present.'')') - RETURN - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER) - WRITE(6,'(<81-FLEN>X,A)') FOLDER(:FLEN) - WRITE(6,1000) ! Write header - DO I=SBULL,EBULL - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,2010) I,DESCRIP(:52),FROM,'(DELETED)' - ELSE - WRITE(6,2010) I,DESCRIP(:52),FROM,DATE(1:7)//DATE(10:11) - END IF - END DO - - DIR_COUNT = EBULL + 1 ! Update directory counter - - IF (DIR_COUNT.GT.NBULL) THEN ! Outputted all entries? - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - -2010 FORMAT(1X,I4,1X,A52,1X,A12,1X,A9) - - END - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And return - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,1010) ! Write error - RETURN ! And return - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030) - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(1:ILEN) - END IF - END DO - ILEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_POINT,BULL_PARAMETER(1:LEN_P) - ! Show name of file created. -100 CALL CLOSE_FILE(1) - RETURN - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 100 - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A,/) - - END - - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*23,INPUT*80,INREAD*1 - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - DIMENSION NOLOGIN_BTIM(2),LOGIN_BTIM_SAVE(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_FILE_SHARED(4) - - CALL MODIFY_SYSTEM_LIST(1) - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) RETURN ! DISMAIL set - IF (IER1.EQ.0) THEN ! There is a user entry - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry - READ_BTIM(2) = NEW_BTIM(2) - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_DISMAIL(USERNAME,DISMAIL) - IF (DISMAIL.EQ.1) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - ELSE - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_FILE(4) ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_FILE_SHARED(9) - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_FILE(9) - END IF - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - BBOARD_BTIM(1) = TODAY_BTIM(1) - BBOARD_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_FILE(4) - IF (.NOT.TEST_BULLCP()) CALL CREATE_BBOARD_PROCESS - ELSE - CALL CLOSE_FILE(4) - IF (IER.NE.0) CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compare - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - - IF (NEW_FLAG(2).NE.0) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - RETURN - END IF - -C -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible. -C - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.FOLDER_SET) THEN - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (FOLDER_NUMBER.GT.0.AND.BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST2(SET_FLAG,FOLDER_NUMBER) - & .AND..NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) RETURN - ! Don't overwhelm new user with lots of non-general msgs - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - LOGIN_BTIM(1) = SYSTEM_LOGIN_BTIM(1) ! Use specified login time - LOGIN_BTIM(2) = SYSTEM_LOGIN_BTIM(2) ! for system messages. - END IF - - CALL OPEN_FILE_SHARED(2) ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF (REVERSE_SWITCH.AND.(.NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,NBULL - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,NBULL,START - END IF - IF (IER.EQ.0) THEN - ALL_DIR = ALL_DIR1 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.NBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_FILE(2) - CALL DISCONNECT_REMOTE - RETURN - END IF - ALL_DIR = ALL_DIR1 - END IF - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - ! No. Is bulletin system or from same user? - IF (.NOT.REVERSE) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (SYSTEM_SWITCH) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - ELSE - DIFF = -1 - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF (SYSTEM.EQ.3) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0) THEN ! And save only the first non-system msg - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_FILE(2) -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (NGEN.EQ.0.AND.NSYS.EQ.0) RETURN - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER) - S1 = (80-(LENF+16))/2 - S2 = 80 - S1 - (LENF + 16) - WRITE (6,1026) FOLDER(:LENF),CTRL_G ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_FILE_SHARED(1) - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_FILE(1) - RETURN - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin to SYS_BUL link list - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - CALL CLOSE_FILE(1) - RETURN - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - END IF - END DO - ILEN = 80 - END DO - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,80 - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_FILE(1) - SYS_BUL = SYS_BUL1 - DO I = 1,NSYS_LINE ! Write out the system messages - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - WRITE(6,1060) '+'//INPUT(1:TRIM(INPUT)) - ELSE - PAGE = PAGE + 1 - WRITE(6,1060) ' '//INPUT(1:TRIM(INPUT)) - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER) - S1 = (80-13-LENF)/2 - S2 = 80-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages',CTRL_G - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages',CTRL_G - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD,INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP,FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP,FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST2(SET_FLAG,FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF - IF (COMPARE_BTIM(READ_BTIM,NEW_BTIM).NE.0) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (80-ILEN)/2 - S2 = 80 - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - ELSE - ILEN = 48 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (80-ILEN)/2 - S2 = 80 - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-48)// - & ' command can be used to read these messages.' - END IF - - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'),A1) -1027 FORMAT(/,' ',('*'),A,('*'),A1) -1028 FORMAT('+',('*'),A,('*'),A1) -1030 FORMAT(' ',80('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A54,1X,A12,1X,A6,1X,I4) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END diff --git a/decus/vax88b1/bulletin/bulletin1.for b/decus/vax88b1/bulletin/bulletin1.for deleted file mode 100644 index 7ab62fd..0000000 --- a/decus/vax88b1/bulletin/bulletin1.for +++ /dev/null @@ -1,1255 +0,0 @@ -C -C BULLETIN1.FOR, Version 7/13/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,'(A)') 'Description: '//DESCRIP ! Output bulletin header info - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'From: '//FROM//' Date: '//DATE//' (DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'From: '//FROM//' Date: '//DATE//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'From: '//FROM//' Date: '//DATE//' Permanent' - ELSE - INPUT = 'From: '//FROM//' Date: '//DATE//' '//DATE(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT - WRITE (3,*) - END IF - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - LEN_I = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN_I.GT.0) - CALL GET_BULL(I,INPUT,LEN_I) - IF (LEN_I.LT.0) THEN - GO TO 90 - ELSE IF (LEN_I.GT.0) THEN - WRITE (3,'(A)') INPUT(:LEN_I) - END IF - END DO - LEN_I = 80 - END DO - -90 CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_FILE(1) - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (MAIL_SUBJECT(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - MAIL_SUBJECT(I:I) = '`' - ELSE - MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - IER = CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER,LEN_P) - - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) - & //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,STATUS) - CALL ENABLE_PRIVS - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder owner.'')') - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_FILE(7) ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_FILE(7) - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - LOGICAL DELETE_ORIGINAL - - CHARACTER INPUT*128,SAVE_FOLDER*25 - - IF (CLI$PRESENT('ORIGINAL').AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IF (.NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_FILE(2) - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_FILE_SHARED(2) - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_FILE(2) - RETURN - END IF - - NUM_COPY = NBULL - BULL_POINT = 1 - END IF - - FROM_REMOTE = REMOTE_SET - - IF (REMOTE_SET) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.0) THEN - CALL OPEN_FILE(1) - I = BULL_POINT - 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THEN - IF (I.EQ.0) THEN - WRITE (12,IOSTAT=IER1) BULLDIR_HEADER - ELSE - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - END IF - NBLOCK = 1 - DO WHILE (I.LT.BULL_POINT+NUM_COPY-1.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THEN - BLOCK = NBLOCK - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - IF (IER1.EQ.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER1) 5,I - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - END IF - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - WRITE (11'NBLOCK,IOSTAT=IER1) INPUT - NBLOCK = NBLOCK + 1 - END DO - END IF - IF (IER1.NE.0) I = IER - END IF - END DO - NUM_COPY = I - BULL_POINT + 1 - END IF - CALL CLOSE_FILE(1) - IF (IER1.NE.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=11) - CLOSE (UNIT=12) - CALL CLOSE_FILE(2) - RETURN - END IF - END IF - - CALL CLOSE_FILE(2) - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IF - - IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - IF (IER.EQ.0) READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND. - & .NOT.SETPRV_PRIV().AND..NOT.ALL) THEN ! Permanent? - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.CLI$PRESENT('ORIGINAL')) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END DO - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - CLOSE (UNIT=11) - - CLOSE (UNIT=12) - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0) THEN - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_FILE(2) ! Totally finished with add - - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE - IF (MERGE) I = 0 - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT-SAVE_BULL_POINT - END IF - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - CALL DELETE - END IF - END IF - - RETURN - - END - - - - - SUBROUTINE PRINT -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*80 INPUT - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,1010) ! Write error - RETURN ! And return - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030) - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - END IF - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END DO - ILEN = 80 - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) ! Get queue name - IF (ILEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - ILEN = 9 - END IF - - CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_FILE(1) - WRITE(6,1000) - CALL SYS_GETMSG(IER) - - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT('Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A,/) - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*11,DATETIME*23 - - LOGICAL SINCE,PAGE - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - CALL OPEN_FILE_SHARED(2) - CALL READDIR_KEYGE(IER) - CALL CLOSE_FILE(2) - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - RETURN - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IF - - IF (.NOT.SINCE) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - CALL CLOSE_FILE(2) - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IF - - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2) - END IF - - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'CURR') THEN - IF (CLI$PRESENT('EDIT')) THEN - CALL READ_EDIT - RETURN - END IF - END IF - - FLEN = TRIM(FOLDER) - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header info - WRITE(6,1050) DESCRIP - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,1060) FROM,DATE//' '//TIME(:5),'(DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - WRITE(6,1060) FROM,DATE//' '//TIME(:5),'Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - WRITE(6,1060) FROM,DATE//' '//TIME(:5),'Permanent' - ELSE - WRITE(6,1060) FROM,DATE//' '//TIME(:5), - & 'Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - WRITE(6,'(''+ / System'',/)') - ELSE - WRITE(6,'(''+'',/)') - END IF -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - END = 4 ! Outputted 4 lines to screen - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - -100 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - IF (READ_COUNT.GT.BLOCK.AND.READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header info - END = END + 1 ! Increase display counter - END IF - CALL OPEN_FILE_SHARED(1) ! Get bulletin file - MORE_LINES = .TRUE. - READ_REC = READ_COUNT - IF (READ_ALREADY.EQ.0) ILEN = 81 - DO WHILE (MORE_LINES.AND.READ_REC.LE.BLOCK+LENGTH-1) - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - CALL GET_BULL(READ_REC,INPUT,ILEN) - IF (ILEN.LT.0) THEN ! Error, couldn't read record - READ_REC = BLOCK + LENGTH ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - READ_ALREADY = 1 - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - ILEN = 80 - IF (MORE_LINES) THEN - READ_REC = READ_REC + 1 - READ_ALREADY = 0 - END IF - END DO - - CALL CLOSE_FILE(1) ! End of bulletin file read - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) ! Get queue record - IF (I.EQ.1.AND.READ_REC.NE.BLOCK.AND.READIT.GT.0) THEN - WRITE(6,2020) INPUT(:TRIM(INPUT)) ! (See above comments) - ELSE - WRITE(6,2010) INPUT(:TRIM(INPUT)) - END IF - END DO - - READ_COUNT = READ_REC ! Update bull record counter - - IF (READ_REC.EQ.BLOCK+LENGTH) THEN ! Last block? - READ_COUNT = 0 ! init bulletin record counter - ELSE IF (READ_REC.EQ.BLOCK+LENGTH-1.AND..NOT.MORE_LINES) THEN - ! Possibly last block since end of page could be last line - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Else if this is not /READ - WRITE(6,1070) ! say there is more of bulletin - END IF - - RETURN - -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT('+Message number: ',I4,<60-FLEN>X,A) -1050 FORMAT(' Description: ',A53) -1060 FORMAT(' From: ',A12,' Date: ',A,' ',A,$) -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) -2010 FORMAT(1X,A) -2020 FORMAT('+',A) - - END - - - - - SUBROUTINE READ_EDIT - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*128 INPUT - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - - CALL OPEN_FILE_SHARED(1) - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - ILEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A,/) - - RETURN - END - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - CHARACTER INREAD*1,INPUT*80,FILE_DEF*80,NUMREAD*5 - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_FILE_SHARED(2) ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_FILE(2) - END IF - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',LEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:LEN-1)//'.BULL]' - LEN_FILE_DEF = LEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_FILE_SHARED(2) - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,ERR=18, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 18 - ELSE IF (ILEN.GT.0) THEN - WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END IF - END DO - ILEN = 80 - END DO - WRITE(6,1040) BULL_PARAMETER(:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_FILE_SHARED(2) ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_FILE(2) ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_FILE(2) - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message - & number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,80('-'),/,' Type Q(Quit), - & F(File it), D(Dir), R(Read msg #) or other for next message: ',$) -1030 FORMAT(1X,80('-'),/,' Type Q(Quit), F(File), N(Next), - & D(Dir), R(Read msg #) or other for MORE: ',$) -1040 FORMAT(' Message written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/) - - END diff --git a/decus/vax88b1/bulletin/bulletin2.for b/decus/vax88b1/bulletin/bulletin2.for deleted file mode 100644 index 295d3dd..0000000 --- a/decus/vax88b1/bulletin/bulletin2.for +++ /dev/null @@ -1,1374 +0,0 @@ -C -C BULLETIN2.FOR, Version 8/3/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_FILE(7) - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,' - & ('' ERROR: BBOARD account needs DISUSER flag set.'')') - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_FILE(7) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - IF (.NOT.IER1) THEN - WRITE (6,'('' WARNING: BBOARD account not in SYSUAF'', - & '' file. Assuming mail forwarding entry.'')') - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_FILE(4) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_FILE(4) - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_FILE(7) - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_FILE(7) - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE - CALL CLOSE_FILE(7) - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_FILE(7) - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - CHARACTER UPDATE*11,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_FILE(4) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - NEW_FLAG(1) = 152 - END IF - - IF (NEW_FLAG(1).NE.152) THEN - CALL CLOSE_FILE(7) - CALL OPEN_FILE(7) - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - NEW_FLAG(1) = 152 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_FILE(4) - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - IF (.NOT.FILE_OPENED) CALL CLOSE_FILE(4) - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,FOLDER_SAVE*25 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_FILE_SHARED(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_FILE(7) - RETURN - END IF - CALL CLOSE_FILE(7) - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for GENERAL folder.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - IF (.NOT.NODE_SET) THEN - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - FOLDER1 = FOLDER - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_FILE(2) ! Remove directory file - CALL OPEN_FILE(1) ! Remove bulletin file - CALL CLOSE_FILE_DELETE(1) - CALL CLOSE_FILE_DELETE(2) - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_FILE(7) - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_FILE_SHARED(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_FILE(7) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND(STATUS) -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - CHARACTER INPUT*80,FROM_TEST*5 - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_NEGATED - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - BULL_PARAMETER = 'RE: '//DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P) - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - LEN_P = TRIM(BULL_PARAMETER) - - IF (BULL_PARAMETER(:1).NE.'"') THEN - BULL_PARAMETER = '"'//BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + 1 - END IF - - IF (BULL_PARAMETER(LEN_P:LEN_P).NE.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'"' - LEN_P = LEN_P + 1 - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - ELSE - EDIT = .FALSE. - END IF - - IF (EDIT.AND.CLI$PRESENT('TEXT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:MIN(79,ILEN)) - IF (ILEN.EQ.80) WRITE (3,'(A)') '>'//INPUT(80:) - END IF - END IF - END DO - ILEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - END IF - - IF (CONFIRM_USER(FROM).EQ.0) THEN - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//FROM - & //'/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT '//FROM//'/SUBJECT='// - & BULL_PARAMETER,,,,,,STATUS) - END IF - CALL ENABLE_PRIVS - ELSE - FROM_TEST = ' ' - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - L_INPUT = 81 - I = BLOCK - DO WHILE (I.LT.BLOCK+LENGTH.AND.L_INPUT.GT.0) - CALL GET_BULL(I,INPUT,L_INPUT) - IF (L_INPUT.GT.0) THEN - CALL STR$UPCASE(FROM_TEST,INPUT(:5)) - IF (FROM_TEST.EQ.'FROM:') THEN - IF (INDEX(INPUT,'.').GT.0.OR.INDEX(INPUT,'@').GT.0 - & .OR.INDEX(INPUT,'%').GT.0) THEN - L_INPUT = 0 - END IF - END IF - ELSE IF (L_INPUT.EQ.0) THEN - L_INPUT = 80 - I = I + 1 - END IF - END DO - CALL CLOSE_FILE(1) - IF (FROM_TEST.EQ.'FROM:') THEN - L_B = INDEX(INPUT,'<') - R_B = INDEX(INPUT,'>') - IF (L_B.GT.0.AND.R_B.GT.0) THEN - INPUT = INPUT(L_B+1:R_B-1) - L_INPUT = R_B - 1 - L_B - ELSE - L_INPUT = TRIM(INPUT) - I = 6 - DO WHILE (INPUT(I:I).EQ.' '.AND.I.GT.0) - I = I + 1 - IF (I.GT.L_INPUT) I = 0 - END DO - INPUT = INPUT(I:L_INPUT) - L_INPUT = L_INPUT - I + 1 - END IF - CALL DISABLE_PRIVS -C -C The commented lines contain modifications to interace with PMDF -C using the in% syntax - Jim Gerland 29-Dec-1987 -C -C K = INDEX (Input, '%') -C If (K .GT. 0) Then -C Input = Input (K+1:L_Input) -C L_Input = l_Input - K -C End If -C - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') -C -C For PMDF, uncomment the following lines and deleted the 3 lines -C in the actual code. -C -C CALL LIB$SPAWN ('$MAIL SYS$LOGIN:BULL.SCR "IN%"' -C & //INPUT(:L_INPUT)// -C & '""/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) -C - CALL LIB$SPAWN('$CHMAIL SYS$LOGIN:BULL.SCR "' - & //INPUT(:L_INPUT)// - & '@XX"/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSE -C -C For PMDF, uncomment the following lines and deleted the 2 lines -C in the actual code. -C -C CALL LIB$SPAWN ('$MAIL SYS$INPUT "IN%"' -C & //INPUT(:L_INPUT)// -C & '""/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) -C - CALL LIB$SPAWN('$CHMAIL/I "'//INPUT(:L_INPUT)// - & '@XX"/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - END IF - CALL ENABLE_PRIVS - ELSE - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//FROM - & //'/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT '//FROM//'/SUBJECT=' - & //BULL_PARAMETER,,,,,,STATUS) - END IF - CALL ENABLE_PRIVS - END IF - END IF - - IF (EDIT) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_FILE_SHARED(8) - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_FILE(8) - - RETURN - END - - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: Replaces existing bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER INDESCRIP*80,INPUT*80 - CHARACTER*1 ANSWER - - CHARACTER DATE_SAVE*11,TIME_SAVE*11 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL*1 DOALL - -C -C Get the bulletin number to be replaced. -C - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are reading - ELSE - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletin - - CALL CLOSE_FILE(2) - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person - RETURN ! and error out - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND. - & USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - -8 IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) DESLEN,INDESCRIP - IF (DESLEN.EQ.0) GO TO 910 ! If no header, don't add bull - IF (DESLEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - GO TO 8 ! and re-request header - END IF - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,DESLEN) - IF (DESLEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - GO TO 910 ! and abort - END IF - END IF - - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy mesage into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 5 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - ILEN = 80 - END DO -5 CALL CLOSE_FILE(1) - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.80) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED', - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = 80 ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.80) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > 80. Reinput::'')') - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_FILE(2) - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.CLI$PRESENT('TEXT')) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN ! If text has been replaced - - LENGTH_SAVE = LENGTH ! Copy BULL modifies LENGTH - - CALL OPEN_FILE(1) ! Prepare to add bulletin - ICOUNT = (ICOUNT+127)/128 - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - NBLOCK = NBLOCK + ICOUNT - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL COPY_BULL(3,REC1,BLOCK,IER) ! Replace old bulletin - - CALL CLOSE_FILE(1) - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = ICOUNT ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (CLI$PRESENT('HEADER').OR.CLI$PRESENT('SUBJECT') - & .OR.DOALL) THEN - DESCRIP=INDESCRIP(:53) ! Update description header - END IF - CALL UPDATE_DIR_HEADER(CLI$PRESENT('EXPIRATION').OR.DOALL, - & CLI$PRESENT('PERMANENT'),CLI$PRESENT('SHUTDOWN'), - & INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT')) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (.NOT.CLI$PRESENT('HEADER').AND..NOT. - & CLI$PRESENT('SUBJECT').AND..NOT.DOALL) INDESCRIP = DESCRIP - IF (CLI$PRESENT('EXPIRATION')) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(:53),MSGTYPE,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - - CALL CLOSE_FILE(2) ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would be - & truncated to:') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER TODAY*23,INEXDATE*11,INEXTIME*11 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUT - - CHARACTER*132 SEARCH_STRING,SAVE_STRING - DATA SEARCH_STRING /' '/, SEARCH_LEN /1/ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL DISABLE_CTRL - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_POINT - BULL_POINT = BULL_POINT - 1 - END IF - - SAVE_STRING = SEARCH_STRING - SAVE_LEN = SEARCH_LEN - - IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - - IF (.NOT.IER) THEN ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - SEARCH_LEN = SAVE_LEN - ELSE IF (.NOT.CLI$PRESENT('START')) THEN ! If string entered but no - BULL_POINT = 0 ! starting message, use first - END IF - - IF (IER) SUBJECT = CLI$PRESENT('SUBJECT') - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(0,IER) - - IF (BULL_POINT+1.GT.NBULL) THEN - WRITE (6,'('' ERROR: No more messages.'')') - CALL CLOSE_FILE(2) - CALL ENABLE_CTRL - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) - - CALL DECLARE_CTRLC_AST - - DO BULL_SEARCH = BULL_POINT+1, NBULL - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1) THEN - CALL STR$UPCASE(DESCRIP,DESCRIP) ! Make upper case - IF (INDEX(DESCRIP,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND..NOT.SUBJECT) THEN - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = 81 - DO J=BLOCK,BLOCK+LENGTH-1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL(J,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - CALL ENABLE_CTRL - RETURN - END IF - END DO - ILEN = 80 - END DO - END IF - END DO - -900 CALL CANCEL_CTRLC_AST - - CALL CLOSE_FILE(1) ! End of bulletin file read - CALL CLOSE_FILE(2) - - CALL ENABLE_CTRL - - WRITE (6,'('' No messages found with given search string.'')') - - RETURN - END - - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_FILE(2) - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')') - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_FILE(2) - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END diff --git a/decus/vax88b1/bulletin/bulletin3.for b/decus/vax88b1/bulletin/bulletin3.for deleted file mode 100644 index 81ea56c..0000000 --- a/decus/vax88b1/bulletin/bulletin3.for +++ /dev/null @@ -1,1505 +0,0 @@ -C -C BULLETIN3.FOR, Version 8/12/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*11 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF (SYSTEM.LE.3.OR.(OLD_SHUTDOWN.EQ.0! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - EXTIME(3:4) = EXTIME(4:5) - READ (EXTIME(1:4),'(I4)') NODE_NUMBER_MSG - EXTIME(9:10) = EXTIME(10:11) - READ (EXTIME(7:10),'(I4)') NODE_AREA_MSG - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - END IF - ELSE - DIFF = 1 - END IF - IF (DIFF.EQ.1) NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF (SYSTEM.LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - CALL CLOSE_FILE(4) - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_FILE_SHARED(2) ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_FILE(2) - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_FILE(2) - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(INPUT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*23 INPUT - CHARACTER*23 TODAY - - DIMENSION EXTIME(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',INPUT,ILEN) - - PROMPT = .TRUE. - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - WRITE(6,1030) TODAY ! Prompt for expiration date - CALL GET_LINE(INPUT,ILEN) ! Get input line - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - INPUT = INPUT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(INPUT,'-').EQ.0.AND.INDEX(INPUT,':').GT.0.AND. - & INDEX(INPUT(:ILEN),' ').EQ.0) THEN - INPUT = TODAY(:INDEX(TODAY(2:),' ')+1)//INPUT - END IF - - CALL STR$UPCASE(INPUT,INPUT) ! Convert to upper case - IER = SYS_BINTIM(INPUT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - GO TO 5 - END IF - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - END IF - - IF (INPUT(2:2).EQ.'-') INPUT = '0'//INPUT - IER = COMPARE_DATE(INPUT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limit - GO TO 5 - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(INPUT(13:),TODAY(13:)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - GO TO 5 ! and re-request date - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A23, - &'. Specify when the message should expire:',/,1x, - &'Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - &'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large. - & Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - IF (IER.NE.SS$_NORMAL) MAIL_EDIT = 'SYS$SYSTEM:MAILEDIT' - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - CALL DISABLE_PRIVS - IF (OUT.EQ.INFILE) THEN - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT))) - ELSE - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - END IF - CALL ENABLE_PRIVS - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0) THEN - CALL EDT$EDIT(INFILE,OUT) - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN - CALL TPU$EDIT(INFILE,OUT) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - ! TPU does CLI$ stuff which wipes our parsed command line - END IF - - RETURN - END - - - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($JPIDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15 - - DIMENSION SAVEPRIV(2) - - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' ERROR: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP cannot be created.'')') - CALL EXIT - END IF - - CALL DISABLE_PRIVS ! Just let real privileged people do a /STARTUP - - CALL SYS$SETPRV(%VAL(1),PROCPRIV,,SAVEPRIV) ! Enable original priv - - JUST_STOP = CLI$PRESENT('STOP') - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXIT - END IF - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1 - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP') - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0)) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM','NL:' - & ,,,,'BULLCP',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - CALL SYS$SETPRV(%VAL(0),SAVEPRIV,,) ! Reset privs - - CALL ENABLE_PRIVS - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*1 DUMMY - - IER = SYS_TRNLNM('BULL_BULLCP',DUMMY) - IF (IER) BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - CHARACTER*23 OLD_TIME,NEW_TIME - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL START_DECNET - - DO WHILE (1) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connectiosn - CALL SYS$SETAST(%VAL(1)) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Do empty block - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - OLD_TIME = NEW_TIME - CALL WAIT('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL REGISTER_BULLCP - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_FILE(4) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - END IF - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_FILE(4) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - - - - SUBROUTINE WAIT(PARAM) -C -C SUBROUTINE WAIT -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(6:7) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(2)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(9:10) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - - SUBROUTINE DELETE_EXPIRED - -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER UPTIME_DATE*11,UPTIME_TIME*11 - - CALL OPEN_FILE_SHARED(2) ! Open directory file - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - CALL CLOSE_FILE(1) - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_FILE(4) ! Create user file to be able to set - CALL CLOSE_FILE(4) ! defaults, privileges, etc. - END IF - CALL CLOSE_FILE(2) - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*74,INFROM*74,INTO*76,INPUT*132 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_FILE(7) ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD.EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=110) - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - LEN_INPUT = 1 - DO WHILE (LEN_INPUT.GT.0) - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - IF (INDEX(INTO,FOLDER_BBOARD(:FLEN)).EQ.0.AND. - & INTO.NE.FOLDER_BBOARD.AND.INDEX(INTO,'@').EQ.0) THEN - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOLDER1_BBOARD = FOLDER_BBOARD - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - FOLDER_Q2_SAVE = FOLDER_Q2 - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - FLEN = TRIM(FOLDER1_BBOARD) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD.NE.'NONE') THEN - IF (INTO.EQ.FOLDER1_BBOARD) THEN - FOUND = .TRUE. - ELSE - FIND_TO = INDEX(INTO,FOLDER1_BBOARD(:FLEN)) - IF (FIND_TO.GT.0) THEN - END_TO = FLEN+FIND_TO - IF (TRIM(INTO).LT.END_TO.OR. - & INTO(END_TO:END_TO).LT.'A'.OR. - & INTO(END_TO:END_TO).GT.'Z') THEN - IF (FIND_TO.EQ.1) THEN - FOUND = .TRUE. - ELSE IF (INTO(FIND_TO-1:FIND_TO-1).LT.'A'.OR. - & INTO(FIND_TO-1:FIND_TO-1).GT.'Z') THEN - FOUND = .TRUE. - END IF - END IF - END IF - END IF - END IF - END DO - IF (FOUND) THEN - IF (F_NBULL.NE.NBULL) CALL UPDATE_FOLDER - FOLDER_COM = FOLDER1_COM - FOLDER_Q_SAVE = FOLDER_Q2_SAVE - END IF - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - FOLDER_SET = .FALSE. - ELSE - FOLDER_SET = .TRUE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - -C -C Add bulletin to bulletin file and directory entry to directory file. -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry - - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - IF (IER.NE.0) GO TO 100 ! If end of file, exit - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) GO TO 5 - ! If line is just form feed, the message is empty - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - OCOUNT = NBLOCK + 1 ! Initialize line count - - SPACE = INDEX(INFROM,' ') - 1 ! Strip off the date - IF (SPACE.GT.0) INFROM = INFROM(:SPACE)! From the "From:" line - - IF (TRIM(INFROM).GT.12) THEN ! Is length > allowable? - LEN_INFROM = TRIM(INFROM) - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & OCOUNT) - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) - I = 12 ! Trim username to first non-alpha character - DO WHILE (I.GT.1.AND. - & ((INFROM(I:I).GE.'A'.AND.INFROM(I:I).LE.'Z').OR. - & (INFROM(I:I).GE.'a'.AND.INFROM(I:I).LE.'z')) ) - I = I - 1 - END DO - IF (I.GT.1) INFROM = INFROM(:I-1) - END IF - - LEN_DESCRP = TRIM(INDESCRIP) - IF (LEN_DESCRP.GT.53) THEN ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//INDESCRIP(:LEN_DESCRP), - & OCOUNT) - INDESCRIP = INDESCRIP(:LEN_DESCRP) - DO I=1,LEN_DESCRP - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - ELSE - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - END IF - - ISTART = 0 - NBLANK = 0 - DO WHILE (INPUT(:1).NE.CHAR(12)) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - NBLANK = 0 - CALL STORE_BULL(MIN(LEN_INPUT,80),INPUT,OCOUNT) - IF (LEN_INPUT.GT.80) THEN ! Breakup line if > 80 chars - CALL STORE_BULL(MIN(LEN_INPUT,132)-80,INPUT(81:),OCOUNT) - END IF - END IF - READ (3,'(Q,A)',END=25) LEN_INPUT,INPUT - END DO - -25 CALL FLUSH_BULL(OCOUNT) - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - DESCRIP = INDESCRIP(:53) ! Description header - FROM = INFROM(:12) ! Username - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - EXTIME = '00:00:00.00' - LENGTH = OCOUNT - NBLOCK ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - -30 CALL CLOSE_FILE(2) ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CALL UPDATE_FOLDER - -110 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GOTO 1 - -900 FOLDER_NUMBER = 0 - - CALL OPEN_FILE_SHARED(7) - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_FILE(7) - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_FILE(4) - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_FILE(4) - END IF - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - WRITE (6,1030) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL EXE$GL_ABSTIM - INTEGER UPTIME(2),SYSTIME(2),UPSINCE(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - UPTIME(1) = GET_L_VAL(EXE$GL_ABSTIM) ! Up time (sec) - - CALL LIB$EMUL(10000000,UPTIME,0,UPTIME) ! 64 bit format - CALL SYS$GETTIM(SYSTIME) - CALL LIB$SUBX(SYSTIME,UPTIME,UPSINCE) - CALL SYS$ASCTIM(,ASCSINCE,UPSINCE,) ! Up since - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:) - - RETURN - END - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*37,FILENAME*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - OFFSET = 36 - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='VMSMAIL', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - OFFSET = 34 - END IF - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::') THEN - ! If normal BBOARD or /VMSMAIL - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - CALL LIB$MOVC3(2,%REF(INPUT(OFFSET:)),COUNT) - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END diff --git a/decus/vax88b1/bulletin/bulletin4.for b/decus/vax88b1/bulletin/bulletin4.for deleted file mode 100644 index 9b087a9..0000000 --- a/decus/vax88b1/bulletin/bulletin4.for +++ /dev/null @@ -1,1491 +0,0 @@ -C -C BULLETIN4.FOR, Version 8/3/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist -C if it creates empty space for new user. -C - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CALL OPEN_FILE_SHARED(8) - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_FILE(9) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_FILE(9) - END IF - - CALL CLOSE_FILE(8) ! All done... - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - CHARACTER INPUT*80 - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),80) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*(BRECLEN) - - DATA POINT/0/ - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT) - POINT = 0 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,INPUT,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128,LINE_LENGTH=80 - - CHARACTER INPUT*(*),TEMP*(BRECLEN), LEFT*(BRECLEN) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (ILEN.GT.LINE_LENGTH) THEN - POINT = 1 - LEFT_LEN = 0 - END IF - - IF (POINT.EQ.1) THEN - IF (REMOTE_SET) THEN - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) - ELSE - DO WHILE (REC_LOCK(IER)) - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN - ILEN = 0 - POINT = 1 - RETURN - END IF - - IF (IER.GT.0) THEN - ILEN = -1 - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN - ILEN = ICHAR(LEFT(:1)) - INPUT = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) - POINT = LEFT_LEN + 1 - LEFT_LEN = 0 - ELSE - ILEN = ICHAR(TEMP(POINT:POINT)) - IF (ILEN.GT.BRECLEN-POINT) THEN - LEFT = TEMP(POINT:) - LEFT_LEN = ILEN - (BRECLEN-POINT) - ILEN = 0 - POINT = 1 - ELSE IF (ILEN.EQ.0) THEN - POINT = 1 - ELSE - INPUT = TEMP(POINT+1:POINT+ILEN) - POINT = POINT+ILEN+1 - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(ILEN) - - IF (POINT.EQ.BRECLEN+1) THEN - ILEN = 0 - ELSE - ILEN = ICHAR(TEMP(POINT:POINT)) - END IF - - RETURN - - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*128 INPUT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) THEN - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*80 INPUT - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - IF (BTEST(FOLDER_FLAG,1)) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - WRITE (3,1050) DESCRIP ! Output bulletin header info - WRITE (3,1060) FROM,DATE - - CALL OPEN_FILE(1) - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - ILEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - END IF - -900 CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - CALL WRITEDIR(0,IER) - -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/) - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limit - POINTER = 0 ! during input. - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10)) - & .OR.INCHAR(I:I).GT.'~') INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGLEN(PAGE_LENGTH) -C -C SUBROUTINE GETPAGLEN -C -C FUNCTION: -C Gets page length of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = DEVDEPEND(4) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($PRVDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_FILE(4) - CALL OPEN_FILE(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*8 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,LEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:LEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_FILE(4) ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN - - END - - - - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privileged - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'( - & '' ERROR: No privs for SYSTEM, NOTIFY, BRIEF or READNEW.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - FOLDER1 = FOLDER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - LENDES = 0 - END IF - END DO - - CALL OPEN_FILE(7) ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_FILE(7) - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_FILE(7) - RETURN - ELSE - FOLDER_OWNER = FOLDER1_OWNER - END IF - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - REMOTE_SET = .TRUE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_OWNER = FOLDER1_OWNER - - IF (CLI$PRESENT('SYSTEM')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_FILE(7) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - diff --git a/decus/vax88b1/bulletin/bulletin5.for b/decus/vax88b1/bulletin/bulletin5.for deleted file mode 100644 index 7947f68..0000000 --- a/decus/vax88b1/bulletin/bulletin5.for +++ /dev/null @@ -1,1464 +0,0 @@ -C -C BULLETIN5.FOR, Version 8/8/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (.NOT.SETPRV_PRIV().AND.INCMD(:3).EQ.'SET') THEN - WRITE (6,'( - & '' ERROR: No privs to change all defaults.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_HEADER(IER) - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - - IF (BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - CALL CLOSE_FILE(4) - - RETURN - END - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL OPEN_FILE(2) ! Remove directory file - CALL OPEN_FILE(1) ! Remove bulletin file - CALL CLOSE_FILE_DELETE(1) - CALL CLOSE_FILE_DELETE(2) - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) FOLDER_SET = .FALSE. - -1000 CALL CLOSE_FILE(7) - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - EXTERNAL CLI$_ABSENT - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1) - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - CALL OPEN_FILE_SHARED(7) ! Go find folder - - REMOTE_TEST = 0 - - IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP - END IF - - CALL CLOSE_FILE(7) - - IF (IER.EQ.0.AND.FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to connect to folder.'')') - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Copy remote folder protection - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - ELSE - LOCAL_FOLDER1_FLAG = IBCLR(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - CALL OPEN_FILE(7) ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE - CALL CLOSE_FILE(7) - END IF - REMOTE_SET = .TRUE. - END IF - - IF (IER.EQ.0) THEN ! Folder found - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::' - & .AND..NOT.SETPRV_PRIV()) THEN - ! Is folder protected and not remote? - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER) THEN - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_FILE(4) - END IF - IER = 0 - RETURN - END IF - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (FOLDER1_BBOARD(:2).NE.'::') THEN - IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - END IF - - IF (IER) THEN - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0) THEN - IF (TEST_BULLCP()) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_FILE(2) - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (FOLDER_NUMBER.NE.0) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - RETURN - - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - - DIMENSION DUMMY(2) - - REMOTE_UNIT = 31 - REMOTE_UNIT - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD)) - & //'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_FILE(4) - END IF - END IF - IER = 2 - ELSE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - CLOSE (UNIT=31-REMOTE_UNIT) - IF ((FOLDER_NUMBER.NE.FOLDER1_NUMBER.AND.(DUMMY(1).NE.0 - & .OR.DUMMY(2).NE.0)).OR.FOLDER1_NUMBER.EQ.-1) THEN - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - END IF - IER = 0 - END IF - - RETURN - END - - - - - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_FILE_SHARED(7) ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_FILE(7) - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & FOLDER1 = FOLDER - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(7) ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_FILE(7) - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Folder is a private folder.'')') - ELSE - WRITE (6,'('' Folder is not a private folder.'')') - END IF - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' BBOARD expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE - WRITE (6,'('' BBOARD messages will not expire.'')') - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_HEADER(IER) - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is BRIEF.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is SHOWNEW.'')') - ELSE - WRITE (6,'('' Default is NOREADNEW.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY.'')') - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_FILE(4) - END IF - END IF - - CALL CLOSE_FILE(7) - - RETURN - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - CHARACTER*17 DATETIME - - EXTERNAL CLI$_NEGATED,CLI$_PRESENT - - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE specified - ELSE - NLINE = 1 - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDER = 0 - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - END IF - END DO - - CALL CLOSE_FILE(7) ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - - IF (.NOT.PAGING) THEN - DISPLAY = (NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2 - ELSE - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2,PAGE_LENGTH-4) - ! If more entries than page size, truncate output - END IF - - DO I=FOLDER_COUNT,FOLDER_COUNT+(DISPLAY-2)/NLINE-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counter - END DO - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*25,RESPONSE*1 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',ID,LEN) ! Get ID - IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: ID name must be < 26 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_FILE(7) - - IF ((.NOT.ALL).AND.(ID.EQ.FOLDER1_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Cannot modify access for owner of folder.'')') - RETURN - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - IF (ACCESS) THEN - IF (.NOT.ALL) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL DEL_ACL(' ','R+W',IER) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - END IF - ELSE - IF (ALL) THEN - CALL DEL_ACL('*','R',IER) - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' ERROR: Cannot modify ACL of folder files.'')') - CALL SYS_GETMSG(IER) - ELSE - WRITE (6,'('' Access to folder has been modified.'')') -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - CALL OPEN_FILE(7) ! Open folder file - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_FILE(7) - END IF - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C -C NOTE: SYS$CHECK_ACCESS is only available under V4.4 or later. -C If you have an earlier version, comment out the lines which call -C it and set both READ_ACCESS and WRITE_ACCESS to 1, which will -C allow program to run, but will not allow READONLY access feature. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - ENTRY WRITE_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE - - REWRITE (7) FOLDER_COM - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP - - REWRITE (7) FOLDER1_COM - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END DO - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - SET_FLAG(1) = SET_FLAG_DEF(1) - SET_FLAG(2) = SET_FLAG_DEF(2) - BRIEF_FLAG(1) = BRIEF_FLAG_DEF(1) - BRIEF_FLAG(2) = BRIEF_FLAG_DEF(2) - NOTIFY_FLAG(1) = NOTIFY_FLAG_DEF(1) - NOTIFY_FLAG(2) = NOTIFY_FLAG_DEF(2) - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_FILE_SHARED(4) - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_FILE_SHARED(4) - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).EQ.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. Added per request of a faculty member for his private -C board. Changes to BULLETIN.FOR should be fairly obvious. -C -C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2) -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - DATA FOLDER_Q1/0/ - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END DO - - CALL CLOSE_FILE(7) ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - WRITE (6,1000) - WRITE (6,1020) - DO J = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - WRITE (6,1030) FOLDER1(:15),F1_NBULL, - & FOLDER1_DESCRIP(:MIN(TRIM(FOLDER1_DESCRIP),60)) - END DO - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - IF (DIR_COUNT.EQ.0) THEN - F1_NBULL = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - CALL DIRECTORY(DIR_COUNT) - - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1020 FORMAT (' Name Count Description'/) -1030 FORMAT (1X,A15,I4,1X,A) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') - - END diff --git a/decus/vax88b1/bulletin/bulletin6.for b/decus/vax88b1/bulletin/bulletin6.for deleted file mode 100644 index df68363..0000000 --- a/decus/vax88b1/bulletin/bulletin6.for +++ /dev/null @@ -1,1387 +0,0 @@ -C -C BULLETIN6.FOR, Version 8/31/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE(INPUT) -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C -C INPUT: -C INPUT - Unit number of file to close out. -C 1 = BULLETIN.DAT -C 2 = BULLDIR.DAT -C 4 = BULLUSER.DAT -C 7 = BULLFOLDER.DAT -C 8 = SYS$SYSTEM:SYSUAF.DAT -C - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT) - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE(INPUT) - - IMPLICIT INTEGER (A-Z) - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT,STATUS='DELETE') - - RETURN - END - - - SUBROUTINE OPEN_FILE(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (INPUT.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL BULLDIR_ERR - END DO - DIR_NUM = -1 - END IF - - IF (INPUT.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL BULLETIN_ERR - END DO - END IF - - IF (INPUT.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL BULLUSER_ERR - END DO - END IF - - IF (INPUT.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL BULLFOLDER_ERR - END DO - END IF - - IF (INPUT.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL BULLINF_ERR - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - ENDI F - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - RETURN - END - - SUBROUTINE TIMER_ERR - - IMPLICIT INTEGER (A-Z) - - ENTRY BULLDIR_ERR - WRITE(6,'('' ERROR: Unable to open directory file after 30 secs.'')') - GO TO 10 - - ENTRY BULLETIN_ERR - WRITE(6,'('' ERROR: Unable to open message file after 30 secs.'')') - GO TO 10 - - ENTRY BULLUSER_ERR - WRITE(6,'('' ERROR: Unable to open BULLUSER.DAT after 30 secs.'')') - GO TO 10 - - ENTRY BULLFOLDER_ERR - WRITE(6,'('' ERROR: Unable to open BULLFOLDER.DAT after 30 secs.'')') - GO TO 10 - - ENTRY BULLINF_ERR - WRITE(6,'('' ERROR: Unable to open BULLINF.DAT after 30 secs.'')') - GO TO 10 - -10 CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT - - CHARACTER*25 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (INPUT.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (INPUT.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_POINT - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (INPUT.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (INPUT.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (INPUT.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - - IF (IER.EQ.0) THEN - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.FOLDER_RECORD/4) THEN - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(ASK_SIZE) - NTRIES = 0 - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (INPUT.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (INPUT.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.INPUT.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - CALL OPEN_FILE(INPUT) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE_SHARE, unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - ENDI F - CALL ENABLE_CTRL_EXIT - END IF - - RETURN - END - - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER INPUT*115 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) INPUT - - CALL LIB$MOVC3(4,%REF(INPUT(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(INPUT(1:11)//' '//INPUT(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(INPUT(20:30)//' '//INPUT(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = INPUT(39:) - CALL SYS_BINTIM(INPUT(51:61)//' '//INPUT(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = INPUT(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) INPUT - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = INPUT(1:) - FROM = INPUT(54:) - BULLDIR_ENTRY(78:81) = INPUT(85:) - BULLDIR_ENTRY(90:97) = INPUT(108:) - CALL SYS_BINTIM(INPUT(89:99)//' '//INPUT(100:107),EX_BTIM) - CALL SYS_BINTIM(INPUT(66:76)//' '//INPUT(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 INPUT - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 INPUT,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_FILE(2) - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - - CALL OPEN_FILE(7) - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_FILE(2) - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') INPUT - ILEN = TRIM(INPUT) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,INPUT,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_FILE(2) - GOTO 100 - -200 CALL OPEN_FILE_SHARED(2) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(ASK_SIZE) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - CHARACTER*80 NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - - EODIR = MAX(INDEX(BULLFOLDER_FILE,':'),INDEX(BULLFOLDER_FILE,']')) - SUFFIX = INDEX(BULLFOLDER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLFOLDER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLFOLDER_FILE,NEW_FILE) - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=9,FILE=BULLFOLDER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.173/4) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - IF (IER.EQ.0) THEN - WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - CALL OPEN_FILE_SHARED(2) - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM - CALL CLOSE_FILE(2) - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=9,STATUS='SAVE') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLFOLDER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*2 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - DIR_NUM = 0 - END IF - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,0 - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_HEADER_FROMBIN - RETURN - END IF - END IF - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) - CALL CLEANUP_DIRFILE(1) - END IF - IF (NEMPTY.EQ.' ') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I2)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (MSG_NUM.NE.ICOUNT) IER = 36 - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) BULLDIR_ENTRY - END IF - END DO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - DIR_NUM = -1 - END IF - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - END IF - END IF - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - UNLOCK 2 - - RETURN - - END - - - - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If not 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) BULLDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - IER = 0 - DIR_NUM = -1 - END IF - UNLOCK 2 - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - IER = MSG_NUM - CALL CONVERT_ENTRY_FROMBIN - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME - NEWEST_EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME - NEWEST_TIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME - SHUTDOWN_TIME = DATETIME(13:) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME - EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME - TIME = DATETIME(13:) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - INCLUDE 'BULLDIR.INC' - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - ELSE - IF (CONV) CALL CONVERT_ENTRY_TOBIN - MSG_NUM = BULLETIN_NUM - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - - RETURN - END - - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*) - CHARACTER NOT_ID*3 - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - DO ACCESS_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - IF ((ACCESS_TYPE.EQ.1.AND.INDEX(ACLSTR,'WRITE').GT.0).OR. - & (ACCESS_TYPE.EQ.2.AND.INDEX(ACLSTR,'READ)').GT.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - DO WHILE - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0) - START_ID = START_ID - 1 - END DO - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (ACCESS_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLFOLDER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = RECL/8 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - diff --git a/decus/vax88b1/bulletin/bulletin7.for b/decus/vax88b1/bulletin/bulletin7.for deleted file mode 100644 index bfe3933..0000000 --- a/decus/vax88b1/bulletin/bulletin7.for +++ /dev/null @@ -1,1609 +0,0 @@ -C -C BULLETIN7.FOR, Version 8/30/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - INCLUDE '($SSDEF)' - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - CHARACTER OUTPUT*160,TERMINAL*8 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_FILE_SHARED(4) - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_FILE(4) - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -C -C Set flags in all user entries that have SET READNEW on the particular -C folder to indicate that a new bulletin is present for the particular folder. -C Also send broadcast if notify flag set. -C - OUTPUT = BELL//CR//LF//LF//'New bulletin added to folder '// - & FOLDER(1:TRIM(FOLDER))//'. From: '//FROM(1:TRIM(FROM))// - & CR//LF//'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IF (ADD_BULL) THEN - IF (FOLDER_NUMBER.GT.0) THEN - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - END IF - - IF (ADD_BULL) THEN - IER = 1 - DO WHILE (GETUSERS(TEMP_USER,TERMINAL)) - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TERMINAL(:TRIM(TERMINAL)),%VAL(BRK$C_DEVICE),,,,,,,) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - END DO - END IF - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_FILE(4) - - RETURN - - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(1:11) - NEWEST_TIME = TODAY_TIME(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00.00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*3600 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*11 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.PROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - CHARACTER*23 TODAY - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_FILE_SHARED(7) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_FILE(7) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_FILE_SHARED(4) ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS$ASCTIM(,TODAY,,) - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - CHARACTER*23 TODAY - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_FILE_SHARED(4) ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -C -C SUBROUTINE CONFIRM_PRIV -C -C FUNCTION: Confirms that given username has SETPRV. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C ALLOW - Returns 1 if account has SETPRV. -C returns 0 if account has no SETPRV. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INCLUDE '($PRVDEF)' - - INCLUDE '($UAIDEF)' - - INTEGER DEF_PRIV(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_DEF_PRIV,%LOC(DEF_PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - ALLOW = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(DEF_PRIV(1),PRV$V_SETPRV).OR. ! SETPRV or CMRKNL - & BTEST(DEF_PRIV(1),PRV$V_CMKRNL)) THEN ! privileges? - ALLOW = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - - - SUBROUTINE CHECK_DISMAIL(USERNAME,DISMAIL) -C -C SUBROUTINE CHECK_DISMAIL -C -C FUNCTION: Checks that given username has DISMAIL. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - - RETURN - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - CALL UPDATE_USERINFO - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FILENAME*132,INPUT*128 - - CALL OPEN_FILE_SHARED(2) - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_FILE(2) - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - OPEN (UNIT=11, - 1 FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - IF (IER.NE.0) THEN - CALL CLOSE_FILE(2) - RETURN - END IF - END IF - - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) INPUT - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) INPUT - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_FILE(1) - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_FILE_DELETE(2) - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CLOSE (UNIT=11) - CALL CLOSE_FILE(2) - RETURN - END IF - END IF - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - NBLOCK = NBLOCK + LENGTH - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_FILE_DELETE(2) - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*11 DATE_SAVE,EXDATE_SAVE - CHARACTER*11 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - BLOCK_SAVE = BLOCK - K = J + 1 ! Search for duplicate entries - DO WHILE (MOVE_FROM.EQ.0.AND.K.LE.NBULL) - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO=J+1 - MOVE_FROM=K+1 - ELSE - K = K + 1 - END IF - END IF - END DO - J = J + 1 ! If no duplicate entry found for this - CALL READDIR(J,IER) ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - CALL READDIR(FIRST_DELETE,IER) - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - - CALL OPEN_FILE_SHARED(4) ! Open user file - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - WRITE (6,'('' For the selected folder '',A)') FOLDER(1:TRIM(FOLDER)) - - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - END IF - - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND. - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (.NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - CALL CLOSE_FILE(4) - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) USERNAME,TERMINAL - - DATA WILDCARD /-1/ - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) WILDCARD = -1 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ - DATA USERINFO_READ /.FALSE./ - - CALL OPEN_FILE_SHARED(9) - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_FILE(4) - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - IF (IER.EQ.0) WRITE (9) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - - CALL CLOSE_FILE(9) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - COMMON /USERINFO/ USERINFO_READ - - INCLUDE 'BULLUSER.INC' - - IF (.NOT.USERINFO_READ) RETURN - - CALL OPEN_FILE_SHARED(9) - - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - CALL CLOSE_FILE(9) - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - IF (TRIM(TIME).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - DIMENSION LOGIN_BTIM_SAVE(2) - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ ! Update login time - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_FILE_SHARED(7) ! Go find folders - - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE - END IF - IF (IER.NE.0) THEN - CALL CHANGE_FLAG_NOCMD(0,2) - CALL CHANGE_FLAG_NOCMD(0,3) - CALL CHANGE_FLAG_NOCMD(0,4) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = 0 - CALL MODIFY_SYSTEM_LIST(0) - END IF - ELSE IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - END IF - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END DO - - CALL CLOSE_FILE(7) - - FOLDER_Q = FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - IF (TEST2(NEW_MSG,0)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - DO FOLDER_NUMBER = 1,FOLDER_MAX-1 - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - END IF - END IF - END DO - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new general messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (FOLDER_NUMBER.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE IF (FOLDER_NUMBER.EQ.0.OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - ELSE ! Can't select the folder - CALL CHANGE_FLAG_NOCMD(0,2) ! then clear SET_FLAG - CALL CHANGE_FLAG_NOCMD(0,3) - END IF - END IF - END DO - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = -1 - FOLDER1 = 'GENERAL' - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to GENERAL folder.'')') - - RETURN - END diff --git a/decus/vax88b1/bulletin/bulletin8.for b/decus/vax88b1/bulletin/bulletin8.for deleted file mode 100644 index e5a1cf6..0000000 --- a/decus/vax88b1/bulletin/bulletin8.for +++ /dev/null @@ -1,1294 +0,0 @@ -C -C BULLETIN8.FOR, Version 8/9/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - CHARACTER NAMEDESC*9 /'BULLETIN1'/ - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - CALL SETDEFAULT('DECNET') - -C CALL SET_TIMER('02') - - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*9 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN),IO$_READVBLK,MBX_IOSB, - & MBX_AST,,MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*6,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL CONNECT(NODENAME,USERNAME,FROMNAME) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(200),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - CHARACTER*128 INPUT - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - - IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL EXECUTE_COMMAND(UNIT_INDEX) - - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - - RETURN - END - - - - - - SUBROUTINE CONNECT(NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/ - - CHARACTER*(*) USERNAME,FROMNAME - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IF (REJECT.NE.IO_REJECT) THEN - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - END DO - - USERNAME = 'DECNET' - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL ENABLE_CTRL_EXIT,SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2) - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - CHARACTER INPUT*(FOLDER_RECORD+16),DESCRIP_TEMP*53 - CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (INPUT,CMD_TYPE),(INPUT,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - BULLCP_PRIV(1) = PROCPRIV(1) - BULLCP_PRIV(2) = PROCPRIV(2) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(INPUT)) - - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDER_NAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - NODENAME = NODE_SAVE(UNIT_INDEX) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15) THEN ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USERNAME,PRIV_SAVE(1,UNIT_INDEX)) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - END IF - END IF - - IF (CMD_TYPE.EQ.1) THEN ! Select folder - FOLDER1 = INPUT(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(INPUT(1:1))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(INPUT(5:5))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(INPUT(9:9))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - ELSE - CALL LIB$MOVC3(4,0,%REF(INPUT(9:9))) - CALL LIB$MOVC3(4,0,%REF(INPUT(13:13))) - END IF - INPUT = INPUT(:16)//FOLDER_COM - CALL WRITE_CHAN(16+LEN(FOLDER_COM),INPUT,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - FOLDER_NAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(53,%REF(INPUT(5:5)),%REF(DESCRIP)) - CALL LIB$MOVC3(11,%REF(INPUT(58:58)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(INPUT(69:69)),%REF(EXTIME)) - CALL LIB$MOVC3(4,%REF(INPUT(80:80)),SYSTEM) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - INPUT = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (SYSTEM.NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF (SYSTEM.NE.0.AND..NOT.SETPRV_PRIV()) THEN ! Priv test - IF (FOLDER_OWNER.NE.USERNAME) THEN - SYSTEM = 0 - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(INPUT(81:81)),BROAD) - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(INPUT(85:85)),BELL) - CALL LIB$MOVC3(4,%REF(INPUT(89:89)),ALL) - CALL LIB$MOVC3(4,%REF(INPUT(93:93)),CLUSTER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_FILE(1) - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_FILE(1) ! Finished adding bulletin - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_FILE(2) ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_FILE_SHARED(4) ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND.(TEMP_USER(2:).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_FILE(4) - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(1)) - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - IER = SYS$CANTIM(%VAL(1),) - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE_SHARED(2) - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(INPUT(9:9)),%REF(MSG_KEY(1:1))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_FILE(2) - CALL LIB$MOVC3(4,IER,%REF(INPUT(1:1))) - IF (ICOUNT.NE.0) THEN - INPUT(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,INPUT,UNIT_INDEX,IER) - ELSE - INPUT(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,INPUT,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),SBULL) - CALL LIB$MOVC3(4,%REF(INPUT(9:9)),EBULL) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE_SHARED(2) - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_FILE(2) - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE(2) - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = INPUT(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = INPUT(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_FILE(2) - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(INPUT(9:9)),IMMEDIATE) - DESCRIP_TEMP = INPUT(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE_SHARED(2) - CALL READDIR(ICOUNT,IER) - CALL OPEN_FILE_SHARED(1) - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE(2) - CALL LIB$MOVC3(53,%REF(INPUT(5:5)),%REF(DESCRIP_TEMP)) - CALL LIB$MOVC3(4,%REF(INPUT(58:58)),ICOUNT) - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(53,%REF(INPUT(62:62)),%REF(DESCRIP)) - CALL LIB$MOVC3(4,%REF(INPUT(115:115)),%REF(MSGTYPE)) - CALL LIB$MOVC3(11,%REF(INPUT(119:119)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(INPUT(130:130)),%REF(EXTIME)) - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_FILE(1) - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_FILE(1) ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BULL_DELETE) - DESCRIP_TEMP = INPUT(9:61) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_FILE(2) - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(11,%REF(INPUT(62:62)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(INPUT(73:73)),%REF(EXTIME)) - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_FILE_SHARED(2) - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(INPUT(5:5)),BULL_POINT) - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_FILE_SHARED(4) - NODENAME = INPUT(9:) - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_FILE(4) - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BLENGTH) - CALL LIB$MOVC3(4,%REF(INPUT(9:9)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(INPUT(13:13)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:1))) - CALL LIB$MOVC3(4,%REF(INPUT(13:13)),ALL) - CALL LIB$MOVC3(4,%REF(INPUT(17:17)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(INPUT(21:21)),FOLDER_NUMBER) - FOLDER = INPUT(25:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - END IF - -1000 PROCPRIV(1) = BULLCP_PRIV(1) - PROCPRIV(2) = BULLCP_PRIV(2) - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.GE.0) RETURN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END diff --git a/decus/vax88b1/bulletin/bulletin9.for b/decus/vax88b1/bulletin/bulletin9.for deleted file mode 100644 index c432db1..0000000 --- a/decus/vax88b1/bulletin/bulletin9.for +++ /dev/null @@ -1,767 +0,0 @@ -C -C BULLETIN9.FOR, Version 6/22/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_FILE(4) - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE '($HLPDEF)' - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P) - & ,LIBRARY,HLP$M_HELP.OR.HLP$M_PROMPT,LIB$GET_INPUT) - - RETURN - END - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - NLEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addedd - END IF - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:NLEN)//'""::' - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Is semicolon present? - IF (NLEN.GT.SEMI+1) THEN ! Yes, is username after node? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - NLEN = SEMI - 1 ! Remove semicolon - ELSE ! No username after nodename - TEMP_USER = DEFAULT_USER ! Set username to default - NLEN = SEMI - 1 ! Remove semicolon - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolon present - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username was - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:NLEN) - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '// - & PASSWORD(1:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FLAGNAME - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_FILE(7) ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_FILE(7) - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,A,'' You are not authorized to modify.'')') - & FLAGNAME - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_FILE(7) ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_FILE(7) - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=13,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(13,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=13) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (13,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(13,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=13,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=13) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=13) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - INCLUDE '($HLPDEF)' - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$PRINT:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - ELSE - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8) - END IF - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END diff --git a/decus/vax88b1/bulletin/bullfiles.inc b/decus/vax88b1/bulletin/bullfiles.inc deleted file mode 100644 index e46ef9a..0000000 --- a/decus/vax88b1/bulletin/bullfiles.inc +++ /dev/null @@ -1,37 +0,0 @@ -C -C THE FIRST 2 FILES ARE FILES CREATED AND USED BY BULLETIN. -C SPECIFY THE DEVICE/DIRECTORY IN WHICH YOU DESIRE THAT THEY BE KEPT. -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNT MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU ALSO MAY HAVE -C TO INCREASE SOME SUBPROCESS SYSTEM PARAMETERS: PQL_DPGFLQUOTA AND -C PQL_DWSQUOTA MAY HAVE TO BE CHANGED. (10000 AND 500 ARE TYPICAL). -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNT USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLDIR_FILE,BULLETIN_FILE,BULLUSER_FILE - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLINF_FILE - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C THE FOLLOWING 2 FILES ARE OBSOLETE AS OF V1.1 AND NO LONGER HAVE TO -C BE SPECIFIED. BULLETIN NOW TREATS THE GENERAL FOLDER AS ANY OTHER -C FOLDER. NEW USERS SHOULD JUST LEAVE THEM ALONE. HOWEVER, USERS -C USING OLDER VERSIONS STILL HAVE TO SPECIFY THEM IN ORDER THAT -C BULLETIN KNOWS THE NAMES IN ORDER TO RENAME THEM. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ diff --git a/decus/vax88b1/bulletin/bullfolder.inc b/decus/vax88b1/bulletin/bullfolder.inc deleted file mode 100644 index 6e31f77..0000000 --- a/decus/vax88b1/bulletin/bullfolder.inc +++ /dev/null @@ -1,46 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,FILLER, - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) diff --git a/decus/vax88b1/bulletin/bullmain.cld b/decus/vax88b1/bulletin/bullmain.cld deleted file mode 100644 index 3c42a94..0000000 --- a/decus/vax88b1/bulletin/bullmain.cld +++ /dev/null @@ -1,24 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD - QUALIFIER LOGIN - QUALIFIER PAGE, DEFAULT - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER,DEFAULT="7") diff --git a/decus/vax88b1/bulletin/bullstart.com b/decus/vax88b1/bulletin/bullstart.com deleted file mode 100644 index 70354a7..0000000 --- a/decus/vax88b1/bulletin/bullstart.com +++ /dev/null @@ -1,5 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vax88b1/bulletin/bulluser.inc b/decus/vax88b1/bulletin/bulluser.inc deleted file mode 100644 index 7332d91..0000000 --- a/decus/vax88b1/bulletin/bulluser.inc +++ /dev/null @@ -1,42 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Last read times for each folder as stored in SYS$LOGIN:BULLETIN.INF - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vax88b1/bulletin/create.com b/decus/vax88b1/bulletin/create.com deleted file mode 100644 index 7572a47..0000000 --- a/decus/vax88b1/bulletin/create.com +++ /dev/null @@ -1,15 +0,0 @@ -$ FORTRAN/EXTEND BULLETIN -$ FORTRAN/EXTEND BULLETIN0 -$ FORTRAN/EXTEND BULLETIN1 -$ FORTRAN/EXTEND BULLETIN2 -$ FORTRAN/EXTEND BULLETIN3 -$ FORTRAN/EXTEND BULLETIN4 -$ FORTRAN/EXTEND BULLETIN5 -$ FORTRAN/EXTEND BULLETIN6 -$ FORTRAN/EXTEND BULLETIN7 -$ FORTRAN/EXTEND BULLETIN8 -$ FORTRAN/EXTEND BULLETIN9 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ @BULLETIN.LNK diff --git a/decus/vax88b1/bulletin/dclremote.com b/decus/vax88b1/bulletin/dclremote.com deleted file mode 100644 index 97f40f0..0000000 --- a/decus/vax88b1/bulletin/dclremote.com +++ /dev/null @@ -1,32 +0,0 @@ -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET diff --git a/decus/vax88b1/bulletin/handout.txt b/decus/vax88b1/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vax88b1/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vax88b1/bulletin/install.com b/decus/vax88b1/bulletin/install.com deleted file mode 100644 index 2524d0f..0000000 --- a/decus/vax88b1/bulletin/install.com +++ /dev/null @@ -1,17 +0,0 @@ -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vax88b1/bulletin/install_remote.com b/decus/vax88b1/bulletin/install_remote.com deleted file mode 100644 index fe81e0a..0000000 --- a/decus/vax88b1/bulletin/install_remote.com +++ /dev/null @@ -1,130 +0,0 @@ -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,KLEIN,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,KLEIN,MOLVAX,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,KLEIN,MOLVAX,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL diff --git a/decus/vax88b1/bulletin/instruct.com b/decus/vax88b1/bulletin/instruct.com deleted file mode 100644 index 49627f6..0000000 --- a/decus/vax88b1/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vax88b1/bulletin/instruct.txt b/decus/vax88b1/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vax88b1/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vax88b1/bulletin/login.com b/decus/vax88b1/bulletin/login.com deleted file mode 100644 index 39e460e..0000000 --- a/decus/vax88b1/bulletin/login.com +++ /dev/null @@ -1,13 +0,0 @@ -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! If you wish bulletins to be displayed upon logging in starting with -$! oldest rather than newest, change BULLETIN/LOGIN to BULLETIN/LOGIN/REVERSE. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/LOGIN diff --git a/decus/vax88b1/bulletin/makefile b/decus/vax88b1/bulletin/makefile deleted file mode 100644 index ac7be6b..0000000 --- a/decus/vax88b1/bulletin/makefile +++ /dev/null @@ -1,74 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Link /NoTrace Bulletin.Obj,Bulletin0.Obj,Bulletin1.Obj,Bulletin2.Obj, - - Bulletin3.Obj,Bulletin4.Obj,Bulletin5.Obj,Bulletin6.Obj, - - Bulletin7.Obj,Bulletin8.Obj,Bulletin9.Obj, - - Bullcom.Obj,Bullmain.Obj,Allmacs.Obj, - - Sys$System:Sys.Stb /Sel /NoUserlib - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin9.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* - diff --git a/decus/vax88b1/bulletin/nonsystem.txt b/decus/vax88b1/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vax88b1/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vax88b1/bulletin/remote.com b/decus/vax88b1/bulletin/remote.com deleted file mode 100644 index 9ec5a2e..0000000 --- a/decus/vax88b1/bulletin/remote.com +++ /dev/null @@ -1,48 +0,0 @@ -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP diff --git a/decus/vax88b1/bulletin/v5/aaareadme.1st b/decus/vax88b1/bulletin/v5/aaareadme.1st deleted file mode 100644 index 237ccd4..0000000 --- a/decus/vax88b1/bulletin/v5/aaareadme.1st +++ /dev/null @@ -1 +0,0 @@ -The files in this directory were created under VMS 5.0-1 with VMS FORTRAN 5.0. diff --git a/decus/vax88b5/bulletin/bulletin.bwr b/decus/vax88b5/bulletin/bulletin.bwr deleted file mode 100644 index 2b2c5b1..0000000 --- a/decus/vax88b5/bulletin/bulletin.bwr +++ /dev/null @@ -1,27 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU@SMTP 22-AUG-1988 20:25 -To: ARISIA::EVERHART -Subj: BULLETIN - - -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 23 Aug 88 15:34-EDT -Date: 22 Aug 88 15:34:08 EDT -From: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@XX, MHG@MITRE-BEDFORD.ARPA@XX, - EVERHART%ARISIA.DECNET@GE-CRD.ARPA@XX, GAYMAN@ARI-HQ1.ARPA@XX -Subject: BULLETIN - -BULLETIN USERS: -A bug was recently brought to my attention. If a new user logs in, and the -/REVERSE switch is on the BULLETIN/LOGIN command, the code does not display -the appropriate new messages. The problem is in BULLETIN0.FOR, so I'm -sending a new copy of that to everyone. - -(A brand new user should see all permanent SYSTEM messages and the first -non-system message in the GENERAL folder. I limit it to that, since otherwise -if there are a lot of messages in the GENERAL folder, a new user might end up -getting page fulls of messages.) - -The LOGIN.COM that I distribute didn't used to have /REVERSE as the default, -but I just changed that. To me, it makes more sense to see the oldest -messages first, since the new messages might refer to older messages. - Mark diff --git a/decus/vax88b5/bulletin/bulletin.for b/decus/vax88b5/bulletin/bulletin.for deleted file mode 100644 index 4fcc1aa..0000000 --- a/decus/vax88b5/bulletin/bulletin.for +++ /dev/null @@ -1,1197 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU@SMTP 16-AUG-1988 22:52 -To: ARISIA::EVERHART -Subj: BULLETIN.FOR - - -Received: from deep-thought.mit.edu by EDDIE.MIT.EDU via Chaosnet with MAIL with sendmail-5.45/4.7 id ; Tue, 16 Aug 8 -8 10:37:00 EDT -Message-Id: <8808161437.AA05490@EDDIE.MIT.EDU> -Received: from PFC-VAX.MIT.EDU by DEEP-THOUGHT.MIT.EDU via Chaosnet; 16 Aug 88 10:36-EDT -Date: 16 Aug 88 10:36:07 EDT -From: MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@EE, MHG@MITRE-BEDFORD.ARPA@EE, - EVERHART%ARISIA.DECNET@GE-CRD.ARPA@EE, GAYMAN@ARI-HQ1.ARPA@EE -Subject: BULLETIN.FOR - -C -C BULLETIN.FOR, Version 8/3/88 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$GET_FOREIGN(INCMD) - CALL CLI$DCL_PARSE('BULLETIN '//INCMD,BULLETIN_MAINCOMMANDS) - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - END IF - CALL LIB$REVERT - - READIT = 0 - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP')) THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - CALL RUN_BULLCP ! doing what BULLCP does! - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - -C -C Get page length for the terminal. -C - - CALL GETPAGLEN(PAGE_LENGTH) - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL SHOW_SYSTEM - CALL EXIT - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - CALL NEW_MESSAGE_NOTIFICATION - ELSE - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IFr - - DO WHILE (1)E - - CALL GET_INPUT_PROMPT(INCMD,IER, - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - - IF (IER.EQ.-2) THENd - IER = RMS$_EOF. - ELSE IF (IER.LE.0) THENs - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ')E - INCMD = INCMD(2:IER)3 - IER = IER - 1 - END DOd - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9')A - IER = IER - 1 - END DO- - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THENR - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN enteredi - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them' - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletinO - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has errorY - GO TO 100 ! ask for new commandC - END IF - - DIR_COUNT = 0 ! Reinit display pointers_ - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0U - - CALL CLI$GET_VALUE('$VERB',INCMD) ! Get the VERB command - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL'T - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THENM - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD bulletin command? - CALL ADD ! Go add bulletinM - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK command? - IF (BULL_POINT.LE.1) THENV - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE command?A - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY command?P - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE command?G - CALL CREATE_FOLDER ! Go create the folderR - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT command? - READ_COUNT = -1 ! Reread current message from beginning.0 - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE command?I - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY command? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders. - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select foldero - IF (IER) THEN ! If successful. - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messagesM - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE command? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR.E - & INCMD(:4).EQ.'QUIT') THEN ! EXIT command? - GO TO 999 ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP command?R - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get helpe - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX command?p - INDEX_COUNT = 1I - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST command?T - READ_COUNT = -1 - BULL_READ = 99999N - CALL READ(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL command? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY command? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE command?M - CALL MOVE(.TRUE.)M - ELSE IF (INCMD(:4).EQ.'NEXT') THEN ! NEXT command?1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT command? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ command?R - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)_ - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified?O - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1T - CALL READ(READ_COUNT,BULL_READ)E - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE command? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY command? - IF (BULL_POINT.LT.1) THEN) - WRITE (6,'('' ERROR: No bulletin currently read.'')')e - ELSE - WRITE (6,'('' Adding REPLY message with the subject:'')') - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP)R - IF (BULL_PARAMETER(:3).NE.'RE:') THENs - DESCRIP = 'RE: '//DESCRIPB - ELSE - DESCRIP = 'RE:'//DESCRIP(4:) - END IF - WRITE (6,'(1X,A)') DESCRIPC - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND command? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH command? - CALL SEARCH(READ_COUNT)C - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT command? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET command?. - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER)I - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'PR') THEN ! SET PRIVS?G - CALL SET_PRIVs - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')')e - ELSE IF (BULL_PARAMETER(:2).EQ.'KE') THEN ! SET KEYPAD? - CALL SET_KEYPADN - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD?a - CALL SET_NOKEYPADg - ELSE IF (BULL_PARAMETER(:3).EQ.'NOP') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')')T - ELSE IF (FOLDER_NUMBER.EQ.-1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')')) - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM?m - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.)M - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP')s - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:3).EQ.'NOT') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1)T - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(1,-2,-2) - ELSEe - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')s - END IF - ELSE - CALL CHANGE_FLAG(1,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.)d - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE?R - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(0,-2,-2) - ELSET - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')R - END IF - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'(E - & '' ERROR: SET SHOWNEW not allowed for GENERAL folder.'')')' - ELSE IF (CLI$PRESENT('DEFAULT')) THENR - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE IF (CLI$PRESENT('ALL')) THENI - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,1) - ELSEE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(1,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THENI - WRITE (6,'(n - & '' ERROR: SET NOSHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEND - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSEt - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')d - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE IF (CLI$PRESENT('ALL')) THENU - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,0) - ELSEB - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')E - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW?i - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THENa - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSEL - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')C - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF?P - IF (FOLDER_NUMBER.EQ.0) THENE - WRITE (6,'(' - & '' ERROR: SET BRIEF not allowed for GENERAL folder.'')')C - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,1)n - ELSEr - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')I - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(1,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (FOLDER_NUMBER.EQ.0) THENi - WRITE (6,'(Y - & '' ERROR: SET NOBRIEF not allowed for GENERAL folder.'')')T - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0)! - ELSEg - WRITE (6,'('' ERROR: /ALL is a privileged command.'')')h - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF' - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.)E - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC?I - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN?A - CALL SET_LOGIN(.FALSE.)( - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW command?c - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGSC - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDERE - ELSE IF (BULL_PARAMETER(:2).EQ.'KE') THEN ! SHOW KEYPADL - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SHOW NEW?b - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - DO FOLDER_NUMBER = 0,FOLDER_MAX-1E - IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR.E - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER)A - IF (NBULL.GT.0) THEN - DIFF = COMPARE_BTIM( - & LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - IF (DIFF.LT.0) THENE - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER))T - END IFY - END IF - END IFI - END DO - FOLDER1 = SAVE_FOLDERO - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER)A - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES?P - CALL SHOW_PRIV - END IF - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE command?E - CALL UNDELETE - END IF - -100 CONTINUE4 - - END DOF - -999 CALL EXIT( - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - SUBROUTINE ADDc -Ca -C SUBROUTINE ADDS -CD -C FUNCTION: Adds bulletin to bulletin file. -CT - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODEC - CHARACTER*32 NODES(10), - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITL - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULTE - DATA EDIT_DEFAULT/.FALSE./P - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'L - - INCLUDE 'BULLFOLDER.INC'' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER*80 INDESCRIP,INPUTA - - CHARACTER INLINE*80,OLD_FOLDER*25 - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C' - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN' - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRVB - CALL DISABLE_PRIVS ! privileges when trying toC - END IF ! create new file.E - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',READONLY,R - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesL - ELSE IF (CLI$PRESENT('TEXT')) THENE - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'E - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,F - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED'). - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)D - GO TO 910 - END IF - - CALL OPEN_FILE_SHARED(1) - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into filee - DO WHILE (ILEN.GT.0): - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THENH - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:MIN(79,ILEN))' - IF (ILEN.EQ.80) WRITE (3,'(A)') '>'//INPUT(80:) - END IF - END IF - END DOx - ILEN = 80 - END DO - -90 CALL CLOSE_FILE(1) - END IF4 - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER)) - IF (.NOT.IER) GO TO 910S - SELECT_FOLDERS = .TRUE.I - ELSE_ - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IFT - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER)A - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET?L - USERNAME = DEFAULT_USER - CALL CONFIRM_PRIV(USERNAME,ALLOW) - END IFS - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and, - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IFB - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present?T - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910E - END IF0 - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privilegesL - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort_ - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?. - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abortR - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?R - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privileges - WRITE(ERROR_UNIT,1081) ! Tell user - GO TO 910 ! and abort - ELSE IF (F_EXPIRE_LIMIT.GT.0.AND..NOT.ALLOW ! Expiration limit - & .AND.USERNAME.NE.FOLDER_OWNER) THEN ! is present - WRITE(ERROR_UNIT,1083)E - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00'n - END IF - END IFF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present?N - IF (.NOT.ALLOW) THEN ! If no privileges' - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abortO - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (INEXTIME,'(I4)') NODE_NUMBER - WRITE (INEXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO_ - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IFS - - SELECT_NODES = .FALSE.N - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940F - SELECT_NODES = .TRUE.L - END IF( - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:)F - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY command?( - INDESCRIP = DESCRIP ! Use descrption with RE:, - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specifiedS - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - GO TO 910 - END IF - ELSE - LENDES = 54 - DO WHILE (LENDES.GT.53) ! Do until valid description - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input lineE - IF (LENDES.LE.0) GO TO 910N - IF (LENDES.GT.53) THEN ! If too many charactersI - WRITE(6,1060) ! tell userS - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fit - END IF' - END DO - END IF? - -CA -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.S -C - - ICOUNT = 0 ! Line count for bulletin - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN( - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',. - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')L - LEN_P = 1 - ELSE - CLOSE (UNIT=3)E - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')Q - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',R - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')E - END IF - END IF - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count& - IF (ILEN.GT.80) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80)A - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with( - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED') ! Sratch file to save bulletinM - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = 81 ! Length of input lineM - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.80) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > 80. Reinput:'')') - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredF - ICOUNT = ICOUNT + 1 + ILEN ! Increment record count - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1E - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outA - ENDIF - - REWIND (UNIT=3) - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN_ - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST'))D - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT'))A - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT'C - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1, - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodesL - INLINE = INLINE(:LEN_INLINE)B - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolonsI - ILEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Are semicolon found?v - IF (ILEN.GT.SEMI+1) THEN ! Is username found? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes - ILEN = SEMI - 1 ! Remove semicolons - ELSE ! No username found...M - TEMP_USER = DEFAULT_USER ! Set user to defaultR - ILEN = SEMI - 1 ! Remove semicolons - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons presentP - TEMP_USER = DEFAULT_USER ! Set user to default - END IFR - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0)M - WRITE(6,'('' Enter password for node '',2A)')I - & NODES(POINT_NODE),CHAR(10)O - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910T - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:ILEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THENA - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF, - END DOU - INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)x - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify dateL - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,80) - IF (IER.EQ.0) THENN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN)I - END IFA - END DOS - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THENR - WRITE (6,'('' Message successfully sent to node '',A)')E - & NODES(POINT_NODE)D - ELSED - WRITE (6,'('' Error while sending message to node '',A)')/ - & NODES(POINT_NODE)& - WRITE (6,'(A)') INPUT - GO TO 940 - END IFh - REWIND (UNIT=3) - END DO - END IF) - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - -CI -C Add bulletin to bulletin file and directory entry for to directory file.F -C - BRDCST = .FALSE.e - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1E - FOLDER1 = NODES(I)/ - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER) THENE - CALL OPEN_FILE(2) ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - LENGTH = (ICOUNT+127)/128 ! Number of recordsE - FROM = USERNAME ! UsernameG - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0I - - REWIND (UNIT=3) - CALL COPY_BULL(3,1,NBLOCK+1,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin -C0 -C Broadcast the bulletin if requested.I -CE - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THENw - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'),E - & CLI$PRESENT('CLUSTER')) - END IF( - CALL BROADCAST(R - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IFI - - CALL CLOSE_FILE(1) ! Finished adding bulletinD - - CALL ADD_ENTRY ! Add the new directory entry' - - IF (FOLDER_NUMBER.GE.0) THENX - CALL UPDATE_FOLDER ! Update info in folder file -CI -C If user is adding message, update that user's last read time forE -C folder, so user is not alerted of new message which is owned by user. -CH - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IFP - - CALL CLOSE_FILE(2) ! Totally finished with add - ELSE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - END DOm - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9e - CLOSE (UNIT=I) - END DOt - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THENh - FOLDER_NUMBER = OLD_FOLDER_NUMBER0 - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER). - END IF - - IF (CLI$PRESENT('TEXT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IFE - - RETURNS - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020)5 - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesR - GOTO 100 - -930 WRITE (ERROR_UNIT,1025)( - CALL CLOSE_FILE(1)) - CALL CLOSE_FILE(2)d - CLOSE (UNIT=3)I - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - CLOSE (UNIT=3)r - GO TO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3)l - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')( -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A)' -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would beL - & truncated to:') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system: - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcastN - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanentE - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -2010 FORMAT(A) -2020 FORMAT(1X,A)Q - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z)i - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*23 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM)c - IF (.NOT.IER) RETURNM - - BTIM(1) = -BTIM(1) ! Convert to negative delta timen - BTIM(2) = -BTIM(2)-1L - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z)8 - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2C - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*8 LOCALNODE - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURNr - - CALL OPEN_FILE_SHARED(4)U - - REMOTE_FOUND = .FALSE.. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND)F - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG) - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE(4) - RETURN( - END IFP - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DOL - - CALL CLOSE (4)A - - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"')F - - IF (IER.EQ.0) THEN - IER = 0I - I = 1I - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER)E - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - END IF - - CLOSE (UNIT=17) - - RETURNn - END - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1n - - RETURN - END diff --git a/decus/vax88b5/bulletin/bulletin0.for b/decus/vax88b5/bulletin/bulletin0.for deleted file mode 100644 index d9487cd..0000000 --- a/decus/vax88b5/bulletin/bulletin0.for +++ /dev/null @@ -1,1261 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU@SMTP 22-AUG-1988 20:27 -To: ARISIA::EVERHART -Subj: New BULLETIN0.FOR - - -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 23 Aug 88 15:34-EDT -Date: 22 Aug 88 15:34:24 EDT -From: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@XX, MHG@MITRE-BEDFORD.ARPA@XX, - EVERHART%ARISIA.DECNET@GE-CRD.ARPA@XX, GAYMAN@ARI-HQ1.ARPA@XX -Subject: New BULLETIN0.FOR - -C -C BULLETIN0.FOR, Version 8/22/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - CHARACTER*128 INPUT - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = 81 - DO I=NBLOCK+1,NBLOCK+LENGTH ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL(I,INPUT,ILEN) - END IF - IF (ILEN.LT.0) THEN ! End of bulletin? - RETURN - ELSE IF (ILEN.GT.0) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - ILEN = 80 - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IF - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - - - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53,INPUT*23 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER) - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_FILE(2) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.REMOTE_USER.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_FILE(2) - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_FILE(2) ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,DESCRIP - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(1:11) - NEWEST_EXTIME = INPUT(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_FILE(2) - - DO BULL_DELETE = SBULL,EBULL - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error oute - CALL CLOSE_FILE(2)v - RETURNX - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_FILE(2) - RETURNo - ELSE IF (SBULL.EQ.EBULL) THEN - CALL CLOSE_FILE(2) - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') RETURNE - CALL OPEN_FILE(2)T - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error outl - CALL CLOSE_FILE(2)/ - RETURN - END IF - END IFh - END IF - -Cs -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - END DOS - - CALL CLOSE_FILE(2)C - RETURN( - -1010 FORMAT(' ERROR: You are not reading any message.')T -1020 FORMAT(' ERROR: Specified message number has incorrect format.')s -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.')T -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.')! -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER INPUT*23 - - INTEGER NOW(2)T - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry, - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventuallyw -Cn -C Change year of expiration date of message to 100 years less,i -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -CL -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C& - - IF (SYSTEM.LE.1) THEN ! General or System messageL - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99'F - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSE_ - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - END IFK - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from nowS - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM)r - IER = SYS$ASCTIM(,INPUT,EX_BTIM,)I - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:) - - CALL WRITEDIR(0,IER) - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates.Y - - IF (SBULL.LE.BULL_POINT) THENO - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1)' - ELSEI - BULL_POINT = SBULL - END IF) - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IFE - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z)Q - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THENU - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVALE - ELSEE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - END IF - IF (EVAL.LT.SVAL) IER = 2E - END IF - - RETURNN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -Cy -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -CL - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'A - - COMMON /PAGE/ PAGE_LENGTH, PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/0 - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT' - - CHARACTER START_PARAMETER*16,DATETIME*23L - - INTEGER TODAY(2)O - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenR - -CL -C Directory listing is first buffered into temporary memory storage beforeG -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen,T -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -CA - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1L - - CALL OPEN_FILE_SHARED(2) ! Get directory fileC - - CALL READDIR(0,IER) ! Does directory header exist?P - IF (IER.EQ.1) THEN ! If so, there are messages_ - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified?N - IER = CLI$GET_VALUE('START',START_PARAMETER,ILEN)E - DECODE(ILEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEND - DIR_COUNT = NBULLL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_FILE(2) - DIR_COUNT = 0u - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY)L - CALL GET_MSGKEY(TODAY,MSG_KEY)e - ELSEi - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IFf - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_FILE(2)o - RETURNo - ELSE' - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1),U - & MSG_KEY) - END IFN - END IF - - CALL READDIR_KEYGE(IER) - - IF (IER.EQ.0) THENT - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_FILE(2) - RETURN - ELSEp - DIR_COUNT = IER - END IFm - ELSEt - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IFI - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THENL - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULLE - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULLF - SBULL = NBULL - (PAGE_LENGTH-5) + 1O - IF (SBULL.LT.1) SBULL = 1$ - ELSE, - SBULL = DIR_COUNTE - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - END IF - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THENN - EBULL = NBULL - END IF - IF (.NOT.REMOTE_SET) THENT - DO I=SBULL,EBULL ! Copy messages from file - CALL READDIR(I,IER) ! Into the queueE - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)e - END DO - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,SBULL,EBULL - IF (IER.EQ.0) THEN' - I = SBULL - DO WHILE (IER.EQ.0.AND.I.LE.EBULL)R - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY. - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO0 - END IFr - IF (IER.NE.0) THENO - CALL CLOSE_FILE(2) - CALL DISCONNECT_REMOTEH - RETURN - END IFL - END IF - ELSET - NBULL = 0k - END IFe - - CALL CLOSE_FILE(2) ! We don't need file anymore - - IF (NBULL.EQ.0) THENL - WRITE (6,'('' There are no messages present.'')')) - RETURN - END IFA - -CE -C Directory entries are now in queue. Output queue entries to screen.E -CL - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER) - WRITE(6,'(<81-FLEN>X,A)') FOLDER(:FLEN) - WRITE(6,1000) ! Write header - DO I=SBULL,EBULL - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,2010) I,DESCRIP(:52),FROM,'(DELETED)' - ELSE - WRITE(6,2010) I,DESCRIP(:52),FROM,DATE(1:7)//DATE(10:11)t - END IF - END DOR - - DIR_COUNT = EBULL + 1 ! Update directory counter) - - IF (DIR_COUNT.GT.NBULL) THEN ! Outputted all entries? - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSEe - WRITE(6,1010) ! Else say there are mored - END IF, - - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/)M - -2010 FORMAT(1X,I4,1X,A52,1X,A12,1X,A9) - - END - L - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z)I - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8) - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DOS - - RETURNE - END - - - - SUBROUTINE FILE -Cl -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z)t - - CHARACTER INPUT*80a - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENTd - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)c - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And returnh - END IFe - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read8 - WRITE(6,1010) ! Write error - RETURN ! And returns - END IF - - CALL OPEN_FILE_SHARED(2)/ - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinF - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030) - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2)) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900,N - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE. - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IFa - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IFd - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90S - ELSE IF (ILEN.GT.0) THEN_ - WRITE (3,'(A)') INPUT(1:ILEN)F - END IFe - END DO - ILEN = 80e - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completedE - - WRITE(6,1040) BULL_POINT,BULL_PARAMETER(1:LEN_P)I - ! Show name of file created.I -100 CALL CLOSE_FILE(1) - RETURN) - -900 WRITE(6,1000)X - CALL ENABLE_PRIVS ! Reset BYPASS privilegesL - GO TO 100 - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Specified bulletin was not found.') -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A,/)S - - END - - - - - SUBROUTINE LOGIN -CS -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -CE - IMPLICIT INTEGER (A - Z)U - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'U - - INCLUDE 'BULLFOLDER.INC'G - - COMMON /READIT/ READITG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGINGT - LOGICAL PAGINGA - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPTM - CHARACTER*39 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)t - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATEf - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*23,INPUT*80,INREAD*1 - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/C - - DATA FIRST_WRITE/.TRUE./i - LOGICAL FIRST_WRITE - - DIMENSION NOLOGIN_BTIM(2),LOGIN_BTIM_SAVE(2),TODAY_BTIM(2)I - DIMENSION NEW_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)< - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C. -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -Cn - - CALL OPEN_FILE_SHARED(4)C - - CALL MODIFY_SYSTEM_LIST(1) - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry) - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) RETURN ! DISMAIL set_ - IF (IER1.EQ.0) THEN ! There is a user entry - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1)C - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)1 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRYe - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONGo - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR.Y - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DON - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry' - READ_BTIM(2) = NEW_BTIM(2) - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I)S - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)D - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_DISMAIL(USERNAME,DISMAIL)_ - IF (DISMAIL.EQ.1) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - ELSEO - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2)L - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - END IF= - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_FILE(4) ! Close the user file - CALL EXIT ! Go away...E - END IFL - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_FILE_SHARED(9) - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO_ - WRITE (9,IOSTAT=IER) USERNAME,V - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_FILE(9)I - END IF - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IFC - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM)N - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - BBOARD_BTIM(1) = TODAY_BTIM(1) - BBOARD_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_FILE(4) - IF (.NOT.TEST_BULLCP()) CALL CREATE_BBOARD_PROCESS - ELSE - CALL CLOSE_FILE(4) - IF (IER.NE.0) CALL EXIT ! If no header, no messages= - END IFL - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entryR -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility., -CM - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compareG - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin dateS - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEND - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM). - END IF - END IF( - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)T - R - IF (NEW_FLAG(2).NE.0) THENK - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - RETURN - END IF - -CN -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible.6 -CU - - ENTRY LOGIN_FOLDERE - - IF (NEW_FLAG(2).EQ.0.OR.FOLDER_SET) THENI - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IFE - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (FOLDER_NUMBER.GT.0.AND.BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST2(SET_FLAG,FOLDER_NUMBER) - & .AND..NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messagesi - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) RETURN? - ! Don't overwhelm new user with lots of non-general msgs - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN2 - ! Can folder have SYSTEM messages and /SYSTEM specified?. - LOGIN_BTIM(1) = SYSTEM_LOGIN_BTIM(1) ! Use specified login timeB - LOGIN_BTIM(2) = SYSTEM_LOGIN_BTIM(2) ! for system messages.f - END IFI - - CALL OPEN_FILE_SHARED(2) ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSEE - NBULL = F_NBULL, - END IF_ - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT))t - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1D - SYS_NUM = SYS_NUM1t - START = 1 - REVERSE = 0 - IF (REVERSE_SWITCH.AND.(.NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR.D - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THENC - REVERSE = 1! - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IFE - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,NBULL - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,NBULL,START - END IF - IF (IER.EQ.0) THEN - ALL_DIR = ALL_DIR1T - I = START - DO WHILE (IER.EQ.0.AND.I.LE.NBULL)S - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY)i - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_FILE(2)e - CALL DISCONNECT_REMOTEA - RETURN4 - END IF - ALL_DIR = ALL_DIR1 - END IFn - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THENE - ICOUNT = NBULL + START - ICOUNT1B - ELSE - ICOUNT = ICOUNT1e - END IF - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY)' - IER = ICOUNT + 1C - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user?R - ! No. Is bulletin system or from same user?G - IF (.NOT.REVERSE) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN1 - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1T - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)T - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (SYSTEM_SWITCH) THENs - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM)i - ELSE - DIFF = -1 - END IF - IF (DIFF.LT.0) THENf - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THENU - BULL_POINT = ICOUNT - 1I - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IFn - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF (SYSTEM.EQ.3) THEN - NSYS = NSYS + 1O - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))n - ELSE IF (NGEN.EQ.0) THEN ! And save only the first non-system msg - SYSTEM = ICOUNT ! Save bulletin number for displayO - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN0 - BULL_POINT = ICOUNT - 1C - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IFT - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IFL - END IF - END DOO -100 CALL CLOSE_FILE(2) -CB -C Review new directory entries. If there are system messages,) -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (NGEN.EQ.0.AND.NSYS.EQ.0) RETURN - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesd - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER) - S1 = (80-(LENF+16))/2 - S2 = 80 - S1 - (LENF + 16) - WRITE (6,1026) FOLDER(:LENF),CTRL_G ! Yep... - PAGE = PAGE + 1O - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_FILE_SHARED(1) - CALL INIT_QUEUE(SYS_BUL1,INPUT)A - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0= - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)_ - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER)= - END IF - IF (IER.GT.0) THEN - CALL CLOSE_FILE(1) - RETURN - END IFT - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin to SYS_BUL link listw - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THENF - CALL CLOSE_FILE(1), - RETURN - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - END IF - END DO - ILEN = 80 - END DOJ - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)V - DO I=1,80 - INPUT(I:I) = SEPARATE! - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF_ - END DO - CALL CLOSE_FILE(1) - SYS_BUL = SYS_BUL1 - DO I = 1,NSYS_LINE ! Write out the system messages - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)E - IF (SYS_BUL.NE.0) THENL - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THENA - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....')s - CALL LIB$ERASE_PAGE(1,1) ! Clear the screent - PAGE = 1 - WRITE(6,1060) '+'//INPUT(1:TRIM(INPUT)), - ELSE) - PAGE = PAGE + 1H - WRITE(6,1060) ' '//INPUT(1:TRIM(INPUT)) - END IF( - END IF1 - END DO - IF (NGEN.EQ.0) THENG - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1t - END IFs - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER)M - S1 = (80-13-LENF)/2S - S2 = 80-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next pageT - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....')L - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages',CTRL_GI - PAGE = 1e - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesC - FIRST_WRITE = .FALSE. ! if this is first write to screen.E - END IFE - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages',CTRL_G1 - PAGE = PAGE + 1 - END IF - WRITE(6,1020)S - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0M - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_ - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,I - & 'HIT Q(Quit listing) or any other key for next page....')s - CALL STR$UPCASE(INREAD,INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1S - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')')2 - ELSEM - WRITE(6,1040) '+'//DESCRIP,FROM,DATE(:6),SYSTEML - END IF_ - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP,FROM,DATE(:6),SYSTEM - END IF_ - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0)L - & .OR.(FOLDER_SET.AND.TEST2(SET_FLAG,FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated.E - END IFL - IF (COMPARE_BTIM(READ_BTIM,NEW_BTIM).NE.0) THEN - WRITE(6,1030)) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1M - S1 = (80-ILEN)/2 - S2 = 80 - S1 - ILENT - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.'( - ELSE) - ILEN = 48 + INDEX(COMMAND_PROMPT,'>') - 1I - S1 = (80-ILEN)/2 - S2 = 80 - S1 - ILENT - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-48)// - & ' command can be used to read these messages.' - END IFT - - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'),A1) -1027 FORMAT(/,' ',('*'),A,('*'),A1)C -1028 FORMAT('+',('*'),A,('*'),A1)R -1030 FORMAT(' ',80('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A54,1X,A12,1X,A6,1X,I4) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END diff --git a/decus/vax88b5/bulletin/bulletin1.for b/decus/vax88b5/bulletin/bulletin1.for deleted file mode 100644 index a826e0e..0000000 --- a/decus/vax88b5/bulletin/bulletin1.for +++ /dev/null @@ -1,1270 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU@SMTP 16-AUG-1988 17:05 -To: ARISIA::EVERHART -Subj: BULLETIN1.FOR - - -Received: from deep-thought.mit.edu by EDDIE.MIT.EDU via Chaosnet with MAIL with sendmail-5.45/4.7 id ; Tue, 16 Aug 8 -8 10:38:43 EDT -Message-Id: <8808161438.AA05497@EDDIE.MIT.EDU> -Received: from PFC-VAX.MIT.EDU by DEEP-THOUGHT.MIT.EDU via Chaosnet; 16 Aug 88 10:38-EDT -Date: 16 Aug 88 10:37:58 EDT -From: MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@EE, MHG@MITRE-BEDFORD.ARPA@EE, - EVERHART%ARISIA.DECNET@GE-CRD.ARPA@EE, GAYMAN@ARI-HQ1.ARPA@EE -Subject: BULLETIN1.FOR - -C -C BULLETIN1.FOR, Version 7/13/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER INPUT*80 - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IF - - CALL CLOSE_FILE(2) - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,'(A)') 'Description: '//DESCRIP ! Output bulletin header info - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'From: '//FROM//' Date: '//DATE//' (DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'From: '//FROM//' Date: '//DATE//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'From: '//FROM//' Date: '//DATE//' Permanent' - ELSE - INPUT = 'From: '//FROM//' Date: '//DATE//' '//DATE(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT - WRITE (3,*) - END IF - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - LEN_I = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (LEN_I.GT.0) - CALL GET_BULL(I,INPUT,LEN_I) - IF (LEN_I.LT.0) THEN - GO TO 90 - ELSE IF (LEN_I.GT.0) THEN - WRITE (3,'(A)') INPUT(:LEN_I) - END IF - END DO - LEN_I = 80 - END DO - -90 CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_FILE(1) - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (MAIL_SUBJECT(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - MAIL_SUBJECT(I:I) = '`' - ELSE - MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - IER = CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER,LEN_P) - - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) - & //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,STATUS) - CALL ENABLE_PRIVS - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder owner.'')') - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_FILE(7) ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_FILE(7) - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'C - - INCLUDE 'BULLFOLDER.INC'i - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - LOGICAL DELETE_ORIGINAL - - CHARACTER INPUT*128,SAVE_FOLDER*25e - - IF (CLI$PRESENT('ORIGINAL').AND..NOT.SETPRV_PRIV()) THENe - WRITE (6,: - & '('' ERROR: You have no privileges to keep original owner.'')') - END IFE - - ALL = CLI$PRESENT('ALL')L - - MERGE = CLI$PRESENT('MERGE')R - - SAVE_BULL_POINT = BULL_POINTE - - IF (.NOT.ALL) THENY - IF (BULL_POINT.EQ.0) THEN ! If no message has been readI - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_FILE(2) - RETURNI - END IF - - NUM_COPY = 1 - ELSEL - CALL OPEN_FILE_SHARED(2) - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_FILE(2)a - RETURN - END IF - - NUM_COPY = NBULL - BULL_POINT = 1 - END IFJ - - FROM_REMOTE = REMOTE_SETE - - IF (REMOTE_SET) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',N - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,P - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')f - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL',i - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,e - & FORM='UNFORMATTED')L - END IF - IF (IER.EQ.0) THEN - CALL OPEN_FILE(1) - I = BULL_POINT - 1E - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THENR - IF (I.EQ.0) THENo - WRITE (12,IOSTAT=IER1) BULLDIR_HEADER - ELSE - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF( - END IFo - NBLOCK = 1p - DO WHILE (I.LT.BULL_POINT+NUM_COPY-1.AND.IER.EQ.I+1)X - I = I + 1 - CALL READDIR(I,IER)r - IF (IER.EQ.I+1) THENA - BLOCK = NBLOCK - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)n - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRYO - IF (IER1.EQ.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER1) 5,I - IF (IER1.GT.0) THEN' - CALL DISCONNECT_REMOTE' - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - END IFI - IF (IER1.EQ.0) THEN( - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTHM - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - WRITE (11'NBLOCK,IOSTAT=IER1) INPUTD - NBLOCK = NBLOCK + 1N - END DOL - END IF - IF (IER1.NE.0) I = IER - END IFI - END DO - NUM_COPY = I - BULL_POINT + 1 - END IF - CALL CLOSE_FILE(1) - IF (IER1.NE.0) THEN( - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=11) - CLOSE (UNIT=12) - CALL CLOSE_FILE(2) - RETURN - END IF - END IF - - CALL CLOSE_FILE(2)S - - SAVE_FOLDER = FOLDERE - SAVE_FOLDER_NUMBER = FOLDER_NUMBERa - CALL CLI$GET_VALUE('FOLDER',FOLDER1)E - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBERQ - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER) THEN( - WRITE (6,'('' ERROR: Cannot access specified folder.'')')" - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11)= - CLOSE (UNIT=12)I - RETURN - END IFL - - IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET)) THEN - IF (READ_ONLY) THEN/ - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')')N - END IF - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDERO - CALL SELECT_FOLDER(.FALSE.,IER1) - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11)E - CLOSE (UNIT=12) - RETURN - END IFT - -CN -C Add bulletin to bulletin file and directory entry for to directory file.U -CS - - CALL OPEN_FILE(2) ! Prepare to add dir entry$ - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCKE - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0e - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)). - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE) THENr - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE))F - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,L - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')R - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,E - & FORM='UNFORMATTED') - END DOI - END IF - ELSEL - IER= 0 - END IFe - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - IF (IER.EQ.0) READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - NUM_COPY = NUM_COPY - 1) - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges?' - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message?1 - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND. - & .NOT.SETPRV_PRIV().AND..NOT.ALL) THEN ! Permanent?) - WRITE (6,'('' ERROR: No privileges to add'',_ - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIREE - SYSTEM = IBCLR(SYSTEM,1)T - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00'H - END IF - - IF (.NOT.CLI$PRESENT('ORIGINAL')) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2N - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (MERGE) CALL ADD_MERGE_TO(IER)Y - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT) - END IF - NBLOCK = NBLOCK + 1 - END DOR - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER)I - ELSE - CALL ADD_ENTRY ! Add the new directory entry - END IFF - BULL_POINT = BULL_POINT + 1 - END IF - END DO_ - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - CLOSE (UNIT=11) - - CLOSE (UNIT=12) - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0) THEN - CALL UPDATE_FOLDER ! Update folder infoo -Cr -C If user is adding message, update that user's last read time forR -C folder, so user is not alerted of new message which is owned by user. -C_ - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IFf - - CALL CLOSE_FILE(2) ! Totally finished with add- - - - IF (IER.EQ.0) THENU - WRITE (6,'('' Successful copy to folder '',A)')C - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//_ - & '.BULLDIR;-1') - END IF - ELSE_ - IF (MERGE) I = 0 - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')')E - & BULL_POINT-SAVE_BULL_POINTI - END IF - E - FOLDER_NUMBER = SAVE_FOLDER_NUMBERT - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1)C - - BULL_POINT = SAVE_BULL_POINTE - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')')L - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - CALL DELETE - END IF - END IFn - - RETURN - - END - - - - - SUBROUTINE PRINTr -Ci -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*80 INPUTe - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been readL - WRITE(6,1010) ! Write error - RETURN ! And returnt - END IFd - - CALL OPEN_FILE_SHARED(2). - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletine - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,1030)N - CALL CLOSE_FILE(2) ! If not, then error out - RETURN - END IFO - - CALL CLOSE_FILE(2) - - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - END IFM - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END DO - ILEN = 80A - END DOU - - CLOSE (UNIT=3) ! Bulletin copy completedI - - CALL CLOSE_FILE(1)R - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) ! Get queue name - IF (ILEN.EQ.0) THEN - QUEUE = 'SYS$PRINT'M - ILEN = 9 - END IFW - - CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE))I - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THENC - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IFD - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURNL - -900 CALL ERRSNS(IDUMMY,IER). - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_FILE(1) - WRITE(6,1000) - CALL SYS_GETMSG(IER)S - - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.')_ -1010 FORMAT(' ERROR: You have not read any message.')L -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' Message ',I4,' written to ',A) -1050 FORMAT('Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A,/)e - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C_ -C SUBROUTINE READ -CV -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER:1 -C READ_COUNT - Variable to store the record in the message fileO -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z). - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUTt - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGINGt - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DATA SCRATCH_B1/0/G - - CHARACTER TODAY*11,DATETIME*23 - - LOGICAL SINCE,PAGEK - - CALL LIB$ERASE_PAGE(1,1) ! Clear screenR - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this isE - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified?R - IER = CLI$GET_VALUE('SINCE',DATETIME)O - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default.I - IER = SYS$BINTIM('-- 00:00:00.00',TODAY)T - CALL GET_MSGKEY(TODAY,MSG_KEY). - ELSEA - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified?F - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THENP - WRITE (6,'('' No new messages are present.'')') - RETURN( - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY)G - END IF - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - CALL OPEN_FILE_SHARED(2) - CALL READDIR_KEYGE(IER) - CALL CLOSE_FILE(2) - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - RETURNm - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IFN - - IF (.NOT.SINCE) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_FILE_SHARED(2) - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entryT - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THENE - READ_COUNT = 0L - CALL READDIR(0,IER) - IF (NBULL.GT.0) THENi - BULL_READ = NBULL' - CALL READDIR(BULL_READ,IER)( - ELSEt - IER = 0 - END IF) - END IF - CALL CLOSE_FILE(2) - ELSE - IER = 0T - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IFN - - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1)I - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2) - END IF - - BULL_POINT = BULL_READ ! Update bulletin counterQ - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'CURR') THEN, - IF (CLI$PRESENT('EDIT')) THENI - CALL READ_EDIT - RETURNQ - END IF - END IFW - - FLEN = TRIM(FOLDER) - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header info - WRITE(6,1050) DESCRIP - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THENI - WRITE(6,1060) FROM,DATE//' '//TIME(:5),'(DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?T - WRITE(6,1060) FROM,DATE//' '//TIME(:5),'Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - WRITE(6,1060) FROM,DATE//' '//TIME(:5),'Permanent' - ELSE0 - WRITE(6,1060) FROM,DATE//' '//TIME(:5),d - & 'Expires: '//EXDATE//' '//EXTIME(:5) - END IFs - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - WRITE(6,'(''+ / System'',/)')e - ELSEe - WRITE(6,'(''+'',/)') - END IF_ -CB -C Each page of the bulletin is buffered into temporary memory storage before( -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory( -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.f -Cs - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?N - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headE - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointerT - END IF - - END = 4 ! Outputted 4 lines to screen - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSE - READ_COUNT = BLOCK ! Init bulletin record counterN - END IF - -100 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to headeru - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - IF (READ_COUNT.GT.BLOCK.AND.READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,1040) BULL_POINT,FOLDER(:FLEN) ! Output bulletin header info - END = END + 1 ! Increase display counter - END IFi - CALL OPEN_FILE_SHARED(1) ! Get bulletin file - MORE_LINES = .TRUE. - READ_REC = READ_COUNT - IF (READ_ALREADY.EQ.0) ILEN = 81E - DO WHILE (MORE_LINES.AND.READ_REC.LE.BLOCK+LENGTH-1)e - DO WHILE (ILEN.GT.0.AND.MORE_LINES)b - CALL GET_BULL(READ_REC,INPUT,ILEN)L - IF (ILEN.LT.0) THEN ! Error, couldn't read recordI - READ_REC = BLOCK + LENGTH ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THENo - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)N - READ_ALREADY = 1 - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF) - END IFo - END DO - ILEN = 800 - IF (MORE_LINES) THEN - READ_REC = READ_REC + 1 - READ_ALREADY = 0) - END IF - END DO - - CALL CLOSE_FILE(1) ! End of bulletin file readi - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems withA -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the1 -C end of the previous page. The output gets confused and thinks it mustC -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C$ - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) ! Get queue recordE - IF (I.EQ.1.AND.READ_REC.NE.BLOCK.AND.READIT.GT.0) THEN - WRITE(6,2020) INPUT(:TRIM(INPUT)) ! (See above comments)L - ELSE - WRITE(6,2010) INPUT(:TRIM(INPUT)) - END IF - END DOA - - READ_COUNT = READ_REC ! Update bull record counterE - - IF (READ_REC.EQ.BLOCK+LENGTH) THEN ! Last block?E - READ_COUNT = 0 ! init bulletin record counterH - ELSE IF (READ_REC.EQ.BLOCK+LENGTH-1.AND..NOT.MORE_LINES) THEN - ! Possibly last block since end of page could be last line - CALL TEST_MORE_LINES(ILEN) ! More lines to read?. - IF (ILEN.GT.0) THEN ! Yes, there are still moreE - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Else if this is not /READ - WRITE(6,1070) ! say there is more of bulletins - END IFn - - RETURN - -1030 FORMAT(' ERROR: Specified message was not found.')( -1040 FORMAT('+Message number: ',I4,<60-FLEN>X,A) -1050 FORMAT(' Description: ',A53)O -1060 FORMAT(' From: ',A12,' Date: ',A,' ',A,$) -1070 FORMAT(1X,/,' Press RETURN for more...',/)e - -2000 FORMAT(A) -2010 FORMAT(1X,A)T -2020 FORMAT('+',A) - - END - - - - - SUBROUTINE READ_EDITa - - IMPLICIT INTEGER (A-Z)t - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'o - - CHARACTER*128 INPUT - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN. - CALL ERRSNS(IDUMMY,IER)r - CALL SYS_GETMSG(IER) - RETURN - END IF - - WRITE(3,1050) DESCRIP ! Output bulletin header infoI - WRITE(3,1060) FROM,DATE//' '//TIME(:5)L - - CALL OPEN_FILE_SHARED(1)U - - ILEN = 81 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 90 - ELSE IF (ILEN.GT.0) THENR - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - ILEN = 80r - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1)T - - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A,/) - - RETURNR - END - - - SUBROUTINE READNEW(REDO)T -CA -C SUBROUTINE READNEW -C( -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -CE - - IMPLICIT INTEGER (A-Z)I - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'C - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - CHARACTER INREAD*1,INPUT*80,FILE_DEF*80,NUMREAD*5 - - DATA LEN_FILE_DEF /0/, INREAD/0/A - - LOGICAL SLOW,SLOW_TERMINAL, - - FIRST_MESSAGE = BULL_POINT) - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first timep - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get inputF - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper cases - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THENE - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DOD - CALL EXIT - ELSEE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question+ - ELSE - CALL LIB$ERASE_PAGE(1,1), - END IF - END IFn - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1M - END IF - END IFL - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletinF - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed?D - CALL OPEN_FILE_SHARED(2) ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and systemT - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it.. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_FILE(2) - END IFe - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE/ - WRITE(6,1030)' - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper caseD - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)')y - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE.o - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to filek - WRITE (6,'(''+ '')') ! Move cursor from end of prompt lineh - ! to beginning of next line.t - IF (LEN_FILE_DEF.EQ.0) THENs - CALL LIB$SYS_TRNLOG('SYS$LOGIN',LEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:LEN-1)//'.BULL]' - LEN_FILE_DEF = LEN + 5y - ELSEC - FILE_DEF = 'SYS$LOGIN:'o - LEN_FILE_DEF = 10l - END IFe - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_FILE_SHARED(2) - CALL OPEN_FILE_SHARED(1) ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRVa - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,ERR=18, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - ILEN = 81O - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into file - DO WHILE (ILEN.GT.0)I - CALL GET_BULL(I,INPUT,ILEN)e - IF (ILEN.LT.0) THEN - GO TO 18H - ELSE IF (ILEN.GT.0) THEN - WRITE(3,'(A)') INPUT(:TRIM(INPUT)). - END IF - END DON - ILEN = 80 - END DO - WRITE(6,1040) BULL_PARAMETER(:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)N - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privilegesL - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finishede - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_FILE_SHARED(2) ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletins - CALL CLOSE_FILE(2) ! Exito - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletinsr - END IF - CALL CLOSE_FILE(2) - ELSE IF (INREAD.EQ.'R') THENt - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)')V - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12r - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THENl - WRITE(6,1010)H - RETURN - END IFE - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),messageS - & number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.')a -1020 FORMAT(1X,80('-'),/,' Type Q(Quit), - & F(File it), D(Dir), R(Read msg #) or other for next message: ',$) -1030 FORMAT(1X,80('-'),/,' Type Q(Quit), F(File), N(Next), - & D(Dir), R(Read msg #) or other for MORE: ',$) -1040 FORMAT(' Message written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/): - - END diff --git a/decus/vax88b5/bulletin/bulletin2.for b/decus/vax88b5/bulletin/bulletin2.for deleted file mode 100644 index 098aa99..0000000 --- a/decus/vax88b5/bulletin/bulletin2.for +++ /dev/null @@ -1,1389 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU@SMTP 16-AUG-1988 22:22 -To: ARISIA::EVERHART -Subj: BULLETIN2.FOR - - -Received: from deep-thought.mit.edu by EDDIE.MIT.EDU via Chaosnet with MAIL with sendmail-5.45/4.7 id ; Tue, 16 Aug 8 -8 10:39:44 EDT -Message-Id: <8808161439.AA05500@EDDIE.MIT.EDU> -Received: from PFC-VAX.MIT.EDU by DEEP-THOUGHT.MIT.EDU via Chaosnet; 16 Aug 88 10:39-EDT -Date: 16 Aug 88 10:38:45 EDT -From: MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@EE, MHG@MITRE-BEDFORD.ARPA@EE, - EVERHART%ARISIA.DECNET@GE-CRD.ARPA@EE, GAYMAN@ARI-HQ1.ARPA@EE -Subject: BULLETIN2.FOR - -C -C BULLETIN2.FOR, Version 8/3/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_FILE(7) - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,' - & ('' ERROR: BBOARD account needs DISUSER flag set.'')') - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_FILE(7) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_FILE(7) - RETURN - END IF - IF (.NOT.IER1) THEN - WRITE (6,'('' WARNING: BBOARD account not in SYSUAF'', - & '' file. Assuming mail forwarding entry.'')') - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_FILE(4) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_FILE(4) - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_FILE(7) - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_FILE(7) - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE - CALL CLOSE_FILE(7) - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_FILE(7) - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - CHARACTER UPDATE*11,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_FILE(4) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - NEW_FLAG(1) = 152 - END IF - - IF (NEW_FLAG(1).NE.152) THEN - CALL CLOSE_FILE(7) - CALL OPEN_FILE(7) - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - NEW_FLAG(1) = 152 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_FILE(4) - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero: - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1m - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0g - END IF3 - - IF (IER.NE.0) THEN8 - WRITE (4,IOSTAT=IER) - & '*SYSTEM',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,U - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE: - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,. - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF. - - IF (.NOT.FILE_OPENED) CALL CLOSE_FILE(4) - - RETURNB - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z)e - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list. - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command.U -CI -C NODE_AREA is set to 0 after shutdown messages are deleted.C -C If node is not part of cluster, NODE_AREA will be 0,B -C so set it to 1 as a dummy value to cause messages to be deleted.a -Ci - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -CO -C FUNCTION: Set or reset remote node specification for selected folder. -CO - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'O - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT7 - - CHARACTER RESPONSE*1,FOLDER_SAVE*25 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_FILE_SHARED(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')')F - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER)L - CALL CLOSE_FILE(7)) - RETURN( - END IF - CALL CLOSE_FILE(7) - END IF - - IF (FOLDER_NUMBER.EQ.0) THENR - WRITE (6,'('' Cannot set remote node for GENERAL folder.'')')N - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - IF (.NOT.NODE_SET) THENN - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE.E - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,o - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURND - END IFY - FOLDER1 = FOLDERP - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN)) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THENE - WRITE (6,'(Y - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSEE - WRITE (6,'('' Folder has been converted to remote.'')')R - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_FILE(2) ! Remove directory file - CALL OPEN_FILE(1) ! Remove bulletin fileL - CALL CLOSE_FILE_DELETE(1) - CALL CLOSE_FILE_DELETE(2) - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::'r - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"')D - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0T - CLOSE (UNIT=17) - END IFb - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1)O - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2)C - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1)R - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2)X - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMITL - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_FILE(7) - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')')E - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_FILE_SHARED(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_FILE(7) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//e - & FOLDER - END IF - - RETURNI - END - - - - - SUBROUTINE RESPOND(STATUS)S -CI -C SUBROUTINE RESPONDB -CE -C FUNCTION: Sends a mail message in reply to a posted message.. -C' -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands.2 -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTn - DATA EDIT_DEFAULT/.FALSE./ - - CHARACTER INPUT*80,FROM_TEST*5L - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_NEGATED - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read' - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And returnO - END IFI - - BULL_PARAMETER = 'RE: '//DESCRIPI - IF (CLI$PRESENT('SUBJECT')) THENL - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P)T - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURNU - END IF - END IFD - - LEN_P = TRIM(BULL_PARAMETER)W - - IF (BULL_PARAMETER(:1).NE.'"') THEN - BULL_PARAMETER = '"'//BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + 1* - END IF* - - IF (BULL_PARAMETER(LEN_P:LEN_P).NE.'"') THENE - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'"' - LEN_P = LEN_P + 1T - END IFT - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THENI - EDIT = .TRUE. - ELSEF - EDIT = .FALSE. - END IF - - IF (EDIT.AND.CLI$PRESENT('TEXT')) THENO - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,( - & STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)E - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) - - ILEN = 81W - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into fileO - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN)G - IF (ILEN.LT.0) THEN= - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - IF (CLI$PRESENT('NOINDENT')) THENE - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:MIN(79,ILEN))I - IF (ILEN.EQ.80) WRITE (3,'(A)') '>'//INPUT(80:) - END IF - END IF - END DOY - ILEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_FILE(1) - END IFL - - IF (CONFIRM_USER(FROM).EQ.0) THEN - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//FROM - & //'/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT '//FROM//'/SUBJECT='//B - & BULL_PARAMETER,,,,,,STATUS) - END IF - CALL ENABLE_PRIVSM - ELSEW - FROM_TEST = ' ' - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - L_INPUT = 81 - I = BLOCK - DO WHILE (I.LT.BLOCK+LENGTH.AND.L_INPUT.GT.0)T - CALL GET_BULL(I,INPUT,L_INPUT) - IF (L_INPUT.GT.0) THENF - CALL STR$UPCASE(FROM_TEST,INPUT(:5)) - IF (FROM_TEST.EQ.'FROM:') THENE - IF (INDEX(INPUT,'.').GT.0.OR.INDEX(INPUT,'@').GT.0 - & .OR.INDEX(INPUT,'%').GT.0) THEN - L_INPUT = 0 - END IF - END IF - ELSE IF (L_INPUT.EQ.0) THEN - L_INPUT = 80 - I = I + 1 - END IF - END DO - CALL CLOSE_FILE(1) - IF (FROM_TEST.EQ.'FROM:') THEN - L_B = INDEX(INPUT,'<')W - R_B = INDEX(INPUT,'>')I - IF (L_B.GT.0.AND.R_B.GT.0) THEN - INPUT = INPUT(L_B+1:R_B-1). - L_INPUT = R_B - 1 - L_B - ELSED - L_INPUT = TRIM(INPUT) - I = 6 - DO WHILE (INPUT(I:I).EQ.' '.AND.I.GT.0) - I = I + 1O - IF (I.GT.L_INPUT) I = 0E - END DO) - INPUT = INPUT(I:L_INPUT) - L_INPUT = L_INPUT - I + 1 - END IF - CALL DISABLE_PRIVS -C -C The commented lines contain modifications to interace with PMDFR -C using the in% syntax - Jim Gerland 29-Dec-1987 -C_ -C K = INDEX (Input, '%')T -C If (K .GT. 0) ThenR -C Input = Input (K+1:L_Input) -C L_Input = l_Input - Ko -C End Ifg -Ca - IF (EDIT) THENe - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')s -Ce -C For PMDF, uncomment the following lines and deleted the 3 linesI -C in the actual code._ -CA -C CALL LIB$SPAWN ('$MAIL SYS$LOGIN:BULL.SCR "IN%"' -C & //INPUT(:L_INPUT)// -C & '""/SUBJECT='//BULL_PARAMETER,,,,,,STATUS)d -Cl - CALL LIB$SPAWN('$CHMAIL SYS$LOGIN:BULL.SCR "'R - & //INPUT(:L_INPUT)// - & '@XX"/SUBJECT='//BULL_PARAMETER,,,,,,STATUS)7 - ELSER -CS -C For PMDF, uncomment the following lines and deleted the 2 lines_ -C in the actual code.T -CO -C CALL LIB$SPAWN ('$MAIL SYS$INPUT "IN%"'e -C & //INPUT(:L_INPUT)// -C & '""/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) -C - CALL LIB$SPAWN('$CHMAIL/I "'//INPUT(:L_INPUT)//0 - & '@XX"/SUBJECT='//BULL_PARAMETER,,,,,,STATUS)R - END IF - CALL ENABLE_PRIVS - ELSE - CALL DISABLE_PRIVSR - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')r - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//FROM - & //'/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSES - CALL LIB$SPAWN('$MAIL SYS$INPUT '//FROM//'/SUBJECT=' - & //BULL_PARAMETER,,,,,,STATUS)E - END IF6 - CALL ENABLE_PRIVS - END IF - END IF. - - IF (EDIT) THENO - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IFT - - RETURNT - - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C' -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -CR - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME_ - - CALL OPEN_FILE_SHARED(8)& - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_FILE(8)F - - RETURN( - END - - - - - - - SUBROUTINE REPLACE -Cs -C SUBROUTINE REPLACEI -CR -C FUNCTION: Replaces existing bulletin to bulletin file., -C' - IMPLICIT INTEGER (A - Z)) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTL - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'R - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER INDESCRIP*80,INPUT*80 - CHARACTER*1 ANSWER - - CHARACTER DATE_SAVE*11,TIME_SAVE*11 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL*1 DOALL - -C_ -C Get the bulletin number to be replaced. -CO - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are reading - ELSEL - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)D - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF, - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN. - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN= - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')')A - RETURNO - END IF - END IFF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')')M - RETURNF - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN= - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURNF - END IF - END IFC - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'(T - & '' ERROR: Not enough privileges to change to permanent.'')')A - RETURN - END IFE -CM -C Check to see if specified bulletin is present, and if the userR -C is permitted to replace the bulletin. -C& - - CALL OPEN_FILE_SHARED(2)I - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletinN - - CALL CLOSE_FILE(2)n - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person - RETURN ! and error out - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,m - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND. - & USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out.A - RETURNR - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IFE - -C' -C If no switches were given, replace the full bulletinP -CM - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND.D - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND.E - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND.E - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN= - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THENs - CALL GET_EXPIRED(INPUT,IER)T - IF (.NOT.IER) GO TO 910) - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:). - END IF - -8 IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletinR - READ(5,'(Q,A)',END=910,ERR=910) DESLEN,INDESCRIP - IF (DESLEN.EQ.0) GO TO 910 ! If no header, don't add bullL - IF (DESLEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fitO - GO TO 8 ! and re-request header - END IF - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,DESLEN)0 - IF (DESLEN.GT.53) THEN ! If too many characters - WRITE(6,1060) ! tell user - WRITE(6,2020) INDESCRIP(:53) ! Show how much would fitI - GO TO 910 ! and abortQ - END IF - END IF' - - - IF (CLI$PRESENT('TEXT').OR.DOALL) THENF -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -CD - L - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1T - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)S - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified= - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THENE - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specifiedP - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specifiedE - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST')I - CALL OPEN_FILE_SHARED(1) ! Prepare to copy message - ILEN = 810 - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy mesage into file - DO WHILE (ILEN.GT.0) - CALL GET_BULL(I,INPUT,ILEN) - IF (ILEN.LT.0) THEN - GO TO 5F - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - END IFP - END DOI - ILEN = 80 - END DO -5 CALL CLOSE_FILE(1). - CLOSE (UNIT=3) ! Bulletin copy completed - END IF) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')- - END IFE - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',h - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',u - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesh - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.80) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THENR - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IFB - END IFS - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED',N - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = 80 ! Length of input lineE - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.80) THEN ! Line too long.A - WRITE(6,'('' ERROR: Input line length > 80. Reinput::'')')I - ELSE IF (ILEN.GT.0) THEN ! If good input line entered, - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK8 - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outS - ENDIF - - REWIND (UNIT=3) - END IFa - -Cx -C Add bulletin to bulletin file and directory entry for to directory file. -CI - - DATE_SAVE = DATEM - TIME_SAVE = TIMEP - INPUT = DESCRIP - - CALL OPEN_FILE(2) ! Prepare to add dir entryE - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR.I - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it.A - IF (IER.NE.NUMBER_PARAM+1) DATE = ' 'I - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER)I - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_FILE(2)R - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')')V - IF (DOALL.OR.CLI$PRESENT('TEXT')) THENE - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')')) - END IF( - GO TO 100 - END IF - END IF, - - CALL READDIR(0,IER) ! Get directory headero - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN ! If text has been replacedF - - LENGTH_SAVE = LENGTH ! Copy BULL modifies LENGTH - - CALL OPEN_FILE(1) ! Prepare to add bulletint - ICOUNT = (ICOUNT+127)/128 - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - NBLOCK = NBLOCK + ICOUNT - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER)c - - CALL COPY_BULL(3,REC1,BLOCK,IER) ! Replace old bulletin( - - CALL CLOSE_FILE(1) - - IF (.NOT.REMOTE_SET) THEN, - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entryc - LENGTH = ICOUNT ! Update size - BLOCK = BLOCK_SAVEI - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IFo - - IF (.NOT.REMOTE_SET) THEN - - IF (CLI$PRESENT('HEADER').OR.CLI$PRESENT('SUBJECT')f - & .OR.DOALL) THEN - DESCRIP=INDESCRIP(:53) ! Update description header - END IF - CALL UPDATE_DIR_HEADER(CLI$PRESENT('EXPIRATION').OR.DOALL, - & CLI$PRESENT('PERMANENT'),CLI$PRESENT('SHUTDOWN'), - & INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN1 - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THENI - SYSTEM = IBCLR(SYSTEM,0)e - END IF - CALL WRITEDIR(NUMBER_PARAM,IER)P - ELSE( - MSGTYPE = 0_ - IF (CLI$PRESENT('SYSTEM').OR.& - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THENR - MSGTYPE = IBSET(MSGTYPE,0)e - END IF - IF (CLI$PRESENT('PERMANENT')) THEN - MSGTYPE = IBSET(MSGTYPE,1)W - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2)= - ELSE IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THENS - MSGTYPE = IBSET(MSGTYPE,3)r - END IF - IF (.NOT.CLI$PRESENT('HEADER').AND..NOT. - & CLI$PRESENT('SUBJECT').AND..NOT.DOALL) INDESCRIP = DESCRIP - IF (CLI$PRESENT('EXPIRATION')) THENA - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(:53),MSGTYPE,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COMT - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTEe - END IF - END IFC - - CALL CLOSE_FILE(2) ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010)T - CLOSE (UNIT=3,ERR=100)( - GOTO 100( - -920 WRITE(6,1020)H - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) - CLOSE (UNIT=3)N - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')( -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.')) -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds 80 characters.') -1050 FORMAT (' Enter description header. Limit header to 53 - & characters.') -1060 FORMAT (' ERROR: Header > 53 characters. Header would bem - & truncated to:') -1090 FORMAT(' ERROR: Specified message is not owned by you.')E -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A)u - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z)l - - INCLUDE 'BULLDIR.INC' - - CHARACTER TODAY*23,INEXDATE*11,INEXTIME*11R - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIMEp - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in! - NEWEST_EXTIME = EXTIME ! the directory file( - CALL WRITEDIR(0,IER)E - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THENA - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THENE - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBERL - WRITE (EXTIME(7:),'(I4)') NODE_AREAT - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//C - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1L - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time' - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IFS - - RETURNE - END - - - - SUBROUTINE SEARCH(READ_COUNT) -CP -C SUBROUTINE SEARCH -C. -C FUNCTION: Search for bulletin with specified string -C, - IMPLICIT INTEGER (A - Z), - - INCLUDE 'BULLDIR.INC' - - COMMON/INPUT_BULL/INPUT - CHARACTER*80 INPUTn - - CHARACTER*132 SEARCH_STRING,SAVE_STRING - DATA SEARCH_STRING /' '/, SEARCH_LEN /1/O - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAGO - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL DISABLE_CTRL - - IF (CLI$PRESENT('START')) THEN ! Starting message specifiedn - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_POINT - BULL_POINT = BULL_POINT - 1L - END IF - - SAVE_STRING = SEARCH_STRING - SAVE_LEN = SEARCH_LEN - - IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - - IF (.NOT.IER) THEN ! If no search string enteredI - SEARCH_STRING = SAVE_STRING ! use saved search string - SEARCH_LEN = SAVE_LEN - ELSE IF (.NOT.CLI$PRESENT('START')) THEN ! If string entered but no - BULL_POINT = 0 ! starting message, use firstL - END IF - - IF (IER) SUBJECT = CLI$PRESENT('SUBJECT') - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case) - - CALL OPEN_FILE_SHARED(2) - - CALL READDIR(0,IER) - - IF (BULL_POINT+1.GT.NBULL) THEN - WRITE (6,'('' ERROR: No more messages.'')')E - CALL CLOSE_FILE(2) - CALL ENABLE_CTRL - RETURN - END IF - - CALL OPEN_FILE_SHARED(1) - - CALL DECLARE_CTRLC_AST3 - - DO BULL_SEARCH = BULL_POINT+1, NBULLc - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1) THEN - CALL STR$UPCASE(DESCRIP,DESCRIP) ! Make upper caseT - IF (INDEX(DESCRIP,SEARCH_STRING(:SEARCH_LEN)).GT.0) THENf - CALL CLOSE_FILE(1)N - CALL CLOSE_FILE(2)1 - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1C - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURNW - END IFE - END IF - IF (IER.EQ.BULL_SEARCH+1.AND..NOT.SUBJECT) THENy - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCHC - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTEB - GO TO 900G - ELSE - CALL GET_REMOTE_MESSAGE(IER)N - IF (IER.GT.0) GO TO 900M - END IF - END IFP - ILEN = 81 - DO J=BLOCK,BLOCK+LENGTH-1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL(J,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_FILE(1)R - CALL CLOSE_FILE(2)I - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLA - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletinI - RETURNM - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')')A - CALL CLOSE_FILE(1)E - CALL CLOSE_FILE(2) - CALL ENABLE_CTRL& - RETURNB - END IF - END DO - ILEN = 80 - END DO - END IF - END DOD - -900 CALL CANCEL_CTRLC_ASTh - - CALL CLOSE_FILE(1) ! End of bulletin file readf - CALL CLOSE_FILE(2)e - - CALL ENABLE_CTRL - - WRITE (6,'('' No messages found with given search string.'')') - - RETURNa - END - - - - - SUBROUTINE UNDELETE -C/ -C SUBROUTINE UNDELETE -C+ -C FUNCTION: Undeletes deleted message.N -CT - IMPLICIT INTEGER (A - Z)L - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'( - - INCLUDE 'BULLFOLDER.INC't - - EXTERNAL CLI$_ABSENT - -CT -C Get the bulletin number to be undeleted. -CC - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I)f - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSEU - BULL_DELETE = BULL_POINT ! Delete the file we are readingL - END IF( - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -CI - - CALL OPEN_FILE(2) - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?L - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IFS - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,F - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or1 - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out.E - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?R - WRITE(6,1030) ! If not, then error outE - GOTO 100 - END IF - END IF - END IF_ - - IF (SYSTEM.LE.1) THEN ! General or System message_ - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:), - END IF - END IF( - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date_ - WRITE (6,'('' Message was undeleted.'')')O - ELSET - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)- - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I)h - ELSEe - WRITE (6,'('' Message was undeleted.'')')e - END IFg - ELSE - CALL DISCONNECT_REMOTEc - END IF - END IF' - -100 CALL CLOSE_FILE(2) - -900 RETURN - -910 WRITE(6,1010)R - GO TO 900 - -920 WRITE(6,1020). - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.')a -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.')i - - END diff --git a/decus/vax88b5/bulletin/bulletin3.for b/decus/vax88b5/bulletin/bulletin3.for deleted file mode 100644 index 6d63ced..0000000 --- a/decus/vax88b5/bulletin/bulletin3.for +++ /dev/null @@ -1,1520 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU@SMTP 16-AUG-1988 22:29 -To: ARISIA::EVERHART -Subj: BULLETIN3.FOR - - -Received: from deep-thought.mit.edu by EDDIE.MIT.EDU via Chaosnet with MAIL with sendmail-5.45/4.7 id ; Tue, 16 Aug 8 -8 10:40:49 EDT -Message-Id: <8808161440.AA05515@EDDIE.MIT.EDU> -Received: from PFC-VAX.MIT.EDU by DEEP-THOUGHT.MIT.EDU via Chaosnet; 16 Aug 88 10:40-EDT -Date: 16 Aug 88 10:39:46 EDT -From: MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@EE, MHG@MITRE-BEDFORD.ARPA@EE, - EVERHART%ARISIA.DECNET@GE-CRD.ARPA@EE, GAYMAN@ARI-HQ1.ARPA@EE -Subject: BULLETIN3.FOR - -C -C BULLETIN3.FOR, Version 8/12/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*11 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF (SYSTEM.LE.3.OR.(OLD_SHUTDOWN.EQ.0! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - EXTIME(3:4) = EXTIME(4:5) - READ (EXTIME(1:4),'(I4)') NODE_NUMBER_MSG - EXTIME(9:10) = EXTIME(10:11) - READ (EXTIME(7:10),'(I4)') NODE_AREA_MSG - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - END IF - ELSE - DIFF = 1 - END IF - IF (DIFF.EQ.1) NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF (SYSTEM.LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - CALL CLOSE_FILE(4) - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previousA -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -Ch - BULL_POINT = -1 ! Init bulletin pointer; - - CALL OPEN_FILE_SHARED(2) ! Yep, so get directory file5 - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THENv - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_FILE(2)O - RETURN- - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER)a - ELSE ! SYSTEM bulletin was not seens - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSER - START = START + 1 - CALL READDIR(START,IER) - END IFC - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IFD - - CALL CLOSE_FILE(2)M - - RETURNW - END - - - - SUBROUTINE GET_EXPIRED(INPUT,IER) - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC'P - - CHARACTER*23 INPUT - CHARACTER*23 TODAY. - - DIMENSION EXTIME(2),NOW(2)E - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',INPUT,ILEN) - - PROMPT = .TRUE. - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE.u - ELSE - WRITE(6,1030) TODAY ! Prompt for expiration date - CALL GET_LINE(INPUT,ILEN) ! Get input line - END IF - ELSEe - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0f - RETURN - END IF - - INPUT = INPUT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(INPUT,'-').EQ.0.AND.INDEX(INPUT,':').GT.0.AND. - & INDEX(INPUT(:ILEN),' ').EQ.0) THEN - INPUT = TODAY(:INDEX(TODAY(2:),' ')+1)//INPUT - END IFp - - CALL STR$UPCASE(INPUT,INPUT) ! Convert to upper case - IER = SYS_BINTIM(INPUT,EXTIME)D - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - GO TO 5 - END IFQ - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - IF (TIMLEN.EQ.16) THEN( - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,INPUT,EXTIME,) - END IF - - IF (INPUT(2:2).EQ.'-') INPUT = '0'//INPUT - IER = COMPARE_DATE(INPUT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN( - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limitN - GO TO 5 - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(INPUT(13:),TODAY(13:)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - GO TO 5 ! and re-request date - END IFN - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A23, - &'. Specify when the message should expire:',/,1x,) - &'Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - &'or delta time: dddd hh:mm:ss')b -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.s - & Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z)t - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILEF - - CHARACTER*80 MAIL_EDIT,OUTD - - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - IF (IER.NE.SS$_NORMAL) MAIL_EDIT = 'SYS$SYSTEM:MAILEDIT' - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THENe - OUT = INFILE - END IFP - - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - CALL DISABLE_PRIVS - IF (OUT.EQ.INFILE) THEN - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT))t - & //' "" '//OUT(:TRIM(OUT))) - ELSE - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT))I - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - END IF - CALL ENABLE_PRIVS_ - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0) THEN) - CALL EDT$EDIT(INFILE,OUT)E - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN - CALL TPU$EDIT(INFILE,OUT)_ - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)N - ! TPU does CLI$ stuff which wipes our parsed command lineO - END IF - - RETURNe - END - - - - - - SUBROUTINE CREATE_BULLCPT - - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($PRCDEF)' - - INCLUDE '($JPIDEF)' - - INCLUDE '($SSDEF)'D - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15N - - DIMENSION SAVEPRIV(2) - - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' ERROR: Account with username DECNET'', - & '' does not exist.'')')W - WRITE (6,'('' BULLCP cannot be created.'')') - CALL EXIT - END IFe - - CALL DISABLE_PRIVS ! Just let real privileged people do a /STARTUP - - CALL SYS$SETPRV(%VAL(1),PROCPRIV,,SAVEPRIV) ! Enable original privH - - JUST_STOP = CLI$PRESENT('STOP') - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXITM - END IF - - WILDCARD = -1_ - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID))a - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1 - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP')S - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.) - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')')- - CALL EXIT - END IFe - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)e - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:'M - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR 'B - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00'( - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionE - - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0)) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM','NL:'I - & ,,,,'BULLCP',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))Y - END DO( - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1)S - END IF - - CALL SYS$SETPRV(%VAL(0),SAVEPRIV,,) ! Reset privs - - CALL ENABLE_PRIVS - - IF (.NOT.IER) THENt - CALL SYS_GETMSG(IER) - ELSE - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IFe - CALL EXIT - - END - - - - SUBROUTINE FIND_BULLCPZ - - IMPLICIT INTEGER (A-Z)P - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*1 DUMMY - - IER = SYS_TRNLNM('BULL_BULLCP',DUMMY) - IF (IER) BULLCP = 1 - - RETURNt - END - - - - - LOGICAL FUNCTION TEST_BULLCPA - - IMPLICIT INTEGER (A-Z)v - - COMMON /BCP/ BULLCP - LOGICAL BULLCP. - - TEST_BULLCP = BULLCP - - RETURNn - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z)c - - INCLUDE 'BULLFOLDER.INC'h - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'L - - COMMON /BCP/ BULLCP - LOGICAL BULLCPc - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSi - - CHARACTER*23 OLD_TIME,NEW_TIMEv - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME)B - - BULLCP = 2 ! Enable process to do BULLCP functionsT - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP')R - IF (.NOT.IER) THEN ! Can't create mailbox, so exit.) - CALL SYS_GETMSG(IER) - CALL EXIT - END IF( - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL START_DECNET - - DO WHILE (1) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connectiosn - CALL SYS$SETAST(%VAL(1)) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))B - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THENW - CALL DELETE_EXPIRED ! Delete expired messages - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Do empty blockT - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! cleanup at 3 a.m.. - IF (NEMPTY.GT.200) THENf - CALL CLEANUP_BULLFILE ! Cleanup empty blocksD - END IF - END IF - END IF - END IFe - CALL SYS$SETAST(%VAL(1)) - END DO - OLD_TIME = NEW_TIME0 - CALL WAIT('15') ! Wait for 15 minutes -CI -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder. -C which requires killing process. -CD - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))d - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF( - CALL SYS$SETAST(%VAL(1))E - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folderU - CALL SELECT_FOLDER(.FALSE.,IER)N - CALL REGISTER_BULLCP - CALL SYS$SETAST(%VAL(1)) - END DOX - - RETURNA - END - - - - SUBROUTINE REGISTER_BULLCPT - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG)x - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)I - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8E - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_FILE(4) - - DO WHILE (REC_LOCK(IER))T - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0) THENs - DO I=1,FLONG - SYSTEM_FLAG(I) = 0t - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0R - END IFi - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)A - - DO I=1,FLONGF - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I)C - END DOS - - IF (IER.NE.0) THENA - WRITE (4,IOSTAT=IER) - & '*SYSTEM',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGD - ELSER - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGT - END IF - - CALL CLOSE_FILE(4) - - RETURNX - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8/ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG), - - CALL OPEN_FILE(4) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DOc - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONGO - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DOC - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THENE - WRITE (4,IOSTAT=IER) - & '*SYSTEM',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSEM - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG' - END IFc - - CALL CLOSE_FILE(4) - - RETURNI - END - - - - - - SUBROUTINE WAIT(PARAM)t -Ct -C SUBROUTINE WAITo -C -C FUNCTION: Waits for specified time period in minutes.P -C) - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time_ - ! in desired system format.T - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/& - - DATA WAIT_EF /0/i - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF)5 - - TIMBUF(6:7) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(2)) ! Set timer.I - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set.s - - RETURNL - END - - - - SUBROUTINE WAIT_SEC(PARAM)C -CC -C SUBROUTINE WAIT_SECI -CS -C FUNCTION: Waits for specified time period in seconds.S -C! - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing timeN - ! in desired system format.r - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/P - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF). - - TIMBUF(9:10) = PARAME - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set.e - - RETURNe - END - - - - - SUBROUTINE DELETE_EXPIRED - -CF -C SUBROUTINE DELETE_EXPIRED -C' -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files,: -C they get converted now. The directory file has had it's record sizeL -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and( -C was replaced with a 128 byte record compressed format). -C1 - - IMPLICIT INTEGER (A-Z)P - - INCLUDE 'BULLUSER.INC'R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)' - - CHARACTER UPTIME_DATE*11,UPTIME_TIME*11 - - CALL OPEN_FILE_SHARED(2) ! Open directory filed - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - CALL CLOSE_FILE(1)f - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls?E - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')N - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.) - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked?) - SHUTDOWN = 0L - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENT - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF' - IER1 = 1C - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Reopen without sharing - CALL UPDATE ! Need to updateU - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_FILE(4) ! Create user file to be able to set - CALL CLOSE_FILE(4) ! defaults, privileges, etc. - END IF - CALL CLOSE_FILE(2)T - - RETURNL - END - - - - - SUBROUTINE BBOARD -CC -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins.P -CU - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'I - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*74,INFROM*74,INTO*76,INPUT*132B - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - - DIMENSION NEW_MAIL(FOLDER_MAX)G - - DATA SPAWN_EF/0/E - - CALL SYS$SETAST(%VAL(0))D - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF)e - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1r - - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from fileo - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)N - END IF - END DOW - - CALL CLOSE_FILE(7) ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1))) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900a - - CALL SYS$SETAST(%VAL(0))E - - FOLDER_Q_SAVE = FOLDER_Qt - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD.EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -Co - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present accountm - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uicS - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY)A - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)//0 - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errorsR - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)N - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF))E - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THENF - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM',N - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE'A - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)D - CALL SYS$SETAST(%VAL(1)) - CALL SYS$WAITFR(%VAL(SPAWN_EF))N - CALL SYS$SETAST(%VAL(0)) - END IF - ELSEN - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARDT - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THENO - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//* - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1))C - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0))E - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THENB - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//N - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)R - CALL SYS$SETAST(%VAL(1))e - CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)), - END IF - END IFR - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM)O - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original accountU - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=110) - CALL SYS$SETAST(%VAL(1))A - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - LEN_INPUT = 1 - DO WHILE (LEN_INPUT.GT.0) - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mailF - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store usernameT - ELSE IF (INPUT(:5).EQ.'Subj:') THENt - INDESCRIP = INPUT(7:) ! Store subjectf - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store addressR - END IF - END DO - - INTO = INTO(:TRIM(INTO))e - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - IF (INDEX(INTO,FOLDER_BBOARD(:FLEN)).EQ.0.AND.t - & INTO.NE.FOLDER_BBOARD.AND.INDEX(INTO,'@').EQ.0) THEN - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOLDER1_BBOARD = FOLDER_BBOARD - FOUND = .FALSE.B - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - FOLDER_Q2_SAVE = FOLDER_Q2I - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM)D - FLEN = TRIM(FOLDER1_BBOARD) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND.f - & FOLDER1_BBOARD.NE.'NONE') THEN - IF (INTO.EQ.FOLDER1_BBOARD) THEN - FOUND = .TRUE. - ELSEd - FIND_TO = INDEX(INTO,FOLDER1_BBOARD(:FLEN))t - IF (FIND_TO.GT.0) THEN - END_TO = FLEN+FIND_TO - IF (TRIM(INTO).LT.END_TO.OR.f - & INTO(END_TO:END_TO).LT.'A'.OR.e - & INTO(END_TO:END_TO).GT.'Z') THEN - IF (FIND_TO.EQ.1) THENh - FOUND = .TRUE. - ELSE IF (INTO(FIND_TO-1:FIND_TO-1).LT.'A'.OR. - & INTO(FIND_TO-1:FIND_TO-1).GT.'Z') THEN - FOUND = .TRUE. - END IF - END IFO - END IF - END IF - END IFB - END DO - IF (FOUND) THENS - IF (F_NBULL.NE.NBULL) CALL UPDATE_FOLDER, - FOLDER_COM = FOLDER1_COM_ - FOLDER_Q_SAVE = FOLDER_Q2_SAVE - END IF - END IF - - IF (FOLDER_NUMBER.EQ.0) THENI - FOLDER_SET = .FALSE. - ELSEe - FOLDER_SET = .TRUE.I - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//W - & FOLDER - END IFy - -Cr -C Add bulletin to bulletin file and directory entry to directory file.d -C - - CALL OPEN_FILE(2) ! Prepare to add dir entry_ - - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - IF (IER.NE.0) GO TO 100 ! If end of file, exitD - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) GO TO 5 - ! If line is just form feed, the message is empty - - CALL OPEN_FILE(1) ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK_ - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - OCOUNT = NBLOCK + 1 ! Initialize line count - - SPACE = INDEX(INFROM,' ') - 1 ! Strip off the date - IF (SPACE.GT.0) INFROM = INFROM(:SPACE)! From the "From:" lineC - - IF (TRIM(INFROM).GT.12) THEN ! Is length > allowable?d - LEN_INFROM = TRIM(INFROM)u - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM),b - & OCOUNT)A - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) - I = 12 ! Trim username to first non-alpha character - DO WHILE (I.GT.1.AND.D - & ((INFROM(I:I).GE.'A'.AND.INFROM(I:I).LE.'Z').OR. - & (INFROM(I:I).GE.'a'.AND.INFROM(I:I).LE.'z')) )E - I = I - 1 - END DO - IF (I.GT.1) INFROM = INFROM(:I-1)' - END IFO - - LEN_DESCRP = TRIM(INDESCRIP)O - IF (LEN_DESCRP.GT.53) THEN ! Is length > allowable subject length?S - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//INDESCRIP(:LEN_DESCRP), - & OCOUNT)D - INDESCRIP = INDESCRIP(:LEN_DESCRP) - DO I=1,LEN_DESCRPY - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - ELSEL - DO I=1,LEN_DESCRP ! Remove control charactersO - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - END IF - - ISTART = 0= - NBLANK = 0 - DO WHILE (INPUT(:1).NE.CHAR(12)) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IFR - ELSE - ISTART = 1E - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DOn - NBLANK = 0e - CALL STORE_BULL(MIN(LEN_INPUT,80),INPUT,OCOUNT) - IF (LEN_INPUT.GT.80) THEN ! Breakup line if > 80 chars - CALL STORE_BULL(MIN(LEN_INPUT,132)-80,INPUT(81:),OCOUNT)A - END IF - END IF - READ (3,'(Q,A)',END=25) LEN_INPUT,INPUT - END DOI - -25 CALL FLUSH_BULL(OCOUNT) - - CALL CLOSE_FILE(1) ! Finished adding bulletin - - DESCRIP = INDESCRIP(:53) ! Description headerO - FROM = INFROM(:12) ! Username - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IFD - EXTIME = '00:00:00.00'o - LENGTH = OCOUNT - NBLOCK ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - -30 CALL CLOSE_FILE(2) ! Totally finished with adde - - CALL SYS$SETAST(%VAL(1))O - - GO TO 5 ! See if there is more mail - -100 CALL UPDATE_FOLDER - -110 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1))e - GOTO 1 - -900 FOLDER_NUMBER = 0( - - CALL OPEN_FILE_SHARED(7)o - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_FILE(7)e - CALL ENABLE_CTRLE - FOLDER_SET = .FALSE.( - - IF (NBBOARD_FOLDERS.EQ.0) THENT - CALL OPEN_FILE(4)( - CALL READ_USER_FILE_HEADER(IER)I - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM)f - REWRITE (4) USER_HEADER ! Rewrite headerN - CALL CLOSE_FILE(4) - END IFE - - RETURN! - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2)' - WRITE (6,1030)S - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.')L -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESSN - - IMPLICIT INTEGER (A-Z)A - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY)R - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)D - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')A - IF (IER.NE.0) RETURNR - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT'e - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT'O - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:') - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11)A - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection( - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURNB - END - - - - SUBROUTINE GETUIC(GRP,MEM), -C -C SUBROUTINE GETUIC(UIC)N -C) -C FUNCTION: -C To get UIC of process submitting the job.( -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UICA -C' - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list/ - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist$ - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURNL - END - - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)L -CF -C SUBROUTINE GET_UPTIME -CT -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z)e - - EXTERNAL EXE$GL_ABSTIMC - INTEGER UPTIME(2),SYSTIME(2),UPSINCE(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - UPTIME(1) = GET_L_VAL(EXE$GL_ABSTIM) ! Up time (sec)= - - CALL LIB$EMUL(10000000,UPTIME,0,UPTIME) ! 64 bit format - CALL SYS$GETTIM(SYSTIME)E - CALL LIB$SUBX(SYSTIME,UPTIME,UPSINCE) - CALL SYS$ASCTIM(,ASCSINCE,UPSINCE,) ! Up since - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:) - - RETURN - END - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURNT - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS: - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*37,FILENAME*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointerA - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - OFFSET = 36 - - IF (IER.NE.0) THENL - OPEN (UNIT=10,FILE='VMSMAIL',_ - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT',O - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)I - OFFSET = 34_ - END IFN - - DO I=1,NUM_FOLDERSB - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)' - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR.E - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::') THEN - ! If normal BBOARD or /VMSMAILT - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - CALL LIB$MOVC3(2,%REF(INPUT(OFFSET:)),COUNT) - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN. - NEW_MAIL(I) = .TRUE. - ELSEE - NEW_MAIL(I) = .FALSE. - END IFO - ELSE - NEW_MAIL(I) = .TRUE.F - END IF - END DON - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN)N -CF -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN)O -C) -C FUNCTION: -C To get image name of process.E -C OUTPUT: -C IMAGNAME - Image name of processL -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAMEe - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listE - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN))e - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlista - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2)) - - IF (REMOTE_SET) THENt - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSEI - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IFT - - RETURNe - END diff --git a/decus/vax88b5/bulletin/bulletin4.for b/decus/vax88b5/bulletin/bulletin4.for deleted file mode 100644 index 3a5b312..0000000 --- a/decus/vax88b5/bulletin/bulletin4.for +++ /dev/null @@ -1,1506 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU@SMTP 16-AUG-1988 22:49 -To: ARISIA::EVERHART -Subj: BULLETIN4.FOR - - -Received: from deep-thought.mit.edu by EDDIE.MIT.EDU via Chaosnet with MAIL with sendmail-5.45/4.7 id ; Tue, 16 Aug 8 -8 10:42:17 EDT -Message-Id: <8808161442.AA05542@EDDIE.MIT.EDU> -Received: from PFC-VAX.MIT.EDU by DEEP-THOUGHT.MIT.EDU via Chaosnet; 16 Aug 88 10:41-EDT -Date: 16 Aug 88 10:40:43 EDT -From: MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@EE, MHG@MITRE-BEDFORD.ARPA@EE, - EVERHART%ARISIA.DECNET@GE-CRD.ARPA@EE, GAYMAN@ARI-HQ1.ARPA@EE -Subject: BULLETIN4.FOR - -C -C BULLETIN4.FOR, Version 8/3/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist -C if it creates empty space for new user. -C - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CALL OPEN_FILE_SHARED(8) - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_FILE(9) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_FILE(9) - END IF - - CALL CLOSE_FILE(8) ! All done... - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - CHARACTER INPUT*80 - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),80) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*(BRECLEN) - - DATA POINT/0/ - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT) - POINT = 0 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z)L - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUTR - - IF (REMOTE_SET) THENL - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSEE - WRITE (1'OCOUNT) OUTPUTI - END IFn - - RETURN4 - END - - - SUBROUTINE GET_BULL(IBLOCK,INPUT,ILEN)4 - - IMPLICIT INTEGER (A-Z)1 - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128,LINE_LENGTH=80M - - CHARACTER INPUT*(*),TEMP*(BRECLEN), LEFT*(BRECLEN) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (ILEN.GT.LINE_LENGTH) THEN - POINT = 1R - LEFT_LEN = 0 - END IFL - - IF (POINT.EQ.1) THENE - IF (REMOTE_SET) THEN - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 l - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) - ELSE - DO WHILE (REC_LOCK(IER))S - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DOe - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN - ILEN = 0 - POINT = 1s - RETURN - END IF - - IF (IER.GT.0) THEN - ILEN = -1 - POINT = 1c - LEFT_LEN = 0 - RETURN - END IFt - - IF (LEFT_LEN.GT.0) THEN - ILEN = ICHAR(LEFT(:1)) - INPUT = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) - POINT = LEFT_LEN + 1 - LEFT_LEN = 0 - ELSEd - ILEN = ICHAR(TEMP(POINT:POINT))E - IF (ILEN.GT.BRECLEN-POINT) THENM - LEFT = TEMP(POINT:) - LEFT_LEN = ILEN - (BRECLEN-POINT) - ILEN = 0! - POINT = 1 - ELSE IF (ILEN.EQ.0) THEN - POINT = 1 - ELSE - INPUT = TEMP(POINT+1:POINT+ILEN)T - POINT = POINT+ILEN+1E - END IF - END IFE - - RETURNR - - ENTRY TEST_MORE_LINES(ILEN) - - IF (POINT.EQ.BRECLEN+1) THEN - ILEN = 0 - ELSEH - ILEN = ICHAR(TEMP(POINT:POINT))e - END IFA - - RETURNV - - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER)e -C -C SUBROUTINE GET_REMOTE_MESSAGE -CD -C FUNCTION: -C Gets remote message. -C3 - - IMPLICIT INTEGER (A-Z)! - - INCLUDE 'BULLDIR.INC' - - CHARACTER*128 INPUT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty?R - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to headT - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointerA - END IF - - ILEN = 128T - IER = 0 - LENGTH = 0I - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) THEN - LENGTH = 01 - IER1 = IERt - CALL DISCONNECT_REMOTE, - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DOE - - RETURN - END - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -CS -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C, -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -Ci - - IMPLICIT INTEGER (A-Z)y - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'i - - CHARACTER*80 INPUT_ - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IFA - - IF (BTEST(FOLDER_FLAG,1)) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - WRITE (3,1050) DESCRIP ! Output bulletin header infoa - WRITE (3,1060) FROM,DATE - - CALL OPEN_FILE(1)l - - ILEN = 81i - DO I=BLOCK,BLOCK+LENGTH-1 ! Copy bulletin into fileM - DO WHILE (ILEN.GT.0)V - CALL GET_BULL(I,INPUT,ILEN)S - IF (ILEN.LT.0) THENL - GO TO 90 - ELSE IF (ILEN.GT.0) THEN - WRITE (3,'(A)') INPUT(:ILEN)) - END IF - END DOn - ILEN = 80 - END DO - -90 CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_FILE(1) - END IF - -900 CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2)T - - NEMPTY = NEMPTY + LENGTH - CALL WRITEDIR(0,IER) - -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A11,/)I - - RETURNT - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -CI -C SUBROUTINE GET_EXDATE -CI -C FUNCTION: Computes expiration date giving number of days to expire.E -C - IMPLICIT INTEGER (A-Z)O - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12)T - DIMENSION LENGTH(12)s - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP',r - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/F - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present dateA - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1. - END DOE - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE9 - LENGTH(2) = 27 - END IF, - - NUM_DAYS = NDAYS ! Put number of days into buffer variableF - - DO WHILE (NUM_DAYS.GT.0)S - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of monthE - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of monthp - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27e - END IF - END IFP - ELSE ! If expiration date is within the monthO - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DON - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT)N -C. -C SUBROUTINE GET_LINE -C) -C FUNCTION: -C Gets line of input from terminal.( -CU -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -Cm -C NOTES:I -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST.E -CT - - IMPLICIT INTEGER (A-Z)T - - LOGICAL*1 DESCRIP(8),DTYPE,CLASSC - INTEGER*2 LENGTHN - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE)T - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPTL - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT)) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE andI -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1H -C - - CALL DECLARE_CTRLC_AST( - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limitP - POINTER = 0 ! during input. - -CU -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line.T -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTI - IF (IER.NE.0) LEN_INPUT = -2 N - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt. - ELSE) - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no promptU - END IFC - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER)_ - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT)( - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of lineE - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO_ - CALL CONVERT_TABS(INPUT,LEN_INPUT)L - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so, - END IF - ELSEI - LEN_INPUT = -1 ! If CTRL-C, say so - END IFE - RETURN0 - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT)T - - IMPLICIT INTEGER (A-Z)Q - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT)_ - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DOI - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMITL - INPUT(I:I) = ' ' - END DON - LEN_INPUT = LIMIT+1 - END IF - END DOT - - CALL FILTER (INPUT, LEN_INPUT) - - RETURNE - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHARI - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10)) - & .OR.INCHAR(I:I).GT.'~') INCHAR(I:I) = '.' - END DOS - - RETURNS - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logicalN - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT)A - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLYN - - COMMON /CTRLC_FLAG/ FLAG - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...')S - CALL SYS$CANEXH() - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXITC - END IF - FLAG = 1 ! to set flag - RETURNo - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast.o -C NOTES:D -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/.0 -CD - IMPLICIT INTEGER (A-Z)O - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINEE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flagR - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO) - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_ASTE - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOb - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURNI - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -CP - IMPLICIT INTEGER (A-Z)E - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHANT - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGD - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./) - - DO I=1,LEN(DATA)l - DATA(I:I) = ' ' - END DO3 - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),K - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),L - & TRM$M_TM_NOECHO) - END IF - - RETURNI - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT)) - - DO I=1,LEN(DATA) - DATA(I:I) = ' 'D - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.) - ELSET - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),R - & TRM$M_TM_NOECHO) - END IF, - - RETURNF - - ENTRY GET_INPUT_NUM(DATA,NLEN)I - - DO I=1,LEN(DATA) - DATA(I:I) = ' '_ - END DOD - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),t - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,,N - & TERMSET,NLEN,TERM) - END IF' - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN& - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM)$ - END IFX - - RETURNG - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal' - - CALL DECLARE_CTRLC_ASTe - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20)D - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID)h - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)e - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPADD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IFM - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9')o - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN- - END - - - - - - SUBROUTINE GETPAGLEN(PAGE_LENGTH) -Cy -C SUBROUTINE GETPAGLEN -CD -C FUNCTION: -C Gets page length of the terminal.N -C= -C OUTPUTS:! -C PAGE_LENGTH - Page length of the terminal. -CH - IMPLICIT INTEGER (A-Z)r - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = DEVDEPEND(4)! - - RETURNi - END - - - - - - LOGICAL FUNCTION SLOW_TERMINALN -CD -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less).E -CT -C OUTPUTS:P -C SLOW_TERMINAL = .true. if slow, .false. if not.) -CA - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE) - - COMMON /TERM_CHAN/ TERM_CHANR - - COMMON CHAR_BUF(2)B - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)'B - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE.N - END IF - - RETURNr - END - - - - - SUBROUTINE SHOW_PRIV -CU -C SUBROUTINE SHOW_PRIVi -Cg -C FUNCTION: -C To show privileges necessary for managing bulletin board.T -C, - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'V - - INCLUDE '($PRVDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not presentT - CALL CLOSE_FILE(4) - CALL OPEN_FILE(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRVi - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')')c - DO I=0,38t - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR.T - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE2 - WRITE (6,'('' ERROR: Cannot show privileges.'')')i - END IF - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURNa - - END - - - - - SUBROUTINE SET_PRIV -Cn -C SUBROUTINE SET_PRIV -Ce -C FUNCTION: -C To set privileges necessary for managing bulletin board. -CN - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'N - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVSi - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/E - - EXTERNAL CLI$_ABSENT - - DIMENSION ONPRIV(2),OFFPRIV(2). - - CHARACTER*8 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THENP - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - OFFPRIV(1) = 0L - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,LEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - PRIV_FOUND = -1S - I = 0I - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1)T - IF (INPUT_PRIV(:LEN).EQ.PRIVS(I)) PRIV_FOUND = II - IF (INPUT_PRIV(3:LEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:LEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THENN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')')D - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSET - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)T - END IF - ELSE - IF (PRIV_FOUND.LT.32) THENI - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE, - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32)& - END IFI - END IF - END DOH - - CALL OPEN_FILE(4) ! Get BULLUSER.DAT file) - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2))I - REWRITE (4) USER_HEADERC - WRITE (6,'('' Privileges successfully modified.'')') - ELSE/ - WRITE (6,'('' ERROR: Cannot modify privileges.'')')B - END IFb - - CALL CLOSE_FILE(4) ! All finished with BULLUSER - - RETURNR - - END - - - - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACLR -CR -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.E -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -CR - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLFOLDER.INC'A - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*)L - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)'o - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,)E - IF (.NOT.IER) THENA - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THENu - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')')n - CALL SYS_GETMSG(IER) - RETURN - END IFU - IDENT = USER + ISHFT(GROUP,16)N - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,)T - END IFM - END IF - END IFH - IF (.NOT.IER) RETURNO - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//E - & '.BULLDIR',%VAL(ACL_ITMLST),,,)R - IF (.NOT.IER) RETURND - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//G - & '.BULLFIL',%VAL(ACL_ITMLST),,,)L - IF (.NOT.IER) RETURNR - - RETURNL - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -CR -C SUBROUTINE DEL_ACLP -CN -C FUNCTION: Adds ACL to bulletin files. -CA -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.M -C IER - Return error from attempting to set ACL. -CG -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLFOLDER.INC'T - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item listR - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT))T - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT))S - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistn - END IF' - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,)R - IF (.NOT.IER) RETURNS - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//A - & '.BULLFIL',%VAL(ACL_ITMLST),,,)T - IF (.NOT.IER) RETURNA - - RETURNA - END - - - - - SUBROUTINE CREATE_FOLDERL -CT -C SUBROUTINE CREATE_FOLDERS -C1 -C FUNCTION: Creates a new bulletin folder.A -C0 - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THENH - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IFC - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IFA - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privilegedE - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR.L - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'(u - & '' ERROR: No privs for SYSTEM, NOTIFY, BRIEF or READNEW.'')') - RETURN - END IFP - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B)E - FOLDER1_BBOARD = FOLDER_BBOARD - FOLDER1 = FOLDER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURNO - ELSE IF (CLI$PRESENT('SYSTEM').AND.P - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURND - END IF - END IFE - - LENDES = 0A - DO WHILE (LENDES.EQ.0)L - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES)x - ELSE - WRITE (6,'('' Enter one line description of folder.'')')n - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THENR - WRITE (6,'('' Aborting folder creation.'')')E - RETURNR - ELSE IF (LENDES.GT.80) THEN ! If too many characterse - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - LENDES = 0T - END IF - END DOR - - CALL OPEN_FILE(7) ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0)R - ! See if folder existsN - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IFi - - IF (CLI$PRESENT('OWNER')) THENE - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_FILE(7)b - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAFC - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER)P - IF (.NOT.IER) THEN3 - WRITE (6,'('' ERROR: Owner not valid username.'')')A - CALL CLOSE_FILE(7) - RETURN - ELSE' - FOLDER_OWNER = FOLDER1_OWNER - END IFT - END IF - ELSED - FOLDER_OWNER = USERNAME ! Get present username' - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF' - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)R - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -CD -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder.1 -CR - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 9102 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDERT - END IFR - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))S - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,I - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')N - - IF (IER.NE.0) THEND - WRITE(6,'('' ERROR: Cannot create folder directory file.'')')i - CALL ERRSNS(IDUMMY,IER)T - CALL SYS_GETMSG(IER) - GO TO 910 - END IFI - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THENF - WRITE(6,'('' ERROR: Cannot create folder message file.'')')( - CALL ERRSNS(IDUMMY,IER)D - CALL SYS_GETMSG(IER) - GO TO 9103 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN) - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1)4 - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))l - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1)C - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER)_ - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IFl - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1)g - LAST_NUMBER = LAST_NUMBER + 1 - END DOu - - IF (IER.EQ.0) THENg - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAXZ - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910C - ELSEL - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IFo - - IF (.NOT.CLI$PRESENT('NODE')) THEN/ - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0D - NBULL = 0O - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - REMOTE_SET = .TRUE.D - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0)_ - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF) - - FOLDER_OWNER = FOLDER1_OWNERn - - IF (CLI$PRESENT('SYSTEM')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - END IF) - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0)F - - CLOSE (UNIT=1)F - CLOSE (UNIT=2)S - - NOTIFY = 0L - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THENC - BRIEF = 1 - READNEW = 1T - END IFR - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)')T - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000: - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE.i - CLOSE (UNIT=1,STATUS='DELETE')M - CLOSE (UNIT=2,STATUS='DELETE')p - -1000 CALL CLOSE_FILE(7)T - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionE - - RETURN - - END - diff --git a/decus/vax88b5/bulletin/bulletin5.for b/decus/vax88b5/bulletin/bulletin5.for deleted file mode 100644 index 37effd9..0000000 --- a/decus/vax88b5/bulletin/bulletin5.for +++ /dev/null @@ -1,1479 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU@SMTP 16-AUG-1988 22:55 -To: ARISIA::EVERHART -Subj: BULLETIN5.FOR - - -Received: from deep-thought.mit.edu by EDDIE.MIT.EDU via Chaosnet with MAIL with sendmail-5.45/4.7 id ; Tue, 16 Aug 8 -8 10:43:22 EDT -Message-Id: <8808161443.AA05571@EDDIE.MIT.EDU> -Received: from PFC-VAX.MIT.EDU by DEEP-THOUGHT.MIT.EDU via Chaosnet; 16 Aug 88 10:42-EDT -Date: 16 Aug 88 10:41:26 EDT -From: MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@EE, MHG@MITRE-BEDFORD.ARPA@EE, - EVERHART%ARISIA.DECNET@GE-CRD.ARPA@EE, GAYMAN@ARI-HQ1.ARPA@EE -Subject: BULLETIN5.FOR - -C -C BULLETIN5.FOR, Version 8/8/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (.NOT.SETPRV_PRIV().AND.INCMD(:3).EQ.'SET') THEN - WRITE (6,'( - & '' ERROR: No privs to change all defaults.'')') - RETURN - END IF - - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_HEADER(IER) - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - - IF (BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - CALL CLOSE_FILE(4) - - RETURN - END - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL OPEN_FILE(2) ! Remove directory file - CALL OPEN_FILE(1) ! Remove bulletin file - CALL CLOSE_FILE_DELETE(1) - CALL CLOSE_FILE_DELETE(2) - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) FOLDER_SET = .FALSE. - -1000 CALL CLOSE_FILE(7) - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - EXTERNAL CLI$_ABSENT - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1) - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - CALL OPEN_FILE_SHARED(7) ! Go find folder - - REMOTE_TEST = 0 - - IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP - END IF - - CALL CLOSE_FILE(7) - - IF (IER.EQ.0.AND.FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - IF (OUTPUT) THENM - WRITE (6,'('' ERROR: Unable to connect to folder.'')') - END IFA - RETURNj - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::"U - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'//M - & FOLDER1 - FOLDER1_NUMBER = -1 - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Copy remote folder protection - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0)L - ELSEO - LOCAL_FOLDER1_FLAG = IBCLR(LOCAL_FOLDER1_FLAG,0)I - END IFR - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - CALL OPEN_FILE(7) ! Update local folder informationt - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - FOLDER_COM = FOLDER1_COMP - CALL REWRITE_FOLDER_FILES - CALL CLOSE_FILE(7)T - END IF - REMOTE_SET = .TRUE.T - END IFO - - IF (IER.EQ.0) THEN ! Folder foundd - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1R - IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::' - & .AND..NOT.SETPRV_PRIV()) THEN. - ! Is folder protected and not remote? - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAMEU - & .NE.FOLDER1_OWNER) THENQ - CALL CHECK_ACCESS, - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS)S - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')')I - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_FILE_SHARED(4)I - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER)_ - CALL CLR2(SET_FLAG,FOLDER1_NUMBER)E - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_FILE(4)1 - END IF - IER = 0E - RETURN - END IF - END IFR - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (FOLDER1_BBOARD(:2).NE.'::') THEN - IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - END IF - - IF (IER) THENN - FOLDER_COM = FOLDER1_COM ! Folder successfully set soT - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THENC - FOLDER_SET = .TRUE. - ELSEL - FOLDER_SET = .FALSE.L - END IFC - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - BULL_POINT = 0 ! Reset pointer to first bulletin( - END IFl - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME= - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THENR - IF (OUTPUT.AND.INCMD(:3).NE.'DIR')' - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE.w - ELSEm - READ_ONLY = .FALSE. - END IF( - ELSE( - READ_ONLY = .FALSE. - END IFS - - IF (FOLDER_NUMBER.GT.0) THEN - IF (TEST_BULLCP()) THENt - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THENL - ! If first select, look for expired messages. - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.R - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2))6 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0. - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN& - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THENW - CALL UPDATE ! Need to update - END IF - ELSEN - NBULL = 0 - END IFD - CALL CLOSE_FILE(2)= - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IFU - END IFF - - IF (FOLDER_NUMBER.NE.0) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find itR - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0D - DO WHILE (NEW_COUNT.GT.0)U - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1O - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletinsN - ELSE - BULL_POINT = 0 - END IF - END IFU - END IF - END IFd - IER = 1 - ELSE IF (OUTPUT) THEN- - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not foundn - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0E - END IF - - RETURNM - - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -CL -C SUBROUTINE CONNECT_REMOTE_FOLDERN -C -C FUNCTION: Connects to folder that is located on other DECNET node.D -C' - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - INCLUDE 'BULLUSER.INC'/ - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - - DIMENSION DUMMY(2) - - REMOTE_UNIT = 31 - REMOTE_UNITD - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,$ - & FILE=FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))D - & //'::"TASK=BULLETIN1"')s - - IF (IER.EQ.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1r - FOLDER_OWNER_SAVE = FOLDER1_OWNERD - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBERI - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY,C - & DUMMY(1),DUMMY(2),FOLDER1_COM. - END IF - END IFR - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)E - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_FILE_SHARED(4) - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_FILE(4) - END IF. - END IF - IER = 2N - ELSE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE' - FOLDER1_NUMBER = FOLDER_NUMBER_SAVEP - FOLDER1_OWNER = FOLDER_OWNER_SAVE - CLOSE (UNIT=31-REMOTE_UNIT)R - IF ((FOLDER_NUMBER.NE.FOLDER1_NUMBER.AND.(DUMMY(1).NE.0: - & .OR.DUMMY(2).NE.0)).OR.FOLDER1_NUMBER.EQ.-1) THEN - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - END IF - IER = 0 - END IFI - - RETURN) - END - - - - - - - - - - SUBROUTINE UPDATE_FOLDERE -CM -C SUBROUTINE UPDATE_FOLDERF -CE -C FUNCTION: Updates folder info due to new message. -CE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'L - - IF (FOLDER_NUMBER.LT.0) RETURNR - - CALL OPEN_FILE_SHARED(7) ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)R - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2)D - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message?T - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF_ - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_FILE(7)) - - RETURN - END - - - - SUBROUTINE SHOW_FOLDERc -Ce -C SUBROUTINE SHOW_FOLDERE -CI -C FUNCTION: Shows the information on any folder.. -C0 - - IMPLICIT INTEGER (A-Z)i - - INCLUDE 'BULLUSER.INC'F - - INCLUDE 'BULLFOLDER.INC'B - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'N - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & FOLDER1 = FOLDER - - IF (INDEX(FOLDER1,'::').NE.0) THENc - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - RETURN - END IFE - - CALL OPEN_FILE_SHARED(7) ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//f - & FOLDER1t - IF (IER.NE.0) THENR - WRITE (6,'('' ERROR: Specified folder was not found.'')')R - CALL CLOSE_FILE(7) - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER,O - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSEI - WRITE (6,1010) FOLDER1,FOLDER1_OWNER,Y - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IFO - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACLP - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THENL - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remoteU - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Folder is a private folder.'')') - ELSEU - WRITE (6,'('' Folder is not a private folder.'')') - END IFA - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',USERNAME, - & READ_ACCESS,WRITE_ACCESS) - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IFR - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')M - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')')N - END IF - END IFO - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' BBOARD expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE_ - ELSE. - WRITE (6,'('' BBOARD messages will not expire.'')')_ - END IFE - ELSED - WRITE (6,'('' No BBOARD has been defined.'')') - END IFF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IFo - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IFE - IF (F1_EXPIRE_LIMIT.GT.0) THENN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IFT - CALL OPEN_FILE_SHARED(4)f - CALL READ_USER_FILE_HEADER(IER) - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is BRIEF.'')')( - ELSE - WRITE (6,'('' Default is READNEW.'')')E - END IF - ELSES - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is SHOWNEW.'')')N - ELSE - WRITE (6,'('' Default is NOREADNEW.'')')L - END IF - END IFN - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY.'')') - ELSEG - WRITE (6,'('' Default is NONOTIFY.'')') - END IFO - CALL CLOSE_FILE(4) - END IF - END IFT - - CALL CLOSE_FILE(7)) - - RETURN - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -CN -C SUBROUTINE DIRECTORY_FOLDERSG -C0 -C FUNCTION: Display all FOLDER entries. -CE - IMPLICIT INTEGER (A - Z)N - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'S - - COMMON /PAGE/ PAGE_LENGTH,PAGINGO - LOGICAL PAGING - - DATA SCRATCH_D1/0/D - - CHARACTER*17 DATETIME - - EXTERNAL CLI$_NEGATED,CLI$_PRESENT. - - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE specified - ELSEE - NLINE = 1e - END IFa - -Cd -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory' -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1( - - CALL OPEN_FILE_SHARED(7) ! Get folder file - - NUM_FOLDER = 0G - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - END IF - END DO - - CALL CLOSE_FILE(7) ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IFC - -C -C Folder entries are now in queue. Output queue entries to screen. -CE - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen: - - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'',R - & 2X,''Owner'',/,1X,80(''-''))') - - IF (.NOT.PAGING) THEN - DISPLAY = (NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2R - ELSE_ - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2,PAGE_LENGTH-4) - ! If more entries than page size, truncate output - END IFE - - DO I=FOLDER_COUNT,FOLDER_COUNT+(DISPLAY-2)/NLINE-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - DIFF = COMPARE_BTIM) - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counter - END DOR - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are moreN - END IF_ - - RETURN( - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12). -1010 FORMAT(1X,/,' Press RETURN for more...',/)B - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C_ -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID.T -C) -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'C - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT_ - - CHARACTER ID*25,RESPONSE*1 - - IF (CLI$PRESENT('ALL')) THENF - ALL = .TRUE. - ELSEI - ALL = .FALSE. - END IF_ - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE.R - ELSEF - READONLY = .FALSE. - END IFD - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder nameE - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THEN= - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')F - RETURN - END IFI - - IF (.NOT.ALL) THEND - IER = CLI$GET_VALUE('ACCESS_ID',ID,LEN) ! Get IDW - IF (LEN.GT.25) THEN: - WRITE(6,'('' ERROR: ID name must be < 26 characters.'')') - RETURNE - END IF - END IFI - - CALL OPEN_FILE(7) ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it existsA - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_FILE(7)E - - IF ((.NOT.ALL).AND.(ID.EQ.FOLDER1_OWNER)) THENR - WRITE (6,'(F - & '' ERROR: Cannot modify access for owner of folder.'')')f - RETURN - END IF) - - IF (IER.NE.0) THENE - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,Y - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE6 - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1E - CALL CHKACLO - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER)N - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENP - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,I - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN( - WRITE (6,'('' Folder access was not changed.'')')_ - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)I - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')')E - GOTO 100 - END IF - END IF - END IF - IF (ACCESS) THEN - IF (.NOT.ALL) THENN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER)1 - ELSE - CALL ADD_ACL(ID,'R+W',IER)e - END IF& - ELSE> - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSEN - CALL DEL_ACL(' ','R+W',IER) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IFf - END IF, - ELSE - IF (ALL) THEN - CALL DEL_ACL('*','R',IER) - ELSER - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IFC - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' ERROR: Cannot modify ACL of folder files.'')') - CALL SYS_GETMSG(IER) - ELSE - WRITE (6,'('' Access to folder has been modified.'')')' -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - CALL OPEN_FILE(7) ! Open folder filee - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAGA - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_FILE(7) - END IFB - END IF - END IF - - RETURNI - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C. -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file.L -CE - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME, - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)'E - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN, - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURNE - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -Cu -C SUBROUTINE CHECK_ACCESS -CG -C FUNCTION: Checks ACL of given file. -C) -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -Cm -C NOTE: SYS$CHECK_ACCESS is only available under V4.4 or later. -C If you have an earlier version, comment out the lines which call -C it and set both READ_ACCESS and WRITE_ACCESS to 1, which wille -C allow program to run, but will not allow READONLY access feature.I -CU - - IMPLICIT INTEGER (A-Z)O - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))s - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THENi - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - END IFT - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))' - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THENL - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF1 - - RETURNL - END - - - - - SUBROUTINE SHOWACL(FILENAME)R -CO -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -CQ -C PARAMETERS: -C FILENAME - Name of file to check.) -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAMEn - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)t - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH)H - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN_ - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAMEe - - INCLUDE 'BULLFOLDER.INC'I - - ENTRY WRITE_FOLDER_FILE(IER)O - - DO WHILE (REC_LOCK(IER)) - WRITE (7,IOSTAT=IER) FOLDER_COMC - END DOR - - RETURN - - ENTRY REWRITE_FOLDER_FILE - - REWRITE (7) FOLDER_COMN - - RETURN_ - - ENTRY REWRITE_FOLDER_FILE_TEMP) - - REWRITE (7) FOLDER1_COM - - RETURNE - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER_COM - END DO0 - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER)M - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER1_COME - END DOM - - RETURNF - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBERD - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COMM - END DOT - - FOLDER_NUMBER = SAVE_FOLDER_NUMBERR - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER))E - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END DOF - - RETURN' - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))S - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END DOc - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER)e - - DO WHILE (REC_LOCK(IER))e - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COMU - END DOI - - RETURNC - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z)C - - CHARACTER*(*) KEY_NAMED - - INCLUDE 'BULLUSER.INC'N - - CHARACTER*12 SAVE_USERNAME* - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAMES - - DO WHILE (REC_LOCK(IER))I - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAMEF - USERNAME = SAVE_USERNAMEE - - RETURNI - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAMER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO( - - USERNAME = SAVE_USERNAMEt - TEMP_USER = KEY_NAME' - - RETURNU - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER))S - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - END DO6 - - RETURN: - - ENTRY WRITE_USER_FILE_NEW(IER)) - - SET_FLAG(1) = SET_FLAG_DEF(1) - SET_FLAG(2) = SET_FLAG_DEF(2) - BRIEF_FLAG(1) = BRIEF_FLAG_DEF(1) - BRIEF_FLAG(2) = BRIEF_FLAG_DEF(2) - NOTIFY_FLAG(1) = NOTIFY_FLAG_DEF(1) - NOTIFY_FLAG(2) = NOTIFY_FLAG_DEF(2) - - ENTRY WRITE_USER_FILE(IER)1 - - DO WHILE (REC_LOCK(IER))F - WRITE (4,IOSTAT=IER) USER_ENTRYc - END DOw - - RETURNe - - END - - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERICu -Cf -C FUNCTION: Enables or disables "GENERIC" display, i.e. displayingR -C general bulletins continually for a certain amount of days.a -C - IMPLICIT INTEGER (A-Z)o - - INCLUDE 'BULLUSER.INC'D - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THENE - WRITE (6,'(D - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IFE - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_FILE_SHARED(4)E - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)' - - IF (IER.EQ.0) THENN - IF (GENERIC) THENP - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF' - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSEY - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_FILE(4), - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -CE -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login.( -CA - IMPLICIT INTEGER (A-Z)m - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23N - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEND - WRITE (6,'(1 - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IFS - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_FILE_SHARED(4) - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956',NOLOGIN_BTIM)I - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).EQ.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEND - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')')s - END IFe - - CALL CLOSE_FILE(4)' - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z)L - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2)R - - CALL INIT_ITMLSTL - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST), - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2)M - - RETURNI - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4)I - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1L - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN5 - END - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT)i -C -C Add INDEX command to BULLETIN, display directories of ALLL -C folders. Added per request of a faculty member for his private -C board. Changes to BULLETIN.FOR should be fairly obvious. -CR -C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2)C -C - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC'u - INCLUDE 'BULLUSER.INC'E - - COMMON /POINT/ BULL_POINT - - DATA FOLDER_Q1/0/ - - BULL_POINT = 0I - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART')e - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2c - DIR_COUNT = 0 - END IFC - - IF (INDEX_COUNT.EQ.1) THENg - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM)S - - FOLDER_Q = FOLDER_Q14 - CALL OPEN_FILE_SHARED(7) ! Get folder fileo - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from filew - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THENs - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF' - END DO - - CALL CLOSE_FILE(7) ! We don't need file anymore_ - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - WRITE (6,1000) - WRITE (6,1020) - DO J = 1,NUM_FOLDERSC - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - WRITE (6,1030) FOLDER1(:15),F1_NBULL,_ - & FOLDER1_DESCRIP(:MIN(TRIM(FOLDER1_DESCRIP),60))T - END DOM - WRITE (6,1060)o - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURNR - ELSE IF (INDEX_COUNT.EQ.2) THEN - IF (DIR_COUNT.EQ.0) THEN - F1_NBULL = 0M - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1C - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN) - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0$ - END IF - END DOI - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0. - RETURN - END IFL - END IF - R - CALL DIRECTORY(DIR_COUNT) - - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040)0 - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURNE - -1000 FORMAT (' The following folders are present'/)o -1020 FORMAT (' Name Count Description'/). -1030 FORMAT (1X,A15,I4,1X,A) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') - - END diff --git a/decus/vax88b5/bulletin/bulletin6.for b/decus/vax88b5/bulletin/bulletin6.for deleted file mode 100644 index 4912460..0000000 --- a/decus/vax88b5/bulletin/bulletin6.for +++ /dev/null @@ -1,1399 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU@SMTP 1-SEP-1988 04:48 -To: ARISIA::EVERHART -Subj: BULLETIN6.FOR - - -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 31 Aug 88 11:58-EDT -Date: 31 Aug 88 11:58:13 EDT -From: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -To: MHG@MITRE-BEDFORD.ARPA@XX, EVERHART%ARISIA.DECNET@GE-CRD.ARPA@XX, - GAYMAN@ARI-HQ1.ARPA@XX, DZIEGIEL@RADC-SOFTVAX.ARPA@XX -Subject: BULLETIN6.FOR - -C -C BULLETIN6.FOR, Version 8/31/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE(INPUT) -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C -C INPUT: -C INPUT - Unit number of file to close out. -C 1 = BULLETIN.DAT -C 2 = BULLDIR.DAT -C 4 = BULLUSER.DAT -C 7 = BULLFOLDER.DAT -C 8 = SYS$SYSTEM:SYSUAF.DAT -C - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT) - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE(INPUT) - - IMPLICIT INTEGER (A-Z) - - CALL ENABLE_CTRL - - CLOSE (UNIT=INPUT,STATUS='DELETE') - - RETURN - END - - - SUBROUTINE OPEN_FILE(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (INPUT.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL BULLDIR_ERR - END DO - DIR_NUM = -1 - END IF - - IF (INPUT.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL BULLETIN_ERR - END DO - END IF - - IF (INPUT.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL BULLUSER_ERR - END DO - END IF - - IF (INPUT.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL BULLFOLDER_ERR - END DO - END IF - - IF (INPUT.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL BULLINF_ERR - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') INPUT - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - ENDI F - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - RETURN - END - - SUBROUTINE TIMER_ERR - - IMPLICIT INTEGER (A-Z) - - ENTRY BULLDIR_ERR - WRITE(6,'('' ERROR: Unable to open directory file after 30 secs.'')') - GO TO 10 - - ENTRY BULLETIN_ERR - WRITE(6,'('' ERROR: Unable to open message file after 30 secs.'')') - GO TO 10 - - ENTRY BULLUSER_ERR - WRITE(6,'('' ERROR: Unable to open BULLUSER.DAT after 30 secs.'')') - GO TO 10 - - ENTRY BULLFOLDER_ERR - WRITE(6,'('' ERROR: Unable to open BULLFOLDER.DAT after 30 secs.'')') - GO TO 10 - - ENTRY BULLINF_ERR - WRITE(6,'('' ERROR: Unable to open BULLINF.DAT after 30 secs.'')') - GO TO 10 - -10 CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED(INPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT - - CHARACTER*25 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (INPUT.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL')A - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE)R - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop6 - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRSS - NTRIES = 0 - END IFT - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IFo - - IF (INPUT.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR.T - & SAVE_FOLDER.NE.FOLDER)) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_POINT - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCKT - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER)E - IER = 0 - END IF - ELSE IF (INPUT.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD',U - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN0 - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILEM - NTRIES = 0 - END IFE - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF' - - IF (INPUT.EQ.4) THENR - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THENM - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILEA - NTRIES = 0 - END IF= - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IFS - - IF (INPUT.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - - IF (IER.EQ.0) THENo - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE)I - IF (ASK_SIZE.NE.FOLDER_RECORD/4) THEN - CLOSE (UNIT=7)G - IDUMMY = FILE_LOCK(IER,IER1)R - CALL CONVERT_BULLFOLDER(ASK_SIZE) - NTRIES = 0 - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (INPUT.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED,= - & USEROPEN=LNM_MODE_EXEC)F - END DO - END IF - - IF (INPUT.EQ.9) THENR - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT. - END DO - END IFE - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.INPUT.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)T - CALL OPEN_FILE(INPUT)I - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE_SHARE, unit = '',I)') INPUTM - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)= - IF (IER1.EQ.0) THENO - WRITE (6,'('' IOSTAT error = '',I)') IERL - ELSE - CALL SYS_GETMSG(IER1) - ENDI F - CALL ENABLE_CTRL_EXIT - END IF= - - RETURND - END - - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'W - - INCLUDE 'BULLFILES.INC' - - CHARACTER INPUT*115 - - WRITE (6,'('' Converting data files to new format. Please wait.'')')D - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)= - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))' - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found., - - READ (2'1,IOSTAT=IER1) INPUTE - - CALL LIB$MOVC3(4,%REF(INPUT(39:)),NBULL)= - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))A - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',L - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THENT - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IFE - - IF (IER1.NE.0) GO TO 800D - - CALL SYS_BINTIM(INPUT(1:11)//' '//INPUT(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(INPUT(20:30)//' '//INPUT(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = INPUT(39:)_ - CALL SYS_BINTIM(INPUT(51:61)//' '//INPUT(62:69),SHUTDOWN_BTIM)E - BULLDIR_HEADER(49:52) = INPUT(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) INPUT - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = INPUT(1:) - FROM = INPUT(54:) - BULLDIR_ENTRY(78:81) = INPUT(85:) - BULLDIR_ENTRY(90:97) = INPUT(108:) - CALL SYS_BINTIM(INPUT(89:99)//' '//INPUT(100:107),EX_BTIM)_ - CALL SYS_BINTIM(INPUT(66:76)//' '//INPUT(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY6 - ICOUNT = ICOUNT + 1 - END IF - END DO3 - -800 CLOSE (UNIT=9,DISPOSE='KEEP')L - CLOSE (UNIT=2)E - -900 CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURNE - - END - - - - SUBROUTINE CONVERT_BULLFILESl -Co -C SUBROUTINE CONVERT_BULLFILES' -C) -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletinE -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs).G -CO - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'O - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 INPUT - - WRITE (6,'('' Converting data files to new format. Please wait.'')')E - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))U - & //'.BULLDIR',STATUS='OLD',P - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',C - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD',U - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT), - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)A - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))O - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,R - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')( - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8)_ - NEMPTY = 0) - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2S - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') INPUTB - WRITE(1,'(A)') INPUT(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') INPUT - WRITE(1,'(A)') INPUT - END DOC - CALL WRITEDIR(ICOUNT-1,IER1)S - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9)O - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1)F - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionE - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)O -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -CR -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C. -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 INPUT,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')')_ - - CALL CLOSE_FILE(2) - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)R - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)E - - CALL OPEN_FILE(7) - -100 READ (7,FMT=FOLDER_FMT,ERR=200). - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD',O - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER,U - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,R - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE)_ - - CALL OPEN_FILE(2) - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THENI - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER)A - NBLOCK = NBLOCK + 1F - SBLOCK = NBLOCKA - DO J=BLOCK,LENGTH+BLOCK-1' - READ(10'J,'(A)') INPUT& - ILEN = TRIM(INPUT)Y - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,INPUT,NBLOCK)D - END DO - CALL FLUSH_BULL(NBLOCK)I - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_FILE(2)A - GOTO 100E - -200 CALL OPEN_FILE_SHARED(2) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURNL - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(ASK_SIZE) -CA -C SUBROUTINE CONVERT_BULLFOLDER -C0 -C FUNCTION: Converts bulletin folder file to new format.S -C. - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'. - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'X - - CHARACTER*80 NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')')T - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)e - - EODIR = MAX(INDEX(BULLFOLDER_FILE,':'),INDEX(BULLFOLDER_FILE,']')) - SUFFIX = INDEX(BULLFOLDER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLFOLDER_FILE(:SUFFIX)//'OLD'U - IER = LIB$RENAME_FILE(BULLFOLDER_FILE,NEW_FILE) - - DO WHILE (FILE_LOCK(IER,IER1))L - OPEN (UNIT=7,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',T - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DOI - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=9,FILE=BULLFOLDER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',0 - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE')= - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.173/4) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0)& - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)1 - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP= - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - IF (IER.EQ.0) THEN - WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0)R - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)N - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP& - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER))C - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF) - CALL OPEN_FILE_SHARED(2)I - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN= - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER)Y - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IFP - END IF/ - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)N - WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBI - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIMC - CALL CLOSE_FILE(2)l - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IFL - - CLOSE (UNIT=7)O - CLOSE (UNIT=9,STATUS='SAVE') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectioni - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURNr - END - - SUBROUTINE CONVERT_USERFILE -CI -C SUBROUTINE CONVERT_USERFILE -CU -C FUNCTION: Converts user file to new format which has 8 bytes added. -CE - - IMPLICIT INTEGER (A-Z)l - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'I - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIMED - - WRITE (6,'('' Converting data files to new format. Please wait.'')')D - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))A - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'R - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',E - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER))( - INQUIRE (UNIT=9,RECORDSIZE=RECL)o - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLFOLDER.INC.'')')& - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)1 - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFT - - IF (IER.EQ.0) THENR - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)E - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',, - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF, - - IF (IER.NE.0) THENM - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)H - CALL SYS_GETMSG(IER1)I - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXITF - END IF0 - - DO I=1,FLONGA - NEW_FLAG(I) = 'FFFFFFFF'XE - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0E - SET_FLAG(I) = 01 - END DOI - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50D - IER = 0( - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFERY - IF (IER.EQ.0) THEN! - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23), - LOGIN_TIME = BUFFER(24:31)1 - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))l - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1))r - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM)n - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFS - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag& - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,I - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THENA - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFL - END DO - END IF_ - - IER = 0 - - CLOSE (UNIT=9)& - CLOSE (UNIT=4), - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionI - - RETURNE - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -CR -C SUBROUTINE READDIR -CF -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -CE -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS:, -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPTL - CHARACTER*39 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*2 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER))I - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADERU - END DON - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - DIR_NUM = 0 - END IFs - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,0 - IF (IER.EQ.0) THEND - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - END IFE - IF (IER.GT.0) THEN. - CALL ERROR_AND_EXIT - ELSER - CALL CONVERT_HEADER_FROMBIN - RETURNI - END IFI - END IF - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) - CALL CLEANUP_DIRFILE(1) - END IF, - IF (NEMPTY.EQ.' ') NEMPTY = 09 -CT -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also checkS -C to see if cleanup was in progress but didn't properly finish. -CR - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THENE - WRITE (CFOLDER_NUMBER,'(I2)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX(L - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IFE - END IF - ELSE - IF (.NOT.REMOTE_SET) THENO - DO WHILE (REC_LOCK(IER))L - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRYT - IF (MSG_NUM.NE.ICOUNT) IER = 36E - ELSEH - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) BULLDIR_ENTRY - END IFR - END DOO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBINB - DIR_NUM = MSG_NUM - ELSER - DIR_NUM = -1N - END IF - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNTB - IF (IER.EQ.0) THEN0 - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IFE - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSEE - CALL CONVERT_ENTRY_FROMBIN - RETURNE - END IFN - END IF - END IF - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - UNLOCK 2Q - - RETURNF - - END - - - - - - SUBROUTINE READDIR_KEYGE(IER) -CE -C SUBROUTINE READDIR_KEYGEC -CY -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified.N -CS -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If not 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z)) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) BULLDIR_ENTRYS - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBINR - DIR_NUM = MSG_NUM - ELSE - IER = 0 - DIR_NUM = -1E - END IF - UNLOCK 2 - ELSEB - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSEB - IER = MSG_NUM - CALL CONVERT_ENTRY_FROMBIN - END IF - END IF) - - RETURN$ - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME - NEWEST_EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,)A - - NEWEST_DATE = DATETIME - NEWEST_TIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIMEa - SHUTDOWN_TIME = DATETIME(13:) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBINL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME - EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,)E - - DATE = DATETIME - TIME = DATETIME(13:)X - - RETURN& - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -CC -C FUNCTION: Writes the entry for the specified bulletin in theT -C directory file.R -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS:' -C IER - Error status from WRITE. -C' - - IMPLICIT INTEGER (A - Z)C - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - INCLUDE 'BULLDIR.INC' - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - ( -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBINT - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER& - ELSE - IER = -1I - IF (DIR_NUM.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADERI - END IF - IF (IER.NE.0) THENn - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THENE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IFF - END IF - IF (IER.NE.0) THENL - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - ELSE - IF (CONV) CALL CONVERT_ENTRY_TOBIN - MSG_NUM = BULLETIN_NUM - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRY - ELSE - IER = -1L - IF (DIR_NUM.EQ.MSG_NUM) THENO - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IFE - IF (IER.NE.0) THENE - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY2 - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IFB - END IF - END IF5 - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -18 - - RETURNR - - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z)% - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM)I - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM)D - - RETURNL - END - - - - SUBROUTINE CONVERT_ENTRY_TOBINI - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - - RETURN1 - END - - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -CT -C SUBROUTINE READACLG -CB -C FUNCTION: Reads the ACL of a file.A -CR -C PARAMETERS: -C FILENAME - Name of file to check.m -C ACLENT - String which will be large enough to hold ACL information.& -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*)M - CHARACTER NOT_ID*3 - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)G - - DO ACCESS_TYPE=1,2I - POINT = 1O - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)4 - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - IF ((ACCESS_TYPE.EQ.1.AND.INDEX(ACLSTR,'WRITE').GT.0).OR. - & (ACCESS_TYPE.EQ.2.AND.INDEX(ACLSTR,'READ)').GT.0)) THENr - START_ID = INDEX(ACLSTR,'=') + 1a - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - IF (ACLSTR(END_ID:END_ID).EQ.']') THENg - START_ID = END_ID - 1 - DO WHILE - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0) - START_ID = START_ID - 1a - END DOo - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IFR - END IFC - IF (OUTLEN.EQ.0) THEN - IF (ACCESS_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(A - & '' These users can only read this folder:'')') - END IF - OUTLEN = 1 - END IFE - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THENU - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)R - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2D - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)B - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IFs - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DOT - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILEa - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))F - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLFOLDER.INC.'')')Y - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFT - - RECL = RECL/8 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW',E - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))Y - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)M - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DOR - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9)C - - RETURNR - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z)_ - _ - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)F - CALL ENABLE_CTRL_EXIT - - RETURN - END - diff --git a/decus/vax88b5/bulletin/bulletin7.for b/decus/vax88b5/bulletin/bulletin7.for deleted file mode 100644 index 8e9f627..0000000 --- a/decus/vax88b5/bulletin/bulletin7.for +++ /dev/null @@ -1,1621 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU@SMTP 1-SEP-1988 04:52 -To: ARISIA::EVERHART -Subj: BULLETIN7.FOR - - -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 31 Aug 88 11:58-EDT -Date: 31 Aug 88 11:58:47 EDT -From: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -To: MHG@MITRE-BEDFORD.ARPA@XX, EVERHART%ARISIA.DECNET@GE-CRD.ARPA@XX, - GAYMAN@ARI-HQ1.ARPA@XX, DZIEGIEL@RADC-SOFTVAX.ARPA@XX -Subject: BULLETIN7.FOR - -C -C BULLETIN7.FOR, Version 8/30/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - INCLUDE '($SSDEF)' - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - CHARACTER OUTPUT*160,TERMINAL*8 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_FILE_SHARED(4) - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_FILE(4) - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -C -C Set flags in all user entries that have SET READNEW on the particular -C folder to indicate that a new bulletin is present for the particular folder. -C Also send broadcast if notify flag set. -C - OUTPUT = BELL//CR//LF//LF//'New bulletin added to folder '// - & FOLDER(1:TRIM(FOLDER))//'. From: '//FROM(1:TRIM(FROM))// - & CR//LF//'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IF (ADD_BULL) THEN - IF (FOLDER_NUMBER.GT.0) THEN - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - END IF - - IF (ADD_BULL) THEN - IER = 1 - DO WHILE (GETUSERS(TEMP_USER,TERMINAL)) - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TERMINAL(:TRIM(TERMINAL)),%VAL(BRK$C_DEVICE),,,,,,,) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - END DO - END IF - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_FILE(4) - - RETURN - - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(1:11) - NEWEST_TIME = TODAY_TIME(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00.00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*3600 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalidV - BTIM(1) = TEMP(1). - BTIM(2) = TEMP(2)m - END IFM - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalidT - BTIM(1) = TEMP(1)F - BTIM(2) = TEMP(2)R - END IFE - - RETURNP - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2). -CA -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future.s -Co -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time- -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -Cp - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*11 TEMP2 - - IF (TIME2.EQ.' ') THENI - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:)' - ELSEF - TEMP2 = TIME2S - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1)))6 - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10)))l - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THENh - COMPARE_TIME = 1h - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IFt - - RETURNe - END - -C------------------------------------------------------------------------- -CT -C The following are subroutines to create a linked-list queue for E -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to closeU -C the file as soon as possible. -CN -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second containsd -C the address. The address is simply the address of the 3rd word ofs -C the record. The last word in the record contains the address of thew -C next record. Every time a record is written, if that record has a: -C zero link, it adds a new record for the next write operation. ( -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -CM -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA)L - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initializedE - LENGTH = LEN(DATA)T - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN) - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATAM - LENGTH = RECORD(1)L - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4)1 - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXTN - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1)C - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA)b - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURNT - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHARS - OUTCHAR = INCHAR(:LENGTH) - RETURNN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN)r - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN' - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0M - RETURNR - END - - - - SUBROUTINE DISABLE_PRIVSR -CD -C SUBROUTINE DISABLE_PRIVSD -CN -C FUNCTION: Disable image high privileges._ -C) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/, - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURNA - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privilegesC - - SETPRV(1) = SETPRV(1).AND..NOT.PROCPRIV(1)B - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -CI -C SUBROUTINE ENABLE_PRIVS -C_ -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURNE - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privsC - - RETURNF - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -CR -C SUBROUTINE CHECK_PRIV_IO -CL -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -CI - - IMPLICIT INTEGER (A-Z)A - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE')V - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200)M - ERROR = 1O - ELSEA - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IFD - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')= - - RETURNE - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder.S -CD -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. E -C If FALSE, clear flag.. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -CR - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC's - - INCLUDE 'BULLFOLDER.INC'h - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))a - - LOGICAL CMD - - CHARACTER*23 TODAYb - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1)u - IF (IER) THENI - FOLDER_NUMBER_SAVE = FOLDER_NUMBER, - CALL OPEN_FILE_SHARED(7)X - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_FILE(7)I - IF (IER.NE.0) THENR - WRITE (6,'('' ERROR: No such folder found.'')')R - RETURN - END IF) - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF2 - -Cr -C Find user entry in BULLUSER.DAT to update information.T -C2 - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_FILE_SHARED(4) ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2)E - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS$ASCTIM(,TODAY,,)u - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THENa - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)a - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)s - END IF - NEW_FLAG(1) = 143A - NEW_FLAG(2) = 0( - CALL WRITE_USER_FILE_NEW(IER)2 - ELSEC - IF (CMD) THEN1 - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143s - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF$ - - RETURNE - - END - - - - - SUBROUTINE SET_VERSION -CR -C SUBROUTINE SET_VERSIONT -C -C FUNCTION: Sets version number.E -C - IMPLICIT INTEGER (A - Z)) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'' - - INCLUDE 'BULLFOLDER.INC'( - - DIMENSION FLAGS(FLONG,4)T - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))P - - LOGICAL CMD - - CHARACTER*23 TODAY - DIMENSION READ_BTIM_SAVE(2) - -C0 -C Find user entry in BULLUSER.DAT to update information.R -C. - - CALL OPEN_FILE_SHARED(4) ! Open user fileF - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2)T - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THENt - NEW_FLAG(1) = 143r - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry: - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IFu - - CALL CLOSE_FILE (4) - RETURNf - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -C -C SUBROUTINE CONFIRM_PRIV -CT -C FUNCTION: Confirms that given username has SETPRV.P -C -C INPUTS: -C USERNAME - UsernameS -C OUTPUTS:D -C ALLOW - Returns 1 if account has SETPRV. -C returns 0 if account has no SETPRV. -C0 - - IMPLICIT INTEGER (A-Z)R - - CHARACTER*(*) USERNAME - - INCLUDE '($PRVDEF)' - - INCLUDE '($UAIDEF)' - - INTEGER DEF_PRIV(2) - - CALL INIT_ITMLSTC - CALL ADD_2_ITMLST(8,UAI$_DEF_PRIV,%LOC(DEF_PRIV)) - CALL END_ITMLST(GETUAI_ITMLST)& - - ALLOW = 0 ! Set return falseC - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(DEF_PRIV(1),PRV$V_SETPRV).OR. ! SETPRV or CMRKNL - & BTEST(DEF_PRIV(1),PRV$V_CMKRNL)) THEN ! privileges?) - ALLOW = 1 ! Yep - END IF - END IFE - - RETURN ! ReturnC - END ! End - - - - - - SUBROUTINE CHECK_DISMAIL(USERNAME,DISMAIL) -CT -C SUBROUTINE CHECK_DISMAIL- -C- -C FUNCTION: Checks that given username has DISMAIL. -CT -C INPUTS: -C USERNAME - Username -C OUTPUTS:e -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -Ch - - IMPLICIT INTEGER (A-Z)o - - CHARACTER*(*) USERNAME - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLSTe - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST)o - - DISMAIL = 0 ! Set return falsei - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET?r - DISMAIL = 1 ! Yepr - END IF - END IFs - - RETURN ! Return - END ! Endo - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z)t - - CHARACTER*(*) INPUT,OUTPUTT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist- - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - - RETURND - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./L - - IF (INIT) THEN- - FILE_LOCK = 1L - INIT = .FALSE. - ELSEE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)R - IF (IER1.EQ.RMS$_FLK) THENU - FILE_LOCK = 1T - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0L - INIT = .TRUE.V - END IF) - ELSE - FILE_LOCK = 0 - IER1 = 0- - INIT = .TRUE. - END IF - END IF4 - - RETURNX - END - - - - SUBROUTINE ENABLE_CTRLT - - IMPLICIT INTEGER (A-Z)( - - COMMON /CTRLY/ CTRLYT - - COMMON /CTRL_LEVEL/ LEVEL - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXITQ - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0R - IF (QUIT.EQ.1) LEVEL = LEVEL - 1L - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THENA - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IFD - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -CC - END IFA - - IF (QUIT.EQ.0) THEN - CALL UPDATE_USERINFO - CALL EXITR - END IFE - QUIT = 0 ! Reinitialize - - RETURN_ - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLYI - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/3 - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURNL - END - - - - - SUBROUTINE CLEANUP_BULLFILE -Cr -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it.N -CN - IMPLICIT INTEGER (A - Z)T - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'1 - - CHARACTER FILENAME*132,INPUT*128C - - CALL OPEN_FILE_SHARED(2)R - -CG -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C) - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADERN - END DOP - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_FILE(2) - RETURN - ELSE IF (NEMPTY.GT.0) THENP - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - OPEN (UNIT=11, - 1 FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',V - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - IF (IER.NE.0) THENU - CALL CLOSE_FILE(2) - RETURN - END IFE - END IF - - CALL OPEN_FILE_SHARED(1) ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER)E - ICOUNT = BLOCK - DO J=1,LENGTHT - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) INPUT - END DOS - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100S - END IF: - WRITE(11) INPUT - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_FILE(1)o - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',L - & '*.BULLFIL') - IER = 1I - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_FILE_DELETE(2)( - IER = 1L - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,n - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',e - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))r - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,T - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')T - IF (IER.NE.0) THENA - CLOSE (UNIT=11)a - CALL CLOSE_FILE(2) - RETURN - END IFs - END IF - - NEMPTY = 0G - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULLF - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY= - NBLOCK = NBLOCK + LENGTH - END DOA - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_FILE(2) - CALL OPEN_FILE(2) ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory headerN - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER)U - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//N - & '.BULLFIL;-1') - END DO_ - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_FILE_DELETE(2) - IER = 1 - DO WHILE (IER)r - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*',E - & '*.*;1') - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)R -C -C SUBROUTINE CLEANUP_DIRFILEi -Cm -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is_ -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting processO -C was abnormally terminated. -CP - IMPLICIT INTEGER (A - Z)R - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVEa - - CHARACTER*11 DATE_SAVE,EXDATE_SAVE - CHARACTER*11 TIME_SAVE,EXTIME_SAVEN - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRYE - DATE_SAVE = DATET - TIME_SAVE = TIME - EXDATE_SAVE = EXDATEL - EXTIME_SAVE = EXTIMEE - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL)S - CALL READDIR(I,IER)L - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in fileS - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)F - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DOm - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURNC - END IFE - LENGTH = -LENGTH ! Indicate starting point by writing_ - CALL WRITEDIR(I,IER) ! next entry into deleted entryT - FIRST_DELETE = I ! with negative lengthI - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion1 - FIRST_DELETE = I ! was previously in progressr - J = I ! Try to find where entry came from - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - BLOCK_SAVE = BLOCKT - K = J + 1 ! Search for duplicate entries - DO WHILE (MOVE_FROM.EQ.0.AND.K.LE.NBULL)C - CALL READDIR(K,IER)) - IF (IER.EQ.K+1) THEN - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO=J+1 - MOVE_FROM=K+1 - ELSEF - K = K + 1 - END IF - END IF - END DO) - J = J + 1 ! If no duplicate entry found for this - CALL READDIR(J,IER) ! entry, see if one exists for anyF - END DO ! of the other entries - END IF - I = I + 1 - END DO= - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessaryU - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULLI - CALL READDIR(J,IER)' - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of fileC - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - CALL READDIR(FIRST_DELETE,IER) - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER)A - END IFT - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE. - DATE = DATE_SAVE - TIME = TIME_SAVE_ - EXDATE = EXDATE_SAVET - EXTIME = EXTIME_SAVE - - RETURNQ - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags._ -CE - IMPLICIT INTEGER (A - Z)_ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLFOLDER.INC'L - -C -C Find user entry in BULLUSER.DAT to obtain flags._ -CL - - CALL OPEN_FILE_SHARED(4) ! Open user file - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry_ - - WRITE (6,'('' For the selected folder '',A)') FOLDER(1:TRIM(FOLDER)) - e - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THENI - WRITE (6,'('' NOTIFY is set.'')')L - END IF - - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND.F - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THENE - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (.NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN. - WRITE (6,'('' No flags are set.'')') - END IFD - - CALL CLOSE_FILE(4)1 - - RETURNR - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z)S - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1))= - - RETURN1 - END - - - SUBROUTINE CLR2(FLAG,NUMBER)) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1))F - - RETURNA - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))1 - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL)U -C= -C FUNCTION GETUSERS -CT -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z)I - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) USERNAME,TERMINAL - - DATA WILDCARD /-1/N - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list: - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,)F - ! Get next process.. - END DO1 - - IF (.NOT.IER) WILDCARD = -1 - - GETUSERS = IERT - - RETURNF - END - - - - - - SUBROUTINE OPEN_USERINFO -CA -C SUBROUTINE OPEN_USERINFOE -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C) - IMPLICIT INTEGER (A - Z)) - - INCLUDE 'BULLUSER.INC'A - - COMMON /USERINFO/ USERINFO_READ - DATA USERINFO_READ /.FALSE./1 - - CALL OPEN_FILE_SHARED(9)E - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - IF (IER.NE.0) THENX - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD',= - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2)F - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_FILE(4)T - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX8 - LAST_READ_BTIM(1,I) = READ_BTIM(1)T - LAST_READ_BTIM(2,I) = READ_BTIM(2)E - END DO - END IFD - END IF - IF (IER.EQ.0) WRITE (9) USERNAME,E - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX)i - END IFn - - CALL CLOSE_FILE(9)B - - USERINFO_READ = .TRUE.R - - RETURNC - END - - - - SUBROUTINE UPDATE_USERINFOT -CM -C SUBROUTINE UPDATE_USERINFOI -C -C FUNCTION: Updates the latest message read times for each folder. -C, - IMPLICIT INTEGER (A - Z)T - - COMMON /USERINFO/ USERINFO_READ - - INCLUDE 'BULLUSER.INC'! - - IF (.NOT.USERINFO_READ) RETURN - - CALL OPEN_FILE_SHARED(9)t - - READ (9,KEY=USERNAME,IOSTAT=IER)T - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,N - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX), - - CALL CLOSE_FILE(9)) - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM)F - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIMEL - - IF (TRIM(TIME).EQ.20) THENM - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM)R - ELSEL - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IFr - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -CR -C FUNCTION: -C_ -C Update user's last read bulletin date. If new bulletins have beenE -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit._ -C - - IMPLICIT INTEGER (A-Z)t - - INCLUDE 'BULLFOLDER.INC'l - - INCLUDE 'BULLUSER.INC'o - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHR - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)A - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATEL - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)E - - DIMENSION LOGIN_BTIM_SAVE(2)E - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)O - CALL UPDATE_READ ! Update login time - - IF (CLI$PRESENT('SELECT_FOLDER')) THENt - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURNr - END IFl - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - FOLDER_Q = FOLDER_Q1R - - CALL OPEN_FILE_SHARED(7) ! Go find folders - - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1. - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENM - CALL SET2(NEW_MSG,FOLDER_NUMBER)m - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THENt - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSIONn - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.t - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) -CL -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed.K -CV - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THENE - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE - END IFQ - IF (IER.NE.0) THENJ - CALL CHANGE_FLAG_NOCMD(0,2) - CALL CHANGE_FLAG_NOCMD(0,3) - CALL CHANGE_FLAG_NOCMD(0,4) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = 0I - CALL MODIFY_SYSTEM_LIST(0) - END IF - ELSE IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSEO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)t - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IFJ - END IF - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF= - END IF - END DO - - CALL CLOSE_FILE(7)t - - FOLDER_Q = FOLDER_Q1S - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - IF (TEST2(NEW_MSG,0)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - DO FOLDER_NUMBER = 1,FOLDER_MAX-1 - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THENH - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)E - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),R - & F_NEWEST_BTIM)D - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM)A - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM)S - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time.S - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IFE - END IF - IF (DIFF.LT.0) THENL - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - END IFT - END IFM - END DO - FOLDER_NUMBER = 0E - CALL SELECT_FOLDER(.FALSE.,IER)N - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THENN - WRITE(6,'('' Type READ to read new general messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0F - DO WHILE (NEW_COUNT.GT.0)E - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSEN - BULL_POINT = 0F - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)N - END IFU - END IF - ELSE ! READNEW mode. - DO FOLDER_NUMBER = 0,FOLDER_MAX-1s - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THENI - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)E - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM)I - ELSE% - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)T - END IF= - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERt - IF (BULL_POINT.NE.-1) THENW - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.e - & TEST2(SET_FLAG,FOLDER_NUMBER)) THENR - IF (FOLDER_NUMBER.GT.0) THEN - WRITE (6,'('' There are new messages in folder '',N - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE IF (FOLDER_NUMBER.EQ.0.OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THENC - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORYB - BULL_POINT = SAVE_BULL_POINTI - END DO - END IF, - END IF - END IFF - ELSE ! Can't select the folder - CALL CHANGE_FLAG_NOCMD(0,2) ! then clear SET_FLAGN - CALL CHANGE_FLAG_NOCMD(0,3)( - END IFH - END IF - END DO - CALL EXITB - END IFL - - RETURNI - END - - - - - SUBROUTINE DISCONNECT_REMOTE1 - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC'D - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = -1n - FOLDER1 = 'GENERAL' - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to GENERAL folder.'')') - - RETURN) - END diff --git a/decus/vax88b5/bulletin/bulletin8.for b/decus/vax88b5/bulletin/bulletin8.for deleted file mode 100644 index 01ae57f..0000000 --- a/decus/vax88b5/bulletin/bulletin8.for +++ /dev/null @@ -1,1309 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU@SMTP 16-AUG-1988 17:17 -To: ARISIA::EVERHART -Subj: BULLETIN8.FOR - - -Received: from deep-thought.mit.edu by EDDIE.MIT.EDU via Chaosnet with MAIL with sendmail-5.45/4.7 id ; Tue, 16 Aug 8 -8 10:45:00 EDT -Message-Id: <8808161445.AA05581@EDDIE.MIT.EDU> -Received: from PFC-VAX.MIT.EDU by DEEP-THOUGHT.MIT.EDU via Chaosnet; 16 Aug 88 10:44-EDT -Date: 16 Aug 88 10:44:13 EDT -From: MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@EE, MHG@MITRE-BEDFORD.ARPA@EE, - EVERHART%ARISIA.DECNET@GE-CRD.ARPA@EE, GAYMAN@ARI-HQ1.ARPA@EE -Subject: BULLETIN8.FOR - -C -C BULLETIN8.FOR, Version 8/9/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - CHARACTER NAMEDESC*9 /'BULLETIN1'/ - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - CALL SETDEFAULT('DECNET') - -C CALL SET_TIMER('02') - - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*9 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN),IO$_READVBLK,MBX_IOSB, - & MBX_AST,,MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*6,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL CONNECT(NODENAME,USERNAME,FROMNAME) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(200),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - CHARACTER*128 INPUT - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - END IFD - - RETURN. - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10h - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFD - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK)M - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURNm - - IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL EXECUTE_COMMAND(UNIT_INDEX). - - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - - RETURN. - END - - - - - - SUBROUTINE CONNECT(NODENAME,USERNAME,FROMNAME)8 - - IMPLICIT INTEGER (A-Z)R - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/i - - CHARACTER*(*) USERNAME,FROMNAME - - EXTERNAL IO$_ACCESS,IO$M_ABORTP - - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME)M - - IF (REJECT.NE.IO_REJECT) THEN - CALL READ_CHAN(CHAN,UNIT_INDEX)X - END IF! - - CALL READ_MBX - - RETURNL - END - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME)N - - IMPLICIT INTEGER (A-Z)M - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area forP - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10I - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSBT - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFL - DATA COUNT /0/I - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)I - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK)_ - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - EXTERNAL IO$_ACCESS,IO$M_ABORTI - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5)T - - LEN_NCB = MBX_BUF(START_NCB-1), - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THENE - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHANE - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER)L - - IF (IER) THENT - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1U - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THENT - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT$ - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAMEC - NODE_SAVE(UNIT_INDEX) = NODENAMEM - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0M - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IFE - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,)O - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1S - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0C - END IFS - - RETURNI - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER)C -CO -C SUBROUTINE GETDEVUNIT -CN -C FUNCTION: -C To get device unit number -C INPUT:K -C CHAN - Channel number( -C OUTPUT: -C DEV_UNIT - Device unit numberL -CR - - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listM - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist) - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURNO - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C_ -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT:) -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME+ - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listN - CALL ADD_2_ITMLST_WITH_RETS - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)): - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlistR - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN= - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -CE -C SUBROUTINE DISCONNECT -CN -C FUNCTION: Disconnects channel and remove its entry from the lists.S -CR - - IMPLICIT INTEGER (A-Z). - - PARAMETER MAXLINK = 10S - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFI - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area forL - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - IF (UNITS(UNIT_INDEX).EQ.0) RETURND - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0, - UNITS(UNIT_INDEX) = 0 - - RETURNX - END - - - - SUBROUTINE SET_TIMER(MIN) -CT -C SUBROUTINE SET_TIMER -CG -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C= - IMPLICIT INTEGER (A-Z)I - INTEGER TIMADR(2) ! Buffer containing timeE - ! in desired system format. - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/, - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN)T - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURNI - END - - - - - SUBROUTINE CHECK_CONNECTIONSI - - IMPLICIT INTEGER (A-Z)L - - PARAMETER MAXLINK = 10O - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFU - - IF (COUNT.GT.0) THEN) - DO UNIT_INDEX=1,MAXLINKT - IF (DEVS(UNIT_INDEX).NE.0.AND.V - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN1 - CALL DISCONNECT(UNIT_INDEX)L - END IFI - END DO - END IF% - - CALL RESET_TIMER - - RETURNI - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*)S - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2)T - - CALL INIT_ITMLSTC - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST)F - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THENC - USERNAME = 'DECNET'( - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)_ - END IFI - - RETURNN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME)S - - IMPLICIT INTEGER (A-Z)N - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100C - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - DO WHILE (NUM.LE.NETUAF_NUM)V - NUM = NUM + 11 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF)O - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEND - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURNN - END IF - END DON - - USERNAME = 'DECNET' - - RETURN0 - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z)A - - CHARACTER NETUAF*656V - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF)I - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)A - - FORMAT = 0 - - IF (IER.NE.0) THEN, - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT',L - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)I - FORMAT = 1 - END IFT - - NETUAF_NUM = 0N - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAFE - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:)M - NLEN = NLEN - 12N - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64)U - SKIP = 4 + ICHAR(NETUAF(65:65))S - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO_ - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65))U - NETUAF(65:) = NETUAF(69:)N - DO I=65+ULEN,76R - NETUAF(I:I) = ' ' - END DO - ELSEN - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DOA - - CLOSE (UNIT=7)N - - RETURNM - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX)U - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'I - - PARAMETER MAXLINK = 10_ - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFA - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)A - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)M - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK)A - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2B - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK)U - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL ENABLE_CTRL_EXIT,SS$_NOSUCHNODE,SS$_NOSUCHOBJR - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2)V - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - CHARACTER INPUT*(FOLDER_RECORD+16),DESCRIP_TEMP*53T - CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (INPUT,CMD_TYPE),(INPUT,INQUEUE)L - - INTEGER BULLCP_PRIV(2)D - - BULLCP_PRIV(1) = PROCPRIV(1) - BULLCP_PRIV(2) = PROCPRIV(2)1 - - ILEN = READ_IOSB(2,UNIT_INDEX)C - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(INPUT)) - - REC_SAVE(UNIT_INDEX) = 0) - USERNAME = USER_SAVE(UNIT_INDEX)C - FOLDER = FOLDER_NAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)T - NODENAME = NODE_SAVE(UNIT_INDEX)V - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15) THEN ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THENF - CALL GET_USER_PRIV(USERNAME,PRIV_SAVE(1,UNIT_INDEX))S - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - END IF - END IFB - - IF (CMD_TYPE.EQ.1) THEN ! Select folder - FOLDER1 = INPUT(5:ILEN)N - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(INPUT(1:1))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(INPUT(5:5))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFOK - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(INPUT(9:9))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - ELSE - CALL LIB$MOVC3(4,0,%REF(INPUT(9:9)))T - CALL LIB$MOVC3(4,0,%REF(INPUT(13:13)))V - END IF - INPUT = INPUT(:16)//FOLDER_COM - CALL WRITE_CHAN(16+LEN(FOLDER_COM),INPUT,UNIT_INDEX,IER1)) - IF (IER.AND.IER1) THEN - FOLDER_NAME(UNIT_INDEX) = FOLDERe - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBERU - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX)V - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1_ - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT(5:132))T - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(53,%REF(INPUT(5:5)),%REF(DESCRIP))O - CALL LIB$MOVC3(11,%REF(INPUT(58:58)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(INPUT(69:69)),%REF(EXTIME)) - CALL LIB$MOVC3(4,%REF(INPUT(80:80)),SYSTEM)) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)L - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENM - INPUT = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000L - ELSE IF (SYSTEM.NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND.C - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF (SYSTEM.NE.0.AND..NOT.SETPRV_PRIV()) THEN ! Priv test - IF (FOLDER_OWNER.NE.USERNAME) THENB - SYSTEM = 0 - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)N - END IF: - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)R - WRITE (EXTIME,'(I4)') NODE_NUMBERR - WRITE (EXTIME(7:),'(I4)') NODE_AREAI - DO I=1,11E - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//A - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IFI - END IF - CALL LIB$MOVC3(4,%REF(INPUT(81:81)),BROAD) - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN_ - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(INPUT(85:85)),BELL)E - CALL LIB$MOVC3(4,%REF(INPUT(89:89)),ALL) - CALL LIB$MOVC3(4,%REF(INPUT(93:93)),CLUSTER) - FOLDER_FILE =C - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERS - CALL OPEN_FILE(2) - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_FILE(1)T - OENTRY = OUT_HEAD(UNIT_INDEX)_ - LENGTH = LEN_SAVE(UNIT_INDEX)L - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH( - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)T - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THENG - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_FILE(1) ! Finished adding bulletinT - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder fileL - CALL CLOSE_FILE(2) ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_FILE_SHARED(4) ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME_ - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND.(TEMP_USER(2:).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node thatT - END IF ! originated the messageO - END DOZ - IF (TEMP_USER(:1).NE.':') THENO - CALL CLOSE_FILE(4)T - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE.P - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000T - END IF - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(1))= - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THENT - CALL ERRSNS(IDUMMY,IDUMMY,INODE)F - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR.E - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THENG - DELETE (4) - END IFR - ELSE) - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH)K - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DOL - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IFE - IER = SYS$CANTIM(%VAL(1),)E - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entryE - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT)T - FOLDER_FILE =( - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERI - CALL OPEN_FILE_SHARED(2) - IF (ICOUNT.GE.0) THENI - CALL READDIR(ICOUNT,IER)I - ELSE - CALL LIB$MOVC3(8,%REF(INPUT(9:9)),%REF(MSG_KEY(1:1))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_FILE(2) - CALL LIB$MOVC3(4,IER,%REF(INPUT(1:1))) - IF (ICOUNT.NE.0) THEN - INPUT(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,INPUT,UNIT_INDEX,IER)D - ELSE - INPUT(5:) = BULLDIR_HEADERO - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,INPUT,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),SBULL) - CALL LIB$MOVC3(4,%REF(INPUT(9:9)),EBULL) - FOLDER_FILE =A - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERR - CALL OPEN_FILE_SHARED(2) - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL)R - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)( - END DO - CALL CLOSE_FILE(2) - OENTRY = OUT_HEAD(UNIT_INDEX)U - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1U - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)I - OUT_SAVE(UNIT_INDEX) = OENTRYO - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT)E - FOLDER_FILE =L - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERV - CALL OPEN_FILE(2)I - IF (ICOUNT.GT.0) THENX - BULLDIR_ENTRY = INPUT(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER)N - ELSE - BULLDIR_HEADER = INPUT(9:)D - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_FILE(2) - ELSE IF (CMD_TYPE.EQ.4) THENT - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(INPUT(9:9)),IMMEDIATE) - DESCRIP_TEMP = INPUT(13:ILEN)) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER). - CALL OPEN_FILE(2)5 - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_FILE(2)_ - INPUT = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000B - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROMU - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_FILE(2)% - INPUT = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRYF - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE)S - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT) - FOLDER_FILE =( - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER) - CALL OPEN_FILE_SHARED(2) - CALL READDIR(ICOUNT,IER) - CALL OPEN_FILE_SHARED(1) - OENTRY = OUT_HEAD(UNIT_INDEX)U - DO I=BLOCK,BLOCK+LENGTH-1L - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_FILE(1) - CALL CLOSE_FILE(2) - OENTRY = OUT_HEAD(UNIT_INDEX)E - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH( - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)_ - OUT_SAVE(UNIT_INDEX) = OENTRYD - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)I - FOLDER_FILE =X - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERE - CALL OPEN_FILE(2)4 - CALL LIB$MOVC3(53,%REF(INPUT(5:5)),%REF(DESCRIP_TEMP)) - CALL LIB$MOVC3(4,%REF(INPUT(58:58)),ICOUNT)R - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_FILE(2): - INPUT = 'ERROR: Cannot find message to replace.'R - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000S - END IF - CALL LIB$MOVC3(53,%REF(INPUT(62:62)),%REF(DESCRIP))E - CALL LIB$MOVC3(4,%REF(INPUT(115:115)),%REF(MSGTYPE)) - CALL LIB$MOVC3(11,%REF(INPUT(119:119)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(INPUT(130:130)),%REF(EXTIME)) - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV()s - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_FILE(2)E - INPUT = 'ERROR: Insufficient privileges to replace message.'_ - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000R - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_FILE(1)I - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX)A - DO I=1,NEW_LENGTH/ - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)A - WRITE (1'NBLOCK+I) INQUEUER - END DO - CALL CLOSE_FILE(1) ! Finished adding bulletinT - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTHU - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1) - END IF - CALL WRITEDIR(ICOUNT,IER)9 - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1),A - & BTEST(MSGTYPE,2),EXDATE,EXTIME)( - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General?( - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BULL_DELETE) - DESCRIP_TEMP = INPUT(9:61) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)E - CALL OPEN_FILE(2)r - CALL READDIR(BULL_DELETE,IER)R - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENT - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 10000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_FILE(2) - INPUT = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER) - GO TO 1000M - END IF - CALL LIB$MOVC3(11,%REF(INPUT(62:62)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(INPUT(73:73)),%REF(EXTIME)) - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - FOLDER_FILE =) - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER) - CALL OPEN_FILE_SHARED(2) - CALL READDIR(0,IER)E - CALL GET_NEWEST_MSG(%REF(INPUT(5:5)),BULL_POINT) - CALL CLOSE_FILE(2) - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER). - CALL OPEN_FILE_SHARED(4) - NODENAME = INPUT(9:) - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) ) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONGM - NEW_FLAG (I) = 0T - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER,R - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_FILE(4) - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BLENGTH) - CALL LIB$MOVC3(4,%REF(INPUT(9:9)),START) - IF (BLENGTH.EQ.-1) THEN_ - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN( - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IFT - CALL LIB$MOVC3(ILEN-12,%REF(INPUT(13:13)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:1))) - CALL LIB$MOVC3(4,%REF(INPUT(13:13)),ALL)N - CALL LIB$MOVC3(4,%REF(INPUT(17:17)),CLUSTER)y - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX))A - IF (ILEN.GT.20) THEN) - CALL LIB$MOVC3(4,%REF(INPUT(21:21)),FOLDER_NUMBER) - FOLDER = INPUT(25:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER)R - END IFE - END IF - END IFI - -1000 PROCPRIV(1) = BULLCP_PRIV(1) - PROCPRIV(2) = BULLCP_PRIV(2)E - - RETURNE - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 10E - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)R - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2)B - - USERNAME = USER_SAVE(UNIT_INDEX)L - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)F - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO( - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),( - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.GE.0) RETURN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - CALL UPDATE_USERINFOE - - RETURNE - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM): - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM)I - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)N - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)F - - RETURN& - - END diff --git a/decus/vax88b5/bulletin/bulletin9.for b/decus/vax88b5/bulletin/bulletin9.for deleted file mode 100644 index f0838ec..0000000 --- a/decus/vax88b5/bulletin/bulletin9.for +++ /dev/null @@ -1,782 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU@SMTP 16-AUG-1988 12:49 -To: ARISIA::EVERHART -Subj: BULLETIN9.FOR - - -Received: from deep-thought.mit.edu by EDDIE.MIT.EDU via Chaosnet with MAIL with sendmail-5.45/4.7 id ; Tue, 16 Aug 8 -8 10:45:42 EDT -Message-Id: <8808161445.AA05597@EDDIE.MIT.EDU> -Received: from PFC-VAX.MIT.EDU by DEEP-THOUGHT.MIT.EDU via Chaosnet; 16 Aug 88 10:45-EDT -Date: 16 Aug 88 10:44:52 EDT -From: MRL%PFC-VAX.MIT.EDU%XX.LCS.MIT.EDU@EDDIE.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@EE, MHG@MITRE-BEDFORD.ARPA@EE, - EVERHART%ARISIA.DECNET@GE-CRD.ARPA@EE, GAYMAN@ARI-HQ1.ARPA@EE -Subject: BULLETIN9.FOR - -C -C BULLETIN9.FOR, Version 6/22/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_FILE_SHARED(4) ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_FILE(4) - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE '($HLPDEF)' - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P) - & ,LIBRARY,HLP$M_HELP.OR.HLP$M_PROMPT,LIB$GET_INPUT) - - RETURN - END - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - NLEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addedd - END IF - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:NLEN)//'""::' - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999X - END IF. - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER)S - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP)D - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Is semicolon present?: - IF (NLEN.GT.SEMI+1) THEN ! Yes, is username after node?X - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - NLEN = SEMI - 1 ! Remove semicolonN - ELSE ! No username after nodenameu - TEMP_USER = DEFAULT_USER ! Set username to default/ - NLEN = SEMI - 1 ! Remove semicolone - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolon presentM - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username wasT - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD)e - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:NLEN) - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '//N - & PASSWORD(1:TRIM(PASSWORD))//'"::',T - & TYPE='SCRATCH',IOSTAT=IER)C - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DOL - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)')0 - & NODES(POINT_NODE)A - ELSE - WRITE (6,'('' Error while deleting message to node '',A)')A - & NODES(POINT_NODE)V - WRITE (6,'(A)') INLINEV - END IF - END DOE - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1I - END DOT - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A)N - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -CO -C SUBROUTINE SET_FOLDER_FLAG -CB -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z)e - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FLAGNAMEN - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_FILE(7) ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)T - - IF (SETTING) THENS - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_FILE(7) - - WRITE (6,'(1X,A,'' has been modified for folder.'')')F - & FLAGNAME - ELSEt - WRITE (6,'(1X,A,'' You are not authorized to modify.'')')e - & FLAGNAME - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -Cc -C SUBROUTINE SET_FOLDER_EXPIRE_LIMITN -CI -C FUNCTION: Sets folder expiration limit. -CT - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLUSER.INC'd - - INCLUDE 'BULLFILES.INC' - - IF (LIMIT.LT.0) THENP - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THENo - CALL OPEN_FILE(7) ! Open folder filei - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_FILE(7) - WRITE (6,'('' Folder expiration date modified.'')')_ - ELSE4 - WRITE (6,'('' You are not allowed to modify folder.'')') - END IFi - - RETURN - END - - - - - - SUBROUTINE MERGET - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVET - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=13,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE',$ - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO( - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(13,IOSTAT=IER1) BULLDIR_HEADERD - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1B - - RETURNB - - ENTRY ADD_MERGE_TO(IER1)M - D - IER1 = 0U - - DO WHILE (IER1.EQ.0)S - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRYR - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1I - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=13) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1)A - - NEWEST_DATE = DATEC - NEWEST_TIME = TIMER - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME)n - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1_ - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF0 - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN_ - - ENTRY ADD_MERGE_REST(IER1)N - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0)N - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THENL - READ (13,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(13,IOSTAT=IER1) BULLDIR_HEADERf - IF (IER1.EQ.0) THEN - CLOSE (UNIT=13,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=13) - END IFN - RETURN - END IF - - NBULL = NBULL + 1S - MSG_NUM = NBULLP - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)M - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY= - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=13) - - RETURN. - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)_ - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURNP - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATEN - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1)E - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',)E - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',)f - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',)U - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',)O - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',)S - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',)U - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',): - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',)N - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',)( - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',)T - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',)_ - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',)U - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',)P - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - RETURNF - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z)O - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT' - CHARACTER*(*) LIBRARY - - INCLUDE '($HLPDEF)' - - IF (CLI$PRESENT('PRINT')) THEN' - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$PRINT:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - ELSE - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8)' - END IF - ELSEN - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD'( - & ,LIBRARY,HLP$M_HELP) - END IFm - - RETURN' - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z)i - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURND - END diff --git a/decus/vax88b5/bulletin/bulletin_ann.txt b/decus/vax88b5/bulletin/bulletin_ann.txt deleted file mode 100644 index 70e2af6..0000000 --- a/decus/vax88b5/bulletin/bulletin_ann.txt +++ /dev/null @@ -1,209 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU@SMTP 15-JUL-1988 10:42 -To: ARISIA::EVERHART -Subj: BULLETIN utility. - - -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 15 Jul 88 09:57-EDT -Date: 15 Jul 88 09:59:23 EDT -From: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -To: EVERHART%ARISIA.DECNET@GE-CRD.ARPA@XX -Subject: BULLETIN utility. - -You are about to receive version 1.52 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -If you are running an older version of BULLETIN, this version will -modify the format of some of the data files. This can cause problems if -the old version of BULLETIN is run after the data files have been -modified. Such a situation is possible on a cluster where each node has -installed the executable separately. To help installation, a new -command procedure INSTALL_REMOTE.COM has been included. This can be -used to install BULLETIN on several nodes from a single node. Read the -comments in the file for information on how to use it. - -(The format of the .BULLDIR will change. After successful installation, -the older versions of these files can be removed. This format change -can take a significant amount of time if the folder is large. If your -site has large folders, it is suggested that the new version be -installed during off peak hours.) - -(The latest feature and bug fixes for this new version are listed later.) - -You will be receiving 14 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) ALLMACS.MAR - 13) BULLCOMS1.HLP - 14) BULLCOMS2.HLP - 15) BULLET1.COM - 16) BULLET2.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run it, you can delete it. Read AAAREADME.TXT -for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. A command procedure is included at this -end of this message which can be run which uses EDT to do this for you. - - MRL%PFCVAX@XX.LCS.MIT.EDU ------------------------------------------------------------------------------- -V1.52 - -Made modifications so it would work with VMS V5.0. - -Modified structure of directory files for folders. The files are now -keyed files, the keys being message number and message date. This speeds -up the process of searching for a message using a date. Thus, BULLETIN is -now more efficient when it has to find the latest message in a folder. - -Modified cleanup algorithm. Old code could cause file corruption. - -Add /SUBJECT in SEARCH command to search only the description of messages. - -Add /DESCRIPTION and /OWNER in CREATE command. - -Corrected problem that would cause invalid notification of new messages -in a remote SYSTEM folder. If a new SYSTEM message was added, and a person -entered BULLETIN, it would notify the user that there was a new message in -the folder even though the SYSTEM message had been displayed during logging -in. To correct this, the BULLFOLDER.DAT format had to be changed to store -the date of the last non-SYSTEM message in each folder. - -Added logical name BULL_DISABLE to disable use of BULLETIN. Useful during -installation (or debugging) of BULLETIN. Also added command procedure -INSTALL_REMOTE.COM. These two should make it easier to install a new version -of BULLETIN in a cluster, where INSTALL must be run on each node to install -the new executable. This is especially important when the new executable -changes the format of the data file, so that the old version must not be run -after the data format has been changed. - -Fixed bug which caused NOTIFY flag for GENERAL folder to be cleared. - -Fixed bug which would cause /SUBJECT not to work in MAIL command if placed -after the username. Also added /HEADER qualifier to MAIL to include the -message header with the message. - -Fixed bug which prevented messages with expiration years > 1999 from being -deleted (without /IMMEDITATE). - -Fixed bug which was causing expired messages from not being deleted. - -Fixed bug which allows non-privileged user to copy a permanent message such -that the copy messaged kept the permanent designation. - -Fixed BBOARD algorithm which required the username in the "To:" mail message -field to be uppercase. Some non-DEC mail systems use lowercase. - -When creating a remote folder, i.e. CREATE/NODE, and the actual folder on -the remote node is PRIVATE, this information will now be displayed via the -SHOW FOLDER command. - -Fixed bug in BULLCP which resulted in subprocess BULL_CLEANUP to be spawned. -This should only occur if BULLCP is not running. BULLCP itself does the -cleanup of empty space in folders, so this was redundant and time consuming. - -Added /TEXT qualifier to REPLY command (and, as a consequence, also to the -ADD command). This is present in the RESPOND command, and includes the text -of the previously read message into the new message. Also, the text of the -old message is indented using ">"s, which can be suppressed with /NOINDENT. - -If files are shared between nodes in a cluster, SHUTDOWN messages were not -deleted at the appropriate times, as there was no way of knowing from -which node the messages were submitted from. This has been fixed so that -SHUTDOWN messages will be deleted when the node they were submitted from -is rebooted. - -KEYPAD mode has been added. Keypad can be enabled so that keys are assigned -to BULLETIN commands. This canenabled either by the SET KEYPAD command, or by -adding /KEYPAD to the command line. SHOW KEYPAD shows the definitions. - -Fixed bug which caused BULLCP not to be able to update a private folder after -BULLCP was used by a remote user. (During a remote access, BULLCP sets it's -privileges to that of the user's proxy login who is doing the access. It was -not getting set back to BULLCP's actual privileges.) - -Did you know that access to a folder can be resticted to a particular DECNET -node? This is because interactive processes are assigned the SYS$NODE_nodename -id, and that id can be specified via a SET ACCESS command. - -------------------------------------------------------------------------------- -$ set nover -$ edit/edt/nocommand allmacs.mar -'; Name: SETACC.MAR' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin0.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin1.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin2.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin3.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin4.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin5.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin6.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin7.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin8.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin9.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bullcoms1.hlp -'1 ADD' -d 1:.-1 -exit -$ edit/edt/nocommand bullcoms2.hlp -'1 ADD' -d 1:.-1 -exit -$ edit/edt/nocommand bullet1.com -'$set nover' -d 1:.-1 -exit -$ edit/edt/nocommand bullet2.com -'$set nover' -d 1:.-1 -exit diff --git a/decus/vax88b5/bulletin/bulletin_warning_vms_v5.txt b/decus/vax88b5/bulletin/bulletin_warning_vms_v5.txt deleted file mode 100644 index 4842c69..0000000 --- a/decus/vax88b5/bulletin/bulletin_warning_vms_v5.txt +++ /dev/null @@ -1,23 +0,0 @@ -From: CSBVAX::MRGATE!MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU@SMTP 10-AUG-1988 06:57 -To: ARISIA::EVERHART -Subj: BULLETIN - - -Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 10 Aug 88 06:38-EDT -Date: 10 Aug 88 06:39:13 EDT -From: MRL%PFC-VAX.MIT.EDU@XX.LCS.MIT.EDU -To: TENCATI@VLSI.JPL.NASA.GOV@XX, MHG@MITRE-BEDFORD.ARPA@XX, - EVERHART%ARISIA.DECNET@GE-CRD.ARPA@XX, GAYMAN@ARI-HQ1.ARPA@XX -Subject: BULLETIN - -WARNING: After upgrading to V5, you MUST reassemble ALLMACS.MAR before -relinking BULLETIN. If you don't do this, running BULLCP will cause your -machine to crash. (Luckily, you are forced to relink BULLETIN, since it uses -shared libraries, and these have changed so you will be unable to INSTALL it. -This will probably jog your memory to assemble ALLMACS, and thus avoid -rebooting under V5 and then have your machine crash repeatedly since BULLCP is -created by the system startup procedure, which is what happened to me!) - -Also, I discovered more changes that were needed to allow the remote folder -feature to work under V5. It requires a new BULLETIN8.FOR, which I will be -distributing shortly. diff --git a/decus/vax89a2/bulletin/aaareadme.1st b/decus/vax89a2/bulletin/aaareadme.1st deleted file mode 100644 index 446b21b..0000000 --- a/decus/vax89a2/bulletin/aaareadme.1st +++ /dev/null @@ -1,177 +0,0 @@ - Note: - Because userthouthout a Fortran compiler will nevertheless have to -assemble ALLMACS on VMS V5, the CREATEREST.COM procedure has been -supplied. - If you just want to build BULLETIN quickly, under either VMS V4 -or V5, just run the procedure - $ @CREATEREST -and a BULLETIN.EXE will be built for you. - Sources must be extracted from the supplied .ZOO files with a command -like - $ ZOO e bullsrc.zoo * -before a complete rebuild can be done from source. Define ZOO as a foreign -VMS command. The ZOO utility is in [vaxlt_89a.tools]. You need to use ZOO -ONLY if you want to recompile everything; running the CREATEREST command -does not require ZOO to have been used. ------------------------------------------ - -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utility PMDF. If you wish to -do so for another utility, read the text file WRITEMSG.TXT. I would be glad to -include any such programs with my distribution if you think such a program -would be of use to other users. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, you may have to modify the subroutine - which executes the RESPOND command. That command sends messages to either - the originator of the message or the mailing list associated with the - folder. These routines assume that one can simply use the VMS MAIL - utility to do so. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - - BULLETIN will work for both V4 & V5. However, you will have to reassemble - ALLMACS.MAR if you are upgrading from V5, i.e. - $ MAC ALLMACS - $ LIB BULL ALLMACS - $ DELETE ALLMACS.OBJ; - $ @BULLETIN.LNK - $ COPY BULLETIN.EXE BULL_DIR: - $ RUN SYS$SYSTEM:INSTALL - BULL_DIR:BULLETIN/REPLACE - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) WARNING: This scheme will - only work if the same SYSUAF files are shared by all nodes. If a different - SYSUAF file is used on a node or nodes, those nodes must have their own - bulletin files and BULLCP. However, they can still share the other nodes' - folder files by using the remote folder feature. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits themn - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you wanth - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COMc - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the- - data file. Older versions of BULLETIN will not run with newer formatst - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require differenti - linked executables.)h - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set ofh - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for howa - to do this. - -9) BULLETIN.COMg - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used.t - NOTE: Privileged functions such as /SYSTEM will work on other nodesL - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. diff --git a/decus/vax89a2/bulletin/aaareadme.too b/decus/vax89a2/bulletin/aaareadme.too deleted file mode 100644 index 43067c8..0000000 --- a/decus/vax89a2/bulletin/aaareadme.too +++ /dev/null @@ -1,311 +0,0 @@ -Obtained by sending a message to -Bulletin%mit.mfenet@nmfecc.arpa -with subject and text containing text -ALL - -From: CRDGW2::CRDGW2::MRGATE::"SMTP::CCC.MFECC.LLNL.GOV::BULLETIN%MIT.MFENET" 5-JUN-1989 14:39 -To: MRGATE::"ARISIA::EVERHART" -Subj: BULLETIN UTILITY. - -Received: from mit.mfenet by ccc.mfenet with Tell via MfeNet ; - Mon, 5 Jun 89 11:27:46 PDT -Date: Mon, 5 Jun 89 11:27:46 PDT -From: BULLETIN%MIT.MFENET@CCC.MFECC.LLNL.GOV -Message-Id: <890605112746.2ce0012a@CCC.MFECC.LLNL.GOV> -Subject: BULLETIN UTILITY. -To: EVERHART@ARISIA.decnet -Comment: From BULLETIN@MIT.MFENET on 5-JUN-1989 14:28:55.23 EDT - -You are about to receive version 1.68 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -The PMDF files have been made part of the general distribution. - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -This version includes all necessary modifications to work under VMS -V5.0. However, it will still be necessary to reassemble the ALLMACS.MAR -source under V5 and relink. The V4 version will not be installable -under V5 due to a change in a shared library which BULLETIN uses. -However, relinking by itself will not be enough. You MUST also -reassemble ALLMACS.MAR. If you only relink, BULLETIN can cause your -system to crash (the BULLCP process will do this because it uses the -routines in ALLMACS.MAR). - -If you are running a version of BULLETIN older than 1.52, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. This -format change can take a significant amount of time if the folder is -large. If your site has large folders, it is suggested that the new -version be installed during off peak hours. NOTE: Problems can occur -if the old version of BULLETIN is run after the data files have been -modified. Such a situation is possible on a cluster where each node has -installed the executable separately. To help installation, a new -command procedure INSTALL_REMOTE.COM has been included. This can be -used to install BULLETIN on several nodes from a single node. Read the -comments in the file for information on how to use it. - -NOTE: The BULLCP process should be stopped using the BULLETIN/STOP -command before the new version of BULLETIN is installed. It can then be -restarted using the BULLETIN/STARTUP command. (The INSTALL_REMOTE.COM -command procedure does this automatically for remote nodes.) - -You will be receiving 17 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) ALLMACS.MAR - 13) BULLCOMS1.HLP - 14) BULLCOMS2.HLP - 15) BULLET1.COM - 16) BULLET2.COM - 17) PMDF.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. Otherwise, you can delete -it. Read AAAREADME.TXT for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. A command procedure is included at the -end of this message which can be run which uses EDT to do this for you. - - MRL%MIT.MFENET@NMFECC.ARPA ------------------------------------------------------------------------- -V1.68 - -Fixed bug which prevented SHUTDOWN messages from being deleted. - -Fixed code to allow SHOW KEY/PRINT to work properly. - -V1.67 - -A bug was fixed which allowed unauthorized users to add messages to -semi-private folders by using the ADD/FOLDER command. - -Modified algorithm which decides if a user has "BULLETIN" privileges. -There was a problem with this algorithm, in that the SET PRIV/ID command -grants privileges to a user by creating an ACL on BULLUSER.DAT. -BULLETIN privileges are granted by checking access to that file. -Unfortunately, for this to properly work, the protection on this file -must be (RWED,RWED,,). However, due to various reasons, it has been -found that the protection of this file has changed and thus allowed -non-authorized users to obtain privileges. Therefore, the checking -algorithm now makes sure that access is obtained via ACLs. However, -this will also affect users that have the ability to set process -privileges to access the file. In the past, setting those privileges -was not necessary to gain BULLETIN privileges, only the ability to set -them was necessary. Now, it is necessary to set them. - -V1.66 - -The SET NODEFAULT_EXPIRE command would not work, since it conflicted -with SET NODE. The command has been removed. Removing the default -expiration time is now accomplished by SET DEFAULT_EXPIRE 0. Setting -the value to -1 specifies that the default is that messages will become -permanent. - -V1.65 - -Added option to COPY, MOVE, FILE, and PRINT commands to be able to -specify a range of messages, i.e. m1-m2. - -Under certain conditions, BULLETIN/STARTUP could be executed such that -the BULLCP created would not fully work, due to privilege problems. -BULLETIN/STARTUP has been changed so that it will work properly. - -V1.64 - -Added SET DIGEST command for a folder. This causes network mail -messages which are in digest form to be undigested, thus avoiding the -necessity of a special command procedure to do it. - -Added SET STRIP command for a folder. This caused network mail messages -to have their mail headers stripped off. - -Added the /ALL and /FORM= qualifiers to the PRINT command. - -Added the SPAWN command. - -Fixed minor bug relating to displaying remote folder messages when -logging in. If a message was added to a remote folder less than 15 -minutes before a user on another node logged in, and that was the only -new message in the folder, it is possible that the message will not be -displayed. This is because BULLCP only updates remote folders on the -local node every 15 minutes. The fix was that when logging in, remote -folders are checked for new messages that have been added since the -previous login time plus 15 minutes. - -If a site does not have a DECNET account, BULLETIN/START will now work -without having to modify the sources. The BULLCP process will be owned -by the process which started it. - -The PMDF program now writes out the owner of the message prefixed by -IN%", so that the RESPOND command will work with requiring modification -of the sources. - -V1.63 - -Fixed bug in deletion algorithm. If a deletion was interrupted, the -file could be left in a state such that BULLETIN would loop when -attempting to recover from the interruption. Also optimized the -recovery algorithm, as it would takes a long time to recover a large -folder. - -Fixed bug regarding remote folders. If user flags (SHOWNEW, READNEW, -etc.) were set for a remote folder, and there was an attempt to access -the remote folder when the remote node was down, BULLETIN would assume -the folder was no longer present, and remove the flags. BULLETIN now is -smart enough to know that the node is simply down, not removed. - -V1.62 - -Fixed exit handler to avoid possibility of default protection being -changed if BULLETIN is exited abnormally.a - -Fixed REMOVE bug relating to forgetting to change default protection. -If a user without process privileges attempts to remove a folder, and -the default protection for SYSTEM is not RWED, BULLETIN will crash.d - -The algorithm for getting the last boot time in order to determine when -to delete SHUTDOWN messages wouldn't work under V5 if the source was -compiled under V4. The routine has been rewritten so it is no longer -dependent on the VMS version. - -V1.61A - -Added SHOW USER command. Will show login times for a user (as recorded -by BULLETIN/LOGIN), and will show which users have NOLOGIN set. - -Fixed SET LOGIN command, as it was not working.t - -V1.6 - -Changed message line length limit from 80 to 255 characters. Messages -lines longer than the terminal width will wrap when displayed. 132 -column mode is now supported.i - -Message owner and subject fields have also been increased to 255 -characters. - -In most cases, the RESPOND subroutine should no longer have to be -customized to work with a site's network mail routine. The original -message owner as stored in VMS MAIL message is copied in full, and the -RESPOND command will use that when responding via the MAIL utility. - -The SET PRIV command now has a /ID qualifier which will allow a rights -identify to be specified. Thus, a user can be granted the ability to -execute privileged commands without the need to have higher VMS -privileges.U - -There is now a SHOW VERSION command. - -There is now a POST and RESPOND/LIST command which will send a mail -message to the network mailing list which is associated with a folder, -i.e. if a folder receives mail from a mailing list via the BBOARD -feature. The address of the mailing list is stored in the folder's -description. There is also a /CC qualifier for both POST & RESPOND. - -The ability to mark messages has been added, similar to the command in -the V5 version of VMS MAIL. New commands are MARK & UNMARK, DIR/MARKED, -READ/MARK, and SELECT/MARKED.a - -Several terminal output statements could not handle message numbers of -greater than 9999. They have been corrected.v - -Fixed bug which didn't allow proper display if page length was > 127.o - -Fixed 2 bugs associated with using the TPU editor when adding a message. -A "BULL.SCR file not found" message used to be displayed. It has now -been suppressed. Also a bug has been fixed which would cause a copy of -BULL.SCR to remain in SYS$LOGIN, if /TEXT was specified. - -Fixed bug which causes a BBOARD message to be split up if a form feedP -character occurs on a line by itself in the message. - --------------------------------------------------------------------------------_ -$ set novero -$ edit/edt/nocommand allmacs.mar -'; Name: SETACC.MAR') -d 1:.-2i -exit -$ edit/edt/nocommand bulletin.for -'C BULLETIN': -d 1:.-2 -exit -$ edit/edt/nocommand bulletin0.for -'C BULLETIN'L -d 1:.-2R -exit -$ edit/edt/nocommand bulletin1.for -'C BULLETIN' -d 1:.-2L -exit -$ edit/edt/nocommand bulletin2.for -'C BULLETIN'6 -d 1:.-2 -exit -$ edit/edt/nocommand bulletin3.for -'C BULLETIN' -d 1:.-2T -exit -$ edit/edt/nocommand bulletin4.for -'C BULLETIN'. -d 1:.-2 -exit -$ edit/edt/nocommand bulletin5.for -'C BULLETIN' -d 1:.-2T -exit -$ edit/edt/nocommand bulletin6.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin7.for -'C BULLETIN'o -d 1:.-2c -exit -$ edit/edt/nocommand bulletin8.for -'C BULLETIN' -d 1:.-2 -exit -$ edit/edt/nocommand bulletin9.for -'C BULLETIN'r -d 1:.-2o -exit -$ edit/edt/nocommand bullcoms1.hlp -'1 ADD'e -d 1:.-1R -exit -$ edit/edt/nocommand bullcoms2.hlp -'1 POST' -d 1:.-1n -exit -$ edit/edt/nocommand bullet1.com -'$set nover' -d 1:.-1 -exit -$ edit/edt/nocommand bullet2.com -'$set nover' -d 1:.-1t -exit -$ edit/edt/nocommand pmdf.comi -'$set nover' -d 1:.-1r -exit diff --git a/decus/vax89a2/bulletin/allmacs.mar b/decus/vax89a2/bulletin/allmacs.mar deleted file mode 100644 index 1b5fc53..0000000 --- a/decus/vax89a2/bulletin/allmacs.mar +++ /dev/null @@ -1,270 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - - .END diff --git a/decus/vax89a2/bulletin/board_digest.com b/decus/vax89a2/bulletin/board_digest.com deleted file mode 100644 index a5de1ed..0000000 --- a/decus/vax89a2/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vax89a2/bulletin/board_special.com b/decus/vax89a2/bulletin/board_special.com deleted file mode 100644 index e155436..0000000 --- a/decus/vax89a2/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vax89a2/bulletin/bullcom.cld b/decus/vax89a2/bulletin/bullcom.cld deleted file mode 100644 index d7f7fe3..0000000 --- a/decus/vax89a2/bulletin/bullcom.cld +++ /dev/null @@ -1,416 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 5/26/89 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER RESTART - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB POST - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER SUBJECT - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLUSTER, DEFAULT - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NOT ALL AND NOT DEFAULT AND CLUSTER - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER LOGIN - QUALIFIER NOLOGIN - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) diff --git a/decus/vax89a2/bulletin/bullcoms1.hlp b/decus/vax89a2/bulletin/bullcoms1.hlp deleted file mode 100644 index 1fb080a..0000000 --- a/decus/vax89a2/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,606 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does not -change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this assumes -that the remote node is capable of supporting this feature, i.e. the BULLCP -process is running on that node. If it is not, you will receive an error -message). If the the foldername is specified with only a nodename, -i.e. FOO::, the foldername is assumed to be GENERAL. NOTE: Specifying -remote nodes is only possible if that remote node is running a special -BULLCP process. If it isn't, the only way to add messages to that remote -node is via the /NODE command. However, /FOLDER is a much quicker method, -and much more versatile. - -You can specify logical names which translate to one or more folder names. -I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify /NODES= -ALL_FOLDERS. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL - -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See installation -notes). You can specify a different username to use at the other nodes by -either using the USERNAME qualifier, or by specifying the nodename with 2 -semi-colons followed by the username, i.e. nodename::username. If you -specify a username, you will be prompted for the password of the account -on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /PERMANENT -This option is restricted to privileged users for the GENERAL folder, -but available to all in other folders. If specified, message will be a -permanent message and will never expire. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -NOTE: If the bulletin files are shared between cluster nodes, the -message will be deleted after the node on which the message was -submitted from is rebooted. If the folder is a remote folder, the -message will be deleted after the remote node reboots, not the node -from which the message was added. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /TEXT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 BACK -Displays the message preceding the current message. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. If the text of the message -is to be changed, a file can be specified which contains the text. -Otherwise, you will be prompted for the text. The expiration info and -header can also be changed. If neither no qualifiers are added to the -command, it is assumed the whole message will be replaced. - - Format: - CHANGE [file-name] -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. This only applies to the GENERAL folder. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number - -Specifies the message number to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is ah -privileged command and is restricted to SYSTEM folders.i -2 /TEXTs -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to beo -copied to. Optionally, a range of messages which are to be copied can bet -specified following the folder name, i.e. COPY NEWFOLDER 2-5.t -2 /ALL -Specifies to copy all the messages in the old folder.B -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.r -2 /ORIGINALp -Specifies that the owner of the copied message will be the original ownere -of the message. The default is that the copied message will be owned by -the person copying the message.s -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically selectedb -(see information on SELECT command). The commands that can be used to -modify the folder's characteristics are: MODIFY, REMOVE, SET ACCESS, -SET BBOARD, SET NODE, and SET SYSTEM.g - - Format:d - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the foldere -is stored in a file name created with the folder name).a - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying BULLCOM.CLD. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description. - -Specifies the description of the folder, which is displayed using thec -SHOW FOLDER command. If omitted, you are prompted for a description. - -NOTE: If this folder is to receive messages from a network mailing listS -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTg -commands, the address of the mailing list should be included in thes -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST o -2 /NODE - /NODE=nodenameE -Specifies that the folder is a remote folder at the specified nodename.. -A remote folder is a folder in which the messages are actually storedr -on a folder at a remote DECNET node. The specified nodename is checked -to see if a folder of the same name is located on that node. If so, the -folder will point to that folder. This capability is only present if theD -BULLCP process is created on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If one node add a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -That information is only updated every 15 minutes (same algorithm for -updating BBOARD messages), or if a user accesses that folder.f -2 /NOTIFYf -Specifies that all users automatically have NOTIFY set for this folder.e -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command.N -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base.A -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info.D -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldernamel -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name.h -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW forb -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEMs -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is. -allowed to have SYSTEM and SHUTDOWN messages added to it. By default, -the GENERAL folder is a SYSTEM folder. This is a privileged command.a - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.e -1 CURRENTo - -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format:a - - CURRENTe -2 /EDITm -Specifies that the editor is to be used to read the message. This ise -useful for scanning a long message.r -1 DELETE -Deletes the specified message. If no message is specified, the currentp -message is deleted. Only the original owner or a privileged user canS -delete a message. Note that the message is not deleted immediately, but -it's expiration is set 15 minutes in the future. This is to allow a usere -to recover the message using the UNDELETE command. If you want thet -message deleted immediately, use the /IMMEDIATE qualifier. - - Format:e - DELETE [message_number][-message_number1]h - -The message's relative number is found by the DIRECTORY command. It ist -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot bea -specified if the folder is remote. -2 /ALL -Specifies to delete all the messages in the folder. Note: This wille -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. -2 /NODES - /NODES=(nodes[,...])i - -Specifies to delete the message at the listed DECNET nodes. The BULLETINd -utility must be installed properly on the other nodes. You can specifyc -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on thee -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one orN -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subjectN - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message.s -It can be a substring of the subject. This is in case you have forgotten -the exact subject that was specified. Case is not critical either.t -You will be notified if the deletion was successful. -2 /USERNAMEf -Specifies username to be used at remote DECNET nodes when deleting messagesm -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORYd -Lists a summary of the messages. The message number, submitter's name,t -date, and subject of each message is displayed.s - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. -2 /DESCRIBEs -Valid when used with /FOLDERS. Specifies to include description of folder.a -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. -2 /MARKEDB -Lists messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will haveo -to be reselected using the SELECT command. -2 /NEW -Specifies to start the listing of messages with the first unread message.r -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.e -2 /START - /START=message_number - -Indicates the first message number you want to display. For example,e -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -1 EXIT -Exits the BULLETIN program. -1 EXTRACTa -Synonym for FILE command.e -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified. - - Format:e - FILE [message_number][-message_number1]t - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5.e -2 /ALL -Copies all the messages in the current folder. -2 /HEADERt - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the l -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 FoldersE -All messages are divided into separate folders. The default folder is -GENERAL. New folders can be created by any user. As an example, then -following creates a folder for GAMES related messages: d - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMESn - -To see the list of available folders, use DIRECTORY/FOLDERS. To selecta -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that -user will be alerted of topics of new messages at login time, and will i -then be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option,c -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATEi -rather than /PRIVATE is specified, all users can read the messages in thes -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SETi -NODE. A remote folder is one which points to a folder on a remote DECNETe -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)e -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/e -SHUTDOWN/BROADCAST messages can be added. By default, the GENERAL foldera -is a SYSTEM folder (and cannot be changed). One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the GENERAL -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, and) -giving access to that UIC group. Only users in that UIC group will seea -the messages in that folder when they log in.s -1 HELP -To obtain help on any topic, type: - - HELP topic - -CTRL-Y only breaks out of a command when no files are open. Otherwise,m -use CTRL-C, which will abort the program. However, unlike CTRL-Y, you -can not resume execution using the VMS CONTINUE command. Also note that -CTRL-C will not abort if BULLETIN is waiting for input from the terminal.W -1 INDEXe -Gives directory listing of all folders in alphabetical order. If the -INDEX command is re-entered while the listing is in progress, the listinge -will skip to the next folder. This is useful for skipping a particulare -folder. It also can be used to continue the listing from where one left -off after one has read a message.E - - Format: - INDEX -2 /MARKEDE -Shows only messages that have been marked (indicated by an asterisk).s -2 /NEW -Specifies to start the listing of each folder with the first unread message. -Otherwise, the listing will start with the first message in the folder.e -If the INDEX command is re-entered for continuing the listing, /NEW must -be respecified.e -2 /RESTART -If specified, causes the listing to be reinitialized and start from thee -first folder.t -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/TE|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/TE| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format:e - LASTs -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format:I - - MAIL recipient-namee - -The input for the recipient name is exactly the same format as used by -the MAIL utility.d -2 /HEADERr - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the b -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of morei -than one word, enclose the text in quotation marks (").e - -If you omit this qualifier, the description of the message will be usedN -as the subject.. -1 MARK -Sets the current or message-id message as marked. Marked messages areS -displayed with an asterisk in the left hand column of the directory= -listing. A marked message can serve as a reminder of importantt -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers]m - UNMARK [message-number or numbers]e - -NOTE: The list of marked messages are stored in a file username.BULLMARK -in the directory pointed to by the logical name BULL_MARK. If BULL_MARK -is not defined, an error message will be displayed when attempting toE -mark a message. BULL_MARK may be defined system wide, depending onD -whether the system manager has decided to do so. -1 MODIFY -Modifies the database information for the current folder. Only the owner -of the folder or a user with privileges can use this command.f - - Format:i - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted forO -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing listh -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST* -commands, the address of the mailing list should be included in thet -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST u -2 /NAMES - /NAME=foldernameN - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not havee -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. -1 MOVE -Moves a message to another folder and deletes it from the current -folder.p - - Format:p - - MOVE folder-name [message_number][-message_number1]e - -The folder-name is the name of the folder to which the message is to beh -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,i -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /MERGE -Specifies that the original date and time of the moved messages arei -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.i -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned byc -the person moving the message. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. diff --git a/decus/vax89a2/bulletin/bullcoms2.hlp b/decus/vax89a2/bulletin/bullcoms2.hlp deleted file mode 100644 index 4e51be0..0000000 --- a/decus/vax89a2/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,751 +0,0 @@ -1 POST -Sends a message via MAIL to the network mailing list which is -associated with the selected folder. This command is used in -conjunction with a folder which receives messages from a network -mailing list. The address of the mailing list must be stored using -either CREATE/DESCRIPTION or MODIFY/DESCRIPTION. See help on those -commands for more information. -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 /TEXT -Specifies that the text of the message that is being read should be -included in the mai message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with > at the -beginning of each line. This can be suppressed with /NOINDENT. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The PRINT command can take optional qualifiers. - - Format: - - PRINT [message_number][-message_number1] - -A range of messages to be printed can optionally be specified, i.e. -FILE 2-5. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder will -be displayed. However, if there are new messages, the first new message -will be displayed. Each time you enter the command, the next page, or if -there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply hitting -the key is equivalent to "READ". -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected using the SELECT command. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged -user can remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /TEXT. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /TEXT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /NOINDENT -See /TEXT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -2 /TEXT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing -the first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header. -If a "search-string" is not specified, a search is made using the -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default general messages. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected.h -1 SETt -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format:s - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format:i - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database -for which access is being modified. It can also be a file name whichp -contains a list of ids. For more information concerning usage ofr -private folders, see HELP CREATE /PRIVATE. NOTE: Access is createdu -via ACLs. If a user's process privileges are set to override ACLs,p -that user will be able to access the folder even if access has not -been granted. -3 id -The id-name can be one or more ids contained in the system Rightsx -Database. This includes usernames and UICs. A UIC that contains -a comma must be enclosed in quotes. UICs can contain wildcards, -i.e. "[130,*]". Note that by default, a process is given thef -process rights id SYS$NODE_nodename, where nodename is the decnet -nodename. Thus, by specifing this id, a folder can be restricteda -to a specific node, which is useful when the folder is shared amongE -nodes in a cluster.s - -Alternatively, the id-name can be a filename which contains a list -of ids. The filename should be preceeded by a "@". If the suffix -is not specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. -If /READ is not specified, the folder will no longer be private. -If /READ is specified, all users will have read access, but only -privileged users will have write access (of course non-privilegedr -users can gain access via a later SET ACCESS command.) - -Format:n - - SET ACCESS /ALL [folder-name]t -3 /READd -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warningv -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that theu -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. u -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will applya -to the selected folder, and each folder can have it's own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, orr -the scratch bboard_directory (specified when compiling BULLETIN) must[ -have world rwed protection. Also, certain system parameters which affect -detached subprocesses are usually too low for the subprocess which -is spawned to read the mail. The parameters and the suggested values are: -PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, and PQL_DFILLIM = 30. If yout -are not using the BULLCP process, the subprocess limit for users must be -at least 2. - - Format:t - - SET BBOARD [username]e - -BBOARD cannot be set for remote folders. See also the commands SET STRIPa -and SET DIGEST for options on formatting BBOARD messages.a -3 /EXPIRATION( - /EXPIRATION=dayse - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to bee -retained. The default is 14 days. The highest limit that can bes -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature.r -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username ism -specified, and the conversion still takes it's input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time and -avoids creating subprocesses. (Useful if input is digest format.) -3 More_information - -The following is relevant only if the messages in the BBOARD accountsd -are sent via a method that causes the name of the account to be placed -in the TO: line of the VMS MAIL. The normal MAIL utility, of course,. -does this. However, packages such as PMDF (and probably many others)a -will not always do this. (I.e. if the mail was sent to the account -using CC:, the address of the person to whom the mail was sent will be -placed in the TO: line rather than the CC: address.) - -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX anda -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for theh -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that havey -the /SPECIAL set on their BBOARD accounts cannot have their mail forwarded -to BBOARD accounts that don't have /SPECIAL set. Folders of the same -type, i.e. that use the same /SPECIAL command procedure, must be grouped -separately. -2 BRIEFt -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. This cannot be specified for -the GENERAL folder. The BRIEF setting contrasts with the READNEWe -setting, which causes a listing of the description of the new messages -to be displayed and prompts the user to read the messages. Settinge -BRIEF will clear a READNEW setting (and visa versa). - - Format:l - - SET [NO]BRIEFm -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newR -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername[ - -Specifies the folder for which the option is to modified. If notE -specified, the selected folder is modified. Valid only with NOBRIEF. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest limitL -that can be specified is 30 days. This can be overridden by a user with -privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will -be used. - - Format:, - - SET DEFAULT_EXPIRE dayst - -If -1 is specified, messages will become permanent. If 0 is specified,i -no default expiration date will be present. The latter should never beL -specified for a folder with a BBOARD, or else the messages will disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or[ -written directly from a network mailing program (i.e. PMDF). Severalt -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set,r -the messages will be separated into individual BULLETIN messages.c - - Format:e - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory. - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. -(NOTE: SHOW FOLDER/FULL is a privileged command.)s -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - SET [NO]EXPIRE_LIMIT [days]- - -The command SHOW FOLDER/FULL will show the expiration limit, if one exists.r -(NOTE: SHOW FOLDER/FULL is a privileged command.) -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information.E - - Format:c - - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will haves -to be reselected.C -2 GENERICd -Specifies that the given account is a "generic" account, i.e used by manyh -different people. If an account is specified as GENERIC, new messages -placed in the GENERAL folder will be displayed upon logging in for a -specific number of days, rather than only once. The default period is 7 -days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username -3 /DAYSe - /DAYS=number_of_daysa - -Specifies the number days that new GENERAL messages will be displayedt -for upon logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has then -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this willh -not occur if DISMAIL is set for an old account. Additionally, removinge -the DISMAIL flag will not automatically enable LOGIN. (The reason for -the above was to avoid extra overhead for constant checking for then -DISMAIL flag.) This command is a privileged command.h - - Format:e - - SET [NO]LOGIN username -2 NODE -Modifies the selected folder from a local folder to a remote folder. -A remote folder is a folder in which the messages are actually storedL -on a folder at a remote DECNET node. The SET NODE command specifies -the name of the remote node, and optionally the name of the remote -folder. If the remote folder name is not included, it is assumed to -be the same as the local folder. When the command is executed, the -selected folder will then point to the remote folder. If there were -messages in the local folder, they will be deleted. This feature is -present only if the BULLCP process is running on the remote node. - - Format:3 - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that folder.t -3 /FOLDERo - /FOLDER=foldernamea - -Specifies the folder for which the node information is to modified.a -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when aa -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -This command does not presently work for remote folders. - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are loggedi -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared.t -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users foro -the specified folder. This is a privileged qualifier. - -If cluster notification is set, users will not be able to disableo -notification for themselves. This is because VMS is unable to find out -user names logged in at other nodes, which requires BULLETIN to keep a -list of users to notify. If /ALL is specified, the list may be very -large, which would cause the notification process to take a very longt -time. It is much easier to simply notify all users. However, this can -be overriden by the /NOCLUSTER qualifier, which will cause the list to -be generated.a -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specifiedo -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. - -If cluster notification is set, all users will notificated, and usersl -will not be able to disable notification for themselves. This isM -because VMS is unable to find out user names logged in at other nodes, -which requires BULLETIN to keep a list of users to notify. If /DEFAULT -is specified, the list may be very large, which would cause theO -notification process to take a very long time. It is much easier to -simply notify all users. However, /NOCLUSTER will override this, -causing the list to be generated.l -3 /CLUSTER - /[NO]CLUSTERo - -Specifies that if /ALL or /DEFAULT has been selected, and clustert -notification is enabled, all users across the network will be notified -of new messages. Users will not be able to disable notification.r -This is the default. /NOCLUSTER will disable this causing /DEFAULTr -and /ALL to work as it normally does, i.e. /DEFAULT simply setting -the default for new users, and /ALL causing all users to be notified -while enabling users to disable notification. However, if your system -has a lot of users, this will cause the notification algorithm to take -a very long time.p -3 /FOLDER - /FOLDER=foldernamep - -Specifies the folder for which the option is to modified. If notl -specified, the selected folder is modified. Valid only with NONOTIFY.] -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is F -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN.d - - Format:t - - SET [NO]PAGE -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format:. - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. l -To remove a privilege, specify the privilege preceeded by "NO".d -If /ID is specified, the parameters are rights identifiers.d -3 /IDd - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.t -2 PROMPT_EXPIREw -Specifies that a user will be prompted for an expiration date when adding -a message. If NOPROMPT_EXPIRE is specified, the user will not be prompted,v -and the default expiration (which is set by SET DEFAULT_EXPIRE or SETr -BBOARD/EXPIRATION) will be used. If the value specified is greater than the -expiration limit, and the user does not have privileges, then the expiration -limit will be used as the default expiration. (If there is no expiration. -limit, and the user doesn't have privileges, then an error will result.) -PROMPT_EXPIRE is the default.t - - Format:i - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to read -new non-system or folder messages (if any exist). The default is dependenta -on how the folder was created by the owner.a - -In order to apply this to a specific folder, first select the folder i -(using the SELECT command), and then enter the SET READNEW command./ -For messages in folders other than the GENERAL folder, both prompting -and display of topics of new messages are controlled by this command.l -For the GENERAL folder, the display of topics cannot be disabled.i - - Format:d - - SET [NO]READNEWp - -NOTE: If you have several folders with READNEW enabled, each folder'sM -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT thee -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP -SET SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersp -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERt - /FOLDER=foldernamec - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default isc -dependent on how the folder was created by the owner.t - -In order to apply this to a specific folder, first select the folder g -(using the SELECT command), and then enter the SET SHOWNEW command.c -This command cannot be used for the GENERAL folder. - - Format:a - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newl -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERu - /FOLDER=foldernamet - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -2 STRIPr -Affect only messages which are added via either the BBOARD option, oro -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped offs -before it is stored as a BULLETIN message. - - Format: - - SET [NO]STRIPi - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is an -privileged command.e - - Format:s - - SET [NO]SYSTEM - -By default, the GENERAL folder is a SYSTEM folder, and the setting for -that folder cannot be removed. - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.l -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGSn -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for thei -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected viai -the SELECT command, information about that folder is shown.i - - Format:e - - SHOW FOLDER [folder-name]e -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder ist -private, and BBOARD information. This information is only those who -have access to that folder. -2 KEYPAD -Displays the keypad command definitions. If the keypad has been enabled -by either the SET KEYPAD COMMAND, or /KEYPAD is specified on the command l -line, the keypad keys will be defined as commands. SHOW KEYPAD is the -equivalent of HELP KEYPAD. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unreads -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in. If NOLOGIN is set for a user,D -this information will be displayed instead. This is a privileged command. -Non-privileged users will only be able to display the information for -their own account. - - Format:h - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. s - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some sites -make BULLETIN/LOGIN an optional command for users to store in their ownm -LOGIN.COM, so this command can be used to show which users have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is ac -privileged command.e -3 /LOGIN - /[NO]LOGINe - -Specifies that only those users which do not have NOLOGIN set are to bet -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -2 VERSIONe -Shows the version of BULLETIN and the date that the executable was linked. -1 SPAWNy -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format:G - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 UNDELETE -Undeletes the specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have theira -expiration date set to 15 minutes in the future and are deleted then. -Undeleting the message will reset the expiration date back to it's originalD -value. Deleted messages will be indicated as such by the string (DELETED) -when either reading or doing a directory listing.e - - Format: - UNDELETE [message-number]i diff --git a/decus/vax89a2/bulletin/bulldir.inc b/decus/vax89a2/bulletin/bulldir.inc deleted file mode 100644 index 8e5dee2..0000000 --- a/decus/vax89a2/bulletin/bulldir.inc +++ /dev/null @@ -1,33 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(LINE_LENGTH) diff --git a/decus/vax89a2/bulletin/bullet1.com b/decus/vax89a2/bulletin/bullet1.com deleted file mode 100644 index 1fc3e88..0000000 --- a/decus/vax89a2/bulletin/bullet1.com +++ /dev/null @@ -1,782 +0,0 @@ -$set nover -$copy sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utility PMDF. If you wish to -do so for another utility, read the text file WRITEMSG.TXT. I would be glad to -include any such programs with my distribution if you think such a program -would be of use to other users. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, you may have to modify the subroutine - which executes the RESPOND command. That command sends messages to either - the originator of the message or the mailing list associated with the - folder. These routines assume that one can simply use the VMS MAIL - utility to do so. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - - BULLETIN will work for both V4 & V5. However, you will have to reassemble - ALLMACS.MAR if you are upgrading from V5, i.e. - $ MAC ALLMACS - $ LIB BULL ALLMACS - $ DELETE ALLMACS.OBJ; - $ @BULLETIN.LNK - $ COPY BULLETIN.EXE BULL_DIR: - $ RUN SYS$SYSTEM:INSTALL - BULL_DIR:BULLETIN/REPLACE - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) WARNING: This scheme will - only work if the same SYSUAF files are shared by all nodes. If a different - SYSUAF file is used on a node or nodes, those nodes must have their own - bulletin files and BULLCP. However, they can still share the other nodes' - folder files by using the remote folder feature. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require different - linked executables.) - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. -$eod -$copy sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(LINE_LENGTH) -$eod -$copy sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in it's memory. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -$eod -$copy sys$input BULLETIN.LNK -$deck -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB- - /EXE=BULLETIN,SYS$INPUT/OPT -ID="V1.68" -$eod -$copy sys$input BULLFILES.INC -$deck -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF IT -C IS NOT, THEN THEY SHOULD ALSO BE CHANGED. -C - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ -$eod -$copy sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,FILLER, - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) -$eod -$copy sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod -$copy sys$input WRITEMSG.TXT -$deck -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/vax89a2/bulletin/bullet2.com b/decus/vax89a2/bulletin/bullet2.com deleted file mode 100644 index 6a4a6f5..0000000 --- a/decus/vax89a2/bulletin/bullet2.com +++ /dev/null @@ -1,1067 +0,0 @@ -$set nover -$copy sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 5/26/89 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER RESTART - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB POST - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW TEXT AND NOT EDIT - DISALLOW TEXT AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT - QUALIFIER TEXT - QUALIFIER EDIT - DISALLOW TEXT AND NOT EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER SUBJECT - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLUSTER, DEFAULT - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NOT ALL AND NOT DEFAULT AND CLUSTER - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER LOGIN - QUALIFIER NOLOGIN - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) -$eod -$copy sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") -$eod -$copy sys$input BULLETIN.COM -$deck -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -$eod -$copy sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER,DEFAULT="7") -$eod -$copy sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy sys$input CREATE.COM -$deck -$ FORTRAN/EXTEND BULLETIN -$ FORTRAN/EXTEND BULLETIN0 -$ FORTRAN/EXTEND BULLETIN1 -$ FORTRAN/EXTEND BULLETIN2 -$ FORTRAN/EXTEND BULLETIN3 -$ FORTRAN/EXTEND BULLETIN4 -$ FORTRAN/EXTEND BULLETIN5 -$ FORTRAN/EXTEND BULLETIN6 -$ FORTRAN/EXTEND BULLETIN7 -$ FORTRAN/EXTEND BULLETIN8 -$ FORTRAN/EXTEND BULLETIN9 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB; -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIB/CREATE BULL -$ LIB BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK -$eod -$copy sys$input DCLREMOTE.COM -$deck -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET -$eod -$copy sys$input INSTALL.COM -$deck -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy sys$input INSTALL_REMOTE.COM -$deck -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL -$eod -$copy sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy sys$input LOGIN.COM -$deck -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! -$eod -$copy sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin9.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* - -$eod -$copy sys$input REMOTE.COM -$deck -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP -$eod diff --git a/decus/vax89a2/bulletin/bulletin.cld b/decus/vax89a2/bulletin/bulletin.cld deleted file mode 100644 index 8d8dbea..0000000 --- a/decus/vax89a2/bulletin/bulletin.cld +++ /dev/null @@ -1,35 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") diff --git a/decus/vax89a2/bulletin/bulletin.com b/decus/vax89a2/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vax89a2/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vax89a2/bulletin/bulletin.for b/decus/vax89a2/bulletin/bulletin.for deleted file mode 100644 index 5dede21..0000000 --- a/decus/vax89a2/bulletin/bulletin.for +++ /dev/null @@ -1,1400 +0,0 @@ -C -C BULLETIN.FOR, Version 5/9/89 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$GET_FOREIGN(INCMD) - CALL CLI$DCL_PARSE('BULLETIN '//INCMD,BULLETIN_MAINCOMMANDS) - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - END IF - CALL LIB$REVERT - - READIT = 0 - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP')) THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV privileges... - CALL CHECK_PRIV_IO(ERR) ! check privileges on output I/O - ELSE - ERR = 0 ! Else we don't have to check them. - END IF - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - CALL RUN_BULLCP ! doing what BULLCP does! - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL SHOW_SYSTEM - CALL EXIT - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - CALL NEW_MESSAGE_NOTIFICATION - - CALL OPEN_OLD_TAG - - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - - DO WHILE (1) - - CALL GET_INPUT_PROMPT(INCMD,IER, - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9') - IER = IER - 1 - END DO - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - - IER = MAX(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - CALL ADD - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - GO TO 999 ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 99999 - CALL READ(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.) - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEXT') THEN ! NEXT? - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - CALL REPLY - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(1,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(0,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET SHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,1) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(1,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOSHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET BRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,1) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(1,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOBRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (NBULL.GT.0) THEN - DIFF = COMPARE_BTIM( - & LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - END IF - END IF - END DO - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.) - END IF - -100 CONTINUE - - END DO - -999 CALL EXIT - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER*(LINE_LENGTH) INDESCRIP - - CHARACTER INLINE*80,OLD_FOLDER*25 - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - ELSE IF (CLI$PRESENT('TEXT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET? - USERNAME = DEFAULT_USER - CALL CONFIRM_PRIV(USERNAME,ALLOW) - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privileges - WRITE(ERROR_UNIT,1081) ! Tell user - GO TO 910 ! and abort - ELSE IF (F_EXPIRE_LIMIT.GT.0.AND..NOT.ALLOW ! Expiration limit - & .AND.USERNAME.NE.FOLDER_OWNER) THEN ! is present - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (INEXTIME,'(I4)') NODE_NUMBER - WRITE (INEXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - INDESCRIP = DESCRIP ! Use description with RE:, - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IF - - ICOUNT = 0 ! Line count for bulletin - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolons - ILEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Are semicolon found? - IF (ILEN.GT.SEMI+1) THEN ! Is username found? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes - ILEN = SEMI - 1 ! Remove semicolons - ELSE ! No username found... - TEMP_USER = DEFAULT_USER ! Set user to default - ILEN = SEMI - 1 ! Remove semicolons - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons present - TEMP_USER = DEFAULT_USER ! Set user to default - END IF - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:ILEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - INLINE = INLINE(:STR$POSITION(INLINE,' ')-1) - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - BRDCST = .FALSE. - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - FROM = USERNAME ! Username - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF - CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - CALL ADD_ENTRY ! Add the new directory entry - - IF (FOLDER_NUMBER.GE.0) THEN - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add - ELSE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (CLI$PRESENT('TEXT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanent - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*23 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*8 LOCALNODE - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE(4) - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE (4) - - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP) - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - DESCRIP = 'RE: '//DESCRIP - ELSE - DESCRIP = 'RE:'//DESCRIP(4:) - END IF - WRITE (6,'(1X,A)') DESCRIP - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - CALL CHECK_BULLETIN_PRIV(USERNAME) - - RETURN - END - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - CHARACTER*255 COMMAND - - CALL DISABLE_PRIVS - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - CALL LIB$SPAWN('$'//COMMAND(:CLEN)) - ELSE - CALL LIB$SPAWN() - END IF - CALL ENABLE_PRIVS - - RETURN - END diff --git a/decus/vax89a2/bulletin/bulletin.hlp b/decus/vax89a2/bulletin/bulletin.hlp deleted file mode 100644 index b3e6d24..0000000 --- a/decus/vax89a2/bulletin/bulletin.hlp +++ /dev/null @@ -1,108 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in it's memory. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) diff --git a/decus/vax89a2/bulletin/bulletin.lnk b/decus/vax89a2/bulletin/bulletin.lnk deleted file mode 100644 index 96e5cb0..0000000 --- a/decus/vax89a2/bulletin/bulletin.lnk +++ /dev/null @@ -1,3 +0,0 @@ -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB- - /EXE=BULLETIN,SYS$INPUT/OPT -ID="V1.68" diff --git a/decus/vax89a2/bulletin/bulletin0.for b/decus/vax89a2/bulletin/bulletin0.for deleted file mode 100644 index 67f04fe..0000000 --- a/decus/vax89a2/bulletin/bulletin0.for +++ /dev/null @@ -1,1418 +0,0 @@ -C -C BULLETIN0.FOR, Version 5/16/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = I + 1 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IF - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - - - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER) - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.REMOTE_USER.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,DESCRIP - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(1:11) - NEWEST_EXTIME = INPUT(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - DO BULL_DELETE = SBULL,EBULL - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM) - IER = SYS$ASCTIM(,INPUT,EX_BTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:) - - CALL WRITEDIR(0,IER) - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT - - CHARACTER START_PARAMETER*16,DATETIME*23 - - INTEGER TODAY(2) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (INCMD(:3).EQ.'DIR'.AND..NOT.READ_TAG) THEN - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').AND. - & CLI$PRESENT('MARKED')) THEN - IF (FOLDER_NUMBER.GE.0) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: Cannot use /MARKED with'', - & '' remote folder.'')') - RETURN - END IF - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified? - IER = CLI$GET_VALUE('START',START_PARAMETER,ILEN) - DECODE(ILEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEN - DIR_COUNT = NBULL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - END IF - - CALL READDIR_KEYGE(IER) - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - RETURN - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IF (READ_TAG) THEN - IF (.NOT.(CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW') - & .OR.CLI$PRESENT('START'))) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - END IF - - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - END IF - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THEN - EBULL = NBULL - END IF - IF (.NOT.REMOTE_SET.AND..NOT.READ_TAG) THEN - DO I=SBULL,EBULL ! Copy messages from file - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - END DO - ELSE IF (READ_TAG) THEN - I = SBULL - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) EBULL = EBULL - 1 - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,SBULL,EBULL - IF (IER.EQ.0) THEN - I = SBULL - DO WHILE (IER.EQ.0.AND.I.LE.EBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - RETURN - END IF - END IF - ELSE - NBULL = 0 - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - IF (NBULL.EQ.0) THEN - WRITE (6,'('' There are no messages present.'')') - RETURN - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - FLEN = TRIM(FOLDER) - WRITE(6,'(X,A)') FOLDER(:FLEN) - WRITE(6,1000) ! Write header - N = 3 - - IF (BULL_TAG.AND..NOT.READ_TAG) THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - DO I=SBULL,EBULL - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - IF (MSG_NUM.GT.999) N = 4 - IF (MSG_NUM.GT.9999) N = 5 - IF (READ_TAG.OR.(BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG)) THEN - WRITE (6,'('' *'',$)') - ELSE - WRITE (6,'('' '',$)') - END IF - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM,'(DELETED)' - ELSE - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM, - & DATE(1:7)//DATE(10:11) - END IF - IF (BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (DIR_COUNT.GT.NBULL.OR.(READ_TAG.AND.IER1.NE.0)) THEN - ! Outputted all entries? - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - -2010 FORMAT('+',I,1X,A<55-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1015) - RETURN - END IF - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And return - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - DO FBULL = SBULL,EBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1) THEN ! Was bulletin found? - WRITE(6,1030) FBULL - IF (FBULL.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_PARAMETER(1:LEN_P) - ! Show name of file created. - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - - RETURN - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message(s) written to ',A) -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*23,INREAD*1 - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - DIMENSION NOLOGIN_BTIM(2),LOGIN_BTIM_SAVE(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL MODIFY_SYSTEM_LIST(1) - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) RETURN - ! DISMAIL set - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry - READ_BTIM(2) = NEW_BTIM(2) - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - ELSE - LOGIN_BTIM_SAVE(1) = NEW_BTIM(1) - LOGIN_BTIM_SAVE(2) = NEW_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - BBOARD_BTIM(1) = TODAY_BTIM(1) - BBOARD_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - IF (.NOT.TEST_BULLCP()) CALL CREATE_BBOARD_PROCESS - ELSE - CALL CLOSE_BULLUSER - IF (IER.NE.0) CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compare - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - - IF (NEW_FLAG(2).NE.0) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - RETURN - END IF - -C -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible. -C - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.FOLDER_SET) THEN - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IF - - IF (REMOTE_SET) THEN ! If system remote folder, use remote - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, ! info, not local login time - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - LOGIN_BTIM(1) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (FOLDER_NUMBER.GT.0.AND.BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST2(SET_FLAG,FOLDER_NUMBER) - & .AND..NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) RETURN - ! Don't overwhelm new user with lots of non-general msgs - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - LOGIN_BTIM(1) = SYSTEM_LOGIN_BTIM(1) ! Use specified login time - LOGIN_BTIM(2) = SYSTEM_LOGIN_BTIM(2) ! for system messages. - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF (REVERSE_SWITCH.AND.(.NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,NBULL - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,NBULL,START - END IF - IF (IER.EQ.0) THEN - ALL_DIR = ALL_DIR1 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.NBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - RETURN - END IF - ALL_DIR = ALL_DIR1 - END IF - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - ! No. Is bulletin system or from same user? - IF (.NOT.REVERSE) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (SYSTEM_SWITCH) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - ELSE - DIFF = -1 - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF (SYSTEM.EQ.3) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0) THEN ! And save only the first non-system msg - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (NGEN.EQ.0.AND.NSYS.EQ.0) RETURN - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - RETURN - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - RETURN - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) '+'//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) '+'//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - ELSE - PAGE = PAGE + 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) ' '//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) ' '//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - IF (SYSTEM.GT.9999) THEN ! # Digits in message number - N = 5 - ELSE IF (SYSTEM.GT.999) THEN - N = 4 - ELSE - N = 3 - END IF - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD,INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:56-N),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:56-N),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST2(SET_FLAG,FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - ELSE - FLEN = TRIM(FOLDER) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 49 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-48)// - & ' command can be used to read these messages.' - ELSE - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-49-FLEN) - & //' '//FOLDER(:FLEN)// - & ' command can be used to read these messages.' - END IF - END IF - - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<57-N>,1X,A12,1X,A6,<6-N>X,I) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END diff --git a/decus/vax89a2/bulletin/bulletin1.for b/decus/vax89a2/bulletin/bulletin1.for deleted file mode 100644 index 69cf466..0000000 --- a/decus/vax89a2/bulletin/bulletin1.for +++ /dev/null @@ -1,1543 +0,0 @@ -C -C BULLETIN1.FOR, Version 5/11/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (MAIL_SUBJECT(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - MAIL_SUBJECT(I:I) = '`' - ELSE - MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - IER = CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER,LEN_P) - - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) - & //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,STATUS) - CALL ENABLE_PRIVS - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*25 - - IF (CLI$PRESENT('ORIGINAL').AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - END IF - END IF - - FROM_REMOTE = REMOTE_SET - - IF (REMOTE_SET) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.0) THEN - CALL OPEN_BULLFIL - I = BULL_POINT - 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THEN - IF (I.EQ.0) THEN - WRITE (12,IOSTAT=IER1) BULLDIR_HEADER - ELSE - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - END IF - NBLOCK = 1 - DO WHILE (I.LT.BULL_POINT+NUM_COPY-1.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THEN - BLOCK = NBLOCK - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - IF (IER1.EQ.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER1) 5,I - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - END IF - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT(:128)) - WRITE (11'NBLOCK,IOSTAT=IER1) INPUT(:128) - NBLOCK = NBLOCK + 1 - END DO - END IF - IF (IER1.NE.0) I = IER - END IF - END DO - NUM_COPY = I - BULL_POINT + 1 - END IF - CALL CLOSE_BULLFIL - IF (IER1.NE.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=11) - CLOSE (UNIT=12) - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IF - - IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_BULLDIR ! Prepare to add dir entry - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND. - & .NOT.SETPRV_PRIV().AND..NOT.ALL) THEN ! Permanent? - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.CLI$PRESENT('ORIGINAL')) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END DO - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - CLOSE (UNIT=11) - - CLOSE (UNIT=12) - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0) THEN - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - CALL DELETE - END IF - END IF - - RETURN - - END - - - - - - SUBROUTINE PRINT -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*31 FORM_NAME - - PARAMETER FF = CHAR(12) - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1015) - RETURN - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - CALL OPEN_BULLDIR_SHARED - - CALL OPEN_BULLFIL_SHARED - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified message - - IF (IER.NE.I+1) THEN ! Was message found? - IF (I.EQ.SBULL) THEN ! No, were any messages found? - WRITE(6,1030) ! If not, then error out - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE ! Yes, message found. - IF (I.GT.SBULL) WRITE(3,'(A)') FF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - END IF - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) ! Get queue name - IF (ILEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - ILEN = 9 - END IF - - CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IF - - IF (CLI$PRESENT('FORM')) THEN - IER = CLI$GET_VALUE('FORM',FORM_NAME,FORM_NAME_LEN) - CALL ADD_2_ITMLST(FORM_NAME_LEN,SJC$_FORM_NAME,%LOC(FORM_NAME)) - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*11,DATETIME*23,BUFFER*(LINE_LENGTH) - CHARACTER SAVE_MSG_KEY*8 - - LOGICAL SINCE,PAGE - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - IF (CLI$PRESENT('MARKED')) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No marked messages found.'')') - RETURN - ELSE - READ_TAG = .TRUE. - END IF - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - RETURN - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IF - - IF (READ_TAG) THEN - NEXT = .FALSE. - IF (INCMD(:4).EQ.'NEXT'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - IF (.NOT.CLI$PRESENT('BULLETIN_NUMBER')) NEXT = .TRUE. - END IF - IF (INCMD(:4).EQ.'BACK') THEN - SAVE_MSG_KEY = MSG_KEY - MSG_KEY = BULLDIR_HEADER - I = 0 - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_KEY.NE.SAVE_MSG_KEY) - I = I + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO - IF (IER.EQ.0) THEN - MSG_KEY = BULLDIR_HEADER - DO J=1,I-1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - ELSE IF (NEXT) THEN - IF (SINCE) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - ELSE - IF (BULL_POINT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END IF - IF (IER.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND. - & (.NOT.READ_TAG.OR.(.NOT.NEXT.AND.INCMD(:4).NE.'BACK'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IF - - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2) - END IF - - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'CURR') THEN - IF (CLI$PRESENT('EDIT')) THEN - CALL READ_EDIT - RETURN - END IF - END IF - - FLEN = TRIM(FOLDER) - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - WRITE (INPUT,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULL - DO WHILE (INDEX(INPUT,' ').LT.TRIM(INPUT)) - I = INDEX(INPUT,' ') - INPUT(I:) = INPUT(I+1:) - END DO - I = TRIM(INPUT) - INPUT = ' #'//INPUT(2:TRIM(INPUT)) - INPUT(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//INPUT(:TRIM(INPUT)) - ELSE - WRITE(6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - - END = END + 1 - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - WRITE(6,'('' From: '',A)') FROM - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - ELSE - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - END IF - WRITE(6,'('' Subj: '',A)') DESCRIP - END = END + 1 - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - WRITE(6,'(1X)') - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE (BUFFER,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULL - DO WHILE (INDEX(BUFFER,' ').LT.TRIM(BUFFER)) - I = INDEX(BUFFER,' ') - BUFFER(I:) = BUFFER(I+1:) - END DO - BUFFER = ' #'//BUFFER(2:TRIM(BUFFER)) - BUFFER(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN) - WRITE(6,'(1X,A,/)') BUFFER(:TRIM(BUFFER)) ! Output header info - END = END + 2 ! Increase display counter - END IF - -200 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - - RETURN - -1030 FORMAT(' ERROR: Specified message was not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE READ_EDIT - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_BULLFIL - - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,' Date: ',A) - - RETURN - END - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - CHARACTER INREAD*1,FILE_DEF*80,NUMREAD*5 - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH,ERR=18,STATUS='UNKNOWN', - & CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END DO - IF (ILEN.EQ.0) WRITE(6,1040) BULL_PARAMETER(:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - IF (READ_COUNT.GT.0) THEN ! Reposition GET_BULL routine - ILEN = LINE_LENGTH + 1 ! in case read in progress - DO I=1,LINE_OFFSET ! and partial block was read. - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - END IF - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message - & number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit), - & F(File it), D(Dir), R(Read msg #) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit), F(File), N(Next), - & D(Dir), R(Read msg #) or other for MORE: ',$) -1040 FORMAT(' Message written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER_OWNER) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END diff --git a/decus/vax89a2/bulletin/bulletin2.for b/decus/vax89a2/bulletin/bulletin2.for deleted file mode 100644 index 6803435..0000000 --- a/decus/vax89a2/bulletin/bulletin2.for +++ /dev/null @@ -1,1520 +0,0 @@ -C -C BULLETIN2.FOR, Version 6/2/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23,RESPONSE*1 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*11,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,FOLDER_SAVE*25 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for GENERAL folder.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND(STATUS) -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FROM_TEST*5,INFROM*(LINE_LENGTH) - - EXTERNAL CLI$_NEGATED - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - BULL_PARAMETER = 'RE: '//DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P) - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - END IF - - LEN_P = TRIM(BULL_PARAMETER) - - IF (BULL_PARAMETER(:1).NE.'"') THEN - BULL_PARAMETER = '"'//BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + 1 - END IF - - IF (BULL_PARAMETER(LEN_P:LEN_P).NE.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'"' - LEN_P = LEN_P + 1 - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - IF (EDIT.AND.CLI$PRESENT('TEXT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - END IF - - LENFRO = 0 - IF (CLI$GET_VALUE('CC',INPUT,ILEN)) THEN - INFROM = INPUT(:ILEN)//',' - LENFRO = ILEN + 1 - END IF - - IF ((EDIT.AND.CLI$PRESENT('TEXT')).OR. - & INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INFROM(:LENFRO)//INPUT(7:) - LENFRO = LENFRO + ILEN - 6 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (CLI$PRESENT('LIST')) THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - - IF (EDIT.AND.CLI$PRESENT('TEXT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (CLI$PRESENT('LIST')) THEN - LIST = INDEX(FOLDER_DESCRIP,'<') - IF (LIST.GT.0) THEN - INFROM = INFROM(:LENFRO)// - & FOLDER_DESCRIP(LIST+1:TRIM(FOLDER_DESCRIP)-1) - LENFRO = LENFRO + TRIM(FOLDER_DESCRIP) - 1 - LIST - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF -C -C NOTE: Normally, RESPOND simply uses MAIL to respond to bulletin message. -C However, if you have a special mail package, you will have to make some -C sort of modification to the code. At PFC, we are still awaiting INTERNET, -C so we get our mail sent from the user PFCVAX::CHAOSMAIL. Therefore, I have -C to test for that username, and then look for a FROM: line in the message in -C in order to find who really to respond to. However, most sites will -C have intelligent network connections which can use the MAIL utility. -C - IF (INDEX(INFROM,'PFCVAX::CHAOSMAIL').EQ.0.AND. - & INDEX(INFROM,'MFENET::').EQ.0) THEN - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - IF (CLI$PRESENT('TEXT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//INFROM(:LENFRO) - & //'"/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT "'//INFROM(:LENFRO)// - & '"/SUBJECT='//BULL_PARAMETER,,,,,,STATUS) - END IF - CALL ENABLE_PRIVS - ELSE - IF (INCMD(:4).NE.'POST') THEN - FROM_TEST = ' ' - CALL OPEN_BULLFIL_SHARED - L_INPUT = LINE_LENGTH + 1 - DO WHILE (L_INPUT.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,L_INPUT) - IF (L_INPUT.GT.0) THEN - CALL STR$UPCASE(FROM_TEST,INPUT(:5)) - IF (FROM_TEST.EQ.'FROM:'.AND. - & INDEX(INPUT,'PFCVAX::CHAOSMAIL').EQ.0) THEN - IF (INDEX(INPUT,'.').GT.0.OR.INDEX(INPUT,'@').GT.0 - & .OR.INDEX(INPUT,'%').GT.0) THEN - L_INPUT = 0 - END IF - END IF - END IF - END DO - CALL CLOSE_BULLFIL - IF (FROM_TEST.EQ.'FROM:') THEN - L_B = INDEX(INPUT,'<') - R_B = INDEX(INPUT,'>') - IF (L_B.GT.0.AND.R_B.GT.0) THEN - INPUT = INPUT(L_B+1:R_B-1) - L_INPUT = R_B - 1 - L_B - ELSE - L_INPUT = TRIM(INPUT) - I = 6 - DO WHILE (INPUT(I:I).EQ.' '.AND.I.GT.0) - I = I + 1 - IF (I.GT.L_INPUT) I = 0 - END DO - INPUT = INPUT(I:L_INPUT) - L_INPUT = L_INPUT - I + 1 - END IF - I = INDEX(INFROM,'PFCVAX::CHAOSMAIL') - INFROM = INFROM(:I-1)//INPUT(:L_INPUT)//INFROM(I+17:) - LENFRO = LENFRO - 17 + L_INPUT - END IF - END IF - I = INDEX(INFROM,'MFENET::') - IF (I.GT.0) THEN - INFROM = INFROM(:I-1)//INFROM(I+8:) - LENFRO = LENFRO - 8 - END IF - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR PFCVAX::'// - & 'MFENET/SUBJECT="'//INFROM(:LENFRO)//'"',,,,,,STATUS) - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT PFCVAX::MFENET'// - & '/SUBJECT="'//INFROM(:LENFRO)//'"',,,,,,STATUS) - END IF - CALL ENABLE_PRIVS - END IF - -900 IF (EDIT) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: Replaces existing bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH) - CHARACTER*1 ANSWER - - CHARACTER DATE_SAVE*11,TIME_SAVE*11 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL*1 DOALL - -C -C Get the bulletin number to be replaced. -C - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are reading - ELSE - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletin - - CALL CLOSE_BULLDIR - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person - RETURN ! and error out - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND. - & USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - REC1 = 0 - - LENFROM = 0 - - IF (LENDES.GT.0.OR.CLI$PRESENT('TEXT').OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (CLI$PRESENT('TEXT').OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (CLI$PRESENT('TEXT').OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - CALL OPEN_BULLDIR ! Prepare to add dir entry - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.CLI$PRESENT('TEXT')) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - NBLOCK = NBLOCK + ICOUNT - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:59) ! Update description header - END IF - CALL UPDATE_DIR_HEADER(CLI$PRESENT('EXPIRATION').OR.DOALL, - & CLI$PRESENT('PERMANENT'),CLI$PRESENT('SHUTDOWN'), - & INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT')) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION')) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:59),MSGTYPE,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER TODAY*23,INEXDATE*11,INEXTIME*11 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*132 SEARCH_STRING,SAVE_STRING - DATA SEARCH_STRING /' '/, SEARCH_LEN /1/ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL DISABLE_CTRL - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_POINT - BULL_POINT = BULL_POINT - 1 - END IF - - SAVE_STRING = SEARCH_STRING - SAVE_LEN = SEARCH_LEN - - IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - - IF (.NOT.IER) THEN ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - SEARCH_LEN = SAVE_LEN - ELSE IF (.NOT.CLI$PRESENT('START')) THEN ! If string entered but no - BULL_POINT = 0 ! starting message, use first - END IF - - IF (IER) SUBJECT = CLI$PRESENT('SUBJECT') - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - IF (BULL_POINT+1.GT.NBULL) THEN - WRITE (6,'('' ERROR: No more messages.'')') - CALL CLOSE_BULLDIR - CALL ENABLE_CTRL - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - CALL DECLARE_CTRLC_AST - - DO BULL_SEARCH = BULL_POINT+1, NBULL - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1) THEN - CALL STR$UPCASE(DESCRIP,DESCRIP) ! Make upper case - IF (INDEX(DESCRIP,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND..NOT.SUBJECT) THEN - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CALL ENABLE_CTRL - RETURN - END IF - END DO - END IF - END DO - -900 CALL CANCEL_CTRLC_AST - - CALL CLOSE_BULLFIL ! End of bulletin file read - CALL CLOSE_BULLDIR - - CALL ENABLE_CTRL - - WRITE (6,'('' No messages found with given search string.'')') - - RETURN - END - - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')') - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END diff --git a/decus/vax89a2/bulletin/bulletin3.for b/decus/vax89a2/bulletin/bulletin3.for deleted file mode 100644 index ce9a49d..0000000 --- a/decus/vax89a2/bulletin/bulletin3.for +++ /dev/null @@ -1,1588 +0,0 @@ -C -C BULLETIN3.FOR, Version 6/1/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*11 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF (SYSTEM.LE.3.OR.(OLD_SHUTDOWN.EQ.0! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - EXTIME(3:4) = EXTIME(4:5) - READ (EXTIME(1:4),'(I4)') NODE_NUMBER_MSG - EXTIME(9:10) = EXTIME(10:11) - READ (EXTIME(7:10),'(I4)') NODE_AREA_MSG - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - END IF - ELSE - DIFF = 1 - END IF - IF (DIFF.EQ.1) NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF (SYSTEM.LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 EXPDAT - CHARACTER*23 TODAY - - DIMENSION EXTIME(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF ((DEFAULT_EXPIRE.GT.F_EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3)) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:),TODAY(13:)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0.AND. - & IER.EQ.SS$_NORMAL) THEN - CALL DISABLE_PRIVS - IF (OUT.EQ.INFILE) THEN - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT))) - ELSE - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - END IF - CALL ENABLE_PRIVS - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0.OR. - & IER.NE.SS$_NORMAL) THEN - CALL EDT$EDIT(INFILE,OUT) - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN - CONTEXT = 0 - IER = LIB$FIND_FILE(INFILE,MAIL_EDIT,CONTEXT) - IF (.NOT.IER) THEN - CALL TPU$EDIT(' ',OUT) - ELSE - CALL TPU$EDIT(INFILE,OUT) - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - ! TPU does CLI$ stuff which wipes our parsed command line - END IF - - RETURN - END - - - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($JPIDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXIT - END IF - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1 - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP') - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0)) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM','NL:' - & ,,,,'BULLCP',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*1 DUMMY - - IER = SYS_TRNLNM('BULL_BULLCP',DUMMY) - IF (IER) BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - CHARACTER*23 OLD_TIME,NEW_TIME - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - DO WHILE (1) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - CALL SYS$SETAST(%VAL(1)) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Do empty block - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Cleanup deleted users from - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! data files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - - OLD_TIME = NEW_TIME - CALL WAIT('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL REGISTER_BULLCP - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER NODENAME*8 - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - END IF - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE WAIT(PARAM) -C -C SUBROUTINE WAIT -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(6:7) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(2)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(9:10) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - - SUBROUTINE DELETE_EXPIRED - -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER UPTIME_DATE*11,UPTIME_TIME*11 - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD.EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=3,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (3,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - IF (INDEX(INTO,FOLDER_BBOARD(:FLEN)).EQ.0.AND. - & INTO.NE.FOLDER_BBOARD.AND.INDEX(INTO,'@').EQ.0) THEN - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOLDER1_BBOARD = FOLDER_BBOARD - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - FOLDER_Q2_SAVE = FOLDER_Q2 - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - FLEN = TRIM(FOLDER1_BBOARD) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD.NE.'NONE') THEN - IF (INTO.EQ.FOLDER1_BBOARD) THEN - FOUND = .TRUE. - ELSE - FIND_TO = INDEX(INTO,FOLDER1_BBOARD(:FLEN)) - IF (FIND_TO.GT.0) THEN - END_TO = FLEN+FIND_TO - IF (TRIM(INTO).LT.END_TO.OR. - & INTO(END_TO:END_TO).LT.'A'.OR. - & INTO(END_TO:END_TO).GT.'Z') THEN - IF (FIND_TO.EQ.1) THEN - FOUND = .TRUE. - ELSE IF (INTO(FIND_TO-1:FIND_TO-1).LT.'A'.OR. - & INTO(FIND_TO-1:FIND_TO-1).GT.'Z') THEN - FOUND = .TRUE. - END IF - END IF - END IF - END IF - END IF - END DO - IF (FOUND) THEN - FOLDER_COM = FOLDER1_COM - FOLDER_Q_SAVE = FOLDER_Q2_SAVE - END IF - END IF - - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=3,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=3) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - WRITE (6,1030) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*37,FILENAME*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - OFFSET = 36 - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='VMSMAIL', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - OFFSET = 34 - END IF - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::') THEN - ! If normal BBOARD or /VMSMAIL - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - CALL LIB$MOVC3(2,%REF(INPUT(OFFSET:)),COUNT) - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END diff --git a/decus/vax89a2/bulletin/bulletin4.for b/decus/vax89a2/bulletin/bulletin4.for deleted file mode 100644 index 01679e4..0000000 --- a/decus/vax89a2/bulletin/bulletin4.for +++ /dev/null @@ -1,1676 +0,0 @@ -C -C BULLETIN4.FOR, Version 6/1/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist -C if it creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - READ (4,IOSTAT=IER) USER_ENTRY ! Skip header - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':') THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IER = 0 - END IF - END IF - END DO - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_SYSUAF ! All done... - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - DATA POINT/0/ - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = 0 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - IBLOCK = SBLOCK ! Initialize pointers. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,ILEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C ILEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns ILEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(LINE_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? - IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - ILEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - ILEN = -1 ! ILEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - ILEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - BUFFER = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) ! Output line. - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(ILEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - ILEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - ILEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (ILEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = ILEN - (BRECLEN-POINT) ! Store leftover length - ILEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (ILEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(ILEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - ILEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - ILEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - IF (BTEST(FOLDER_FLAG,1)) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -900 CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - CALL WRITEDIR(0,IER) - -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limit - POINTER = 0 ! during input. - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10)) - & .OR.INCHAR(I:I).GT.'~') INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privileged - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'( - & '' ERROR: No privs for SYSTEM, NOTIFY, BRIEF or READNEW.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - LENDES = 0 - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_OWNER = FOLDER1_OWNER - END IF - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_OWNER = FOLDER1_OWNER - - IF (CLI$PRESENT('SYSTEM')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - diff --git a/decus/vax89a2/bulletin/bulletin5.for b/decus/vax89a2/bulletin/bulletin5.for deleted file mode 100644 index c0e7b92..0000000 --- a/decus/vax89a2/bulletin/bulletin5.for +++ /dev/null @@ -1,1596 +0,0 @@ -C -C BULLETIN5.FOR, Version 5/16/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_NEGATED - - IF (.NOT.SETPRV_PRIV().AND.INCMD(:3).EQ.'SET') THEN - WRITE (6,'( - & '' ERROR: No privs to change all defaults.'')') - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - - FLAG = 0 - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',TEMP_USER) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',TEMP_USER) - END IF - READ (TEMP_USER(:1),'(I1)',IOSTAT=IER) FLAG - - IF (NOTIFY.EQ.1.AND.BTEST(FLAG,1).AND. - & CLI$PRESENT('CLUSTER').EQ.%LOC(CLI$_NEGATED)) THEN - CALL OPEN_BULLNOTIFY - READ (10,KEY='*',IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=10) - FLAG = -1 - END IF - - IF (BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - IF (FLAG.EQ.-1) WRITE (10,IOSTAT=IER) TEMP_USER - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - IF (FLAG.EQ.-1) THEN - CALL CLOSE_BULLNOTIFY - ELSE IF (NOTIFY.EQ.1.AND.BTEST(FLAG,1).AND. - & CLI$PRESENT('CLUSTER').NE.%LOC(CLI$_NEGATED)) THEN - WRITE (6,'('' NOTE: In a cluster, /ALL or /DEFAULT '', - & ''causes all users to be notified.'')') - WRITE (6,'('' They will not be able to disable this.'', - & '' See HELP SET NOTIFY for more info.'')') - CALL OPEN_BULLNOTIFY - CALL CLOSE_BULLNOTIFY_DELETE - CALL OPEN_BULLNOTIFY - WRITE (10) '* ' - CALL CLOSE_BULLNOTIFY - ELSE IF (NOTIFY.EQ.0.AND.BTEST(FLAG,1)) THEN - CALL OPEN_BULLNOTIFY - READ (10,IOSTAT=IER) TEMP_USER - IF ((IER.EQ.0.AND.TEMP_USER.EQ.'*').OR. - & (BRIEF.NE.-1.AND.READNEW.NE.-1)) THEN - CALL CLOSE_BULLNOTIFY_DELETE - ELSE - CALL CLOSE_BULLNOTIFY - END IF - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL OPEN_BULLNOTIFY - CALL CLOSE_BULLNOTIFY_DELETE - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - FOLDER_SET = .FALSE. - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - EXTERNAL CLI$_ABSENT - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1) - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - - REMOTE_TEST = 0 - - IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP - END IF - - CALL CLOSE_BULLFOLDER - - IF (IER.EQ.0.AND.FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to connect to folder.'')') - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Copy remote folder protection - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - ELSE - LOCAL_FOLDER1_FLAG = IBCLR(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - END IF - REMOTE_SET = .TRUE. - END IF - - IF (IER.EQ.0) THEN ! Folder found - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::' - & .AND..NOT.SETPRV_PRIV()) THEN - ! Is folder protected and not remote? - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND. - & IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (FOLDER1_BBOARD(:2).NE.'::') THEN - IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - END IF - - IF (IER) THEN - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0) THEN - IF (TEST_BULLCP()) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (FOLDER_NUMBER.GE.0.AND.CLI$PRESENT('MARKED')) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - IF (INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only marked messages'', - & '' will be shown.'')') - ELSE - WRITE(6,'('' ERROR: No marked messages found.'')') - END IF - END IF - ELSE - READ_TAG = .FALSE. - END IF - END IF - - IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - RETURN - - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*25 FOLDER_SAVE - - DIMENSION DUMMY(2) - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - END IF - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.LOGIN_SWITCH) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - END IF - IER = 0 - END IF - - RETURN - END - - - - - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & FOLDER1 = FOLDER - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Folder is a private folder.'')') - ELSE - WRITE (6,'('' Folder is not a private folder.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is BRIEF.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is SHOWNEW.'')') - ELSE - WRITE (6,'('' Default is NOREADNEW.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY.'')') - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - CHARACTER*17 DATETIME - - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE specified - ELSE - NLINE = 1 - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDER = 0 - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - - IF (.NOT.PAGING) THEN - DISPLAY = (NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2 - ELSE - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2,PAGE_LENGTH-4) - ! If more entries than page size, truncate output - END IF - - DO I=FOLDER_COUNT,FOLDER_COUNT+(DISPLAY-2)/NLINE-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counter - END DO - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*1 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ELSE - ID = INPUT - INPUT = ' ' - END IF - ILEN = TRIM(ID) - IF (ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - CALL OPEN_BULLFOLDER ! Open folder file - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - ENTRY WRITE_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE - - REWRITE (7) FOLDER_COM - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP - - REWRITE (7) FOLDER1_COM - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END DO - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - SET_FLAG(1) = SET_FLAG_DEF(1) - SET_FLAG(2) = SET_FLAG_DEF(2) - BRIEF_FLAG(1) = BRIEF_FLAG_DEF(1) - BRIEF_FLAG(2) = BRIEF_FLAG_DEF(2) - NOTIFY_FLAG(1) = NOTIFY_FLAG_DEF(1) - NOTIFY_FLAG(2) = NOTIFY_FLAG_DEF(2) - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END diff --git a/decus/vax89a2/bulletin/bulletin6.for b/decus/vax89a2/bulletin/bulletin6.for deleted file mode 100644 index 99bc71f..0000000 --- a/decus/vax89a2/bulletin/bulletin6.for +++ /dev/null @@ -1,1502 +0,0 @@ -C -C BULLETIN6.FOR, Version 5/1/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - DATA LUN /0/ - - ENTRY CLOSE_BULLNOTIFY - LUN = LUN + 1 ! Unit = 10 - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - DATA LUN /0/ - - ENTRY CLOSE_BULLNOTIFY_DELETE - LUN = LUN + 8 ! Unit = 10 - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - DATA LUN /0/ - - LUN = UNIT - 10 ! 10 gets added to LUN - - ENTRY OPEN_BULLNOTIFY - LUN = LUN + 1 ! Unit = 10 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.10) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=10,STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=3, - & ORGANIZATION='INDEXED',KEY=(1:12:CHARACTER), - & FORM='UNFORMATTED', - & FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.NOTIFY') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','notify'/ - INTEGER NAME(10) - DATA NAME/1,2,0,3,0,0,4,0,5,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - CHARACTER*25 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNOTIFY_SHARED - LUN = LUN + 1 ! Unit = 10 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_POINT - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - - IF (IER.EQ.0) THEN - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.FOLDER_RECORD/4) THEN - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(ASK_SIZE) - NTRIES = 0 - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.10) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=10,STATUS='OLD',IOSTAT=IER, - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=3, - & ORGANIZATION='INDEXED',KEY=(1:12:CHARACTER), - & FORM='UNFORMATTED', - & FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.NOTIFY') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - CALL OPEN_FILE(LUN) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE_SHARE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*115 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(1:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(1:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(78:81) = BUFFER(85:) - BULLDIR_ENTRY(90:97) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(ASK_SIZE) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - CHARACTER*80 NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - - EODIR = MAX(INDEX(BULLFOLDER_FILE,':'),INDEX(BULLFOLDER_FILE,']')) - SUFFIX = INDEX(BULLFOLDER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLFOLDER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLFOLDER_FILE,NEW_FILE) - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=9,FILE=BULLFOLDER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.173/4) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - IF (IER.EQ.0) THEN - WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM - CALL CLOSE_BULLDIR - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=9,STATUS='SAVE') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*3 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - DIR_NUM = 0 - END IF - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,0 - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_HEADER_FROMBIN - RETURN - END IF - END IF - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' ') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I3)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (MSG_NUM.NE.ICOUNT) IER = 36 - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) BULLDIR_ENTRY - END IF - END DO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - DIR_NUM = -1 - END IF - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - END IF - END IF - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - UNLOCK 2 - - RETURN - - END - - - - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If not 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) BULLDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - IER = 0 - DIR_NUM = -1 - END IF - UNLOCK 2 - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - IER = MSG_NUM - CALL CONVERT_ENTRY_FROMBIN - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME - NEWEST_EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME - NEWEST_TIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME - SHUTDOWN_TIME = DATETIME(13:) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME - EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME - TIME = DATETIME(13:) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - INCLUDE 'BULLDIR.INC' - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - ELSE - IF (CONV) CALL CONVERT_ENTRY_TOBIN - MSG_NUM = BULLETIN_NUM - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - - RETURN - END - - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*) - CHARACTER NOT_ID*3 - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - DO WHILE - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0) - START_ID = START_ID - 1 - END DO - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = RECL/8 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - diff --git a/decus/vax89a2/bulletin/bulletin7.for b/decus/vax89a2/bulletin/bulletin7.for deleted file mode 100644 index 26b81bd..0000000 --- a/decus/vax89a2/bulletin/bulletin7.for +++ /dev/null @@ -1,1750 +0,0 @@ -C -C BULLETIN7.FOR, Version 4/16/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - INCLUDE '($SSDEF)' - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - CHARACTER OUTPUT*160,TERMINAL*7,FLAGS*1 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (FOLDER_NUMBER.GT.0) THEN ! Folder private? - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER(1:TRIM(FOLDER)) - & //'. From: '//FROM(1:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - FLAG = 0 - BFLAG = 0 - - IF (IER) THEN - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) THEN ! Node part of cluster? - CALL OPEN_BULLNOTIFY_SHARED ! Yes, get notify list. - DO WHILE (REC_LOCK(IER1)) ! Any entries? - READ (10,IOSTAT=IER1) TEMP_USER - END DO - IF (IER1.NE.0) THEN ! No entries. - CALL READ_USER_FILE(IER) ! Create entries from - DO WHILE (IER.EQ.0) ! user file. - IF (TEMP_USER(:1).NE.':'.AND.TEMP_USER(:1).NE.'*' - & .AND.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (10) TEMP_USER - END IF - CALL READ_USER_FILE(IER) - END DO - DO WHILE (REC_LOCK(IER1)) ! Reset to first entry. - READ (10,KEYGT=' ',IOSTAT=IER1) - & TEMP_USER - END DO - END IF - - BFLAG = BRK$M_CLUSTER ! Broadcast to all nodes - - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER_NUMBER).AND. ! If /ALL then - & TEMP_USER.EQ.'*'.AND.IER1.EQ.0) THEN ! notify all. - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & ,%VAL(BRK$C_ALLUSERS),,,%VAL(BFLAG),,,,) - IER1 = 1 ! Don't have to loop through notify list - END IF - END IF - END IF - - DO WHILE ((BFLAG.EQ.0.AND.GETUSERS(TEMP_USER,TERMINAL)).OR. - & (BFLAG.NE.0.AND.IER1.EQ.0)) - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - IF (BFLAG.EQ.0) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TERMINAL(:TRIM(TERMINAL)),%VAL(BRK$C_DEVICE) - & ,,,%VAL(BFLAG),,,,) - ELSE - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TEMP_USER(:TRIM(TEMP_USER)),%VAL(BRK$C_USERNAME) - & ,,,%VAL(BFLAG),,,,) - END IF - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USER//USER_ENTRY(13:) - END IF - ELSE IF (IER.NE.0.AND.BFLAG.NE.0) THEN - DELETE (UNIT=10) - END IF - IF (BFLAG.NE.0) THEN - DO WHILE (REC_LOCK(IER1)) - READ (10,IOSTAT=IER1) TEMP_USER - END DO - END IF - END DO - IF (BFLAG.NE.0) CALL CLOSE_BULLNOTIFY - END IF - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(1:11) - NEWEST_TIME = TODAY_TIME(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00.00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*3600 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*11 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - - IF (FLAG.EQ.4) THEN ! If notify, see if cluster - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',TEMP_USER) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',TEMP_USER) - END IF - READ (TEMP_USER(:1),'(I1)',IOSTAT=IER) BFLAG - IF (BTEST(BFLAG,1).AND.IER.EQ.0) THEN - CALL OPEN_BULLNOTIFY_SHARED - DO WHILE (REC_LOCK(IER)) - READ (10,IOSTAT=IER) TEMP_USER - END DO - IF (TEMP_USER.NE.'*') THEN - IF (CMD) THEN - WRITE (10,IOSTAT=IER) USERNAME - ELSE - DO WHILE (REC_LOCK(IER)) - READ (10,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (UNIT=10) - END IF - END IF - CALL CLOSE_BULLNOTIFY - END IF - END IF - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -C -C SUBROUTINE CONFIRM_PRIV -C -C FUNCTION: Confirms that given username has SETPRV. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C ALLOW - Returns 1 if account has SETPRV. -C returns 0 if account has no SETPRV. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INCLUDE '($PRVDEF)' - - INCLUDE '($UAIDEF)' - - INTEGER DEF_PRIV(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_DEF_PRIV,%LOC(DEF_PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - ALLOW = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(DEF_PRIV(1),PRV$V_SETPRV).OR. ! SETPRV or CMRKNL - & BTEST(DEF_PRIV(1),PRV$V_CMKRNL)) THEN ! privileges? - ALLOW = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM) OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:TRIM(INPUT)),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM) OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - CALL UPDATE_USERINFO - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FILENAME*132,BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - OPEN (UNIT=11, - 1 FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED') - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - NBLOCK = NBLOCK + LENGTH - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*11 DATE_SAVE,EXDATE_SAVE - CHARACTER*11 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - WRITE (6,'('' For the selected folder '',A)') FOLDER(1:TRIM(FOLDER)) - - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - END IF - - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND. - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (.NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER USERNAME*(*),TERMINAL*(*) - - DATA WILDCARD /-1/ - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) WILDCARD = -1 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ - DATA USERINFO_READ /.FALSE./ - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_BULLUSER - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - - CALL CLOSE_BULLINF - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - COMMON /USERINFO/ USERINFO_READ - - INCLUDE 'BULLUSER.INC' - - IF (.NOT.USERINFO_READ) RETURN - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - IF (TRIM(TIME).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - DIMENSION LOGIN_BTIM_SAVE(2) - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ ! Update login time - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2).AND.IER.EQ.0) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE - END IF - IF (IER.NE.0) THEN - CALL CHANGE_FLAG_NOCMD(0,2) - CALL CHANGE_FLAG_NOCMD(0,3) - CALL CHANGE_FLAG_NOCMD(0,4) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = 0 - CALL MODIFY_SYSTEM_LIST(0) - END IF - ELSE IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - IF (TEST2(NEW_MSG,0)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - NEW_MESS = .FALSE. - DO FOLDER_NUMBER = 1,FOLDER_MAX-1 - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(1:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - IF (NEW_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new GENERAL messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (FOLDER_NUMBER.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE IF (FOLDER_NUMBER.EQ.0.OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = -1 - FOLDER1 = 'GENERAL' - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to GENERAL folder.'')') - - RETURN - END diff --git a/decus/vax89a2/bulletin/bulletin8.for b/decus/vax89a2/bulletin/bulletin8.for deleted file mode 100644 index 4720507..0000000 --- a/decus/vax89a2/bulletin/bulletin8.for +++ /dev/null @@ -1,1460 +0,0 @@ -C -C BULLETIN8.FOR, Version 12/15/88 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - CHARACTER NAMEDESC*9 /'BULLETIN1'/ - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*9 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN),IO$_READVBLK,MBX_IOSB, - & MBX_AST,,MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*6,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL CONNECT(NODENAME,USERNAME,FROMNAME) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(200),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - CHARACTER*128 INPUT - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - - IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL EXECUTE_COMMAND(UNIT_INDEX) - - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - - RETURN - END - - - - - - SUBROUTINE CONNECT(NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/ - - CHARACTER*(*) USERNAME,FROMNAME - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IF (REJECT.NE.IO_REJECT) THEN - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL ENABLE_CTRL_EXIT,SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2) - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*53 - CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - BULLCP_PRIV(1) = PROCPRIV(1) - BULLCP_PRIV(2) = PROCPRIV(2) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDER_NAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - NODENAME = NODE_SAVE(UNIT_INDEX) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15) THEN ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USERNAME,PRIV_SAVE(1,UNIT_INDEX)) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - PRIV_SAVE(1,UNIT_INDEX) = PROCPRIV(1) - PRIV_SAVE(2,UNIT_INDEX) = PROCPRIV(2) - END IF - END IF - END IF - - IF (CMD_TYPE.EQ.1) THEN ! Select folder - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:5))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:9))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - END IF - BUFFER = BUFFER(:16)//FOLDER_COM - CALL WRITE_CHAN(16+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - FOLDER_NAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP)) - CALL LIB$MOVC3(11,%REF(BUFFER(58:58)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(69:69)),%REF(EXTIME)) - CALL LIB$MOVC3(4,%REF(BUFFER(80:80)),SYSTEM) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (SYSTEM.NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF (SYSTEM.NE.0.AND..NOT.SETPRV_PRIV()) THEN ! Priv test - IF (FOLDER_OWNER.NE.USERNAME) THEN - SYSTEM = 0 - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(84:84)),BROAD) - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(88:88)),BELL) - CALL LIB$MOVC3(4,%REF(BUFFER(92:92)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(97:97)),CLUSTER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND.(TEMP_USER(2:).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(1)) - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - IER = SYS$CANTIM(%VAL(1),) - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:9)),%REF(MSG_KEY(1:1))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),EBULL) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP_TEMP)) - CALL LIB$MOVC3(4,%REF(BUFFER(58:58)),ICOUNT) - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(53,%REF(BUFFER(62:62)),%REF(DESCRIP)) - CALL LIB$MOVC3(4,%REF(BUFFER(115:115)),%REF(MSGTYPE)) - CALL LIB$MOVC3(11,%REF(BUFFER(119:119)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(130:130)),%REF(EXTIME)) - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE) - DESCRIP_TEMP = BUFFER(9:61) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(11,%REF(BUFFER(62:62)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(73:73)),%REF(EXTIME)) - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:5)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:13)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:1))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:13)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:17)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:21)),FOLDER_NUMBER) - FOLDER = BUFFER(25:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - END IF - -1000 PROCPRIV(1) = BULLCP_PRIV(1) - PROCPRIV(2) = BULLCP_PRIV(2) - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.GE.0) RETURN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) THEN - PROCPRIV(1) = NEEDPRIV(1) - PROCPRIV(2) = NEEDPRIV(2) - END IF - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END diff --git a/decus/vax89a2/bulletin/bulletin9.for b/decus/vax89a2/bulletin/bulletin9.for deleted file mode 100644 index a57ed02..0000000 --- a/decus/vax89a2/bulletin/bulletin9.for +++ /dev/null @@ -1,1763 +0,0 @@ -C -C BULLETIN9.FOR, Version 6/1/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - NLEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addedd - END IF - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:NLEN)//'""::' - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Is semicolon present? - IF (NLEN.GT.SEMI+1) THEN ! Yes, is username after node? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - NLEN = SEMI - 1 ! Remove semicolon - ELSE ! No username after nodename - TEMP_USER = DEFAULT_USER ! Set username to default - NLEN = SEMI - 1 ! Remove semicolon - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolon present - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username was - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:NLEN) - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '// - & PASSWORD(1:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FLAGNAME - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=13,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(13,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=13) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (13,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(13,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=13,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=13) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=13) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - INCLUDE '($HLPDEF)' - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$PRINT:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - ELSE - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8) - END IF - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,DISPLAY_ID,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA DISPLAY_ID/0/,KEYBOARD_ID/0/ - - IER = SMG$CREATE_PASTEBOARD(PASTEBOARD_ID) ! Initialize terminal - IF (DISPLAY_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_DISPLAY(PAGE_LENGTH, - & PAGE_WIDTH,DISPLAY_ID) - END IF - IER = SMG$PASTE_VIRTUAL_DISPLAY(DISPLAY_ID,PASTEBOARD_ID,1,1) - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (1) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LBR$CLOSE(LINDEX) ! then close library, - CALL SMG$UNPASTE_VIRTUAL_DISPLAY(DISPLAY_ID,PASTEBOARD_ID) - ! remove virtual display - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,DISPLAY_ID,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = SMG$ERASE_DISPLAY(DISPLAY_ID) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = SMG$ERASE_DISPLAY(DISPLAY_ID) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - CHARACTER VERSION*10,DATE*23 - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - END - - - - - - - SUBROUTINE TAG(ADD_OR_DEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - IER1 = 0 - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT).AND.IER1.EQ.0) ! Get the specified messages - - DECODE(LEN_P,'(I)',BULL_PARAMETER) MESSAGE_NUMBER - - CALL READDIR(MESSAGE_NUMBER,IER) ! Get info for bulletin - - IF (IER.NE.MESSAGE_NUMBER+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER1) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Message '',I, - & '' was not marked.'')') MESSAGE_NUMBER - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found.') - - END - - - - SUBROUTINE ADD_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 TAG_KEY - - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY) - - IF (IER.EQ.FOR$IOS_INCKEYCHG) THEN - WRITE (6,'('' Message was already marked.'')') - ELSE IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to add mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE DEL_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 TAG_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - END DO - IF (IER.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to delete mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER) RETURN - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE='BULL_MARK:'// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (IER.EQ.0) BULL_TAG = .TRUE. - - RETURN - END - - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 BULL_MARK - - IER = SYS_TRNLNM('BULL_MARK',BULL_MARK) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: BULL_MARK must be defined.'', - & '' See HELP MARK.'')') - RETURN - ELSE - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1.OR.BULL_MARK.NE.BULL_PARAMETER) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = 0 - END IF - OPEN (UNIT=13,FILE='BULL_MARK:'// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - BULL_TAG = .TRUE. - IER = 1 - END IF - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - GO TO 10 - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - HEADER = .FALSE. - -10 DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - & INPUT_KEY - END DO - - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (FOLDER1_NUMBER.NE.FOLDER_NUMBER.OR.IER.NE.0) THEN - IER = 1 - UNLOCK 13 - RETURN - ELSE - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL OPEN_BULLDIR - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - RETURN - ELSE - DELETE (UNIT=13) - IER = 1 - END IF - END IF - - END DO - - END - - - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. Added per request of a faculty member for his private -C board. Changes to BULLETIN.FOR should be fairly obvious. -C -C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2) -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - DATA FOLDER_Q1/0/ - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - WRITE (6,1000) - WRITE (6,1020) - DO J = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - WRITE (6,1030) FOLDER1(:15),F1_NBULL, - & FOLDER1_DESCRIP(:MIN(TRIM(FOLDER1_DESCRIP),59)) - END DO - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - READ_TAG = .FALSE. - IF (CLI$PRESENT('MARKED')) READ_TAG = .TRUE. - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - IF (DIR_COUNT.EQ.0) THEN - F1_NBULL = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1020 FORMAT (' Name Count Description'/) -1030 FORMAT (1X,A15,I5,1X,A) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') - - END - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - DIMENSION NOLOGIN_BTIM(2) - - CHARACTER*17 DATETIME - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV_PRIV().AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to user command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - CALL OPEN_BULLUSER_SHARED - - IF (.NOT.ALL) THEN - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - ELSE - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - RETURN - ELSE - IER = 1 - END IF - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - - LEN_FROM = TRIM(IN_FROM) - IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - ELSE - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - END IF - - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - - CALL STRIP_HEADER(INPUT,0,IER1) - - RETURN - END - - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /STRIP_HEADER/ STRIP - DATA STRIP/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - CHARACTER*(*) BUFFER - - LEN_BUFFER = TRIM(BUFFER) - - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF (.NOT.STRIP) THEN - CALL STORE_BULL(1,' ',NBLOCK) ! just store one space - ELSE - STRIP = .FALSE. - END IF - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (STRIP) THEN - CALL STRIP_HEADER(BUFFER,LEN_BUFFER,IER) - IF (IER) THEN - RETURN - ELSE - STRIP = .FALSE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - TEXT = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /STRIP_HEADER/ STRIP - - COMMON /TEXT_PRESENT/ TEXT - - STRIP = .TRUE. ! Reset strip flag - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - RETURN - END IF - - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - EXTIME = '00:00:00.00' - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - RETURN - END - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(LINE_LENGTH) INFROM - - INFROM = IFROM - - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - IF (INDEX(INFROM,'<').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<'):) ! personal-name - END IF - - IF (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name) - & INDEX(INFROM,'@').GT.INDEX(INFROM,'(')) THEN - INFROM = INFROM(INDEX(INFROM,'(')+1:) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'"')) - I = I + 1 - END DO - INFROM = INFROM(I:) - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.12.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'"') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,I-1 - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) BUFFER - - INCLUDE 'BULLFOLDER.INC' - - IF (.NOT.BTEST(FOLDER_FLAG,4).OR.TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - RETURN - END IF - - IF (BLEN.EQ.0) CONT_LINE = .FALSE. - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header line - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - - RETURN - END diff --git a/decus/vax89a2/bulletin/bullfiles.inc b/decus/vax89a2/bulletin/bullfiles.inc deleted file mode 100644 index 5a169eb..0000000 --- a/decus/vax89a2/bulletin/bullfiles.inc +++ /dev/null @@ -1,28 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF IT -C IS NOT, THEN THEY SHOULD ALSO BE CHANGED. -C - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ diff --git a/decus/vax89a2/bulletin/bullfolder.inc b/decus/vax89a2/bulletin/bullfolder.inc deleted file mode 100644 index d5e4900..0000000 --- a/decus/vax89a2/bulletin/bullfolder.inc +++ /dev/null @@ -1,46 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,FILLER, - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) diff --git a/decus/vax89a2/bulletin/bullmain.cld b/decus/vax89a2/bulletin/bullmain.cld deleted file mode 100644 index a10267f..0000000 --- a/decus/vax89a2/bulletin/bullmain.cld +++ /dev/null @@ -1,25 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER,DEFAULT="7") diff --git a/decus/vax89a2/bulletin/bullstart.com b/decus/vax89a2/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vax89a2/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vax89a2/bulletin/bulluser.inc b/decus/vax89a2/bulletin/bulluser.inc deleted file mode 100644 index b0cbcf8..0000000 --- a/decus/vax89a2/bulletin/bulluser.inc +++ /dev/null @@ -1,42 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vax89a2/bulletin/create.com b/decus/vax89a2/bulletin/create.com deleted file mode 100644 index 683b792..0000000 --- a/decus/vax89a2/bulletin/create.com +++ /dev/null @@ -1,19 +0,0 @@ -$ FORTRAN/Extend/Nocheck/Nodebug BULLETIN -$ FORTRAN/Extend/Nocheck/Nodebug BULLETIN0 -$ FORTRAN/Extend/Nocheck/Nodebug BULLETIN1 -$ FORTRAN/Extend/Nocheck/Nodebug BULLETIN2 -$ FORTRAN/Extend/Nocheck/Nodebug BULLETIN3 -$ FORTRAN/Extend/Nocheck/Nodebug BULLETIN4 -$ FORTRAN/Extend/Nocheck/Nodebug BULLETIN5 -$ FORTRAN/Extend/Nocheck/Nodebug BULLETIN6 -$ FORTRAN/Extend/Nocheck/Nodebug BULLETIN7 -$ FORTRAN/Extend/Nocheck/Nodebug BULLETIN8 -$ FORTRAN/Extend/Nocheck/Nodebug BULLETIN9 -$ MACRO ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB; -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIB/CREATE BULL -$ LIB BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vax89a2/bulletin/createrest.com b/decus/vax89a2/bulletin/createrest.com deleted file mode 100644 index 81e77ac..0000000 --- a/decus/vax89a2/bulletin/createrest.com +++ /dev/null @@ -1,20 +0,0 @@ -$! Create rest of BULLETIN where you lack a FORTRAN compiler. -$! FORTRAN/Extend/Nocheck/Nodebug BULLETIN -$! FORTRAN/Extend/Nocheck/Nodebug BULLETIN0 -$! FORTRAN/Extend/Nocheck/Nodebug BULLETIN1 -$! FORTRAN/Extend/Nocheck/Nodebug BULLETIN2 -$! FORTRAN/Extend/Nocheck/Nodebug BULLETIN3 -$! FORTRAN/Extend/Nocheck/Nodebug BULLETIN4 -$! FORTRAN/Extend/Nocheck/Nodebug BULLETIN5 -$! FORTRAN/Extend/Nocheck/Nodebug BULLETIN6 -$! FORTRAN/Extend/Nocheck/Nodebug BULLETIN7 -$! FORTRAN/Extend/Nocheck/Nodebug BULLETIN8 -$! FORTRAN/Extend/Nocheck/Nodebug BULLETIN9 -$ MACRO ALLMACS -$! SET COMMAND/OBJ BULLCOM -$! SET COMMAND/OBJ BULLMAIN -$! IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB; -$! IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIB/CREATE BULL -$ LIB BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vax89a2/bulletin/dclremote.com b/decus/vax89a2/bulletin/dclremote.com deleted file mode 100644 index 7617272..0000000 --- a/decus/vax89a2/bulletin/dclremote.com +++ /dev/null @@ -1,32 +0,0 @@ -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET diff --git a/decus/vax89a2/bulletin/handout.txt b/decus/vax89a2/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vax89a2/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vax89a2/bulletin/install.com b/decus/vax89a2/bulletin/install.com deleted file mode 100644 index 8d2e831..0000000 --- a/decus/vax89a2/bulletin/install.com +++ /dev/null @@ -1,18 +0,0 @@ -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vax89a2/bulletin/install_remote.com b/decus/vax89a2/bulletin/install_remote.com deleted file mode 100644 index 034b820..0000000 --- a/decus/vax89a2/bulletin/install_remote.com +++ /dev/null @@ -1,130 +0,0 @@ -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL diff --git a/decus/vax89a2/bulletin/instruct.com b/decus/vax89a2/bulletin/instruct.com deleted file mode 100644 index 49627f6..0000000 --- a/decus/vax89a2/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vax89a2/bulletin/instruct.txt b/decus/vax89a2/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vax89a2/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vax89a2/bulletin/login.com b/decus/vax89a2/bulletin/login.com deleted file mode 100644 index edaadc3..0000000 --- a/decus/vax89a2/bulletin/login.com +++ /dev/null @@ -1,25 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! diff --git a/decus/vax89a2/bulletin/makefile b/decus/vax89a2/bulletin/makefile deleted file mode 100644 index 6541a4d..0000000 --- a/decus/vax89a2/bulletin/makefile +++ /dev/null @@ -1,74 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin9.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* - diff --git a/decus/vax89a2/bulletin/nonsystem.txt b/decus/vax89a2/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vax89a2/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vax89a2/bulletin/pmdf.com b/decus/vax89a2/bulletin/pmdf.com deleted file mode 100644 index cd0f687..0000000 --- a/decus/vax89a2/bulletin/pmdf.com +++ /dev/null @@ -1,648 +0,0 @@ -$set nover -$copy sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE '[-]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE '[-]APFILES.INC', - %INCLUDE '[-]MMFILES.INC', - %INCLUDE '[-]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* Winter 1988 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE '[-]UTILCONST.INC' - %INCLUDE '[-]OSCONST.INC' - %INCLUDE '[-]APCONST.INC' - %INCLUDE '[-]MMCONST.INC' - %INCLUDE '[-]HECONST.INC' - %INCLUDE '[-]LOGCONST.INC' - - TYPE - %INCLUDE '[-]UTILTYPE.INC' - %INCLUDE '[-]OSTYPE.INC' - %INCLUDE '[-]APTYPE.INC' - %INCLUDE '[-]MMTYPE.INC' - %INCLUDE '[-]HETYPE.INC' - %INCLUDE '[-]LOGTYPE.INC' - - VAR - %INCLUDE '[-]UTILVAR.INC' - %INCLUDE '[-]OSVAR.INC' - %INCLUDE '[-]APVAR.INC' - %INCLUDE '[-]QUVAR.INC' - %INCLUDE '[-]MMVAR.INC' - %INCLUDE '[-]HEVAR.INC' - %INCLUDE '[-]LOGVAR.INC' - - outbound : text; - - %INCLUDE '[-]UTILDEF.INC' - %INCLUDE '[-]OSDEF.INC' - %INCLUDE '[-]APDEF.INC' - %INCLUDE '[-]HEDEF.INC' - %INCLUDE '[-]LOGDEF.INC' - %INCLUDE '[-]MMDEF.INC' - %INCLUDE '[-]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - -(* pmdf_to_vms_backward is used to convert a PMDF From: address into something - that VMS MAIL will like. *) - -procedure pmdf_to_vms_backward (var addressee : vstring); - -var - buffer, dummy : vstring; i,stat : integer; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - -begin (* pmdf_to_vms_backward *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - copyvstring (buffer, addressee); - addressee.length := 0; - for i := 1 to protocol_name.length do catchar (addressee, protocol_name[i]); - catchar (addressee, '"'); - for i := 1 to buffer.length do begin - case buffer.body[i] of - '''' : begin - catchar (addressee, '\'); catchar (addressee, 's'); - end; - '"' : catchar (addressee, ''''); - '\' : begin - catchar (addressee, '\'); catchar (addressee, '\'); - end; - otherwise catchar (addressee, buffer.body[i]); - end; (* case *) - end; (* for *) - catchar (addressee, '"'); -end; (* pmdf_to_vms_backward *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR filename, fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - pmdf_to_vms_backward (fromaddr); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - substr (fromaddr.body, 1, fromaddr.length), - ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channelN -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel% -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channelN -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channelI -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line)a -$ if (chan .nes. channel_name) then -d -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then -s - goto list_loop -$ ! Found at least one to try.a -$ cnt = cnt + 1E -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT* -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ !C -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the maili -$ ! -$ run pmdf_root:[exe]master1 -$ exit_stat = $status* -$ !_ -$ ! Activate optional cleanup script to reset terminal/modem -$ !v -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TTe -$ deassign TTa -$ deassign PMDF_DEVICE -$ !s -$ ! If master does not exit normally, then try a different connection. -$ !e -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_datah -$ !a -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism.i -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ !d -$ regular_master:h -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TTe -$ !' -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]masterb -$ exit_stat = $status -$ !o -$ ! Activate optional cleanup script to reset terminal/modem; -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat'n -$ deallocate TT -$ deassign TT[ -$ deassign PMDF_DEVICE -$ !d -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30N -$ goto out1 -$ !T -$ ! Directory channel: -$ !r -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1p -$ !a -$ ! This is a DECnet channel; set up and use DN_MASTER -$ !O -$ DECnet_channel:l -$ ! -$ ! Define other logical names -$ !p -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1I -$ !S -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ !E -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1) -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ !a -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gatewaye -$ goto out1 -$ !a -$ ! This is a BULLETIN channel; use BULLETIN_MASTERr -$ ! -$ BULLETIN_channel: -$ !L -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTERt -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1l -$ !_ -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel:. -$ !u -$ run pmdf_root:[exe]ctcp_master -$ goto out1R -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTERq -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ !f -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ !o -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ !j -$ MTCP_channel: -$ !e -$ run pmdf_root:[exe]mtcp_master -$ goto out1o -$ !s -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ !A -$ ETCP_channel:f -$ !t -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ !f -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ !' -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1p -$ !l -$ CN_channel:e -$ !c -$ ! Define other logical names -$ !e -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277q -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_mastera -$ goto out1 -$ !g -$ KER_channel: -$ !n -$ ! kermit protocol is slave only. If we get here there has been a mistake.o -$ ! however we will just exit and no harm done. -$ goto out1" -$ !D -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ !o -$ PX25_channel:c -$ != -$ ! Define other logical names -$ !- -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ !c -$ run pmdf_root:[exe]PX25_master -$ goto out1n -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTERN -$ !a -$ UUCP_channel:a -$ !4 -$ ! Define other logical names -$ !t -$ uucp_to_host = channel_name - "uucp_"n -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmpc -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfilen -$ !. -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll". -$ uupoll 'uucp_to_host'_ -$ goto out1f -$ !t -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ !f -$ XSMTP_channel: -$ !m -$ run pmdf_root:[exe]xsmtp_mastera -$ goto out1e -$ !t -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ !a -$ DSMTP_channel: -$ !q -$ run pmdf_root:[exe]dsmtp_master -$ goto out1t -$ !c -$ ! Handle delivery on the local channel, MAIL_ channels, anda -$ ! the DECnet compatibility channel -$ !t -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel:g -$ open/read queue_file 'dirlst_file' -$ local_loop:q -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list)) -$ goto local_loopn -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1n -$ !t -$ ! This is a SMTP test channel, use TEST_SMTP_MASTERo -$ !i -$ TEST_channel:s -$ !e -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1l -$ ! -$ out1: -$ delete 'dirlst_file';* -$ !t -$ ! Common exit point - clean up things first -$ !f -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_datan -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT. -$ deassign TTt -$ deassign PMDF_DEVICE -$ restore: -$ !_ -$ ! Restore saved stufft -$ !a -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ !s -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel] -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87e -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988e -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminatel -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988l -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988_ -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DATe -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT tot -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters:a -$ !c -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed./ -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTERT -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod : -$copy sys$input PMDF.TXT -$deck -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETINa -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it asa -follows: m - - LINK BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB,] - -and put the .EXE in PMDF_ROOT:[EXE]. Put the new MASTER.COM in PMDF_ROOT:[EXE]._ - -You then need a channel definition like the following in your configurationa -file PMDF.CNF: - - bull_local single master logging - BULLETIN-DAEMONa - -And a rewrite rule of the form:n - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON_ - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletinT - tex-hax: tex-hax@bulletinb - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletinn - jnet-l: jnet-l@bulletinI - policy-l: policy-l@bulletinr - future-l: future-l@bulletin - mon-l: mon-l@bulletinT - ug-l: ug-l@bulletinM - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders. After -doing so, restart BULLCP using BULLETIN/START. -$eod n diff --git a/decus/vax89a2/bulletin/remote.com b/decus/vax89a2/bulletin/remote.com deleted file mode 100644 index d034167..0000000 --- a/decus/vax89a2/bulletin/remote.com +++ /dev/null @@ -1,48 +0,0 @@ -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP diff --git a/decus/vax89a2/bulletin/writemsg.txt b/decus/vax89a2/bulletin/writemsg.txt deleted file mode 100644 index 4ebbd76..0000000 --- a/decus/vax89a2/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vax90a/bulletin/aaa-readme.net-txt b/decus/vax90a/bulletin/aaa-readme.net-txt deleted file mode 100644 index 7e5295c..0000000 --- a/decus/vax90a/bulletin/aaa-readme.net-txt +++ /dev/null @@ -1,209 +0,0 @@ -You are about to receive version 1.81 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -NOTE: The following commands can be sent to BULLETIN@NERUS.PFC.MIT.EDU: - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -This version includes all necessary modifications to work under VMS -V5.0. However, it will still be necessary to reassemble the ALLMACS.MAR -source under V5 and relink. The V4 version will not be installable -under V5 due to a change in a shared library which BULLETIN uses. -However, relinking by itself will not be enough. You MUST also -reassemble ALLMACS.MAR. If you only relink, BULLETIN can cause your -system to crash (the BULLCP process will do this because it uses the -routines in ALLMACS.MAR). - -If you are running a version of BULLETIN older than 1.52, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. This -format change can take a significant amount of time if the folder is -large. If your site has large folders, it is suggested that the new -version be installed during off peak hours. NOTE: Problems can occur -if the old version of BULLETIN is run after the data files have been -modified. Such a situation is possible on a cluster where each node has -installed the executable separately. To help installation, a new -command procedure INSTALL_REMOTE.COM has been included. This can be -used to install BULLETIN on several nodes from a single node. Read the -comments in the file for information on how to use it. - -NOTE: The BULLCP process should be stopped using the BULLETIN/STOP -command before the new version of BULLETIN is installed. It can then be -restarted using the BULLETIN/STARTUP command. (The INSTALL_REMOTE.COM -command procedure does this automatically for remote nodes.) - -You will be receiving 17 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) ALLMACS.MAR - 13) BULLCOMS1.HLP - 14) BULLCOMS2.HLP - 15) BULLET1.COM - 16) BULLET2.COM - 17) PMDF.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. Otherwise, you can delete -it. Read AAAREADME.TXT for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. A command procedure is included at the -end of this message which can be run which uses EDT to do this for you. - - MRL@NERUS.PFC.MIT.EDU ------------------------------------------------------------------------- -V1.81 - -Extensive modification to make BULLETIN/LOGIN run faster. - -V1.80 - -Modify folder compression algorithm to avoid attempting compression if -not enough disk space to create temporary files, which must be the same -size as the original files. - -V1.79 - -RESPOND will not add RE: to the subject if the subject of the message -being responded to already starts with RE: - -A bug was present in the PMDF software which could cause the message's -owner's name to be incorrectly stored. This would happpen if in the -header, a continuation line was present after the From: line. (I.e. If -one of the header lines was too long to fit on one line, and continued -to the next, that continuation was thought to be part of the From: -line.) - -V1.78 - -DIR/FOLDER would not show remote folders for a non-privileged user. - -If STRIP was enabled for a folder, if the subject line contained a tab, -it would not be converted to spaces but would remain a tab, thus causing -faulty output on a DIRECTORY command. Also, if the first line of the -message started with a word followed by a colon, i.e. SIRS:, that line -would be incorrectly flagged as part of the header and be deleted. - -/EXTRACT would not work if /EDIT was not explicitly specified when -adding a message, even if /EDIT was present on the BULLETIN command -line. - -V1.77 - -/EXTRACT is now a synonym of /TEXT where /TEXT is used (to be consistent -with MAIL). - -Fixed bug which causes a message added to a remote folder with -/BROADCAST to have an extra FROM: line added to the top of the message -when it is broadcasted. - -V1.76 - -Fixed problem which caused BULLETIN to hang when attempting to send -several notifications to a disconnected decserver port. This seems to -occur only in a cluster environment, but might be possible in a stand -alone system. The problem is that the system runs out of buffer space -for the broadcasts and thus BULLCP goes into a wait for resource mode. -This prevents anyone from using BULLETIN since BULLCP has the data files -opened without sharing. The solution was to simply disable resource -wait mode. - -V1.75 - -A bug in the data file cleanup algorithm was fixed which destroys the -acls on the folder files, therefore wiping out private and semiprivate -designations. This was introduced several versions back in order to fix -a problem with a user whose BULL_DIR directory had SET -DIRECTORY/VERSION=1 was set, as the previous algorithm created temporary -files with the same name as the old data files. The temporary files are -now creating with a different name, which was not causing the acls to be -propagated. A subroutine has been added to copy the acls. - -V1.74 - -Added /ALL qualifier on BULLETIN command. This suppresses the automatic -setting of NOLOGIN for users which have DISMAIL set. It also removes the -NOLOGIN setting if any account already has it set. - -Fixed bug in BBOARD digest code. Crash would occur if the FROM line was -empty in the digested message. - -Modified BULLETIN_MASTER to send message to POSTMASTER in the event that -PMDF mail was sent to a non-existant folder. Previously, the mail would -simply disappear without any recording of the error. - -Fixed bug which caused entering command SHOW FOLDER/ALL to crash -BULLETIN. - -V1.73 - -Modified the affect of the SET STRIP command. It now strips all headers -which appear at the top of the message. Previously it stopped stripping -headers as soon as it encountered a blank line. - -Fixed the MAIL command. It was unable to accept a quote (") in the -username. It also was unable to send mail to more than one user (even -though it accepted a username list.) - -Fixed the conversion routines which upgraded file formats from older -bulletin versions (i.e. circa 1986). - -V1.72 - -Corrected the corrections I applied in V1.71. There were a few minor -bugs, one of which can cause BULLETIN_MASTER to crash. - -Fixed bug which prevented the POST and RESPOND commands from working if -the subject line contained a quotation mark ("). Fixed bug in POST -which caused message to be sent to owner of message if /EDIT/TEXT is -specified. - -Fixed bug in MOVE command which prevented messages from being deleted -from original folder if a range of messages is specified. - -V1.71 - -The PMDF interface was not placing the proper address into the owner -field of the message. The last forwarding address was being entered -rather than the address in the From: field of the message. This has -been fixed. Also, if a Reply-to: field exists, it will be used as the -owner rather than the From: address. Additionally modified code to -correctly store usernames in digested folders so that messages can be -RESPOND'ed to. Rebuild both BULLETIN and BULLETIN_MASTER sources, and -remember to relink and reinstall BULLETIN_MASTER.EXE in order for these -changes to be installed. - -V1.70 - -Added /REVERSE qualifier for SEARCH command. - -Added ability to specify a nodename when using the /SHUTDOWN option. -This is useful in a cluster environment. Normally, the message would be -deleted only after the node on which the message was added was rebooted. -Now, any node on the cluster can now be specified. diff --git a/decus/vax90a/bulletin/aaareadme.1st b/decus/vax90a/bulletin/aaareadme.1st deleted file mode 100644 index 48e46bd..0000000 --- a/decus/vax90a/bulletin/aaareadme.1st +++ /dev/null @@ -1,161 +0,0 @@ -Editors Note: All souce files were put in the ZOO archive BULLSRC.ZOO. -The objects are in the library BULL.OLB, use the command @BULLETIN.LNK to -rebuild BULLETIN for your system. - - -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utility PMDF. If you wish to -do so for another utility, read the text file WRITEMSG.TXT. I would be glad to -include any such programs with my distribution if you think such a program -would be of use to other users. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, you may have to modify the subroutine - which executes the RESPOND command. That command sends messages to either - the originator of the message or the mailing list associated with the - folder. These routines assume that one can simply use the VMS MAIL - utility to do so. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - - BULLETIN will work for both V4 & V5. However, you will have to reassemble - ALLMACS.MAR if you are upgrading from V5, i.e. - $ MAC ALLMACS - $ LIB BULL ALLMACS - $ DELETE ALLMACS.OBJ; - $ @BULLETIN.LNK - $ COPY BULLETIN.EXE BULL_DIR: - $ RUN SYS$SYSTEM:INSTALL - BULL_DIR:BULLETIN/REPLACE - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require different - linked executables.) - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. diff --git a/decus/vax90a/bulletin/aaareadme.txt b/decus/vax90a/bulletin/aaareadme.txt deleted file mode 100644 index daaef04..0000000 --- a/decus/vax90a/bulletin/aaareadme.txt +++ /dev/null @@ -1,56 +0,0 @@ - BULLETIN -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. diff --git a/decus/vax90a/bulletin/allmacs.mar b/decus/vax90a/bulletin/allmacs.mar deleted file mode 100644 index f8a6793..0000000 --- a/decus/vax90a/bulletin/allmacs.mar +++ /dev/null @@ -1,270 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - - .END diff --git a/decus/vax90a/bulletin/board_digest.com b/decus/vax90a/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vax90a/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vax90a/bulletin/board_special.com b/decus/vax90a/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vax90a/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vax90a/bulletin/bullcom.cld b/decus/vax90a/bulletin/bullcom.cld deleted file mode 100644 index f605e80..0000000 --- a/decus/vax90a/bulletin/bullcom.cld +++ /dev/null @@ -1,419 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 2/16/90 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW (TEXT OR EXTRACT) AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER RESTART - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB POST - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACT - QUALIFIER LIST, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT AND NOT EXTRACT - QUALIFIER TEXT - QUALIFIER EDIT - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW (EXTRACT OR TEXT) AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACT - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT AND NOT EXTRACT - QUALIFIER TEXT - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REVERSE - QUALIFIER SUBJECT - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLUSTER, DEFAULT - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NOT ALL AND NOT DEFAULT AND CLUSTER - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER LOGIN - QUALIFIER NOLOGIN - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) diff --git a/decus/vax90a/bulletin/bullcoms1.hlp b/decus/vax90a/bulletin/bullcoms1.hlp deleted file mode 100644 index c73fbeb..0000000 --- a/decus/vax90a/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,628 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does not -change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this assumes -that the remote node is capable of supporting this feature, i.e. the BULLCP -process is running on that node. If it is not, you will receive an error -message). If the the foldername is specified with only a nodename, -i.e. FOO::, the foldername is assumed to be GENERAL. NOTE: Specifying -remote nodes is only possible if that remote node is running a special -BULLCP process. If it isn't, the only way to add messages to that remote -node is via the /NODE command. However, /FOLDER is a much quicker method, -and much more versatile. - -You can specify logical names which translate to one or more folder names. -I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify /NODES= -ALL_FOLDERS. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL - -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See installation -notes). You can specify a different username to use at the other nodes by -either using the USERNAME qualifier, or by specifying the nodename with 2 -semi-colons followed by the username, i.e. nodename::username. If you -specify a username, you will be prompted for the password of the account -on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /PERMANENT -This option is restricted to privileged users for the GENERAL folder, -but available to all in other folders. If specified, message will be a -permanent message and will never expire. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /TEXT -This is a synonym of /EXTRACT. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 BACK -Displays the message preceding the current message. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. If the text of the message -is to be changed, a file can be specified which contains the text. -Otherwise, you will be prompted for the text. The expiration info and -header can also be changed. If neither no qualifiers are added to the -command, it is assumed the whole message will be replaced. - - Format: - CHANGE [file-name] -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /EXTRACT -Specifies that the message text is to be replaced. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. This only applies to the GENERAL folder. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number - -Specifies the message number to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -This is a synonym of /EXTRACT. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically selected -(see information on SELECT command). The commands that can be used to -modify the folder's characteristics are: MODIFY, REMOVE, SET ACCESS, -SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the folder -is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying BULLCOM.CLD. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST -2 /NODE - /NODE=node -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, the -folder will then be modified to point to that folder. For example if -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be shared -between more than one node. This capability is only present if the BULLCP -process is running on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. By default, -the GENERAL folder is a SYSTEM folder. This is a privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT - -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message. -It can be a substring of the subject. This is in case you have forgotten -the exact subject that was specified. Case is not critical either. -You will be notified if the deletion was successful. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting messages -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of folder. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected using the SELECT command. -2 /NEW -Specifies to start the listing of messages with the first unread message. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified. - - Format: - FILE [message_number][-message_number1] - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5. -2 /ALL -Copies all the messages in the current folder. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 Folders -All messages are divided into separate folders. The default folder is -GENERAL. New folders can be created by any user. As an example, the -following creates a folder for GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that -user will be alerted of topics of new messages at login time, and will -then be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in the -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote DECNET -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP) -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. By default, the GENERAL folder -is a SYSTEM folder (and cannot be changed). One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the GENERAL -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, and -giving access to that UIC group. Only users in that UIC group will see -the messages in that folder when they log in. -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INDEX -Gives directory listing of all folders in alphabetical order. If the -INDEX command is re-entered while the listing is in progress, the listing -will skip to the next folder. This is useful for skipping a particular -folder. It also can be used to continue the listing from where one left -off after one has read a message. - - Format: - INDEX -2 /MARKED -Shows only messages that have been marked (indicated by an asterisk). -2 /NEW -Specifies to start the listing of each folder with the first unread message. -Otherwise, the listing will start with the first message in the folder. -If the INDEX command is re-entered for continuing the listing, /NEW must -be respecified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/TE|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/TE| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL utility. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers] - -NOTE: The list of marked messages are stored in a file username.BULLMARK -in the directory pointed to by the logical name BULL_MARK. If BULL_MARK -is not defined, an error message will be displayed when attempting to -mark a message. BULL_MARK may be defined system wide, depending on -whether the system manager has decided to do so. -1 MODIFY -Modifies the database information for the current folder. Only the owner -of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However, -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. diff --git a/decus/vax90a/bulletin/bullcoms2.hlp b/decus/vax90a/bulletin/bullcoms2.hlp deleted file mode 100644 index 6f49ecb..0000000 --- a/decus/vax90a/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,761 +0,0 @@ -1 POST -Sends a message via MAIL to the network mailing list which is -associated with the selected folder. This command is used in -conjunction with a folder which receives messages from a network -mailing list. The address of the mailing list must be stored using -either CREATE/DESCRIPTION or MODIFY/DESCRIPTION. See help on those -commands for more information. -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mai message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with > at the -beginning of each line. This can be suppressed with /NOINDENT. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 /TEXT -This is a synonym of /EXTRACT. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The PRINT command can take optional qualifiers. - - Format: - - PRINT [message_number][-message_number1] - -A range of messages to be printed can optionally be specified, i.e. -FILE 2-5. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder will -be displayed. However, if there are new messages, the first new message -will be displayed. Each time you enter the command, the next page, or if -there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply hitting -the key is equivalent to "READ". -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected using the SELECT command. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged -user can remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /EXTRACT. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /TEXT -This is a synonym of /EXTRACT. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -2 /TEXT -This is a synonym of /EXTRACT. -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing -the first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header. -If a "search-string" is not specified, a search is made using the -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the last -message. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default general messages. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database -for which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created -via ACLs. If a user's process privileges are set to override ACLs, -that user will be able to access the folder even if access has not -been granted. -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains -a comma must be enclosed in quotes. UICs can contain wildcards, -i.e. "[130,*]". Note that by default, a process is given the -process rights id SYS$NODE_nodename, where nodename is the decnet -nodename. Thus, by specifing this id, a folder can be restricted -to a specific node, which is useful when the folder is shared among -nodes in a cluster. - -Alternatively, the id-name can be a filename which contains a list -of ids. The filename should be preceeded by a "@". If the suffix -is not specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. -If /READ is not specified, the folder will no longer be private. -If /READ is specified, all users will have read access, but only -privileged users will have write access (of course non-privileged -users can gain access via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which affect -detached subprocesses are usually too low for the subprocess which -is spawned to read the mail. The parameters and the suggested values are: -PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, and PQL_DFILLM = 30. If you -are not using the BULLCP process, the subprocess limit for users must be -at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET STRIP -and SET DIGEST for options on formatting BBOARD messages. -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time and -avoids creating subprocesses. (Useful if input is digest format.) -3 More_information - -The following is relevant only if the messages in the BBOARD accounts -are sent via a method that causes the name of the account to be placed -in the TO: line of the VMS MAIL. The normal MAIL utility, of course, -does this. However, packages such as PMDF (and probably many others) -will not always do this. (I.e. if the mail was sent to the account -using CC:, the address of the person to whom the mail was sent will be -placed in the TO: line rather than the CC: address.) - -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail forwarded -to BBOARD accounts that don't have /SPECIAL set. Folders of the same -type, i.e. that use the same /SPECIAL command procedure, must be grouped -separately. -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. This cannot be specified for -the GENERAL folder. The BRIEF setting contrasts with the READNEW -setting, which causes a listing of the description of the new messages -to be displayed and prompts the user to read the messages. Setting -BRIEF will clear a READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest limit -that can be specified is 30 days. This can be overridden by a user with -privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will -be used. - - Format: - - SET DEFAULT_EXPIRE days - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, -the messages will be separated into individual BULLETIN messages. - - Format: - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory. - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. -(NOTE: SHOW FOLDER/FULL is a privileged command.) -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one exists. -(NOTE: SHOW FOLDER/FULL is a privileged command.) -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by many -different people. If an account is specified as GENERIC, new messages -placed in the GENERAL folder will be displayed upon logging in for a -specific number of days, rather than only once. The default period is 7 -days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new GENERAL messages will be displayed -for upon logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will -not occur if DISMAIL is set for an old account. Additionally, removing -the DISMAIL flag will not automatically enable LOGIN. (The reason for -the above was to avoid extra overhead for constant checking for the -DISMAIL flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NODE -Modifies the selected folder from a local folder to a remote folder. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The SET NODE command specifies -the name of the remote node, and optionally the name of the remote -folder. If the remote folder name is not included, it is assumed to -be the same as the local folder. When the command is executed, the -selected folder will then point to the remote folder. If there were -messages in the local folder, they will be deleted. This feature is -present only if the BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that folder. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -This command does not presently work for remote folders. - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are logged -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. - -If cluster notification is set, users will not be able to disable -notification for themselves. This is because VMS is unable to find out -user names logged in at other nodes, which requires BULLETIN to keep a -list of users to notify. If /ALL is specified, the list may be very -large, which would cause the notification process to take a very long -time. It is much easier to simply notify all users. However, this can -be overriden by the /NOCLUSTER qualifier, which will cause the list to -be generated. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. - -If cluster notification is set, all users will notificated, and users -will not be able to disable notification for themselves. This is -because VMS is unable to find out user names logged in at other nodes, -which requires BULLETIN to keep a list of users to notify. If /DEFAULT -is specified, the list may be very large, which would cause the -notification process to take a very long time. It is much easier to -simply notify all users. However, /NOCLUSTER will override this, -causing the list to be generated. -3 /CLUSTER - /[NO]CLUSTER - -Specifies that if /ALL or /DEFAULT has been selected, and cluster -notification is enabled, all users across the network will be notified -of new messages. Users will not be able to disable notification. -This is the default. /NOCLUSTER will disable this causing /DEFAULT -and /ALL to work as it normally does, i.e. /DEFAULT simply setting -the default for new users, and /ALL causing all users to be notified -while enabling users to disable notification. However, if your system -has a lot of users, this will cause the notification algorithm to take -a very long time. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format: - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. -To remove a privilege, specify the privilege preceeded by "NO". -If /ID is specified, the parameters are rights identifiers. -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed. -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when adding -a message. If NOPROMPT_EXPIRE is specified, the user will not be prompted, -and the default expiration (which is set by SET DEFAULT_EXPIRE or SET -BBOARD/EXPIRATION) will be used. If the value specified is greater than the -expiration limit, and the user does not have privileges, then the expiration -limit will be used as the default expiration. (If there is no expiration -limit, and the user doesn't have privileges, then an error will result.) -PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to read -new non-system or folder messages (if any exist). The default is dependent -on how the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. -For messages in folders other than the GENERAL folder, both prompting -and display of topics of new messages are controlled by this command. -For the GENERAL folder, the display of topics cannot be disabled. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP -SET SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. -This command cannot be used for the GENERAL folder. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -2 STRIP -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped off -before it is stored as a BULLETIN message. - - Format: - - SET [NO]STRIP - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -By default, the GENERAL folder is a SYSTEM folder, and the setting for -that folder cannot be removed. - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected via -the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 KEYPAD -Displays the keypad command definitions. If the keypad has been enabled -by either the SET KEYPAD COMMAND, or /KEYPAD is specified on the command -line, the keypad keys will be defined as commands. SHOW KEYPAD is the -equivalent of HELP KEYPAD. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in. If NOLOGIN is set for a user, -this information will be displayed instead. This is a privileged command. -Non-privileged users will only be able to display the information for -their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some sites -make BULLETIN/LOGIN an optional command for users to store in their own -LOGIN.COM, so this command can be used to show which users have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGIN - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -2 VERSION -Shows the version of BULLETIN and the date that the executable was linked. -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 UNDELETE -Undeletes the specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have their -expiration date set to 15 minutes in the future and are deleted then. -Undeleting the message will reset the expiration date back to its original -value. Deleted messages will be indicated as such by the string (DELETED) -when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] diff --git a/decus/vax90a/bulletin/bulldir.inc b/decus/vax90a/bulletin/bulldir.inc deleted file mode 100644 index 640dc6c..0000000 --- a/decus/vax90a/bulletin/bulldir.inc +++ /dev/null @@ -1,33 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(LINE_LENGTH) diff --git a/decus/vax90a/bulletin/bullet1.com b/decus/vax90a/bulletin/bullet1.com deleted file mode 100644 index 9a2c483..0000000 --- a/decus/vax90a/bulletin/bullet1.com +++ /dev/null @@ -1,778 +0,0 @@ -$set nover -$copy sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utility PMDF. If you wish to -do so for another utility, read the text file WRITEMSG.TXT. I would be glad to -include any such programs with my distribution if you think such a program -would be of use to other users. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, you may have to modify the subroutine - which executes the RESPOND command. That command sends messages to either - the originator of the message or the mailing list associated with the - folder. These routines assume that one can simply use the VMS MAIL - utility to do so. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - - BULLETIN will work for both V4 & V5. However, you will have to reassemble - ALLMACS.MAR if you are upgrading from V5, i.e. - $ MAC ALLMACS - $ LIB BULL ALLMACS - $ DELETE ALLMACS.OBJ; - $ @BULLETIN.LNK - $ COPY BULLETIN.EXE BULL_DIR: - $ RUN SYS$SYSTEM:INSTALL - BULL_DIR:BULLETIN/REPLACE - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require different - linked executables.) - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. - You will be prompted for the password for the account on the remote node. -$eod -$copy sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(LINE_LENGTH) -$eod -$copy sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in it's memory. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -$eod -$copy sys$input BULLETIN.LNK -$deck -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB- - /EXE=BULLETIN,SYS$INPUT/OPT -ID="V1.81" -$eod -$copy sys$input BULLFILES.INC -$deck -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF IT -C IS NOT, THEN THEY SHOULD ALSO BE CHANGED. -C - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ -$eod -$copy sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,FILLER, - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) -$eod -$copy sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod -$copy sys$input WRITEMSG.TXT -$deck -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/vax90a/bulletin/bullet2.com b/decus/vax90a/bulletin/bullet2.com deleted file mode 100644 index 7cbb761..0000000 --- a/decus/vax90a/bulletin/bullet2.com +++ /dev/null @@ -1,1075 +0,0 @@ -$set nover -$copy sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 2/16/90 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW (TEXT OR EXTRACT) AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER RESTART - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB POST - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACT - QUALIFIER LIST, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT AND NOT EXTRACT - QUALIFIER TEXT - QUALIFIER EDIT - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW (EXTRACT OR TEXT) AND FILESPEC - QUALIFIER USERNAME, LABEL=USERNAME, VALUE(REQUIRED) - NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACT - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT TEXT AND NOT EXTRACT - QUALIFIER TEXT - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REVERSE - QUALIFIER SUBJECT - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLUSTER, DEFAULT - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NOT ALL AND NOT DEFAULT AND CLUSTER - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW ALL AND DEFAULT - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER LOGIN - QUALIFIER NOLOGIN - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) -$eod -$copy sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") -$eod -$copy sys$input BULLETIN.COM -$deck -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -$eod -$copy sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER,DEFAULT="7") -$eod -$copy sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy sys$input CREATE.COM -$deck -$ FORTRAN/EXTEND BULLETIN -$ FORTRAN/EXTEND BULLETIN0 -$ FORTRAN/EXTEND BULLETIN1 -$ FORTRAN/EXTEND BULLETIN2 -$ FORTRAN/EXTEND BULLETIN3 -$ FORTRAN/EXTEND BULLETIN4 -$ FORTRAN/EXTEND BULLETIN5 -$ FORTRAN/EXTEND BULLETIN6 -$ FORTRAN/EXTEND BULLETIN7 -$ FORTRAN/EXTEND BULLETIN8 -$ FORTRAN/EXTEND BULLETIN9 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB; -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIB/CREATE BULL -$ LIB BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK -$eod -$copy sys$input DCLREMOTE.COM -$deck -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET -$eod -$copy sys$input INSTALL.COM -$deck -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy sys$input INSTALL_REMOTE.COM -$deck -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL -$eod -$copy sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy sys$input LOGIN.COM -$deck -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! -$eod -$copy sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V1.81" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin9.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* -$eod -$copy sys$input REMOTE.COM -$deck -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP -$eod diff --git a/decus/vax90a/bulletin/bulletin.cld b/decus/vax90a/bulletin/bulletin.cld deleted file mode 100644 index 7b0312a..0000000 --- a/decus/vax90a/bulletin/bulletin.cld +++ /dev/null @@ -1,36 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") diff --git a/decus/vax90a/bulletin/bulletin.com b/decus/vax90a/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vax90a/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vax90a/bulletin/bulletin.for b/decus/vax90a/bulletin/bulletin.for deleted file mode 100644 index a1836a4..0000000 --- a/decus/vax90a/bulletin/bulletin.for +++ /dev/null @@ -1,1436 +0,0 @@ -C -C BULLETIN.FOR, Version 5/17/90 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$GET_FOREIGN(INCMD) - CALL CLI$DCL_PARSE('BULLETIN '//INCMD,BULLETIN_MAINCOMMANDS) - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - END IF - CALL LIB$REVERT - - READIT = 0 - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP')) THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - CALL RUN_BULLCP ! doing what BULLCP does! - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL SHOW_SYSTEM - CALL EXIT - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - CALL NEW_MESSAGE_NOTIFICATION - - CALL OPEN_OLD_TAG - - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - - DO WHILE (1) - - CALL GET_INPUT_PROMPT(INCMD,IER, - & CHAR(10)//COMMAND_PROMPT(:TRIM(COMMAND_PROMPT)+1)) - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9') - IER = IER - 1 - END DO - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - GO TO 999 ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - - IER = MIN(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - CALL ADD - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - GO TO 999 ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 99999 - CALL READ(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.) - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEXT') THEN ! NEXT? - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - CALL REPLY - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(1,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(0,-2,-2) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET SHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,1) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(1,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOSHOWNEW not allowed for GENERAL folder.'')') - ELSE IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET BRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,1,1) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(1,2) - CALL CHANGE_FLAG(1,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'( - & '' ERROR: SET NOBRIEF not allowed for GENERAL folder.'')') - ELSE - IF (CLI$PRESENT('DEFAULT')) THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE IF (CLI$PRESENT('ALL')) THEN - IF (SETPRV_PRIV()) THEN - CALL SET_FOLDER_DEFAULT(-2,0,0) - ELSE - WRITE (6,'('' ERROR: /ALL is a privileged command.'')') - END IF - ELSE - CALL CHANGE_FLAG(0,2) - CALL CHANGE_FLAG(0,3) - END IF - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (NBULL.GT.0) THEN - DIFF = COMPARE_BTIM( - & LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - END IF - END IF - END DO - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.) - END IF - -100 CONTINUE - - END DO - -999 CALL EXIT - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER*(LINE_LENGTH) INDESCRIP - - CHARACTER INLINE*80,OLD_FOLDER*25,LOCAL_NODE*8 - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF (CLI$PRESENT('TEXT').OR.CLI$PRESENT('EXTRACT')) THEN - IF (.NOT.((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If no /EDIT - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.ALLOW) THEN ! If no SETPRV privileges, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - ELSE IF (CLI$PRESENT('TEXT').OR.CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IF (DECNET_PROC) THEN ! Running via DECNET? - USERNAME = DEFAULT_USER - CALL CONFIRM_PRIV(USERNAME,ALLOW) - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privileges - WRITE(ERROR_UNIT,1081) ! Tell user - GO TO 910 ! and abort - ELSE IF (F_EXPIRE_LIMIT.GT.0.AND..NOT.ALLOW ! Expiration limit - & .AND.USERNAME.NE.FOLDER_OWNER) THEN ! is present - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - WRITE (INEXTIME,'(I4)') NODE_NUMBER - WRITE (INEXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF (SYSTEM.LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - INDESCRIP = DESCRIP ! Use description with RE:, - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IF - - ICOUNT = 0 ! Line count for bulletin - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolons - ILEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Are semicolon found? - IF (ILEN.GT.SEMI+1) THEN ! Is username found? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes - ILEN = SEMI - 1 ! Remove semicolons - ELSE ! No username found... - TEMP_USER = DEFAULT_USER ! Set user to default - ILEN = SEMI - 1 ! Remove semicolons - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolons present - TEMP_USER = DEFAULT_USER ! Set user to default - END IF - IER = 1 - DO WHILE ((INLINE.NE.'ADD'.OR.SEMI.GT.0.OR. - & CLI$PRESENT('USERNAME')).AND.IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:ILEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - INLINE = INLINE(:STR$POSITION(INLINE,' ')-1) - & //'/USERNAME='//TEMP_USER - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF (SYSTEM.LE.1) ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - LUSER = TRIM(USERNAME) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - BRDCST = .FALSE. - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - FROM = USERNAME ! Username - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - CALL STORE_BULL(LNODE+LUSER+6,'From: '// - & LOCAL_NODE(:LNODE)//USERNAME(:LUSER),OBLOCK) - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF - CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - CALL ADD_ENTRY ! Add the new directory entry - - IF (FOLDER_NUMBER.GE.0) THEN - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add - ELSE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (CLI$PRESENT('TEXT').OR.CLI$PRESENT('EXTRACT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanent - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*23 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER LOCALNODE*8,RESPONSE*1 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE(4) - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE (4) - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE.NE.'n'.AND.RESPONSE.NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP) - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - DESCRIP = 'RE: '//DESCRIP - ELSE - DESCRIP = 'RE:'//DESCRIP(4:) - END IF - WRITE (6,'(1X,A)') DESCRIP - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - CHARACTER*255 COMMAND - - CALL DISABLE_PRIVS - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - CALL LIB$SPAWN('$'//COMMAND(:CLEN)) - ELSE - CALL LIB$SPAWN() - END IF - CALL ENABLE_PRIVS - - RETURN - END diff --git a/decus/vax90a/bulletin/bulletin.hlp b/decus/vax90a/bulletin/bulletin.hlp deleted file mode 100644 index b3e6d24..0000000 --- a/decus/vax90a/bulletin/bulletin.hlp +++ /dev/null @@ -1,108 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in it's memory. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) diff --git a/decus/vax90a/bulletin/bulletin.lnk b/decus/vax90a/bulletin/bulletin.lnk deleted file mode 100644 index 6d25588..0000000 --- a/decus/vax90a/bulletin/bulletin.lnk +++ /dev/null @@ -1,3 +0,0 @@ -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB- - /EXE=BULLETIN,SYS$INPUT/OPT -ID="V1.81" diff --git a/decus/vax90a/bulletin/bulletin0.for b/decus/vax90a/bulletin/bulletin0.for deleted file mode 100644 index 023da71..0000000 --- a/decus/vax90a/bulletin/bulletin0.for +++ /dev/null @@ -1,1494 +0,0 @@ -C -C BULLETIN0.FOR, Version 11/20/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - - - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('USERNAME',REMOTE_USER) - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.REMOTE_USER.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,DESCRIP - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(1:11) - NEWEST_EXTIME = INPUT(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - DO BULL_DELETE = SBULL,EBULL - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM) - IER = SYS$ASCTIM(,INPUT,EX_BTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:) - - CALL WRITEDIR(0,IER) - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT - - CHARACTER START_PARAMETER*16,DATETIME*23 - - INTEGER TODAY(2) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (INCMD(:3).EQ.'DIR'.AND..NOT.READ_TAG) THEN - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').AND. - & CLI$PRESENT('MARKED')) THEN - IF (FOLDER_NUMBER.GE.0) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: Cannot use /MARKED with'', - & '' remote folder.'')') - RETURN - END IF - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - IF (CLI$PRESENT('START')) THEN ! Start number specified? - IER = CLI$GET_VALUE('START',START_PARAMETER,ILEN) - DECODE(ILEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEN - DIR_COUNT = NBULL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - END IF - - CALL READDIR_KEYGE(IER) - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - RETURN - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IF (READ_TAG) THEN - IF (.NOT.(CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW') - & .OR.CLI$PRESENT('START'))) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - END IF - - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - END IF - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THEN - EBULL = NBULL - END IF - IF (.NOT.REMOTE_SET.AND..NOT.READ_TAG) THEN - DO I=SBULL,EBULL ! Copy messages from file - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - END DO - ELSE IF (READ_TAG) THEN - I = SBULL - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) EBULL = EBULL - 1 - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,SBULL,EBULL - IF (IER.EQ.0) THEN - I = SBULL - DO WHILE (IER.EQ.0.AND.I.LE.EBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - RETURN - END IF - END IF - ELSE - NBULL = 0 - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - IF (NBULL.EQ.0) THEN - WRITE (6,'('' There are no messages present.'')') - RETURN - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - FLEN = TRIM(FOLDER) - WRITE(6,'(X,A)') FOLDER(:FLEN) - WRITE(6,1000) ! Write header - N = 3 - - IF (BULL_TAG.AND..NOT.READ_TAG) THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - DO I=SBULL,EBULL - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - IF (MSG_NUM.GT.999) N = 4 - IF (MSG_NUM.GT.9999) N = 5 - IF (READ_TAG.OR.(BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG)) THEN - WRITE (6,'('' *'',$)') - ELSE - WRITE (6,'('' '',$)') - END IF - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM,'(DELETED)' - ELSE - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM, - & DATE(1:7)//DATE(10:11) - END IF - IF (BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (DIR_COUNT.GT.NBULL.OR.(READ_TAG.AND.IER1.NE.0)) THEN - ! Outputted all entries? - DIR_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - -2010 FORMAT('+',I,1X,A<55-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1015) - RETURN - END IF - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And return - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH, - & STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACCESS='APPEND') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - DO FBULL = SBULL,EBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1) THEN ! Was bulletin found? - WRITE(6,1030) FBULL - IF (FBULL.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_PARAMETER(1:LEN_P) - ! Show name of file created. - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - - RETURN - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message(s) written to ',A) -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*23,INREAD*1 - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - ELSE - RETURN ! Don't notify - END IF - END IF - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry - READ_BTIM(2) = NEW_BTIM(2) - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - ELSE - LOGIN_BTIM_SAVE(1) = NEW_BTIM(1) - LOGIN_BTIM_SAVE(2) = NEW_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - BBOARD_BTIM(1) = TODAY_BTIM(1) - BBOARD_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_BBOARD_PROCESS - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compare - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - - IF (NEW_FLAG(2).NE.0) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - -C -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible. -C - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.FOLDER_SET) THEN - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IF - - IF (REMOTE_SET) THEN ! If system remote folder, use remote - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, ! info, not local login time - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - LOGIN_BTIM(1) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (FOLDER_NUMBER.GT.0.AND.BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST2(SET_FLAG,FOLDER_NUMBER) - & .AND..NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(1) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - LOGIN_BTIM(1) = SYSTEM_LOGIN_BTIM(1) ! Use specified login time - LOGIN_BTIM(2) = SYSTEM_LOGIN_BTIM(2) ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - LOGIN_BTIM_OLD(1) = LOGIN_BTIM(1) - LOGIN_BTIM_OLD(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(1) - LOGIN_BTIM_NEW(1) = LOGIN_BTIM(1) - LOGIN_BTIM_NEW(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = LOGIN_BTIM_OLD(1) - LOGIN_BTIM(2) = LOGIN_BTIM_OLD(2) - END IF - CALL CLOSE_BULLUSER - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF (REVERSE_SWITCH.AND.(.NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,NBULL - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,NBULL,START - END IF - IF (IER.EQ.0) THEN - ALL_DIR = ALL_DIR1 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.NBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - ALL_DIR = ALL_DIR1 - END IF - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - ! No. Is bulletin system or from same user? - IF (.NOT.REVERSE) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (SYSTEM_SWITCH) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - ELSE - DIFF = -1 - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF (SYSTEM.EQ.3) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0) THEN ! And save only the first non-system msg - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) '+'//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) '+'//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - ELSE - PAGE = PAGE + 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) ' '//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) ' '//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - IF (SYSTEM.GT.9999) THEN ! # Digits in message number - N = 5 - ELSE IF (SYSTEM.GT.999) THEN - N = 4 - ELSE - N = 3 - END IF - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD,INREAD) - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:56-N),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:56-N),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST2(SET_FLAG,FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - ELSE - FLEN = TRIM(FOLDER) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 49 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-48)// - & ' command can be used to read these messages.' - ELSE - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-49-FLEN) - & //' '//FOLDER(:FLEN)// - & ' command can be used to read these messages.' - END IF - END IF - -9999 IF (LOGIN_SWITCH) THEN - LOGIN_BTIM(1) = LOGIN_BTIM_NEW(1) - LOGIN_BTIM(2) = LOGIN_BTIM_NEW(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM_OLD(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM_OLD(2) - END IF - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<57-N>,1X,A12,1X,A6,<6-N>X,I) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IF - - RETURN - END - diff --git a/decus/vax90a/bulletin/bulletin1.for b/decus/vax90a/bulletin/bulletin1.for deleted file mode 100644 index fc51748..0000000 --- a/decus/vax90a/bulletin/bulletin1.for +++ /dev/null @@ -1,1565 +0,0 @@ -C -C BULLETIN1.FOR, Version 9/26/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (MAIL_SUBJECT(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - MAIL_SUBJECT(I:I) = '`' - ELSE - MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_P = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_P = LEN_P + I + 1 - BULL_PARAMETER(LEN_P:LEN_P) = ',' - END DO - LEN_P = LEN_P - 1 - - I = 1 ! Must change all " to "" in MAIL recipients - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:I)//'"'// - & BULL_PARAMETER(I+1:) - I = I + 1 - LEN_P = LEN_P + 1 - END IF - I = I + 1 - END DO - - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) - & //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,STATUS) - CALL ENABLE_PRIVS - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - EXTERNAL BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*25 - - IF (CLI$PRESENT('ORIGINAL').AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - END IF - END IF - - FROM_REMOTE = REMOTE_SET - - IF (REMOTE_SET) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.0) THEN - CALL OPEN_BULLFIL - I = BULL_POINT - 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THEN - IF (I.EQ.0) THEN - WRITE (12,IOSTAT=IER1) BULLDIR_HEADER - ELSE - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - END IF - NBLOCK = 1 - DO WHILE (I.LT.BULL_POINT+NUM_COPY-1.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THEN - BLOCK = NBLOCK - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - IF (IER1.EQ.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER1) 5,I - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - END IF - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT(:128)) - WRITE (11'NBLOCK,IOSTAT=IER1) INPUT(:128) - NBLOCK = NBLOCK + 1 - END DO - END IF - IF (IER1.NE.0) I = IER - END IF - END DO - NUM_COPY = I - BULL_POINT + 1 - END IF - CALL CLOSE_BULLFIL - IF (IER1.NE.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=11) - CLOSE (UNIT=12) - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IF - - IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_BULLDIR ! Prepare to add dir entry - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND. - & .NOT.SETPRV_PRIV().AND..NOT.ALL) THEN ! Permanent? - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.CLI$PRESENT('ORIGINAL')) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END DO - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - CLOSE (UNIT=11) - - CLOSE (UNIT=12) - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0) THEN - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE - END IF - END IF - - RETURN - - END - - - - - SUBROUTINE PRINT -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*31 FORM_NAME - - PARAMETER FF = CHAR(12) - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1015) - RETURN - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - CALL OPEN_BULLDIR_SHARED - - CALL OPEN_BULLFIL_SHARED - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified message - - IF (IER.NE.I+1) THEN ! Was message found? - IF (I.EQ.SBULL) THEN ! No, were any messages found? - WRITE(6,1030) ! If not, then error out - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE ! Yes, message found. - IF (I.GT.SBULL) WRITE(3,'(A)') FF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - END IF - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) ! Get queue name - IF (ILEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - ILEN = 9 - END IF - - CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IF - - IF (CLI$PRESENT('FORM')) THEN - IER = CLI$GET_VALUE('FORM',FORM_NAME,FORM_NAME_LEN) - CALL ADD_2_ITMLST(FORM_NAME_LEN,SJC$_FORM_NAME,%LOC(FORM_NAME)) - END IF - - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*11,DATETIME*23,BUFFER*(LINE_LENGTH) - CHARACTER SAVE_MSG_KEY*8 - - LOGICAL SINCE,PAGE - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - IF (CLI$PRESENT('MARKED')) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No marked messages found.'')') - RETURN - ELSE - READ_TAG = .TRUE. - END IF - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - RETURN - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IF - - IF (READ_TAG) THEN - NEXT = .FALSE. - IF (INCMD(:4).EQ.'NEXT'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - IF (.NOT.CLI$PRESENT('BULLETIN_NUMBER')) NEXT = .TRUE. - END IF - IF (INCMD(:4).EQ.'BACK') THEN - SAVE_MSG_KEY = MSG_KEY - MSG_KEY = BULLDIR_HEADER - I = 0 - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_KEY.NE.SAVE_MSG_KEY) - I = I + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO - IF (IER.EQ.0) THEN - MSG_KEY = BULLDIR_HEADER - DO J=1,I-1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - ELSE IF (NEXT) THEN - IF (SINCE) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - ELSE - IF (BULL_POINT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END IF - IF (IER.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND. - & (.NOT.READ_TAG.OR.(.NOT.NEXT.AND.INCMD(:4).NE.'BACK'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IF - - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2) - END IF - - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'CURR') THEN - IF (CLI$PRESENT('EDIT')) THEN - CALL READ_EDIT - RETURN - END IF - END IF - - FLEN = TRIM(FOLDER) - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - WRITE (INPUT,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULL - DO WHILE (INDEX(INPUT,' ').LT.TRIM(INPUT)) - I = INDEX(INPUT,' ') - INPUT(I:) = INPUT(I+1:) - END DO - I = TRIM(INPUT) - INPUT = ' #'//INPUT(2:TRIM(INPUT)) - INPUT(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//INPUT(:TRIM(INPUT)) - ELSE - WRITE(6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - - END = END + 1 - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - WRITE(6,'('' From: '',A)') FROM - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - ELSE - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - END IF - WRITE(6,'('' Subj: '',A)') DESCRIP - END = END + 1 - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - WRITE(6,'(1X)') - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE (BUFFER,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULL - DO WHILE (INDEX(BUFFER,' ').LT.TRIM(BUFFER)) - I = INDEX(BUFFER,' ') - BUFFER(I:) = BUFFER(I+1:) - END DO - BUFFER = ' #'//BUFFER(2:TRIM(BUFFER)) - BUFFER(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN) - WRITE(6,'(1X,A,/)') BUFFER(:TRIM(BUFFER)) ! Output header info - END = END + 2 ! Increase display counter - END IF - -200 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - - RETURN - -1030 FORMAT(' ERROR: Specified message was not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE READ_EDIT - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_BULLFIL - - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,' Date: ',A) - - RETURN - END - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - CHARACTER INREAD*1,FILE_DEF*80,NUMREAD*5 - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - IF (.NOT.SETPRV_PRIV()) THEN ! If no SETPRV, remove SYSPRV - CALL DISABLE_PRIVS ! privileges when trying to - END IF ! create new file. - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH,ERR=18,STATUS='UNKNOWN', - & CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END DO - IF (ILEN.EQ.0) WRITE(6,1040) BULL_PARAMETER(:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - IF (READ_COUNT.GT.0) THEN ! Reposition GET_BULL routine - ILEN = LINE_LENGTH + 1 ! in case read in progress - DO I=1,LINE_OFFSET ! and partial block was read. - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - END IF - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message - & number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit), - & F(File it), D(Dir), R(Read msg #) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit), F(File), N(Next), - & D(Dir), R(Read msg #) or other for MORE: ',$) -1040 FORMAT(' Message written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER_OWNER) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END diff --git a/decus/vax90a/bulletin/bulletin2.for b/decus/vax90a/bulletin/bulletin2.for deleted file mode 100644 index 3af8357..0000000 --- a/decus/vax90a/bulletin/bulletin2.for +++ /dev/null @@ -1,1518 +0,0 @@ -C -C BULLETIN2.FOR, Version 2/16/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23,RESPONSE*1 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*11,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,FOLDER_SAVE*25 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for GENERAL folder.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND(STATUS) -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FROM_TEST*5,INFROM*(LINE_LENGTH) - - EXTERNAL CLI$_NEGATED - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP) - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - BULL_PARAMETER = 'RE: '//DESCRIP - ELSE - BULL_PARAMETER = 'RE:'//DESCRIP(4:) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P) - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EXTRACT') - - IF (EDIT.AND.TEXT) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - LENFRO = 0 - IF (CLI$GET_VALUE('CC',INPUT,ILEN)) THEN - INFROM = INPUT(:ILEN)//',' - LENFRO = ILEN + 1 - END IF - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INFROM(:LENFRO)//INPUT(7:) - LENFRO = LENFRO + ILEN - 6 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (CLI$PRESENT('LIST')) THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - - IF (INCMD(:4).EQ.'POST') LENFRO = 0 - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (CLI$PRESENT('LIST')) THEN - LIST = INDEX(FOLDER_DESCRIP,'<') - IF (LIST.GT.0) THEN - INFROM = INFROM(:LENFRO)// - & FOLDER_DESCRIP(LIST+1:TRIM(FOLDER_DESCRIP)-1) - LENFRO = LENFRO + TRIM(FOLDER_DESCRIP) - 1 - LIST - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - LEN_P = TRIM(BULL_PARAMETER) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - IF (LEN_P.EQ.64) THEN - BULL_PARAMETER(I:I) = '`' - ELSE - BULL_PARAMETER = BULL_PARAMETER(:I)//'"' - & //BULL_PARAMETER(I+1:) - I = I + 1 - LEN_P = LEN_P + 1 - END IF - END IF - I = I + 1 - END DO - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - IF (TEXT) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//INFROM(:LENFRO) - & //'"/SUBJECT="'//BULL_PARAMETER//'"',,,,,,STATUS) - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT "'//INFROM(:LENFRO)// - & '"/SUBJECT="'//BULL_PARAMETER//'"',,,,,,STATUS) - END IF - CALL ENABLE_PRIVS - -900 IF (EDIT) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: Replaces existing bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH) - CHARACTER*1 ANSWER - - CHARACTER DATE_SAVE*11,TIME_SAVE*11 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL*1 DOALL - -C -C Get the bulletin number to be replaced. -C - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are reading - ELSE - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletin - - CALL CLOSE_BULLDIR - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person - RETURN ! and error out - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND. - & USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EXTRACT') - - IF (TEXT) THEN - IF (.NOT.((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If no /EDIT - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - END IF - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.TEXT).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - REC1 = 0 - - LENFROM = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - CALL OPEN_BULLDIR ! Prepare to add dir entry - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - NBLOCK = NBLOCK + ICOUNT - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:59) ! Update description header - END IF - CALL UPDATE_DIR_HEADER(CLI$PRESENT('EXPIRATION').OR.DOALL, - & CLI$PRESENT('PERMANENT'),CLI$PRESENT('SHUTDOWN'), - & INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT')) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION')) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:59),MSGTYPE,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER TODAY*23,INEXDATE*11,INEXTIME*11 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*132 SEARCH_STRING,SAVE_STRING - DATA SEARCH_STRING /' '/, SEARCH_LEN /1/ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL DISABLE_CTRL - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_POINT - BULL_POINT = BULL_POINT - 1 - END IF - - SAVE_STRING = SEARCH_STRING - SAVE_LEN = SEARCH_LEN - - IER1 = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - - IF (.NOT.IER1) THEN ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - SEARCH_LEN = SAVE_LEN - IF (SAVE_LEN.EQ.0) THEN - WRITE (6,'('' No search string present.'')') - RETURN - END IF - IF (STEP_BULL.EQ.-1) BULL_POINT = BULL_POINT - 2 - END IF - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - IF (IER1) THEN ! If string entered - IF (.NOT.CLI$PRESENT('START')) THEN ! If starting message not - BULL_POINT = 0 ! specified, use first - IF (CLI$PRESENT('REVERSE')) BULL_POINT = NBULL - 1 ! or last - END IF - SUBJECT = CLI$PRESENT('SUBJECT') - IF (CLI$PRESENT('REVERSE')) THEN - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - END IF - END IF - - IF ((BULL_POINT+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (BULL_POINT+1.EQ.0)) THEN - WRITE (6,'('' ERROR: No more messages.'')') - CALL CLOSE_BULLDIR - CALL ENABLE_CTRL - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - CALL DECLARE_CTRLC_AST - - DO BULL_SEARCH = BULL_POINT+1, END_BULL, STEP_BULL - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1) THEN - CALL STR$UPCASE(DESCRIP,DESCRIP) ! Make upper case - IF (INDEX(DESCRIP,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND..NOT.SUBJECT) THEN - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - BULL_POINT = BULL_SEARCH - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - RETURN - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CALL ENABLE_CTRL - RETURN - END IF - END DO - END IF - END DO - -900 CALL CANCEL_CTRLC_AST - - CALL CLOSE_BULLFIL ! End of bulletin file read - CALL CLOSE_BULLDIR - - CALL ENABLE_CTRL - - WRITE (6,'('' No messages found with given search string.'')') - - RETURN - END - - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF (SYSTEM.LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')') - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END diff --git a/decus/vax90a/bulletin/bulletin3.for b/decus/vax90a/bulletin/bulletin3.for deleted file mode 100644 index 3c0510a..0000000 --- a/decus/vax90a/bulletin/bulletin3.for +++ /dev/null @@ -1,1594 +0,0 @@ -C -C BULLETIN3.FOR, Version 3/15/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*11 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF (SYSTEM.LE.3.OR.(OLD_SHUTDOWN.EQ.0! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - EXTIME(3:4) = EXTIME(4:5) - READ (EXTIME(1:4),'(I4)') NODE_NUMBER_MSG - EXTIME(9:10) = EXTIME(10:11) - READ (EXTIME(7:10),'(I4)') NODE_AREA_MSG - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - END IF - ELSE - DIFF = 1 - END IF - IF (DIFF.EQ.1) NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF (SYSTEM.LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 EXPDAT - CHARACTER*23 TODAY - - DIMENSION EXTIME(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF ((DEFAULT_EXPIRE.GT.F_EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3)) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER) THEN - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:),TODAY(13:)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) ! Convert to upper case - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0.AND. - & IER.EQ.SS$_NORMAL) THEN - CALL DISABLE_PRIVS - IF (OUT.EQ.INFILE) THEN - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT))) - ELSE - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - END IF - CALL ENABLE_PRIVS - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0.OR. - & IER.NE.SS$_NORMAL) THEN - CALL EDT$EDIT(INFILE,OUT) - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN - CONTEXT = 0 - IER = LIB$FIND_FILE(INFILE,MAIL_EDIT,CONTEXT) - IF (.NOT.IER) THEN - CALL TPU$EDIT(' ',OUT) - ELSE - CALL TPU$EDIT(INFILE,OUT) - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - ! TPU does CLI$ stuff which wipes our parsed command line - END IF - - RETURN - END - - - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($JPIDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXIT - END IF - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1 - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP') - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0)) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM','NL:' - & ,,,,'BULLCP',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*1 DUMMY - - IER = SYS_TRNLNM('BULL_BULLCP',DUMMY) - IF (IER) BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - CHARACTER*23 OLD_TIME,NEW_TIME - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - DO WHILE (1) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - CALL SYS$SETAST(%VAL(1)) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Do empty block - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Cleanup deleted users from - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! data files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - - OLD_TIME = NEW_TIME - CALL WAIT('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL REGISTER_BULLCP - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER NODENAME*8 - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - END IF - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE WAIT(PARAM) -C -C SUBROUTINE WAIT -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(6:7) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(2)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(9:10) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - - SUBROUTINE DELETE_EXPIRED - -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER UPTIME_DATE*11,UPTIME_TIME*11 - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD.EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - IF (INDEX(INTO,FOLDER_BBOARD(:FLEN)).EQ.0.AND. - & INTO.NE.FOLDER_BBOARD.AND.INDEX(INTO,'@').EQ.0) THEN - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOLDER1_BBOARD = FOLDER_BBOARD - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - FOLDER_Q2_SAVE = FOLDER_Q2 - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - FLEN = TRIM(FOLDER1_BBOARD) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD.NE.'NONE') THEN - IF (INTO.EQ.FOLDER1_BBOARD) THEN - FOUND = .TRUE. - ELSE - FIND_TO = INDEX(INTO,FOLDER1_BBOARD(:FLEN)) - IF (FIND_TO.GT.0) THEN - END_TO = FLEN+FIND_TO - IF (TRIM(INTO).LT.END_TO.OR. - & INTO(END_TO:END_TO).LT.'A'.OR. - & INTO(END_TO:END_TO).GT.'Z') THEN - IF (FIND_TO.EQ.1) THEN - FOUND = .TRUE. - ELSE IF (INTO(FIND_TO-1:FIND_TO-1).LT.'A'.OR. - & INTO(FIND_TO-1:FIND_TO-1).GT.'Z') THEN - FOUND = .TRUE. - END IF - END IF - END IF - END IF - END IF - END DO - IF (FOUND) THEN - FOLDER_COM = FOLDER1_COM - FOLDER_Q_SAVE = FOLDER_Q2_SAVE - END IF - END IF - - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=14) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - WRITE (6,1030) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*37,FILENAME*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - OFFSET = 36 - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='VMSMAIL', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - OFFSET = 34 - END IF - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::') THEN - ! If normal BBOARD or /VMSMAIL - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - CALL LIB$MOVC3(2,%REF(INPUT(OFFSET:)),COUNT) - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END diff --git a/decus/vax90a/bulletin/bulletin4.for b/decus/vax90a/bulletin/bulletin4.for deleted file mode 100644 index d86064c..0000000 --- a/decus/vax90a/bulletin/bulletin4.for +++ /dev/null @@ -1,1703 +0,0 @@ -C -C BULLETIN4.FOR, Version 8/2/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist -C if it creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - READ (4,IOSTAT=IER) USER_ENTRY ! Skip header - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':') THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - DATA POINT/0/ - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = 0 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - IBLOCK = SBLOCK ! Initialize pointers. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,ILEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C ILEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns ILEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(LINE_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? - IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - ILEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - ILEN = -1 ! ILEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - ILEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - BUFFER = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) ! Output line. - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(ILEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - ILEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - ILEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (ILEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = ILEN - (BRECLEN-POINT) ! Store leftover length - ILEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (ILEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(ILEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - ILEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - ILEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - IF (BTEST(FOLDER_FLAG,1)) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -900 CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - CALL WRITEDIR(0,IER) - -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - - LENGTH = 0 ! Init special variable - DTYPE = 0 ! descriptor so we won't - CLASS = 2 ! run into any memory limit - POINTER = 0 ! during input. - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privileged - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'( - & '' ERROR: No privs for SYSTEM, NOTIFY, BRIEF or READNEW.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - LENDES = 0 - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_OWNER = FOLDER1_OWNER - END IF - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_OWNER = FOLDER1_OWNER - - IF (CLI$PRESENT('SYSTEM')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - diff --git a/decus/vax90a/bulletin/bulletin5.for b/decus/vax90a/bulletin/bulletin5.for deleted file mode 100644 index 40dcd71..0000000 --- a/decus/vax90a/bulletin/bulletin5.for +++ /dev/null @@ -1,1614 +0,0 @@ -C -C BULLETIN5.FOR, Version 2/12/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_NEGATED - - IF (.NOT.SETPRV_PRIV().AND.INCMD(:3).EQ.'SET') THEN - WRITE (6,'( - & '' ERROR: No privs to change all defaults.'')') - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - - FLAG = 0 - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',TEMP_USER) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',TEMP_USER) - END IF - READ (TEMP_USER(:1),'(I1)',IOSTAT=IER) FLAG - - IF (NOTIFY.EQ.1.AND.BTEST(FLAG,1).AND. - & CLI$PRESENT('CLUSTER').EQ.%LOC(CLI$_NEGATED)) THEN - CALL OPEN_BULLNOTIFY - READ (10,KEY='*',IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=10) - FLAG = -1 - END IF - - IF (BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - IF (FLAG.EQ.-1) WRITE (10,IOSTAT=IER) TEMP_USER - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - IF (FLAG.EQ.-1) THEN - CALL CLOSE_BULLNOTIFY - ELSE IF (NOTIFY.EQ.1.AND.BTEST(FLAG,1).AND. - & CLI$PRESENT('CLUSTER').NE.%LOC(CLI$_NEGATED)) THEN - WRITE (6,'('' NOTE: In a cluster, /ALL or /DEFAULT '', - & ''causes all users to be notified.'')') - WRITE (6,'('' They will not be able to disable this.'', - & '' See HELP SET NOTIFY for more info.'')') - CALL OPEN_BULLNOTIFY - CALL CLOSE_BULLNOTIFY_DELETE - CALL OPEN_BULLNOTIFY - WRITE (10) '* ' - CALL CLOSE_BULLNOTIFY - ELSE IF (NOTIFY.EQ.0.AND.BTEST(FLAG,1)) THEN - CALL OPEN_BULLNOTIFY - READ (10,IOSTAT=IER) TEMP_USER - IF ((IER.EQ.0.AND.TEMP_USER.EQ.'*').OR. - & (BRIEF.NE.-1.AND.READNEW.NE.-1)) THEN - CALL CLOSE_BULLNOTIFY_DELETE - ELSE - CALL CLOSE_BULLNOTIFY - END IF - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL OPEN_BULLNOTIFY - CALL CLOSE_BULLNOTIFY_DELETE - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - FOLDER_SET = .FALSE. - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - EXTERNAL CLI$_ABSENT - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1) - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - - IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP - END IF - - CALL CLOSE_BULLFOLDER - END IF - - IF (IER.EQ.0.AND.FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD)) - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Copy remote folder protection - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - ELSE - LOCAL_FOLDER1_FLAG = IBCLR(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - END IF - REMOTE_SET = .TRUE. - END IF - - IF (IER.EQ.0) THEN ! Folder found - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::' - & .AND..NOT.SETPRV_PRIV()) THEN - ! Is folder protected and not remote? - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND. - & IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (FOLDER1_BBOARD(:2).NE.'::') THEN - IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - END IF - - IF (IER) THEN - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0) THEN - IF (TEST_BULLCP()) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (FOLDER_NUMBER.GE.0.AND.CLI$PRESENT('MARKED')) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - IF (INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only marked messages'', - & '' will be shown.'')') - ELSE - WRITE(6,'('' ERROR: No marked messages found.'')') - END IF - END IF - ELSE - READ_TAG = .FALSE. - END IF - END IF - - IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - RETURN - - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*25 FOLDER_SAVE - - DIMENSION DUMMY(2) - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - END IF - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.LOGIN_SWITCH) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - END IF - IER = 0 - END IF - - RETURN - END - - - - - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & FOLDER1 = FOLDER - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Folder is a private folder.'')') - ELSE - WRITE (6,'('' Folder is not a private folder.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is BRIEF.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is SHOWNEW.'')') - ELSE - WRITE (6,'('' Default is NOREADNEW.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY.'')') - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - CHARACTER*17 DATETIME - - IF (FOLDER_COUNT.GT.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE specified - ELSE - NLINE = 1 - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDER = 0 - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (INDEX(FOLDER1_BBOARD,'::').EQ.0.AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - - IF (.NOT.PAGING) THEN - DISPLAY = (NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2 - ELSE - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2,PAGE_LENGTH-4) - ! If more entries than page size, truncate output - END IF - - DO I=FOLDER_COUNT,FOLDER_COUNT+(DISPLAY-2)/NLINE-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counter - END DO - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = 0 ! Yes. Set counter to 0. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*1 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ELSE - ID = INPUT - INPUT = ' ' - END IF - ILEN = TRIM(ID) - IF (ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - CALL OPEN_BULLFOLDER ! Open folder file - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - ENTRY WRITE_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE - - REWRITE (7) FOLDER_COM - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP - - REWRITE (7) FOLDER1_COM - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END DO - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - SET_FLAG(1) = SET_FLAG_DEF(1) - SET_FLAG(2) = SET_FLAG_DEF(2) - BRIEF_FLAG(1) = BRIEF_FLAG_DEF(1) - BRIEF_FLAG(2) = BRIEF_FLAG_DEF(2) - NOTIFY_FLAG(1) = NOTIFY_FLAG_DEF(1) - NOTIFY_FLAG(2) = NOTIFY_FLAG_DEF(2) - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END diff --git a/decus/vax90a/bulletin/bulletin6.for b/decus/vax90a/bulletin/bulletin6.for deleted file mode 100644 index f567bff..0000000 --- a/decus/vax90a/bulletin/bulletin6.for +++ /dev/null @@ -1,1586 +0,0 @@ -C -C BULLETIN6.FOR, Version 10/26/89 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - DATA LUN /0/ - - ENTRY CLOSE_BULLNOTIFY - LUN = LUN + 1 ! Unit = 10 - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - DATA LUN /0/ - - ENTRY CLOSE_BULLNOTIFY_DELETE - LUN = LUN + 8 ! Unit = 10 - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - DATA LUN /0/ - - LUN = UNIT - 10 ! 10 gets added to LUN - - ENTRY OPEN_BULLNOTIFY - LUN = LUN + 1 ! Unit = 10 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.10) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=10,STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=3, - & ORGANIZATION='INDEXED',KEY=(1:12:CHARACTER), - & FORM='UNFORMATTED', - & FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.NOTIFY') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','notify'/ - INTEGER NAME(10) - DATA NAME/1,2,0,3,0,0,4,0,5,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - CHARACTER*25 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNOTIFY_SHARED - LUN = LUN + 1 ! Unit = 10 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_POINT - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - - IF (IER.EQ.0) THEN - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.FOLDER_RECORD/4) THEN - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(ASK_SIZE) - NTRIES = 0 - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.10) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=10,STATUS='OLD',IOSTAT=IER, - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=3, - & ORGANIZATION='INDEXED',KEY=(1:12:CHARACTER), - & FORM='UNFORMATTED', - & FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.NOTIFY') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - CALL OPEN_FILE(LUN) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE_SHARE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*115 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(1:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(1:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(78:81) = BUFFER(85:) - BULLDIR_ENTRY(90:97) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(ASK_SIZE) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*80 NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - - EODIR = MAX(INDEX(BULLFOLDER_FILE,':'),INDEX(BULLFOLDER_FILE,']')) - SUFFIX = INDEX(BULLFOLDER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLFOLDER_FILE(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.173/4) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - IF (IER.EQ.0) THEN - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,BULLFOLDER_FILE) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*3 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - DIR_NUM = 0 - END IF - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,0 - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_HEADER_FROMBIN - RETURN - END IF - END IF - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' ') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I3)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (MSG_NUM.NE.ICOUNT) IER = 36 - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) BULLDIR_ENTRY - END IF - END DO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - DIR_NUM = -1 - END IF - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - END IF - END IF - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - UNLOCK 2 - - RETURN - - END - - - - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If not 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) BULLDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - IER = 0 - DIR_NUM = -1 - END IF - UNLOCK 2 - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - IER = MSG_NUM - CALL CONVERT_ENTRY_FROMBIN - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME - NEWEST_EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME - NEWEST_TIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME - SHUTDOWN_TIME = DATETIME(13:) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME - EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME - TIME = DATETIME(13:) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - INCLUDE 'BULLDIR.INC' - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - ELSE - IF (CONV) CALL CONVERT_ENTRY_TOBIN - MSG_NUM = BULLETIN_NUM - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - - RETURN - END - - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*) - CHARACTER NOT_ID*3 - DATA NOT_ID /'=[,'/ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - DO WHILE - & (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0) - START_ID = START_ID - 1 - END DO - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = RECL/8 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*255 - - CHARACTER*(*) INFILE,OUTFILE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl output - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C -C SUBROUTINE COPY_ACL1 -C -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,) - ! Read input file acl - - CALL INIT_ITMLST ! Initialize item list - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END diff --git a/decus/vax90a/bulletin/bulletin7.for b/decus/vax90a/bulletin/bulletin7.for deleted file mode 100644 index f9b970d..0000000 --- a/decus/vax90a/bulletin/bulletin7.for +++ /dev/null @@ -1,1845 +0,0 @@ - -C -C BULLETIN7.FOR, Version 4/3/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - INCLUDE '($SSDEF)' - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - CHARACTER OUTPUT*160,TERMINAL*7,FLAGS*1 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (FOLDER_NUMBER.GT.0) THEN ! Folder private? - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER(1:TRIM(FOLDER)) - & //'. From: '//FROM(1:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - FLAG = 0 - BFLAG = 0 - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (IER) THEN - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) THEN ! Node part of cluster? - CALL OPEN_BULLNOTIFY_SHARED ! Yes, get notify list. - DO WHILE (REC_LOCK(IER1)) ! Any entries? - READ (10,IOSTAT=IER1) TEMP_USER - END DO - IF (IER1.NE.0) THEN ! No entries. - CALL READ_USER_FILE(IER) ! Create entries from - DO WHILE (IER.EQ.0) ! user file. - IF (TEMP_USER(:1).NE.':'.AND.TEMP_USER(:1).NE.'*' - & .AND.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (10) TEMP_USER - END IF - CALL READ_USER_FILE(IER) - END DO - DO WHILE (REC_LOCK(IER1)) ! Reset to first entry. - READ (10,KEYGT=' ',IOSTAT=IER1) - & TEMP_USER - END DO - END IF - - BFLAG = BRK$M_CLUSTER ! Broadcast to all nodes - - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER_NUMBER).AND. ! If /ALL then - & TEMP_USER.EQ.'*'.AND.IER1.EQ.0) THEN ! notify all. - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & ,%VAL(BRK$C_ALLUSERS),,,%VAL(BFLAG),,,,) - IER1 = 1 ! Don't have to loop through notify list - END IF - END IF - END IF - - DO WHILE ((BFLAG.EQ.0.AND.GETUSERS(TEMP_USER,TERMINAL)).OR. - & (BFLAG.NE.0.AND.IER1.EQ.0)) - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - IF (BFLAG.EQ.0) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TERMINAL(:TRIM(TERMINAL)),%VAL(BRK$C_DEVICE) - & ,,,%VAL(BFLAG),,,,) - ELSE - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TEMP_USER(:TRIM(TEMP_USER)),%VAL(BRK$C_USERNAME) - & ,,,%VAL(BFLAG),,,,) - END IF - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USER//USER_ENTRY(13:) - END IF - ELSE IF (IER.NE.0.AND.BFLAG.NE.0) THEN - DELETE (UNIT=10) - END IF - IF (BFLAG.NE.0) THEN - DO WHILE (REC_LOCK(IER1)) - READ (10,IOSTAT=IER1) TEMP_USER - END DO - END IF - END DO - IF (BFLAG.NE.0) CALL CLOSE_BULLNOTIFY - CALL SYS$SETRWM(%VAL(0)) - END IF - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(1:11) - NEWEST_TIME = TODAY_TIME(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00.00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*11 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - - IF (FLAG.EQ.4) THEN ! If notify, see if cluster - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',TEMP_USER) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',TEMP_USER) - END IF - READ (TEMP_USER(:1),'(I1)',IOSTAT=IER) BFLAG - IF (BTEST(BFLAG,1).AND.IER.EQ.0) THEN - CALL OPEN_BULLNOTIFY_SHARED - DO WHILE (REC_LOCK(IER)) - READ (10,IOSTAT=IER) TEMP_USER - END DO - IF (TEMP_USER.NE.'*') THEN - IF (CMD) THEN - WRITE (10,IOSTAT=IER) USERNAME - ELSE - DO WHILE (REC_LOCK(IER)) - READ (10,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (UNIT=10) - END IF - END IF - CALL CLOSE_BULLNOTIFY - END IF - END IF - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW) -C -C SUBROUTINE CONFIRM_PRIV -C -C FUNCTION: Confirms that given username has SETPRV. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C ALLOW - Returns 1 if account has SETPRV. -C returns 0 if account has no SETPRV. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INCLUDE '($PRVDEF)' - - INCLUDE '($UAIDEF)' - - INTEGER DEF_PRIV(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_DEF_PRIV,%LOC(DEF_PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - ALLOW = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(DEF_PRIV(1),PRV$V_SETPRV).OR. ! SETPRV or CMRKNL - & BTEST(DEF_PRIV(1),PRV$V_CMKRNL)) THEN ! privileges? - ALLOW = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM) OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:TRIM(INPUT)),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM) OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - CALL UPDATE_USERINFO - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FILENAME*132,BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - NBLOCK = NBLOCK + LENGTH - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*11 DATE_SAVE,EXDATE_SAVE - CHARACTER*11 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - WRITE (6,'('' For the selected folder '',A)') FOLDER(1:TRIM(FOLDER)) - - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - END IF - - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND. - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (.NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER USERNAME*(*),TERMINAL*(*) - - DATA WILDCARD /-1/ - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) WILDCARD = -1 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,0:FOLDER_MAX-1) - DATA USERINFO_READ /.FALSE./ - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IF - END DO - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_BULLUSER - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM,OLD_LAST_READ_BTIM) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,0:FOLDER_MAX-1) - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - FNUM = 0 - - DO WHILE (.NOT.DIFF.AND.FNUM.LT.FOLDER_MAX) - DIFF = LAST_READ_BTIM(1,FNUM).NE.OLD_LAST_READ_BTIM(1,FNUM) - IF (.NOT.DIFF) THEN - DIFF = LAST_READ_BTIM(2,FNUM).NE.OLD_LAST_READ_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1 - END DO - - IF (.NOT.DIFF) RETURN - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - IF (TRIM(TIME).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO FOLDER_NUMBER = 0,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO FOLDER_NUMBER = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(1:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - IF (NEW_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new GENERAL messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO FOLDER_NUMBER = 0,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (FOLDER_NUMBER.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - ELSE IF (FOLDER_NUMBER.EQ.0.OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/,SAVE_FOLDER_NUM/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - DO WHILE (IER.EQ.0) - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2).AND.IER.EQ.0) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE - END IF - IF (IER.NE.0) THEN - CALL CHANGE_FLAG_NOCMD(0,2) - CALL CHANGE_FLAG_NOCMD(0,3) - CALL CHANGE_FLAG_NOCMD(0,4) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = 0 - CALL MODIFY_SYSTEM_LIST(0) - END IF - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - FOLDER_NUMBER = FOLDER_NUMBER + 1 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - SAVE_FOLDER_NUM = FOLDER_NUMBER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = -1 - FOLDER1 = 'GENERAL' - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to GENERAL folder.'')') - - RETURN - END diff --git a/decus/vax90a/bulletin/bulletin8.for b/decus/vax90a/bulletin/bulletin8.for deleted file mode 100644 index 64a3bb0..0000000 --- a/decus/vax90a/bulletin/bulletin8.for +++ /dev/null @@ -1,1567 +0,0 @@ -C -C BULLETIN8.FOR, Version 3/22/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - CHARACTER NAMEDESC*9 /'BULLETIN1'/ - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*9 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN),IO$_READVBLK,MBX_IOSB, - & MBX_AST,,MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*6,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL CONNECT(NODENAME,USERNAME,FROMNAME) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(200),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - CHARACTER*128 INPUT - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - - IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL EXECUTE_COMMAND(UNIT_INDEX) - - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - - RETURN - END - - - - - - SUBROUTINE CONNECT(NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/ - - CHARACTER*(*) USERNAME,FROMNAME - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IF (REJECT.NE.IO_REJECT) THEN - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL ENABLE_CTRL_EXIT,SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - PARAMETER TIMEOUT = -10*1000*1000*30 - DIMENSION TIMEBUF(2) - DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*53 - CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - BULLCP_PRIV(1) = PROCPRIV(1) - BULLCP_PRIV(2) = PROCPRIV(2) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDER_NAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - NODENAME = NODE_SAVE(UNIT_INDEX) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15) THEN ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USERNAME,PRIV_SAVE(1,UNIT_INDEX)) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - PRIV_SAVE(1,UNIT_INDEX) = PROCPRIV(1) - PRIV_SAVE(2,UNIT_INDEX) = PROCPRIV(2) - END IF - END IF - END IF - - IF (CMD_TYPE.EQ.1) THEN ! Select folder - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:5))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:9))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - END IF - BUFFER = BUFFER(:16)//FOLDER_COM - CALL WRITE_CHAN(16+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - FOLDER_NAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP)) - CALL LIB$MOVC3(11,%REF(BUFFER(58:58)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(69:69)),%REF(EXTIME)) - CALL LIB$MOVC3(4,%REF(BUFFER(80:80)),SYSTEM) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (SYSTEM.NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF (SYSTEM.NE.0.AND..NOT.SETPRV_PRIV()) THEN ! Priv test - IF (FOLDER_OWNER.NE.USERNAME) THEN - SYSTEM = 0 - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(84:84)),BROAD) - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(88:88)),BELL) - CALL LIB$MOVC3(4,%REF(BUFFER(92:92)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(97:97)),CLUSTER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND.(TEMP_USER(2:).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT, - & %VAL(1)) - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - IER = SYS$CANTIM(%VAL(1),) - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:9)),%REF(MSG_KEY(1:1))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),EBULL) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP_TEMP)) - CALL LIB$MOVC3(4,%REF(BUFFER(58:58)),ICOUNT) - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(53,%REF(BUFFER(62:62)),%REF(DESCRIP)) - CALL LIB$MOVC3(4,%REF(BUFFER(115:115)),%REF(MSGTYPE)) - CALL LIB$MOVC3(11,%REF(BUFFER(119:119)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(130:130)),%REF(EXTIME)) - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE) - DESCRIP_TEMP = BUFFER(9:61) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(11,%REF(BUFFER(62:62)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(73:73)),%REF(EXTIME)) - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:5)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:13)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:1))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:13)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:17)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:21)),FOLDER_NUMBER) - FOLDER = BUFFER(25:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - END IF - -1000 PROCPRIV(1) = BULLCP_PRIV(1) - PROCPRIV(2) = BULLCP_PRIV(2) - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.GE.0) RETURN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) THEN - PROCPRIV(1) = NEEDPRIV(1) - PROCPRIV(2) = NEEDPRIV(2) - END IF - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (INDEX(NODES(NODE_NUM),'::').GT.0) THEN ! Remove :: if - NLEN = INDEX(NODES(NODE_NUM),'::') - 1 ! addedd - END IF - IF (LOCAL_NODE(1:L_NODE).EQ.NODES(NODE_NUM)(1:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(1:NLEN)//'""::' - & //'"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - - RETURN - END diff --git a/decus/vax90a/bulletin/bulletin9.for b/decus/vax90a/bulletin/bulletin9.for deleted file mode 100644 index b4ae874..0000000 --- a/decus/vax90a/bulletin/bulletin9.for +++ /dev/null @@ -1,1860 +0,0 @@ -C -C BULLETIN9.FOR, Version 2/6/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER PASSWORD*31,INLINE*80,DEFAULT_USER*12 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('USERNAME',DEFAULT_USER) - IF (.NOT.IER) DEFAULT_USER = USERNAME - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - SEMI = INDEX(NODES(POINT_NODE),'::') ! Look for semicolon after node - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - IF (SEMI.GT.0) THEN ! Is semicolon present? - IF (NLEN.GT.SEMI+1) THEN ! Yes, is username after node? - TEMP_USER = NODES(POINT_NODE)(SEMI+2:) ! Yes, set username - NLEN = SEMI - 1 ! Remove semicolon - ELSE ! No username after nodename - TEMP_USER = DEFAULT_USER ! Set username to default - NLEN = SEMI - 1 ! Remove semicolon - SEMI = 0 ! Indicate no username - END IF - ELSE ! No semicolon present - TEMP_USER = DEFAULT_USER ! Set username to default - END IF - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))// - & '"/USERNAME='//TEMP_USER(:TRIM(TEMP_USER)) - IF (CLI$PRESENT('USERNAME').OR.SEMI.GT.0) THEN ! If username was - IER = 1 ! specified, prompt for password - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(POINT_NODE),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) GO TO 910 - OPEN (UNIT=10+NODE_NUM,NAME=NODES(POINT_NODE)(:NLEN) - & //'"'//TEMP_USER(1:TRIM(TEMP_USER))//' '// - & PASSWORD(1:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10+NODE_NUM) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FLAGNAME - - IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=13,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(13,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=13) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (13,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(13,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=13,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=13) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=13) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - INCLUDE '($SMGDEF)' - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - INCLUDE '($HLPDEF)' - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - ELSE - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - END IF - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,DISPLAY_ID,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA DISPLAY_ID/0/,KEYBOARD_ID/0/ - - IER = SMG$CREATE_PASTEBOARD(PASTEBOARD_ID) ! Initialize terminal - IF (DISPLAY_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_DISPLAY(PAGE_LENGTH, - & PAGE_WIDTH,DISPLAY_ID) - END IF - IER = SMG$PASTE_VIRTUAL_DISPLAY(DISPLAY_ID,PASTEBOARD_ID,1,1) - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (1) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LBR$CLOSE(LINDEX) ! then close library, - CALL SMG$UNPASTE_VIRTUAL_DISPLAY(DISPLAY_ID,PASTEBOARD_ID) - ! remove virtual display - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,DISPLAY_ID,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = SMG$ERASE_DISPLAY(DISPLAY_ID) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = SMG$ERASE_DISPLAY(DISPLAY_ID) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - CHARACTER VERSION*10,DATE*23 - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - END - - - - - - - SUBROUTINE TAG(ADD_OR_DEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - IER1 = 0 - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT).AND.IER1.EQ.0) ! Get the specified messages - - DECODE(LEN_P,'(I)',BULL_PARAMETER) MESSAGE_NUMBER - - CALL READDIR(MESSAGE_NUMBER,IER) ! Get info for bulletin - - IF (IER.NE.MESSAGE_NUMBER+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER1) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Message '',I, - & '' was not marked.'')') MESSAGE_NUMBER - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found.') - - END - - - - SUBROUTINE ADD_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 TAG_KEY - - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY) - - IF (IER.EQ.FOR$IOS_INCKEYCHG) THEN - WRITE (6,'('' Message was already marked.'')') - ELSE IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to add mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE DEL_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 TAG_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - END DO - IF (IER.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to delete mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER) RETURN - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE='BULL_MARK:'// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (IER.EQ.0) BULL_TAG = .TRUE. - - RETURN - END - - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 BULL_MARK - - IER = SYS_TRNLNM('BULL_MARK',BULL_MARK) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: BULL_MARK must be defined.'', - & '' See HELP MARK.'')') - RETURN - ELSE - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1.OR.BULL_MARK.NE.BULL_PARAMETER) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = 0 - END IF - OPEN (UNIT=13,FILE='BULL_MARK:'// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - BULL_TAG = .TRUE. - IER = 1 - END IF - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - GO TO 10 - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - HEADER = .FALSE. - -10 DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - & INPUT_KEY - END DO - - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (FOLDER1_NUMBER.NE.FOLDER_NUMBER.OR.IER.NE.0) THEN - IER = 1 - UNLOCK 13 - RETURN - ELSE - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL OPEN_BULLDIR - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - RETURN - ELSE - DELETE (UNIT=13) - IER = 1 - END IF - END IF - - END DO - - END - - - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. Added per request of a faculty member for his private -C board. Changes to BULLETIN.FOR should be fairly obvious. -C -C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2) -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - DATA FOLDER_Q1/0/ - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - WRITE (6,1000) - WRITE (6,1020) - DO J = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - WRITE (6,1030) FOLDER1(:15),F1_NBULL, - & FOLDER1_DESCRIP(:MIN(TRIM(FOLDER1_DESCRIP),59)) - END DO - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - READ_TAG = .FALSE. - IF (CLI$PRESENT('MARKED')) READ_TAG = .TRUE. - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - IF (DIR_COUNT.EQ.0) THEN - F1_NBULL = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1020 FORMAT (' Name Count Description'/) -1030 FORMAT (1X,A15,I5,1X,A) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') - - END - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - DIMENSION NOLOGIN_BTIM(2) - - CHARACTER*17 DATETIME - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV_PRIV().AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to user command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - CALL OPEN_BULLUSER_SHARED - - IF (.NOT.ALL) THEN - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - ELSE - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(LINE_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER_FROM/ OLD_BUFFER_FROM - DATA OLD_BUFFER_FROM /.FALSE./ - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - RETURN - ELSE - IER = 1 - END IF - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - ELSE - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1) - IF (IER1.NE.0) THEN - OPEN (UNIT=3,STATUS='SCRATCH',FILE='BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - CALL STRIP_HEADER(INPUT,0,IER1) - - OLD_BUFFER = ' ' - - OLD_BUFFER_FROM = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - CHARACTER*255 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /STRIP_HEADER/ STRIP - DATA STRIP/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(LINE_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER_FROM/ OLD_BUFFER_FROM - DATA OLD_BUFFER_FROM /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:LEN_BUFFER) - IF (OLD_BUFFER_FROM.AND.BUFFER(:1).EQ.' ') THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER - OLD_BUFFER_FROM = .FALSE. - ELSE IF (BUFFER(:5).EQ.'From:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.OR.LEN_BUFFER.EQ.0) THEN - IF (BUFFER(:9).EQ.'Reply-to:') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0.AND.SAVE_IN_FROM.EQ.' ') THEN - CALL GETUSER(SAVE_IN_FROM) - END IF - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - CALL WRITEOUT_STORED - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF (.NOT.STRIP) THEN - CALL STORE_BULL(1,' ',NBLOCK) ! just store one space - ELSE - CALL STRIP_HEADER(BUFFER,LEN_BUFFER,IER) - OLD_BUFFER = ' ' - END IF - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (STRIP) THEN - CALL STRIP_HEADER(BUFFER,LEN_BUFFER,IER) - IF (IER) THEN - OLD_BUFFER = BUFFER - RETURN - ELSE - IF (TRIM(OLD_BUFFER).GT.0) THEN - CALL STORE_BULL(TRIM(OLD_BUFFER),OLD_BUFFER,NBLOCK) - END IF - STRIP = .FALSE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - TEXT = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /STRIP_HEADER/ STRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - STRIP = .TRUE. ! Reset strip flag - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - RETURN - END IF - - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - EXTIME = '00:00:00.00' - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(LINE_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.'''') THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - IF (INDEX(INFROM,'<').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<'):) ! personal-name - END IF - - IF (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name) - & INDEX(INFROM,'@').GT.INDEX(INFROM,'(')) THEN - INFROM = INFROM(INDEX(INFROM,'(')+1:) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'"')) - I = I + 1 - END DO - INFROM = INFROM(I:) - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.12.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'"') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,I-1 - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) BUFFER - - INCLUDE 'BULLFOLDER.INC' - - IF (.NOT.BTEST(FOLDER_FLAG,4).OR.TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - RETURN - END IF - - IF (BLEN.EQ.0) CONT_LINE = .FALSE. - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header line - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - - RETURN - END diff --git a/decus/vax90a/bulletin/bulletin_wheretoget.txt b/decus/vax90a/bulletin/bulletin_wheretoget.txt deleted file mode 100644 index c6ea706..0000000 --- a/decus/vax90a/bulletin/bulletin_wheretoget.txt +++ /dev/null @@ -1,26 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 6-JUN-1990 16:36:59.33 -To: MRGATE::"ARISIA::EVERHART" -CC: -Subj: Re: BULLETIN - -Received: by crdgw1.ge.com (5.57/GE 1.70) - id AA02928; Wed, 6 Jun 90 15:59:18 EDT -Received: From NERUS.PFC.MIT.EDU by CRVAX.SRI.COM with TCP; Wed, 6 JUN 90 04:48:03 PDT -Message-Id: <83766B684CBFC02D63@NERUS.PFC.MIT.EDU> -Date: Wed, 6 Jun 90 07:46 EST -From: MRL@NERUS.PFC.MIT.EDU -Subject: Re: BULLETIN -To: MSD@ENH.NIST.GOV, INFO-VAX@KL.SRI.COM -X-Envelope-To: INFO-VAX@KL.SRI.COM -X-Vms-To: IN%"MSD@ENH.NIST.GOV",IN%"INFO-VAX@KL.SRI.COM" - -The new address for getting BULLETIN is BULLETIN@NERUS.PFC.MIT.EDU. - -Valid commands are: - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - Mark - diff --git a/decus/vax90a/bulletin/bullfiles.inc b/decus/vax90a/bulletin/bullfiles.inc deleted file mode 100644 index 33021bc..0000000 --- a/decus/vax90a/bulletin/bullfiles.inc +++ /dev/null @@ -1,28 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF IT -C IS NOT, THEN THEY SHOULD ALSO BE CHANGED. -C - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ diff --git a/decus/vax90a/bulletin/bullfolder.inc b/decus/vax90a/bulletin/bullfolder.inc deleted file mode 100644 index 6e31f77..0000000 --- a/decus/vax90a/bulletin/bullfolder.inc +++ /dev/null @@ -1,46 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,FILLER, - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) diff --git a/decus/vax90a/bulletin/bullmain.cld b/decus/vax90a/bulletin/bullmain.cld deleted file mode 100644 index 6f23cd7..0000000 --- a/decus/vax90a/bulletin/bullmain.cld +++ /dev/null @@ -1,26 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER,DEFAULT="7") diff --git a/decus/vax90a/bulletin/bullstart.com b/decus/vax90a/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vax90a/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vax90a/bulletin/bulluser.inc b/decus/vax90a/bulletin/bulluser.inc deleted file mode 100644 index 04dc139..0000000 --- a/decus/vax90a/bulletin/bulluser.inc +++ /dev/null @@ -1,42 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Bit set indicates new message in folder - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vax90a/bulletin/create.com b/decus/vax90a/bulletin/create.com deleted file mode 100644 index ec2a1a4..0000000 --- a/decus/vax90a/bulletin/create.com +++ /dev/null @@ -1,19 +0,0 @@ -$ FORTRAN/EXTEND BULLETIN -$ FORTRAN/EXTEND BULLETIN0 -$ FORTRAN/EXTEND BULLETIN1 -$ FORTRAN/EXTEND BULLETIN2 -$ FORTRAN/EXTEND BULLETIN3 -$ FORTRAN/EXTEND BULLETIN4 -$ FORTRAN/EXTEND BULLETIN5 -$ FORTRAN/EXTEND BULLETIN6 -$ FORTRAN/EXTEND BULLETIN7 -$ FORTRAN/EXTEND BULLETIN8 -$ FORTRAN/EXTEND BULLETIN9 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB; -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIB/CREATE BULL -$ LIB BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vax90a/bulletin/dclremote.com b/decus/vax90a/bulletin/dclremote.com deleted file mode 100644 index 97f40f0..0000000 --- a/decus/vax90a/bulletin/dclremote.com +++ /dev/null @@ -1,32 +0,0 @@ -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET diff --git a/decus/vax90a/bulletin/handout.txt b/decus/vax90a/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vax90a/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vax90a/bulletin/install.com b/decus/vax90a/bulletin/install.com deleted file mode 100644 index 7f61965..0000000 --- a/decus/vax90a/bulletin/install.com +++ /dev/null @@ -1,18 +0,0 @@ -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIB/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIB/CREATE/HELP SYS$HELP:BULL -$ LIB/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIB/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vax90a/bulletin/install_remote.com b/decus/vax90a/bulletin/install_remote.com deleted file mode 100644 index 5e9e9aa..0000000 --- a/decus/vax90a/bulletin/install_remote.com +++ /dev/null @@ -1,130 +0,0 @@ -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL diff --git a/decus/vax90a/bulletin/instruct.com b/decus/vax90a/bulletin/instruct.com deleted file mode 100644 index 49627f6..0000000 --- a/decus/vax90a/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vax90a/bulletin/instruct.txt b/decus/vax90a/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vax90a/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vax90a/bulletin/login.com b/decus/vax90a/bulletin/login.com deleted file mode 100644 index e4302af..0000000 --- a/decus/vax90a/bulletin/login.com +++ /dev/null @@ -1,28 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vax90a/bulletin/makefile b/decus/vax90a/bulletin/makefile deleted file mode 100644 index 04dad89..0000000 --- a/decus/vax90a/bulletin/makefile +++ /dev/null @@ -1,74 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V1.81" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin9.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vax90a/bulletin/nonsystem.txt b/decus/vax90a/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vax90a/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vax90a/bulletin/pmdf.com b/decus/vax90a/bulletin/pmdf.com deleted file mode 100644 index 291f8c9..0000000 --- a/decus/vax90a/bulletin/pmdf.com +++ /dev/null @@ -1,743 +0,0 @@ -$set nover -$copy sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE '[-]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE '[-]APFILES.INC', - %INCLUDE '[-]MMFILES.INC', - %INCLUDE '[-]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE '[-]UTILCONST.INC' - %INCLUDE '[-]OSCONST.INC' - %INCLUDE '[-]APCONST.INC' - %INCLUDE '[-]MMCONST.INC' - %INCLUDE '[-]HECONST.INC' - %INCLUDE '[-]LOGCONST.INC' - %INCLUDE '[-]SYCONST.INC' - - TYPE - %INCLUDE '[-]UTILTYPE.INC' - %INCLUDE '[-]OSTYPE.INC' - %INCLUDE '[-]APTYPE.INC' - %INCLUDE '[-]SYTYPE.INC' - %INCLUDE '[-]MMTYPE.INC' - %INCLUDE '[-]HETYPE.INC' - %INCLUDE '[-]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE '[-]UTILVAR.INC' - %INCLUDE '[-]OSVAR.INC' - %INCLUDE '[-]APVAR.INC' - %INCLUDE '[-]QUVAR.INC' - %INCLUDE '[-]MMVAR.INC' - %INCLUDE '[-]HEVAR.INC' - %INCLUDE '[-]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - %INCLUDE '[-]UTILDEF.INC' - %INCLUDE '[-]OSDEF.INC' - %INCLUDE '[-]APDEF.INC' - %INCLUDE '[-]HEDEF.INC' - %INCLUDE '[-]LOGDEF.INC' - %INCLUDE '[-]MMDEF.INC' - %INCLUDE '[-]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - 'IN%',' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy sys$input PMDF.TXT -$deck -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows: - - LINK BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - -and put the .EXE in PMDF_ROOT:[EXE]. Put the new MASTER.COM in PMDF_ROOT:[EXE]. -NOTE: Check your MASTER.COM, as the latest version of PMDF contains the code -necessary to check for bulletin mail. However, it will not necessary have the -latest copy of BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders. After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vax90a/bulletin/remote.com b/decus/vax90a/bulletin/remote.com deleted file mode 100644 index 9ec5a2e..0000000 --- a/decus/vax90a/bulletin/remote.com +++ /dev/null @@ -1,48 +0,0 @@ -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP diff --git a/decus/vax90a/bulletin/writemsg.txt b/decus/vax90a/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vax90a/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vax90b1/bulletin-net90b/bulletin_bugfix0.src b/decus/vax90b1/bulletin-net90b/bulletin_bugfix0.src deleted file mode 100644 index 6647ef6..0000000 --- a/decus/vax90b1/bulletin-net90b/bulletin_bugfix0.src +++ /dev/null @@ -1,493 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::ALCVAX.PFC.MIT.EDU::MRL" 30-AUG-1990 11:22:34.01 -To: MRGATE::"ARISIA::EVERHART" -CC: -Subj: BULLETIN - -Received: by crdgw1.ge.com (5.57/GE 1.70) - id AA21066; Wed, 29 Aug 90 12:01:02 EDT -Message-Id: <4152189BA47F200043@ALCVAX.PFC.MIT.EDU> -Date: Wed, 29 Aug 90 11:52 EST -From: MRL@ALCVAX.PFC.MIT.EDU -Subject: BULLETIN -To: EVERHART@ARISIA.DECNET -X-Envelope-To: EVERHART%ARISIA.DECNET@CRDGW1.GE.COM -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -There is a major bug in the CHANGE command. If it used on a message, the text -of the message might get written over when another message in the same folder -is added or changed. I am including the modified routine (extracted from -BULLETIN2.FOR). Simply compile it, insert it into BULL.OLB, and the relink -BULLETIN. - -Note: I plan to have time next month to work on BULLETIN. Any requests for -new features should be submitted to me now (I've stored all the previous -requests, so you don't have to resend them.) - - Mark - MRL@NERUS.PFC.MIT.EDU ------------------------------------------------------------------------------ - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: Replaces existing bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH) - CHARACTER*1 ANSWER - - CHARACTER DATE_SAVE*11,TIME_SAVE*11 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL*1 DOALL - -C -C Get the bulletin number to be replaced. -C - IF (.NOT.CLI$PRESENT('NUMBER')) THEN ! No number has been specified - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - NUMBER_PARAM = BULL_POINT ! Replace the bulletin we are reading - ELSE - CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) NUMBER_PARAM - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for specified bulletin - - CALL CLOSE_BULLDIR - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Was bulletin found? - WRITE (6,1015) ! If not, tell the person - RETURN ! and error out - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EXTRACT') - - IF (TEXT) THEN - IF (.NOT.((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If no /EDIT - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - END IF - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.TEXT).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - REC1 = 0 - - LENFROM = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN2 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file@ - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IFV - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVSa - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')r - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1')m - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',p - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')L - ELSE IF (LEN_P.GT.0) THENt - IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVSo - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges- - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950e - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN_ - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line withU - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1T - END IFM - END IFR - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input linef - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line enteredI - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count_ - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN. - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK( - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outs - ENDIF - - END IFR - -C -C Add bulletin to bulletin file and directory entry for to directory file.W -CE - - DATE_SAVE = DATE' - TIME_SAVE = TIMEa - INPUT = DESCRIP - - CALL OPEN_BULLDIR ! Prepare to add dir entryI - - CALL READDIR(NUMBER_PARAM,IER) ! Get info for messageC - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR.E - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' 'N - NUMBER_PARAM = 0 - IER = 1_ - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER)e - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find messageL - CALL CLOSE_BULLDIRC - CLOSE (UNIT=3,STATUS='SAVE')n - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')')s - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')')M - END IF - GO TO 100 - END IF - END IF - - CALL READDIR(0,IER) ! Get directory headerO - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletinE - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK)A - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3)' - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.'C - CALL CLOSE_BULLFILI - CALL CLOSE_BULLDIRT - CLOSE (UNIT=3)O - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER)u - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry$ - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVED - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSET - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:59) ! Update description headerI - END IF - CALL UPDATE_DIR_HEADER(CLI$PRESENT('EXPIRATION').OR.DOALL, - & CLI$PRESENT('PERMANENT'),CLI$PRESENT('SHUTDOWN'),R - & INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN: - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0)f - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSEI - MSGTYPE = 0( - IF (CLI$PRESENT('SYSTEM').OR.d - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THENE - MSGTYPE = IBSET(MSGTYPE,0)I - END IF - IF (CLI$PRESENT('PERMANENT')) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2)0 - ELSE IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THENU - MSGTYPE = IBSET(MSGTYPE,3)T - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIPL - IF (CLI$PRESENT('EXPIRATION')) THENC - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER)_ - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:59),MSGTYPE,EXDATE,EXTIMEI - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF. - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF. - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3)D - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN) - -910 WRITE(6,1010)O - CLOSE (UNIT=3,ERR=100)y - GOTO 100n - -920 WRITE(6,1020)E - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100, - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)L - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.')n -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')N -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.')O -1100 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to replace it? ',$)E -2020 FORMAT(1X,A)P - - END diff --git a/decus/vax90b1/bulletin-net90b/bulletin_bugfix1.src b/decus/vax90b1/bulletin-net90b/bulletin_bugfix1.src deleted file mode 100644 index 02ccd1d..0000000 --- a/decus/vax90b1/bulletin-net90b/bulletin_bugfix1.src +++ /dev/null @@ -1,54 +0,0 @@ -From: CRDGW2::CRDGW2::MRGATE::"SMTP::NERUS.PFC.MIT.EDU::MRL" 30-AUG-1990 07:23:44.16 -To: MRGATE::"ARISIA::EVERHART" -CC: -Subj: BULLETIN - -Received: by crdgw1.ge.com (5.57/GE 1.70) - id AA24820; Thu, 30 Aug 90 05:13:54 EDT -Message-Id: <40C0C59CA99FE031A3@NERUS.PFC.MIT.EDU> -Date: Thu, 30 Aug 90 05:13 EST -From: MRL@NERUS.PFC.MIT.EDU -Subject: BULLETIN -To: EVERHART@ARISIA.DECNET -X-Envelope-To: EVERHART%ARISIA.DECNET@CRDGW1.GE.COM -X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM" - -Oops. The REPLACE routine I sent you calls a new routine which I just added in -BULLETIN V1.82, so it won't work for older versions. If you have an older -version and want to avoid getting a whole new version (especially since I plan -to make changes soon), make the following mods to your version of the routine -REPLACE in BULLETIN2.FOR: - - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH -delete-> NBLOCK = NBLOCK + ICOUNT - -delete-> IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 -add-> NBLOCK = NBLOCK + LENGTH_SAVE - -add-> IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) diff --git a/decus/vax90b1/bulletin/aaareadme.1st b/decus/vax90b1/bulletin/aaareadme.1st deleted file mode 100644 index 37d0730..0000000 --- a/decus/vax90b1/bulletin/aaareadme.1st +++ /dev/null @@ -1,166 +0,0 @@ -(Editor's Note: Sources are in the ZOO file BULL_SOURCE.ZOO) - - -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utility PMDF. If you wish to -do so for another utility, read the text file WRITEMSG.TXT. I would be glad to -include any such programs with my distribution if you think such a program -would be of use to other users. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, you may have to modify the subroutine - which executes the RESPOND command. That command sends messages to either - the originator of the message or the mailing list associated with the - folder. These routines assume that one can simply use the VMS MAIL - utility to do so. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - - BULLETIN will work for both V4 & V5. However, you will have to reassemble - ALLMACS.MAR if you are upgrading from V5, i.e. - $ MAC ALLMACS - $ LIB BULL ALLMACS - $ DELETE ALLMACS.OBJ; - $ @BULLETIN.LNK - $ COPY BULLETIN.EXE BULL_DIR: - $ RUN SYS$SYSTEM:INSTALL - BULL_DIR:BULLETIN/REPLACE - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require different - linked executables.) - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - The object BULLETIN pointing to BULLETIN.COM must be added to the NCP - database, i.e. the command - MCR NCP SET OBJ BULLETIN FILE directory:BULLETIN.COM number 0 - must be executed at startup time on the remote node. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. diff --git a/decus/vax90b1/bulletin/aaareadme.txt b/decus/vax90b1/bulletin/aaareadme.txt deleted file mode 100644 index fbdaa1e..0000000 --- a/decus/vax90b1/bulletin/aaareadme.txt +++ /dev/null @@ -1,252 +0,0 @@ -(Editor's Note: Sources are in the ZOO file BULL_SOURCE.ZOO) - - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULDo -EXPIRE: ENTER ABsolute TIME: e - -The above session adds the text in the file 'mess.txt' as theo -next message in the PUBLIC_ANNOUNCEMENTS Folder. The messageo -will be deleted automatically on the 20th of July as requested -by the user adding the message.D - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when newr -messages are in a folder, he should use the 'READNEW' option.b -This command does not force the reader to reading new messages,n -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set tos -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTSp -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEWt - -Alternately, you may type SET SHOWNEW. This will just display ag -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in theT -BULLETIN. While reading the message that he/she desires to send,p -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too.r - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vax90b1/bulletin/announce.txt b/decus/vax90b1/bulletin/announce.txt deleted file mode 100644 index 19bbab6..0000000 --- a/decus/vax90b1/bulletin/announce.txt +++ /dev/null @@ -1,219 +0,0 @@ -You are about to receive version 1.93 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -NOTE: The following commands can be sent to BULLETIN@NERUS.PFC.MIT.EDU: - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -This version includes all necessary modifications to work under VMS -V5.0. However, it will still be necessary to reassemble the ALLMACS.MAR -source under V5 and relink. The V4 version will not be installable -under V5 due to a change in a shared library which BULLETIN uses. -However, relinking by itself will not be enough. You MUST also -reassemble ALLMACS.MAR. If you only relink, BULLETIN can cause your -system to crash (the BULLCP process will do this because it uses the -routines in ALLMACS.MAR). - -If you are running a version of BULLETIN older than 1.52, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. This -format change can take a significant amount of time if the folder is -large. If your site has large folders, it is suggested that the new -version be installed during off peak hours. NOTE: Problems can occur -if the old version of BULLETIN is run after the data files have been -modified. Such a situation is possible on a cluster where each node has -installed the executable separately. To help installation, a new -command procedure INSTALL_REMOTE.COM has been included. This can be -used to install BULLETIN on several nodes from a single node. Read the -comments in the file for information on how to use it. - -NOTE: The BULLCP process should be stopped using the BULLETIN/STOP -command before the new version of BULLETIN is installed. It can then be -restarted using the BULLETIN/STARTUP command. (The INSTALL_REMOTE.COM -command procedure does this automatically for remote nodes.) - -You will be receiving 17 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) ALLMACS.MAR - 13) BULLCOMS1.HLP - 14) BULLCOMS2.HLP - 15) BULLET1.COM - 16) BULLET2.COM - 17) PMDF.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. Otherwise, you can delete -it. Read AAAREADME.TXT for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@NERUS.PFC.MIT.EDU ------------------------------------------------------------------------- -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fix bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vax90b1/bulletin/board_digest.com b/decus/vax90b1/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vax90b1/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vax90b1/bulletin/board_special.com b/decus/vax90b1/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vax90b1/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vax90b1/bulletin/bullcom.cld b/decus/vax90b1/bulletin/bullcom.cld deleted file mode 100644 index 3eca526..0000000 --- a/decus/vax90b1/bulletin/bullcom.cld +++ /dev/null @@ -1,437 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 9/7/90 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DISALLOW EXTRACT AND FILESPEC - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER ID, NONNEGATABLE -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW REPLY AND SUBJECT - DISALLOW (REPLY OR SUBJECT OR SEARCH) AND MARKED - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_FOLDER - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEXT - DEFINE VERB POST - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACT - QUALIFIER LIST, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER EDIT - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LOCAL - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DISALLOW EXTRACT AND FILESPEC - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACT - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER SUBJECT - DISALLOW SEARCH_STRING AND REPLY - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER LOGIN - QUALIFIER NOLOGIN - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) diff --git a/decus/vax90b1/bulletin/bullcoms1.hlp b/decus/vax90b1/bulletin/bullcoms1.hlp deleted file mode 100644 index 53e0bf1..0000000 --- a/decus/vax90b1/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,740 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does not -change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this assumes -that the remote node is capable of supporting this feature, i.e. the BULLCP -process is running on that node. If it is not, you will receive an error -message). If the the foldername is specified with only a nodename, -i.e. FOO::, the foldername is assumed to be GENERAL. NOTE: Specifying -remote nodes is only possible if that remote node is running a special -BULLCP process. If it isn't, the only way to add messages to that remote -node is via the /NODE command. However, /FOLDER is a much quicker method, -and much more versatile. - -You can specify logical names which translate to one or more folder names. -I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify /NODES= -ALL_FOLDERS. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL - -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See installation -notes). You can specify a different username to use at the other nodes by -either using the USERNAME qualifier, or by specifying the nodename with 2 -semi-colons followed by the username, i.e. nodename::username. If you -specify a username, you will be prompted for the password of the account -on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /PERMANENT -This option is restricted to privileged users for the GENERAL folder, -but available to all in other folders. If specified, message will be a -permanent message and will never expire. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers so -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file can -be specified which contains the text. If the editor is used for changing -the text, the old message text will be extracted. This can be suppressed -by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. This only applies to the GENERAL folder. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically selected -(see information on SELECT command). The commands that can be used to -modify the folder's characteristics are: MODIFY, REMOVE, SET ACCESS, -SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the folder -is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying BULLCOM.CLD. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, the -folder will then be modified to point to that folder. For example if -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be shared -between more than one node. This capability is only present if the BULLCP -process is running on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. By default, -the GENERAL folder is a SYSTEM folder. This is a privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT - -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message. -It can be a substring of the subject. This is in case you have forgotten -the exact subject that was specified. Case is not critical either. -You will be notified if the deletion was successful. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting messages -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at -message #1, or if a message has already been read, it will start at that -message. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of folder. -2 /EXPIRATION -Shows the message's expiration date rather than the creation date. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected using the SELECT command. -2 /NEW -Specifies to start the listing of messages with the first unread message. -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /SEARCH - /SEARCH=[string] - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified string -is used. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified. - - Format: - FILE filename [message_number][-message_number1] - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Copies all the messages in the current folder. -2 /FF -Specifies that a form feed is placed inbetween messages in the file. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 Folders -All messages are divided into separate folders. The default folder is -GENERAL. New folders can be created by any user. As an example, the -following creates a folder for GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that -user will be alerted of topics of new messages at login time, and will -then be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in the -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote DECNET -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP) -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. By default, the GENERAL folder -is a SYSTEM folder (and cannot be changed). One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the GENERAL -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, and -giving access to that UIC group. Only users in that UIC group will see -the messages in that folder when they log in. -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INDEX -Gives directory listing of all folders in alphabetical order. If the -INDEX command is re-entered while the listing is in progress, the listing -will skip to the next folder. This is useful for skipping a particular -folder. It also can be used to continue the listing from where one left -off after one has read a message. - - Format: - INDEX -2 /MARKED -Shows only messages that have been marked (indicated by an asterisk). -2 /NEW -Specifies to start the listing of each folder with the first unread message. -Otherwise, the listing will start with the first message in the folder. -If the INDEX command is re-entered for continuing the listing, /NEW must -be respecified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/TE|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/TE| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying an -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" must -be specified as xxx%"""address""". -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers] - -NOTE: The list of marked messages are stored in a file username.BULLMARK -in the directory pointed to by the logical name BULL_MARK. If BULL_MARK -is not defined, an error message will be displayed when attempting to -mark a message. BULL_MARK may be defined system wide, depending on -whether the system manager has decided to do so. -1 MODIFY -Modifies the database information for the current folder. Only the owner -of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However, -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. diff --git a/decus/vax90b1/bulletin/bullcoms2.hlp b/decus/vax90b1/bulletin/bullcoms2.hlp deleted file mode 100644 index 2391936..0000000 --- a/decus/vax90b1/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,784 +0,0 @@ -1 POST -Sends a message via MAIL to the network mailing list which is associated -with the selected folder. This command is used in conjunction with a -folder which receives messages from a network mailing list. The address -of the mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with > at the -beginning of each line. This can be suppressed with /NOINDENT. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The PRINT command can take optional qualifiers. - - Format: - - PRINT [message_number][-message_number1] - -A range of messages to be printed can optionally be specified, i.e. -FILE 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply hitting -the key is equivalent to "READ". -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected using the SELECT command. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /EXTRACT. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header. -If a "search-string" is not specified, a search is made using the -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the last -message. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default general messages. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The form -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY. -The time will always be 00:00, even if the time is specified on the line. -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time and -avoids creating subprocesses. (Useful if input is digest format.) -3 More_information - -The following is relevant only if the messages in the BBOARD accounts -are sent via a method that causes the name of the account to be placed -in the TO: line of the VMS MAIL. The normal MAIL utility, of course, -does this. However, packages such as PMDF (and probably many others) -will not always do this. (I.e. if the mail was sent to the account -using CC:, the address of the person to whom the mail was sent will be -placed in the TO: line rather than the CC: address.) - -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail forwarded -to BBOARD accounts that don't have /SPECIAL set. Folders of the same -type, i.e. that use the same /SPECIAL command procedure, must be grouped -separately. -2 BRIEF - -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by the -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier. -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed every -time when logging in, until the new messages are read. Normally, the -BRIEF setting causes notification only at the first time that new messages -are detected. - - Format: - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - - Format: - - SET DEFAULT_EXPIRE days - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages. - - Format: - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory. - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the GENERAL folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new GENERAL messages will be displayed -for upon logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are logged -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format: - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers. -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed. -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that READNEW is a permanent flag and cannot be changed by the -individual. This is a privileged qualifier. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged qualifier. -2 STRIP -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped off -before it is stored as a BULLETIN message. - - Format: - - SET [NO]STRIP - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -By default, the GENERAL folder is a SYSTEM folder, and the setting for -that folder cannot be removed. - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected via -the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 KEYPAD -Displays the keypad command definitions. If the keypad has been enabled -by either the SET KEYPAD COMMAND, or /KEYPAD is specified on the command -line, the keypad keys will be defined as commands. SHOW KEYPAD is the -equivalent of HELP KEYPAD. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in. If NOLOGIN is set for a user, -this information will be displayed instead. This is a privileged command. -Non-privileged users will only be able to display the information for -their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some sites -make BULLETIN/LOGIN an optional command for users to store in their own -LOGIN.COM, so this command can be used to show which users have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGIN - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -2 VERSION -Shows the version of BULLETIN and the date that the executable was linked. -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 UNDELETE -Undeletes the specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have their -expiration date set to 15 minutes in the future and are deleted then. -Undeleting the message will reset the expiration date back to its original -value. Deleted messages will be indicated as such by the string (DELETED) -when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] diff --git a/decus/vax90b1/bulletin/bulletin.cld b/decus/vax90b1/bulletin/bulletin.cld deleted file mode 100644 index 7ac084e..0000000 --- a/decus/vax90b1/bulletin/bulletin.cld +++ /dev/null @@ -1,40 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vax90b1/bulletin/bulletin.com b/decus/vax90b1/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vax90b1/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vax90b1/bulletin/bulletin.hlp b/decus/vax90b1/bulletin/bulletin.hlp deleted file mode 100644 index b3fd0dc..0000000 --- a/decus/vax90b1/bulletin/bulletin.hlp +++ /dev/null @@ -1,137 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are -displayed. Reading of those messages is optional. (Use the command SET -READNEW while in BULLETIN for setting automatic reading.) Privileged -users can add system bulletins that are displayed in full at login -time. These messages are also saved, and can be read by BULLETIN. -Messages are automatically deleted after a specified expiration date, -or they can manually be deleted by either the submitter of the message -or a privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and -reading messages is easy to do via a utility similar to the VMS MAIL -utility. Privileged users can create messages which are displayed in -full. (known as SYSTEM messages). Non-privileged users may be able to -create non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic -can be placed together. Folders can be made private so that reading -and writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or -all terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. -2 Parameters -The parameter following the BULLETIN command is interpreted as the folder -name which should be selected, rather than the default GENERAL folder. -If the parameter is specified with quotes ("parameter"), the parameter is -interpreted as an interactive BULLETIN command, i.e. commands which are -entered once BULLETIN is executed, i.e. "DIRECTORY", "ADD", etc. BULLETIN -will exit immediately after entering that command, rather than prompting -for another command. More than one command can be specified by separating -the commands with semi-colons, i.e. "SELECT DATA;DIR". - -NOTE: Depending on how the BULLETIN command is defined, triple quotes -rather than single quotes may be required. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vax90b1/bulletin/bulletin.lnk b/decus/vax90b1/bulletin/bulletin.lnk deleted file mode 100644 index 11387a9..0000000 --- a/decus/vax90b1/bulletin/bulletin.lnk +++ /dev/null @@ -1,3 +0,0 @@ -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB- - /EXE=BULLETIN,SYS$INPUT/OPT -ID="V1.93" diff --git a/decus/vax90b1/bulletin/bulletin10.for b/decus/vax90b1/bulletin/bulletin10.for deleted file mode 100644 index 5cba6a9..0000000 --- a/decus/vax90b1/bulletin/bulletin10.for +++ /dev/null @@ -1,2106 +0,0 @@ -From: ADVAX::"MRL@NERUS.PFC.MIT.EDU" " " 7-MAR-1991 13:06:15.96 -To: ARISIA::EVERHART -CC: -Subj: BULLETIN - -Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Thu, 7 Mar 91 13:03:14 EST -Received: from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP - id AA01068 for ; Thu, 7 Mar 91 11:34:18 -0500 -From: MRL@NERUS.PFC.MIT.EDU -Received: from ALCVAX.PFC.MIT.EDU by mcnc.mcnc.org (5.59/MCNC/6-11-90) - id AA03246; Thu, 7 Mar 91 10:14:22 -0500 - for ARISIA.DNET.ge.com!EVERHART -Message-Id: -Date: Thu, 7 Mar 91 10:09 EST -Subject: BULLETIN -To: ARISIA::EVERHART -X-Envelope-To: EVERHART@ARISIA.DNET.GE.COM -X-Vms-To: IN%"EVERHART@ARISIA.DNET.GE.COM" - -Greetings: - I've discovered a bug in BULLETIN10.FOR which affects the newsreader -feature. It could result in file corruption when using NEWS in BULLETIN. -Enclosed is the corrected BULLETIN10.FOR. - MRL ------------------------------------------------------------------------------- - -C -C BULLETIN10.FOR, Version 3/7/91 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (1) - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - IF (END_LINE.GT.0) THEN - SB = START_READ - IF (END_LINE-2.LE.255) THEN - END_LINE = END_LINE + SB - 1 - EB = END_LINE - 2 - ELSE - EB = SB + 254 - IF (INDEX(BUFFER(SB:EB),' ').GT.0) THEN - DO WHILE (BUFFER(EB:EB).NE.' ') - EB = EB - 1 - END DO - END IF - END_LINE = EB - END IF - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - RETURN - ELSE IF (END_READ-START_READ.EQ.1023) THEN - NEWS_READ = 0 - RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - CALL NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*6 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (INDEX(FOLDER,'.').GT.0) THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*255 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (HIGHFROM.EQ.USERNAME.AND.MESSAGE_ID(INDEX(MESSAGE_ID,'@')+1: - & TRIM(MESSAGE_ID)-1).EQ.PATHNAME(:INDEX(PATHNAME,'!')-1)) - & THEN - CALL NEWS_POST('cancel',0,IER,'Delete news item.') - ELSE - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*6 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.'.AND..NOT. - & OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ')+SB-2) - & ,START,,%VAL(1))) RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) RETURN - START = MAX(F_START,START-NUMDIR) - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1)))D - & RETURN6 - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THENG - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURNu - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ')o - NUMBER = ' '//NUMBER(1:) - END DOI - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1E - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' '). - NUMBER1 = NUMBER1(2:) - END DOi - END IFh - END IF - END IF. - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1.AND..NOT.NEWS_WRITE- - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURNV - IF (I.EQ.2.AND..NOT.NEWS_WRITEa - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURNe - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR)u - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - DO J=SB+INDEX(BUFFER(SB:EB),' '),EBR - IF (ICHAR(BUFFER(J:J)).LT.32) BUFFER(J:J) = ' ' - END DO - TEMP(I*256+1:) = BUFFER(SB+INDEX(BUFFER(SB:EB),' '):EB)H - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP)D - IF (.NOT.NEWS_READ()) RETURN - END DOH - END IFE - END DO - QXHDR = QXHDR1 - IER = 0E - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN_ - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURNG - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500'B - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22'): - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0R - END = START - 1D - RETURN - END IF - END IFD - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IFU - - IF (IER.EQ.0) THEN - I = START1 - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DESCRIP = TEMP(257:512) - CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768)))= - ELSEA - IER = OTS$CVT_TI_L(BUFFER(SB+4:O - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1))C - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN_ - END IFL - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THENR - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURNW - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1U - IER = 0 - RETURN - END IFT - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IFR - END DO - END IFS - P - IF (REMOTE_SET.EQ.3) THEN - IER = 1E - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURNN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF. - . - RETURN( - END - - E - I - INTEGER FUNCTION NEWS_LOGIN - E - IMPLICIT INTEGER (A-Z) - D - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - C - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - C - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (.NOT.NEWS_CONNECTED) THENE - NEWS_LOGIN = .FALSE. - NEWS_CONNECTED = NEWS_CONNECT() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURNS - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - END IFE - - NEWS_LOGIN = .TRUE. - R - RETURNC - END - ( - S - , - D - SUBROUTINE NEWS_HEADER(IER) - 1 - IMPLICIT INTEGER (A-Z)U - , - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EBF - CHARACTER BUFFER*1280 - A - EX_BTIM(1) = 0, - EX_BTIM(2) = 0, - D - DESCRIP = ' ' - FROM = ' 'F - E - DO WHILE (BUFFER(SB:EB).NE.'.') - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THENS - DO I=SB+9,EBT - IF (ICHAR(BUFFER(I:I)).LT.32) BUFFER(I:I) = ' 'L - END DO( - DESCRIP = BUFFER(SB+9:EB) - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THENe - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THENU - CALL GET_FROM(BUFFER(SB+6:EB),EB-SB+1), - END IFT - END IF - END DOC - O - IER = 0 - D - RETURNE - END - T - N - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - L - IMPLICIT INTEGER (A-Z) - L - INCLUDE 'BULLFOLDER.INC'M - , - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - 1 - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*6 NUMBERQ - R - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2H - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 03 - END IFT - R - RETURNT - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z)H - - INCLUDE 'BULLFOLDER.INC' - E - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - M - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - L - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - , - DIMENSION IN_BTIM(2) - O - CHARACTER TIME*20,FIRST*80 - - CHARACTER*6 NUMBER2 - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THENF - I = NEWS_FIND_SUBSCRIBE()N - START = (LAST_NEWS_READ2(2,I).AND.'3FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1E - ELSE - LAST_NEWS_READ2(2,I) = (F_NBULL-LAST_NEWS_READ(2,I))E - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSEE - START = -1 - IER = SYS$ASCTIM(,TIME,IN_BTIM,) - CALL DATE_TIME(TIME) - SKIP = 0 - DO WHILE (1) - IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( - & FOLDER_NAME))//' '//TIME)) RETURNR - IF (.NOT.NEWS_READ()) RETURNQ - IF (BUFFER(:2).EQ.'23') THEN - IF (.NOT.NEWS_READ()) CALL EXIT - DO I=1,SKIP - IF (.NOT.NEWS_READ()) CALL EXIT - END DO. - FIRST = BUFFER(SB:EB) - IF (FIRST.EQ.'.') RETURND - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL EXITB - END DOU - IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) - & CALL EXIT - IF (.NOT.NEWS_READ()) CALL EXIT - IF (BUFFER(:2).EQ.'22') THEN - IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN - I = F_NBULL + 1 - DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. - & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>'))D - & .OR.I.GT.F_NBULL)) - I = I - 1 - IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURNS - IF (.NOT.NEWS_READ()) RETURNO - END DOM - IF (I.GE.F_START) START = I - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END IF - RETURN - END IF1 - END IF - SKIP = SKIP + 1 - END DO - END IFE - N - RETURN - END - - M - 1 - SUBROUTINE REMOTE_COPY_BULL(IER) - U - IMPLICIT INTEGER (A-Z)D - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - I - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - ELSEE - END IF' - ) - RETURN - END - - D - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - W - IMPLICIT INTEGER (A-Z)S - E - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - E - CHARACTER*(*) OUTPUTa - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IFI - B - RETURN. - END - T - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -CR -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -CM - 1 - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLDIR.INC' - C - INCLUDE '($RMSDEF)' - ) - COMMON /BUFFER/ BUFFER,SB,EBE - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - ' - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - E - COMMON /REF/ REFERENCES,LREF - CHARACTER*255 REFERENCESD - E - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*255 NEWSGROUPSE - I - CHARACTER*255 TEMP,FROM_LINE,SUBJECT_LINE - E - CHARACTER*10 MSGNUM - . - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty?T - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to headN - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointerN - END IFI - . - IF (REMOTE_SET.EQ.3) THEN - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - & - SUBJECT_LINE = ' ' - FROM_LINE = ' ') - NEWSGROUPS = ' ' - LREF = 0 - DO WHILE (BUFFER(SB:EB).NE.'.')3 - IER = NEWS_READ() - IF (.NOT.IER) RETURN) - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GT.SB+5) THENN - FROM_LINE = 'From: '//BUFFER(SB+6:EB) - ELSE IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.( - & EB.GT.SB+8) THEN - DO I=SB+9,EB - IF (ICHAR(BUFFER(I:I)).LT.32) BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB+9:EB) - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND.E - & EB.GT.SB+11) THEN4 - NEWSGROUPS = BUFFER(SB+12:EB) - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND.I - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN. - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '//B - & REFERENCES(:LREF)( - END IFE - LREF = TRIM(REFERENCES)) - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND.E - & EB.GT.SB+11) THENC - IF (LREF.EQ.0) THENT - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IFI - LREF = TRIM(REFERENCES)X - END IF - END IF, - END DO - C - LSUB = TRIM(SUBJECT_LINE)R - LFRO = TRIM(FROM_LINE) - END IF - L - ILEN = 128( - IER = 0 - LENGTH = 0U - LTEMP = 0 - - IF (REMOTE_SET.EQ.3.AND.R - & LSUB.EQ.0.AND..NOT.NEWS_WRITE('ARTICLE '//MSGNUM)) RETURN - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THENR - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN_ - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IFN - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - BUFFER = FROM_LINE - SB = 1 - EB = LFROR - LFRO = 0 - IER = 1( - ELSE IF (LSUB.GT.0) THEN - IF (BUFFER.EQ.SUBJECT_LINE) THEN - IF (.NOT.NEWS_WRITE('ARTICLE '//MSGNUM)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THENC - IER = 0 - RETURNC - END IF - LSUB = 0 - IER = NEWS_READ() - ELSE - BUFFER = SUBJECT_LINE - SB = 1 - EB = LSUB - IER = 1 - END IF - ELSE) - IER = NEWS_READ(). - END IF - IF (IER.AND.BUFFER(SB:EB).NE.'.') THEN - IER = 0. - LTEMP = MIN(255,EB-SB+1) - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - ELSE - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THENB - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0)D - ILEN = -128F - ELSEF - ILEN = 128 - END IF) - ELSE - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)' - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this errorA - IER = 0 - ILEN = 0F - ELSEL - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTES - END IF: - ELSE IF (ABS(ILEN).EQ.128) THENH - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DOT - U - RETURN - END - B - E - B - E - SUBROUTINE REMOTE_REMOVE_FOLDER(IER)F - E - IMPLICIT INTEGER (A-Z) - T - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - _ - RETURNU - END - , - ) - L - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -CI -C SUBROUTINE CONNECT_REMOTE_FOLDERO -CS -C FUNCTION: Connects to folder that is located on other DECNET node.2 -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - L - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHF - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)C - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATEM - ) - COMMON /READIT/ READITW - E - COMMON /NEWS_INIT/ END_READ - N - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLDIR.INC' - E - INCLUDE 'BULLFILES.INC' - ) - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*25 FOLDER_SAVEU - S - DIMENSION DUMMY(4) - A - IF (INDEX(FOLDER1,'.').GT.0) THEN - END_READ = 0 - IF (.NOT.NEWS_LOGIN()) THENB - IER = 2 - RETURN* - END IF - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - M - REMOTE_UNIT = 31 - REMOTE_UNIT_ - M - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name differentE - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1F - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - S - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEND - FOLDER1_FILE = FOLDER_FILEE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1) - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE.W - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THENF - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF. - END IF - IF (.NOT.SYSLOG) THENU - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARDT - FOLDER_NUMBER_SAVE = FOLDER1_NUMBERD - IF (IER.EQ.0) THEN - IF (SYSLOG) THENO - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSER - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE1 - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE1 - FOLDER1_OWNER = FOLDER_OWNER_SAVE1 - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND.T - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process' - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER)E - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSERT - END IF - END IF - IER = 2O - ELSEA - CLOSE (UNIT=31-REMOTE_UNIT)t -Ce -C If remote folder has returned a last read time for the folder,' -C and if in /LOGIN mode, or last selected folder was a differentA -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1)/ - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - IF (SYSLOG) THENT - LAST_SYS_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(3) - LAST_SYS_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(4) - END IFs - END IF - IER = 0U - END IF_ - N - RETURN - END - 1 - S - T - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - . - IMPLICIT INTEGER (A-Z)B - E - INCLUDE 'BULLDIR.INC' - + - INCLUDE 'BULLFOLDER.INC'' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - 0 - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - = - COMMON /BUFFER/ BUFFER,SB,EBE - CHARACTER BUFFER*1280 - E - COMMON /MSGID/ MESSAGE_ID - CHARACTER*255 MESSAGE_IDQ - r - COMMON /NEXT/ NEXTT - LOGICAL NEXT /.FALSE./F - : - COMMON /NEWGROUP/ NEWGROUP - L - CHARACTER*6 NUMBER) - . - CHARACTER IN_BTIM(2)& - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN) - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBINE - END IF - RETURN - ELSEI - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY1 - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THENC - NBULL = F_NBULL - ICOUNT = 1= - RETURN) - ELSE IF (ICOUNT.EQ.-1) THENR - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THENT - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURNN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THEN - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1D - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXITL - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') NEXT = .FALSE. - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THENU - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXITN - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN. - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN0 - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT: - END IF - END IFT - IF (BUFFER(:2).NE.'22') RETURNT - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1)) - IF (.NOT.IER) RETURNE - START = ICOUNTF - BULLETIN_NUM = START - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) - IER = 0E - CALL NEWS_HEADER(IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBINr - END IF - BLOCK = STARTN - MSG_NUM = STARTM - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IFC - - RETURNC - END - I - E - S - E - O - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - S - IMPLICIT INTEGER (A-Z) - T - INTEGER BTIM(2)R - I - CHARACTER*8 MSG_KEY,INPUTD - N - INPUT = MSG_KEY - I - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - ' - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1))_ - E - RETURN - END - A - R - - SUBROUTINE NEWS_GROUP(IER)D - Y - IMPLICIT INTEGER (A-Z)E - ' - INCLUDE 'BULLFOLDER.INC'D - 0 - COMMON /BUFFER/ BUFFER,SB,EBE - CHARACTER BUFFER*1280 - R - COMMON /NEWGROUP/ NEWGROUPN - _ - IER = NEWS_WRITE('GROUP '//FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP))) - IF (.NOT.IER) RETURNE - N - IER = NEWS_READ() - IF (.NOT.IER) RETURNU - _ - IF (BUFFER(:3).EQ.'411') THEN - CALL OPEN_BULLNEWS_SHAREDI - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - IF (IER1.EQ.0) DELETE (7)S - CALL CLOSE_BULLFOLDER - RETURNN - END IF - - NEWGROUP = .TRUE. - I - BUFFER = BUFFER(5:) - N - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_END,,%VAL(1))D - IF (.NOT.IER) RETURN) - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1))= - IF (.NOT.IER) RETURN( - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - S - IER = 0 - - RETURNT - END - E - E - T - SUBROUTINE NEWS_TIME(INTIME,BTIM) - L - IMPLICIT INTEGER (A-Z)F - E - CHARACTER*(*) INTIMEL - R - CHARACTER*20 TIME - F - I = 1 - LTIME = TRIM(INTIME)( - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR.1 - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DOI - ) - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IFS - - CALL STR$UPCASE(TIME,INTIME(I:))F - - DO J = 1,2S - I = 1 - DO WHILE (TIME(I:I).NE.' ')I - I = I + 1 - END DO - TIME(I:I) = '-'S - END DOD - _ - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEND - TIME = TIME(:I)//'19'//TIME(I+1:)F - ELSEQ - TIME = TIME(:I)//'20'//TIME(I+1:) - END IFD - M - I = 1 - DO J = 1,2T - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DOE - R - CALL SYS_BINTIM(TIME(:I-2),BTIM)E - O - RETURN - END1 - U - ( - F - SUBROUTINE NEWS_LISTI - - IMPLICIT INTEGER (A-Z)S - ) - INCLUDE 'BULLFOLDER.INC' - D - COMMON /BUFFER/ BUFFER,SB,EB1 - CHARACTER BUFFER*1280 - E - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - E - CALL OPEN_BULLNEWS_SHARED ! Open folder fileF - E - NEWS_FOLDER1_BBOARD = '::' - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)r - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_END = 1001 - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMA - END IF - IF (NEWS_F1_END.LT.1001) NEWS_F1_END = 1001 - NEWS_F_END = NEWS_F1_ENDE - LAST_READ = NEWS_FOLDER1_NUMBER - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1Y - NEWS_FOLDER1 = BUFFER(SB:MIN(25,FLEN)+SB-1) - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER)l - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2w - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1))/ - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (FLEN.GT.25) THEN, - NEWS_FOLDER1_DESCRIP = BUFFER(SB+25:FLEN+SB-1) - ELSE - NEWS_FOLDER1_DESCRIP = ' ' - END IFS - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER))U - READ (7,KEY=NEWS_F_END,KEYID=1,IOSTAT=IER)_ - END DO - IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1 - END DOO - NEWS_FOLDER1_NUMBER = NEWS_F_ENDE - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1 - ELSE IF (F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL) THEN/ - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - DO I = LAST_READ+1,NEXT_READ-1M - DO WHILE (REC_LOCK(IER)) ! Delete non-existant - READ (7,KEY=I,KEYID=1,IOSTAT=IER) ! newsgroups6 - END DO - IF (IER.EQ.0) DELETE (UNIT=7) - END DO - LAST_READ = NEXT_READ - END IF - END DO, - A - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)E - NEWS_F1_END = NEWS_F_END= - REWRITE (7) NEWS_FOLDER1_COM - - CALL CLOSE_BULLNEWS - - RETURNN - END - - - SUBROUTINE LOWERCASE(INPUT) - = - CHARACTER*(*) INPUT - R - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN2 - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DON - X - RETURN - END - I - I - N - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z)E - N - INCLUDE 'BULLNEWS.INC' - D - INCLUDE 'BULLFOLDER.INC'= - ) - INCLUDE 'BULLUSER.INC' - - COMMON /BUFFER/ BUFFER,SB,EBE - CHARACTER BUFFER*1280 - R - COMMON /REF/ REFERENCES,LREFN - CHARACTER*255 REFERENCESO - R - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAMEM - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - ( - COMMON /MSGID/ MESSAGE_ID - CHARACTER*255 MESSAGE_IDN - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - R - COMMON /NEWSGROUPS/ NEWSGROUPS_ - CHARACTER*255 NEWSGROUPS - - CHARACTER*(*) FILENAME,SUBJECTI - T - CHARACTER TODAY*23,MSGID*23,ZONE*5 - - DIMENSION NOW(2),GMT(2) - ( - IER = 1 - - IF (FILENAME.NE.'cancel') THEN( - IF (.NOT.FILEOPEN) THENA - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1)N - IF (IER1.NE.0) RETURN - END IF - ( - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900R - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - N - REWIND (UNIT=3)E - END IF) - L - IF (.NOT.NEWS_LOGIN()) GO TO 900I - I - IF (LPATH.EQ.0) CALL GET_PATHNAME - I - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900D - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THENE - IF (.NOT.NEWS_WRITE('Newsgroups: '//W - & NEWSGROUPS(:TRIM(NEWSGROUPS)))) GO TO 900 - ELSE IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.NEWS_WRITE('Newsgroups: '//. - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)))) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Newsgroups: '// - & FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)))) GO TO 900 - END IF - NEWSGROUPS = ' ' - END IFR - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(:LPATH))) GO TO 900R - IF (.NOT.NEWS_WRITE('From: '//PATHNAME(INDEX(PATHNAME,'!')+1: - & TRIM(PATHNAME))//'@'//PATHNAME(:INDEX(PATHNAME,'!')-1))) - & GO TO 900L - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT))))O - & GO TO 900F - N - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF)))L - & GO TO 900 - END IF - - CALL SYS$ASCTIM(,TODAY(:23),,)A - E - IF (LZONE.EQ.0) THEN - IF (SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',ZONE)) THEN - IER = OTS$CVT_TI_L(ZONE(:TRIM(ZONE)),DIFF,,%VAL(1)) - IF (DIFF.LT.0) THEN - PAST = .TRUE. - ZONE = ZONE(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFFT - IER = OTS$CVT_L_TI(DIFF,ZONE(1:2),,,) - IF (ZONE(1:1).EQ.' ') ZONE = ZONE(2:) - ELSE - PAST = .FALSE. - END IF - IER = SYS_BINTIM('0 '//ZONE(:TRIM(ZONE))//':00',GMT)= - IER = SYS$GETTIM(NOW) - IF (PAST) THEN - IER = LIB$ADDX(NOW,GMT,GMT)F - ELSEH - IER = LIB$SUBX(NOW,GMT,GMT)E - END IFO - IER = SYS$ASCTIM(,TODAY,GMT,) - ZONE = 'GMT'S - ELSE IF (.NOT.SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .AND..NOT.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - ZONE = 'GMT'D - END IF - LZONE = TRIM(ZONE) - END IFM - T - MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (MSGID(1:1).EQ.' ') MSGID = MSGID(2:)I - IF (.NOT.NEWS_WRITE('Message-ID: <'//MSGID(:TRIM(MSGID))//O - & '@'//PATHNAME(:INDEX(PATHNAME,'!')-1)//'>')) GO TO 900E - N - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:)O - R - IF (LORGAN.EQ.0) THEN - LORGAN = TRIM(ORGANIZATION)F - IF (LORGAN.EQ.0) THENR - IF (.NOT.SYS_TRNLNM_SYSTEM('BULL_NEWS_ORGANIZATION',I - & ORGANIZATION)) THEN - LORGAN = -1 - ELSEE - LORGAN = TRIM(ORGANIZATION)B - END IF1 - END IF - END IFE - U - IF (LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN)))L - & GO TO 900C - END IFF - E - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//I - & ZONE(:LZONE))) GO TO 900 - S - IF (FILENAME.EQ.'cancel') THEN' - IF (.NOT.NEWS_WRITE('Control: cancel ' - & //MESSAGE_ID(:TRIM(MESSAGE_ID)))) RETURN - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).EQ.'240') IER = 0 - RETURN - END IFR - O - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - F - IER1 = 0A - DO WHILE (IER1.EQ.0)R - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2E - END IF - IF (IER1.EQ.0.AND..NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900T - END DOE - F - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') IER = 0 - C -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - - RETURNM - END - - - L - SUBROUTINE GET_PATHNAME - E - IMPLICIT INTEGER (A-Z) - $ - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATHO - CHARACTER*132 PATHNAMEI - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN- - IF (.NOT.SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME).AND.) - & .NOT.SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME)) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURNI - END IF - END IFE - - PATHNAME = PATHNAME(:TRIM(PATHNAME))//'!' - & //USERNAME(:TRIM(USERNAME)) - CALL LOWERCASE(PATHNAME)R - LPATH = TRIM(PATHNAME) - - RETURNN - END - S - - - P - SUBROUTINE NEWS2BULL) - I - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'E - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - U - COMMON /BUFFER/ BUFFER,SB,EBI - CHARACTER BUFFER*1280 - S - EXTERNAL BULLETIN_SUBCOMMANDS - E - CHARACTER TIME*20,FIRST*80,FOLDER_SAVE*25 - ! - CHARACTER*6 NUMBERE - N - DIMENSION SAVE_F_NEWEST_BTIM(2) - - CALL ALLPRIVE - Y - CALL NEWS_LIST1 - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - ' - FOLDER_Q = FOLDER_Q1E - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file= - ) - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THENE - IF ((INDEX(FOLDER_DESCRIP,'@').LE.SLIST.OR. - & FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@').AND. - & INDEX(FOLDER_DESCRIP,'.').GT.SLIST) THEN - NUM_FOLDERS = NUM_FOLDERS + 1X - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)E - END IF - END IFE - END IF - END DOX - F - CALL CLOSE_BULLFOLDER ! We don't need file anymoreP - E - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT_ - E - FOLDER_Q = FOLDER_Q1E - POINT_FOLDER = 0E - FILEOPEN = .FALSE.T - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)P - IF (.NOT.FILEOPEN) THEN - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - SAVE_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1), - SAVE_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2)R - FOLDER_SAVE = FOLDERD - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (FOLDER_DESCRIP(1:1).EQ.'@'.AND.IER) THENS - OPEN (UNIT=3,FILE=FOLDER_DESCRIP(2:TRIM(FOLDER_DESCRIP)) - & ,STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) THEN - READ (3,'(A)',IOSTAT=IER1) FOLDER_DESCRIP - IF (IER1.NE.0) CLOSE (UNIT=3)K - IF (IER1.EQ.0) FILEOPEN = .TRUE. - END IFI - ELSET - IER1 = 0 - END IF - END IF - IF (IER.AND.IER1.EQ.0) THEN, - FOLDER_NUMBER = -1E - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL REMOTE_GET_NEWEST_MSG(SAVE_F_NEWEST_BTIM,START) - IF (START.GE.F_START) THEN= - CALL OTS$CVT_L_TI(START,NUMBER,,,)( - INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM(I - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)( - CALL MOVE(.FALSE.) - END IF - END IFE - IF (FILEOPEN) THENC - READ (3,'(A)',IOSTAT=IER1) FOLDER_DESCRIPL - IF (IER1.NE.0) CLOSE (UNIT=3) - IF (IER1.NE.0) FILEOPEN = .FALSE.M - END IFE - END IF - END DOR - 5 - CALL EXIT - END - M - - T - SUBROUTINE DATE_TIME(TIME)R - 2 - IMPLICIT INTEGER (A-Z)C - A - CHARACTER*36 MONTHA - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/A - R - CHARACTER*(*) TIME - M - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - A - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+A - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)//M - & TIME(16:17)//TIME(19:20)M - E - RETURN) - END - - F - N - SUBROUTINE ALLPRIV - - IMPLICIT INTEGER (A-Z) - ' - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1 - PROCPRIV(2) = -1I - NEEDPRIV(1) = -1 - NEEDPRIV(2) = -1S - = - RETURNF - END - - - R - SUBROUTINE NEWS_NEW_FOLDER - I - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'T - E - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COMI - L - NEWS_FOLDER1 = FOLDER1A - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0)9 - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_END,KEYID=1) - IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1 - END DO - - NEWS_FOLDER1_NUMBER = NEWS_F_END - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)E - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_END = NEWS_F_END_ - REWRITE (7) NEWS_FOLDER1_COM. - S - RETURNe - END - - . - - SUBROUTINE SUBSCRIBED - R - IMPLICIT INTEGER (A-Z)) - G - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC's - / - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - S - IF (REMOTE_SET.NE.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')')T - RETURN - END IF - R - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX) - I = I + 1& - END DO - L - IF (I.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')')L - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSER - WRITE (6,'('' You are now subscribed to '',A,''.'')')S - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - ( - LAST_NEWS_READ2(1,I) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THENT - LAST_NEWS_READ2(2,I) = F_NBULL - (F_START - 1) - LAST_NEWS_READ(2,I) = F_START - 1 - ELSEA - LAST_NEWS_READ2(2,I) = 0 - LAST_NEWS_READ(2,I) = F_NBULL: - END IF) - ' - RETURN= - END - I - = - S - SUBROUTINE UNSUBSCRIBEP - ) - IMPLICIT INTEGER (A-Z)I - D - INCLUDE 'BULLUSER.INC'E - H - INCLUDE 'BULLFOLDER.INC'N - G - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSEY - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF: - / - DO J=I,FOLDER_MAX-1 - LAST_NEWS_READ(1,J) = LAST_NEWS_READ(1,J+1)O - LAST_NEWS_READ(2,J) = LAST_NEWS_READ(2,J+1) - END DOS - ( - LAST_NEWS_READ(1,FOLDER_MAX) = 0- - LAST_NEWS_READ(2,FOLDER_MAX) = 0 - - RETURNA - END - N - ( - H - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - T - IMPLICIT INTEGER (A-Z)/ - ' - INCLUDE 'BULLUSER.INC'Y - 1 - INCLUDE 'BULLFOLDER.INC'O - R - I = NEWS_FIND_SUBSCRIBE() - O - IER = LAST_NEWS_READ(2,I) + 1 - ( - IF (I.GT.FOLDER_MAX.OR.IER.GT.F_NBULL) THEN - IER = 0_ - RETURN - END IF - - RETURNG - END - ) - H - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - G - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'E - I - INCLUDE 'BULLFOLDER.INC'H - - I = NEWS_FIND_SUBSCRIBE() - z - IF (I.GT.FOLDER_MAX) RETURN - L - IF (NUMBER.GT.LAST_NEWS_READ(2,I)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = - & (F_NBULL-NUMBER).OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IFN - N - RETURN( - END - - c - ' - - & - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) - ( - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLUSER.INC' - U - IF (SUBNUM.EQ.0) THEN - COUNT = 00 - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - LAST_NEWS_READ(1,J) = LAST_NEWS_READ(1,J+1) - LAST_NEWS_READ(2,J) = LAST_NEWS_READ(2,J+1) - END DO - E - LAST_NEWS_READ(1,FOLDER_MAX) = 0 - LAST_NEWS_READ(2,FOLDER_MAX) = 0 - ELSED - COUNT = COUNT + 1S - END IF' - G - IF (COUNT.LE.FOLDER_MAX) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT)E - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE. - SUBNUM = 0 - END IF= - - RETURNR - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES)E -CA -C SUBROUTINE NEW_NOTIFICATION -C - - IMPLICIT INTEGER (A-Z)P - O - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'H - E - COMMON /READIT/ READITN - S - COMMON /POINT/ BULL_POINT - N - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)_ - L - CHARACTER*1 DUMMY - T - MESSAGES = .FALSE.N - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER',DUMMY)) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - IF (MSGNUM.EQ.0) RETURN - E - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1M - T - DO WHILE (SUBNUM.GT.0)E - IER = 1E - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)N - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THENT - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START) - ELSE IF (IER.NE.0) THEN, - SUBNUM = -1 - ELSE IF (MSGNUM.GE.F_NBULL) THENS - IER = 1I - END IFC - END IFY - IF (IER.EQ.0.AND.SUBNUM.GT.0) THENL - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR.F - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR., - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (DIFF.GT.0) IER = 1' - END IF - END IFX - END IF, - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN - WRITE (6,'('' There are new messages in folder '',R - & A,''.'',$)') FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP)) - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A,''.'',$)') FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP)) - ELSE+ - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THENE - CALL LOGIN_FOLDERV - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THENE - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY. - BULL_POINT = SAVE_BULL_POINT( - END DOR - END IF( - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IF0 - END IF - END DOR - - CALL CLOSE_BULLNEWS - D - RETURNP - END - F - E - N - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)R - Q - IMPLICIT INTEGER (A-Z) - D - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX) THEN. - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF= - L - I = NEWS_FIND_SUBSCRIBE() - P - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) - - RETURNN - END - - A - R - T - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER) - I - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLUSER.INC'_ - S - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX) THENI - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IFS - - I = NEWS_FIND_SUBSCRIBE() - ( - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15)E - - RETURN - END - - - D - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() - E - IMPLICIT INTEGER (A-Z)F - E - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC'F - E - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBERD - & .AND.I.LE.FOLDER_MAX) - I = I + 1 - END DO( - E - NEWS_FIND_SUBSCRIBE = I - Z - RETURNC - END - 3 - O - A - D - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - C - IMPLICIT INTEGER (A-Z)N - T - INCLUDE 'BULLUSER.INC') - ) - I = NEWS_FIND_SUBSCRIBE() - T - IF (I.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF) - I - IF (NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY cannot be set for news folder.'')') - RETURN - END IFI - - IF (READNEW.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - E - RETURN7 - END diff --git a/decus/vax90b1/bulletin/bullmain.cld b/decus/vax90b1/bulletin/bullmain.cld deleted file mode 100644 index 08e259b..0000000 --- a/decus/vax90b1/bulletin/bullmain.cld +++ /dev/null @@ -1,30 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vax90b1/bulletin/bullstart.com b/decus/vax90b1/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vax90b1/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vax90b1/bulletin/create.com b/decus/vax90b1/bulletin/create.com deleted file mode 100644 index b076e1c..0000000 --- a/decus/vax90b1/bulletin/create.com +++ /dev/null @@ -1,19 +0,0 @@ -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN0 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN1 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN2 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN3 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN4 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN5 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN6 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN7 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN8 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN9 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB; -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vax90b1/bulletin/dclremote.com b/decus/vax90b1/bulletin/dclremote.com deleted file mode 100644 index 97f40f0..0000000 --- a/decus/vax90b1/bulletin/dclremote.com +++ /dev/null @@ -1,32 +0,0 @@ -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET diff --git a/decus/vax90b1/bulletin/handout.txt b/decus/vax90b1/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vax90b1/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vax90b1/bulletin/install.com b/decus/vax90b1/bulletin/install.com deleted file mode 100644 index 263ed60..0000000 --- a/decus/vax90b1/bulletin/install.com +++ /dev/null @@ -1,18 +0,0 @@ -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vax90b1/bulletin/install_remote.com b/decus/vax90b1/bulletin/install_remote.com deleted file mode 100644 index 5e9e9aa..0000000 --- a/decus/vax90b1/bulletin/install_remote.com +++ /dev/null @@ -1,130 +0,0 @@ -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL diff --git a/decus/vax90b1/bulletin/instruct.com b/decus/vax90b1/bulletin/instruct.com deleted file mode 100644 index 49627f6..0000000 --- a/decus/vax90b1/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vax90b1/bulletin/instruct.txt b/decus/vax90b1/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vax90b1/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vax90b1/bulletin/login.com b/decus/vax90b1/bulletin/login.com deleted file mode 100644 index e4302af..0000000 --- a/decus/vax90b1/bulletin/login.com +++ /dev/null @@ -1,28 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vax90b1/bulletin/makefile b/decus/vax90b1/bulletin/makefile deleted file mode 100644 index 9ace1ca..0000000 --- a/decus/vax90b1/bulletin/makefile +++ /dev/null @@ -1,74 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V1.92" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin9.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vax90b1/bulletin/nonsystem.txt b/decus/vax90b1/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vax90b1/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vax90b1/bulletin/pmdf.com b/decus/vax90b1/bulletin/pmdf.com deleted file mode 100644 index e0b489b..0000000 --- a/decus/vax90b1/bulletin/pmdf.com +++ /dev/null @@ -1,747 +0,0 @@ -$set nover -$copy sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using PMDF V3.1. If using V3.2, use the copy of BULLETIN_MASTER which -comes with the PMDF installation. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows: - - LINK BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - -and put the .EXE in PMDF_ROOT:[EXE]. Put the new MASTER.COM in PMDF_ROOT:[EXE]. -NOTE: Check your MASTER.COM, as the latest version of PMDF contains the code -necessary to check for bulletin mail. However, it will not necessary have the -latest copy of BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders. After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vax90b1/bulletin/remote.com b/decus/vax90b1/bulletin/remote.com deleted file mode 100644 index 9ec5a2e..0000000 --- a/decus/vax90b1/bulletin/remote.com +++ /dev/null @@ -1,48 +0,0 @@ -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/allmacs.mar b/decus/vax90b1/bulletin/vlt90b/bulletin/allmacs.mar deleted file mode 100644 index f8a6793..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/allmacs.mar +++ /dev/null @@ -1,270 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - - .END diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulldir.inc b/decus/vax90b1/bulletin/vlt90b/bulletin/bulldir.inc deleted file mode 100644 index 640dc6c..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulldir.inc +++ /dev/null @@ -1,33 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(LINE_LENGTH) diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin.for b/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin.for deleted file mode 100644 index 01ad989..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin.for +++ /dev/null @@ -1,1623 +0,0 @@ -C -C BULLETIN.FOR, Version 11/27/90 -C Purpose: Bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER*132 DCL_CMD - - CHARACTER*42 PROMPT - - DCL_COMMAND = 0 - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,'"') - IF (DCL_COMMAND.EQ.0) THEN - CALL CLI$DCL_PARSE('BULLETIN '//INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL CLI$DCL_PARSE('BULLETIN '//INCMD(:DCL_COMMAND-1), - & BULLETIN_MAINCOMMANDS) - DCL_CMD = INCMD(DCL_COMMAND+1:) - IF (DCL_CMD(TRIM(DCL_CMD):).EQ.'"') THEN - DCL_CMD = DCL_CMD(:TRIM(DCL_CMD)-1) - END IF - END IF - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - END IF - CALL LIB$REVERT - - READIT = 0 - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP')) THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - CALL RUN_BULLCP ! doing what BULLCP does! - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL SHOW_SYSTEM - CALL EXIT - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (DCL_COMMAND.EQ.0) CALL NEW_MESSAGE_NOTIFICATION - - CALL OPEN_OLD_TAG - - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (1) - - IF (DCL_COMMAND.EQ.0) THEN - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9') - IER = IER - 1 - END DO - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - IER = MIN(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' - ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN - FOLDER_COUNT = -1 - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) - INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - CALL ADD - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ(READ_COUNT,BULL_POINT-1) ! Try to read previous bull - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER')) THEN ! /FOLDER specified? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 99999 - CALL READ(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.) - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEXT') THEN ! NEXT? - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ(READ_COUNT,BULL_READ) - ELSE - CALL READ(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - CALL REPLY - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (NBULL.GT.0) THEN - DIFF = COMPARE_BTIM( - & LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - END IF - END IF - END DO - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.) - END IF - -100 CONTINUE - - IF (DCL_COMMAND.GT.0.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER*(LINE_LENGTH) INDESCRIP - - CHARACTER INLINE*80,OLD_FOLDER*25,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF (CLI$PRESENT('EXTRACT')) THEN - IF (.NOT.((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If no /EDIT - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - ELSE IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (.NOT.ALLOW.AND..NOT.FOLDER_SET) THEN ! If no privileges - WRITE(ERROR_UNIT,1081) ! Tell user - GO TO 910 ! and abort - ELSE IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - WRITE (INEXTIME,'(I4)') NODE_NUMBER - WRITE (INEXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - INDESCRIP = DESCRIP ! Use description with RE:, - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)).AND. - & .NOT.DECNET_PROC) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IF - - ICOUNT = 0 ! Line count for bulletin - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - LUSER = TRIM(USERNAME) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - BRDCST = .FALSE. - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - FROM = USERNAME ! Username - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - CALL STORE_BULL(LNODE+LUSER+6,'From: '// - & LOCAL_NODE(:LNODE)//USERNAME(:LUSER),OBLOCK) - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF - CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - CALL ADD_ENTRY ! Add the new directory entry - - IF (FOLDER_NUMBER.GE.0) THEN - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add - ELSE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (CLI$PRESENT('EXTRACT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1081 FORMAT (' ERROR: SETPRV privileges are needed to permanent - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*23 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER LOCALNODE*8,RESPONSE*1 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE(4) - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE (4) - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE.NE.'n'.AND.RESPONSE.NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP) - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - DESCRIP = 'RE: '//DESCRIP - ELSE - DESCRIP = 'RE:'//DESCRIP(4:) - END IF - WRITE (6,'(1X,A)') DESCRIP - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($UAIDEF)' - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*255 COMMAND - - DATA CAPTIVE /0/ - - IF (CAPTIVE.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) ! Get address of itemlist - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - CAPTIVE = 1 - IF ((FLAGS.AND.UAI$M_CAPTIVE).NE.0) CAPTIVE = -1 - END IF - - IF (CAPTIVE.EQ.-1) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')') - RETURN - END IF - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - CALL LIB$SPAWN('$'//COMMAND(:CLEN)) - ELSE - CALL LIB$SPAWN() - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*15 PROCESS - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - RETURN - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin0.for b/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin0.for deleted file mode 100644 index 51b0be0..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin0.for +++ /dev/null @@ -1,1636 +0,0 @@ -C -C BULLETIN0.FOR, Version 11/27/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE DELETE -C -C SUBROUTINE DELETE -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,DESCRIP - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(1:11) - NEWEST_EXTIME = INPUT(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - DO BULL_DELETE = SBULL,EBULL - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM) - IER = SYS$ASCTIM(,INPUT,EX_BTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:) - - CALL WRITEDIR(0,IER) - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - - CHARACTER START_PARAMETER*16,DATETIME*23,SEARCH_STRING*80 - - INTEGER TODAY(2) - - CHARACTER*9 EXPIRES - - CHARACTER TIMBUF*13 - DATA TIMBUF/'0 00:00:05.00'/ - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM(TIMBUF,TIMADR) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (INCMD(:3).EQ.'DIR'.AND..NOT.READ_TAG) THEN - SUBJECT = CLI$PRESENT('SUBJECT') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').AND. - & CLI$PRESENT('MARKED')) THEN - IF (FOLDER_NUMBER.GE.0) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: Cannot use /MARKED with'', - & '' remote folder.'')') - RETURN - END IF - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - IER = CLI$GET_VALUE('START',START_PARAMETER,ILEN) - DECODE(ILEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEN - DIR_COUNT = NBULL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - END IF - - CALL READDIR_KEYGE(IER) - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - RETURN - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IF (CLI$PRESENT('SEARCH')) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - END IF - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only MARKED messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - IF (.NOT.(CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW') - & .OR.CLI$PRESENT('START'))) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - END IF - - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - IER1 = 0 - IER = 0 - FBULL = 0 - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) THEN - EBULL = DIR_COUNT - FBULL = EBULL + 1 - END IF - FBULL = FBULL - 1 - IF (EBULL-FBULL.EQ.(PAGE_LENGTH-7)-1) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (FBULL.EQ.FIRST_BULL) THEN - CALL READDIR(EBULL,IER) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT) - DO WHILE (IER.EQ.0.AND.EBULL-FBULL.LT.(PAGE_LENGTH-7)-1) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT) - IF (IER.EQ.0) EBULL = EBULL + 1 - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT) - END DO - IF (IER.NE.0) EBULL = DIR_COUNT - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THEN - EBULL = NBULL - END IF - IF (SUBJECT.OR.REPLY.OR.SEARCH) THEN - CONTINUE - ELSE IF (.NOT.REMOTE_SET.AND..NOT.READ_TAG) THEN - DO I = SBULL,EBULL - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - END DO - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - SBULL = DIR_COUNT - I = SBULL - END IF - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVE - END IF - END IF - END IF - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,SBULL,EBULL - IF (IER.EQ.0) THEN - I = SBULL - DO WHILE (IER.EQ.0.AND.I.LE.EBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - RETURN - END IF - END IF - ELSE - NBULL = 0 - END IF - - IF (NBULL.EQ.0) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - WRITE (6,'('' There are no messages present.'')') - RETURN - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - FLEN = TRIM(FOLDER) - WRITE(6,'(X,A)') FOLDER(:FLEN) - IF (EXPIRATION) THEN - WRITE(6,1005) ! Write header - ELSE - WRITE(6,1000) ! Write header - END IF - N = 3 - - IF (.NOT.(SUBJECT.OR.REPLY.OR.SEARCH).AND. - & BULL_TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(1:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - IF (BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - MSG_NUM = -MSG_NUM - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) START_SEARCH = I - 1 - IF (SUBJECT.OR.REPLY.OR.SEARCH) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH) CALL OPEN_BULLFIL_SHARED - CLOSED_FILES = .FALSE. - END IF - DO WHILE (I.LE.EBULL) - IF (.NOT.(SUBJECT.OR.REPLY.OR.SEARCH)) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (CLOSED_FILES) THEN - CLOSED_FILES = .FALSE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH) CALL OPEN_BULLFIL_SHARED - END IF - CALL GET_SEARCH(FOUND,SEARCH_STRING,START_SEARCH,.FALSE. - & ,SUBJECT,REPLY_FIRST,.FALSE.,.TRUE.) - IF (INCMD(1:3).NE.' '.AND.BULL_TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - CALL READDIR(FOUND,IER) - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - CALL READDIR(FOUND,IER) - MSG_NUM = -MSG_NUM - END IF - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.LE.EBULL) THEN - CALL CONVERT_ENTRY_FROMBIN - IF (MSG_NUM.LT.0.OR.READ_TAG) THEN - WRITE (6,'('' *'',$)') - IF (MSG_NUM.LT.0) MSG_NUM = -MSG_NUM - ELSE - WRITE (6,'('' '',$)') - END IF - IF (MSG_NUM.GT.999) N = 4 - IF (MSG_NUM.GT.9999) N = 5 - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM,'(DELETED)' - ELSE IF (EXPIRATION) THEN - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Permanent bulletin? - EXPIRES = 'Permanent' - ELSE - EXPIRES = EXDATE(1:7)//EXDATE(10:11) - END IF - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM,EXPIRES - ELSE - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM, - & DATE(1:7)//DATE(10:11) - END IF - END IF - I = I + 1 - IF (SUBJECT.OR.REPLY.OR.SEARCH) IER = SYS$CANTIM(,) - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (SEARCH.OR.REPLY.OR.SUBJECT) THEN - IF (SEARCH) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IF - - IF (DIR_COUNT.GT.NBULL.OR.(READ_TAG.AND.IER1.NE.0)) THEN - ! Outputted all entries? - DIR_COUNT = -1 ! Yes. Set counter to -1. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - -2010 FORMAT('+',I,1X,A<55-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER) - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1015) - RETURN - END IF - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And return - END IF - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - DO FBULL = SBULL,EBULL - IF (FBULL.GT.SBULL.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1) THEN ! Was bulletin found? - WRITE(6,1030) FBULL - IF (FBULL.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_PARAMETER(1:LEN_P) - ! Show name of file created. - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - - RETURN - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message(s) written to ',A) -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*23,INREAD*1 - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - ELSE - RETURN ! Don't notify - END IF - END IF - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry - READ_BTIM(2) = NEW_BTIM(2) - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - ELSE - LOGIN_BTIM_SAVE(1) = NEW_BTIM(1) - LOGIN_BTIM_SAVE(2) = NEW_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - BBOARD_BTIM(1) = TODAY_BTIM(1) - BBOARD_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_BBOARD_PROCESS - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compare - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - LOGIN_BTIM_NEW(1) = LOGIN_BTIM(1) - LOGIN_BTIM_NEW(2) = LOGIN_BTIM(2) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - -C -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible. -C - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IF - - IF (REMOTE_SET) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - LOGIN_BTIM(1) = LAST_SYS_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_SYS_BTIM(2,FOLDER_NUMBER+1) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - LOGIN_BTIM(1) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST2(SET_FLAG,FOLDER_NUMBER) - & .AND..NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(1) - LOGIN_BTIM_NEW(1) = LOGIN_BTIM(1) - LOGIN_BTIM_NEW(2) = LOGIN_BTIM(2) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - LOGIN_BTIM(1) = SYSTEM_LOGIN_BTIM(1) ! Use specified login time - LOGIN_BTIM(2) = SYSTEM_LOGIN_BTIM(2) ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - LOGIN_BTIM_OLD(1) = LOGIN_BTIM(1) - LOGIN_BTIM_OLD(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(1) - LOGIN_BTIM_NEW(1) = LOGIN_BTIM(1) - LOGIN_BTIM_NEW(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = LOGIN_BTIM_OLD(1) - LOGIN_BTIM(2) = LOGIN_BTIM_OLD(2) - END IF - CALL CLOSE_BULLUSER - END IF - - IF (READIT.EQ.1) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - LOGIN_BTIM(1) = LAST_SYS_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_SYS_BTIM(2,FOLDER_NUMBER+1) - END IF - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LOGIN_BTIM_NEW(1) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LOGIN_BTIM_NEW(2) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF (.NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,NBULL - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,NBULL,START - END IF - IF (IER.EQ.0) THEN - ALL_DIR = ALL_DIR1 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.NBULL) - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - END DO - END IF - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - ALL_DIR = ALL_DIR1 - END IF - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - ! No. Is bulletin system or from same user? - IF (.NOT.REVERSE) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (SYSTEM_SWITCH) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - ELSE - DIFF = -1 - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0) THEN ! And save only the first non-system msg - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) '+'//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) '+'//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - ELSE - PAGE = PAGE + 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) ' '//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) ' '//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER(1:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER(1:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - IF (SYSTEM.GT.9999) THEN ! # Digits in message number - N = 5 - ELSE IF (SYSTEM.GT.999) THEN - N = 4 - ELSE - N = 3 - END IF - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD,INREAD) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:56-N),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:56-N),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST2(SET_FLAG,FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - ELSE - FLEN = TRIM(FOLDER) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 49 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-48)// - & ' command can be used to read these messages.' - ELSE - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-49-FLEN) - & //' '//FOLDER(:FLEN)// - & ' command can be used to read these messages.' - END IF - END IF - -9999 IF (LOGIN_SWITCH) THEN - LOGIN_BTIM(1) = LOGIN_BTIM_NEW(1) - LOGIN_BTIM(2) = LOGIN_BTIM_NEW(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM_OLD(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM_OLD(2) - END IF - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<57-N>,1X,A12,1X,A6,<6-N>X,I) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IF - - RETURN - END - diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin1.for b/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin1.for deleted file mode 100644 index 20d3af8..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin1.for +++ /dev/null @@ -1,1603 +0,0 @@ -C -C BULLETIN1.FOR, Version 11/27/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (MAIL_SUBJECT(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - MAIL_SUBJECT(I:I) = '`' - ELSE - MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_P = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_P = LEN_P + I + 1 - BULL_PARAMETER(LEN_P:LEN_P) = ',' - END DO - LEN_P = LEN_P - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:I)//'""'// - & BULL_PARAMETER(I+1:) - I = I + 2 - LEN_P = LEN_P + 2 - END IF - I = I + 1 - END DO - - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) - & //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,STATUS) - CALL ENABLE_PRIVS - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - EXTERNAL BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*25 - - IF (CLI$PRESENT('ORIGINAL').AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - END IF - END IF - - FROM_REMOTE = REMOTE_SET - - IF (REMOTE_SET) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.0) THEN - CALL OPEN_BULLFIL - I = BULL_POINT - 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THEN - IF (I.EQ.0) THEN - WRITE (12,IOSTAT=IER1) BULLDIR_HEADER - ELSE - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - END IF - NBLOCK = 1 - DO WHILE (I.LT.BULL_POINT+NUM_COPY-1.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1) THEN - BLOCK = NBLOCK - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - IF (IER1.EQ.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER1) 5,I - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - END IF - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT(:128)) - WRITE (11'NBLOCK,IOSTAT=IER1) INPUT(:128) - NBLOCK = NBLOCK + 1 - END DO - END IF - IF (IER1.NE.0) I = IER - END IF - END DO - NUM_COPY = I - BULL_POINT + 1 - END IF - CALL CLOSE_BULLFIL - IF (IER1.NE.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=11) - CLOSE (UNIT=12) - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IF - - IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - CALL OPEN_BULLDIR ! Prepare to add dir entry - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND.FOLDER_NUMBER.EQ.0.AND. - & .NOT.SETPRV_PRIV().AND..NOT.ALL) THEN ! Permanent? - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.CLI$PRESENT('ORIGINAL')) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END DO - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - CLOSE (UNIT=11) - - CLOSE (UNIT=12) - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0) THEN - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE - END IF - END IF - - RETURN - - END - - - - - SUBROUTINE PRINT -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*31 FORM_NAME - - PARAMETER FF = CHAR(12) - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1015) - RETURN - END IF - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - CALL OPEN_BULLDIR_SHARED - - CALL OPEN_BULLFIL_SHARED - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified message - - IF (IER.NE.I+1) THEN ! Was message found? - IF (I.EQ.SBULL) THEN ! No, were any messages found? - WRITE(6,1030) ! If not, then error out - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE ! Yes, message found. - IF (I.GT.SBULL) WRITE(3,'(A)') FF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - END IF - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) ! Get queue name - IF (ILEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - ILEN = 9 - END IF - - CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IF - - IF (CLI$PRESENT('FORM')) THEN - IER = CLI$GET_VALUE('FORM',FORM_NAME,FORM_NAME_LEN) - CALL ADD_2_ITMLST(FORM_NAME_LEN,SJC$_FORM_NAME,%LOC(FORM_NAME)) - END IF - - CALL DISABLE_PRIVS - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*11,DATETIME*23,BUFFER*(LINE_LENGTH) - CHARACTER SAVE_MSG_KEY*8,PREV_MSG_KEY*8 - - LOGICAL SINCE,PAGE - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - IF (CLI$PRESENT('MARKED')) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No marked messages found.'')') - RETURN - ELSE - READ_TAG = .TRUE. - END IF - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - END IF - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - RETURN - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IF - - IF (READ_TAG) THEN - NEXT = .FALSE. - IF (INCMD(:4).EQ.'NEXT'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - IF (.NOT.CLI$PRESENT('BULLETIN_NUMBER')) NEXT = .TRUE. - END IF - IF (INCMD(:4).EQ.'BACK') THEN - SAVE_MSG_KEY = MSG_KEY - MSG_KEY = BULLDIR_HEADER - I = 0 - IER = 0 - CALL OPEN_BULLDIR_SHARED - DO WHILE (IER.EQ.0.AND.MSG_KEY.NE.SAVE_MSG_KEY) - I = I + 1 - IF (MSG_KEY.NE.SAVE_MSG_KEY) PREV_MSG_KEY = MSG_KEY - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO - IF (IER.EQ.0) THEN - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IER = 0 - IF (BULL_POINT.EQ.0) CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_READ) - DO WHILE (IER.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO - CALL CLOSE_BULLDIR - IER = BULL_READ + 1 - ELSE IF (NEXT) THEN - IF (SINCE) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - ELSE - IF (BULL_POINT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END IF - IF (IER.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ) - IF (IER1.NE.0) IER = 0 - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - RETURN - END IF - - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2) - END IF - - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'CURR') THEN - IF (CLI$PRESENT('EDIT')) THEN - CALL READ_EDIT - RETURN - END IF - END IF - - FLEN = TRIM(FOLDER) - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - WRITE (INPUT,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULL - DO WHILE (INDEX(INPUT,' ').LT.TRIM(INPUT)) - I = INDEX(INPUT,' ') - INPUT(I:) = INPUT(I+1:) - END DO - I = TRIM(INPUT) - INPUT = ' #'//INPUT(2:TRIM(INPUT)) - INPUT(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//INPUT(:TRIM(INPUT)) - ELSE - WRITE(6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - - END = END + 1 - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - WRITE(6,'('' From: '',A)') FROM - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - ELSE - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - END IF - WRITE(6,'('' Subj: '',A)') DESCRIP - END = END + 1 - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - WRITE(6,'(1X)') - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE (BUFFER,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULL - DO WHILE (INDEX(BUFFER,' ').LT.TRIM(BUFFER)) - I = INDEX(BUFFER,' ') - BUFFER(I:) = BUFFER(I+1:) - END DO - BUFFER = ' #'//BUFFER(2:TRIM(BUFFER)) - BUFFER(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN) - WRITE(6,'(1X,A,/)') BUFFER(:TRIM(BUFFER)) ! Output header info - END = END + 2 ! Increase display counter - END IF - -200 SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - DISPLAY = 0 - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - - RETURN - -1030 FORMAT(' ERROR: Specified message was not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE READ_EDIT - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_BULLFIL - - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,' Date: ',A) - - RETURN - END - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - CHARACTER INREAD*1,FILE_DEF*80,NUMREAD*5 - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH,ERR=18,STATUS='UNKNOWN', - & CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END DO - IF (ILEN.EQ.0) WRITE(6,1040) BULL_PARAMETER(:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - IF (READ_COUNT.GT.0) THEN ! Reposition GET_BULL routine - ILEN = LINE_LENGTH + 1 ! in case read in progress - DO I=1,LINE_OFFSET ! and partial block was read. - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - END IF - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message - & number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit), - & F(File it), D(Dir), R(Read msg #) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit), F(File), N(Next), - & D(Dir), R(Read msg #) or other for MORE: ',$) -1040 FORMAT(' Message written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin2.for b/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin2.for deleted file mode 100644 index 189f9d6..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin2.for +++ /dev/null @@ -1,1638 +0,0 @@ -C -C BULLETIN2.FOR, Version 11/27/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23,RESPONSE*1 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*11,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,FOLDER_SAVE*25 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for GENERAL folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND(STATUS) -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FROM_TEST*5,INFROM*(LINE_LENGTH) - - EXTERNAL CLI$_NEGATED - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP) - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - BULL_PARAMETER = 'RE: '//DESCRIP - ELSE - BULL_PARAMETER = 'RE:'//DESCRIP(4:) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P) - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - IF (EDIT.AND.TEXT) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - LENFRO = 0 - IF (CLI$GET_VALUE('CC',INPUT,ILEN)) THEN - INFROM = INPUT(:ILEN)//',' - LENFRO = ILEN + 1 - END IF - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INFROM(:LENFRO)//INPUT(7:) - LENFRO = LENFRO + ILEN - 6 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (CLI$PRESENT('LIST')) THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - - IF (INCMD(:4).EQ.'POST') LENFRO = 0 - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (CLI$PRESENT('LIST')) THEN - LIST = INDEX(FOLDER_DESCRIP,'<') - IF (LIST.GT.0) THEN - INFROM = INFROM(:LENFRO)// - & FOLDER_DESCRIP(LIST+1:TRIM(FOLDER_DESCRIP)-1) - LENFRO = LENFRO + TRIM(FOLDER_DESCRIP) - 1 - LIST - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - LEN_P = TRIM(BULL_PARAMETER) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - IF (LEN_P.EQ.64) THEN - BULL_PARAMETER(I:I) = '`' - ELSE - BULL_PARAMETER = BULL_PARAMETER(:I)//'"' - & //BULL_PARAMETER(I+1:) - I = I + 1 - LEN_P = LEN_P + 1 - END IF - END IF - I = I + 1 - END DO - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - IF (TEXT) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//INFROM(:LENFRO) - & //'"/SUBJECT="'//BULL_PARAMETER//'"',,,,,,STATUS) - ELSE - CALL LIB$SPAWN('$MAIL SYS$INPUT "'//INFROM(:LENFRO)// - & '"/SUBJECT="'//BULL_PARAMETER//'"',,,,,,STATUS) - END IF - CALL ENABLE_PRIVS - -900 IF (EDIT) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: Replaces existing bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH) - CHARACTER*1 ANSWER - - CHARACTER DATE_SAVE*11,TIME_SAVE*11 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL*1 DOALL - -C -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - TEXT = CLI$PRESENT('TEXT') - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.TEXT).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')') - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I5,'' cannot be found.'')') - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - LENFROM = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:59) ! Update description header - END IF - CALL UPDATE_DIR_HEADER(CLI$PRESENT('EXPIRATION').OR.DOALL, - & CLI$PRESENT('PERMANENT'),CLI$PRESENT('SHUTDOWN'), - & INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT')) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION')) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:59),MSGTYPE,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER TODAY*23,INEXDATE*11,INEXTIME*11 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*132 SEARCH_STRING - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IF - - IER1 = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - - CALL GET_SEARCH(FOUND,SEARCH_STRING,START_BULL, - & CLI$PRESENT('REVERSE'),CLI$PRESENT('SUBJECT'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START')) - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - WRITE (6,'('' No messages found with given search string.'')') - ELSE IF (FOUND.EQ.-2) THEN - WRITE (6,'('' ERROR: No more messages.'')') - END IF - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,START_BULL,REVERSE, - & SUBJECT,REPLY,FILES,START) -C -C SUBROUTINE GET_SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) SEARCH_STRING - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - CHARACTER*53 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN - SEARCH_MODE = 3 - ELSE - SEARCH_MODE = 2 - END IF - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - ELSE IF (REPLY) THEN - CALL READDIR(START_BULL,IER) - IF (START_BULL+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - END IF - - SAVE_STRING = SEARCH_STRING - SEARCH_LEN = TRIM(SAVE_STRING) - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR. - & REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last - END IF - IF (REVERSE) THEN - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - DO BULL_SEARCH = START_BULL+1, END_BULL, STEP_BULL - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - CALL STR$UPCASE(DESCRIP1,DESCRIP) ! Make upper case - IF ((SEARCH_MODE.EQ.3.AND. - & INDEX(DESCRIP1,SEARCH_STRING(:SEARCH_LEN)).GT.0).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1))) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - GO TO 900 - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - GO TO 900 - END IF - END DO - END IF - END DO - - FOUND = 0 - -900 IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN - END - - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')') - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin3.for b/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin3.for deleted file mode 100644 index b67007b..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin3.for +++ /dev/null @@ -1,1738 +0,0 @@ -C -C BULLETIN3.FOR, Version 11/27/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*11 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - EXTIME(3:4) = EXTIME(4:5) - READ (EXTIME(1:4),'(I4)') NODE_NUMBER_MSG - EXTIME(9:10) = EXTIME(10:11) - READ (EXTIME(7:10),'(I4)') NODE_AREA_MSG - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.GT.0) NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 EXPDAT - CHARACTER*23 TODAY - - DIMENSION EXTIME(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF ((DEFAULT_EXPIRE.GT.F_EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.F_EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3)) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:),TODAY(13:)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - IF (MAIL_EDIT.EQ.' ') THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - IF (MAIL_EDIT.EQ.' ') THEN - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - ELSE - IER = SS$_NORMAL - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) ! Convert to upper case - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0.AND. - & IER.EQ.SS$_NORMAL) THEN - IF (OUT.EQ.INFILE) THEN - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT))) - ELSE - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - END IF - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0.OR. - & IER.NE.SS$_NORMAL) THEN - CALL EDT$EDIT(INFILE,OUT) - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (.NOT.IER1) THEN - CALL TPU$EDIT(' ',OUT) - ELSE - CALL TPU$EDIT(INFILE,OUT) - END IF - IER1 = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - ! TPU does CLI$ stuff which wipes our parsed command line - END IF - CALL ENABLE_PRIVS - - RETURN - END - - - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($JPIDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PQLDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15 - - STRUCTURE /QUOTA_ITMLST/ - BYTE ITEM - INTEGER VALUE - END STRUCTURE - - RECORD /QUOTA_ITMLST/ QUOTA(3) - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXIT - END IF - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1 - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP') - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - I = 1 - IER = CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(I).ITEM = PQL$_PGFLQUOTA - QUOTA(I).VALUE = PGFLQUOTA - I = I + 1 - END IF - IER = CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - QUOTA(I).ITEM = PQL$_WSEXTENT - QUOTA(I).VALUE = WSEXTENT - I = I + 1 - END IF - QUOTA(I).ITEM = PQL$_LISTEND - QUOTA(I).VALUE = 0 - - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0)) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*1 DUMMY - - IER = SYS_TRNLNM('BULL_BULLCP',DUMMY) - IF (IER) BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - CHARACTER*23 OLD_TIME,NEW_TIME - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - DO WHILE (1) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - CALL SYS$SETAST(%VAL(1)) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Do empty block - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Cleanup deleted users from - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! data files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - - OLD_TIME = NEW_TIME - CALL WAIT('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL REGISTER_BULLCP - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER NODENAME*8 - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - END IF - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE WAIT(PARAM) -C -C SUBROUTINE WAIT -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(6:7) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(2)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(9:10) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - - SUBROUTINE DELETE_EXPIRED - -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER UPTIME_DATE*11,UPTIME_TIME*11 - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD.EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - IF (INDEX(INTO,FOLDER_BBOARD(:FLEN)).EQ.0.AND. - & INTO.NE.FOLDER_BBOARD.AND.INDEX(INTO,'@').EQ.0) THEN - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOLDER1_BBOARD = FOLDER_BBOARD - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - FOLDER_Q2_SAVE = FOLDER_Q2 - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - FLEN = TRIM(FOLDER1_BBOARD) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD.NE.'NONE') THEN - IF (INTO.EQ.FOLDER1_BBOARD) THEN - FOUND = .TRUE. - ELSE - FIND_TO = INDEX(INTO,FOLDER1_BBOARD(:FLEN)) - IF (FIND_TO.GT.0) THEN - END_TO = FLEN+FIND_TO - IF (TRIM(INTO).LT.END_TO.OR. - & INTO(END_TO:END_TO).LT.'A'.OR. - & INTO(END_TO:END_TO).GT.'Z') THEN - IF (FIND_TO.EQ.1) THEN - FOUND = .TRUE. - ELSE IF (INTO(FIND_TO-1:FIND_TO-1).LT.'A'.OR. - & INTO(FIND_TO-1:FIND_TO-1).GT.'Z') THEN - FOUND = .TRUE. - END IF - END IF - END IF - END IF - END IF - END DO - IF (FOUND) THEN - FOLDER_COM = FOLDER1_COM - FOLDER_Q_SAVE = FOLDER_Q2_SAVE - END IF - END IF - - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=14) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - WRITE (6,1030) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_BBOARD_PROCESS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER*132 IMAGENAME - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,,'BBOARD',%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD.NE.'NONE') THEN ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DO - - CALL CLOSE_BULLDIR - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - CALL CLOSE_BULLDIR - - RETURN - END diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin4.for b/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin4.for deleted file mode 100644 index 07d40c5..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin4.for +++ /dev/null @@ -1,1776 +0,0 @@ -C -C BULLETIN4.FOR, Version 6/6/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - READ (4,IOSTAT=IER) USER_ENTRY ! Skip header - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':') THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - DATA POINT/0/ - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = 0 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - IBLOCK = SBLOCK ! Initialize pointers. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,ILEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C ILEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns ILEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(LINE_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? - IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - ILEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - ILEN = -1 ! ILEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - ILEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - BUFFER = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) ! Output line. - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(ILEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - ILEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - ILEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (ILEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = ILEN - (BRECLEN-POINT) ! Store leftover length - ILEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (ILEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(ILEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - ILEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - ILEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ILEN.GT.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - IF (BTEST(FOLDER_FLAG,1)) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -900 CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - CALL WRITEDIR(0,IER) - -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privileged - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'( - & '' ERROR: No privs for SYSTEM, NOTIFY, BRIEF or READNEW.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - LENDES = 0 - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_OWNER = FOLDER1_OWNER - - IF (CLI$PRESENT('SYSTEM')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - END IF - - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -C -C Description: -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*255 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin5.for b/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin5.for deleted file mode 100644 index 145e949..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin5.for +++ /dev/null @@ -1,1859 +0,0 @@ -C -C BULLETIN5.FOR, Version 10/15/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_NEGATED - - ALL = .FALSE. - DEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - - RETURN - - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & FOLDER1.EQ.'GENERAL') THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - FOLDER_SET = .FALSE. - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER*132 DCL_CMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - EXTERNAL CLI$_ABSENT - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1) - IF (FOLDER1(1:1).EQ.'"'.AND.INCMD.EQ.'SELECT') THEN - DCL_COMMAND = 1 - DCL_CMD = FOLDER1(2:) - IF (DCL_CMD(TRIM(DCL_CMD):).EQ.'"') THEN - DCL_CMD = DCL_CMD(:TRIM(DCL_CMD)-1) - END IF - IER = %LOC(CLI$_ABSENT) - FOLDER1 = ' ' - END IF - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - - IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP - END IF - END IF - - CALL CLOSE_BULLFOLDER - END IF - - IF (IER.EQ.0.AND.FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD)) - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET = .TRUE. - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Copy remote folder protection - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - ELSE - LOCAL_FOLDER1_FLAG = IBCLR(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - REMOTE_SET = .TRUE. - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::' - & .AND..NOT.SETPRV_PRIV()) THEN - ! Is folder protected and not remote? - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND. - & IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (FOLDER1_BBOARD(:2).NE.'::') THEN - IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - END IF - - IF (IER) THEN - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0) THEN - IF (TEST_BULLCP().GT.0) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (FOLDER_NUMBER.GE.0.AND.CLI$PRESENT('MARKED')) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - IF (INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only marked messages'', - & '' will be shown.'')') - ELSE - WRITE(6,'('' ERROR: No marked messages found.'')') - END IF - END IF - ELSE - READ_TAG = .FALSE. - END IF - END IF - - IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - RETURN - - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /READIT/ READIT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*25 FOLDER_SAVE - - DIMENSION DUMMY(4) - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - IF (SYSLOG) THEN - LAST_SYS_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(3) - LAST_SYS_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(4) - END IF - END IF - IER = 0 - END IF - - RETURN - END - - - - - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & FOLDER1 = FOLDER - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Folder is a private folder.'')') - ELSE - WRITE (6,'('' Folder is not a private folder.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - CHARACTER*17 DATETIME - - IF (FOLDER_COUNT.NE.0) GO TO 50 ! Skip init steps if this is - ! not the 1st page of folder - - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE specified - ELSE - NLINE = 1 - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDER = 0 - IER = 0 - FOLDER1 = ' ' ! Start folder search - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (INDEX(FOLDER1_BBOARD,'::').EQ.0.AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - FOLDER_COUNT = 1 ! Init folder number counter - -50 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - - IF (FOLDER_COUNT.EQ.-1) THEN - FOLDER_COUNT = FIRST_FOLDER - (PAGE_LENGTH-4)/NLINE - IF (FOLDER_COUNT.LT.1) FOLDER_COUNT = 1 - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=1,FOLDER_COUNT-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - END DO - END IF - - IF (.NOT.PAGING) THEN - DISPLAY = (NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2 - ELSE - DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2,PAGE_LENGTH-4) - ! If more entries than page size, truncate output - END IF - - FIRST_FOLDER = FOLDER_COUNT - - DO I=FOLDER_COUNT,FOLDER_COUNT+(DISPLAY-2)/NLINE-1 - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - FOLDER_COUNT = FOLDER_COUNT + 1 ! Update folder counter - END DO - - IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN ! Outputted all entries? - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*1 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ELSE - ID = INPUT - INPUT = ' ' - END IF - ILEN = TRIM(ID) - IF (ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - CALL OPEN_BULLFOLDER ! Open folder file - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - ENTRY WRITE_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE - - REWRITE (7) FOLDER_COM - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP - - REWRITE (7) FOLDER1_COM - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END DO - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END DO - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END DO - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - DO I=1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin6.for b/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin6.for deleted file mode 100644 index 739cc47..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin6.for +++ /dev/null @@ -1,1603 +0,0 @@ -C -C BULLETIN6.FOR, Version 10/26/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - DATA LUN /0/ - - LUN = UNIT - 9 ! 9 gets added to LUN - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(5) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT'/ - INTEGER NAME(9) - DATA NAME/1,2,0,3,0,0,4,0,5/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - CHARACTER*25 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - DATA LUN /0/ - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED,READONLY, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_POINT - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - - IF (IER.EQ.0) THEN - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.FOLDER_RECORD/4) THEN - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(ASK_SIZE) - NTRIES = 0 - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - CALL OPEN_FILE(LUN) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE_SHARE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*115 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(1:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(1:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(78:81) = BUFFER(85:) - BULLDIR_ENTRY(90:97) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(ASK_SIZE) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*80 NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - - EODIR = MAX(INDEX(BULLFOLDER_FILE,':'),INDEX(BULLFOLDER_FILE,']')) - SUFFIX = INDEX(BULLFOLDER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLFOLDER_FILE(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.173/4) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - IF (IER.EQ.0) THEN - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,BULLFOLDER_FILE) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*3 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - DIR_NUM = 0 - END IF - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,0 - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_HEADER_FROMBIN - RETURN - END IF - END IF - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' ') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I3)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (MSG_NUM.NE.ICOUNT) IER = 36 - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) BULLDIR_ENTRY - END IF - END DO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - DIR_NUM = -1 - END IF - ELSE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - END IF - END IF - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - UNLOCK 2 - - RETURN - - END - - - - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If not 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) BULLDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - IER = 0 - DIR_NUM = -1 - END IF - UNLOCK 2 - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - END IF - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME - NEWEST_EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME - NEWEST_TIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME - SHUTDOWN_TIME = DATETIME(13:) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME - EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME - TIME = DATETIME(13:) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - INCLUDE 'BULLDIR.INC' - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - ELSE - IF (CONV) CALL CONVERT_ENTRY_TOBIN - MSG_NUM = BULLETIN_NUM - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - - RETURN - END - - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(1:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII)) - IF (ACLSTR(START_ID:START_ID).NE.','.AND. - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DO - IF (ASCII) THEN - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = RECL/8 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl output - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - CALL LIB$FREE_VM(ACLLENGTH+8,ACLSTR) - - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C -C SUBROUTINE COPY_ACL1 -C -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - ! Read input file acl - - IF (.NOT.IER) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin7.for b/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin7.for deleted file mode 100644 index becab25..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin7.for +++ /dev/null @@ -1,1929 +0,0 @@ -C -C BULLETIN7.FOR, Version 10/23/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - - BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(1:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_NUMBER.GT.0) THEN ! Folder private? - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - CHARACTER OUTPUT*160,TERMINAL*7,FLAGS*1 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - CHARACTER*12 SENT_TEMP_USER - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER(1:TRIM(FOLDER)) - & //'. From: '//FROM(1:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USER) - WRITE_TEMP_USER = TEMP_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USER,TERMINAL)) - READ_TEMP_USER = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USER.NE.SENT_TEMP_USER.AND. - & READ_TEMP_USER.NE.WRITE_TEMP_USER) - CALL READ_QUEUE(%VAL(READ_TEMP_USER),READ_TEMP_USER, - & SENT_TEMP_USER) - END DO - IF (TEMP_USER.NE.SENT_TEMP_USER) THEN - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_USER),WRITE_TEMP_USER, - & TEMP_USER) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TEMP_USER(:TRIM(TEMP_USER)),%VAL(BRK$C_USERNAME) - & ,,,%VAL(BFLAG),,,,) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(1:11) - NEWEST_TIME = TODAY_TIME(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:) - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00.00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*11 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM) OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:TRIM(INPUT)),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM) OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL UPDATE_USERINFO - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FILENAME*132,BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - NBLOCK = NBLOCK + LENGTH - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*11 DATE_SAVE,EXDATE_SAVE - CHARACTER*11 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - WRITE (6,'('' For the selected folder '',A)') FOLDER(1:TRIM(FOLDER)) - - IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - END IF - - IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND. - & (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (.NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER pscan$_BEGIN = '00000000'X - PARAMETER pscan$_ACCOUNT = '00000001'X - PARAMETER pscan$_AUTHPRI = '00000002'X - PARAMETER pscan$_CURPRIV = '00000003'X - PARAMETER pscan$_GRP = '00000004'X - PARAMETER pscan$_HW_MODEL = '00000005'X - PARAMETER pscan$_HW_NAME = '00000006'X - PARAMETER pscan$_JOBPRCCNT = '00000007'X - PARAMETER pscan$_JOBTYPE = '00000008'X - PARAMETER pscan$_MASTER_PID = '00000009'X - PARAMETER pscan$_MEM = '0000000A'X - PARAMETER pscan$_MODE = '0000000B'X - PARAMETER pscan$_NODE_CSID = '0000000C'X - PARAMETER pscan$_NODENAME = '0000000D'X - PARAMETER pscan$_OWNER = '0000000E'X - PARAMETER pscan$_PRCCNT = '0000000F'X - PARAMETER pscan$_PRCNAM = '00000010'X - PARAMETER pscan$_PRI = '00000011'X - PARAMETER pscan$_PRIB = '00000012'X - PARAMETER pscan$_STATE = '00000013'X - PARAMETER pscan$_STS = '00000014'X - PARAMETER pscan$_TERMINAL = '00000015'X - PARAMETER pscan$_UIC = '00000016'X - PARAMETER pscan$_USERNAME = '00000017'X - PARAMETER pscan$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER pscan$_END = '00000019'X - PARAMETER pscan$k_type = '00000081'X - PARAMETER pscan$M_OR = '00000001'X - PARAMETER pscan$M_BIT_ALL = '00000002'X - PARAMETER pscan$M_BIT_ANY = '00000004'X - PARAMETER pscan$M_GEQ = '00000008'X - PARAMETER pscan$M_GTR = '00000010'X - PARAMETER pscan$M_LEQ = '00000020'X - PARAMETER pscan$M_LSS = '00000040'X - PARAMETER pscan$M_PREFIX_MATCH = '00000080'X - PARAMETER pscan$M_WILDCARD = '00000100'X - PARAMETER pscan$M_CASE_BLIND = '00000200'X - PARAMETER pscan$M_EQL = '00000400'X - PARAMETER pscan$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER pscan$S_OR = 1 - PARAMETER pscan$V_OR = 0 - PARAMETER pscan$S_BIT_ALL = 1 - PARAMETER pscan$V_BIT_ALL = 1 - PARAMETER pscan$S_BIT_ANY = 1 - PARAMETER pscan$V_BIT_ANY = 2 - PARAMETER pscan$S_GEQ = 1 - PARAMETER pscan$V_GEQ = 3 - PARAMETER pscan$S_GTR = 1 - PARAMETER pscan$V_GTR = 4 - PARAMETER pscan$S_LEQ = 1 - PARAMETER pscan$V_LEQ = 5 - PARAMETER pscan$S_LSS = 1 - PARAMETER pscan$V_LSS = 6 - PARAMETER pscan$S_PREFIX_MATCH = 1 - PARAMETER pscan$V_PREFIX_MATCH = 7 - PARAMETER pscan$S_WILDCARD = 1 - PARAMETER pscan$V_WILDCARD = 8 - PARAMETER pscan$S_CASE_BLIND = 1 - PARAMETER pscan$V_CASE_BLIND = 9 - PARAMETER pscan$S_EQL = 1 - PARAMETER pscan$V_EQL = 10 - PARAMETER pscan$S_NEQ = 1 - PARAMETER pscan$V_NEQ = 11 - BYTE %FILL (2) - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./ - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IF - END DO - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_BULLUSER - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - - LUSER = TRIM(USERNAME) - USERNAME(LUSER:LUSER) = CHAR(128.OR.ICHAR(USERNAME(LUSER:LUSER))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME, - & ((LAST_SYS_BTIM(1,I),LAST_SYS_BTIM(2,I)),I=1,FOLDER_MAX) - USERNAME(LUSER:LUSER) = CHAR(127.AND.ICHAR(USERNAME(LUSER:LUSER))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0 - LAST_SYS_BTIM(2,I) = 0 - END DO - END IF - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF.AND.FNUM.LE.FOLDER_MAX) - DIFF = LAST_READ_BTIM(1,FNUM).NE.OLD_LAST_READ_BTIM(1,FNUM) - IF (.NOT.DIFF) THEN - DIFF = LAST_READ_BTIM(2,FNUM).NE.OLD_LAST_READ_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1 - END DO - - DIFF1 = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF1.AND.FNUM.LE.FOLDER_MAX) - DIFF1 = LAST_SYS_BTIM(1,FNUM).NE.OLD_LAST_SYS_BTIM(1,FNUM) - IF (.NOT.DIFF1) THEN - DIFF1 = LAST_SYS_BTIM(2,FNUM).NE.OLD_LAST_SYS_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1 - END DO - - IF (.NOT.(DIFF.OR.DIFF1)) RETURN - - CALL OPEN_BULLINF_SHARED - - IF (DIFF) THEN - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - - IF (DIFF1) THEN - LUSER = TRIM(USERNAME) - USERNAME(LUSER:LUSER) = CHAR(128.OR.ICHAR(USERNAME(LUSER:LUSER))) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_SYS_BTIM(1,I),LAST_SYS_BTIM(2,I)),I=1,FOLDER_MAX) - ELSE - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_SYS_BTIM(1,I),LAST_SYS_BTIM(2,I)),I=1,FOLDER_MAX) - END IF - USERNAME(LUSER:LUSER) = CHAR(127.AND.ICHAR(USERNAME(LUSER:LUSER))) - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - IF (TRIM(TIME).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(1:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - IF (NEW_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new GENERAL messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(1:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - DIFF = 0 - END IF - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/,SAVE_FOLDER_NUM/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - CALL MODIFY_SYSTEM_LIST(1) - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = -1 - FOLDER1 = 'GENERAL' - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to GENERAL folder.'')') - - RETURN - END diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin8.for b/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin8.for deleted file mode 100644 index 2a5d215..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin8.for +++ /dev/null @@ -1,1654 +0,0 @@ -C -C BULLETIN8.FOR, Version 11/28/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - CHARACTER NAMEDESC*9 /'BULLETIN1'/ - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(208,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*9 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN),IO$_READVBLK,MBX_IOSB, - & MBX_AST,,MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(208,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*6,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL CONNECT(NODENAME,USERNAME,FROMNAME) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(208,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(208),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(208,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - CHARACTER*128 INPUT - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(208,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - - IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL EXECUTE_COMMAND(UNIT_INDEX) - - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - - RETURN - END - - - - - - SUBROUTINE CONNECT(NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/ - - CHARACTER*(*) USERNAME,FROMNAME - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IF (REJECT.NE.IO_REJECT) THEN - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - - CALL READ_MBX - - RETURN - END - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(208,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(208,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(208,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(208,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*53 - CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - BULLCP_PRIV(1) = PROCPRIV(1) - BULLCP_PRIV(2) = PROCPRIV(2) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDER_NAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - NODENAME = NODE_SAVE(UNIT_INDEX) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15) THEN ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USERNAME,PRIV_SAVE(1,UNIT_INDEX)) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - PRIV_SAVE(1,UNIT_INDEX) = PROCPRIV(1) - PRIV_SAVE(2,UNIT_INDEX) = PROCPRIV(2) - END IF - END IF - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:1))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:1))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:5))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:9))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24 - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:17))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF - FOLDER_NAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP)) - CALL LIB$MOVC3(11,%REF(BUFFER(58:58)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(69:69)),%REF(EXTIME)) - CALL LIB$MOVC3(4,%REF(BUFFER(80:80)),SYSTEM) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (FOLDER_OWNER.NE.USERNAME.AND. - & F_EXPIRE_LIMIT.GT.0) THEN - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(84:84)),BROAD) - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(88:88)),BELL) - CALL LIB$MOVC3(4,%REF(BUFFER(92:92)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(97:97)),CLUSTER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:9)),%REF(MSG_KEY(1:1))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),EBULL) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP_TEMP)) - CALL LIB$MOVC3(4,%REF(BUFFER(58:58)),ICOUNT) - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(53,%REF(BUFFER(62:62)),%REF(DESCRIP)) - CALL LIB$MOVC3(4,%REF(BUFFER(115:115)),%REF(MSGTYPE)) - CALL LIB$MOVC3(11,%REF(BUFFER(119:119)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(130:130)),%REF(EXTIME)) - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE) - DESCRIP_TEMP = BUFFER(9:61) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(11,%REF(BUFFER(62:62)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(73:73)),%REF(EXTIME)) - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:5)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:13)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:1))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:13)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:17)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:21)),FOLDER_NUMBER) - FOLDER = BUFFER(25:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - END IF - -1000 PROCPRIV(1) = BULLCP_PRIV(1) - PROCPRIV(2) = BULLCP_PRIV(2) - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = -1 - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) THEN - PROCPRIV(1) = NEEDPRIV(1) - PROCPRIV(2) = NEEDPRIV(2) - END IF - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256,PASSWORD*31,TEMP_USER*12 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - RETURN - END diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin9.for b/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin9.for deleted file mode 100644 index 874f5ea..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulletin9.for +++ /dev/null @@ -1,1950 +0,0 @@ -C -C BULLETIN9.FOR, Version 10/23/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FLAGNAME - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=13,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(13,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=13) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (13,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(13,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=13,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=13) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=13) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - INCLUDE '($HLPDEF)' - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - ELSE - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - END IF - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA DISPLAY_ID/0/,KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (1) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - CHARACTER VERSION*10,DATE*23 - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - END - - - - - - - SUBROUTINE TAG(ADD_OR_DEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - IER1 = 0 - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT).AND.IER1.EQ.0) ! Get the specified messages - - DECODE(LEN_P,'(I)',BULL_PARAMETER) MESSAGE_NUMBER - - CALL READDIR(MESSAGE_NUMBER,IER) ! Get info for bulletin - - IF (IER.NE.MESSAGE_NUMBER+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER1) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Message '',I, - & '' was not marked.'')') MESSAGE_NUMBER - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found.') - - END - - - - SUBROUTINE ADD_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 TAG_KEY - - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY) - - IF (IER.EQ.FOR$IOS_INCKEYCHG) THEN - WRITE (6,'('' Message was already marked.'')') - ELSE IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to add mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE DEL_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 TAG_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - END DO - IF (IER.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to delete mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER) RETURN - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE='BULL_MARK:'// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (IER.EQ.0) BULL_TAG = .TRUE. - - RETURN - END - - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 BULL_MARK - - IER = SYS_TRNLNM('BULL_MARK',BULL_MARK) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: BULL_MARK must be defined.'', - & '' See HELP MARK.'')') - RETURN - ELSE - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1.OR.BULL_MARK.NE.BULL_PARAMETER) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = 0 - END IF - OPEN (UNIT=13,FILE='BULL_MARK:'// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - BULL_TAG = .TRUE. - IER = 1 - END IF - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - GO TO 10 - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE) - - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - & INPUT_KEY - END DO - - IF (IER.EQ.0) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - HEADER = .FALSE. - -10 DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - & INPUT_KEY - END DO - - DO WHILE (1) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (FOLDER1_NUMBER.NE.FOLDER_NUMBER.OR.IER.NE.0) THEN - IER = 1 - UNLOCK 13 - RETURN - ELSE - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE - CALL READDIR_KEYGE(IER) - END IF - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - RETURN - ELSE - DELETE (UNIT=13) - DO WHILE (REC_LOCK(IER)) - READ (13,IOSTAT=IER) INPUT_KEY - END DO - END IF - END IF - - END DO - - END - - - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. Added per request of a faculty member for his private -C board. Changes to BULLETIN.FOR should be fairly obvious. -C -C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2) -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - DATA FOLDER_Q1/0/ - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - WRITE (6,1000) - WRITE (6,1020) - DO J = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - WRITE (6,1030) FOLDER1(:15),F1_NBULL, - & FOLDER1_DESCRIP(:MIN(TRIM(FOLDER1_DESCRIP),59)) - END DO - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - READ_TAG = .FALSE. - IF (CLI$PRESENT('MARKED')) READ_TAG = .TRUE. - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1020 FORMAT (' Name Count Description'/) -1030 FORMAT (1X,A15,I5,1X,A) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') - - END - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - DIMENSION NOLOGIN_BTIM(2) - - CHARACTER*17 DATETIME - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV_PRIV().AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to user command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - CALL OPEN_BULLUSER_SHARED - - IF (.NOT.ALL) THEN - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - ELSE - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(LINE_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER_FROM/ OLD_BUFFER_FROM - DATA OLD_BUFFER_FROM /.FALSE./ - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - RETURN - ELSE - IER = 1 - END IF - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - ELSE - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1) - IF (IER1.NE.0) THEN - OPEN (UNIT=3,STATUS='SCRATCH',FILE='BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - CALL STRIP_HEADER(INPUT,0,IER1) - - OLD_BUFFER = ' ' - - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - CHARACTER*255 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /STRIP_HEADER/ STRIP - DATA STRIP/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(LINE_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER_FROM/ OLD_BUFFER_FROM - DATA OLD_BUFFER_FROM /.FALSE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(LINE_LENGTH) DATE_LINE - - CHARACTER*23 TODAY - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:LEN_BUFFER) - IF (OLD_BUFFER_FROM.AND.BUFFER(:1).EQ.' ') THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER - OLD_BUFFER_FROM = .FALSE. - ELSE IF (BUFFER(:5).EQ.'From:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.OR.LEN_BUFFER.EQ.0) THEN - IF (BUFFER(:9).EQ.'Reply-to:') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0.AND.SAVE_IN_FROM.EQ.' ') THEN - CALL GETUSER(SAVE_IN_FROM) - END IF - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - CALL WRITEOUT_STORED - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF (.NOT.STRIP) THEN - CALL STORE_BULL(1,' ',NBLOCK) ! just store one space - ELSE - CALL STRIP_HEADER(BUFFER,LEN_BUFFER,IER) - OLD_BUFFER = ' ' - END IF - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2 - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-') - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO - INEXDATE = .TRUE. - END IF - END IF - IF (STRIP) THEN - CALL STRIP_HEADER(BUFFER,LEN_BUFFER,IER) - IF (IER) THEN - OLD_BUFFER = BUFFER - RETURN - ELSE - IF (TRIM(DATE_LINE).GT.0) THEN - CALL STORE_BULL(TRIM(DATE_LINE),DATE_LINE,NBLOCK) - CALL STORE_BULL(1,' ',NBLOCK) - DATE_LINE = ' ' - END IF - IF (TRIM(OLD_BUFFER).GT.0) THEN - CALL STORE_BULL(TRIM(OLD_BUFFER),OLD_BUFFER,NBLOCK) - END IF - STRIP = .FALSE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - TEXT = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /STRIP_HEADER/ STRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*23 TODAY - - DIMENSION BIN_EXTIME(2) - - IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - STRIP = .TRUE. ! Reset strip flag - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - RETURN - END IF - - EXTIME = '00:00:00.00' - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(LINE_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.'''') THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - IF (INDEX(INFROM,'<').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<'):) ! personal-name - END IF - - IF (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name) - & INDEX(INFROM,'@').GT.INDEX(INFROM,'(')) THEN - INFROM = INFROM(INDEX(INFROM,'(')+1:) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'"')) - I = I + 1 - END DO - INFROM = INFROM(I:) - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.12.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'"') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,I-1 - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(LINE_LENGTH) DATE_LINE - - CHARACTER*(*) BUFFER - - IF (.NOT.BTEST(FOLDER_FLAG,4).OR.TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - END IF - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header line - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - IF (BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.' - END IF - END IF - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - - RETURN - END diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bullfiles.inc b/decus/vax90b1/bulletin/vlt90b/bulletin/bullfiles.inc deleted file mode 100644 index 33021bc..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bullfiles.inc +++ /dev/null @@ -1,28 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF IT -C IS NOT, THEN THEY SHOULD ALSO BE CHANGED. -C - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bullfolder.inc b/decus/vax90b1/bulletin/vlt90b/bulletin/bullfolder.inc deleted file mode 100644 index 6e31f77..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bullfolder.inc +++ /dev/null @@ -1,46 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,FILLER, - & FOLDER_FILE,FOLDER_SET - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) diff --git a/decus/vax90b1/bulletin/vlt90b/bulletin/bulluser.inc b/decus/vax90b1/bulletin/vlt90b/bulletin/bulluser.inc deleted file mode 100644 index 2aa4fca..0000000 --- a/decus/vax90b1/bulletin/vlt90b/bulletin/bulluser.inc +++ /dev/null @@ -1,44 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vax90b1/bulletin/writemsg.txt b/decus/vax90b1/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vax90b1/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vax90b1/bulletin_beta/allmacs.mar b/decus/vax90b1/bulletin_beta/allmacs.mar deleted file mode 100644 index a74474d..0000000 --- a/decus/vax90b1/bulletin_beta/allmacs.mar +++ /dev/null @@ -1,299 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - - .MACRO M$$DEFERRED_CALL, IMAGE, NAME, NAME1 -; -; Defer image activation on this routine -; - .PSECT $LOCAL,PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG - IMAGE_'NAME: .ASCID /IMAGE/ - SYMBOL_'NAME: .ASCID /NAME1/ - ADDRESS_'NAME: .BLKL 1 - FIND_'NAME: .LONG 3 - .ADDRESS IMAGE_'NAME - .ADDRESS SYMBOL_'NAME - .ADDRESS ADDRESS_'NAME - .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG - .ENTRY 'NAME,^M - CALLG G^FIND_'NAME',G^LIB$FIND_IMAGE_SYMBOL - ADDL3 #2,G^ADDRESS_'NAME,R2 - JMP (R2) - .ENDM M$$DEFERRED_CALL - - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY socket_close socket_close - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY gethostbyname1 gethostbyname - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY socket socket - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY bcopy bcopy - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY htons htons - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY connect connect - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY socket_write socket_write - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY socket_read socket_read - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY gethostname gethostname - - .END diff --git a/decus/vax90b1/bulletin_beta/bull20_ann.txt b/decus/vax90b1/bulletin_beta/bull20_ann.txt deleted file mode 100644 index 0eb3138..0000000 --- a/decus/vax90b1/bulletin_beta/bull20_ann.txt +++ /dev/null @@ -1,243 +0,0 @@ -From: ADVAX::"BULLETIN@NERUS.PFC.MIT.EDU" " " 1-FEB-1991 12:43:13.27 -To: ARISIA::EVERHART -CC: -Subj: BULLETIN utility. - -Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Fri, 1 Feb 91 12:41:49 EST -Received: from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP - id AA10303 for ; Fri, 1 Feb 91 10:47:15 -0500 -From: BULLETIN@NERUS.PFC.MIT.EDU -Received: from NERUS.PFC.MIT.EDU by mcnc.mcnc.org (5.59/MCNC/6-11-90) - id AA04428; Fri, 1 Feb 91 09:05:06 -0500 - for ARISIA.dnet.ge.com!EVERHART -Message-Id: -Date: Fri, 1 Feb 91 08:51 EST -Subject: BULLETIN utility. -To: ARISIA::EVERHART -X-Envelope-To: EVERHART@ARISIA.dnet.ge.com -X-Vms-To: IN%"EVERHART@ARISIA.dnet.ge.com" - -You are about to receive version 2.0 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -As of V2.0, BULLETIN is able to read USENET NEWS via TCP/IP using either -CMU or MULTINET, or via DECNET. - -NOTE: The following commands can be sent to BULLETIN@NERUS.PFC.MIT.EDU: - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. (This does not describe the NEWS reader -feature, however.) - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -This version includes all necessary modifications to work under VMS -V5.0. However, it will still be necessary to reassemble the ALLMACS.MAR -source under V5 and relink. The V4 version will not be installable -under V5 due to a change in a shared library which BULLETIN uses. -However, relinking by itself will not be enough. You MUST also -reassemble ALLMACS.MAR. If you only relink, BULLETIN can cause your -system to crash (the BULLCP process will do this because it uses the -routines in ALLMACS.MAR). - -If you are running a version of BULLETIN older than 1.52, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. This -format change can take a significant amount of time if the folder is -large. If your site has large folders, it is suggested that the new -version be installed during off peak hours. NOTE: Problems can occur -if the old version of BULLETIN is run after the data files have been -modified. Such a situation is possible on a cluster where each node has -installed the executable separately. To help installation, a new -command procedure INSTALL_REMOTE.COM has been included. This can be -used to install BULLETIN on several nodes from a single node. Read the -comments in the file for information on how to use it. - -NOTE: The BULLCP process should be stopped using the BULLETIN/STOP -command before the new version of BULLETIN is installed. It can then be -restarted using the BULLETIN/STARTUP command. (The INSTALL_REMOTE.COM -command procedure does this automatically for remote nodes.) - -You will be receiving 19 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) BULLETIN10.FOR - 13) ALLMACS.MAR - 14) BULLCOMS1.HLP - 15) BULLCOMS2.HLP - 16) BULLET1.COM - 17) BULLET2.COM - 18) PMDF.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. Otherwise, you can delete -it. Read AAAREADME.TXT for installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@NERUS.PFC.MIT.EDU ------------------------------------------------------------------------- -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fix bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vax90b1/bulletin_beta/bullcoms1.hlp b/decus/vax90b1/bulletin_beta/bullcoms1.hlp deleted file mode 100644 index f131c62..0000000 --- a/decus/vax90b1/bulletin_beta/bullcoms1.hlp +++ /dev/null @@ -1,789 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be GENERAL. NOTE: -Specifying remote nodes is only possible if that remote node is running -a special BULLCP process. If it isn't, the only way to add messages to -that remote node is via the /NODE command. However, /FOLDER is a much -quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -/FOLDER= ALL_FOLDERS. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /HEADER -/[NO]HEADER - -If a message header exists, specifies that the header is to be displayed -along with the text of the message. For news folders, the default is -/NOHEADER. For other folders, it is dependent on whether SET STRIP has -been specified or not. Once /HEADER or /NOHEADER has been specified, -that setting will be used for all further reads until it is changed, or -another folder is selected. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. - -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers so -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file can -be specified which contains the text. If the editor is used for changing -the text, the old message text will be extracted. This can be suppressed -by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. This only applies to the GENERAL folder. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically selected -(see information on SELECT command). The commands that can be used to -modify the folder's characteristics are: MODIFY, REMOVE, SET ACCESS, -SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the folder -is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying BULLCOM.CLD. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, the -folder will then be modified to point to that folder. For example if -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be shared -between more than one node. This capability is only present if the BULLCP -process is running on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. By default, -the GENERAL folder is a SYSTEM folder. This is a privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT - -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message. -It can be a substring of the subject. This is in case you have forgotten -the exact subject that was specified. Case is not critical either. -You will be notified if the deletion was successful. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting messages -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of folder. -2 /EXPIRATION -Shows the message's expiration date rather than the creation date. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected using the SELECT command. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWS -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /SEARCH - /SEARCH=[string] - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified string -is used. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified. - - Format: - FILE filename [message_number][-message_number1] - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Copies all the messages in the current folder. -2 /FF -Specifies that a form feed is placed inbetween messages in the file. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 Folders -All messages are divided into separate folders. The default folder is -GENERAL. New folders can be created by any user. As an example, the -following creates a folder for GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that -user will be alerted of topics of new messages at login time, and will -then be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in the -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote DECNET -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP) -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. By default, the GENERAL folder -is a SYSTEM folder (and cannot be changed). One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the GENERAL -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, and -giving access to that UIC group. Only users in that UIC group will see -the messages in that folder when they log in. -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INDEX -Gives directory listing of all folders in alphabetical order. If the -INDEX command is re-entered while the listing is in progress, the listing -will skip to the next folder. This is useful for skipping a particular -folder. It also can be used to continue the listing from where one left -off after one has read a message. - - Format: - INDEX -2 /MARKED -Shows only messages that have been marked (indicated by an asterisk). -2 /NEW -Specifies to start the listing of each folder with the first unread message. -Otherwise, the listing will start with the first message in the folder. -If the INDEX command is re-entered for continuing the listing, /NEW must -be respecified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/TE|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/TE| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying an -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" must -be specified as xxx%"""address""". -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers] - -NOTE: The list of marked messages are stored in a file username.BULLMARK -in the directory pointed to by the logical name BULL_MARK. If BULL_MARK -is not defined, an error message will be displayed when attempting to -mark a message. BULL_MARK may be defined system wide, depending on -whether the system manager has decided to do so. -1 MODIFY -Modifies the database information for the current folder. Only the owner -of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However, -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEWS -Displays the list of available news groups. - -Format: - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. diff --git a/decus/vax90b1/bulletin_beta/bullcoms2.hlp b/decus/vax90b1/bulletin_beta/bullcoms2.hlp deleted file mode 100644 index a4793fa..0000000 --- a/decus/vax90b1/bulletin_beta/bullcoms2.hlp +++ /dev/null @@ -1,801 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with > at the -beginning of each line. This can be suppressed with /NOINDENT. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The PRINT command can take optional qualifiers. - - Format: - - PRINT [message_number][-message_number1] - -A range of messages to be printed can optionally be specified, i.e. -FILE 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply hitting -the key is equivalent to "READ". -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads of in the selected folder. The default is /HEADER for -non NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -2 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected using the SELECT command. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /EXTRACT. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header. -If a "search-string" is not specified, a search is made using the -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the last -message. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default general messages. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The form -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY. -The time will always be 00:00, even if the time is specified on the line. -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time and -avoids creating subprocesses. (Useful if input is digest format.) -3 More_information - -The following is relevant only if the messages in the BBOARD accounts -are sent via a method that causes the name of the account to be placed -in the TO: line of the VMS MAIL. The normal MAIL utility, of course, -does this. However, packages such as PMDF (and probably many others) -will not always do this. (I.e. if the mail was sent to the account -using CC:, the address of the person to whom the mail was sent will be -placed in the TO: line rather than the CC: address.) - -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail forwarded -to BBOARD accounts that don't have /SPECIAL set. Folders of the same -type, i.e. that use the same /SPECIAL command procedure, must be grouped -separately. -2 BRIEF - -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by the -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier. -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed every -time when logging in, until the new messages are read. Normally, the -BRIEF setting causes notification only at the first time that new messages -are detected. - - Format: - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - - Format: - - SET DEFAULT_EXPIRE days - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages. - - Format: - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory. - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the GENERAL folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new GENERAL messages will be displayed -for upon logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are logged -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format: - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers. -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed. -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that READNEW is a permanent flag and cannot be changed by the -individual. This is a privileged qualifier. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged qualifier. -2 STRIP -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped off -before it is stored as a BULLETIN message. - - Format: - - SET [NO]STRIP - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -By default, the GENERAL folder is a SYSTEM folder, and the setting for -that folder cannot be removed. - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected via -the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 KEYPAD -Displays the keypad command definitions. If the keypad has been enabled -by either the SET KEYPAD COMMAND, or /KEYPAD is specified on the command -line, the keypad keys will be defined as commands. SHOW KEYPAD is the -equivalent of HELP KEYPAD. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in. If NOLOGIN is set for a user, -this information will be displayed instead. This is a privileged command. -Non-privileged users will only be able to display the information for -their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some sites -make BULLETIN/LOGIN an optional command for users to store in their own -LOGIN.COM, so this command can be used to show which users have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGIN - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -2 VERSION -Shows the version of BULLETIN and the date that the executable was linked. -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will keep track of the -newest message that has been read for that NEWS folder. When the NEWS folder -is selected, the message pointer will automatically point to the next newest -message that has not been read. -1 UNDELETE -Undeletes the specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have their -expiration date set to 15 minutes in the future and are deleted then. -Undeleting the message will reset the expiration date back to its original -value. Deleted messages will be indicated as such by the string (DELETED) -when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] -1 UNSUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See the -SUBSCRIBE command for further info. diff --git a/decus/vax90b1/bulletin_beta/bullet1.com b/decus/vax90b1/bulletin_beta/bullet1.com deleted file mode 100644 index a31c8db..0000000 --- a/decus/vax90b1/bulletin_beta/bullet1.com +++ /dev/null @@ -1,1251 +0,0 @@ -$set nover -$copy sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utility PMDF. If you wish to -do so for another utility, read the text file WRITEMSG.TXT. I would be glad to -include any such programs with my distribution if you think such a program -would be of use to other users. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - - NOTE 3: If you elect to have folders with the BBOARD feature that receives - messages from outside networks, you may have to modify the subroutine - which executes the RESPOND command. That command sends messages to either - the originator of the message or the mailing list associated with the - folder. These routines assume that one can simply use the VMS MAIL - utility to do so. - - BULLETIN will work for both V4 & V5. However, you will have to reassemble - ALLMACS.MAR if you are upgrading from V5, i.e. - $ MAC ALLMACS - $ LIB BULL ALLMACS - $ DELETE ALLMACS.OBJ; - $ @BULLETIN.LNK - $ COPY BULLETIN.EXE BULL_DIR: - $ RUN SYS$SYSTEM:INSTALL - BULL_DIR:BULLETIN/REPLACE - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require different - linked executables.) - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - The object BULLETIN pointing to BULLETIN.COM must be added to the NCP - database, i.e. the command - MCR NCP SET OBJ BULLETIN FILE directory:BULLETIN.COM number 0 - must be executed at startup time on the remote node. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. -$eod -$copy sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(LINE_LENGTH) -$eod -$copy sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". - -NOTE: Depending on how the BULLETIN command is defined, triple quotes -rather than single quotes may be required. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. -$eod -$copy sys$input BULLETIN.LNK -$deck -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB- - /EXE=BULLETIN,SYS$INPUT/OPT -ID="V2.00" -$eod -$copy sys$input BULLFILES.INC -$deck -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF IT -C IS NOT, THEN THEY SHOULD ALSO BE CHANGED. -C - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ - CHARACTER*80 BULLNEWS_FILE /'BULL_DIR:BULLNEWS.DAT'/ -$eod -$copy sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,FILLER, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - EQUIVALENCE (FOLDER_BBOARD(3:),F_START) - EQUIVALENCE (FOLDER_BBOARD(7:),F_END) - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - EQUIVALENCE (FOLDER1_BBOARD(3:),F1_START) - EQUIVALENCE (FOLDER1_BBOARD(7:),F1_END) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A25,A4,A55,A12,3A4)' - PARAMETER NEWS_FOLDER_RECORD = 108 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_FOLDER_DESCRIP,NEWS_FOLDER_BBOARD, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*25 - CHARACTER NEWS_FOLDER_DESCRIP*55,NEWS_FOLDER_BBOARD*12 - - EQUIVALENCE (NEWS_FOLDER_BBOARD(3:),NEWS_F_START) - EQUIVALENCE (NEWS_FOLDER_BBOARD(7:),NEWS_F_END) - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_FOLDER1_DESCRIP,NEWS_FOLDER1_BBOARD, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*25 - CHARACTER NEWS_FOLDER1_DESCRIP*55,NEWS_FOLDER1_BBOARD*12 - - EQUIVALENCE (NEWS_FOLDER1_BBOARD(3:),NEWS_F1_START) - EQUIVALENCE (NEWS_FOLDER1_BBOARD(7:),NEWS_F1_END) - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) -$eod -$copy sys$input BULLNEWS.INC -$deck - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*10 MAILER - DATA MAILER /'IN%'/ -$eod -$copy sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy sys$input BULL_NEWS.C -$deck - -#include -#include -#include - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -#else - -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -news_get_chan() -{return(s);} - -news_set_chan(i) -int *i; -{s = *i;} - -news_disconnect() -{ - sys$dassgn(s); -} - -#if MULTINET - -static struct hostent *hp; -static struct sockaddr_in sin; - -#endif - -int *node; - -news_assign() -{ - int n; -#if MULTINET - struct hostent *GETHOSTBYNAME1(); -#endif - node = getenv("BULL_NEWS_SERVER"); - if (!node) return(0); - if (!strchr(node,'.')) { - strcpy(&task[0],node); - n = strlen(node); - strcpy(&task[n],"::\"TASK=NNTP\""); - task_d.dsc$w_length = 13 + n; - if (!(sys$assign(&task_d,&s,0,0) & 1)) return(0); - mode = DECNET; - return(1); - } -#if MULTINET - /* - * Get the IP address of the NEWS host. - */ - - hp = GETHOSTBYNAME1(node); - if (hp == NULL) return(0); - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif - return(1); -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,hp->h_addrtype, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,hp->h_addrtype, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET - - /* - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()) and - * the remote NNTP port number (from getservbyname()). - */ - - sin.sin_family = hp->h_addrtype; - BCOPY(hp->h_addr, &sin.sin_addr, hp->h_length); - sin.sin_port = HTONS(119); - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET - - /* - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()) and - * the remote NNTP port number (from getservbyname()). - */ - - sin.sin_family = hp->h_addrtype; - BCOPY(hp->h_addr, &sin.sin_addr, hp->h_length); - sin.sin_port = HTONS(119); - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif - - return(1); -} - -news_connect() -{ - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if MULTINET - return(GETHOSTNAME(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -} -$eod -$copy sys$input BULL_NEWSDUMMY.FOR -$deck - SUBROUTINE NEWS_DISCONNECT - - IMPLICIT INTEGER (A-Z) - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - IMPLICIT INTEGER (A-Z) - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) BUF - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) BUF - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) BUF - - RETURN - END -$eod -$copy sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy sys$input NEWS.TXT -$deck -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when a -user accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. It is also possible to -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - -Presently, BULLETIN can be used with either MULTINET or CMU TCP/IP packages -(and of course DECNET) for reading NEWS. Support for other packages can be -added if I can find sites willing to beta test the interface for me. The -source for the TCP interface is in C rather than FORTRAN because the MULTINET -include files are in C. However, if you do not have C, I will be glad to send -the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -and if it doesn't find this, it looks for INTERNET_HOST_NAME. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded that -BULLCP be installed. - -If you have any problems or questions, please let me know. - MRL -$eod -$copy sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod -$copy sys$input WRITEMSG.TXT -$deck -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/vax90b1/bulletin_beta/bullet2.com b/decus/vax90b1/bulletin_beta/bullet2.com deleted file mode 100644 index 51e1c9b..0000000 --- a/decus/vax90b1/bulletin_beta/bullet2.com +++ /dev/null @@ -1,1142 +0,0 @@ -$set nover -$copy sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 1/1/91 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DISALLOW EXTRACT AND FILESPEC - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER ID, NONNEGATABLE -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW REPLY AND SUBJECT - DISALLOW (REPLY OR SUBJECT OR SEARCH) AND MARKED - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER HEADER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - DEFINE VERB N - DEFINE VERB NEXT - DEFINE VERB POST - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACT - QUALIFIER LIST, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER EDIT - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DISALLOW EXTRACT AND FILESPEC - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACT - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER SUBJECT - DISALLOW SEARCH_STRING AND REPLY - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER LOGIN - QUALIFIER NOLOGIN - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSUBSCRIBE -$eod -$copy sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP -$eod -$copy sys$input BULLETIN.COM -$deck -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -$eod -$copy sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP -$eod -$copy sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy sys$input CREATE.COM -$deck -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN0 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN1 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN2 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN3 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN4 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN5 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN6 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN7 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN8 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN9 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN10 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ ON ERROR THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO CMU -$ CC BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$CMU: -$ CC BULL_NEWS -$ GOTO LINK -$DUMMY: -$ FOR BULL_NEWSDUMMY -$LINK: -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB; -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK -$eod -$copy sys$input DCLREMOTE.COM -$deck -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET -$eod -$copy sys$input INSTALL.COM -$deck -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy sys$input INSTALL_REMOTE.COM -$deck -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL -$eod -$copy sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy sys$input LOGIN.COM -$deck -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! -$eod -$copy sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.0" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc - Fortran /Extend /NoList Bulletin10.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* -$eod -$copy sys$input REMOTE.COM -$deck -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP -$eod diff --git a/decus/vax90b1/bulletin_beta/bulletin.doc b/decus/vax90b1/bulletin_beta/bulletin.doc deleted file mode 100644 index 7495f5d..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin.doc +++ /dev/null @@ -1,875 +0,0 @@ -From: ADVAX::"BULLETIN@NERUS.PFC.MIT.EDU" " " 1-FEB-1991 15:18:22.12 -To: ARISIA::EVERHART -CC: -Subj: BULLETIN.DOC - -Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Fri, 1 Feb 91 15:16:02 EST -Received: from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP - id AA14382 for ; Fri, 1 Feb 91 14:24:58 -0500 -From: BULLETIN@NERUS.PFC.MIT.EDU -Received: from NERUS.PFC.MIT.EDU by mcnc.mcnc.org (5.59/MCNC/6-11-90) - id AA17922; Fri, 1 Feb 91 13:49:22 -0500 - for ARISIA.dnet.ge.com!EVERHART -Message-Id: -Date: Fri, 1 Feb 91 13:48 EST -Subject: BULLETIN.DOC -To: ARISIA::EVERHART -X-Envelope-To: EVERHART@ARISIA.dnet.ge.com -X-Vms-To: IN%"EVERHART@ARISIA.dnet.ge.com" - -1. Introduction - - -BULLETIN is a utility that serves as an electronic analog to a public -bulletin board. With it, you can post messages for other people to see, -and you can read messages posted by other users. Typical uses of -BULLETIN include ongoing discussions and notices on various topics. The -contents of the bulletin board are up to those who use it. The CRNL -Computing Center simply provides the structure - the corkboard and -thumbtacks as it were. - -The organization of BULLETIN is modelled after VMS Mail. Individual -messages are grouped into topics (called folders in VMS Mail and in -BULLETIN), and within each topic, the messages are ordered -chronologically. Once you enter BULLETIN, you can move from one topic to -another, and skip around within a topic to read any messages that seem -interesting. BULLETIN automatically keeps track of the newest message -that your account has read in each topic, so you also have the option of -skipping over old messages. - -Pictorially, the structure looks like this: - - --------- --------- --------- --------- - TOPIC ---- TOPIC B ---- TOPIC C --- . . . --- TOPIC x - --------- --------- --------- --------- - Message 1 Message 1 Message 1 Message 1 - . . . . - Message 2 Message 2 Message 2 message 2 - . . . . - Message 3 Message 3 Message 3 Message 3 - . . . . - . . . . - . . . . - Message n Message n Message n Message n - -To see a list of topics (looking across), you use the DIRECTORY/FOLDER -command. To see a list of messages within a particular topic (looking -down), you use the DIRECTORY command. To move across from one topic to -another, you use the SELECT command. To move up and down within a topic, -you can use the READ, NEXT, BACK, LAST and CURRENT commands. - -To add a message of your own to the bottom of the current topic, you can -use the ADD command. To add an entirely new topic to the bulletin board, -use the CREATE command. - -Chris Tanner -Chalk River Nuclear Labs. - -2.0 General Information - -The first step in using BULLETIN is to log into the VAX and enter either - - BULL name - - - -or - BULLETIN name - -In response, you may get a list of topics that have new messages (this -only happens for those topics for which you have requested this -service), and a prompt of the form: - - BULL> - -The topic name will have been selected. If no name is specified on the -BULLetin command, then the GENERAL folder will be selected. - -One of the following qualifiers may be appended to the BULLETIN command -to select an option for this execution of BULLETIN: - - /EDIT - Specifies that all ADD or REPLACE commands within - BULLETIN will use the editor for inputting text. - /KEYPAD - Specifies that the keypad mode is set on, such that - the keypad keys correspond to BULLETIN commands. See - the SET KEYPAD command (section 3.7 below). - /{NO}PAGE - Specifies whether BULLETIN will stop outputting - after it displays a full screen or not. /PAGE is the - default. If /NOPAGE is specified, any output will - continue until it is finished. - - -At this point, you can enter any of the commands described below. The -command format for BULLETIN is similar to that used by VMS. Commands may -be entered in either upper- or lower-case, and is a fairly free format, -with words and symbols proceeded by and separated by multiple blanks. -The general format of a command is: - - command {object} {/qualifiers} - -The items in braces are optional, depending on the command, and what you -want to do. - -The object of a command may be a help subject (for the HELP command), a -message number (for the READ command), or a topic name (for some other -commands). - -Qualifiers are used to modify the action of a particular command. They -follow the object (if any) and are separated from it by a slash. -Individual qualifiers may be abbreviated, and are separated from each -other by slashes, spaces, or commas. - -Qualifiers and objects can have three general forms: - qualifier - NOqualifier - qualifier=value -The first case turns on a condition that is currently off. An example of -this is /HEADER qualifier on the FILE command. The second case turns off -a condition that is currently off, for example /NOHEADER. The form -qualifier=value is used to specify a single value for that qualifier. An - - -example would be DIRECTORY /SINCE=TODAY to list those messages that were -added today. - -The following are examples of valid BULLETIN commands: - - DIRECTORY - DIRECTORY/FOLD - SELECT new_list - HELP SET - SET SHOWNEW - - -3.0 BULLETIN Commands - -The following sections cover the individual BULLETIN commands in detail, -grouping them by function. To find a specific command, refer to the -command index at the end of this document. - -In this section, and throughout the rest of this document, the minimum -abbreviation for commands and qualifiers is shown by the upper-case -letters in the command name and qualifier list. The possible qualifiers -for a command follow the command name on the first line. - - -3.1 Getting Out of Bulletin and Getting Help - - -The commands in this section are used to get out of BULLETIN, and to get -information while inside BULLETIN. - - -EXIt or Quit - -The EXIT command ends the BULLETIN session and returns you to the VMS -operating system. - - -Help topic - -The HELP command can be used within BULLETIN to obtain help on any -topic. This command works in the same manner as the VMS HELP command. -Entering the HELP command without specifying a topic displays a list of -available topics. - - -3.2 Finding Out What's in the Bulletin Board - -The commands in this section are used to get a quick idea of what is -currently in the system, without necessarily reading all the messages. - - -DIrectory /Describe /Folders /Marked /New /SInce=date - /STart=message_number - - - -The Directory command lists a summary of messages of folders. The -command: - - DIRECTORY - -causes the message number, submittor's name, date, and subject of each -message in the currently selected folder to be displayed. The command: - - DIRECTORY name - -causes first the folder name to be selected then the list of messages to -be displayed. - -This usually starts with the last message read. To change the starting -point of the list use one of the following: - - /MARKED - to list messages that have been marked (indicated by an - asterisk). After using /MARKED, in order to see all messages, - the folder will have to be reselected using the SELECT - command. - - /NEW - to start the listing of message with the first unread message - - /SINCE=date - to list all messages created on or after the specified - date (If no date is specified, the default is TODAY)L - N - /START=message_number - to start the list with the indicated message number.o - c -To get a list of folders, use the command: - P - DIRECTORY /FOLDERSF - 9 -This will list the folder name, last message date and number of messages -in the folder for all folders. An asterisk (*) next to the folder name -indicates that there are unread messages in that folder. The command:A - A - DIRECTORY /FOLDERS / DESCRIBE - , -will cause the list of folders to contain the folder description. - n - o -MARK {message-number or numbers} -UNMARK {message-number or numbers} - . -The MARK command sets a message as having been marked. This can be useda -to mark an important message for later reading. Marked messages ares -displayed with an asterisk in the left hand column of the directoryd -listing. The UNMARK command removes the mark from the specified message. - t - s - -Message numbers are specified for the MARK and UNMARK commands as foro -the COPY and MOVE commands. - t - s -3.3 Moving Around and Reading Messages - d -Once you find a message that you would like to read, you will need tol -move to that topic, and then position to the message. The SELECT command -is used to change topics, while the rest of the commands in this section -are used to move around within a topic.n - - L -SELect folder-name /Markedo - -The SELECT command selects a folder of messages. Once a folder has beenm -selected, all commands, i.e. DIRECTORY, READ, etc. will apply only to -only to those messages. The command: - c - SELECT old-fold - o -will position you to the first new message in the folder old-fold. - s -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. For example, INFOV can be used for -INFOVAX. Omitting the folder name will select the folder GENERAL which -contains general messages about BULLETIN.a - 1 -After selecting a folder, the user will be notified of the number of -unread messages, and the message pointer will be placed at the first -unread message. - -The command: - - SELECT old-fold /MARKED - -will cause only marked messages to be selected. After using /MARKED, in -order to see all messages, the folder will have to be reselected. - - . -[RETURN] - -Just entering carriage return in response to a BULLETIN prompt will -cause either the next screen of the current message, or the first screen -of the next message to be displayed. By just entering carriage returns,R -the user can see all parts of all messages in a folder.t - l - t -NExt - k -The NEXT command skips to the next message and displays it. This iso -useful when paging through messages and a particularly long message is -encountered that a user would like to skip over. - C - E - c - a -CUrrent /Edit - s -The CURRENT command displays the beginning of the message that the user -is currently reading. When in the middle of reading a long message, andA -the user wants to see the first part again, then the CURRENT command can -be entered. - -The /EDIT qualifier specifies that the editor is to be used to read ther -message. This is useful for scanning a long message. - a - -REAd message-number /Edit /Marked /New /{NO}Page /Since=date - s -The READ command is used to read a specific message in the current -folder without having to step through the other messages to get to it. -For example, if the DIRECTORY command shows that the current folderL -contains 15 messages, but the user only wants to read message number 12f -then the command: - - READ 12 - B -can be used to read just that message. - h -NOTE:u - a) If you enter a message number greater than the number of - messages in the folder, then the last message in the folder - will be displayed./ - P - b) The READ command can be abbreviated by omitting the READ - command. i.e. entering the command 2 is equivalent to READ 2. - -The /EDIT qualifier specifies that the editor will be used to read the -message. - h -The /MARKED qualifier causes only marked messages to be read. - d -The /NEW qualifier specifies that the first unread message is to bel -read.N - G -The /PAGE qualifier determines what to do when at the end of the page. -If /PAGE is specified (default), BULLETIN will pause when it reaches the -end of a page (screen). If /NOPAGE is specified, the whole message willy -be displayed. This is useful for terminals that can store more than onea -screenful at a time, or have a remote printer. - d -The /DATE qualifier is used to select the first message created on or -after the specified date. If no date is specified, the default is TODAY. - - i -Last - e -The LAST command displays the last message in the current folder. - o - n - a - e -BAck - u -The BACK command displays the message preceeding the current message., - - o -3.4 Adding Messages to a Folders - -So far we have covered the commands that are used to read messages thaty -have been created by other people. The commands in this section are used -to add new messages to a folder, and change messages that already exist. - a - s -Add {file-name} /{NO}EDit /EXpirationtime /NOIndentv - /SUbject=description /Textr - -The ADD command adds a message to the specified folder. The command: - t - ADD message_file.dat - m -will use the contents of the file message_file.dat as the message. The -command: - o - ADD - -will cause BULLETIN to prompt for the text.m - u -Unless specified by qualifiers, BULLETIN will prompt for an expiration -date, and the message subject. - / -The /EDIT qualifier determines whether or note to invoke the editor to -edit the message being added. If /EDIT was specified on the BULLETIN -command line, then it is the default, otherwise /NOEDIT is the default.S - S -The /EXPIRATION qualifier is used to specify the time at which the -message is to expire. Either absolute time: {dd-mm-yyyy} hh:mm:ss, ort -delta time: dddd {hh:mm:ss} can be used. If the time is omitted, thend -the default expiration time for that folder is used. This is normally 15 -days., - e -The /SUBJECT qualifier can be used to specify the subject of the message -being added. - t -The /TEXT qualifier specifies that the text of the previously read -message should be included at the beginning of the new message. Then -previous message must be in the same folder. This qualifier is valid -only when used with /EDIT. The text is indented with > at the beginningB -of each line. This indentation can be suppressed with the /NOINDENTN -qualifier. - t - s -CHange {file-name} /{NO}EDit /EXpiration=time /Header /NEw - /NUmber=message_number /SUbject /Text - n - l - n -The CHANGE command replaces or modifies an existing message. This can be -used to change part or all of a message without causing users who have -already seen it to be notified of it a second time. The command: - t - CHANGE message_file.dat - s -will cause BULLETIN to take the new text of the message from the file, -message_file.dat. The command: - e - CHANGE - -will cause BULLETIN to prompt for the text.I - = -The expiration date and header can also be changed. If no qualifiers are -specified, then it is assumed that the whole message is to be replaced.O - -The /EDIT qualifier and the /SUBJECT qualifier behave as in the ADD -command. - -The /HEADER qualifier specified that the message header is to be -replaced. The user will be prompted for the new message description. - -The /NEW qualifier works with the /EDIT qualifier. If /NEW is specified, -then the old message text will not be read into the editor, and as -totally new text will be used. - -The /NUMBER qualifier specifies the number of the message to bec -replaced. If it is not specified, then the current message will be -altered. - e -The /TEXT qualifier specifies that the message text is to be replaced. - - -DElete {message number}{-message_number1} /IMmediatei - n -The DELETE command deletes the specified message. Only the original -owner can delete a message. - a -Note that messages are not deleted immediately, but their expiration is -set to 15 minutes in the future. This allows a user to recover the -message using the UNDELETE command. If you want the message deletedl -immediately, use the /IMMEDIATE qualifier. - R -The command: - - DELETEi - t -will delete the current message, while the command:g - - DELETE 3 - -will delete message number 5, and the command: - n - DELETE 2-6a - u - a -will delete messages 2 to 6 inclusive. - A - -UNDelete {message-number}E - I -The DELETE command (without the /IMMEDIATE qualifier) actually sets the -expiration date for a message to 15 minutes in the future. The UNDELETEb -command can be specified any time within that 15 minutes to roll backa -the deletion process and reset the expiration date to its original -value. 15 minutes after a message has been DELETed, it will have -disappeared, and the UNDELETE command will have no effect. - f -Deleted messages will be indicated as such by the string 'DELETED' in a -directory listing. - m - s -3.5 Other Commands Affecting Messages - -This section describes other commands that act on single messages. The -COPY command can be used to copy a message to another folder, the MAIL -command will mail a message to a user and the PRINT command will send it -to a line printer (or laser printer).s - c - n -COPY folder-name {message_number}{-message_number1}E - /Merge /Original - h -The COPY command copies a message to another folder without deleting ite -from the current folder. For example:E - - COPY new-fold - -will copy the current message to the folder 'new-fold'. The command: - l - COPY new-fold 3-6 - w -will copy messages 3 to 6 inclusive from the current folder to the -folder 'new-fold'. - T -The /MERGE qualifier causes the original date and time of the copied -messages to be saved and the messages placed in the correcth -chronological order in the new folder. This operation is lengthy if thef -new folder is large. - h -The /ORIGINAL qualifier specifies that the owner of the copied message -will be the original owner of the message. The default is that the -copied message will be owned by the person copying the message.a - d - s -MOVE folder-name {message_number}{-message_number1} - /Merge /Originale - i -The MOVE command copies a message to another folder deleting it from the -current folder. For example: - r - t - MOVE new-fold - n -will move the current message to the folder 'new-fold'. The command: - g - MOVE new-fold 3-6 - t -will move messages 3 to 6 inclusive from the current folder to the -folder 'new-fold'. - -The /MERGE and /ORIGINAL qualifiers are as for the COPY command. - - s -EXTract or FIle {message_number}{-message_number1} file_name - /All /{NO}Header /New - e -The EXTRACT or FILE command copies the specified message to the namedU -file. Thus the command:e - g - FILE abc.dat - t -will copy the current message to the file 'abc.dat', and the command:m - a - FILE 1-5 abc.datt - e -will copy messages 1 to 5 inclusive to the file 'abc.dat'. - d -If the file exists, the messages are appended to the file, unless ther -/NEW qualifier is specified, which causes a new file to created whetherE -one of the given name exists or not. - N -The /ALL qualifier causes all messages in the current folder to be -copied to the specified file.w - o -The /HEADER qualifier controls whether a header containing the owner,, -subject and date of the message is written to the file. The default is -to write the header. Specifying /NOHEADER prevents this header fromc -being written. - - A -PRint {message_number}{-message_number1} - /All /Form /{NO}Header /{NO}NOTifye - /Queue{=queue_name} - r -The PRINT command sends a copy of the selected message to a printer. The -command: - - PRINT - d -will send the current message while the command: - d - PRINT 3-6 - -will send messages 3 to 6 inclusive. - o - n - -The /ALL qualifier will cause all messages in the current folder to be -printed. - s -The /FORM qualifier specifies the name or number of the form that youm -want to use for the print job. This corresponds to the /FORM qualifier -in the VMS PRINT command.d - -The /HEADER qualifier controls whether a header containing the owner,g -subject and date of the message is printed at the beginning. The default -is to write the header. Specifying /NOHEADER will suppress this header.l - -Specifying the /NOTIFY qualifier indicates that the user will be -notified by a broadcast message, when the message(s) have been printed.l -This is suppressed with the /NONOTIFY qualifier. The default is /NOTIFY. - -The /QUEUE qualifier specifies the name of the print queue to which theh -message is to be sent. This corresponds to the /QUEUE qualifier on the -VMS PRINT command. - - K -3.6 Folder (topic) Managementr - e -The commands in this section describe how to create and remove a folder, -and change some of the parameters associated with a folder.s - s - a -CReate folder_name /Description=description /Private - /SEMIPRIVATEa - n -The CREATE command creates a folder of messages. Folders in BULLETIN are -similar to folders in the VMS MAIL utility. They are created so that -messages of a similar topic can be grouped together, and/or to restrictf -reading of certain messages to specified users. The command: - i - CREATE new-fold - f -will create a folder named 'new_fold'. Folder names are limited to 25 -letters and must not include spaces or characters that are also invalidl -in filenames. This is because the folder is stored in a file nameg -created with the folder name.f - -If the description of the folder is not specified in the /DESCRIPTIONi -qualifier, BULLETIN will prompt for the folder description. If thei -folder receives messages from a network mailing list, the address of -that mailing list is included at the end of the description enclosed byi -<>. For example: - i - INFOVAX Mailing List - -In this case, IN%"INFO-VAX@KL.SRI.COM" is the address of the INFO-VAX -mailing list. Contact the CRNL hotline at CC1::CONSULT or DN 4000 forq -help in setting up such a folder. - j - - t -The /PRIVATE qualifier specifies that the folder can only be accessed by -users who have been granted access by the SET ACCESS command. See thet -SET ACCESS command (section 3.7) for more details. - a -The /SEMIPRIVATE qualifier specifies that only specified users (see thes -SET ACCESS command) can add or modify messages in this folder. All users -can read the folder. - D - N -MODify /Description=description /Name=new name - p -The MODIFY command changes information for the current folder. Only thee -owner of the folder can use this command. - m -If the /DESCRIPTION qualifier is not specified, then BULLETIN will -prompt for the new description.r - h -To change the name of a folder, use the /NAME qualifier. - h - o -REMove folder_name - G -The REMOVE command removes a folder. Only the owner of a folder canh -perform this task. - , - e -3.7 The SET and SHOW Commandse - -The SET command is used with other commands to define or change= -characteristics of the BULLETIN Utility. The SHOW command is used to -display information about these characteristics. - s - e -SET {NO}Access user_id {folder-name} - /All /ReadT - a -The SET ACCESS command controls access to a private folder. Such a -folder can be selected only by users who have been granted access by the -owner of the folder. - e -The user-id can be one or more ids contained in the system RightsI -Database or the name of a file which contains a list of such ids. Theh -Rights Database contains usernames and UICs. For example:N - E - SET ACCESS SMITHJ a_folder - -will grant access to the folder 'a_folder' to the user 'SMITHJ', and the -command: - e - SET ACCESS @list_of_ids.dis - -will grant access to all the ids listed in the file 'list_of_ids.dis'. -Note that the file name must be proceeded by a '@'.m - d - l - s -The /ALL qualifier causes access to the folder to be granted to alle -users. The command:s - s - SET ACCESS private_folder /ALL - i -will cause the folder 'private_folder' to be converted to a public -folder; it is accessible by all users. The command:u - n - SET ACCESS private_folder /ALL /READ/ - E -will convert the folder 'private_folder' to a semi-private folder. All -users can read messages in it, but only those who have been grantedi -access (by the SET ACCESS command) can add messages to it. - -The /READ qualifier states that the specified user will be limited to{ -only being able to read messages in the folder. - - M -SET {NO}BRief /Folder=folder_namex - a -The SET BRIEF command controls whether the user will be alerted upon -logging in that there are new messages in the currently selected folder. -This contrasts with the READNEW and SHOWNEW flags which cause a listing -of the descriptions of the new messages to be displayed, and in the case -of READNEW, asks the user if he/she wants to read the messages. Settingd -BRIEF will clear a READNEW or SHOWNEW setting (and visa versa). - -The command: - m - SET NOBRIEF /FOLDER=big_folderi - d -will clear the brief setting for the folder 'big_folder'.O - c - a -SET DEfault_expire=daysm - a -The SET DEFAULT_EXPIRE command sets the default length of time a message -remains in the current folder. When a folder is created, the value is 14 -days. The command: - { - SET DEFAULT_EXPIRE=30 - E -will cause the default expiration time to be set to 30 days. - s - -SET Expire_limit daysu - e -The SET EXPIRE LIMIT command specifies that maximum expiration that cano -be specified when a user is adding a message to the currently selected -folder. - - C -SET {NO}Keypad -SHOW Keypadp - e - g -The SET KEYPAD command controls whether the keypad is enabled such thatT -the keys on the keypad correspond to command definitions. The default is -NOKEYPAD unless the /KEYPAD qualifier is specified on the BULLETIN -command line. The SHOW KEYPAD will show these definitions which are as -follows: - lqqqqqqqqwqqqqqqqqwqqqqqqqqwqqqqqqqqk - x PF1 x PF2 x FP3 x PF4 x - x x HELP x EXTRACTxSHOW KEYx - x GOLD xST NOKEYx FILE xSH KY/PRx - tqqqqqqqqnqqqqqqqqnqqqqqqqqnqqqqqqqqx - x 7 x 8 x 9 x - x - x ADD x REPLY x MAIL xREAD/NEWx - x ADD/EDIxRP/ED/TExM/NOHEADxSHOW/NEWx - tqqqqqqqqnqqqqqqqqnqqqqqqqqnqqqqqqqqu - x 4 x 5 x 6 x , x - x CURRENTx RESPONDx LAST x DIR/NEWx - xCURR/EDIxRS/ED/TEx x INDEX x - tqqqqqqqqnqqqqqqqqnqqqqqqqqnqqqqqqqqx - x 1 x 2 x 3 x ENTER x - x BACK x PRINT x DIR x x - x NEXT xP/NONOTIxDIR/FOLDx ENTER x - tqqqqqqqqvqqqqqqqqnqqqqqqqqu SELECT x - x 0 x . x x - x SHOW/FOLDER/FULLx DELETE x x - x SHOW FLAGS x UNDELE x x - mqqqqqqqqqqqqqqqqqvqqqqqqqqvqqqqqqqqj - i - c -SET {NO}NOTify /FOlder=folder_namen - f -The SET NOTIFY controls whether a user will be notified via a broadcasts -message when a message is added to a selected folder. The command: - H - SET NOTIFYt - s -will cause a such a broadcast message to be issued for the currently -selected folder, while the command:l - s - SET NONOTIFY/FOLDER=his_foldH - E -will cause such messages to cease for the folder named 'his_fold'. - m - } -SET {NO}PAge - } -The SET PAGE command specifies whether any directory message listing -will pause when it reaches the end of the page (or screen) or not. -Setting NOPAGE is useful for terminals that can store more than oneu -screenful at a time, and that have a remote printer that can print the -contents of the terminal's memory. The default is PAGE, but this can bee -changed by specifying /NOPAGE on the command used to invoke BULLETIN.p - f - -SET {NO}PROmpt_expireh - o - t -The PROMPT_EXPIRE specifies that a user will be prompted for an/ -expiration date when adding a message. This is the default condition. If -NOPROMPT_EXPIRE is specified for a folder, then users will not beh -prompted when adding a message to that folder, and the default -expiration time (set by a SET DEFAULT_EXPIRE) will be used. - -This command works only on the currently selected folder, and can be -only be used by folder owner.e - h - e -SET {NO}Readnew /Folder=foldername - p -If the READNEW flag is set for a folder then whenever a user logs in, aE -list of messages that have been added to that folder since the last log -in are displayed and the user asked if he/she would like to read them. -The SET READNEW command controls this flag for individual users. The -default setting is usually NOREADNEW, but it can be changed by the owner -of the folder. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command.d - e -If you have several folders with READNEW enabled, each folder's messages -will be displayed separately. However, if you EXIT the READNEW beforeo -all the folders have been displayed, you will not be alerted of the newa -messages in undisplayed folders the next time you login. However, if you -enter BULLETIN, you will be told that new messages are present in thoser -other folders. - u -The /FOLDER qualifier can be used to specify the folder for which thee -option is to be modified, for the SET NOREADNEW command only. For -example: - f - SET NOREADNEW his_foldi - o -will clear the READNEW flag for the folder 'his_fold'. The command: - - SET READNEW his_fold - d -is illegal.e - g - f -SET {NO}SHownew /Folder=folder_name - -The SET SHOWNEW command is similar to the SET READNEW command, but only -the directory listing of new messages is displayed at login time. UsersM -are not asked if they want to read the new messages. The command format- -and qualifiers are as for the SET READNEW command. - N - T -SHOW FLAGS - q -Shows the setting of some of the flags for the currently selectedi -folder.i - s - a -SHOW FOLDER {folder-name} /Full - s -Shows some information (e.g. owner and description) about a folder ofE -information. If the folder name is omitted, then information isI -displayed for the currently selected folder. - s -Specifying the /FULL qualifier causes a lot more information to be -displayed, including the current setting of all flags associated with= -the folder.N - = - -SHOW VERSION - I -Shows the version of BULLETIN and the date the program was loaded. - - t - f - e - a diff --git a/decus/vax90b1/bulletin_beta/bulletin.for b/decus/vax90b1/bulletin_beta/bulletin.for deleted file mode 100644 index 751a0ff..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin.for +++ /dev/null @@ -1,1648 +0,0 @@ -C -C BULLETIN.FOR, Version 12/16/90 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER*132 DCL_CMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*42 PROMPT - - DCL_COMMAND = 0 - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,'"') - IF (DCL_COMMAND.EQ.0) THEN - CALL CLI$DCL_PARSE('BULLETIN '//INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL CLI$DCL_PARSE('BULLETIN '//INCMD(:DCL_COMMAND-1), - & BULLETIN_MAINCOMMANDS) - DCL_CMD = INCMD(DCL_COMMAND+1:) - IF (DCL_CMD(TRIM(DCL_CMD):).EQ.'"') THEN - DCL_CMD = DCL_CMD(:TRIM(DCL_CMD)-1) - END IF - END IF - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - END IF - CALL LIB$REVERT - - READIT = 0 - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP')) THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL SHOW_SYSTEM - CALL EXIT - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (DCL_COMMAND.EQ.0) CALL NEW_MESSAGE_NOTIFICATION - - CALL OPEN_OLD_TAG - - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (1) - - IF (DCL_COMMAND.EQ.0) THEN - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - DO WHILE (IER.GT.0.AND. - & INCMD(IER:IER).GE.'0'.AND.INCMD(IER:IER).LE.'9') - IER = IER - 1 - END DO - IF (IER.EQ.0) INCMD = 'READ '//INCMD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - IER = MIN(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (REMOTE_SET.GE.3) THEN - INCMD = 'POST' - CALL RESPOND(MAIL_STATUS) - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 99999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.) - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (REMOTE_SET.GE.3) THEN - CALL RESPOND(MAIL_STATUS) - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND? - CALL RESPOND(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - DO FOLDER_NUMBER = 0,FOLDER_MAX-1 - IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (NBULL.GT.0) THEN - DIFF = COMPARE_BTIM( - & LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - END IF - END IF - END DO - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.) - ELSE IF (INCMD(:3).EQ.'UNS') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - -100 CONTINUE - - IF (DCL_COMMAND.GT.0.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more messages.') - - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER*(LINE_LENGTH) INDESCRIP - - CHARACTER INLINE*80,OLD_FOLDER*25,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF (CLI$PRESENT('EXTRACT')) THEN - IF (.NOT.((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If no /EDIT - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',READONLY, - & SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - ELSE IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - WRITE (INEXTIME,'(I4)') NODE_NUMBER - WRITE (INEXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! Not permanent or shutdown - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - INDESCRIP = DESCRIP ! Use description with RE:, - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)).AND. - & .NOT.DECNET_PROC) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - END IF - END IF - - ICOUNT = 0 ! Line count for bulletin - - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - LUSER = TRIM(USERNAME) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - BRDCST = .FALSE. - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - FROM = USERNAME ! Username - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - CALL STORE_BULL(LNODE+LUSER+6,'From: '// - & LOCAL_NODE(:LNODE)//USERNAME(:LUSER),OBLOCK) - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF - CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - CALL ADD_ENTRY ! Add the new directory entry - - IF (FOLDER_NUMBER.GE.0) THEN - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add - ELSE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (CLI$PRESENT('EXTRACT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*23 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER LOCALNODE*8,RESPONSE*1 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE(4) - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE (4) - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE.NE.'n'.AND.RESPONSE.NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLDIR.INC' - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP) - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - DESCRIP = 'RE: '//DESCRIP - ELSE - DESCRIP = 'RE:'//DESCRIP(4:) - END IF - WRITE (6,'(1X,A)') DESCRIP - - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($UAIDEF)' - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*255 COMMAND - - DATA CAPTIVE /0/ - - IF (CAPTIVE.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) ! Get address of itemlist - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - CAPTIVE = 1 - IF ((FLAGS.AND.UAI$M_CAPTIVE).NE.0) CAPTIVE = -1 - END IF - - IF (CAPTIVE.EQ.-1) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')') - RETURN - END IF - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - CALL LIB$SPAWN('$'//COMMAND(:CLEN)) - ELSE - CALL LIB$SPAWN() - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*15 PROCESS - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - RETURN - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,,,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END diff --git a/decus/vax90b1/bulletin_beta/bulletin0.for b/decus/vax90b1/bulletin_beta/bulletin0.for deleted file mode 100644 index 94c70f4..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin0.for +++ /dev/null @@ -1,1645 +0,0 @@ -C -C BULLETIN0.FOR, Version 12/16/90 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - CALL REMOTE_DELETE(SBULL,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.NE.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(1:11) - NEWEST_EXTIME = INPUT(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - DO BULL_DELETE = SBULL,EBULL - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM) - IER = SYS$ASCTIM(,INPUT,EX_BTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:) - - CALL WRITEDIR(0,IER) - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - - CHARACTER START_PARAMETER*16,DATETIME*23,SEARCH_STRING*80 - - INTEGER TODAY(2) - - CHARACTER*9 EXPIRES - - CHARACTER TIMBUF*13 - DATA TIMBUF/'0 00:00:05.00'/ - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM(TIMBUF,TIMADR) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (INCMD(:3).EQ.'DIR'.AND..NOT.READ_TAG) THEN - SUBJECT = CLI$PRESENT('SUBJECT') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').AND. - & CLI$PRESENT('MARKED')) THEN - IF (FOLDER_NUMBER.GE.0) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: Cannot use /MARKED with'', - & '' remote folder.'')') - RETURN - END IF - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - IER = CLI$GET_VALUE('START',START_PARAMETER,ILEN) - DECODE(ILEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEN - DIR_COUNT = NBULL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - IF (REMOTE_SET.NE.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IF - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - RETURN - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IF (CLI$PRESENT('SEARCH')) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - END IF - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only MARKED messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - IF (.NOT.(CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW') - & .OR.CLI$PRESENT('START'))) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - END IF - - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - IER1 = 0 - IER = 0 - FBULL = 0 - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) THEN - EBULL = DIR_COUNT - FBULL = EBULL + 1 - END IF - FBULL = FBULL - 1 - IF (EBULL-FBULL.EQ.(PAGE_LENGTH-7)-1) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (FBULL.EQ.FIRST_BULL) THEN - CALL READDIR(EBULL,IER) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT) - DO WHILE (IER.EQ.0.AND.EBULL-FBULL.LT.(PAGE_LENGTH-7)-1) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT) - IF (IER.EQ.0) EBULL = EBULL + 1 - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT) - END DO - IF (IER.NE.0) EBULL = DIR_COUNT - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THEN - EBULL = NBULL - END IF - IF (SUBJECT.OR.REPLY.OR.SEARCH) THEN - CONTINUE - ELSE IF (.NOT.REMOTE_SET.AND..NOT.READ_TAG) THEN - DO I = SBULL,EBULL - CALL READDIR(I,IER) ! Into the queue - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - END DO - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - SBULL = DIR_COUNT - I = SBULL - END IF - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVE - END IF - END IF - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - RETURN - END IF - END IF - ELSE - NBULL = 0 - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - WRITE (6,'('' There are no messages present.'')') - RETURN - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - FLEN = TRIM(FOLDER_NAME) - WRITE(6,'(X,A)') FOLDER_NAME(:FLEN) - IF (EXPIRATION) THEN - WRITE(6,1005) ! Write header - ELSE - WRITE(6,1000) ! Write header - END IF - - IF (.NOT.(SUBJECT.OR.REPLY.OR.SEARCH).AND. - & BULL_TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(1:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - IF (BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - MSG_NUM = -MSG_NUM - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) START_SEARCH = I - 1 - IF (SUBJECT.OR.REPLY.OR.SEARCH) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH) CALL OPEN_BULLFIL_SHARED - CLOSED_FILES = .FALSE. - END IF - DO WHILE (I.LE.EBULL) - IF (.NOT.(SUBJECT.OR.REPLY.OR.SEARCH)) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (CLOSED_FILES) THEN - CLOSED_FILES = .FALSE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH) CALL OPEN_BULLFIL_SHARED - END IF - CALL GET_SEARCH(FOUND,SEARCH_STRING,START_SEARCH,.FALSE. - & ,SUBJECT,REPLY_FIRST,.FALSE.,.TRUE.) - IF (INCMD(1:3).NE.' '.AND.BULL_TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - CALL READDIR(FOUND,IER) - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - CALL READDIR(FOUND,IER) - MSG_NUM = -MSG_NUM - END IF - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.LE.EBULL) THEN - CALL CONVERT_ENTRY_FROMBIN - IF (MSG_NUM.LT.0.OR.READ_TAG) THEN - WRITE (6,'('' *'',$)') - IF (MSG_NUM.LT.0) MSG_NUM = -MSG_NUM - ELSE - WRITE (6,'('' '',$)') - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3) - IF ((EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) - & .AND.REMOTE_SET.NE.3) THEN - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM,'(DELETED)' - ELSE IF (EXPIRATION) THEN - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Permanent bulletin? - EXPIRES = 'Permanent' - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(1:7)//EXDATE(10:11) - END IF - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM,EXPIRES - ELSE - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM, - & DATE(1:7)//DATE(10:11) - END IF - END IF - I = I + 1 - IF (SUBJECT.OR.REPLY.OR.SEARCH) IER = SYS$CANTIM(,) - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (SEARCH.OR.REPLY.OR.SUBJECT) THEN - IF (SEARCH) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IF - - IF (DIR_COUNT.GT.NBULL.OR.(READ_TAG.AND.IER1.NE.0)) THEN - ! Outputted all entries? - DIR_COUNT = -1 ! Yes. Set counter to -1. - ELSE - WRITE(6,1010) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - -2010 FORMAT('+',I,1X,A<55-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER) - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1015) - RETURN - END IF - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And return - END IF - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - FIRST = .TRUE. - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1.OR.(FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1 - IF (FBULL1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(FBULL,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_PARAMETER(1:LEN_P) - ! Show name of file created. - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - - RETURN - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message(s) written to ',A) -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*23,INREAD*1 - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - ELSE - RETURN ! Don't notify - END IF - END IF - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - READ_BTIM(1) = NEW_BTIM(1) ! Make new entry - READ_BTIM(2) = NEW_BTIM(2) - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - ELSE - LOGIN_BTIM_SAVE(1) = NEW_BTIM(1) - LOGIN_BTIM_SAVE(2) = NEW_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - BBOARD_BTIM(1) = TODAY_BTIM(1) - BBOARD_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compare - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - LOGIN_BTIM_NEW(1) = LOGIN_BTIM(1) - LOGIN_BTIM_NEW(2) = LOGIN_BTIM(2) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - -C -C If there are new messages, look for them in BULLDIR.DAT -C Save all new entries in the GEN_DIR file BULLCHECK.SCR so -C that we can close BULLDIR.DAT as soon as possible. -C - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - LOGIN_BTIM(1) = LAST_SYS_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_SYS_BTIM(2,FOLDER_NUMBER+1) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - LOGIN_BTIM(1) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(1) - LOGIN_BTIM_NEW(1) = LOGIN_BTIM(1) - LOGIN_BTIM_NEW(2) = LOGIN_BTIM(2) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - LOGIN_BTIM(1) = SYSTEM_LOGIN_BTIM(1) ! Use specified login time - LOGIN_BTIM(2) = SYSTEM_LOGIN_BTIM(2) ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - LOGIN_BTIM_OLD(1) = LOGIN_BTIM(1) - LOGIN_BTIM_OLD(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(1) - LOGIN_BTIM_NEW(1) = LOGIN_BTIM(1) - LOGIN_BTIM_NEW(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = LOGIN_BTIM_OLD(1) - LOGIN_BTIM(2) = LOGIN_BTIM_OLD(2) - END IF - CALL CLOSE_BULLUSER - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - LOGIN_BTIM(1) = LAST_SYS_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_SYS_BTIM(2,FOLDER_NUMBER+1) - END IF - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LOGIN_BTIM_NEW(1) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LOGIN_BTIM_NEW(2) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF (.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL,REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100 - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - ! No. Is bulletin system or from same user? - IF (.NOT.REVERSE) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (SYSTEM_SWITCH) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - ELSE - DIFF = -1 - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0) THEN ! And save only the first non-system msg - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) '+'//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) '+'//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - ELSE - PAGE = PAGE + 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) ' '//INPUT(:ILEN) - ILEN = 0 - ELSE - WRITE(6,1060) ' '//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(1:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER_NAME(1:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD,INREAD) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - ELSE - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 49 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'The ' //COMMAND_PROMPT(:ILEN-48)// - & ' command can be used to read these messages.' - ELSE - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-49-FLEN) - & //' '//FOLDER_NAME(:FLEN)// - & ' command can be used to read these messages.' - END IF - END IF - -9999 IF (LOGIN_SWITCH) THEN - LOGIN_BTIM(1) = LOGIN_BTIM_NEW(1) - LOGIN_BTIM(2) = LOGIN_BTIM_NEW(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM_OLD(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM_OLD(2) - END IF - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IF - - RETURN - END - diff --git a/decus/vax90b1/bulletin_beta/bulletin1.for b/decus/vax90b1/bulletin_beta/bulletin1.for deleted file mode 100644 index b5b2f0d..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin1.for +++ /dev/null @@ -1,1786 +0,0 @@ -C -C BULLETIN1.FOR, Version 12/18/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (MAIL_SUBJECT(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - MAIL_SUBJECT(I:I) = '`' - ELSE - MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_P = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_P = LEN_P + I + 1 - BULL_PARAMETER(LEN_P:LEN_P) = ',' - END DO - LEN_P = LEN_P - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:I)//'""'// - & BULL_PARAMETER(I+1:) - I = I + 2 - LEN_P = LEN_P + 2 - END IF - I = I + 1 - END DO - - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) - & //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,STATUS) - CALL ENABLE_PRIVS - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LEN_P = 81 - DO WHILE (LEN_P.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LEN_P) ! Get input line - IF (LEN_P.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LEN_P.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LEN_P) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THEN - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.FALSE./ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT - - EXTERNAL BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*25,POST_SUBJECT*255 - - IF (CLI$PRESENT('ORIGINAL').AND..NOT.SETPRV_PRIV()) THEN - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - END IF - END IF - - FROM_REMOTE = REMOTE_SET - - IF (REMOTE_SET) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.0) THEN - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - IF (IER.EQ.1) WRITE (12,IOSTAT=IER1) BULLDIR_HEADER - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - I1 = I - CALL READDIR(I,IER) - IF (I1.EQ.BULL_POINT.AND.I1.NE.I) THEN - WRITE(6,'('' ERROR: Message not found: '',I)') I1 - CLOSE (UNIT=11) - CLOSE (UNIT=12) - CALL CLOSE_BULLDIR - CALL CLOSE_BULLFIL - RETURN - END IF - IF (IER.EQ.I+1) THEN - BLOCK = NBLOCK - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (LENGTH.EQ.0) IER = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT(:128)) - WRITE (11'NBLOCK,IOSTAT=IER1) INPUT(:128) - IF (IER1.EQ.0) NBLOCK = NBLOCK + 1 - END DO - END IF - IF (IER1.EQ.0) WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - IF (IER1.NE.0) THEN - I = IER - ELSE - NUM_COPY = NUM_COPY + 1 - END IF - END IF - END DO - END IF - CALL CLOSE_BULLFIL - IF (IER1.NE.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=11) - CLOSE (UNIT=12) - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.EQ.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.4) THEN - IF (CLI$PRESENT('ORIGINAL')) THEN - REMOTE_SET = 0 - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - IER1 = .FALSE. - END IF - END IF - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11) - CLOSE (UNIT=12) - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (REMOTE_SET.GE.3) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - ELSE - CALL OPEN_BULLDIR ! Prepare to add dir entry - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE) THEN - READ (12,KEYID=0,KEY=0,IOSTAT=IER) - ELSE - READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.EQ.3) THEN - SYSTEM = 0 - IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,14) - END IF - END IF - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.CLI$PRESENT('ORIGINAL')) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - ELSE IF (REMOTE_SET.GE.3) THEN - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT) - END IF - - IF (REMOTE_SET.LT.3) THEN - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE IF (FROM_REMOTE) THEN - CALL ADD_ENTRY - ELSE - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF - END DO - - IF (REMOTE_SET.GE.3) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLFIL - - CLOSE (UNIT=11) - - CLOSE (UNIT=12) - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, update that user's last read time for -C folder, so user is not alerted of new message which is owned by user. -C - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - IF (REMOTE_SET.LT.3) HEADER = SAVE_HEADER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IF - - RETURN - END - - - - - SUBROUTINE PRINT -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*31 FORM_NAME - - PARAMETER FF = CHAR(12) - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1015) - RETURN - END IF - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - - CALL OPEN_BULLDIR_SHARED - - CALL OPEN_BULLFIL_SHARED - - HEAD = CLI$PRESENT('HEADER') - - FIRST = .TRUE. - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - - IF (IER.NE.I+1.OR.(I1.EQ.SBULL.AND.I.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST) THEN - WRITE (3,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) ! Get queue name - IF (ILEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - ILEN = 9 - END IF - - CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IF - - IF (CLI$PRESENT('FORM')) THEN - IER = CLI$GET_VALUE('FORM',FORM_NAME,FORM_NAME_LEN) - CALL ADD_2_ITMLST(FORM_NAME_LEN,SJC$_FORM_NAME,%LOC(FORM_NAME)) - END IF - - CALL DISABLE_PRIVS - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ_MSG -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.FALSE./ - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*11,DATETIME*23,BUFFER*(LINE_LENGTH) - CHARACTER SAVE_MSG_KEY*8,PREV_MSG_KEY*8 - - LOGICAL SINCE,PAGE - - EXTERNAL CLI$_NEGATED - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - SINCE = .FALSE. - PAGE = .TRUE. - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE. - END IF - IF (CLI$PRESENT('MARKED')) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No marked messages found.'')') - RETURN - ELSE - READ_TAG = .TRUE. - END IF - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - IF (REMOTE_SET.NE.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THEN - WRITE (6,'('' No new messages are present.'')') - RETURN - END IF - END IF - END IF - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - RETURN - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IF - - NEXT = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - IF (.NOT.CLI$PRESENT('BULLETIN_NUMBER')) NEXT = .TRUE. - END IF - - IF (READ_TAG) THEN - IF (INCMD(:4).EQ.'BACK') THEN - SAVE_MSG_KEY = MSG_KEY - MSG_KEY = BULLDIR_HEADER - I = 0 - IER = 0 - CALL OPEN_BULLDIR_SHARED - DO WHILE (IER.EQ.0.AND.MSG_KEY.NE.SAVE_MSG_KEY) - I = I + 1 - IF (MSG_KEY.NE.SAVE_MSG_KEY) PREV_MSG_KEY = MSG_KEY - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO - IF (IER.EQ.0) THEN - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IER = 0 - IF (BULL_POINT.EQ.0) CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_READ) - DO WHILE (IER.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO - CALL CLOSE_BULLDIR - IER = BULL_READ + 1 - ELSE IF (NEXT) THEN - IF (SINCE) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - ELSE - IF (BULL_POINT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END IF - IF (IER.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (REMOTE_SET.NE.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - IF (IER.NE.BULL_READ+1) THEN - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ) - IF (IER1.NE.0) IER = 0 - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - NEXT = .FALSE. - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.NE.3) THEN - WRITE(6,1030) ! If not, then error out - ELSE - WRITE(6,1040) - END IF - RETURN - END IF - - IF (REMOTE_SET.NE.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2) - END IF - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'CURR') THEN - IF (CLI$PRESENT('EDIT')) THEN - CALL READ_EDIT - RETURN - END IF - END IF - - FLEN = TRIM(FOLDER) - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - IF (REMOTE_SET.EQ.3) THEN - WRITE (INPUT,'(1X,I5,'' of '',I5,''-'',I5)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(INPUT,'- ').GT.0) - I = INDEX(INPUT,'- ') - INPUT(I+1:) = INPUT(I+2:) - END DO - ELSE - WRITE (INPUT,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULL - END IF - DO WHILE (INDEX(INPUT,' ').LT.TRIM(INPUT)) - I = INDEX(INPUT,' ') - INPUT(I:) = INPUT(I+1:) - END DO - I = TRIM(INPUT) - INPUT = ' #'//INPUT(2:TRIM(INPUT)) - INPUT(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//INPUT(:TRIM(INPUT)) - ELSE - WRITE(6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - - END = END + 1 - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - WRITE(6,'('' From: '',A)') FROM - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - WRITE(6,'(1X,A)') INPUT(:I) - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - ELSE - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - END IF - WRITE(6,'('' Subj: '',A)') DESCRIP - END = END + 1 - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - WRITE(6,'(1X)') - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE (BUFFER,'(1X,I5,'' of '',I5)') BULL_POINT,F_NBULL - DO WHILE (INDEX(BUFFER,' ').LT.TRIM(BUFFER)) - I = INDEX(BUFFER,' ') - BUFFER(I:) = BUFFER(I+1:) - END DO - BUFFER = ' #'//BUFFER(2:TRIM(BUFFER)) - BUFFER(PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN) - WRITE(6,'(1X,A,/)') BUFFER(:TRIM(BUFFER)) ! Output header info - END = END + 2 ! Increase display counter - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - - RETURN - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE READ_EDIT - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - CALL CLOSE_BULLFIL - - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,' Date: ',A) - - RETURN - END - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - CHARACTER INREAD*1,FILE_DEF*80,NUMREAD*6 - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH,ERR=18,STATUS='UNKNOWN', - & CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END DO - IF (ILEN.EQ.0) WRITE(6,1040) BULL_PARAMETER(:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - IF (READ_COUNT.GT.0) THEN ! Reposition GET_BULL routine - ILEN = LINE_LENGTH + 1 ! in case read in progress - DO I=1,LINE_OFFSET ! and partial block was read. - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - END IF - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privileges - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message - & number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit), - & F(File it), D(Dir), R(Read msg #) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit), F(File), N(Next), - & D(Dir), R(Read msg #) or other for MORE: ',$) -1040 FORMAT(' Message written to ',A) -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END diff --git a/decus/vax90b1/bulletin_beta/bulletin10.for b/decus/vax90b1/bulletin_beta/bulletin10.for deleted file mode 100644 index 7ff3d32..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin10.for +++ /dev/null @@ -1,1980 +0,0 @@ -C -C BULLETIN10.FOR, Version 1/1/91 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (1) - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - IF (END_LINE.GT.0) THEN - END_LINE = END_LINE + START_READ - 1 - SB = START_READ - EB = END_LINE - 2 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - RETURN - ELSE IF (END_READ-START_READ.EQ.1023) THEN - NEWS_READ = 0 - RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - CHARACTER*(*) WRITE - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - RETURN - END - - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*255 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (HIGHFROM.EQ.USERNAME.AND.MESSAGE_ID(INDEX(MESSAGE_ID,'@')+1: - & TRIM(MESSAGE_ID)-1).EQ.PATHNAME(:INDEX(PATHNAME,'!')-1)) - & THEN - CALL NEWS_POST('cancel',0,IER,'Delete news item.') - ELSE - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*6 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.'.AND..NOT. - & OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ')+SB-2) - & ,START,,%VAL(1))) RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) RETURN - START = MAX(F_START,START-NUMDIR) - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1.AND..NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - IF (I.EQ.2.AND..NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - TEMP(I*256+1:) = BUFFER(SB+INDEX(BUFFER(SB:EB),' '):EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DESCRIP = TEMP(257:512) - CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - NEWS_CONNECTED = NEWS_CONNECT() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) THEN - CALL NEWS_DISCONNECT - RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - - DO WHILE (BUFFER(SB:EB).NE.'.') - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - DESCRIP = BUFFER(SB+9:EB) - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - CALL GET_FROM(BUFFER(SB+6:EB),EB-SB+1) - END IF - END IF - END DO - - IER = 0 - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*6 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*6 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'3FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = (F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - START = -1 - IER = SYS$ASCTIM(,TIME,IN_BTIM,) - CALL DATE_TIME(TIME) - IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( - & FOLDER_NAME))//' '//TIME)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'23') THEN - IF (.NOT.NEWS_READ()) CALL EXIT - FIRST = BUFFER(SB:EB) - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL EXIT - END DO - IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) CALL EXIT - IF (.NOT.NEWS_READ()) CALL EXIT - IF (BUFFER(:2).EQ.'22') THEN - IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN - I = F_NBULL + 1 - DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. - & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) - & .OR.I.GT.F_NBULL)) - I = I - 1 - IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (I.GE.F_START) START = I - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END IF - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - ELSE - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*255 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*255 NEWSGROUPS - - CHARACTER*255 TEMP,FROM_LINE,SUBJECT_LINE - - CHARACTER*10 MSGNUM - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - IF (REMOTE_SET.EQ.3) THEN - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - NEWSGROUPS = ' ' - LREF = 0 - DO WHILE (BUFFER(SB:EB).NE.'.') - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GT.SB+5) THEN - FROM_LINE = 'From: '//BUFFER(SB+6:EB) - ELSE IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND. - & EB.GT.SB+8) THEN - SUBJECT_LINE = 'Subj: '//BUFFER(SB+9:EB) - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - NEWSGROUPS = BUFFER(SB+12:EB) - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - LREF = EB - (SB+12) + 1 - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - LREF = EB - (SB+12) + 1 - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - END IF - END IF - END DO - - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - - IF (REMOTE_SET.EQ.3.AND. - & LSUB.EQ.0.AND..NOT.NEWS_WRITE('ARTICLE '//MSGNUM)) RETURN - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - BUFFER = FROM_LINE - SB = 1 - EB = LFRO - LFRO = 0 - IER = 1 - ELSE IF (LSUB.GT.0) THEN - IF (BUFFER.EQ.SUBJECT_LINE) THEN - IF (.NOT.NEWS_WRITE('ARTICLE '//MSGNUM)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - RETURN - END IF - LSUB = 0 - IER = NEWS_READ() - ELSE - BUFFER = SUBJECT_LINE - SB = 1 - EB = LSUB - IER = 1 - END IF - ELSE - IER = NEWS_READ() - END IF - IF (IER.AND.BUFFER(SB:EB).NE.'.') THEN - IER = 0 - LTEMP = MIN(255,EB-SB+1) - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - ELSE - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128 - ELSE - ILEN = 128 - END IF - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ABS(ILEN).EQ.128) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /READIT/ READIT - - COMMON /NEWS_INIT/ END_READ - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*25 FOLDER_SAVE - - DIMENSION DUMMY(4) - - IF (INDEX(FOLDER1,'.').GT.0) THEN - END_READ = 0 - IF (.NOT.NEWS_LOGIN()) THEN - IER = 2 - RETURN - END IF - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - IF (SYSLOG) THEN - LAST_SYS_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(3) - LAST_SYS_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(4) - END IF - END IF - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*255 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUP - - CHARACTER*6 NUMBER - - CHARACTER IN_BTIM(2) - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURN - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1 - RETURN - ELSE IF (ICOUNT.EQ.-1) THEN - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THEN - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') NEXT = .FALSE. - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURN - BUFFER = BUFFER(5:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),ICOUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - START = ICOUNT - BULLETIN_NUM = START - END IF - NEWGROUP = .FALSE. - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - MESSAGE_ID = BUFFER(:INDEX(BUFFER,' ')-1) - IER = 0 - CALL NEWS_HEADER(IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - BLOCK = START - MSG_NUM = START - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN - END - - - - SUBROUTINE NEWS_GROUP(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IER = NEWS_WRITE('GROUP '//FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP))) - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IF (BUFFER(:3).EQ.'411') THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - IF (IER1.EQ.0) DELETE (7) - CALL CLOSE_BULLFOLDER - RETURN - END IF - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_END,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = 0 - - RETURN - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME - - CHARACTER*20 TIME - - I = 1 - LTIME = TRIM(INTIME) - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:)) - - DO J = 1,2 - I = 1 - DO WHILE (TIME(I:I).NE.' ') - I = I + 1 - END DO - TIME(I:I) = '-' - END DO - - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DO - - CALL SYS_BINTIM(TIME(:I-2),BTIM) - - RETURN - END - - - - SUBROUTINE NEWS_LIST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - NEWS_FOLDER1_BBOARD = '::' - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_END = 1001 - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_END.LT.1001) NEWS_F1_END = 1001 - NEWS_F_END = NEWS_F1_END - LAST_READ = NEWS_FOLDER1_NUMBER - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - NEWS_FOLDER1 = BUFFER(SB:MIN(25,FLEN)+SB-1) - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (FLEN.GT.25) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SB+25:FLEN+SB-1) - ELSE - NEWS_FOLDER1_DESCRIP = ' ' - END IF - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_END,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1 - END DO - NEWS_FOLDER1_NUMBER = NEWS_F_END - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1 - ELSE IF (F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL) THEN - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - DO I = LAST_READ+1,NEXT_READ-1 - DO WHILE (REC_LOCK(IER)) ! Delete non-existant - READ (7,KEY=I,KEYID=1,IOSTAT=IER) ! newsgroups - END DO - IF (IER.EQ.0) DELETE (UNIT=7) - END DO - LAST_READ = NEXT_READ - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - NEWS_F1_END = NEWS_F_END - REWRITE (7) NEWS_FOLDER1_COM - - CALL CLOSE_BULLNEWS - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DO - - RETURN - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*255 REFERENCES - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*255 MESSAGE_ID - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*255 NEWSGROUPS - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER TODAY*23,MSGID*23,ZONE*5 - - DIMENSION NOW(2),GMT(2) - - IER = 1 - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('Newsgroups: '// - & NEWSGROUPS(:TRIM(NEWSGROUPS)))) RETURN - ELSE IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.NEWS_WRITE('Newsgroups: '// - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)))) RETURN - ELSE - IF (.NOT.NEWS_WRITE('Newsgroups: '// - & FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)))) RETURN - END IF - NEWSGROUPS = ' ' - END IF - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(:LPATH))) RETURN - IF (.NOT.NEWS_WRITE('From: '//PATHNAME(INDEX(PATHNAME,'!')+1: - & TRIM(PATHNAME))//'@'//PATHNAME(:INDEX(PATHNAME,'!')-1))) - & RETURN - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & RETURN - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) - & RETURN - END IF - - CALL SYS$ASCTIM(,TODAY(:23),,) - - IF (LZONE.EQ.0) THEN - IF (SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',ZONE)) THEN - IER = OTS$CVT_TI_L(ZONE(:TRIM(ZONE)),DIFF,,%VAL(1)) - IF (DIFF.LT.0) THEN - PAST = .TRUE. - ZONE = ZONE(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - IER = OTS$CVT_L_TI(DIFF,ZONE(1:2),,,) - IF (ZONE(1:1).EQ.' ') ZONE = ZONE(2:) - ELSE - PAST = .FALSE. - END IF - IER = SYS_BINTIM('0 '//ZONE(:TRIM(ZONE))//':00',GMT) - IER = SYS$GETTIM(NOW) - IF (PAST) THEN - IER = LIB$ADDX(NOW,GMT,GMT) - ELSE - IER = LIB$SUBX(NOW,GMT,GMT) - END IF - IER = SYS$ASCTIM(,TODAY,GMT,) - ZONE = 'GMT' - ELSE IF (.NOT.SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .AND..NOT.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - ZONE = 'GMT' - END IF - LZONE = TRIM(ZONE) - END IF - - MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (MSGID(1:1).EQ.' ') MSGID = MSGID(2:) - IF (.NOT.NEWS_WRITE('Message-ID: <'//MSGID(:TRIM(MSGID))// - & '@'//PATHNAME(:INDEX(PATHNAME,'!')-1)//'>')) RETURN - - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - - IF (LORGAN.EQ.0) THEN - LORGAN = TRIM(ORGANIZATION) - IF (LORGAN.EQ.0) THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('BULL_NEWS_ORGANIZATION', - & ORGANIZATION)) THEN - LORGAN = -1 - ELSE - LORGAN = TRIM(ORGANIZATION) - END IF - END IF - END IF - - IF (LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN))) - & RETURN - END IF - - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & ZONE(:LZONE))) RETURN - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel ' - & //MESSAGE_ID(:TRIM(MESSAGE_ID)))) RETURN - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') IER = 0 - RETURN - END IF - - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER) - IF (IER.NE.0) RETURN - END IF - - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2 - END IF - IF (IER1.EQ.0.AND..NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END DO - - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') IER = 0 - -900 IF (.NOT.FILEOPEN) CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME).AND. - & .NOT.SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME)) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURN - END IF - END IF - - PATHNAME = PATHNAME(:TRIM(PATHNAME))//'!' - & //USERNAME(:TRIM(USERNAME)) - CALL LOWERCASE(PATHNAME) - LPATH = TRIM(PATHNAME) - - RETURN - END - - - - - SUBROUTINE NEWS2BULL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER TIME*20,FIRST*80,FOLDER_SAVE*25 - - CHARACTER*6 NUMBER - - DIMENSION SAVE_F_NEWEST_BTIM(2) - - CALL ALLPRIV - - CALL NEWS_LIST - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF ((INDEX(FOLDER_DESCRIP,'@').LE.SLIST.OR. - & FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@').AND. - & INDEX(FOLDER_DESCRIP,'.').GT.SLIST) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - FILEOPEN = .FALSE. - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - IF (.NOT.FILEOPEN) THEN - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - SAVE_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - SAVE_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_SAVE = FOLDER - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (FOLDER_DESCRIP(1:1).EQ.'@'.AND.IER) THEN - OPEN (UNIT=3,FILE=FOLDER_DESCRIP(2:TRIM(FOLDER_DESCRIP)) - & ,STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) THEN - READ (3,'(A)',IOSTAT=IER1) FOLDER_DESCRIP - IF (IER1.NE.0) CLOSE (UNIT=3) - IF (IER1.EQ.0) FILEOPEN = .TRUE. - END IF - ELSE - IER1 = 0 - END IF - END IF - IF (IER.AND.IER1.EQ.0) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL REMOTE_GET_NEWEST_MSG(SAVE_F_NEWEST_BTIM,START) - IF (START.GE.F_START) THEN - CALL OTS$CVT_L_TI(START,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - END IF - END IF - IF (FILEOPEN) THEN - READ (3,'(A)',IOSTAT=IER1) FOLDER_DESCRIP - IF (IER1.NE.0) CLOSE (UNIT=3) - IF (IER1.NE.0) FILEOPEN = .FALSE. - END IF - END IF - END DO - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - CHARACTER*(*) TIME - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+ - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)// - & TIME(16:17)//TIME(19:20) - - RETURN - END - - - - SUBROUTINE ALLPRIV - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1 - PROCPRIV(2) = -1 - NEEDPRIV(1) = -1 - NEEDPRIV(2) = -1 - - RETURN - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COM - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_END,KEYID=1) - IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1 - END DO - - NEWS_FOLDER1_NUMBER = NEWS_F_END - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_END = NEWS_F_END - REWRITE (7) NEWS_FOLDER1_COM - - RETURN - END - - - - SUBROUTINE SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.NE.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')') - RETURN - END IF - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE - WRITE (6,'('' You are now subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - LAST_NEWS_READ2(1,I) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - LAST_NEWS_READ2(2,I) = F_NBULL - (F_START - 1) - LAST_NEWS_READ(2,I) = F_START - 1 - ELSE - LAST_NEWS_READ2(2,I) = 0 - LAST_NEWS_READ(2,I) = F_NBULL - END IF - - RETURN - END - - - - SUBROUTINE UNSUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - DO J=I,FOLDER_MAX-1 - LAST_NEWS_READ(1,J) = LAST_NEWS_READ(1,J+1) - LAST_NEWS_READ(2,J) = LAST_NEWS_READ(2,J+1) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX) = 0 - LAST_NEWS_READ(2,FOLDER_MAX) = 0 - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX.OR.IER.GT.F_NBULL) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = - & (F_NBULL-NUMBER).OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0 - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - LAST_NEWS_READ(1,J) = LAST_NEWS_READ(1,J+1) - LAST_NEWS_READ(2,J) = LAST_NEWS_READ(2,J+1) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX) = 0 - LAST_NEWS_READ(2,FOLDER_MAX) = 0 - ELSE - COUNT = COUNT + 1 - END IF - - IF (COUNT.LE.FOLDER_MAX) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT) - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE - SUBNUM = 0 - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES) -C -C SUBROUTINE NEW_NOTIFICATION -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - CHARACTER*1 DUMMY - - MESSAGES = .FALSE. - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER',DUMMY)) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - IF (MSGNUM.EQ.0) RETURN - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1 - - DO WHILE (SUBNUM.GT.0) - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START) - ELSE IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (MSGNUM.GE.F_NBULL) THEN - IER = 1 - END IF - END IF - IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (DIFF.GT.0) IER = 1 - END IF - END IF - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A,''.'',$)') FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP)) - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A,''.'',$)') FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP)) - ELSE - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IF - END IF - END DO - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX) THEN - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX) THEN - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15) - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE = I - - RETURN - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - IF (NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY cannot be set for news folder.'')') - RETURN - END IF - - IF (READNEW.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - - RETURN - END diff --git a/decus/vax90b1/bulletin_beta/bulletin2.for b/decus/vax90b1/bulletin_beta/bulletin2.for deleted file mode 100644 index b364a46..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin2.for +++ /dev/null @@ -1,1773 +0,0 @@ -C -C BULLETIN2.FOR, Version 12/14/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23,RESPONSE*1 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot set modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*11,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,FOLDER_SAVE*25 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for GENERAL folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND(STATUS) -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FROM_TEST*5,INFROM*(LINE_LENGTH) - - EXTERNAL CLI$_NEGATED - - IF (INCMD(:4).EQ.'REPLY') THEN - BULL_PARAMETER = 'mailing list.' - IF (CLI$PRESENT('ALL')) - & BULL_PARAMETER = 'message owner and mailing list.' - ELSE IF (INCMD(:4).EQ.'RESP') THEN - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) - & BULL_PARAMETER = 'message owner and mailing list.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP) - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - BULL_PARAMETER = 'RE: '//DESCRIP - ELSE - BULL_PARAMETER = 'RE:'//DESCRIP(4:) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P) - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') BULL_PARAMETER - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - IF (EDIT.AND.TEXT) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - LENFRO = 0 - IF (CLI$GET_VALUE('CC',INPUT,ILEN)) THEN - CALL ADD_PROTOCOL(INPUT,ILEN) - INFROM = INPUT(:ILEN)//',' - LENFRO = ILEN + 1 - END IF - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL ADD_PROTOCOL(INPUT(7:),ILEN) - INFROM = INFROM(:LENFRO)//INPUT(7:) - LENFRO = LENFRO + ILEN - 6 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (LIST.AND.REMOTE_SET.NE.3) THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - - IF (INCMD(:4).EQ.'POST') THEN - LENFRO = 0 - ELSE IF (INCMD(:4).EQ.'REPL') THEN - IF (.NOT.CLI$PRESENT('ALL')) LENFRO = 0 - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (LIST.AND.REMOTE_SET.NE.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (REMOTE_SET.NE.4) THEN - INFROM = INFROM(:LENFRO)// - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - LENFRO = LENFRO + TRIM(FOLDER_DESCRIP) - 1 - SLIST - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - LEN_P = TRIM(BULL_PARAMETER) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - IF (LEN_P.EQ.64) THEN - BULL_PARAMETER(I:I) = '`' - ELSE - BULL_PARAMETER = BULL_PARAMETER(:I)//'"' - & //BULL_PARAMETER(I+1:) - I = I + 1 - LEN_P = LEN_P + 1 - END IF - END IF - I = I + 1 - END DO - CALL DISABLE_PRIVS - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - IF (TEXT) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - IF (REMOTE_SET.GE.3.AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & BULL_PARAMETER) - END IF - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// - & INFROM(:LENFRO)//'"/SUBJECT="'//BULL_PARAMETER// - & '"',,,,,,STATUS) - END IF - ELSE - IF (REMOTE_SET.GE.3.AND.LIST) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - WRITE (6,'('' Enter message: End with ctrl-z,'', - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - REWIND (UNIT=3) - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & BULL_PARAMETER) - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// - & INFROM(:LENFRO)// - & '"/SUBJECT="'//BULL_PARAMETER//'"',,,,,,STATUS) - END IF - END IF - ELSE - IER = 0 - CALL LIB$SPAWN('$MAIL SYS$INPUT "'//INFROM(:LENFRO)// - & '"/SUBJECT="'//BULL_PARAMETER//'"',,,,,,STATUS) - END IF - IF (IER.NE.0) WRITE (6,'('' ERROR: No message added.'')') - END IF - CALL ENABLE_PRIVS - -900 IF (EDIT.OR.(REMOTE_SET.GE.3.AND.LIST)) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - END - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: CHANGE command subroutine. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH) - CHARACTER*1 ANSWER - - CHARACTER DATE_SAVE*11,TIME_SAVE*11 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL*1 DOALL - - IF (REMOTE_SET.GT.1) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IF - -C -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - TEXT = CLI$PRESENT('TEXT') - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.TEXT).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')') - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I5,'' cannot be found.'')') - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - LENFROM = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:59) ! Update description header - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT, - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:59),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER TODAY*23,INEXDATE*11,INEXTIME*11 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*132 SEARCH_STRING - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IF - - IER1 = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - - CALL GET_SEARCH(FOUND,SEARCH_STRING,START_BULL, - & CLI$PRESENT('REVERSE'),CLI$PRESENT('SUBJECT'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START')) - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - WRITE (6,'('' No messages found with given search string.'')') - ELSE IF (FOUND.EQ.-2) THEN - WRITE (6,'('' ERROR: No more messages.'')') - END IF - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,START_BULL,REVERSE, - & SUBJECT,REPLY,FILES,START) -C -C SUBROUTINE GET_SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) SEARCH_STRING - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - CHARACTER*53 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN - SEARCH_MODE = 3 - ELSE - SEARCH_MODE = 2 - END IF - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - ELSE IF (REPLY) THEN - CALL READDIR(START_BULL,IER) - IF (START_BULL+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - END IF - - SAVE_STRING = SEARCH_STRING - SEARCH_LEN = TRIM(SAVE_STRING) - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR. - & REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last - END IF - IF (REVERSE) THEN - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - DO BULL_SEARCH = START_BULL+1, END_BULL, STEP_BULL - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - CALL STR$UPCASE(DESCRIP1,DESCRIP) ! Make upper case - IF ((SEARCH_MODE.EQ.3.AND. - & INDEX(DESCRIP1,SEARCH_STRING(:SEARCH_LEN)).GT.0).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1))) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - GO TO 900 - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - GO TO 900 - END IF - END DO - END IF - END DO - - FOUND = 0 - -900 IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN - END - - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IF (REMOTE_SET.GT.1) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')') - RETURN - END IF -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')') - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*(*) INPUT - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - IF (LMAIL.EQ.0) THEN - LMAIL = TRIM(MAILER) - IF (LMAIL.EQ.0) THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('BULL_NEWS_MAILER',MAILER)) THEN - MAILER = 'IN%' - END IF - LMAIL = TRIM(MAILER) - END IF - END IF - - INPUT = MAILER(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"' - - IF (ILEN.NE.0) ILEN = ILEN + LMAIL + 2 - - RETURN - END diff --git a/decus/vax90b1/bulletin_beta/bulletin3.for b/decus/vax90b1/bulletin_beta/bulletin3.for deleted file mode 100644 index 91711fe..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin3.for +++ /dev/null @@ -1,1757 +0,0 @@ -C -C BULLETIN3.FOR, Version 1/1/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*11 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - EXTIME(3:4) = EXTIME(4:5) - READ (EXTIME(1:4),'(I4)') NODE_NUMBER_MSG - EXTIME(9:10) = EXTIME(10:11) - READ (EXTIME(7:10),'(I4)') NODE_AREA_MSG - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.GT.0) NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 EXPDAT - CHARACTER*23 TODAY - - DIMENSION EXTIME(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF ((DEFAULT_EXPIRE.GT.F_EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.F_EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3)) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:),TODAY(13:)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - IF (MAIL_EDIT.EQ.' ') THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - IF (MAIL_EDIT.EQ.' ') THEN - IER = SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT) - ELSE - IER = SS$_NORMAL - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) ! Convert to upper case - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - IF (INDEX(MAIL_EDIT,'CALLABLE_').EQ.0.AND. - & IER.EQ.SS$_NORMAL) THEN - IF (OUT.EQ.INFILE) THEN - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT))) - ELSE - CALL LIB$SPAWN('$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT))) - END IF - ELSE IF (INDEX(MAIL_EDIT,'EDT').GT.0.OR. - & IER.NE.SS$_NORMAL) THEN - CALL EDT$EDIT(INFILE,OUT) - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (.NOT.IER1) THEN - CALL TPU$EDIT(' ',OUT) - ELSE - CALL TPU$EDIT(INFILE,OUT) - END IF - IER1 = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - ! TPU does CLI$ stuff which wipes our parsed command line - END IF - CALL ENABLE_PRIVS - - RETURN - END - - - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($JPIDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PQLDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15 - - STRUCTURE /QUOTA_ITMLST/ - BYTE ITEM - INTEGER VALUE - END STRUCTURE - - RECORD /QUOTA_ITMLST/ QUOTA(3) - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXIT - END IF - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1 - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP') - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - I = 1 - IER = CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(I).ITEM = PQL$_PGFLQUOTA - QUOTA(I).VALUE = PGFLQUOTA - I = I + 1 - END IF - IER = CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - QUOTA(I).ITEM = PQL$_WSEXTENT - QUOTA(I).VALUE = WSEXTENT - I = I + 1 - END IF - QUOTA(I).ITEM = PQL$_LISTEND - QUOTA(I).VALUE = 0 - - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0)) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*1 DUMMY - - IER = SYS_TRNLNM('BULL_BULLCP',DUMMY) - IF (IER) BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - CHARACTER*23 OLD_TIME,NEW_TIME - - CHARACTER*1 DUMMY - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - HOUR = 0 - - DO WHILE (1) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - CALL SYS$SETAST(%VAL(1)) - CALL BBOARD ! Look for BBOARD messages. - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Do empty block - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - - IF (SYS_TRNLNM('BULL_NEWS_SERVER',DUMMY).AND.HOUR.EQ.0) THEN - CALL SYS$SETAST(%VAL(0)) - CALL CREATE_PROCESS('BULLCP NEWS') - CALL SYS$SETAST(%VAL(1)) - END IF - - HOUR = HOUR + 1 - IF (HOUR.EQ.4) HOUR = 0 - - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Cleanup deleted users from - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! data files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - - OLD_TIME = NEW_TIME - CALL HIBER('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL REGISTER_BULLCP - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER NODENAME*8 - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - END IF - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE HIBER(PARAM) -C -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - - TIMBUF(6:7) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/ - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(9:10) = PARAM - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - - SUBROUTINE DELETE_EXPIRED - -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER UPTIME_DATE*11,UPTIME_TIME*11 - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD.EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - IF (INDEX(INTO,FOLDER_BBOARD(:FLEN)).EQ.0.AND. - & INTO.NE.FOLDER_BBOARD.AND.INDEX(INTO,'@').EQ.0) THEN - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOLDER1_BBOARD = FOLDER_BBOARD - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - FOLDER_Q2_SAVE = FOLDER_Q2 - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - FLEN = TRIM(FOLDER1_BBOARD) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD.NE.'NONE') THEN - IF (INTO.EQ.FOLDER1_BBOARD) THEN - FOUND = .TRUE. - ELSE - FIND_TO = INDEX(INTO,FOLDER1_BBOARD(:FLEN)) - IF (FIND_TO.GT.0) THEN - END_TO = FLEN+FIND_TO - IF (TRIM(INTO).LT.END_TO.OR. - & INTO(END_TO:END_TO).LT.'A'.OR. - & INTO(END_TO:END_TO).GT.'Z') THEN - IF (FIND_TO.EQ.1) THEN - FOUND = .TRUE. - ELSE IF (INTO(FIND_TO-1:FIND_TO-1).LT.'A'.OR. - & INTO(FIND_TO-1:FIND_TO-1).GT.'Z') THEN - FOUND = .TRUE. - END IF - END IF - END IF - END IF - END IF - END DO - IF (FOUND) THEN - FOLDER_COM = FOLDER1_COM - FOLDER_Q_SAVE = FOLDER_Q2_SAVE - END IF - END IF - - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - - CALL SYS$SETAST(%VAL(1)) - - IF (SYS_TRNLNM('BULL_NEWS_SERVER',DUMMY).AND. - & .NOT.TEST_BULLCP()) CALL NEWS2BULL - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=14) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - WRITE (6,1030) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - - RETURN - END - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD.NE.'NONE') THEN ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DO - - CALL CLOSE_BULLDIR - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - CALL CLOSE_BULLDIR - - RETURN - END diff --git a/decus/vax90b1/bulletin_beta/bulletin4.for b/decus/vax90b1/bulletin_beta/bulletin4.for deleted file mode 100644 index 1834332..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin4.for +++ /dev/null @@ -1,1803 +0,0 @@ -C -C BULLETIN4.FOR, Version 1/1/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - READ (4,IOSTAT=IER) USER_ENTRY ! Skip header - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':') THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - DATA POINT/0/ - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = 0 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(LINE_LENGTH) DATE_LINE - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(BUFFER,0,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (1) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - IF (STRIP) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.OR.BUFFER(:5).EQ.'Subj:') THEN - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - END IF - END IF - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' ') THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,ILEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C ILEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns ILEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(LINE_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? - IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - ILEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - ILEN = -1 ! ILEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - ILEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - BUFFER = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) ! Output line. - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(ILEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - ILEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - ILEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (ILEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = ILEN - (BRECLEN-POINT) ! Store leftover length - ILEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (ILEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(ILEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - ILEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - ILEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - IF (BTEST(FOLDER_FLAG,1)) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -900 CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - CALL WRITEDIR(0,IER) - -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - FLEN = TRIM(FOLDER1_FILE) - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLFIL',%VAL(ACL_ITMLST),,,) - IF (.NOT.IER) RETURN - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND. ! /NOTIFY /READNEW /BRIEF privileged - & (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'( - & '' ERROR: No privs for SYSTEM, NOTIFY, BRIEF or READNEW.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - LENDES = 0 - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_OWNER = FOLDER1_OWNER - - IF (CLI$PRESENT('SYSTEM')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - END IF - - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -C -C Description: -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*255 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END diff --git a/decus/vax90b1/bulletin_beta/bulletin5.for b/decus/vax90b1/bulletin_beta/bulletin5.for deleted file mode 100644 index 076a390..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin5.for +++ /dev/null @@ -1,2017 +0,0 @@ -C -C BULLETIN5.FOR, Version 1/1/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_NEGATED - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot set modify for remote folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - - RETURN - - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (FOLDER_NUMBER.LT.0.AND.NEWS_FOLDER_NUMBER.GT.0) THEN - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & FOLDER1.EQ.'GENERAL') THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - FOLDER_SET = .FALSE. - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER*132 DCL_CMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.FALSE./ - - EXTERNAL CLI$_ABSENT - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - CHARACTER*25 FOLDER1_SAVE - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1) - IF (FOLDER1(1:1).EQ.'"'.AND.INCMD.EQ.'SELECT') THEN - DCL_COMMAND = 1 - DCL_CMD = FOLDER1(2:) - IF (DCL_CMD(TRIM(DCL_CMD):).EQ.'"') THEN - DCL_CMD = DCL_CMD(:TRIM(DCL_CMD)-1) - END IF - IER = %LOC(CLI$_ABSENT) - FOLDER1 = ' ' - END IF - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - ELSE - IF (INDEX(FOLDER1,'.').GT.0.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER',FOLDER1_SAVE)) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP - END IF - END IF - - CALL CLOSE_BULLFOLDER - END IF - - IF ((IER.EQ.0.OR.INDEX(FOLDER1,'.').GT.0).AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1 - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (INDEX(FOLDER1,'.').EQ.0) THEN - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD)) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET = 1 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - REMOTE_SET = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_NBULL = F1_NBULL - F_START = F1_START - CALL REWRITE_FOLDER_FILE - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Copy remote folder protection - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - ELSE - LOCAL_FOLDER1_FLAG = IBCLR(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - REMOTE_SET = 1 - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::' - & .AND..NOT.SETPRV_PRIV()) THEN - ! Is folder protected and not remote? - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND. - & IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (FOLDER1_BBOARD(:2).NE.'::') THEN - IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - END IF - - IF (IER) THEN - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP - FOLDER_NUMBER = -1 - END IF - - IF (REMOTE_SET.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0.AND.(INDEX(FOLDER_DESCRIP,'@').LE.SLIST - & .OR.FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@').AND. - & INDEX(FOLDER_DESCRIP,'.').GT.SLIST) REMOTE_SET = 4 - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') - & WRITE (6,'('' Folder only accessible for reading.'')') - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0) THEN - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (FOLDER_NUMBER.GE.0.AND.CLI$PRESENT('MARKED')) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - IF (INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only marked messages'', - & '' will be shown.'')') - ELSE - WRITE(6,'('' ERROR: No marked messages found.'')') - END IF - END IF - ELSE - READ_TAG = .FALSE. - END IF - END IF - - IF (REMOTE_SET.EQ.3.AND.OUTPUT) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.NE.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & FOLDER1 = FOLDER - - IF (INDEX(FOLDER1,'::').NE.0.OR.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Folder is a private folder.'')') - ELSE - WRITE (6,'('' Folder is not a private folder.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /CTRLC_FLAG/ FLAG - - DATA SCRATCH_D1/0/ - - CHARACTER*80 FOLDER_MATCH - - CHARACTER*17 DATETIME - - CHARACTER*1 DUMMY - - SUBSCRIBE = .FALSE. - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER',DUMMY)) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF - - IF (FOLDER_COUNT.EQ.0) THEN - FOLDER_COUNT = 1 ! Init folder number counter - NLINE = 1 - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE. - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - CALL NEWS_LIST - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - END IF - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_END) - SUBNUM = 1 - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER) - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN) - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - F1_END = MSGNUM - IF (SUBNUM.EQ.0) IER = 1 - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - END IF - IF (IER.EQ.0) THEN - IF (INDEX(FOLDER1_BBOARD,'::').EQ.0.AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - IF (.NOT.MATCH) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF (STR$MATCH_WILD(FOLDER1 - & (:TRIM(FOLDER1)),FOLDER_MATCH(:MLEN))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) IER1 = 1 - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DO - - IF (MATCH) MATCH = .FALSE. - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Folder search aborted.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE - WRITE (6,'(1X,''Folder'',60X,''First Last'', - & /,1X,80(''-''))') - END IF - - IF (.NOT.PAGING) THEN - DISPLAY = NUM_FOLDER*NLINE+2 - ELSE - DISPLAY = MIN(NUM_FOLDER*NLINE+2,PAGE_LENGTH-4) - ! If more entries than page size, truncate output - END IF - - I = 1 - DO WHILE ((I.LE.(DISPLAY-2)/NLINE.OR.MATCH).AND.FLAG.NE.1) - IF (.NOT.MATCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL, - & FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL, - & FOLDER1_OWNER - END IF - ELSE - IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - IF (F1_END.LT.F1_NBULL) THEN - WRITE (6,1005) '*'//FOLDER1_DESCRIP(:63), - & F1_START,F1_NBULL - ELSE - WRITE (6,1005) ' '//FOLDER1_DESCRIP(:63), - & F1_START,F1_NBULL - END IF - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:64),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1005) ' '//FOLDER1_DESCRIP(:63),0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:64),0,0 - END IF - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - IF (MATCH.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) FLAG = 1 - FOUND = .FALSE. - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0.AND.STR$MATCH_WILD(FOLDER1 - & (:TRIM(FOLDER1)),FOLDER_MATCH(:MLEN))) THEN - FOUND = .TRUE. - END IF - END DO - IF (.NOT.FOUND) FLAG = 1 - END IF - END DO - - IF (MATCH) THEN - CALL CLOSE_BULLFOLDER - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - END IF - - IF (IER.NE.0) THEN ! Outputted all entries? - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - ELSE - WRITE(6,1100) ! Else say there are more - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A64,1X,I6,' ',I6) -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*1 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ELSE - ID = INPUT - INPUT = ' ' - END IF - ILEN = TRIM(ID) - IF (ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - CALL OPEN_BULLFOLDER ! Open folder file - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*255 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7) NEWS_FOLDER_COM - ELSE - REWRITE (7) FOLDER_COM - END IF - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7) NEWS_FOLDER1_COM - ELSE - REWRITE (7) FOLDER1_COM - END IF - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - DO I=1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*23 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END diff --git a/decus/vax90b1/bulletin_beta/bulletin6.for b/decus/vax90b1/bulletin_beta/bulletin6.for deleted file mode 100644 index b48bb7a..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin6.for +++ /dev/null @@ -1,1693 +0,0 @@ -C -C BULLETIN6.FOR, Version 1/1/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - CHARACTER*25 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED,READONLY, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - - IF (IER.EQ.0) THEN - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.FOLDER_RECORD/4) THEN - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE,ASK_SIZE) - NTRIES = 0 - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - CALL OPEN_FILE(LUN) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE_SHARE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP(26:) - NEWS_FOLDER_BBOARD = FOLDER_BBOARD - NEWS_F_NBULL = F_NBULL - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - NEWS_FOLDER1_BBOARD = FOLDER1_BBOARD - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER//NEWS_FOLDER_DESCRIP(26:) - FOLDER_BBOARD = NEWS_FOLDER_BBOARD - F_NBULL = NEWS_F_NBULL - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = 0 - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1//NEWS_FOLDER1_DESCRIP(26:) - FOLDER1_BBOARD = NEWS_FOLDER1_BBOARD - F1_NBULL = NEWS_F1_NBULL - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = 0 - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*115 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(1:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(1:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(78:81) = BUFFER(85:) - BULLDIR_ENTRY(90:97) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(1:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME,ASK_SIZE) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER*80 NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.173/4) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - IF (IER.EQ.0) THEN - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*3 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - DIR_NUM = 0 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURN - END IF - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' ') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I3)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (MSG_NUM.NE.ICOUNT) IER = 36 - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) BULLDIR_ENTRY - END IF - END DO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURN - END IF - END IF - - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - - UNLOCK 2 - - RETURN - - END - - - - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If not 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) BULLDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - ELSE - IER = 0 - DIR_NUM = -1 - END IF - UNLOCK 2 - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME - NEWEST_EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME - NEWEST_TIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME - SHUTDOWN_TIME = DATETIME(13:) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME - EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME - TIME = DATETIME(13:) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - INCLUDE 'BULLDIR.INC' - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - ELSE - IF (CONV) CALL CONVERT_ENTRY_TOBIN - MSG_NUM = BULLETIN_NUM - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - - RETURN - END - - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(1:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII)) - IF (ACLSTR(START_ID:START_ID).NE.','.AND. - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DO - IF (ASCII) THEN - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = RECL/8 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl output - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - CALL LIB$FREE_VM(ACLLENGTH+8,ACLSTR) - - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C -C SUBROUTINE COPY_ACL1 -C -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - ! Read input file acl - - IF (.NOT.IER) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END diff --git a/decus/vax90b1/bulletin_beta/bulletin7.for b/decus/vax90b1/bulletin_beta/bulletin7.for deleted file mode 100644 index 055151a..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin7.for +++ /dev/null @@ -1,2026 +0,0 @@ -C -C BULLETIN7.FOR, Version 1/1/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - - BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(1:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_NUMBER.GT.0) THEN ! Folder private? - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - CHARACTER OUTPUT*160,TERMINAL*7,FLAGS*1 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - CHARACTER*12 SENT_TEMP_USER - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER(1:TRIM(FOLDER)) - & //'. From: '//FROM(1:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USER) - WRITE_TEMP_USER = TEMP_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USER,TERMINAL)) - READ_TEMP_USER = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USER.NE.SENT_TEMP_USER.AND. - & READ_TEMP_USER.NE.WRITE_TEMP_USER) - CALL READ_QUEUE(%VAL(READ_TEMP_USER),READ_TEMP_USER, - & SENT_TEMP_USER) - END DO - IF (TEMP_USER.NE.SENT_TEMP_USER) THEN - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_USER),WRITE_TEMP_USER, - & TEMP_USER) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USER,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TEMP_USER(:TRIM(TEMP_USER)),%VAL(BRK$C_USERNAME) - & ,,,%VAL(BFLAG),,,,) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(1:11) - NEWEST_TIME = TODAY_TIME(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - NEW_DATE = .TRUE. - - GO TO 10 - - ENTRY NEWS2BULL_ADD_ENTRY - - NEW_DATE = .FALSE. - -10 CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - IF (.NOT.NEW_DATE) THEN - DIFF = COMPARE_DATE(NEWEST_DATE,DATE) - IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_TIME,TIME) - END IF - IF (DIFF.GE.0) NEW_DATE = .TRUE. - END IF - - IF (NEW_DATE) THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:) - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*11 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM) OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:TRIM(INPUT)),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM) OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL UPDATE_USERINFO - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FILENAME*132,BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - NBLOCK = NBLOCK + LENGTH - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*11 DATE_SAVE,EXDATE_SAVE - CHARACTER*11 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.NE.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(1:TRIM(FOLDER_NAME)) - - IF (REMOTE_SET.NE.3.AND.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - END IF - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (REMOTE_SET.EQ.3.OR. - & .NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - IF (REMOTE_SET.NE.3) CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER pscan$_BEGIN = '00000000'X - PARAMETER pscan$_ACCOUNT = '00000001'X - PARAMETER pscan$_AUTHPRI = '00000002'X - PARAMETER pscan$_CURPRIV = '00000003'X - PARAMETER pscan$_GRP = '00000004'X - PARAMETER pscan$_HW_MODEL = '00000005'X - PARAMETER pscan$_HW_NAME = '00000006'X - PARAMETER pscan$_JOBPRCCNT = '00000007'X - PARAMETER pscan$_JOBTYPE = '00000008'X - PARAMETER pscan$_MASTER_PID = '00000009'X - PARAMETER pscan$_MEM = '0000000A'X - PARAMETER pscan$_MODE = '0000000B'X - PARAMETER pscan$_NODE_CSID = '0000000C'X - PARAMETER pscan$_NODENAME = '0000000D'X - PARAMETER pscan$_OWNER = '0000000E'X - PARAMETER pscan$_PRCCNT = '0000000F'X - PARAMETER pscan$_PRCNAM = '00000010'X - PARAMETER pscan$_PRI = '00000011'X - PARAMETER pscan$_PRIB = '00000012'X - PARAMETER pscan$_STATE = '00000013'X - PARAMETER pscan$_STS = '00000014'X - PARAMETER pscan$_TERMINAL = '00000015'X - PARAMETER pscan$_UIC = '00000016'X - PARAMETER pscan$_USERNAME = '00000017'X - PARAMETER pscan$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER pscan$_END = '00000019'X - PARAMETER pscan$k_type = '00000081'X - PARAMETER pscan$M_OR = '00000001'X - PARAMETER pscan$M_BIT_ALL = '00000002'X - PARAMETER pscan$M_BIT_ANY = '00000004'X - PARAMETER pscan$M_GEQ = '00000008'X - PARAMETER pscan$M_GTR = '00000010'X - PARAMETER pscan$M_LEQ = '00000020'X - PARAMETER pscan$M_LSS = '00000040'X - PARAMETER pscan$M_PREFIX_MATCH = '00000080'X - PARAMETER pscan$M_WILDCARD = '00000100'X - PARAMETER pscan$M_CASE_BLIND = '00000200'X - PARAMETER pscan$M_EQL = '00000400'X - PARAMETER pscan$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER pscan$S_OR = 1 - PARAMETER pscan$V_OR = 0 - PARAMETER pscan$S_BIT_ALL = 1 - PARAMETER pscan$V_BIT_ALL = 1 - PARAMETER pscan$S_BIT_ANY = 1 - PARAMETER pscan$V_BIT_ANY = 2 - PARAMETER pscan$S_GEQ = 1 - PARAMETER pscan$V_GEQ = 3 - PARAMETER pscan$S_GTR = 1 - PARAMETER pscan$V_GTR = 4 - PARAMETER pscan$S_LEQ = 1 - PARAMETER pscan$V_LEQ = 5 - PARAMETER pscan$S_LSS = 1 - PARAMETER pscan$V_LSS = 6 - PARAMETER pscan$S_PREFIX_MATCH = 1 - PARAMETER pscan$V_PREFIX_MATCH = 7 - PARAMETER pscan$S_WILDCARD = 1 - PARAMETER pscan$V_WILDCARD = 8 - PARAMETER pscan$S_CASE_BLIND = 1 - PARAMETER pscan$V_CASE_BLIND = 9 - PARAMETER pscan$S_EQL = 1 - PARAMETER pscan$V_EQL = 10 - PARAMETER pscan$S_NEQ = 1 - PARAMETER pscan$V_NEQ = 11 - BYTE %FILL (2) - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./ - - EQUIVALENCE (LAST_READ_BTIM(1,1),LAST(1,1)) - DIMENSION LAST(2,FOLDER_MAX) - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IF - END DO - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_BULLUSER - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIM - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0 - LAST_SYS_BTIM(2,I) = 0 - END DO - END IF - - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_NEWS_READ - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - - EQUIVALENCE (LAST_READ_BTIM(1,1),LAST(1,1)) - DIMENSION LAST(2,FOLDER_MAX) - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF.AND.FNUM.LE.FOLDER_MAX) - DIFF = LAST_READ_BTIM(1,FNUM).NE.OLD_LAST_READ_BTIM(1,FNUM) - IF (.NOT.DIFF) THEN - DIFF = LAST_READ_BTIM(2,FNUM).NE.OLD_LAST_READ_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1 - END DO - - DIFF1 = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF1.AND.FNUM.LE.FOLDER_MAX) - DIFF1 = LAST_SYS_BTIM(1,FNUM).NE.OLD_LAST_SYS_BTIM(1,FNUM) - IF (.NOT.DIFF1) THEN - DIFF1 = LAST_SYS_BTIM(2,FNUM).NE.OLD_LAST_SYS_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1 - END DO - - DIFF2 = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF2.AND.FNUM.LE.FOLDER_MAX) - DIFF2 = LAST_NEWS_READ(1,FNUM).NE.OLD_LAST_NEWS_READ(1,FNUM) - IF (.NOT.DIFF2) THEN - DIFF2 = LAST_NEWS_READ(2,FNUM).NE.OLD_LAST_NEWS_READ(2,FNUM) - END IF - FNUM = FNUM + 1 - END DO - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHARED - - IF (DIFF) THEN - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - - IF (DIFF1) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF - - IF (DIFF2) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - END IF - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - IF (TRIM(TIME).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(1:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - IF (NEW_MESS.OR.NEWS_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new GENERAL messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(1:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(1:TRIM(FOLDER)) - END IF - DIFF = 0 - END IF - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/,SAVE_FOLDER_NUM/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - CALL MODIFY_SYSTEM_LIST(1) - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = -1 - FOLDER1 = 'GENERAL' - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to GENERAL folder.'')') - - RETURN - END diff --git a/decus/vax90b1/bulletin_beta/bulletin8.for b/decus/vax90b1/bulletin_beta/bulletin8.for deleted file mode 100644 index bf14be7..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin8.for +++ /dev/null @@ -1,1907 +0,0 @@ -C -C BULLETIN8.FOR, Version 11/28/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER NAMEDESC*9 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1')! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - - RETURN - END - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*9 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*6,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).GT.0) THEN - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,%VAL(1),,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.15) THEN - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)), - & %VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_WRITEVBLK,READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX), - & %VAL(READ_IOSB(2,UNIT_INDEX)),,%VAL(1),,) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/ - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(WRITE_EFS(UNIT_INDEX), - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - IER = NEWS_CREATE_BULLCP(WRITE_EFS(UNIT_INDEX), - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*53 - CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - BULLCP_PRIV(1) = PROCPRIV(1) - BULLCP_PRIV(2) = PROCPRIV(2) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - NODENAME = NODE_SAVE(UNIT_INDEX) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15) THEN ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USERNAME,PRIV_SAVE(1,UNIT_INDEX)) - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - PRIV_SAVE(1,UNIT_INDEX) = PROCPRIV(1) - PRIV_SAVE(2,UNIT_INDEX) = PROCPRIV(2) - END IF - END IF - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:1))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:1))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:5))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:9))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24 - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:17))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP)) - CALL LIB$MOVC3(11,%REF(BUFFER(58:58)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(69:69)),%REF(EXTIME)) - CALL LIB$MOVC3(4,%REF(BUFFER(80:80)),SYSTEM) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(84:84)),BROAD) - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(88:88)),BELL) - CALL LIB$MOVC3(4,%REF(BUFFER(92:92)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(97:97)),CLUSTER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:9)),%REF(MSG_KEY(1:1))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),EBULL) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP_TEMP)) - CALL LIB$MOVC3(4,%REF(BUFFER(58:58)),ICOUNT) - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(53,%REF(BUFFER(62:62)),%REF(DESCRIP)) - CALL LIB$MOVC3(4,%REF(BUFFER(115:115)),%REF(MSGTYPE)) - CALL LIB$MOVC3(11,%REF(BUFFER(119:119)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(130:130)),%REF(EXTIME)) - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE) - DESCRIP_TEMP = BUFFER(9:61) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(11,%REF(BUFFER(62:62)),%REF(EXDATE)) - CALL LIB$MOVC3(11,%REF(BUFFER(73:73)),%REF(EXTIME)) - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:5)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:13)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:1))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:13)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:17)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:21)),FOLDER_NUMBER) - FOLDER = BUFFER(25:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - END IF - -1000 PROCPRIV(1) = BULLCP_PRIV(1) - PROCPRIV(2) = BULLCP_PRIV(2) - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*25,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = -1 - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) THEN - PROCPRIV(1) = NEEDPRIV(1) - PROCPRIV(2) = NEEDPRIV(2) - END IF - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256,PASSWORD*31,TEMP_USER*12 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - RETURN - END diff --git a/decus/vax90b1/bulletin_beta/bulletin9.for b/decus/vax90b1/bulletin_beta/bulletin9.for deleted file mode 100644 index 06127d8..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin9.for +++ /dev/null @@ -1,1977 +0,0 @@ -C -C BULLETIN9.FOR, Version 10/23/90 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=13,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(13,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=13) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (13,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(13,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=13,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=13) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=13) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/TEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - INCLUDE '($HLPDEF)' - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - ELSE - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - END IF - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA DISPLAY_ID/0/,KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (1) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - CHARACTER VERSION*10,DATE*23 - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - END - - - - - - - SUBROUTINE TAG(ADD_OR_DEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_ABSENT - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - IER1 = 0 - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT).AND.IER1.EQ.0) ! Get the specified messages - - DECODE(LEN_P,'(I)',BULL_PARAMETER) MESSAGE_NUMBER - - CALL READDIR(MESSAGE_NUMBER,IER) ! Get info for bulletin - - IF (IER.NE.MESSAGE_NUMBER+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER1) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Message '',I, - & '' was not marked.'')') MESSAGE_NUMBER - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found.') - - END - - - - SUBROUTINE ADD_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 TAG_KEY - - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY) - - IF (IER.EQ.FOR$IOS_INCKEYCHG) THEN - WRITE (6,'('' Message was already marked.'')') - ELSE IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to add mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE DEL_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*12 TAG_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - END DO - IF (IER.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to delete mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER) RETURN - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE='BULL_MARK:'// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (IER.EQ.0) BULL_TAG = .TRUE. - - RETURN - END - - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*64 BULL_MARK - - IER = SYS_TRNLNM('BULL_MARK',BULL_MARK) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: BULL_MARK must be defined.'', - & '' See HELP MARK.'')') - RETURN - ELSE - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1.OR.BULL_MARK.NE.BULL_PARAMETER) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = 0 - END IF - OPEN (UNIT=13,FILE='BULL_MARK:'// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - BULL_TAG = .TRUE. - IER = 1 - END IF - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - GO TO 10 - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE) - - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - & INPUT_KEY - END DO - - IF (IER.EQ.0) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - HEADER = .FALSE. - -10 DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - & INPUT_KEY - END DO - - DO WHILE (1) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (FOLDER1_NUMBER.NE.FOLDER_NUMBER.OR.IER.NE.0) THEN - IER = 1 - UNLOCK 13 - RETURN - ELSE - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE - CALL READDIR_KEYGE(IER) - END IF - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - RETURN - ELSE - DELETE (UNIT=13) - DO WHILE (REC_LOCK(IER)) - READ (13,IOSTAT=IER) INPUT_KEY - END DO - END IF - END IF - - END DO - - END - - - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. Added per request of a faculty member for his private -C board. Changes to BULLETIN.FOR should be fairly obvious. -C -C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2) -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - DATA FOLDER_Q1/0/ - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - CALL OPEN_BULLNEWS_SHARED ! Get folder file - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_END) - SUBNUM = 1 - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,F1_END) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - END IF - IF (IER.EQ.0.AND.FOLDER1_NUMBER.EQ.1000) IER = 2 - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLNEWS ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - WRITE (6,1000) - IF (SUBSCRIBE) THEN - WRITE (6,1025) - ELSE - WRITE (6,1020) - END IF - DO J = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - WRITE (6,1035) FOLDER1_DESCRIP(:72),F1_NBULL - ELSE - WRITE (6,1030) FOLDER1,F1_NBULL, - & FOLDER1_DESCRIP(:MIN(TRIM(FOLDER1_DESCRIP),47)) - END IF - END DO - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - READ_TAG = .FALSE. - IF (CLI$PRESENT('MARKED')) READ_TAG = .TRUE. - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1020 FORMAT (' Name Count Description'/) -1025 FORMAT (' Name',69X,'Count'/) -1030 FORMAT (1X,A,1X,I5,1X,A) -1035 FORMAT (1X,A,1X,I5) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') - - END - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - DIMENSION NOLOGIN_BTIM(2) - - CHARACTER*17 DATETIME - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV_PRIV().AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to user command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - CALL OPEN_BULLUSER_SHARED - - IF (.NOT.ALL) THEN - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - ELSE - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(LINE_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER_FROM/ OLD_BUFFER_FROM - DATA OLD_BUFFER_FROM /.FALSE./ - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - RETURN - ELSE - IER = 1 - END IF - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - ELSE - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1) - IF (IER1.NE.0) THEN - OPEN (UNIT=3,STATUS='SCRATCH',FILE='BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - OLD_BUFFER = ' ' - - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - CHARACTER*255 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(LINE_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER_FROM/ OLD_BUFFER_FROM - DATA OLD_BUFFER_FROM /.FALSE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(LINE_LENGTH) DATE_LINE - - CHARACTER*23 TODAY - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:LEN_BUFFER) - IF (OLD_BUFFER_FROM.AND.BUFFER(:1).EQ.' ') THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER - OLD_BUFFER_FROM = .FALSE. - ELSE IF (BUFFER(:5).EQ.'From:') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - CALL WRITEOUT_STORED - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - CALL STORE_BULL(1,' ',NBLOCK) ! just store one space - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2 - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-') - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO - INEXDATE = .TRUE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - TEXT = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*23 TODAY - - DIMENSION BIN_EXTIME(2) - - IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - RETURN - END IF - - EXTIME = '00:00:00.00' - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(LINE_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.'''') THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(INFROM,LEN_INFROM) - - RETURN - END - - - SUBROUTINE GET_FROM(INFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INFROM - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - IF (INDEX(INFROM,'<').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<'):) ! personal-name - END IF - - IF (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name) - & INDEX(INFROM,'@').GT.INDEX(INFROM,'(')) THEN - INFROM = INFROM(INDEX(INFROM,'(')+1:) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'"')) - I = I + 1 - END DO - INFROM = INFROM(I:) - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.12.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'"') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,I-1 - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(LINE_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - END IF - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header line - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - IF (REMOTE_SET.NE.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.' - END IF - END IF - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - - RETURN - END diff --git a/decus/vax90b1/bulletin_beta/bulletin_beta_ann.txt b/decus/vax90b1/bulletin_beta/bulletin_beta_ann.txt deleted file mode 100644 index 904e285..0000000 --- a/decus/vax90b1/bulletin_beta/bulletin_beta_ann.txt +++ /dev/null @@ -1,71 +0,0 @@ -From: ADVAX::"MRL@NERUS.PFC.MIT.EDU" " " 1-FEB-1991 06:54:40.20 -To: ARISIA::EVERHART -CC: -Subj: BULLETIN - -Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Fri, 1 Feb 91 06:53:22 EST -Received: from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP - id AA07227 for ; Fri, 1 Feb 91 06:46:44 -0500 -From: MRL@NERUS.PFC.MIT.EDU -Received: from NERUS.PFC.MIT.EDU by mcnc.mcnc.org (5.59/MCNC/6-11-90) - id AA25895; Fri, 1 Feb 91 05:34:05 -0500 - for ARISIA.DNET.ge.com!EVERHART -Message-Id: -Date: Fri, 1 Feb 91 05:31 EST -Subject: BULLETIN -To: ARISIA::EVERHART -X-Envelope-To: EVERHART@ARISIA.DNET.GE.COM -X-Vms-To: IN%"EVERHART@ARISIA.DNET.GE.COM" - -NOTE: IF YOU NO LONGER WISH TO RECEIVE ON NEW BULLETIN RELEASES, OR YOU ARE -GETTING MORE THAN ONE COPY OF THIS, PLEASE LET ME KNOW. - -Greetings: - -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups, it will periodically update it via BULLCP. Other client-only readers -use a private database, which requires updating it every time the reader -program is run, which is why they take a long time to start up. It is also -possible to feed NEWS groups into a "real" BULLETIN folder, so that the -messages are saved on disk. - -Presently, BULLETIN can be used with either MULTINET or CMU TCP/IP packages -(and of course DECNET) for reading NEWS. Support for other packages can be -added if I can find sites willing to beta test the interface for me. The -source for the TCP interface is in C rather than FORTRAN because the MULTINET -include files are in C. However, if you do not have C, I will be glad to send -the object for it (or to even possibly rewrite the code in FORTRAN). - -If you would like a copy of this version, use the SEND BETA command instead of -SEND ALL. Read the file NEWS.TXT for installation instructions. If you have -any problems or questions, please let me know. - MRL - -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. diff --git a/decus/vax90b1/bulletin_beta/pmdf.com b/decus/vax90b1/bulletin_beta/pmdf.com deleted file mode 100644 index 469515b..0000000 --- a/decus/vax90b1/bulletin_beta/pmdf.com +++ /dev/null @@ -1,1019 +0,0 @@ -$set nover -$copy sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy sys$input BULLETIN_MASTER.PAS_V32 -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *) -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - - outbound : text; - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL - 100; - - VAR - line, errorsto : vstring; - bigline : bigvstring; result : rp_bufstruct; - header : he_header; - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string); - - BEGIN (* try_something *) - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *) - end; (* try_something *) - - BEGIN (* return_bad_messages *) - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt'); - try_something (he_read_header (header, qu_rtxt), 'he_read_header'); - errorsto.length := 0; - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i]; - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto), - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr); - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *) - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages (tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but -there is a small bug in it. The following instructions are for V3.1. It will -work with V3.2, but V3.2 does have shared images that can be linked to if you -use the MAKEFILE that comes with PMDF (although you have to modify MAKEFILE in -order to correctly point to BULL.OLB). - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows: - - LINK BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - -and put the .EXE in PMDF_ROOT:[EXE]. Put the new MASTER.COM in PMDF_ROOT:[EXE]. -NOTE: Check your MASTER.COM, as the latest version of PMDF contains the code -necessary to check for bulletin mail. However, it will not necessary have the -latest copy of BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders. After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vax91a/bulletin/aaareadme.txt b/decus/vax91a/bulletin/aaareadme.txt deleted file mode 100644 index 8f72906..0000000 --- a/decus/vax91a/bulletin/aaareadme.txt +++ /dev/null @@ -1,169 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utility PMDF. If you wish to -do so for another utility, read the text file WRITEMSG.TXT. I would be glad to -include any such programs with my distribution if you think such a program -would be of use to other users. - -Responding to mail which is either added via the BBOARD feature is done using -VMS MAIL. If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require different - linked executables.) - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compression that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. - -10) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - The object BULLETIN pointing to BULLETIN.COM must be added to the NCP - database, i.e. the command - MCR NCP SET OBJ BULLETIN FILE directory:BULLETIN.COM number 0 - must be executed at startup time on the remote node. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. diff --git a/decus/vax91a/bulletin/allmacs.mar b/decus/vax91a/bulletin/allmacs.mar deleted file mode 100644 index a74474d..0000000 --- a/decus/vax91a/bulletin/allmacs.mar +++ /dev/null @@ -1,299 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M<> ; Entry mask - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - - .MACRO M$$DEFERRED_CALL, IMAGE, NAME, NAME1 -; -; Defer image activation on this routine -; - .PSECT $LOCAL,PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG - IMAGE_'NAME: .ASCID /IMAGE/ - SYMBOL_'NAME: .ASCID /NAME1/ - ADDRESS_'NAME: .BLKL 1 - FIND_'NAME: .LONG 3 - .ADDRESS IMAGE_'NAME - .ADDRESS SYMBOL_'NAME - .ADDRESS ADDRESS_'NAME - .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG - .ENTRY 'NAME,^M - CALLG G^FIND_'NAME',G^LIB$FIND_IMAGE_SYMBOL - ADDL3 #2,G^ADDRESS_'NAME,R2 - JMP (R2) - .ENDM M$$DEFERRED_CALL - - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY socket_close socket_close - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY gethostbyname1 gethostbyname - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY socket socket - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY bcopy bcopy - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY htons htons - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY connect connect - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY socket_write socket_write - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY socket_read socket_read - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY gethostname gethostname - - .END diff --git a/decus/vax91a/bulletin/board_digest.com b/decus/vax91a/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vax91a/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vax91a/bulletin/board_special.com b/decus/vax91a/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vax91a/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vax91a/bulletin/bull_news.c b/decus/vax91a/bulletin/bull_news.c deleted file mode 100644 index c013d59..0000000 --- a/decus/vax91a/bulletin/bull_news.c +++ /dev/null @@ -1,372 +0,0 @@ -#include -#include -#include - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -news_get_chan() -{return(s);} - -news_set_chan(i) -int *i; -{s = *i;} - -news_disconnect() -{ -#if UCX - sys$cancel(s); - sys$qiow(0,s,IO$_DEACCESS,0,0,0,0,0,0,0,0,0); -#endif - sys$dassgn(s); -} - -#if MULTINET - -static struct hostent *hp; -static struct sockaddr_in sin; - -#endif - -int *node; - -news_assign() -{ - int n; -#if MULTINET - struct hostent *GETHOSTBYNAME1(); -#endif - node = getenv("BULL_NEWS_SERVER"); - if (!node) return(0); - if (!strchr(node,'.')) { - strcpy(&task[0],node); - n = strlen(node); - strcpy(&task[n],"::\"TASK=NNTP\""); - task_d.dsc$w_length = 13 + n; - if (!(sys$assign(&task_d,&s,0,0) & 1)) return(0); - mode = DECNET; - return(1); - } -#if MULTINET - /* - * Get the IP address of the NEWS host. - */ - - hp = GETHOSTBYNAME1(node); - if (hp == NULL) return(0); - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,hp->h_addrtype, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,hp->h_addrtype, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET - - /* - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()) and - * the remote NNTP port number (from getservbyname()). - */ - - sin.sin_family = hp->h_addrtype; - BCOPY(hp->h_addr, &sin.sin_addr, hp->h_length); - sin.sin_port = HTONS(119); - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET - - /* - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()) and - * the remote NNTP port number (from getservbyname()). - */ - - sin.sin_family = hp->h_addrtype; - BCOPY(hp->h_addr, &sin.sin_addr, hp->h_length); - sin.sin_port = HTONS(119); - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if MULTINET - return(GETHOSTNAME(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -} diff --git a/decus/vax91a/bulletin/bull_newsdummy.for b/decus/vax91a/bulletin/bull_newsdummy.for deleted file mode 100644 index d0cf993..0000000 --- a/decus/vax91a/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,58 +0,0 @@ - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - RETURN - END diff --git a/decus/vax91a/bulletin/bullcom.cld b/decus/vax91a/bulletin/bullcom.cld deleted file mode 100644 index 0a6818f..0000000 --- a/decus/vax91a/bulletin/bullcom.cld +++ /dev/null @@ -1,485 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 4/26/91 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER ID, NONNEGATABLE -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW REPLY AND SUBJECT - DISALLOW (REPLY OR SUBJECT OR SEARCH) AND MARKED - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER EDIT - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER EDIT - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER SUBJECT - DISALLOW SEARCH_STRING AND REPLY - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vax91a/bulletin/bullcoms1.hlp b/decus/vax91a/bulletin/bullcoms1.hlp deleted file mode 100644 index aab34db..0000000 --- a/decus/vax91a/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,829 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] - -All the qualifiers except for /EDIT and /NODES are restricted to users -with SETPRV privileges. -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be GENERAL. NOTE: -Specifying remote nodes is only possible if that remote node is running -a special BULLCP process. If it isn't, the only way to add messages to -that remote node is via the /NODE command. However, /FOLDER is a much -quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /HEADER - /[NO]HEADER - -If a message header exists, specifies that the header is to be displayed -along with the text of the message. For news folders, the default is -NOHEADER. For other folders, it is dependent on whether SET STRIP has -been specified or not. Once /HEADER or /NOHEADER has been specified, -that setting will be used for all further reads until it is changed, or -another folder is selected. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. - -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message.a -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages havee -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed.c -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers soe -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file canf -be specified which contains the text. If the editor is used for changinge -the text, the old message text will be extracted. This can be suppresseda -by the qualifier /NEW. - r - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expirationg -date and message headers can be changed if this qualifier is specified.. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the messageb -you are replacing. The old message text is read into the editor unlessE -a file-name or /NEW is specified. /EDIT is the default if you haveh -added /EDIT to your BULLETIN command line. -2 /EXPIRATION/ - /EXPIRATION[=time]f - u -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can bei -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. This only applies to the GENERAL folder. -2 /HEADER -Specifies that the message header is to be replaced. You will bei -prompted for the new message description.e -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totallyf -new text is to be read in. -2 /NUMBERg - /NUMBER=message_number[-message_number1] - r -Specifies the message or messages to be replaced. If this qualifier is u -omitted, the message that is presently being read will be replaced.e -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - r -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent.i -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computere -shutdown. This option is restricted to SYSTEM folders.u -2 /SUBJECT - /SUBJECT=descriptione - t -Specifies the subject of the message to be added.l -2 /SYSTEMe -Specifies that the message is to be made a SYSTEM message. This is aX -privileged command and is restricted to SYSTEM folders.h -2 /TEXTo -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder.e - r - Format:e - t - COPY folder-name [message_number][-message_number1]e - e -The folder-name is the name of the folder to which the message is to bef -copied to. Optionally, a range of messages which are to be copied can beg -specified following the folder name, i.e. COPY NEWFOLDER 2-5.d - , -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder.e -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message tob -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADERe - /[NO]HEADER - s -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.l -2 /ORIGINALf -Specifies that the owner of the copied message will be the original owneru -of the message. The default is that the copied message will be owned by -the person copying the message.A -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM.t - - Format:f - CREATE folder-name - a -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - r -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYSm -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read.a -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF forr -more information.) -2 /DESCRIPTION - /DESCRIPTION=descriptionT - d -Specifies the description of the folder, which is displayed using theT -SHOW FOLDER command. If omitted, you are prompted for a description.e - -If this folder is to receive messages from a network mailing listl -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTh -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - y - INFOVAX MAILING LIST - o -If a mailer protocol is needs to be added to the network address in -order for it to be sent by VMS MAIL, i.e. protocol%"address", the -appropriate protocol can be specified by either hardcoding it into the -file BULLNEWS.INC before compiling BULLETIN, or by defining the system -logical name BULL_NEWS_MAILER (it is the same protocol used by the NEWSl -feature in order to respond to NEWS messages). The default protocol ise -IN%. If desired, you can specify the protocol with the address, i.e. - - INFOVAX MAILING LIST I -2 /IDn -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presentlyo -assigned to it. Any process which has that identifier assigned to itL -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - t -Note: This feature will not work during remote access to the folder. -2 /NODEp - /NODE=node - -Specifies that the folder is a remote folder at the specified node.a -A remote folder is a folder in which the messages are actually storedA -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, thef -folder will then be modified to point to that folder. For example ifi -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be sharedo -between more than one node. This capability is only present if the BULLCPd -process is running on the remote node via the BULL/STARTUP command.a -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - i -NOTE: If a message is added to a remote node, the message is storedi -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information ise -only updated every 15 minutes (same algorithm for updating BBOARDi -messages), or if a user accesses that folder. Thus, if the folder ish -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the userh -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes.e -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder.i -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command.c -See also /ID. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have beent -granted access via the SET ACCESS command. Note: This option uses ACLsd -and users who are granted access must be entered into the Rights Data Base.f -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW ford -more information.) -2 /REMOTENAMEn - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name.l -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW fora -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only witho -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder isY -allowed to have SYSTEM and SHUTDOWN messages added to it. By default, -the GENERAL folder is a SYSTEM folder. This is a privileged command.a - i -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.e -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. Ifo -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is notd -always true, as BULLETIN will ignore the CTRL-Y if it has a data filed -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT - c -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - n - Format:o - e - CURRENTS -2 /EDIT -Specifies that the editor is to be used to read the message. This iss -useful for scanning a long message.s -1 DELETE -Deletes the specified message. If no message is specified, the currentE -message is deleted. Only the original owner or a privileged user cane -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want them -message deleted immediately, use the /IMMEDIATE qualifier. - t - Format:e - DELETE [message_number][-message_number1]p - g -The message's relative number is found by the DIRECTORY command. It ist -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot bet -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This willE -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. -2 /NODES - /NODES=(nodes[,...])v - d -Specifies to delete the message at the listed DECNET nodes. The BULLETINr -utility must be installed properly on the other nodes. You can specifys -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the. -other nodes. The /SUBJECT must be specified to identify the specifich -message that is to be deleted. - g -Additionally, you can specify logical names which translate to one ore -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - t -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message. -It can be a substring of the subject. This is in case you have forgottenf -the exact subject that was specified. Case is not critical either.o -You will be notified if the deletion was successful. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting messages -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORYr -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed.n - t - Format: - t - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message.I -2 /DESCRIBEn -Valid when used with /FOLDERS. Specifies to include description of folder.y -2 /EXPIRATIONt -Shows the message's expiration date rather than the creation date. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS.t -2 /MARKEDe -Lists messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will haveo -to be reselected using the SELECT command. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWSf -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /SEARCHn - /SEARCH=[string]n - o -Specifies that only messages which contain the specified string aree -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.C -2 /START - /START=message_number - n -Indicates the first message number you want to display. For example,e -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunctionn -with /MARKED. If no string is specified, the previously specified stringe -is used. -1 EXIT -Exits the BULLETIN program.u -1 EXTRACTo -Synonym for FILE command., -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified.S - t - Format: - FILE filename [message_number][-message_number1] - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5.y - p -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Copies all the messages in the current folder. -2 /FF -Specifies that a form feed is placed inbetween messages in the file. -2 /HEADERt - /[NO]HEADER - v -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - x -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file.e -1 Foldersi -All messages are divided into separate folders. The default folder is -GENERAL. New folders can be created by any user. As an example, thec -following creates a folder for GAMES related messages: h - f -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMESD - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, thato -user will be alerted of topics of new messages at login time, and will -then be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option,r -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command.d - i -A folder can be restricted to only certain users, if desired. This is t -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATEi -rather than /PRIVATE is specified, all users can read the messages in theo -folder, but only those give access can add messages. - i -A folder can be converted into a remote folder using CREATE/NODE or SETf -NODE. A remote folder is one which points to a folder on a remote DECNETd -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)p -must be running on the remote node for this option to be used. - s -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/s -SHUTDOWN/BROADCAST messages can be added. By default, the GENERAL foldera -is a SYSTEM folder (and cannot be changed). One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the GENERAL -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, and -giving access to that UIC group. Only users in that UIC group will seeu -the messages in that folder when they log in.s -1 HELP -To obtain help on any topic, type: - h - HELP topicm -1 INDEX, -Gives directory listing of all folders in alphabetical order. If the -INDEX command is re-entered while the listing is in progress, the listing -will skip to the next folder. This is useful for skipping a particularc -folder. It also can be used to continue the listing from where one left -off after one has read a message.e - s - Format: - INDEX -2 /MARKEDn -Shows only messages that have been marked (indicated by an asterisk).r -2 /NEW -Specifies to start the listing of each folder with the first unread message. -Otherwise, the listing will start with the first message in the folder.s -If the INDEX command is re-entered for continuing the listing, /NEW must -be respecified.a -2 /RESTART -If specified, causes the listing to be reinitialized and start from thed -first folder.g -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - t -Displays the last message in the current folder. - e - Format:r - LAST -2 /EDITN -Specifies that the editor is to be used to read the message. This iss -useful for scanning a long message. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - s - Format:e - e - MAIL recipient-name[s] - e -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying an, -address that has quotes, in order to pass the quotes you must specifye -triple quotes. I.e. a network address of the form xxx%"address" mustd -be specified as xxx%"""address""". -2 /HEADERh - /[NO]HEADER - a -Controls whether a header containing the owner, subject, and date of the e -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - t -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks (").s - h -If you omit this qualifier, the description of the message will be useda -as the subject.y -1 MARK -Sets the current or message-id message as marked. Marked messages arei -displayed with an asterisk in the left hand column of the directorye -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id messaget -as unmarked. - S - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers]h - e -NOTE: The list of marked messages are stored in a file username.BULLMARK -in the directory pointed to by the logical name BULL_MARK. If BULL_MARK -is not defined, an error message will be displayed when attempting toi -mark a message. BULL_MARK may be defined system wide, depending oni -whether the system manager has decided to do so. -1 MODIFY -Modifies the database information for the current folder. Only the ownero -of the folder or a user with privileges can use this command.e - l - Format:C - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted fora -the text of the description. - a -NOTE: If this folder is to receive messages from a network mailing list3 -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTe -commands, the address of the mailing list should be included in thej -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - r - INFOVAX MAILING LIST N -2 /IDm -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to itE -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - c -Note: This feature will not work during remote access to the folder. -2 /NAMET - /NAME=foldernamei - i -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - E -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID.a -1 MOVE -Moves a message to another folder and deletes it from the current -folder.T - d - Format:o - i - MOVE folder-name [message_number][-message_number1]t - e -The folder-name is the name of the folder to which the message is to bep -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However, -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - p -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPSE - /GROUPS=(newsgroup,[...]) - a -Valid only if a NEWS group is selected. Specifies to send the message toi -the specified NEWS group(s) in addition to the selected NEWS group.e -2 /HEADERh - /[NO]HEADER - a -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied.a -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the moved messages ared -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.r -2 /ORIGINALl -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned byd -the person moving the message. -1 NEWS -Displays the list of available news groups.a - m -Format:r - i - NEWS [string] - E -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed.n -2 /START - /START=string - i -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B.t -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over.i -2 /EDIT -Specifies that the editor is to be used to read the message. This is. -useful for scanning a long message.e diff --git a/decus/vax91a/bulletin/bullcoms2.hlp b/decus/vax91a/bulletin/bullcoms2.hlp deleted file mode 100644 index 53a2a0f..0000000 --- a/decus/vax91a/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,945 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with > at the -beginning of each line. This can be suppressed with /NOINDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. In -order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply surround -the exclusive text starting with the line "START " and ending -with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The PRINT command can take optional qualifiers. - - Format: - - PRINT [message_number][-message_number1] - -A range of messages to be printed can optionally be specified, i.e. -FILE 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply hitting -the key is equivalent to "READ". -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads of in the selected folder. The default is /HEADER for -non NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -2 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected using the SELECT command. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected and /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LISTr -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /NOINDENTc -See /EXTRACT for information on this qualifier. -2 /SUBJECT - /SUBJECT=text - C -Specifies the subject of the mail message. If the text consists of more. -than one word, enclose the text in quotation marks (").r - i -If you omit this qualifier, the description of the message will be usedt -as the subject preceeded by "RE: ".d -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text string. - e - Format: - T - SEARCH [search-string]r - , -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header.E -If a "search-string" is not specified, a search is made using thei -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, ae -search can be aborted by typing a CTRL-C.o -2 /EDITq -Specifies that the editor is to be used for reading the message. -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the laste -message. -2 /START - /START=message_number - l -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched.b -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created.s - n - Format: - - SELECT [node-name::][folder-name] - n -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - u -Omitting the folder name will select the default general messages. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.)b - r -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - C -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case.e -2 /MARKEDt -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected.e -1 SETt -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - ( - Format:o - v - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - E - Format:o - o - SET [NO]ACCESS id-name [folder-name] - j -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - e -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster.l - p -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" .o -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - u -Format:t - a - SET ACCESS /ALL [folder-name]A -3 /READc -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warningn -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read.e - o - Format: - - SET [NO]ALWAYS -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - o - Format: - - SET BBOARD [username]d - s -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages.A - f -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30"i -will cause the updates to be don every 30 minutes. - e -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The formg -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY. -The time will always be 00:00, even if the time is specified on the line.e -3 /EXPIRATIONi - /EXPIRATION=daysr - /NOEXPIRATION - u -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - r -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature.s -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be:n - g -FAKE MAILING LIST LISTSERV. - n -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - a -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - r -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - r - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECTd - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - R -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account. - r -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - o -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - o -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - i -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION.Y -2 BRIEFt -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa). - a - Format:e - d - SET [NO]BRIEFA -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newH -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERf - /FOLDER=foldername - s -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENTA - d -Specifies that BRIEF is a permanent flag and cannot be changed by thee -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier.B -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed everyz -time when logging in, until the new messages are read. Normally, thes -BRIEF setting causes notification only at the first time that new messages -are detected.t - . - Format:e - i - SET [NO]CONTINUOUS_BRIEF - e -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for theh -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges. - A -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - t - Format: - s - SET DEFAULT_EXPIRE daysP - E -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages./ - X - Format: - c - SET [NO]DIGEST - c -The command SHOW FOLDER/FULL will show if DIGEST has been set. - e -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory. - S - Format:s - e - SET [NO]DUMP - i -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - f - SET [NO]EXPIRE_LIMIT [days]m - i -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) v -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information.d - e - Format:t - t - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will haveh -to be reselected. -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the GENERAL folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format:_ - w - SET [NO]GENERIC username - e -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for ther -same user. -3 /DAYS - /DAYS=number_of_days - h -Specifies the number days that new GENERAL messages will be displayedw -for upon logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format:o - m - SET [NO]KEYPAD -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command.t - - Format:u - n - SET [NO]LOGIN username -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node.l - n - Format:i - SET NODE nodename [remotename] - SET NONODE - d -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder. -3 /FOLDERa - /FOLDER=foldernames - a -Specifies the folder for which the node information is to modified.e -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - _ - Format:n - m - SET [NO]NOTIFY - E -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are loggede -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared.e -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users forB -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specifiedD -folder. This is a privileged qualifier. It will only affect brand newr -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernameo - s -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY.l -3 /PERMANENT - /[NO]PERMANENTa - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier.d -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - s - Format: - o - SET [NO]PAGE -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format:p - i - SET PRIVILEGES parametersp - f -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers.f -3 /IDs - /[NO]ID - E -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.c -2 PROMPT_EXPIREi -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format:u - . - SET [NO]PROMPT_EXPIRE -2 READNEWb -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. - E - Format:X - E - SET [NO]READNEWs - i -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder).s -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersm -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERl - /FOLDER=foldernameE - M -Specifies the folder for which the option is to modified. If notr -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENTd - e -Specifies that READNEW is a permanent flag and cannot be changed by theo -individual. This is a privileged qualifier. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN.t - f -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - a - Format: - - SET [NO]SHOWNEWC -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersw -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newi -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERe - /FOLDER=foldernamey - o -Specifies the folder for which the option is to modified. If nots -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENTn - d -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged qualifier. -2 STRIPh -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped offh -before it is stored as a BULLETIN message. - l - Format: - i - SET [NO]STRIPt - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is aE -privileged command. - O - Format:s - e - SET [NO]SYSTEM - -By default, the GENERAL folder is a SYSTEM folder, and the setting for -that folder cannot be removed. - n -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.o -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGSh -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for thel -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected via -the SELECT command, information about that folder is shown.r - t - Format: - - SHOW FOLDER [folder-name]d -3 /FULLa -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder isp -private, and BBOARD information. This information is only those who -have access to that folder.s -2 KEYPAD -Displays the keypad command definitions. If the keypad has been enabled -by either the SET KEYPAD COMMAND, or /KEYPAD is specified on the command -line, the keypad keys will be defined as commands. SHOW KEYPAD is the -equivalent of HELP KEYPAD. - m -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT).a -2 NEWi -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unreadh -messages, you will not be notified about them the next time you enterc -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - d - Format:d - SHOW USER [username] - n -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - a -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command.o -3 /LOGIN - /[NO]LOGINP - I -Specifies that only those users which do not have NOLOGIN set are to ben -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDERi - /FOLDER=[foldername]d - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - R -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups.e -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSIONu -Shows the version of BULLETIN and the date that the executable was -linked. -1 SPAWNi -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - s - Format:i - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBEe -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - c - Format: - UNDELETE [message-number]e -1 UNSUBSCRIBES -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See thed -SUBSCRIBE command for further info. diff --git a/decus/vax91a/bulletin/bulldir.inc b/decus/vax91a/bulletin/bulldir.inc deleted file mode 100644 index 6025611..0000000 --- a/decus/vax91a/bulletin/bulldir.inc +++ /dev/null @@ -1,33 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(LINE_LENGTH) diff --git a/decus/vax91a/bulletin/bullet1.com b/decus/vax91a/bulletin/bullet1.com deleted file mode 100644 index 5a67a26..0000000 --- a/decus/vax91a/bulletin/bullet1.com +++ /dev/null @@ -1,1360 +0,0 @@ -$set nover -$copy/log sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utility PMDF. If you wish to -do so for another utility, read the text file WRITEMSG.TXT. I would be glad to -include any such programs with my distribution if you think such a program -would be of use to other users. - -Responding to mail which is either added via the BBOARD feature is done using -VMS MAIL. If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to SYS$SYSTEM and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically check for expire messages, cleanup - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require different - linked executables.) - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set ofh - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for howe - to do this. - n -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed.f - - If you use the NEWS feature, it is suggest that you run this procedures - on BULLNEWS.DAT after it is created. Compression that file greatly speedsd - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (orr - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT.i - o -10) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used.l - The object BULLETIN pointing to BULLETIN.COM must be added to the NCP - database, i.e. the command - MCR NCP SET OBJ BULLETIN FILE directory:BULLETIN.COM number 0 - must be executed at startup time on the remote node.L - NOTE: Privileged functions such as /SYSTEM will work on other nodess - if you have an account on the other node with appropriate privileges. -$eod l -$copy/log sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4 - d - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIMt - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIMEc - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*53 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM. - . - CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATEM - CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIMET - a - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - I - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - h - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER)A - , - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - r - CHARACTER MSG_KEY*8 - o - EQUIVALENCE (MSG_BTIM,MSG_KEY)o - r - PARAMETER LINE_LENGTH=255 - e - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(LINE_LENGTH) -$eod d -$copy/log sys$input BULLETIN.HLP -$deckf -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - o - Format: - - BULLETIN [foldername or bulletin interactive command]B - E -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Descriptionm - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited.m - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals).f - e -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - s -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - g -Messages can be either sent to a file, to a print queue, or mailed to -another user.e - o -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". - -NOTE: Depending on how the BULLETIN command is defined, triple quotes -rather than single quotes may be required. -2 /EDITi -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPADa - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD.t -2 /PAGEi - /[NO]PAGE - . -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory.o -2 /PGFLQUOTA - /PGFLQUOTA=pagesE - f -Used if you want to specify the page file quota for the BULLCP process.t -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETINa -is aware that it is running on another node. (On the local node wheret -BULLCP is running, this logical name is automatically defined.) -2 /STOP, -Stops the BULLCP process without restarting a new one. (See /STARTUPB -for information on the BULLCP process.) -2 /SYSTEMa - /SYSTEM=[days]y - s -Displays system messages that have been recently added. The default is& -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages thatm -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - i -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before( -the terminal type is known, and the default width is larger than what theX -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT, - /WSEXTENT=pages - T -Used if you want to specify the working set limit for the BULLCP process.T -$eod E -$copy/log sys$input BULLETIN.LNK -$deckE -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB-C - /EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHAREO -ID="V2.04" -$eod G -$copy/log sys$input BULLFILES.INCI -$deckI -CG -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -CY -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY,F -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SUREh -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVEt -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30.b -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR")e -Cf - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORYe - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -Ci -C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF ITn -C IS NOT, THEN THEY SHOULD ALSO BE CHANGED. -CL - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/i - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/n - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ - CHARACTER*80 BULLNEWS_FILE /'BULL_DIR:BULLNEWS.DAT'/l -$eod -$copy/log sys$input BULLFOLDER.INC -$deck -!v -! The following 2 parameters can be modified if desired before compilation. -!s - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days thato - ! BBOARDS can be set to.b - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING.r - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number.n - v - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE,t - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT,g - & F_NEWEST_NOSYS_BTIM,FILLER,y - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2)o - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SETo - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/s - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - u - EQUIVALENCE (FOLDER_BBOARD(3:),F_START) - EQUIVALENCE (FOLDER_BBOARD(7:),F_END) - o - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - n - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1,c - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT,d - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE,FOLDER1_NAMEn - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - m - EQUIVALENCE (FOLDER1_BBOARD(3:),F1_START) - EQUIVALENCE (FOLDER1_BBOARD(7:),F1_END) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - b - PARAMETER NEWS_FOLDER_FMT = '(A25,A4,A55,A12,3A4)' - PARAMETER NEWS_FOLDER_RECORD = 108 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER,n - & NEWS_FOLDER_DESCRIP,NEWS_FOLDER_BBOARD,g - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIMs - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*25 - CHARACTER NEWS_FOLDER_DESCRIP*55,NEWS_FOLDER_BBOARD*12 - - EQUIVALENCE (NEWS_FOLDER_BBOARD(3:),NEWS_F_START) - EQUIVALENCE (NEWS_FOLDER_BBOARD(7:),NEWS_F_END) - o - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COMA - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_FOLDER1_DESCRIP,NEWS_FOLDER1_BBOARD, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIMe - INTEGER NEWS_F1_NEWEST_BTIM(2)h - CHARACTER NEWS_FOLDER1*25 - CHARACTER NEWS_FOLDER1_DESCRIP*55,NEWS_FOLDER1_BBOARD*12e - h - EQUIVALENCE (NEWS_FOLDER1_BBOARD(3:),NEWS_F1_START) - EQUIVALENCE (NEWS_FOLDER1_BBOARD(7:),NEWS_F1_END) - o - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) -$eod t -$copy/log sys$input BULLNEWS.INC -$deckf - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILERr - o - CHARACTER*132 ORGANIZATIONn - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/d - - CHARACTER*10 MAILER - DATA MAILER /'IN%'/ -$eod r -$copy/log sys$input BULLUSER.INC -$deckq -!e -! The parameter FOLDER_MAX should be changed to increase the maximum numberN -! of folders available. Due to storage via longwords, the maximum numbere -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own.p -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - h - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16w - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - e - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF/ - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEFI - CHARACTER TEMP_USER*12e - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - f - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2)e - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folderp - ! Now NEW_FLAG(2) contains SET GENERIC dayss - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcaste - ! notification when new bulletin is added. - y - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - ( - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX)a - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DATi - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX)d - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1))f - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DATs - l - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod e -$copy/log sys$input BULL_NEWS.Cn -$deckW -#include -#include -#include - d -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h"t -#include "multinet_root:[multinet.include.netinet]in.h"h -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - , -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet);k - -#elsei - o -#if UCXL - p -#include - y -struct sockaddr {K - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8];U - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2];o -static struct sockaddr local_host, remote_host;_ -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev);R - E -static int addr_buff;O - Y -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#elseD - R -#define CMU 1T -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip);B - R -#endif - -#endif - T -static char task[20];W -$DESCRIPTOR(task_d,task);F - -static int s;B - D -static struct iosb { - short status; - short size; - int info; -} iosb;U - H -#define TCP 0H -#define DECNET 1 - -static int mode = TCP; - -news_get_chan()I -{return(s);} - -news_set_chan(i) -int *i;T -{s = *i;} - -news_disconnect()E -{R -#if UCXA - sys$cancel(s);L - sys$qiow(0,s,IO$_DEACCESS,0,0,0,0,0,0,0,0,0); -#endif - sys$dassgn(s);L -}I - S -#if MULTINET - W -static struct hostent *hp; -static struct sockaddr_in sin; - D -#endif - 0 -int *node; - -news_assign()E -{C - int n;B -#if MULTINET - struct hostent *GETHOSTBYNAME1(); -#endif - node = getenv("BULL_NEWS_SERVER");A - if (!node) return(0); - if (!strchr(node,'.')) {F - strcpy(&task[0],node); - n = strlen(node);T - strcpy(&task[n],"::\"TASK=NNTP\"");N - task_d.dsc$w_length = 13 + n;O - if (!(sys$assign(&task_d,&s,0,0) & 1)) return(0);_ - mode = DECNET; - return(1); - } -#if MULTINET - /*B - * Get the IP address of the NEWS host.H - */ - - hp = GETHOSTBYNAME1(node);T - if (hp == NULL) return(0);R - L - /*. - * Create an IP-family socket on which to make the connectionn - */ - T - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCXF - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0);U - { - short retlen; - struct dsc$descriptor host_namef - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor commandP - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_adC - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb;E - / - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0,M - &command,&host_name,&retlen,&host_ad,0,0) & 1)a - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0);2 - }2 - } -#else) - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1);O -}R - O -news_socket()B -{F - if (mode == DECNET) return (1); - F -#if MULTINET - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,hp->h_addrtype, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) {& - sys$dassgn(s); - return(0); - } -#endif -#if UCXR - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET;O - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host;R - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0,E - UCX$C_DSC_ALL,0,0);O - sys$dassgn(s); - return(0); - } -#endif - & - return(1);C -}, - D -news_socket_bullcp(efn,biosb,astadr,astprm)G -int *biosb,*astadr,*astprm,*efn; -{F - if (mode == DECNET) return (1); - L -#if MULTINET - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,hp->h_addrtype,C - SOCK_STREAM,0,0,0,0) & 1) ) return(0);1 -#elseE -#if UCX0 - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET;E - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host;F - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0);P -#elseR - return(-1); -#endif -#endif - b - return(1); -} - -news_create()O -{R - if (mode == DECNET) return (1); - -#if MULTINET - _ - /*I - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()) andA - * the remote NNTP port number (from getservbyname()). - */ - N - sin.sin_family = hp->h_addrtype;T - BCOPY(hp->h_addr, &sin.sin_addr, hp->h_length); - sin.sin_port = HTONS(119);L - _ - /*D - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok).E - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) {D - sys$dassgn(s); - return(0); - } -#elseB -#if UCX - remote_host.inet_family = INET$C_AF_INET;: - remote_host.inet_port = htons(119);E - remote_host.inet_adrs = addr_buff;( - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1)R - || !(iosb.status & 1)) {I - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0);p - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1)e - || !(iosb.status & 1)) {e - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1);u -}p - o -news_create_bullcp(efn,biosb,astadr,astprm)o -int *biosb,*astadr,*astprm,*efn; -{M - if (mode == DECNET) return (1); - -#if MULTINET - t - /*t - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()) ando - * the remote NNTP port number (from getservbyname()). - */ - X - sin.sin_family = hp->h_addrtype;O - BCOPY(hp->h_addr, &sin.sin_addr, hp->h_length); - sin.sin_port = HTONS(119);M - R - /*_ - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok).R - */ - M - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0);N -#elseM -#if UCXT - remote_host.inet_family = INET$C_AF_INET;A - remote_host.inet_port = htons(119);T - remote_host.inet_adrs = addr_buff;T - rhst_adrs.lgth = sizeof remote_host;) - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#elsey - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node,s - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - c - return(1);B -}F - t -news_connect() -{_ - if (!news_assign()) return(0); - if (!news_socket()) return(0);n - return(news_create());e -} - -news_write_packet(buf) - G -struct dsc$descriptor_s *buf;U -{L - static int n,len; - M - len = buf->dsc$w_length;E -#if CMUE - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#elseS - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer,e - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - L - return(1);( -}O - R -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len)N -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMUt - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0);N -#elseW - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf,p - *len,0,0,0,0) & 1)) return(0); -#endif - t - return(1);u -}< - c -news_read_packet(buf). -struct dsc$descriptor_s *buf;u -{" - static int n,len; - . - len = buf->dsc$w_length;u - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size;n - d - return(n);i -}u - " -news_gethostname(buf). - l -struct dsc$descriptor_s *buf;t -{o - if (mode == DECNET) return (-1);" -#if MULTINET - return(GETHOSTNAME(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -}c -$eod e -$copy/log sys$input HANDOUT.TXTh -$deckt - Introduction to BULLETIN on the Vax - 2/88 AWc - d -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BEl -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - d -BULLETIN was written for the Public Domain by Mark London at MIT.v - u - The BULLETIN utility permits a user to create messages forg -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messagest -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of textU -written by a user or staff person and added to a particularr -folder. All users are not permitted to submit messages to all -folders. - U - A message consists of an expiration date, a subject linee -and the text of the message. BULLETIN will prompt the user ford -these things when a message is being added. - t - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message.( -This is a special message type. It will be displayed to eache -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - e -FoldersL - _ - Different folders have been created to contain messages onE -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to( -it. Currently, there are several folders defined: - -GENERAL -- system messages - & -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the publics - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - ) -In addition on Alpha there are folders that receive electronic -magazines, such as:D -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers.0 -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 ands -Prolog journalsN -watch for new ones being added.p - -Using BULLETIN - n - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompti -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To0 -leave the BULLETIN program, type 'EXIT'. - $ -To see what is there - ; - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which foldersq -exist, the directory/folders command is used. for example: -typing:_ - E - BULLETIN> directory/folders - E -will make a display like:I - $ - Folder Owner - *GENERAL SYSTEMT - *PUBLIC_ANNOUNCEMENTS BBEYER. - NETMONTH BITNETl - *VAX_SIG BBEYER& - a -An asterisk (*) next to the folder name indicates you have unreadp -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all availabler -folders, along with a brief description of each. - E - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the followings -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - a -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS> - d -and BULLETIN would respond:& - Folder has been set to PUBLIC_ANNOUNCEMENTS - 1 - Now the user may get a list of the messages in this folderl -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORYi -would have bulletin respond: - n - # Description From DateN - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - e - The command 'DIR/NEW' will list just unread messages. - u - ( -Reading messages - i - In order to read messages in a folder, the user may typeq -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquiredI -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, ita -will type the first new message in the folder. - } - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - T -Message number: 1 PUBLIC_ANNOUNCEMENTSc -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - m -...Body of message.....m - t - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - / -BULLETIN> READ 3 - c - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being) -read./ - M -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - N -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - e -Saving the interesting stuff., - O - If the user sees something which he/she wants a copy of,e -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be( -prompted for it. For example: - e -BULLETIN> Read 2t - t -********** Message on Screen ********n - , -A person could then type -BULLETIN> extractE -file: FV.TXTo -BULLETIN>R - V -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists,, -BULLETIN will append the message to the file. The user cano -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - s -This command may be useful if you wish to transfer the message to, -your PC, perhaps using a BITNET journal message as a reference in_ -a paper. Once the file is saved, you can transfer it to a PC bye -following the instructions in the handout 'Transferring filesD -from the PC to the VAX of from the VAX to a PC". - -Adding messageso - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided thatb -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message usingt -the VAX editor or uploading a message from your PC (see. -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subjectd -line. It will then add the text of the file as the body of theB -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - n - ADD filename - u -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may alsoo -use the EDT text editor by issuing the command with the -'/EDIT'option. - g -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - u -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULDT -EXPIRE: ENTER ABsolute TIME: i - d -The above session adds the text in the file 'mess.txt' as thel -next message in the PUBLIC_ANNOUNCEMENTS Folder. The messaged -will be deleted automatically on the 20th of July as requested -by the user adding the message.s - l -Asking BULLETIN to notify you of new messages upon logging in. - e - If the user wishes to get notification on login when news -messages are in a folder, he should use the 'READNEW' option.d -This command does not force the reader to reading new messages,i -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set tob -that folder. - i -Example: - r -BULLETIN> Select PUBLIC_ANNOUNCEMENTSe -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - d -Alternately, you may type SET SHOWNEW. This will just display as -message notifying you that there are new messages. - i -Mailing a BULLETIN message - o - A user may directly mail another user a message found in thei -BULLETIN. While reading the message that he/she desires to send,e -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - s -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod r -$copy/log sys$input INSTRUCT.TXT -$decks -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayeda -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can bev -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). o -$eod e -$copy/log sys$input NEWS.TXT -$deck -BULLETIN now has the capability to read and post messages to USENET NEWS in ae -client mode. I realize that there are many NEWS readers, some with much mores -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Oure -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it couldU -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added ther -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway betweenR -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when aN -user accesses the NEWS groups. Several other NEWS readers do this when you runo -them, which is why they take a long time to start up. It is also possible toa -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - i -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages1 -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - s -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWSe -node. If it is decnet, simply specify the decnet node name, i.e.a - a - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUSL - N -BULLETIN decides to use DECNET rather than TCP access based on the node name.n -If it does not have any periods in it, then it assumes it is a DECNET node.c - a -In our cluster, we usually have one node which is an internet node, and theg -rest non-internet nodes. If you have a similar situation, you'll have toe -create a startup procedure that defines BULL_NEWS_SERVER to be the internetR -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.)o - r -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - a - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "FALSE"e - ) -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME,o -INTERNET_HOST_NAME, and MX_NODE_NAME. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - h -The name of the organization is included in the header of the NEWS message.. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by definingL -the system logical name BULL_NEWS_ORGANIZATION.f - s -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - e -After installing the new BULLETIN, execute the command NEWS, which asks for an -list of all the news groups. Because this is the first time it is executed, itn -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want tom -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. (NOTE: BULLCP will create a subprocess BULLCP NEWS which does thef -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). After BULLNEWS.DAT is created, it is -suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the file to be -compressed and will allow updates to run much faster (factor of 5 or more). - a -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over aO -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number1 -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you tor -read NEWS, and do not know of one (i.e. a USENET node), I know of no officialx -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find at -USENET node near you to contact. s -$eod s -$copy/log sys$input NONSYSTEM.TXTm -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but onlym -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in thisE -manner, the bulletins can optionally be written to a file. If you have thet -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into.m - t -A user can disable this prompting featuring by using BULLETIN as follows: - e -$ BULLETIN -BULLETIN> SET NOREADNEWN -BULLETIN> EXIT - A -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages.e -$eod T -$copy/log sys$input WRITEMSG.TXT -$deckt -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoidT -the extra overhead of having the message sent to an account as MAIL, and thenm -have BULLCP read the mail. It is better if the network mail could be writteny -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - L -Call INIT_MESSAGE_ADD to initiate a message addition.i -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition.n - t -Calling formats: - i - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -Ca -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS:s -C IER - Error status. True if properly connected to folder. -C False if folder not found.l -Ci - - CALL WRITE_MESSAGE_LINE(BUFFER) -Cu -C INPUTS: -C BUFFER - Character string containing line to be put into message.t -Ce - - CALL FINISH_MESSAGE_ADD -Cn -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/vax91a/bulletin/bullet2.com b/decus/vax91a/bulletin/bullet2.com deleted file mode 100644 index 0c870ee..0000000 --- a/decus/vax91a/bulletin/bullet2.com +++ /dev/null @@ -1,1495 +0,0 @@ -$set nover -$copy/log sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy/log sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy/log sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 4/26/91 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUEo - QUALIFIER SYSTEM,NONNEGATABLE! - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDITt - DISALLOW SYSTEM AND GENERALi - DISALLOW PERMANENT AND SHUTDOWNi - DISALLOW PERMANENT AND EXPIRATION. - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADERC - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder"" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALLN - QUALIFIER MERGET - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE" - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER ID, NONNEGATABLE -!F -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -!" - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED)F - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PRIVATE, NONNEGATABLEj - QUALIFIER READNEW, NONNEGATABLEE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED)O - QUALIFIER SEMIPRIVATE, NONNEGATABLE. - QUALIFIER SHOWNEW, NONNEGATABLET - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DEFINE VERB CURRENT - QUALIFIER EDIT - DEFINE VERB DELETEF - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALLO - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)U - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER)' - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDERy - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLEL - QUALIFIER EXPIRATION - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLEi - QUALIFIER NEW/ - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLEa - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)! - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLEy - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW REPLY AND SUBJECT - DISALLOW (REPLY OR SUBJECT OR SEARCH) AND MARKED - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWSn - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER SUBSCRIBEa - QUALIFIER FOLDER - DEFINE SYNTAX DIRECTORY_FOLDERm - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULTa - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command.f - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command.i - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED),d - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALLd - QUALIFIER FF - QUALIFIER HEADER, DEFAULTi - QUALIFIER NEW, NONNEGATABLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILEt - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALLA - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE( - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDERM - QUALIFIER EXPIRATION - QUALIFIER MARKED - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE_ - QUALIFIER NEW - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER RESTARTN - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBEf - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLEM - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)P - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE VERB LASTI - QUALIFIER EDIT, NEGATABLE( - DEFINE VERB MAIL( - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients"T - VALUE(REQUIRED,IMPCAT,LIST)G - QUALIFIER HEADER, DEFAULTT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB MODIFY1 - QUALIFIER DESCRIPTIONR - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVEX - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder"E - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALLH - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGEB - QUALIFIER NODESS - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODESB - DEFINE VERB NEWSE - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLES - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBES - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - DEFINE VERB NEXTB - QUALIFIER EDIT, NEGATABLEP - DEFINE VERB POSTb - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)T - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACTt - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULTD - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACTD - QUALIFIER EDIT - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER HEADER, DEFAULTU - QUALIFIER NOTIFY, DEFAULTF - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUITc - DEFINE VERB READU - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER NEWP - QUALIFIER PAGE, DEFAULTU - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)E - DISALLOW NEW AND SINCE - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)T - QUALIFIER ALL, NONNEGATABLEU - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLEA - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELLR - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLER - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE, - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)N - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST,DEFAULT - QUALIFIER LOCALU - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACTA - QUALIFIER PERMANENT, NONNEGATABLEY - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWNT - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVEF - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)E - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXTRACTA - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACTU - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRINGA - QUALIFIER EDIT - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED)B - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSEE - QUALIFIER SUBJECTE - DISALLOW SEARCH_STRING AND REPLY - DEFINE VERB SELECTA - PARAMETER P1, LABEL=SELECT_FOLDERA - QUALIFIER MARKED, NONNEGATABLE - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODEF - KEYWORD NONODE, SYNTAX = SET_NONODEL - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGINN - KEYWORD NOLOGIN, SYNTAX=SET_LOGINN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARDE - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGSF - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGSl - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGSU - KEYWORD READNEW, SYNTAX=SET_FLAGSL - KEYWORD ACCESS, SYNTAX=SET_ACCESSR - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDERR - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGESA - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE= - KEYWORD NOPROMPT_EXPIRE) - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRED - KEYWORD STRIPI - KEYWORD NOSTRIPA - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED)L - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED)( - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"A - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"L - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"I - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED)E - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLEI - QUALIFIER ALL, NONNEGATABLEA - QUALIFIER PERMANENTO - QUALIFIER NOPERMANENTI - QUALIFIER FOLDER, VALUE(REQUIRED)N - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLEF - QUALIFIER PERMANENTE - QUALIFIER NOPERMANENTS - QUALIFIER ALL, NONNEGATABLEF - QUALIFIER FOLDER, VALUE(REQUIRED)E - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAMEN - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLEm - QUALIFIER VMSMAIL, NONNEGATABLEA - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDERN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"U - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - DEFINE SYNTAX SET_NOACCESSE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDERE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLYE - DEFINE SYNTAX SET_ACCESS) - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"T - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDERF - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGESB - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"T - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges"( - VALUE (REQUIRED,LIST)E - DEFINE SYNTAX SET_DEFAULT_EXPIREO - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOWE - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -!F -! The following are defined to allow qualifiers to be specifiedM -! directly after the SHOW command, i.e. SHOW/FULL FOLDER.L -! Otherwise, the CLI routines will reject the command, because itF -! first attempts to process the qualifier before process the parameter,V -! so it has no information the qualifiers are valid. -!L - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLEE - QUALIFIER ALL, SYNTAX=SHOW_USERU - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USERF - QUALIFIER LOGIN, SYNTAX=SHOW_USERL - QUALIFIER NOLOGIN, SYNTAX=SHOW_USERU - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINTA - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USERA - DEFINE TYPE SHOW_OPTIONSE - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSIONE - DEFINE SYNTAX SHOW_FLAGSE - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)( - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)E - QUALIFIER PRINT,DEFAULTF - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)U - PARAMETER P2, LABEL=SHOW_FOLDERU - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)L - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALLT - QUALIFIER FOLDER, VALUEL - QUALIFIER LOGING - QUALIFIER NOLOGINE - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAMEF - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULLF - QUALIFIER FULL, DEFAULTU - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)A - PARAMETER P2, LABEL=SHOW_FOLDER( - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWNL - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARKE - PARAMETER P1, LABEL=NUMBER, VALUE(LIST,TYPE=$NUMBER) - DEFINE VERB UNDELETEE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSUBSCRIBE -$eod O -$copy/log sys$input BULLETIN.CLD -$deckU -!E -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN.E -! Either way will work, and it is up to the user's to decide whichA -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -!D - N -Define Verb BULLETIN - Image BULL_DIR:BULLETINE - Parameter P1, Label = SELECT_FOLDER - Qualifier ALLO - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required)I - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LOGINR - Qualifier MARKED - Qualifier PAGE, Default, - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required)I - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEWT - Qualifier REVERSE - !A - ! The following line causes a line to be outputted separating system notices.= - ! The line consists of a line of all "-"s, i.e.: - !--------------------------------------------------------------------------Y - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!)Y - !T - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUPN - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier WIDTH, Value (Type = $NUMBER, Required)E - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP -$eod B -$copy/log sys$input BULLETIN.COM -$deckE -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN -$eod W -$copy/log sys$input BULLMAIN.CLD -$deckO - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN= - PARAMETER P1, LABEL=SELECT_FOLDERA - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULTS - QUALIFIER LOGINR - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSEP -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!--------------------------------------------------------------------------E -! If you want a different character to be used, simply put in the desired oneE -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -!E - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULTP - QUALIFIER STARTUPA - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED)R - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP -$eod _ -$copy/log sys$input BULLSTART.COMQ -$deckT -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT1 -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod _ -$copy/log sys$input BULL_NEWSDUMMY.FOR -$deck( - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L), - A - RETURND - END - D - N - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L)A - 1 - RETURN" - END - - L - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N)R - E - RETURNE - END - - F - SUBROUTINE NEWS_DISCONNECTE - - RETURN= - END - 1 - R - T - INTEGER FUNCTION NEWS_CONNECT - E - NEWS_CONNECT = .FALSE.E - L - RETURNA - END - - L - E - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - I - RETURNF - END - R - A - ( - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - A - CHARACTER*(*) BUF - A - RETURNT - END - - V - E - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - A - CHARACTER*(*) BUF - U - RETURNE - END -$eod U -$copy/log sys$input CREATE.COM -$deckN -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETINX -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN0 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN1 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN2 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN3 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN4 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN5 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN6 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN7 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN8 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN9 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN103 -$ MAC ALLMACSF -$ SET COMMAND/OBJ BULLCOMN -$ SET COMMAND/OBJ BULLMAIN -$ ON ERROR THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCXD -$ CC BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINKE -$UCX:1 -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC BULL_NEWS/DEFINE=(UCX=1)S -$ GOTO LINKS -$CMU:A -$ CC BULL_NEWS -$ GOTO LINKE -$DUMMY:L -$ FOR BULL_NEWSDUMMY -$LINK: -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN-T - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULLV -$ LIBRARY BULL *.OBJ;_ -$ DELETE *.OBJ;* -$ @BULLETIN.LNKV -$eod -$copy/log sys$input DCLREMOTE.COMI -$deckT -$! DCL procedure to execute DCL commands passed over Decnet on a remote system." -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE andH -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command:i -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file.f -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE canr -$! be defined to point at it. Y -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang.L -$! -$ SET NOON -$ N = 0D -$AGAIN: -$ N = N + 1S -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NETF -$NEXT_CMD: -$ READ /ERR=DONE NET COMMANDG -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NETR -$eod W -$copy/log sys$input INSTALL.COM_ -$deck -$ COPY BULLETIN.EXE BULL_DIR:M -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DELT -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXITQ -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and, -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN -$eod L -$copy/log sys$input INSTALL_REMOTE.COM -$deckE -$! -$! INSTALL_REMOTE.COMN -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes.U -$! -$! INPUTS: -$! The following parameters can be added to the command line. TheyO -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes.T -$! TEST - Specifies that all the nodes are to be checked to see if theyN -$! are up before beginning the intallation.u -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes.s -$! See comments at the beginning of that file for instructions.o -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES.a -$! Place the nodes where the executable is to be copied to in COPY_NODES.- -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +-g -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON"i -$ BULLCP_NODES = "NERUS,LAURIE,ARVON" -$! -$ NODES = NODES + ","a -$ COPY_NODES = COPY_NODES + ","u -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0E -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0E -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes.M -$! -$ IF .NOT. COPYB THEN GOTO END_COPYU -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES)i -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR:- -$ GOTO COPY- -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51R -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE:U -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALLR -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. -E - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCPD -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOPI -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETEE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL:T -$ IF F$LEN(NODES1) .EQ. 0 THEN EXITR -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1)T -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR-C -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM)C -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACEO -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLEO -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. -K - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCPE -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN"O -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP:F -$ @REMOTE 'NODE' END CONTINUED -$ GOTO INSTALL -$eod O -$copy/log sys$input INSTRUCT.COM -$deckD -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT1 -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXTA -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod A -$copy/log sys$input LOGIN.COM -$deck_ -$! -$! The following line defines the BULLETIN command.N -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named afterO -$! the executable image. Thus, as it is presently set up, the promptI -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break.R -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier.m -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran> -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots ofM -$! messages upon logging in for the first time.m -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command.n -$! -$eod b -$copy/log sys$input MAKEFILE.e -$decks -# Makefile for BULLETINh - i -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.OlbS - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.04" $M - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.ObjL - Library /Create Bull.Olb *.ObjO - Purge /Log *.Obj,*.ExeR - M -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.ForL - m -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \e - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - ! -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \! - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - T -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \L - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - R -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \E - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - ! -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \! - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - l -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \e - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - h -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \e - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - d -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \t - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - i -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \D - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - o -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \i - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \u - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For! - o -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.clde - Set Command /Obj Bullcom.CldD - B -Bullmain.Obj : Bullmain.cldu - Set Command /Obj Bullmain.Cld - e -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlbs -*.hlb :i - lib/help/cre $*S -$eod P -$copy/log sys$input OPTIMIZE_RMS.COM -$deckc -$ SET NOON -$ EXIT_STATUS = 1a -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1+ -$ SPEC = F$SEARCH(FILENAME)A -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME")U -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN-a - GOTO INTERACTIVE_CHECK_ADDS, -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILEr -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVEO -$! -$INTERACTIVE_CHECK_CONVERT:R -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)"! -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OKS -$! -$BATCH:N -$GOT_NAME: -$ FILENAME = P11 -$ SPEC = F$SEARCH(FILENAME)N -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292" -$ GOTO DONE -$! -$FILE_EXISTS:T -$ NAME = F$PARSE(FILENAME,,,"NAME")e -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN-E - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024E -$ GOTO DONE0 -$! -$TYPE_OK:O -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060o -$ GOTO DONEe -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK")e -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = P4c -$ FDL_NAME = F$PARSE(".FDL;0",SPEC)o -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM"o -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'"! -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZEROG -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO:' -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC"D -$ WRITE OUT "NO"E -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC"O -$ WRITE OUT "NO"D -$ WRITE OUT "KC"N -$ WRITE OUT "NO"B -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +-_ - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFFA -$ THEN -$ WRITE OUT "IC"Q -$ WRITE OUT "NO"O -$ ENDIFT -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC"O -$ WRITE OUT "NO" -$ ENDIFN -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOPU -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUTR -$! -$ @'TEMP_FILEU -$ DELETE 'TEMP_FILE;*/ -$ WRITE SYS$OUTPUT ""= -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT ""O -$ GOTO DONET -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUSQ -$eod F -$copy/log sys$input REMOTE.COM -$deckP -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAKS -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directoryM -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object.S -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control.i -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default! -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$e -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD"i -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINKa -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMDm -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK:s -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$u -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMANDh -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINEl -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD'u -$ WRITE SYS$OUTPUT LINEf -$ GOTO LOOPL -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR:i -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP -$eod . -$copy/log sys$input SETUSER.MARi -$deckB - .Title SETUSERS -;e -; Program Setuser -; -; This program will change the username and UIC of the running process -;b -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -;3 - .LIBRARY /SYS$LIBRARY:LIB.MLB/B - $PCBDEF ;define PCB offsetsi - $JIBDEF ;define JIB offsetsj - $UAFDEF ;define user authorization file offsetsb -INFAB: $FAB FAC=GET - ;only gets on input fileO - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffixl - SHR= ;allow full sharingo -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this fileb - ROP=NLK - ;don't lock read recordsr - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of bufferr -BUFFER: .BLKB 2048 ;buffer for datau -COMMLD: .ASCID / / ;space for typed in usernamee -PROMPTD:.ASCID /Username: / ;prompt stringe -COMMLDS:.WORD 0 ;space for number of bytes typed inu -FAODESC:.LONG 80 - .LONG FAOBUFi -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1E - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/t -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - u -JPIUSER: .BLKB 12e -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME)f -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LISTu -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT. - - .ENTRY START,^M<> ;start of programt - PUSHAW COMMLDS ;address of word to get read byte countn - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear errorl - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a recordl - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok?t - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2)l - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - y - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string" - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group numberd - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes0 - P5=#OLDUSER,- ;address of old usernameT - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytesu - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command1 - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get commandF - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any, - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11i - MOVL PCB$L_PID(R11),R9 ;save PID0 - MOVL PCB$L_UIC(R11),OLDUIC ;save old UICP - MOVL R8,PCB$L_UIC(R11) ;change our UICE - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET T -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIBR - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1I -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit statusF - RET ;end of exec mode code - .END START ;end of programL -$eod F diff --git a/decus/vax91a/bulletin/bulletin.cld b/decus/vax91a/bulletin/bulletin.cld deleted file mode 100644 index c1ce566..0000000 --- a/decus/vax91a/bulletin/bulletin.cld +++ /dev/null @@ -1,40 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vax91a/bulletin/bulletin.com b/decus/vax91a/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vax91a/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vax91a/bulletin/bulletin.for b/decus/vax91a/bulletin/bulletin.for deleted file mode 100644 index 3a96bb7..0000000 --- a/decus/vax91a/bulletin/bulletin.for +++ /dev/null @@ -1,1692 +0,0 @@ -C -C BULLETIN.FOR, Version 4/27/91 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*39 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*42 PROMPT - - CHARACTER DCL_CMD*132 - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP')) THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL SHOW_SYSTEM - CALL EXIT - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have beeni -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - C - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATIONe - - CALL OPEN_OLD_TAGA - 1 - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IFe - i -Cr -C The MAIN loop for processing bulletin commands. -Cn - - DIR_COUNT = 0 ! # directory entry to continue bulletin read fromI - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder fromL - INDEX_COUNT = 0 - A - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN/ - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND.O - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THENO - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':'A - HLEN = HLEN + 1G - END IF_ - Y - LPROMPT = TRIM(COMMAND_PROMPT)C - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' 'R - LPROMPT = LPROMPT + 2 - N - DO WHILE (1)B - T - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSEM - INCMD = DCL_CMDC - DCL_CMD = ' 'C - END IFI - IER = TRIM(INCMD) - END IF - E - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN/ - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ')M - INCMD = INCMD(2:IER)I - IER = IER - 1 - END DOT - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THENI - INCMD = 'READ '//INCMDR - END IFE - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - M - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN enteredL - LEN_P = 0 ! Indicate no parameter in commandT - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0" - FOLDER_COUNT = 0 - INDEX_COUNT = 0A - END IFL - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has errorS - GO TO 100 ! ask for new commandB - END IF - N - IER = MIN(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/'))S - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers( - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - A - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1i - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1N -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' 'g - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0t - INDEX_COUNT = 0 - END IF - m - IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL't - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN$ - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (REMOTE_SET.GE.3) THENn - INCMD = 'POST' - CALL RESPOND(MAIL_STATUS)R - ELSE - CALL ADDE - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH! - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THENE - WRITE(6,1060) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previousL - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE?C - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE?I - CALL CREATE_FOLDER ! Go create the folder) - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE?P - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified?M - & CLI$PRESENT('NEWS')) THEN ! or /NEWS?' - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all foldersP - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder_ - IF (IER) THEN ! If successfulE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages' - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE ! Copy bulletin to file - ELSE IF (INCMD(:1).EQ.'E'.OR.S - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST?& - READ_COUNT = -1S - BULL_READ = 99999E - CALL READ_MSG(READ_COUNT,BULL_READ)) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK?I - CALL TAG(.TRUE.) - ELSE IF (INCMD(:4).EQ.'MAIL') THEN ! MAIL? - CALL MAIL(MAIL_STATUS) - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE?E - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new foldersB - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT?, - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin_ - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - CALL RESPOND(MAIL_STATUS)S - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT ! Printout bulletinE - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ)a - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY?_ - IF (REMOTE_SET.GE.3) THENF - CALL RESPOND(MAIL_STATUS)G - ELSE - CALL REPLY( - END IF - ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND?R - CALL RESPOND(MAIL_STATUS). - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT)T - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER)T - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIVt - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD?b - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPADi - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')')n - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM?A - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.)i - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD?D - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP?o - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP')E - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST')M - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST?= - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS')N - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS?M - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))T - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)= - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.)c - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))o - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1)I - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))1 - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1), - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW?i - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0)( - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))n - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW?O - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))l - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0)G - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))E - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')): - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEFE - CALL SET_BRIEF_CONTINUOUS(.TRUE.)d - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC?T - CALL SET_GENERIC(.FALSE.)f - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE')& - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIREI - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW?O - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGSN - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDERA - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATIONO - FOLDER1 = SAVE_FOLDER: - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER)D - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES?O - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USERA - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION. - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESSI - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBEL - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE?E - CALL UNDELETEH - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.)E - ELSE IF (INCMD(:3).EQ.'UNS') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBED - END IF - N -100 CONTINUEF - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXITA - R - END DOD - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more preceding messages.') - - END - S - D - I - SUBROUTINE COMMAND_INPUT(IER) - L - IMPLICIT INTEGER (A - Z) - E - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - R - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*42 PROMPT - A - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - D - RETURNS - ) - END - S - C - - - A - SUBROUTINE ADD. -CE -C SUBROUTINE ADD -CC -C FUNCTION: Adds bulletin to bulletin file. -CT - IMPLICIT INTEGER (A - Z)R - T - COMMON /POINT/ BULL_POINT - : - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - L - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10)A - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - E - COMMON /EDIT/ EDIT_DEFAULTE - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - P - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - A - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'e - ' - INCLUDE 'BULLFOLDER.INC'_ - B - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER*(LINE_LENGTH) INDESCRIP - o - CHARACTER INLINE*80,OLD_FOLDER*25,LOCAL_NODE*8L - A - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - ? - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - A - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THENT - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IFO - ) - CALL DISABLE_CTRL ! Disable CTRL-Y & -CF - E - ALLOW = SETPRV_PRIV() - A - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - . - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THEN. - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'F - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH,R - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED')E - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)E - GO TO 910 - END IF - ? - CALL OPEN_BULLFIL_SHARED - , - ILEN = LINE_LENGTH + 1 - _ - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENE - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENL - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - _ - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN)S - END IFT - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - L -90 CALL CLOSE_BULLFIL - END IF) - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',E - & READONLY,SHARED,ERR=920,FORM='FORMATTED'), - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',B - & READONLY,SHARED,ERR=920,FORM='FORMATTED')A - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUTF - IF (IER.EQ.0) THENB - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1I - WRITE (3,'(A)') INPUT(:ILEN) - END IF. - END DON - CLOSE (UNIT=4)( - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER)T - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesL - END IFD - D - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER)1 - IF (.NOT.IER) GO TO 910? - SELECT_FOLDERS = .TRUE.) - ELSE$ - NODE_NUM = 1 - NODES(1) = OLD_FOLDERP - END IF) - . - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910i - END IFL - R - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present?( - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IFN - P - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort' - END IF - SYSTEM = 1 ! Set system bit - ELSET - SYSTEM = 0 ! Clear system bit - END IFR - N - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abortT - ELSE IF (CLI$PRESENT('CLUSTER')) THENL - SYSTEM = SYSTEM.OR.8 - END IF - END IFA - T - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?O - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083)F - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00'D - END IF - END IFE - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present?E - IF (.NOT.ALLOW) THEN ! If no privilegesT - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abortC - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE)A - IF (IER.NE.%LOC(CLI$_ABSENT)) THENE - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no codeU - GO TO 910 ! present to send the name. - END IFI - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF( - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit. - INEXDATE = '5-NOV-2000' - WRITE (INEXTIME,'(I4)') NODE_NUMBER - WRITE (INEXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO3 - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IFP - P - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THENN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE.D - END IFS - ' - IF ((SYSTEM.AND.7).LE.1) THEN ! Not permanent or shutdown_ - CALL GET_EXPIRED(INPUT,IER)P - IF (.NOT.IER) GO TO 910S - INEXDATE = INPUT(:11)G - INEXTIME = INPUT(13:)A - END IF. - ' - IF (INCMD(:3).EQ.'REP') THEN ! REPLY?H - INDESCRIP = DESCRIP ! Use description with RE:,H - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specifiedH - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSEE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IFR - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: "O - -CL -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.B -C_ - A - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specifiedE - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')S - LEN_P = 1 - ELSE - CLOSE (UNIT=3)N - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')E - IF (CLI$PRESENT('EXTRACT')) THEN - CONTEXT = 0( - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEND - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')0 - END IF - END IFe - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',M - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')C - END IF - END IFI - D - ICOUNT = 0 ! Line count for bulletin - R - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950u - ICOUNT = ICOUNT + 1 + MIN(ILEN,80)E - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line withL - END DO ! 1 space for blank line - ELSE ! If no input file - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counterA - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH1 - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredO - ICOUNT = ICOUNT + ILEN ! Update counter$ - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file. - END IFN - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out' - ENDIF - n - REWIND (UNIT=3) - o - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THENC - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST'))C - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT'_ - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - O - LEN_INLINE = STR$POSITION(INLINE,' ') - 1+ - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodesL - INLINE = INLINE(:LEN_INLINE)E - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1)N - ! If not permanent or shutdown specify dateU - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH)I - IF (IER.EQ.0) THENL - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN)A - END IFL - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THENE - WRITE (6,'('' Message successfully sent to node '',A)')N - & NODES(POINT_NODE)E - ELSE, - WRITE (6,'('' Error while sending message to node '',A)')A - & NODES(POINT_NODE)B - WRITE (6,'(A)') INPUT(:80)2 - GO TO 940 - END IFI - REWIND (UNIT=3) - END DO - END IFI - E - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - E - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IFL - A - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - LUSER = TRIM(USERNAME)L - R -C -C Add bulletin to bulletin file and directory entry for to directory file.I -CE - BRDCST = .FALSE.' - T - DO I = 1,NODE_NUM - E - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1S - FOLDER1 = NODES(I)E - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entryp - f - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - FROM = USERNAME ! UsernameN - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0E - ' - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - CALL STORE_BULL(LNODE+LUSER+6,'From: '//o - & LOCAL_NODE(:LNODE)//USERNAME(:LUSER),OBLOCK)E - IF (LENDES.GT.LEN(DESCRIP)) THENr - CALL STORE_BULL(LENDES+6,I - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1S -C) -C Broadcast the bulletin if requested. -CF - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'),p - & CLI$PRESENT('CLUSTER')) - END IFT - CALL BROADCAST(t - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER'))W - END IF - W - CALL CLOSE_BULLFIL ! Finished adding bulletin - S - CALL ADD_ENTRY ! Add the new directory entryT - - IF (FOLDER_NUMBER.GE.0) THEN0 - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -CI -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -CB - IF (DIFF.GE.0) THEN) - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)e - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IFN - _ - CALL CLOSE_BULLDIR ! Totally finished with add - ELSE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - E -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9A - CLOSE (UNIT=I) - END DOE - M - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEND - FOLDER_NUMBER = OLD_FOLDER_NUMBER' - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER)9 - END IF - - IF (CLI$PRESENT('EXTRACT')) THENF - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF_ - O - RETURN( - E -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100)I - GOTO 100 - Y -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GOTO 100A - G -930 WRITE (ERROR_UNIT,1025)F - CALL CLOSE_BULLFILS - CALL CLOSE_BULLDIRT - CLOSE (UNIT=3)I - GO TO 100 - A -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018)H - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)I - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')m -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system. - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown( - & if folder is remote.')B -2010 FORMAT(A) -2020 FORMAT(1X,A)L - C - END - - I - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER)X - - IMPLICIT INTEGER (A-Z)N - I - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*23 - E - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM)D - IF (.NOT.IER) RETURN$ - E - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - I - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - M - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - N - RETURN! - END - n - o - u - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - a - IMPLICIT INTEGER (A-Z)W - E - INCLUDE 'BULLUSER.INC'f - l - INCLUDE 'BULLFOLDER.INC'' - D - PARAMETER BRDCST_LIMIT = 82*12 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - u - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8N - O - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - u - CHARACTER LOCALNODE*8,RESPONSE*1R - H - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURNM - E - CALL OPEN_BULLUSER_SHARED - e - REMOTE_FOUND = .FALSE.T - TEMP_USER = ':' - t - DO WHILE (.NOT.REMOTE_FOUND)= - DO WHILE (REC_LOCK(IER)) u - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAGl - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE(4) - RETURNT - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DOn - e - CALL CLOSE (4) - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,. - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"')E - ! - IF (IER.EQ.0) THENW - IER = 0I - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER)O - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 1280 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE= - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ')A - IF (RESPONSE.NE.'n'.AND.RESPONSE.NE.'N') THEN - WRITE (6,'('' Trying again...'')')) - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')')( - END IF - END IF - - CLOSE (UNIT=17) - I - RETURNO - END - L - , - ) - / - INTEGER FUNCTION ERROR_TRAP - R - ERROR_TRAP = 1' - - RETURN - END - I - N - = - SUBROUTINE REPLYi - o - IMPLICIT INTEGER (A - Z) - L - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - 7 - INCLUDE 'BULLDIR.INC' - a - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read, - WRITE(6,'('' ERROR: You have not read any message.'')')O - RETURN ! And returnI - END IF) - - CALL OPEN_BULLDIR_SHAREDL - I - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinE - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF2 - - CALL CLOSE_BULLDIRD - , - WRITE (6,'('' Adding REPLY message with the subject:'')') - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP) - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - DESCRIP = 'RE: '//DESCRIP, - ELSE - DESCRIP = 'RE:'//DESCRIP(4:) - END IFg - WRITE (6,'(1X,A)') DESCRIP - E - CALL ADDE - - RETURN( - END - I - T - 0 - - SUBROUTINE CRELNM(INPUT,OUTPUT) - R - IMPLICIT INTEGER (A-Z)O - E - INCLUDE '($PSLDEF)' - O - INCLUDE '($LNMDEF)' - O - CHARACTER*(*) INPUT,OUTPUTf - c - CALL INIT_ITMLSTe - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - ' - RETURND - END - E - T - ( - SUBROUTINE GETPRIV= -CI -C SUBROUTINE GETPRIV -Cd -C FUNCTION: -C To get process privileges. -C OUTPUTS:e -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - F - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - = - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - E - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistR - : - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infop - t - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - m - RETURN - END - - N - L - L - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z)E - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/K - - INCLUDE '($PRVDEF)' - I - INCLUDE 'BULLUSER.INC'O - 1 - INCLUDE 'BULLFILES.INC' - E - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER)L - CALL CLOSE_BULLUSERu - NEEDPRIV(1) = USERPRIV(1)K - NEEDPRIV(2) = USERPRIV(2) - END IF( - , - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE.b - END IFf - q - RETURN - END - - - O - LOGICAL FUNCTION OPER_PRIVA - IMPLICIT INTEGER (A-Z)N - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - N - C - P - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSERE -CL -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process., -C$ - S - IMPLICIT INTEGER (A-Z)E - I - INCLUDE '($PRVDEF)' - _ - CHARACTER*(*) USERNAME ! Limit is 12 charactersL - D - INCLUDE '($JPIDEF)' - i - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - L - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infor - - RETURNs - END - n - e - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - r - INCLUDE 'BULLUSER.INC'i - w - INCLUDE '($UAIDEF)' - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*255 COMMAND - N - DATA CAPTIVE /0/_ - M - IF (CAPTIVE.EQ.0) THENE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))L - CALL END_ITMLST(GETUAI_ITMLST) ! Get address of itemlist - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - CAPTIVE = 1N - IF ((FLAGS.AND.UAI$M_CAPTIVE).NE.0) CAPTIVE = -1 - END IF - - IF (CAPTIVE.EQ.-1) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')')C - RETURN - END IFN - _ - CALL DISABLE_PRIVSI - ) - SAVE_KEYPAD_MODE = KEYPAD_MODER - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - M - IF (CLI$PRESENT('COMMAND')) THENR - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN)T - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE' - CALL LIB$SPAWN()I - END IFR - R - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPADT - E - CALL ENABLE_PRIVS - Y - RETURNT - END1 - ) - C - SUBROUTINE ATTACHA - G - IMPLICIT INTEGER (A - Z)5 - - COMMON /KEYPAD/ KEYPAD_MODE - _ - COMMON /TERM_CHAN/ TERM_CHAN - 1 - INCLUDE '($JPIDEF)' - ) - CHARACTER*15 PROCESSI - ( - IF (CLI$PRESENT('PROCESS')) THEN1 - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - T - CALL INIT_ITMLST ! Initialize item lists - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,)D - ELSE0 - CALL INIT_ITMLST ! Initialize item listf - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - ' - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)h - END IF - 0 - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODEe - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - e - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER)p - i - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD) - 0 - RETURN - ENDd - h - e - r - o - i - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - s - IMPLICIT INTEGER (A-Z) - & - INCLUDE 'BULLDIR.INC' - 0 - INCLUDE '($BRKDEF)' - ( - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - D -C_ -C The largest message that can be broadcasted is dependent on systemE -C and user quotas. The following limit is 12 lines of ( 80 characters += -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway.l -Ct - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7)L - T - PARAMETER BRDCST_LIMIT = 82*12 + 2D - CHARACTER*(BRDCST_LIMIT) BROAD - $ - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH! - E - IF (RING_BELL) THEN ! Include BELL in message?L - BROAD(:36) = ! Say who the bulletin is fromU - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROMM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is fromG - & CR//LF//LF//'NEW BULLETIN FROM: '//FROMG - BLENGTH = 35 ! Start adding next line here - END IFD - - IF (REMOTE_SET) REWIND (UNIT=3) - R - END = 0 - ILEN = LINE_LENGTH + 1. - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUTH - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN)A - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will beD - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long?N - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURNO - I - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - N - IF (ALL) THEN ! Should we broadcast to ALL?O - IF (CLUSTER) THENT - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,,,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THENs - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,,t - & %VAL(BRK$C_ALLUSERS),,,,,,,)i - END IF - END IFd - o - CALL SYS$SETRWM(%VAL(0))I - - RETURNE - END - ) - I - SUBROUTINE GET_FOLDER_INFO(IER) -CT -C SUBROUTINE GET_FOLDER_INFOE -CR -C FUNCTION: Obtains & verifies folder names from command line.o -CI - I - IMPLICIT INTEGER (A-Z) - M - INCLUDE 'BULLFOLDER.INC' - M - EXTERNAL CLI$_ABSENTM - R - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODEQ - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - o - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - A - CHARACTER NODE_TEMP*256 - L - NODE_NUM = 0 ! Initialize number of nodesP - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0)e - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',')( - IF (COMMA.GT.0) THENi - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE' - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IFR - NLEN = TRIM(NODES(NODE_NUM)), - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1D - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN_ - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN= - ELSE IF (READ_ONLY) THENP - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM)E - IER = 0 - RETURNN - END IF - END DO - END DOt - o - IER = 1 - e - RETURNT - END diff --git a/decus/vax91a/bulletin/bulletin.hlp b/decus/vax91a/bulletin/bulletin.hlp deleted file mode 100644 index 284b193..0000000 --- a/decus/vax91a/bulletin/bulletin.hlp +++ /dev/null @@ -1,143 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". - -NOTE: Depending on how the BULLETIN command is defined, triple quotes -rather than single quotes may be required. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vax91a/bulletin/bulletin.lnk b/decus/vax91a/bulletin/bulletin.lnk deleted file mode 100644 index 32ed815..0000000 --- a/decus/vax91a/bulletin/bulletin.lnk +++ /dev/null @@ -1,4 +0,0 @@ -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL/NOUSERLIB- - /EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.04" diff --git a/decus/vax91a/bulletin/bulletin0.for b/decus/vax91a/bulletin/bulletin0.for deleted file mode 100644 index 3be127d..0000000 --- a/decus/vax91a/bulletin/bulletin0.for +++ /dev/null @@ -1,1650 +0,0 @@ -C -C BULLETIN0.FOR, Version 4/28/91 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1 - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - CALL REMOTE_DELETE(SBULL,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.NE.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(1:11) - NEWEST_EXTIME = INPUT(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - DO BULL_DELETE = SBULL,EBULL - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL.AND.REMOTE_USER.EQ.FROM) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER.NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(1:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(1:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(1:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM) - IER = SYS$ASCTIM(,INPUT,EX_BTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:) - - CALL WRITEDIR(0,IER) - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IFr - e - RETURNn - END - i - y - o - m - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - L - IMPLICIT INTEGER (A-Z)m - : - INCLUDE 'BULLFOLDER.INC'p - g - COMMON /POINT/ BULL_POINT - s - CHARACTER*(*) INPUT - e - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-'))a - t - IF (DELIM.EQ.0) THENe - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVALo - ELSEl - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IFI - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL_ - IF (IER.NE.0) THENP - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THENE - EVAL = F_NBULL - IER = 0R - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT_ - IER = 0T - END IFN - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IFN - 2 - RETURNI - END - = - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C= -C SUBROUTINE DIRECTORY' -CE -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - O - INCLUDE 'BULLUSER.INC'm - - INCLUDE 'BULLFOLDER.INC'A - ( - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - A - COMMON /POINT/ BULL_POINT - L - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - ) - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - D - COMMON /CLOSE_FILES_INFO/ CLOSED_FILESQ - R - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES( - E - CHARACTER START_PARAMETER*16,DATETIME*23,SEARCH_STRING*80 - E - INTEGER TODAY(2) - C - CHARACTER*9 EXPIRES - - CHARACTER TIMBUF*13e - DATA TIMBUF/'0 00:00:05.00'/ - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/R - _ - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN)I - IER=SYS$BINTIM(TIMBUF,TIMADR)t - d - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenN - M - IF (INCMD(:3).EQ.'DIR'.AND..NOT.READ_TAG) THEN_ - SUBJECT = CLI$PRESENT('SUBJECT') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLYR - SEARCH = CLI$PRESENT('SEARCH') - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').AND. - & CLI$PRESENT('MARKED')) THENE - IF (FOLDER_NUMBER.GE.0) THEN? - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)L - ELSEe - WRITE (6,'('' ERROR: Cannot use /MARKED with'', - & '' remote folder.'')') - RETURNR - END IF - END IF - END IF - U -C -C Directory listing is first buffered into temporary memory storage beforeU -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen,( -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - s - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1l - - CALL OPEN_BULLDIR_SHARED ! Get directory file - F - CALL READDIR(0,IER) ! Does directory header exist?R - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified?( - IER = CLI$GET_VALUE('START',START_PARAMETER,ILEN)S - DECODE(ILEN,'(I)',START_PARAMETER) DIR_COUNT - IF (DIR_COUNT.GT.NBULL) THEN - DIR_COUNT = NBULL - ELSE IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0E - RETURN - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM)c - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IFR - CALL READDIR_KEYGE(IER) - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - IF (REMOTE_SET.NE.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR! - RETURNa - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1),L - & MSG_KEY)E - END IFF - CALL READDIR_KEYGE(IER) - ELSEE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THENE - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')')o - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IF - END IF - END IF - - IF (IER.EQ.0) THENn - WRITE (6,'('' No messages past specified date.'')')B - CALL CLOSE_BULLDIR - RETURN - ELSEU - DIR_COUNT = IER0 - END IF - ELSEe - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IFc - o - IF (CLI$PRESENT('SEARCH')) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN)e - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - END IF - e - IF (READ_TAG) THEN) - IF (SUBJECT.OR.REPLY.OR.SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '',E - & ''displaying only MARKED messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IFt - IF (.NOT.(CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW') - & .OR.CLI$PRESENT('START'))) THEN - DIR_COUNT = 1 - END IFn - CALL READDIR(DIR_COUNT,IER1)l - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I))t - IF (ITEST.GT.0) THEN, - MSG_KEY(I:I) = CHAR(ITEST-1)o - I = 9 - ELSE - I = I + 1 - END IF - END DOm - END IF) - n - IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THENs - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1o - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULLA - SBULL = NBULL - (PAGE_LENGTH-5) + 10 - IF (SBULL.LT.1) SBULL = 1 - ELSEe - SBULL = DIR_COUNTI - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1T - END IFX - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE.L - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THENE - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULLI - IF (SBULL.LT.1) SBULL = 1L - END IFL - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEND - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL)E - FIRST_BULL = FIRST_BULL + 1 - IER1 = 0) - IER = 0 - FBULL = 0 - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER)e - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT)N - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) THEN - EBULL = DIR_COUNTL - FBULL = EBULL + 1 - END IFL - FBULL = FBULL - 1 - IF (EBULL-FBULL.EQ.(PAGE_LENGTH-7)-1) THEN - IER = 1s - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IFI - END DOE - IF (FBULL.EQ.FIRST_BULL) THEN - CALL READDIR(EBULL,IER) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT)R - DO WHILE (IER.EQ.0.AND.EBULL-FBULL.LT.(PAGE_LENGTH-7)-1)) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT) - IF (IER.EQ.0) EBULL = EBULL + 1= - END DOS - DO I=1,3E - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT) - END DOS - IF (IER.NE.0) EBULL = DIR_COUNT - END IFI - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY) - IF (IER.NE.0) EBULL = EBULL + 1 - END IFS - CALL READDIR(SBULL,IER) - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9R - ELSE - I = I + 1 - END IFE - END DOT - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING) THEN - EBULL = NBULL - END IF - IF (SUBJECT.OR.REPLY.OR.SEARCH) THEN - CONTINUEN - ELSE IF (.NOT.REMOTE_SET.AND..NOT.READ_TAG) THEN - DO I = SBULL,EBULLE - CALL READDIR(I,IER) ! Into the queueC - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)G - END DOP - ELSE IF (READ_TAG) THENG - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT) - IF (I.EQ.0.AND.IER1.EQ.0) THENE - SBULL = DIR_COUNTA - I = SBULLC - END IF2 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)L - I = I + 1 - END DOR - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1* - ELSEG - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY)R - IF (IER1.EQ.0) THEN - IER = 00 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THENu - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY)I - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY)s - END IFI - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVEE - IER1 = 1T - ELSE - EBULL = EBULL_SAVE& - END IF - END IFT - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN( - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTEm - RETURN' - END IFR - END IF - ELSE - NBULL = 0I - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - WRITE (6,'('' There are no messages present.'')') - RETURN - END IFd - -Ci -C Directory entries are now in queue. Output queue entries to screen.h -Ci - t - FLEN = TRIM(FOLDER_NAME) - WRITE(6,'(X,A)') FOLDER_NAME(:FLEN), - IF (EXPIRATION) THENs - WRITE(6,1005) ! Write header - ELSES - WRITE(6,1000) ! Write headere - END IFs - C - IF (.NOT.(SUBJECT.OR.REPLY.OR.SEARCH).AND.R - & BULL_TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(1:3).NE.' ') THENF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to headerI - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)I - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D_ - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)_ - IF (BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - MSG_NUM = -MSG_NUM: - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG)$ - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IFE - END DO - END IFW - / - CALL CLOSE_BULLDIR ! We don't need file anymore - T - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - f - I = SBULL - START_SEARCH = IB - IF (.NOT.REPLY_FIRST) START_SEARCH = I - 1E - IF (SUBJECT.OR.REPLY.OR.SEARCH) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH) CALL OPEN_BULLFIL_SHARED - CLOSED_FILES = .FALSE. - END IFE - DO WHILE (I.LE.EBULL) - IF (.NOT.(SUBJECT.OR.REPLY.OR.SEARCH)) THENe - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)( - ELSE - IF (CLOSED_FILES) THEN& - CLOSED_FILES = .FALSE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH) CALL OPEN_BULLFIL_SHAREDe - END IF - CALL GET_SEARCH(FOUND,SEARCH_STRING,START_SEARCH,.FALSE. - & ,SUBJECT,REPLY_FIRST,.FALSE.,.TRUE.) - IF (INCMD(1:3).NE.' '.AND.BULL_TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - CALL READDIR(FOUND,IER) - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - SEARCH_STRING = ' ' - START_SEARCH = FOUNDT - IF (BULL_TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG) - IF (IER.NE.0) NEXT_TAG = NBULL + 1' - CALL READDIR(FOUND,IER) - MSG_NUM = -MSG_NUM - END IF - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.LE.EBULL) THEN - CALL CONVERT_ENTRY_FROMBINC - IF (MSG_NUM.LT.0.OR.READ_TAG) THEN$ - WRITE (6,'('' *'',$)') - IF (MSG_NUM.LT.0) MSG_NUM = -MSG_NUM - ELSEF - WRITE (6,'('' '',$)') - END IF' - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3)E - IF ((EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) - & .AND.REMOTE_SET.NE.3) THEN - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM,'(DELETED)' - ELSE IF (EXPIRATION) THEN - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin?O - EXPIRES = 'Shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Permanent bulletin? - EXPIRES = 'Permanent'T - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(1:7)//EXDATE(10:11) - END IF - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM,EXPIRES - ELSEK - WRITE(6,2010) MSG_NUM,DESCRIP(:55-N),FROM, - & DATE(1:7)//DATE(10:11) - END IF - END IF - I = I + 1I - IF (SUBJECT.OR.REPLY.OR.SEARCH) IER = SYS$CANTIM(,)= - END DOT - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (SEARCH.OR.REPLY.OR.SUBJECT) THEN - IF (SEARCH) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IFE - e - IF (DIR_COUNT.GT.NBULL.OR.(READ_TAG.AND.IER1.NE.0)) THEN - ! Outputted all entries? - DIR_COUNT = -1 ! Yes. Set counter to -1. - ELSEG - WRITE(6,1010) ! Else say there are more= - END IF - - RETURN - F -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/)N -1010 FORMAT(1X,/,' Press RETURN for more...',/)N - - -2010 FORMAT('+',I,1X,A<55-N>,1X,A12,1X,A9)H - - END - - - SUBROUTINE CLOSE_FILES - F - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILESA - R - INQUIRE(UNIT=1,OPENED=IER)E - IF (IER) CALL CLOSE_BULLFIL - S - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - L - RETURN - END - L - S - L - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - S - IMPLICIT INTEGER (A-Z)R - D - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - R - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO. - T - RETURN - END - B - - I - SUBROUTINE FILE -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z)_ - G - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - S - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC', - ) - EXTERNAL CLI$_ABSENTF - E - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?, - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)E - IF (EBULL.GT.F_NBULL) EBULL = F_NBULLA - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1I - EBULL = F_NBULLC - IER = 0E - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSET - SBULL = BULL_POINT - EBULL = SBULLI - IER = 0L - END IF+ - - IF (SBULL.LE.0.OR.IER.NE.0) THEN( - WRITE (6,1015) - RETURN - END IF - L - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)S - T - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write error - RETURN ! And return - END IFD - C - CALL DISABLE_PRIVSD - C - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE. - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH,D - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')= - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12)L - END IF - END IFO - ) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - D - CALL OPEN_BULLDIR_SHAREDQ - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - I - FIRST = .TRUE.E - D - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletinA - G - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1T - IF (FBULL1.GT.SBULL) GO TO 100E - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFILG - CALL CLOSE_BULLDIR - RETURNI - ELSE IF (REMOTE_SET) THENE - CALL REMOTE_READ_MESSAGE(FBULL,IER1)F - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSEU - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100F - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12)L - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN' - WRITE(3,1060) FROM,DATE//' '//TIME(:8)y - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENi - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN). - END DO - END DOS - T -100 CLOSE (UNIT=3) ! Bulletin copy completed - - WRITE(6,1040) BULL_PARAMETER(1:LEN_P) - ! Show name of file created.L - CALL CLOSE_BULLFILG - CALL CLOSE_BULLDIRX - A - RETURN - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privilegesC - RETURNn - q -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format.')_ -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I)R -1040 FORMAT(' Message(s) written to ',A) -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - I - END - N - O - E - I - SUBROUTINE LOGIN_ -CL -C SUBROUTINE LOGIN -Ce -C FUNCTION: Alerts user of new messages upon logging in.r -C - IMPLICIT INTEGER (A - Z)A - S - INCLUDE 'BULLDIR.INC' - _ - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'A - ) - COMMON /READIT/ READITL - _ - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - S - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGR - Y - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPTH - CHARACTER*39 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHL - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)A - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATER - . - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - B - CHARACTER TODAY*23,INREAD*1 - - LOGICAL*1 CTRL_G/7/ - X - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/_ - T - DATA FIRST_WRITE/.TRUE./_ - LOGICAL FIRST_WRITE - R - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)R - D - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - T - FOLDER_NAME = 'GENERAL' - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - L - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -CS -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -CX - E - CALL OPEN_BULLUSER_SHARED - 1 - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entryu - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entryk - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN0 - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN- - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2)- - ELSE - RETURN ! Don't notify1 - END IF - END IF - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1)E - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)D - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRYE - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONGT - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR.1 - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO. - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead userss - READ_BTIM(1) = NEW_BTIM(1) ! Make new entryl - READ_BTIM(2) = NEW_BTIM(2) - DO I = 1,FLONGR - SET_FLAG(I) = SET_FLAG_DEF(I)X - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)o - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DOs - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THENN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - ELSEE - LOGIN_BTIM_SAVE(1) = NEW_BTIM(1) - LOGIN_BTIM_SAVE(2) = NEW_BTIM(2) - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2)T - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF_ - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away..., - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL setL - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DOH - WRITE (9,IOSTAT=IER) USERNAME,C - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINFi - END IF - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF( - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM)G - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - BBOARD_BTIM(1) = TODAY_BTIM(1) - BBOARD_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_HEADER ! Rewrite headerr - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD')T - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER( - CALL EXIT ! If no header, no messagesN - END IFS - E - IF (IER1.EQ.0) THEN ! Skip date comparison if new entryL -CA -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility.. -C0 - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - LOGIN_BTIM(1) = READ_BTIM(1) ! then use the read date to compareI - LOGIN_BTIM(2) = READ_BTIM(2) ! with the latest bulletin date - END IF ! to see if should alert user.R - N - IF (SYSTEM_SWITCH) THENB - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM)L - END IF - END IFR - D - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) ! These are destroyed in UPDATE_READ - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)S - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THENS - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1' - IF (READIT.EQ.1) THENI - CALL UPDATE_READ(1) - LOGIN_BTIM_NEW(1) = LOGIN_BTIM(1) - LOGIN_BTIM_NEW(2) = LOGIN_BTIM(2) - CALL READ_IN_FOLDERS. - CALL MODIFY_SYSTEM_LIST(1)C - END IF - CALL CLOSE_BULLUSERL - RETURN - END IFE - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - N - ENTRY LOGIN_FOLDERT - R - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - LOGIN_BTIM(1) = LOGIN_BTIM_SAVE(1) - LOGIN_BTIM(2) = LOGIN_BTIM_SAVE(2) - END IFH - 1 - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login timeT - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THENT - LOGIN_BTIM(1) = LAST_SYS_BTIM(1,FOLDER_NUMBER+1)H - LOGIN_BTIM(2) = LAST_SYS_BTIM(2,FOLDER_NUMBER+1)1 - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,E - & LAST_READ_BTIM(1,FOLDER_NUMBER+1))D - IF (DIFF1.LT.0) THEN0 - LOGIN_BTIM(1) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - ELSE( - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM)A - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta timeL - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IFn - END IFR - END IF - END IF - n - ENTRY SHOW_SYSTEM - A - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))o - g - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messagesA - BULL_POINT = -1 - ) - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(1)L - LOGIN_BTIM_NEW(1) = LOGIN_BTIM(1)I - LOGIN_BTIM_NEW(2) = LOGIN_BTIM(2)/ - END IFC - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs, - END IFL - C - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THENM - ! Can folder have SYSTEM messages and /SYSTEM specified? - LOGIN_BTIM(1) = SYSTEM_LOGIN_BTIM(1) ! Use specified login timeC - LOGIN_BTIM(2) = SYSTEM_LOGIN_BTIM(2) ! for system messages.I - END IFS - _ - IF (LOGIN_SWITCH) THENC - IF (READIT.EQ.1) THENI - LOGIN_BTIM_OLD(1) = LOGIN_BTIM(1) - LOGIN_BTIM_OLD(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(1) - LOGIN_BTIM_NEW(1) = LOGIN_BTIM(1) - LOGIN_BTIM_NEW(2) = LOGIN_BTIM(2) - LOGIN_BTIM(1) = LOGIN_BTIM_OLD(1) - LOGIN_BTIM(2) = LOGIN_BTIM_OLD(2) - END IF - CALL CLOSE_BULLUSER - END IFD - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THENf - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))R - IF (DIFF1.LT.0) THENB - LOGIN_BTIM(1) = LAST_SYS_BTIM(1,FOLDER_NUMBER+1) - LOGIN_BTIM(2) = LAST_SYS_BTIM(2,FOLDER_NUMBER+1) - END IF_ - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LOGIN_BTIM_NEW(1)C - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LOGIN_BTIM_NEW(2)I - END IF - Y - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)0 - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN1 - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IFn - d - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULLI - END IFT - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT))( - GEN_DIR = GEN_DIR1. - SYS_DIR = SYS_DIR1H - SYS_NUM = SYS_NUM1) - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1I - IF (IER1.EQ.0) THENI - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1M - END IF - END IFM - - IF (REMOTE_SET) THENS - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIRB - CALL DISCONNECT_REMOTER - GO TO 9999R - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF1 - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THENF - ICOUNT = NBULL + START - ICOUNT1N - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100s - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1T - ELSE - CALL READDIR(ICOUNT,IER)E - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user?L - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IFG - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1_ - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THENN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)s - ELSE IF (.NOT.SYSTEM_SWITCH) THENL - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM), - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.e - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100= - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF_ - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THENE - NSYS = NSYS + 1k - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))U - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for displayE - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN( - BULL_POINT = ICOUNT - 1r - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100d - END IFl - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IFP - END IF - END DOE -100 CALL CLOSE_BULLDIR -C0 -C Review new directory entries. If there are system messages,) -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - N - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesI - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2G - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep...P - PAGE = PAGE + 1L - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT)Y - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0D - DO J=1,NSYSL - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)N - IF (REMOTE_SET) THEN) - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER)D - END IF - IF (IER.GT.0) THEN( - CALL CLOSE_BULLFIL - GO TO 9999 - END IF( - END IFT - INPUT = ' '1 - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1E - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)G - END IFS - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)D - END IFF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO) - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFILL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATET - END DOR - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2o - END IFg - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1D - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages. - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THENI - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN_ - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next pagee - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....')M - WRITE (6,'(1X)')e - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenL - PAGE = 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) '+'//INPUT(:ILEN) - ILEN = 0I - ELSE - WRITE(6,1060) '+'//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:)( - ILEN = ILEN - PAGE_WIDTHN - END IF - ELSEP - PAGE = PAGE + 1G - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) ' '//INPUT(:ILEN) - ILEN = 0L - ELSE - WRITE(6,1060) ' '//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:)E - ILEN = ILEN - PAGE_WIDTHL - END IF - END IF - END IFB - END DO - IF (NGEN.EQ.0) THEN - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IFD - 1 - ENTRY REDISPLAY_DIRECTORY - T - GEN_DIR = GEN_DIR1( - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2E - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page0 - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)')E - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(1:LENF)//' messages' - PAGE = 1T - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesC - FIRST_WRITE = .FALSE. ! if this is first write to screen.D - END IF - WRITE (6,'(''+'',A,$)') CTRL_GR - WRITE(6,1027) 'New '//FOLDER_NAME(1:LENF)//' messages'N - PAGE = PAGE + 1 - END IF - WRITE(6,1020)T - WRITE(6,1025) - PAGE = PAGE + 2_ - I = 0E - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIND - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen, - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD, - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD,INREAD) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1R - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')')T - ELSE - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF= - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEMe - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0)E - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THENI - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IFg -C -C Instruct users how to read displayed messages if READNEW not selected.E -C - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030)Y - ELSE IF (NGEN.EQ.0) THENE - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.'( - ELSEA - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1C - ILEN = 49 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILENF - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'The ' //COMMAND_PROMPT(:ILEN-48)// - & ' command can be used to read these messages.' - ELSE - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-49-FLEN) - & //' '//FOLDER_NAME(:FLEN)//M - & ' command can be used to read these messages.' - END IF - END IF - C -9999 IF (LOGIN_SWITCH) THENU - LOGIN_BTIM(1) = LOGIN_BTIM_NEW(1) - LOGIN_BTIM(2) = LOGIN_BTIM_NEW(2)E - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM_OLD(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM_OLD(2) - END IFs - RETURNI - ( -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'))V -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.')- -1080 FORMAT(' ',/) - I - END - N - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - E - IMPLICIT INTEGER (A-Z) - T - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - E - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlistR - l - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)),I - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - n - IF (.NOT.IER) THENT - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0N - END IF - - RETURN0 - END - . diff --git a/decus/vax91a/bulletin/bulletin1.for b/decus/vax91a/bulletin/bulletin1.for deleted file mode 100644 index 61c9823..0000000 --- a/decus/vax91a/bulletin/bulletin1.for +++ /dev/null @@ -1,1792 +0,0 @@ -C -C BULLETIN1.FOR, Version 4/22/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL(STATUS) -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent' - ELSE - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (MAIL_SUBJECT(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - MAIL_SUBJECT(I:I) = '`' - ELSE - MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_P = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_P = LEN_P + I + 1 - BULL_PARAMETER(LEN_P:LEN_P) = ',' - END DO - LEN_P = LEN_P - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:I)//'""'// - & BULL_PARAMETER(I+1:) - I = I + 2 - LEN_P = LEN_P + 2 - END IF - I = I + 1 - END DO - - CALL DISABLE_PRIVS - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) - & //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,STATUS) - CALL ENABLE_PRIVS - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - RETURN - ELSE IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.25) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 25 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0)e - ! See if folder existso - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IFL - o - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - M - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THENg - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (IER) THENB - IER = 0 - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - END IF - END IFI - I - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)O - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IFl - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6)L - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6)E - END IF - CALL WRITE_FOLDER_FILE(IER)E - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THENP - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IFs - i - CALL CLOSE_BULLFOLDER - R - RETURNP - END - H - ! - s - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z)L - O - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - o - RETURNr - END - . - ' - - SUBROUTINE MOVE(DELETE_ORIGINAL)P -CE -C SUBROUTINE MOVE -Cr -C FUNCTION: Moves message from one folder to another. -C, - IMPLICIT INTEGER (A - Z)I - R - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - L - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - 5 - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - 4 - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - T - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /HEADER/ HEADERN - I - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - D - INCLUDE 'BULLFOLDER.INC'm - n - INCLUDE 'BULLFILES.INC' - ' - EXTERNAL CLI$_ABSENTI - : - EXTERNAL BULLETIN_SUBCOMMANDS - X - LOGICAL DELETE_ORIGINAL - N - CHARACTER SAVE_FOLDER*25,POST_SUBJECT*255 - e - IF (CLI$PRESENT('ORIGINAL').AND..NOT.SETPRV_PRIV()) THENm - WRITE (6, - & '('' ERROR: You have no privileges to keep original owner.'')') - RETURN - END IFL - P - ALL = CLI$PRESENT('ALL')L - I - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT, - G - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THENL - IF (BULL_POINT.EQ.0) THEN ! If no message has been readN - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry) - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIRW - RETURNI - END IF - E - NUM_COPY = 1 - ELSE3 - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIRL - RETURNF - END IF - I - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSEA - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IFR - IF (NUM_COPY.GT.1) ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THENa - NUM_COPY = NBULLr - BULL_POINT = 1I - END IF - END IFU - P - FROM_REMOTE = REMOTE_SET - - IF (REMOTE_SET) THENL - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',N - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,R - & ORGANIZATION='INDEXED',IOSTAT=IER,/ - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')T - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL',F - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,D - & FORM='UNFORMATTED')E - END IF - IF (IER.EQ.0) THEN - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - IF (IER.EQ.1) WRITE (12,IOSTAT=IER1) BULLDIR_HEADER - I = BULL_POINT - 16 - IER = I + 1 - NBLOCK = 1D - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0I - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - I1 = IE - CALL READDIR(I,IER)A - IF ((I1.EQ.BULL_POINT.AND.I1.NE.I)I - & .AND..NOT.CLI$PRESENT('ALL')) THENR - WRITE(6,'('' ERROR: Message not found: '',I)') I1S - CLOSE (UNIT=11)S - CLOSE (UNIT=12)L - CALL CLOSE_BULLDIR - CALL CLOSE_BULLFILr - RETURN - END IF. - IF (IER.EQ.I+1.AND.I.LE.LAST) THENC - BLOCK = NBLOCK - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)E - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE' - CALL GET_REMOTE_MESSAGE(IER1) - END IF' - IF (LENGTH.EQ.0) IER = 1 ! Don't allow empty messagesr - IF (IER1.EQ.0) THENU - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT(:128))i - WRITE (11'NBLOCK,IOSTAT=IER1) INPUT(:128)O - IF (IER1.EQ.0) NBLOCK = NBLOCK + 1 - END DO! - END IF - IF (IER1.EQ.0) WRITE (12,IOSTAT=IER1) BULLDIR_ENTRYl - IF (IER1.NE.0) THEN) - I = IER - ELSE - NUM_COPY = NUM_COPY + 1 - END IF - END IF - END DOD - END IF - CALL CLOSE_BULLFIL - IF (IER1.NE.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=11) - CLOSE (UNIT=12) - CALL CLOSE_BULLDIR - RETURNP - END IF - END IF - - CALL CLOSE_BULLDIR' - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBERI - CALL CLI$GET_VALUE('FOLDER',FOLDER1)1 - h - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBERN - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - L - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')')F - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THENa - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')')T - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.4) THEN - IF (CLI$PRESENT('ORIGINAL')) THENA - REMOTE_SET = 0_ - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = E - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1)I - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - IER1 = .FALSE. - END IF' - END IF - END IFW - ) - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBERd - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1): - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=11)I - CLOSE (UNIT=12)L - RETURN - END IFr -Cl -C Add bulletin to bulletin file and directory entry for to directory file.Y -C0 - IF (REMOTE_SET.GE.3) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,R - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - ELSET - CALL OPEN_BULLDIR ! Prepare to add dir entry - K - CALL OPEN_BULLFIL ! Prepare to add bulletinN - N - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDERR - / - IF (.NOT.FROM_REMOTE) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,L - & ORGANIZATION='INDEXED',IOSTAT=IER,$ - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')R - END DO - A - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1))F - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,L - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED')F - END DO - END IF - ELSEL - IER= 0 - END IFR - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THENN - HEADER = .TRUE. - ELSE - HEADER = .FALSE.o - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - ( - IF (IER.EQ.0) THENF - IF (FROM_REMOTE) THEN - READ (12,KEYID=0,KEY=0,IOSTAT=IER), - ELSE - READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - END IF - END IFS - O - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - NUM_COPY = NUM_COPY - 1S - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - T - IF (REMOTE_SET.GE.3) SYSTEM = 0B - T - IF (FROM_REMOTE.EQ.3) THEN - SYSTEM = 0o - IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,14) - END IF - END IF - END IF - T - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges?A - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - N - IF (BTEST(SYSTEM,2).AND. ! Shutdown message?L - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'',E - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THENe - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)L - WRITE (6,'('' Expiration will be '',I,'' days.'')')G - & FOLDER_BBEXPIRE= - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1)R - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - I - IF (.NOT.CLI$PRESENT('ORIGINAL')) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - g - IF (REMOTE_SET.EQ.1) THENL - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2I - IF (IER.NE.0) CALL ERROR_AND_EXIT - ELSE IF (REMOTE_SET.GE.3) THEN - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)o - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSEN - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)E - END IFa - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)R - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - A - REWIND (UNIT=3) - T - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT)4 - END IF - - IF (REMOTE_SET.LT.3) THENI - IF (MERGE) CALL ADD_MERGE_TO(IER) - A - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - I - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THENI - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128))T - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF( - E - IF (IER.EQ.0) THENI - IF (MERGE) THEN_ - CALL ADD_MERGE_FROM(IER) - ELSE IF (FROM_REMOTE) THEN - CALL ADD_ENTRYT - ELSE - CALL ADD_ENTRY ! Add the new directory entry+ - END IF - BULL_POINT = BULL_POINT + 1R - END IFE - END IF - END DOE - I - IF (REMOTE_SET.GE.3) CLOSE (UNIT=3) - ' - IF (MERGE) CALL ADD_MERGE_REST(IER) - g - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLFIL - 1 - CLOSE (UNIT=11) - = - CLOSE (UNIT=12) - E - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder infoE -CI -C If user is adding message, an no new messages, update last read time forE -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THENE - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)E - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IFT - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THENB - WRITE (6,'('' Successful copy to folder '',A)'). - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THENN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')')I - & BULL_POINT - START_BULL_POINT - END IFl - ' - IF (REMOTE_SET.LT.3) HEADER = SAVE_HEADER - T - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT_ - D - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN_ - IF (FROM_REMOTE.AND.ALL) THENE - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')')O - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IFD - L - RETURN - END - I - ( - ( - E - SUBROUTINE PRINTw -Ce -C SUBROUTINE PRINT -CL -C FUNCTION: Print header to queue. -Cv - d - IMPLICIT INTEGER (A-Z)T - - INCLUDE '($SJCDEF)' - S - INCLUDE 'BULLDIR.INC' - . - INCLUDE 'BULLFOLDER.INC'N - O - COMMON /POINT/ BULL_POINT - _ - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - E - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - M - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE1 - . - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - ' - CHARACTER*31 FORM_NAME - = - PARAMETER FF = CHAR(12) - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULLD - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1L - EBULL = F_NBULLE - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0e - END IFI - R - IF (SBULL.LE.0.OR.IER.NE.0) THEN= - WRITE (6,1015) - RETURN - END IF - - CALL DISABLE_PRIVSS - U - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - N - CALL OPEN_BULLDIR_SHAREDR - - CALL OPEN_BULLFIL_SHAREDQ - - HEAD = CLI$PRESENT('HEADER')C - s - FIRST = .TRUE. - L - DO I=SBULL,EBULLD - I1 = I - CALL READDIR(I,IER) ! Get info for specified messageO - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT) - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THENL - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1D - IF (I1.GT.SBULL) GO TO 100, - CLOSE (UNIT=3,STATUS='DELETE')& - CALL CLOSE_BULLFILD - CALL CLOSE_BULLDIR - RETURNG - ELSE IF (REMOTE_SET) THEN' - CALL REMOTE_READ_MESSAGE(I,IER1)N - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE1 - CALL GET_REMOTE_MESSAGE(IER1) - END IFS - IF (IER1.NE.0) GO TO 100 - END IF - E - IF (.NOT.FIRST) THEN - WRITE (3,'(A)') FF& - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - E - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)H - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENN - IF (HEAD) THEN. - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN( - WRITE(3,1060) FROM,DATE//' '//TIME(:8)E - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - O - DO WHILE (ILEN.GT.0) ! Copy bulletin into fileM - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN)T - END DO - END DOS - E -100 CLOSE (UNIT=3) ! Bulletin copy completed - Q - CALL CLOSE_BULLFILF - CALL CLOSE_BULLDIR0 - H - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) ! Get queue name - IF (ILEN.EQ.0) THEN - QUEUE = 'SYS$PRINT'V - ILEN = 9 - END IFr - l - CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - T - IF (CLI$PRESENT('NOTIFY')) THEN - CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - END IFy - m - IF (CLI$PRESENT('FORM')) THEN - IER = CLI$GET_VALUE('FORM',FORM_NAME,FORM_NAME_LEN)Y - CALL ADD_2_ITMLST(FORM_NAME_LEN,SJC$_FORM_NAME,%LOC(FORM_NAME))e - END IFd - E - CALL DISABLE_PRIVSw - e - CALL END_ITMLST(SJC_ITMLST) - B - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)E - IF (IER.AND.(.NOT.JBC_ERROR)) THENn - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - , - RETURN - m -900 CALL ERRSNS(IDUMMY,IER)R - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER)L - RETURNF - E -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.')s -1010 FORMAT(' ERROR: You have not read any message.')I -1015 FORMAT(' ERROR: Specified message number has incorrect format.')1 -1030 FORMAT(' ERROR: Following bulletin was not found: ',I)T -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - I - A - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ_MSG -CE -C FUNCTION: Reads a specified bulletin. -C( -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file_ -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z)T - I - COMMON /POINT/ BULL_POINT - O - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC', - ) - INCLUDE 'BULLUSER.INC'E - I - COMMON /READIT/ READITI - . - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGINGT - LOGICAL PAGINGL - T - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - ) - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - U - COMMON /READ_DISPLAY/ LINE_OFFSET - L - COMMON /TAGS/ BULL_TAG,READ_TAG - T - COMMON /HEADER/ HEADERF - E - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./D - R - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*11,DATETIME*23,BUFFER*(LINE_LENGTH) - CHARACTER SAVE_MSG_KEY*8,PREV_MSG_KEY*8,HEADLINE*132 - ' - LOGICAL SINCE,PAGE1 - - EXTERNAL CLI$_NEGATED - ) - CALL LIB$ERASE_PAGE(1,1) ! Clear screenK - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - ( - SINCE = .FALSE. - PAGE = .TRUE. - O - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - IF (CLI$PRESENT('HEADER')) THENd - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE.N - END IF - IF (CLI$PRESENT('MARKED')) THENS - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)g - IF (IER.NE.0) THENA - WRITE (6,'('' ERROR: No marked messages found.'')') - RETURN - ELSE. - READ_TAG = .TRUE.. - END IF - END IF - A - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified?t - IER = CLI$GET_VALUE('SINCE',DATETIME)s - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default.l - IER = SYS$BINTIM('-- 00:00:00.00',TODAY)i - CALL GET_MSGKEY(TODAY,MSG_KEY)) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM)W - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF= - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified?T - IF (REMOTE_SET.NE.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THENF - WRITE (6,'('' No new messages are present.'')') - RETURNT - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY)' - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER)E - IF (IER.EQ.0) THEN - WRITE (6,'('' No new messages are present.'')') - RETURNR - END IF - END IF - BULL_READ = IER - IER = IER + 1 - END IF - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - RETURNd - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IFN - F - NEXT = .FALSE.R - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THENN - NEXT = .TRUE.N - ELSE IF (INCMD(:4).EQ.'READ'.AND..NOT.CLI$PRESENT('SINCE')I - & .AND..NOT.CLI$PRESENT('NEW').AND. - & .NOT.CLI$PRESENT('BULLETIN_NUMBER')) THEN - NEXT = .TRUE.C - END IFI - - IF (READ_TAG) THENO - IF (INCMD(:4).EQ.'BACK') THEN - SAVE_MSG_KEY = MSG_KEY - MSG_KEY = BULLDIR_HEADER - I = 0R - IER = 0M - CALL OPEN_BULLDIR_SHARED - DO WHILE (IER.EQ.0.AND.MSG_KEY.NE.SAVE_MSG_KEY)T - I = I + 1 - IF (MSG_KEY.NE.SAVE_MSG_KEY) PREV_MSG_KEY = MSG_KEY - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ)T - END DO - IF (IER.EQ.0) THEN - MSG_KEY = PREV_MSG_KEYI - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ)( - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IER = 0 - IF (BULL_POINT.EQ.0) CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_READ) - DO WHILE (IER.EQ.0)R - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END DO - CALL CLOSE_BULLDIR - IER = BULL_READ + 1I - ELSE IF (NEXT) THENR - IF (SINCE) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - ELSE - IF (BULL_POINT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) - CALL CLOSE_BULLDIR - ELSEP - MSG_KEY = BULLDIR_HEADER - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) - END IF - IF (IER.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF. - E - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND.B - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'))) THENE - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry_ - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.EQ.3 - & .AND.INCMD(:4).EQ.'READ') THEN( - IF (CLI$PRESENT('NEW')) THEN - NEXT = .TRUE._ - CALL READDIR(BULL_READ,IER) - END IFE - END IF - IF (REMOTE_SET.NE.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0, - IF (IER.NE.BULL_READ+1) THEN. - CALL READDIR(0,IER)N - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0H - END IF - END IFT - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ) - IF (IER1.NE.0) IER = 0) - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0. - END IF - END IFu - - NEXT = .FALSE.I - H - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.NE.3) THEN - WRITE(6,1030) ! If not, then error out - ELSE - WRITE(6,1040) - END IF - RETURN - END IFl - - IF (REMOTE_SET.NE.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)): - IF (DIFF.GT.0) THEND - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2) - END IF - ELSEt - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IFC - O - BULL_POINT = BULL_READ ! Update bulletin counterC - G - EDIT = .FALSE.Q - E - PAGE_WIDTH = REAL_PAGE_WIDTHI - . - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THENN - IF (CLI$PRESENT('EDIT')) THENL - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')L - IF (IER.NE.0) THEN, - CALL ERRSNS(IDUMMY,IER)' - CALL SYS_GETMSG(IER) - RETURN - END IFL - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTHE - PAGE = .FALSE.D - END IF - END IFL - R - FLEN = TRIM(FOLDER) - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - E - IF (REMOTE_SET.EQ.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ')S - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSEI - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULLl - END IF - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:)_ - END DOR - I = TRIM(HEADLINE)0 - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - HEADLINE(REAL_PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN)( - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE))m - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSEe - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE))n - END IF - 0 - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THENN - INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)' - ELSEo - INPUT = 'Date: '//DATE//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?d - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown'h - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent'P - ELSEN - INPUT = 'Date: '//DATE//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5)I - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IFN - IF (EDIT) THENN - WRITE (3,'(A)') INPUT(:TRIM(INPUT))A - ELSE1 - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IFT - N - END = END + 1 - A - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1/ - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:)S - DO WHILE (TRIM(INPUT).GT.0)L - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSEe - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1o - ELSEt - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROMG - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1R - END IFA - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - END IFH - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0)6 - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I). - ELSEE - WRITE(6,'(1X,A)') INPUT(:I)E - END IFA - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1( - IF (EDIT) WRITE(3,'(1X)')E - ELSE. - END = END + 1A - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP - IF (LINE_OFFSET.EQ.1) THEN_ - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2E - END IF) - END IF - END IFD - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1N - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) GO TO 200 - R - WRITE(6,'(1X)') - B - IF (READIT.GT.0) WRITE(6,'(1X)')I - END = END + 1 -CF -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -CR - R - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?D - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headE - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IFD - I - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - RETURN - ELSEM - READ_COUNT = BLOCK ! Init bulletin record counter. - END IFC - P - GO TO 200 - N -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF - U - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - _ -200 DISPLAY = 0I - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - I - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN_ - WRITE(3,'(A)') INPUT(:ILEN)O - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THENI - CHAR_OFFSET = 1R - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSEL - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IFD - ELSE, - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTHE - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEND - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)= - CHAR_OFFSET = 0E - ELSEI - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)T - END IF( - END IF) - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE._ - END IFt - END IF - END DOn - _ - CALL CLOSE_BULLFIL ! End of bulletin file read - & - IF (EDIT) THEN. - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counterN - RETURN - END IFN - Q -C. -C Bulletin page is now in temporary memory, so output to terminal.N -C Note that if this is a /READ, the first line will have problems with. -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at theI -C end of the previous page. The output gets confused and thinks it mustS -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -CX - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DOO - R - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counterE - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC)e - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read?E - IF (ILEN.GT.0) THEN ! Yes, there are still moreE - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter' - END IFL - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - - RETURNE - I -1030 FORMAT(' No more messages.')B -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - A -2000 FORMAT(A) - ' - END - , - ) - - & - - L - SUBROUTINE READNEW(REDO) -CW -C SUBROUTINE READNEW -CG -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z)A - N - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - A - INCLUDE 'BULLUSER.INC'I - ) - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'L - ( - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - / - COMMON /POINT/ BULL_POINT - A - COMMON /READ_DISPLAY/ LINE_OFFSET - O - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGE - I - CHARACTER INREAD*1,FILE_DEF*80,NUMREAD*6 - - DATA LEN_FILE_DEF /0/, INREAD/0/I - ) - LOGICAL SLOW,SLOW_TERMINAL' - E - FIRST_MESSAGE = BULL_POINTD - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time: - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - e - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - e -1 WRITE(6,1000) ! Ask if want to read new bulletinsE - N - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THENl - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN( - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DOU - DO I=1,FLONG ! Test for new messages in SYSTEM foldersM - IF (NEW_MSG(I).NE.0) RETURN+ - END DOL - CALL EXIT - ELSEt - WRITE (6,'(''+o'',$)') - END IF0 - RETURN ! If NO, exitC - ! Include QUIT to be consistent with next questionT - ELSE - CALL LIB$ERASE_PAGE(1,1)U - END IF - END IF( - S -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')'), - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 11 - END IF - END IF+ - - READ_COUNT = 0 ! Initialize display pointer( - T -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - FILE_POINT = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed?I - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system' - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10) - END IF - CALL CLOSE_BULLDIR - END IFE - E -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IFF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper caseI - 3 - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directoryE - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE.H - RETURN - ELSE IF (INREAD.EQ.'F') THEN ! If F then copy bulletin to file_ - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line.I - IF (LEN_FILE_DEF.EQ.0) THEN) - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF)1 - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]'o - LEN_FILE_DEF = ILEN + 5 - ELSEe - FILE_DEF = 'SYS$LOGIN:'e - LEN_FILE_DEF = 10 - END IFl - END IF - - LEN_FOLDER = TRIM(FOLDER)t - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THENt - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEFn - END IF - END IF - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - CALL READDIR(FILE_POINT,IER) - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,d - & RECL=LINE_LENGTH,ERR=18,STATUS='UNKNOWN', - & CARRIAGECONTROL='LIST',ACCESS='APPEND') - WRITE(3,1050) DESCRIP ! Output bulletin header info - WRITE(3,1060) FROM,DATE//' '//TIME(:5) - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT)) - END DO - IF (ILEN.EQ.0) WRITE(6,1040) BULL_PARAMETER(:LEN_P) - ! Show name of file created. -18 IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - END IF - CLOSE (UNIT=3) ! Bulletin copy completed - IF (READ_COUNT.GT.0) THEN ! Reposition GET_BULL routine - ILEN = LINE_LENGTH + 1 ! in case read in progressW - DO I=1,LINE_OFFSET ! and partial block was read. - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)( - END DO, - END IF - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - CALL ENABLE_PRIVS ! Reset BYPASS privilegesC - GO TO 12 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THENB - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin( - CALL CLOSE_BULLDIR ! ExitA - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletinsB - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')')l - WRITE (6,'('' Enter message number: '',$)'). - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010)h - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - s -1000 FORMAT(' Read messages? Type N(No),E(Exit),messagee - & number, or any other key for yes: ',$)! -1010 FORMAT(' No more messages.')R -1020 FORMAT(1X,('-'),/,' Type Q(Quit), - & F(File it), D(Dir), R(Read msg #) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit), F(File), N(Next), - & D(Dir), R(Read msg #) or other for MORE: ',$) -1040 FORMAT(' Message written to ',A)o -1050 FORMAT(/,'Description: ',A53) -1060 FORMAT('From: ',A12,' Date: ',A20,/)b - e - END - s - - c - n - SUBROUTINE SET_DEFAULT_EXPIRE -CA -C SUBROUTINE SET_DEFAULT_EXPIRE -CC -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z)( - N - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'e - t - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THENu - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3r - READ (EXPIRE,'(I)') TEMP - I - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)l - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THENo - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')')W - ELSE - FOLDER_BBEXPIRE = TEMP: - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDERU - ELSEM - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - C - RETURNL - END diff --git a/decus/vax91a/bulletin/bulletin10.for b/decus/vax91a/bulletin/bulletin10.for deleted file mode 100644 index 9f98214..0000000 --- a/decus/vax91a/bulletin/bulletin10.for +++ /dev/null @@ -1,2087 +0,0 @@ -C -C BULLETIN10.FOR, Version 4/26/91 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (1) - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - IF (END_LINE.GT.0) THEN - SB = START_READ - IF (END_LINE-2.LE.255) THEN - END_LINE = END_LINE + SB - 1 - EB = END_LINE - 2 - ELSE - EB = SB + 254 - IF (INDEX(BUFFER(SB:EB),' ').GT.0) THEN - DO WHILE (BUFFER(EB:EB).NE.' ') - EB = EB - 1 - END DO - END IF - END_LINE = EB - END IF - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - RETURN - ELSE IF (END_READ-START_READ.EQ.1023) THEN - NEWS_READ = 0 - RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - CALL NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*6 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*255 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (HIGHFROM.EQ.USERNAME.AND.MESSAGE_ID(INDEX(MESSAGE_ID,'@')+1: - & TRIM(MESSAGE_ID)-1).EQ.PATHNAME(:INDEX(PATHNAME,'!')-1)) - & THEN - CALL NEWS_POST('cancel',0,IER,'Delete news item.') - ELSE - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*6 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.'.AND..NOT. - & OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ')+SB-2) - & ,START,,%VAL(1))) RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) RETURN - START = MAX(F_START,START-NUMDIR) - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1.AND..NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - IF (I.EQ.2.AND..NOT.NEWS_WRITEr - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - IF (.NOT.NEWS_READ()) RETURNM - IF (BUFFER(:2).EQ.'22') THEN1 - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1s - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - DO J=SB+INDEX(BUFFER(SB:EB),' '),EBR - IF (ICHAR(BUFFER(J:J)).LT.32) BUFFER(J:J) = ' ' - END DO - TEMP(I*256+1:) = BUFFER(SB+INDEX(BUFFER(SB:EB),' '):EB)A - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP)D - IF (.NOT.NEWS_READ()) RETURN - END DOE - END IFB - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500'' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0E - END = START - 1D - RETURN - END IF - END IFT - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURNN - IER = OTS$CVT_TI_L(BUFFER(SB+4:D - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))R - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN1 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DESCRIP = TEMP(257:512) - CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768)))K - ELSE/ - IER = OTS$CVT_TI_L(BUFFER(SB+4:D - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURNL - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THENM - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURNA - IF (.NOT.NEWS_READ()) RETURNO - IF (BUFFER(:3).NE.'223') THENL - END = I - 1 - IER = 0O - RETURN - END IFF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IFR - END DO - END IFS - P - IF (REMOTE_SET.EQ.3) THEN - IER = 1E - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURNN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF. - . - RETURN( - END - - E - I - INTEGER FUNCTION NEWS_LOGIN - E - IMPLICIT INTEGER (A-Z) - D - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - C - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - C - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (.NOT.NEWS_CONNECTED) THENE - NEWS_LOGIN = .FALSE. - NEWS_CONNECTED = NEWS_CONNECT() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURNS - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - END IFE - - NEWS_LOGIN = .TRUE. - R - RETURNC - END - ( - S - , - D - SUBROUTINE NEWS_HEADER(IER) - 1 - IMPLICIT INTEGER (A-Z)U - , - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EBF - CHARACTER BUFFER*1280 - A - EX_BTIM(1) = 0, - EX_BTIM(2) = 0, - D - DESCRIP = ' ' - FROM = ' 'F - E - DO WHILE (BUFFER(SB:EB).NE.'.') - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THENS - DO I=SB+9,EBT - IF (ICHAR(BUFFER(I:I)).LT.32) BUFFER(I:I) = ' 'L - END DO( - DESCRIP = BUFFER(SB+9:EB) - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THENe - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THENU - CALL GET_FROM(BUFFER(SB+6:EB),EB-SB+1), - END IFT - END IF - END DOC - O - IER = 0 - D - RETURNE - END - T - N - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - L - IMPLICIT INTEGER (A-Z) - L - INCLUDE 'BULLFOLDER.INC'M - , - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - 1 - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*6 NUMBERQ - R - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2H - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 03 - END IFT - R - RETURNT - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z)H - - INCLUDE 'BULLFOLDER.INC' - E - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - M - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - L - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - , - DIMENSION IN_BTIM(2) - O - CHARACTER TIME*20,FIRST*80 - - CHARACTER*6 NUMBER2 - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THENF - I = NEWS_FIND_SUBSCRIBE()N - START = (LAST_NEWS_READ2(2,I).AND.'3FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1E - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)). - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)V - END IF - ELSED - START = -1 - IER = SYS$ASCTIM(,TIME,IN_BTIM,) - CALL DATE_TIME(TIME) - SKIP = 0 - DO WHILE (1) - IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( - & FOLDER_NAME))//' '//TIME)) RETURN - IF (.NOT.NEWS_READ()) RETURNA - IF (BUFFER(:2).EQ.'23') THEND - IF (.NOT.NEWS_READ()) CALL EXIT - DO I=1,SKIP - IF (.NOT.NEWS_READ()) CALL EXITT - END DOA - FIRST = BUFFER(SB:EB) - IF (FIRST.EQ.'.') RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL EXIT - END DO - IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) - & CALL EXIT - IF (.NOT.NEWS_READ()) CALL EXIT - IF (BUFFER(:2).EQ.'22') THEN - IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN - I = F_NBULL + 1 - DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. - & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>'))U - & .OR.I.GT.F_NBULL)) - I = I - 1 - IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURNM - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURNV - END DO - IF (I.GE.F_START) START = I - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END IF - RETURN - END IF - END IFO - SKIP = SKIP + 1 - END DO - END IF - - RETURNL - END - 1 - 1 - Q - SUBROUTINE REMOTE_COPY_BULL(IER)R - : - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - ELSE' - END IF - N - RETURN - END - - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z)' - U - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - . - CHARACTER*(*) OUTPUT& - ' - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IFE - 2 - RETURN) - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -CR -C SUBROUTINE GET_REMOTE_MESSAGE -CW -C FUNCTION: -C Gets remote message. -C. - D - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLDIR.INC' - D - INCLUDE '($RMSDEF)' - T - COMMON /BUFFER/ BUFFER,SB,EBR - CHARACTER BUFFER*1280 - I - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - : - COMMON /REF/ REFERENCES,LREFU - CHARACTER*255 REFERENCESD - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*255 NEWSGROUPS - - CHARACTER*255 TEMP,FROM_LINE,SUBJECT_LINE - - CHARACTER*10 MSGNUM - N - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty?, - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF. - S - IF (REMOTE_SET.EQ.3) THEN - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - E - SUBJECT_LINE = ' ' - FROM_LINE = ' 'N - NEWSGROUPS = ' ' - LREF = 0 - DO WHILE (BUFFER(SB:EB).NE.'.')0 - IER = NEWS_READ() - IF (.NOT.IER) RETURN' - IF (BUFFER(SB:EB).NE.'.') THEN( - IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GT.SB+5) THEN_ - FROM_LINE = 'From: '//BUFFER(SB+6:EB)T - ELSE IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.: - & EB.GT.SB+8) THEN - DO I=SB+9,EB - IF (ICHAR(BUFFER(I:I)).LT.32) BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB+9:EB) - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND.D - & EB.GT.SB+11) THEN+ - NEWSGROUPS = BUFFER(SB+12:EB)S - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEND - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '//E - & REFERENCES(:LREF)H - END IFE - LREF = TRIM(REFERENCES)E - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND.M - & EB.GT.SB+11) THENS - IF (LREF.EQ.0) THENP - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IFE - LREF = TRIM(REFERENCES)( - END IF - END IF) - END DO - S - LSUB = TRIM(SUBJECT_LINE)R - LFRO = TRIM(FROM_LINE) - END IFR - _ - ILEN = 128L - IER = 0 - LENGTH = 0N - LTEMP = 0 - = - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THENM - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUTR - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THENT - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF_ - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - BUFFER = FROM_LINE - SB = 1 - EB = LFRO - LFRO = 0 - IER = 1 - ELSE IF (LSUB.GT.0) THENT - BUFFER = SUBJECT_LINER - SB = 1 - EB = LSUB( - LSUB = 0 - IER = 1 - ELSE. - IF (LSUB.EQ.0) THEN - IF (.NOT.NEWS_WRITE('ARTICLE '//MSGNUM)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THENC - IER = 0 - RETURNC - END IF - LSUB = -1 - END IF - IER = NEWS_READ() - END IFE - IF (IER.AND.BUFFER(SB:EB).NE.'.') THENA - IER = 02 - LTEMP = MIN(255,EB-SB+1) - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - ELSE - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)R - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEND - IER = 0E - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128E - ELSE. - ILEN = 128 - END IFF - ELSEC - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)E - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this errorE - IER = 0 - ILEN = 0B - ELSEN - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTEB - END IF - ELSE IF (ABS(ILEN).EQ.128) THENa - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DOQ - x - RETURNN - END - B - - N - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER)) - - IMPLICIT INTEGER (A-Z)B - . - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - B - RETURN6 - END - B - , - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDERO -CN -C FUNCTION: Connects to folder that is located on other DECNET node.L -CI - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - , - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHQ - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)T - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATEL - A - COMMON /READIT/ READITC - - COMMON /NEWS_INIT/ END_READ - T - INCLUDE 'BULLUSER.INC' - U - INCLUDE 'BULLFOLDER.INC'( - A - INCLUDE 'BULLDIR.INC' - F - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*25 FOLDER_SAVE - - DIMENSION DUMMY(4)O - G - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - END_READ = 0 - IF (.NOT.NEWS_LOGIN()) THEN' - IER = 2 - RETURNA - END IF - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IFN - N - REMOTE_UNIT = 31 - REMOTE_UNIT* - F - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name differentB - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1A - END IFN - F - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - S - IF (IER.EQ.0) THENF - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1N - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIRO - REMOTE_SET = REMOTE_SET_SAVEE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IFI - END IF - IF (.NOT.SYSLOG) THEN_ - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNERX - FOLDER_BBOARD_SAVE = FOLDER1_BBOARDN - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER) - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSEF - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IFU - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE) - FOLDER1_NUMBER = FOLDER_NUMBER_SAVES - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IFU - R - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP processI - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)E - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED) - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSERH - END IFR - END IF - IER = 2I - ELSEU - CLOSE (UNIT=31-REMOTE_UNIT)R -C -C If remote folder has returned a last read time for the folder,O -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time.U -C' - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1)B - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) - LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) - IF (SYSLOG) THENN - LAST_SYS_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(3) - LAST_SYS_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(4) - END IFT - END IF - IER = 0e - END IF, - - RETURN_ - END - C - 1 - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - s - IMPLICIT INTEGER (A-Z)U - C - INCLUDE 'BULLDIR.INC' - _ - INCLUDE 'BULLFOLDER.INC'e - o - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - S - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EBN - CHARACTER BUFFER*1280 - ' - COMMON /MSGID/ MESSAGE_ID - CHARACTER*255 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./R - - COMMON /NEWGROUP/ NEWGROUP. - T - CHARACTER*6 NUMBERU - R - CHARACTER IN_BTIM(2)D - . - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN: - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNTA - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEYI - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN0 - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THENF - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURN - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBINR - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1I - RETURN= - ELSE IF (ICOUNT.EQ.-1) THEN - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITA - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN= - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURNB - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER))L - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITE - END IF - IF (BUFFER(:2).NE.'22') THEND - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1A - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXITS - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') NEXT = .FALSE. - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THENI - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXITF - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITY - IF (BUFFER(:3).NE.'223') RETURN= - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITS - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURNN - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1))S - IF (.NOT.IER) RETURNR - START = ICOUNTN - BULLETIN_NUM = STARTM - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) - IER = 0, - CALL NEWS_HEADER(IER)N - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBINI - END IF - BLOCK = START - MSG_NUM = STARTR - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IFA - S - RETURNS - END - I - T - 2 - - M - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - C - IMPLICIT INTEGER (A-Z) - R - INTEGER BTIM(2)O - N - CHARACTER*8 MSG_KEY,INPUTU - S - INPUT = MSG_KEY - E - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1))_ - E - RETURN - END - V - - - SUBROUTINE NEWS_GROUP(IER) - L - IMPLICIT INTEGER (A-Z)R - 1 - INCLUDE 'BULLFOLDER.INC'D - 0 - COMMON /BUFFER/ BUFFER,SB,EBE - CHARACTER BUFFER*1280 - R - COMMON /NEWGROUP/ NEWGROUPN - _ - IER = NEWS_WRITE('GROUP '//FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP))) - IF (.NOT.IER) RETURNE - N - IER = NEWS_READ() - IF (.NOT.IER) RETURNU - * - IF (BUFFER(:3).EQ.'411') THEN - CALL OPEN_BULLNEWS_SHAREDI - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - IF (IER1.EQ.0) DELETE (7)S - CALL CLOSE_BULLFOLDER - RETURNN - END IF - - NEWGROUP = .TRUE. - I - BUFFER = BUFFER(5:) - N - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_END,,%VAL(1))D - IF (.NOT.IER) RETURN) - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1))= - IF (.NOT.IER) RETURN( - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - S - IER = 0 - - RETURNT - END - E - E - T - SUBROUTINE NEWS_TIME(INTIME,BTIM) - L - IMPLICIT INTEGER (A-Z)F - E - CHARACTER*(*) INTIMEL - R - CHARACTER*20 TIME - F - I = 1 - LTIME = TRIM(INTIME)( - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR.1 - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DOI - ) - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IFS - - CALL STR$UPCASE(TIME,INTIME(I:))F - - DO J = 1,2S - I = 1 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-'E - END DOO - R - IF (I.EQ.LEN(TIME)) RETURNN - - IF (TIME(I+3:I+3).EQ.' ') THENM - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IFM - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DOU - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) RETURNE - CALL SYS_BINTIM(TIME(:I-2),BTIM)_ - A - RETURN - ENDU - R - F - E - SUBROUTINE NEWS_LISTD - _ - IMPLICIT INTEGER (A-Z) - E - INCLUDE 'BULLFOLDER.INC'R - O - COMMON /BUFFER/ BUFFER,SB,EBE - CHARACTER BUFFER*1280 - - IF (.NOT.NEWS_LOGIN()) RETURN - 0 - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - I - CALL OPEN_BULLNEWS_SHARED ! Open folder file& - - NEWS_FOLDER1_BBOARD = '::'B - S - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_END = 1001 - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMU - END IF) - IF (NEWS_F1_END.LT.1001) NEWS_F1_END = 1001 - NEWS_F_END = NEWS_F1_ENDL - LAST_READ = NEWS_FOLDER1_NUMBER - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1u - NEWS_FOLDER1 = BUFFER(SB:MIN(25,FLEN)+SB-1) - IF (IER1.EQ.0) THENe - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER)d - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)). - SP = EP + 2) - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (FLEN.GT.25) THENR - NEWS_FOLDER1_DESCRIP = BUFFER(SB+25:FLEN+SB-1) - ELSE - NEWS_FOLDER1_DESCRIP = ' ' - END IF - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER))s - READ (7,KEY=NEWS_F_END,KEYID=1,IOSTAT=IER)_ - END DO - IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1 - END DOI - NEWS_FOLDER1_NUMBER = NEWS_F_ENDS - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1 - ELSE IF (F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL) THENR - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - DO I = LAST_READ+1,NEXT_READ-1D - DO WHILE (REC_LOCK(IER)) ! Delete non-existant - READ (7,KEY=I,KEYID=1,IOSTAT=IER) ! newsgroupsN - END DO - IF (IER.EQ.0) DELETE (UNIT=7) - END DOI - LAST_READ = NEXT_READ - END IF - END DOO - . - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)I - NEWS_F1_END = NEWS_F_ENDE - REWRITE (7) NEWS_FOLDER1_COM. - - CALL CLOSE_BULLNEWS - A - RETURN_ - ENDO - T - R - SUBROUTINE LOWERCASE(INPUT) - F - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DOD - E - RETURN, - END - S - = - ) - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - F - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLNEWS.INC'I - I - INCLUDE 'BULLFOLDER.INC'L - O - INCLUDE 'BULLUSER.INC' - E - COMMON /BUFFER/ BUFFER,SB,EBM - CHARACTER BUFFER*1280 - ( - COMMON /REF/ REFERENCES,LREF( - CHARACTER*255 REFERENCESN - L - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAMEI - I - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - B - COMMON /MSGID/ MESSAGE_ID - CHARACTER*255 MESSAGE_ID( - B - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS) - CHARACTER*255 NEWSGROUPS - - CHARACTER*(*) FILENAME,SUBJECTR - A - CHARACTER TODAY*23,MSGID*23,ZONE*5,GROUPS*255 - . - DIMENSION NOW(2),GMT(2) - - IER = 1 - T - IF (FILENAME.NE.'cancel') THENN - IF (.NOT.FILEOPEN) THEN( - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1)T - IF (IER1.NE.0) RETURN - END IF - C - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900F - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3)T - END IFU - N - IF (.NOT.NEWS_LOGIN()) GO TO 900N - N - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (.NOT.NEWS_WRITE('POST')) GO TO 900T - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900C - END IF_ - R - IF (REMOTE_SET.GE.3) THEN - IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THENE - GROUPS = 'Newsgroups: '//NEWSGROUPS - ELSE IF (REMOTE_SET.EQ.4) THEN - GROUPS = 'Newsgroups: '//FOLDER1_DESCRIPL - ELSE - GROUPS = 'Newsgroups: '//FOLDER_DESCRIP - END IF - IF (FILENAME.NE.'cancel') THEN - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0A - DO WHILE (CLI$GET_VALUE('GROUPS',FOLDER1_NAME,FLEN) - & .AND.TRIM(GROUPS)+FLEN+1.LE.LEN(GROUPS)) - CALL LOWERCASE(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1)O - IF (IER1.EQ.0) GROUPS = GROUPS(:TRIM(GROUPS))//X - & ','//FOLDER1_NAME(:TRIM(FOLDER1_NAME))( - END DOL - CALL CLOSE_BULLNEWS - END IFF - END IF - IF (.NOT.NEWS_WRITE(GROUPS(:TRIM(GROUPS)))) GO TO 900R - END IF2 - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(:LPATH))) GO TO 900) - IF (.NOT.NEWS_WRITE('From: '//PATHNAME(INDEX(PATHNAME,'!')+1: - & TRIM(PATHNAME))//'@'//PATHNAME(:INDEX(PATHNAME,'!')-1))) - & GO TO 900T - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT))))) - & GO TO 900O - , - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF)))R - & GO TO 900 - END IFA - . - CALL SYS$ASCTIM(,TODAY(:23),,)U - R - IF (LZONE.EQ.0) THEN) - IF (SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',ZONE)) THEN - IER = OTS$CVT_TI_L(ZONE(:TRIM(ZONE)),DIFF,,%VAL(1)) - IF (DIFF.LT.0) THEN - PAST = .TRUE. - ZONE = ZONE(2:)T - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF+ - IER = OTS$CVT_L_TI(DIFF,ZONE(1:2),,,)D - IF (ZONE(1:1).EQ.' ') ZONE = ZONE(2:) - ELSEU - PAST = .FALSE. - END IF - IER = SYS_BINTIM('0 '//ZONE(:TRIM(ZONE))//':00',GMT)N - IER = SYS$GETTIM(NOW) - IF (PAST) THENG - IER = LIB$ADDX(NOW,GMT,GMT)I - ELSE - IER = LIB$SUBX(NOW,GMT,GMT) - END IFV - IER = SYS$ASCTIM(,TODAY,GMT,) - ZONE = 'GMT' - ELSE IF (.NOT.SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE)R - & .AND..NOT.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - ZONE = 'GMT' - END IF - LZONE = TRIM(ZONE) - END IFN - _ - MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'//) - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (MSGID(1:1).EQ.' ') MSGID = MSGID(2:)H - IF (.NOT.NEWS_WRITE('Message-ID: <'//MSGID(:TRIM(MSGID))//_ - & '@'//PATHNAME(:INDEX(PATHNAME,'!')-1)//'>')) GO TO 900L - O - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - R - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION)F - END IF - LORGAN = TRIM(ORGANIZATION) - END IF. - ) - IF (LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN)))' - & GO TO 900A - END IFI - . - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//S - & ZONE(:LZONE))) GO TO 900 - E - IF (FILENAME.EQ.'cancel') THENE - IF (.NOT.NEWS_WRITE('Control: cancel ' - & //MESSAGE_ID(:TRIM(MESSAGE_ID)))) RETURN - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).EQ.'240') IER = 0 - RETURN - END IFC - ( - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - - IER1 = 0) - DO WHILE (IER1.EQ.0)N - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2( - END IF - IF (IER1.EQ.0.AND..NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900I - END DOE - E - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') IER = 0' - . -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - ) - RETURNE - END - T - - I - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLUSER.INC'E - I - COMMON /PATH/ PATHNAME,LPATHE - CHARACTER*132 PATHNAME - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN. - IF (.NOT.SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME).AND. - & .NOT.SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME).AND.P - & .NOT.SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME)) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')')E - RETURNU - END IF - END IFS - - PATHNAME = PATHNAME(:TRIM(PATHNAME))//'!' - & //USERNAME(:TRIM(USERNAME)) - CALL LOWERCASE(PATHNAME)H - LPATH = TRIM(PATHNAME) - - RETURND - END - D - ' - B - S - SUBROUTINE NEWS2BULLE - Y - IMPLICIT INTEGER (A-Z) - R - INCLUDE 'BULLFOLDER.INC'E - = - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BUFFER/ BUFFER,SB,EBN - CHARACTER BUFFER*1280 - - EXTERNAL BULLETIN_SUBCOMMANDS - N - CHARACTER TIME*20,FIRST*80,FOLDER_SAVE*25 - D - CHARACTER*6 NUMBERR - D - DIMENSION SAVE_F_NEWEST_BTIM(2) - ) - CALL ALLPRIVL - = - CALL NEWS_LIST) - ' - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - , - FOLDER_Q = FOLDER_Q1E - E - CALL OPEN_BULLFOLDER_SHARED ! Get folder fileT - ( - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF ((INDEX(FOLDER_DESCRIP,'@').LE.SLIST.OR. - & FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@').AND. - & INDEX(FOLDER_DESCRIP,'.').GT.SLIST) THEN. - NUM_FOLDERS = NUM_FOLDERS + 1D - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)F - END IF - END IFI - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymoreC - E - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXITT - R - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0_ - FILEOPEN = .FALSE.1 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)B - IF (.NOT.FILEOPEN) THENE - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - SAVE_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1)( - SAVE_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2)T - FOLDER_SAVE = FOLDERH - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (FOLDER_DESCRIP(1:1).EQ.'@'.AND.IER) THEND - OPEN (UNIT=3,FILE=FOLDER_DESCRIP(2:TRIM(FOLDER_DESCRIP)) - & ,STATUS='OLD',IOSTAT=IER1)W - IF (IER1.EQ.0) THEN - READ (3,'(A)',IOSTAT=IER1) FOLDER_DESCRIP - IF (IER1.NE.0) CLOSE (UNIT=3)O - IF (IER1.EQ.0) FILEOPEN = .TRUE.D - END IFN - ELSE( - IER1 = 0 - END IF. - END IF - IF (IER.AND.IER1.EQ.0) THENP - FOLDER_NUMBER = -1A - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL REMOTE_GET_NEWEST_MSG(SAVE_F_NEWEST_BTIM,START) - IF (START.GE.F_START) THEN - CALL OTS$CVT_L_TI(START,NUMBER,,,)F - INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM(E - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)C - CALL MOVE(.FALSE.) - END IF - END IFO - IF (FILEOPEN) THENA - READ (3,'(A)',IOSTAT=IER1) FOLDER_DESCRIPO - IF (IER1.NE.0) CLOSE (UNIT=3) - IF (IER1.NE.0) FILEOPEN = .FALSE.O - END IFA - END IF - END DOJ - R - CALL EXIT - END - Y - , - I - SUBROUTINE DATE_TIME(TIME)D - N - IMPLICIT INTEGER (A-Z)I - = - CHARACTER*36 MONTH. - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - O - CHARACTER*(*) TIMEN - , - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - . - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+ - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)//. - & TIME(16:17)//TIME(19:20) - I - RETURN3 - END - I - - - SUBROUTINE ALLPRIV) - O - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - O - PROCPRIV(1) = -1. - PROCPRIV(2) = -19 - NEEDPRIV(1) = -1. - NEEDPRIV(2) = -1 - T - RETURN - END - s - g - t - SUBROUTINE NEWS_NEW_FOLDERC - E - IMPLICIT INTEGER (A-Z)E - E - INCLUDE 'BULLFOLDER.INC'G - P - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COMw - o - NEWS_FOLDER1 = FOLDER1L - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - w - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_END,KEYID=1) - IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1' - END DO - C - NEWS_FOLDER1_NUMBER = NEWS_F_END - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)C - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM& - . - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_END = NEWS_F_END) - REWRITE (7) NEWS_FOLDER1_COME - M - RETURN - END - O - R - A - SUBROUTINE SUBSCRIBE - ( - IMPLICIT INTEGER (A-Z)S - R - INCLUDE 'BULLUSER.INC'' - / - INCLUDE 'BULLFOLDER.INC'N - ) - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - I - IF (REMOTE_SET.NE.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')')E - RETURN - END IFT - M - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX) - I = I + 1H - END DO- - ) - IF (I.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')')F - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE= - WRITE (6,'('' You are now subscribed to '',A,''.'')')D - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IFZ - ( - LAST_NEWS_READ2(1,I) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THENF - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-(F_START-1)) - LAST_NEWS_READ(2,I) = F_START - 1 - ELSES - LAST_NEWS_READ2(2,I) = 0 - LAST_NEWS_READ(2,I) = F_NBULLN - END IF/ - E - RETURNN - END - ' - T - - SUBROUTINE UNSUBSCRIBEO - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'T - T - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSEN - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - G - DO J=I,FOLDER_MAX-1 - LAST_NEWS_READ(1,J) = LAST_NEWS_READ(1,J+1)/ - LAST_NEWS_READ(2,J) = LAST_NEWS_READ(2,J+1)G - END DOQ - ' - LAST_NEWS_READ(1,FOLDER_MAX) = 0S - LAST_NEWS_READ(2,FOLDER_MAX) = 0( - I - RETURN - END - ' - / - H - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - L - IMPLICIT INTEGER (A-Z)/ - / - INCLUDE 'BULLUSER.INC'0 - ) - INCLUDE 'BULLFOLDER.INC'O - - I = NEWS_FIND_SUBSCRIBE() - Q - IER = LAST_NEWS_READ(2,I) + 1 - N - IF (I.GT.FOLDER_MAX.OR.IER.GT.F_NBULL) THEN - IER = 0M - RETURN - END IFI - , - RETURNI - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z)F - N - INCLUDE 'BULLUSER.INC'o - ' - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - I - IF (I.GT.FOLDER_MAX) RETURN - Y - IF (NUMBER.GT.LAST_NEWS_READ(2,I)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)) - END IF - - RETURNN - END - ( - ) - E - N - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG): - E - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLUSER.INC'E - W - IF (SUBNUM.EQ.0) THEN - COUNT = 0D - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - LAST_NEWS_READ(1,J) = LAST_NEWS_READ(1,J+1) - LAST_NEWS_READ(2,J) = LAST_NEWS_READ(2,J+1) - END DO - D - LAST_NEWS_READ(1,FOLDER_MAX) = 0 - LAST_NEWS_READ(2,FOLDER_MAX) = 0 - ELSEI - COUNT = COUNT + 1 - END IF - - IF (COUNT.LE.FOLDER_MAX) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT)T - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSEA - SUBNUM = 0 - END IF - Z - RETURNI - END - U - S - I - E - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES)T -C1 -C SUBROUTINE NEW_NOTIFICATION -CN - ( - IMPLICIT INTEGER (A-Z) - F - INCLUDE 'BULLFOLDER.INC'R - E - INCLUDE 'BULLUSER.INC'D - - COMMON /READIT/ READITM - S - COMMON /POINT/ BULL_POINT - M - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)E - M - MESSAGES = .FALSE.) - H - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - ' - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - IF (MSGNUM.EQ.0) RETURN - A - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1N - ( - DO WHILE (SUBNUM.GT.0)O - IER = 1A - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)R - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)E - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THENA - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START) - ELSE IF (IER.NE.0) THEN8 - SUBNUM = -1D - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0) THENB - IER = 1L - END IF - END IFL - IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN_ - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND.l - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR.H - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR.I - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (DIFF.GT.0) IER = 1& - END IF - END IFI - END IF) - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THENC - WRITE (6,'('' There are new messages in folder '', - & A,''.'',$)') FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP)) - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A,''.'',$)') FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP)) - ELSEL - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN) - CALL LOGIN_FOLDERI - IF (BULL_POINT.NE.-1) THENE - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THENE - SAVE_BULL_POINT = BULL_POINTR - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORYT - BULL_POINT = SAVE_BULL_POINTO - END DOI - END IFP - END IF - END IF' - CALL OPEN_BULLNEWS_SHARED - END IF - END IF - END DOI - A - CALL CLOSE_BULLNEWS - - RETURNE - END - C - E - N - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)P - = - IMPLICIT INTEGER (A-Z) - E - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX) THEN) - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IFI - T - I = NEWS_FIND_SUBSCRIBE() - L - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14)N - - RETURNA - END - _ - _ - E - M - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER)G - _ - IMPLICIT INTEGER (A-Z) - L - INCLUDE 'BULLUSER.INC'E - , - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX) THEN_ - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF - C - I = NEWS_FIND_SUBSCRIBE() - N - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15) - - RETURN - END - - - I - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE()) - O - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLUSER.INC'I - ) - INCLUDE 'BULLFOLDER.INC'F - O - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX) - I = I + 1E - END DOI - I - NEWS_FIND_SUBSCRIBE = I - A - RETURNO - END - T - O - / - N - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - T - IMPLICIT INTEGER (A-Z)X - N - INCLUDE 'BULLUSER.INC'I - T - I = NEWS_FIND_SUBSCRIBE() - ' - IF (I.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF' - / - IF (NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY cannot be set for news folder.'')')N - RETURN - END IF - M - IF (READNEW.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - S - RETURNE - END diff --git a/decus/vax91a/bulletin/bulletin2.for b/decus/vax91a/bulletin/bulletin2.for deleted file mode 100644 index 780ba48..0000000 --- a/decus/vax91a/bulletin/bulletin2.for +++ /dev/null @@ -1,2020 +0,0 @@ -C -C BULLETIN2.FOR, Version 3/20/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23,RESPONSE*1 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*11,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2)0 - END IFP - o - IF (REMOTE_SET) THENs - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURNo - END IF - END IFg - A - CALL GET_UPTIME(UPDATE,UPTIME)b - o - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - e - IF (NODE_AREA.EQ.0) THENp - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zeroI - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1I - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0D - END IF) - E - IF (IER.NE.0) THEN_ - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG( - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION,R - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - I - CALL READ_PERME - B - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - I - RETURNC - END - E - ) - E - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - O - IMPLICIT INTEGER (A-Z) - C - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlistB - ) - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C& -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0,( -C so set it to 1 as a dummy value to cause messages to be deleted.F -CE - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - 0 - RETURNC - END - F - E - I - T - SUBROUTINE SET_NODE(NODE_SET) -CF -C SUBROUTINE SET_NODE -CR -C FUNCTION: Set or reset remote node specification for selected folder. -C' - IMPLICIT INTEGER (A-Z): - c - INCLUDE 'BULLFOLDER.INC'' - - INCLUDE 'BULLUSER.INC'L - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,FOLDER_SAVE*25 - n - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - T - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder namee - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')')r - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER)L - CALL CLOSE_BULLFOLDER - RETURNE - END IF - CALL CLOSE_BULLFOLDERE - END IF= - P - IF (FOLDER_NUMBER.EQ.0) THENE - WRITE (6,'('' Cannot set remote node for GENERAL folder.'')')E - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN( - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE.B - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//E - & FOLDERS - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder nameE - REMOTE_SET = REMOTE_SET_SAVE: - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')')A - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE.R - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '//) - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): '). - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURNT - END IFO - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IFb - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSEL - WRITE (6,'('' Folder has been converted to remote.'')')' - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SETB - REMOTE_SET = .FALSE.) - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin fileP - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*'R - END IF_ - REMOTE_SET = REMOTE_SET_SAVES - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::'m - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,L - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"')r - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0I - CLOSE (UNIT=17) - END IFI - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULLR - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1)M - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2)A - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1)U - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMITU - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE - CALL CLOSE_BULLFOLDERD - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')')& - END IFE - O - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//O - & FOLDER - END IFA - ) - RETURNL - END - T - O - S - N - SUBROUTINE RESPOND(STATUS)E -CN -C SUBROUTINE RESPONDE -C' -C FUNCTION: Sends a mail message in reply to a posted message.E -CM -C NOTE: Modify the last SPAWN statement to specify the commandH -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands.D -C, - IMPLICIT INTEGER (A - Z)E - D - COMMON /POINT/ BULL_POINT - = - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - R - COMMON /EDIT/ EDIT_DEFAULTL - DATA EDIT_DEFAULT/.FALSE./O - _ - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'( - 1 - CHARACTER FROM_TEST*5,INFROM*(LINE_LENGTH). - 0 - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - 1 - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPLY') THEN8 - BULL_PARAMETER = 'mailing list.' - IF (CLI$PRESENT('ALL')) THEN - BULL_PARAMETER = 'message owner and mailing list.'R - MSG_OWN = .TRUE.C - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEND - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.'H - IF (CLI$PRESENT('LIST')) - & BULL_PARAMETER = 'message owner and mailing list.') - ELSET - BULL_PARAMETER = 'mailing list.' - END IF - R - WRITE (6,'('' Sending message to '',A)')T - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))1 - . - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - P - CALL OPEN_BULLDIR_SHARED - A - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')')O - CALL CLOSE_BULLDIR ! If not, then error outM - RETURN) - END IF - W - CALL CLOSE_BULLDIR - - CALL STR$UPCASE(BULL_PARAMETER,DESCRIP)M - IF (BULL_PARAMETER(:3).NE.'RE:') THEN - BULL_PARAMETER = 'RE: '//DESCRIPz - ELSE - BULL_PARAMETER = 'RE:'//DESCRIP(4:) - END IF - END IFG - - IF (CLI$PRESENT('SUBJECT')) THENN - IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P) - IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')'), - RETURNO - END IF - ELSE IF (INCMD(:4).EQ.'POST') THENA - WRITE(6,'('' Enter subject of message:'')')E - CALL GET_LINE(BULL_PARAMETER,LEN_P)R - IF (LEN_P.LE.0) THEN - LEN_P = 0 - WRITE(6,'('' ERROR: No subject specified.'')'). - RETURN) - END IF - ELSER - WRITE (6,'('' Message will have the subject:'')')N - WRITE (6,'(1X,A)') BULL_PARAMETERI - END IFE - A - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN_ - EDIT = .TRUE._ - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSEU - EDIT = .FALSE. - END IFY - T - TEXT = CLI$PRESENT('EXTRACT') - ) - LIST = CLI$PRESENT('LIST')G - Y - CALL DISABLE_PRIVSn - c - ILEN = 0& - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY,l - & SHARED,IOSTAT=IER,FORM='FORMATTED') - IF (IER.NE.0) FILESPEC = .FALSE. - END IFE - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,t - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')I - I - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900D - END IFE - T - LENFRO = 0 - IF (CLI$GET_VALUE('CC',INPUT,ILEN)) THENE - CALL ADD_PROTOCOL(INPUT,ILEN) - INFROM = INPUT(:ILEN)D - LENFRO = ILEN - IF (MSG_OWN) THENS - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - END IF. - 0 - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THENE - CALL ENABLE_PRIVSH - CALL OPEN_BULLFIL_SHARED - i - ILEN = LINE_LENGTH + 1 - I - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN), - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENN - ILEN = TRIM(INPUT) - IF (EDIT.AND.TEXT) THEN - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(7:ILEN)//' wrote:'L - END IFE - IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(INPUT(7:),ILEN)n - INFROM = INFROM(:LENFRO)//INPUT(7:)E - LENFRO = LENFRO + ILEN - 6 - END IFa - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROMD - LENFRO = TRIM(FROM) + LENFROR - END IF - = - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IFL - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THENE - WRITE (3,'(A)') INPUT(:ILEN)E - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)L - END DOE - - IF (FILESPEC) THENC - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - N - CLOSE (UNIT=3) ! Bulletin copy completed) - END IF - T - CALL CLOSE_BULLFIL - CALL DISABLE_PRIVS - END IFT - M - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0D - ICOUNT = 0 - DO WHILE (IER.EQ.0)E - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN)E - ICOUNT = ICOUNT + 1 - END IFT - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THENo - CLOSE (UNIT=3,STATUS='DELETE')L - ELSE - CLOSE (UNIT=3)h - END IF - END IFr - t - IF (LIST.AND.REMOTE_SET.NE.3) THENE - SLIST = INDEX(FOLDER_DESCRIP,'<')D - IF (SLIST.GT.0) THEN - IF (REMOTE_SET.NE.4) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)L - INPUT = INPUT(:ILEN)f - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1I - END IFa - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSEE - FOLDER1_DESCRIP = E - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1)+ - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900L - END IFO - END IFl - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')')' - GO TO 900 - END IF - END IF) - H - I = 1 ! Must change all " to "" in FROM fieldI - DO WHILE (I.LE.LENFRO)L - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:)I - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1I - END DO) - , - LEN_P = TRIM(BULL_PARAMETER)E - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - IF (LEN_P.EQ.64) THEN - BULL_PARAMETER(I:I) = '`' - ELSET - BULL_PARAMETER = BULL_PARAMETER(:I)//'"'W - & //BULL_PARAMETER(I+1:) - I = I + 1 - LEN_P = LEN_P + 1 - END IFF - END IF - I = I + 1P - END DO - 1 - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')A - CONTEXT = 0_ - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT) THEN - VERSION = INDEX(INPUT,';') + 1I - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSEM - IER = 0 - END IFB - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME)S - IF (REMOTE_SET.GE.3.AND.LIST) THENN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & BULL_PARAMETER) - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')')a - END IF - END IF - IF (IER.EQ.0.AND.LENFRO.GT.0) THENd - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM(:LENFRO),C - & BULL_PARAMETER(:LEN_P),STATUS) - END IFT - END IF - ELSER - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,D - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')C - IF (.NOT.FILESPEC) THENO - WRITE (6,'('' Enter message: End with ctrl-z,'',U - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counterG - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too longg - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredS - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch filen - END IF - END DO, - ELSE - IER = 0 - ICOUNT = 0U - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUTN - IF (IER.EQ.0) THEN. - ICOUNT = ICOUNT + 1s - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DOs - CLOSE (UNIT=4)R - FILESPEC = .FALSE.F - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF (REMOTE_SET.GE.3.AND.LIST) THENL - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & BULL_PARAMETER)E - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSEN - IER = 0 - END IF_ - CLOSE (UNIT=3)C - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN: - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM(:LENFRO), - & BULL_PARAMETER(:LEN_P),STATUS) - END IFR - END IF - END IFF - IF (IER.NE.0) WRITE (6,'('' ERROR: No message added.'')') - O -900 CALL ENABLE_PRIVSc - IF (FILESPEC) CLOSE (UNIT=4)O - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')E - - RETURN( - END - t - s - e - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -CR -C SUBROUTINE ADD_SIGNATURE -C -C FUNCTION: Adds signature to message being mailed/posted.' -C. - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FOLDER_NAME - g - CHARACTER*128 BULL_SIGNATURE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/I - ( - CHARACTER*255 INPUT - I - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - D - IF (IER.NE.0) THENL - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY,A - & SHARED,IOSTAT=IER,FORM='FORMATTED')) - END IFS - - IF (IER.NE.0) RETURNY - C - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED')H - END IFP - ( - ICOUNT = 0N - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUTD - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME)))L - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT). - IF (.NOT.MATCH) THENS - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUTH - ILEN = TRIM(INPUT)o - END DOe - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IFV - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE. - ELSET - ICOUNT = ICOUNT + 1E - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' '. - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN)T - END IFE - END IF - END DOL - E - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURNB - END - B - K - N - , - LOGICAL FUNCTION STREQ(INPUT,INPUT1)U - 6 - IMPLICIT INTEGER (A-Z) - I - CHARACTER*(*) INPUT,INPUT1 - I - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - e - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.DIFF.NE.32) RETURN - END DOL - n - STREQ = .TRUE.M - I - RETURNN - END - U - : - - - - E - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -C_ -C SUBROUTINE RESPOND_MAIL -CE -C FUNCTION: Sends mail to address. -CL - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'/ - O - INCLUDE 'BULLFOLDER.INC'O - + - CHARACTER*(*) FILE,SENDTO,SUBJECT - A - CHARACTER MAILER*128I - I - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - L - IF (LISTSERV) THENL - CALL SETUSER(FOLDER_BBOARD)L - IF (SYS_TRNLNM('MX_NODE_NAME',MAILER)) THENt - REPLY_TO = .NOT.SYS_TRNLNM('MX_REPLY_TO',MAILER) - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - REPLY_TO = .NOT.SYS_TRNLNM('PMDF_REPLY_TO',MAILER)N - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - END IF - END IF - - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))//O - & ' SYS$LOGIN:BULL.SCR "'//SENDTO//'" "'//SUBJECT - & //'" '//USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IFE - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' SYS$LOGIN:BULL.SCR "'//SENDTO//= - & '" "'//SUBJECT//'"',,,,,,STATUS) - END IF - ELSEP - CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//SENDTO// - & '"/SUBJECT="'//SUBJECT//'"',,,,,,STATUS) - END IF. - T - IF (LISTSERV) THENN - CALL SETUSER(USERNAME) - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('PMDF_REPLY_TO')L - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('MX_REPLY_TO')S - END IFD - - RETURNS - END - H - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -CE -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -CI - IMPLICIT INTEGER (A-Z): - N - CHARACTER*(*) USERNAMEO - O - CALL OPEN_SYSUAF_SHARED - ( - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - H - CALL CLOSE_SYSUAF - O - RETURN) - END - - - F - = - N - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACEL -CR -C FUNCTION: CHANGE command subroutine.R -C - IMPLICIT INTEGER (A - Z)E - D - COMMON /POINT/ BULL_POINT - C - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTR - u - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - ) - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - E - INCLUDE 'BULLDIR.INC' - I - INCLUDE 'BULLUSER.INC' - r - INCLUDE 'BULLFOLDER.INC'n - l - CHARACTER INEXDATE*11,INEXTIME*11 - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH) - CHARACTER*1 ANSWERI - D - CHARACTER DATE_SAVE*11,TIME_SAVE*11 - I - INTEGER TIMADR(2) - I - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL*1 DOALL - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')')T - RETURN - END IFc - g -Cl -C Get the bulletin number to be replaced. -C_ - - ALL = CLI$PRESENT('ALL'). - ' - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THENU - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entryX - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSEI - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')')R - RETURN - END IF - A - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IFS - ALL = .TRUE.T - ELSE IF (CLI$PRESENT('ALL')) THENI - SBULL = 1 - EBULL = NBULL - END IF - END IFH - A - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')')) - RETURNE - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THENh - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN( - END IF - END IFu - i - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')')G - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN= - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE.I - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'',. - & '' permitted for remote folder.'')') - RETURN - END IF - END IFD - s - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IFL -C) -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -CE - Q - CALL OPEN_BULLDIR_SHAREDs - e - SAME_OWNER = .TRUE. - DO I=SBULL,EBULLR - CALL READDIR(I,IER) ! Get info for specified messagesR - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. L - END DOI - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIRM - R - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner?S - WRITE(6,1090) ! If not, then error out.N - RETURNB - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit - END IF - END IFO - -CI -C If no switches were given, replace the full bulletinS -CE - O - DOALL = .FALSE. - T - TEXT = CLI$PRESENT('TEXT')L - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND.N - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.TEXT).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IFU - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THENH - WRITE (6,'('' ERROR: Cannot change text when replacing'',R - & '' more than one messsage.'')')) - RETURN - END IFA - I - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THENN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER)T - PERMANENT = BTEST(SYSTEM,1) - IF (.NOT.IER) GO TO 910R - INEXDATE = INPUT(:11)P - INEXTIME = INPUT(13:)N - END IF - E -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THENT - WRITE(6,1050) ! Request header for bulletinA - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IFE - N - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIPD - LENDES = MIN(LENDES+6,LEN(INDESCRIP))N - END IF1 - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - R - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find messageF - CALL CLOSE_BULLDIRN - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')') - & NUMBER_PARAME - WRITE(6,'('' All messages up to that message were modified.'')')E - RETURNS - END IF - END IF - L - REC1 = 0 - E - LENFROM = 0 - C - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')) - . - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)X - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - E - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - S - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)M - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENT - INFROM = INPUT(:ILEN) - LENFROM = ILENI - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENN - IF (LENDES.EQ.0.AND..NOT.DOALL) THENE - INDESCRIP = INPUT(:ILEN)N - LENDES = ILEN - END IFH - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN)E - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - W - CALL CLOSE_BULLFIL - ) - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - = - IF (TEXT.OR.DOALL) THENE -C/ -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.E -C" - S - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1_ - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)_ - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THENe - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specifiedN - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW',I - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST')P - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)T - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN' - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into fileR - WRITE (3,'(A)') INPUT(:ILEN)C - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IFb - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')O - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1')e - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',R - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')I - ELSE IF (LEN_P.GT.0) THENr - CALL DISABLE_PRIVSL - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',N - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - + - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesR - : - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950y - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with. - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1O - END IFd - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long.. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH( - ELSE IF (ILEN.GT.0) THEN ! If good input line enteredR - ICOUNT = ICOUNT + 1 + ILEN ! Increment character countR - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THENb - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outM - ENDIF - - END IF - I -CL -C Add bulletin to bulletin file and directory entry for to directory file.E -CL - _ - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIPR - : - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - u - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it.n - IF (IER.NE.NUMBER_PARAM+1) DATE = ' 'E - NUMBER_PARAM = 0 - IER = 1E - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE')9 - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')')e - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')')R - END IFu - GO TO 100 - END IF - END IF - END IF - o - CALL READDIR(0,IER) ! Get directory header - I - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin' - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - R - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THENN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3). - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.'g - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - R - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVEL - T - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER)T - R - CALL CLOSE_BULLFIL - Y - IF (.NOT.REMOTE_SET) THENT - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry: - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE) - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - G - IF (.NOT.REMOTE_SET) THEN' - d - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:59) ! Update description headerS - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT,U - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THENF - SYSTEM = IBSET(SYSTEM,0)R - ELSE IF (CLI$PRESENT('GENERAL')) THENM - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER)E - ELSE - MSGTYPE = 0, - IF (CLI$PRESENT('SYSTEM').OR.& - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THENs - MSGTYPE = IBSET(MSGTYPE,0)T - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THENC - MSGTYPE = IBSET(MSGTYPE,1)L - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2)L - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL)' - & .AND..NOT.PERMANENT) THENC - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP_ - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER)T - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:59),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COME - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IFU - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO) - - CALL CLOSE_BULLDIR ! Totally finished with replace - L - CLOSE (UNIT=3) - _ -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - A -910 WRITE(6,1010)) - CLOSE (UNIT=3,ERR=100)C - GOTO 100) - -920 WRITE(6,1020)E - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100o - n -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)h - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.')P -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')N -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.',% - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A)f - - END - . - . - $ - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME)L - R - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - & - EXTERNAL CLI$_ABSENTF - A - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - B - CHARACTER TODAY*23,INEXDATE*11,INEXTIME*11 - L - IF (EXPIRE) THEN1 - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIMEL - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in) - NEWEST_EXTIME = EXTIME ! the directory fileG - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THENe - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2)S - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN, - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000'T - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THENA - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THENN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'',n - & '' Invalid node name specified.'')') - END IFd - END IFI - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBERi - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11o - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//O - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1k - CALL SYS$ASCTIM(,TODAY,,) ! Get the present timeI - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IFS - , - RETURN - END - D - O - ' - E - SUBROUTINE SEARCH(READ_COUNT) -CT -C SUBROUTINE SEARCH -CR -C FUNCTION: Search for bulletin with specified string -C0 - IMPLICIT INTEGER (A - Z)t - o - COMMON /POINT/ BULL_POINT - G - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*132 SEARCH_STRING - I - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specifiedE - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IFm - - IER1 = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN)c - c - CALL GET_SEARCH(FOUND,SEARCH_STRING,START_BULL, - & CLI$PRESENT('REVERSE'),CLI$PRESENT('SUBJECT'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'))2 - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - WRITE (6,'('' No messages found with given search string.'')') - ELSE IF (FOUND.EQ.-2) THEN - WRITE (6,'('' ERROR: No more messages.'')')b - END IFi - a - RETURNo - END - f - t - i - t - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,START_BULL,REVERSE, - & SUBJECT,REPLY,FILES,START) -C -C SUBROUTINE GET_SEARCH -C! -C FUNCTION: Search for bulletin with specified string -CR - IMPLICIT INTEGER (A - Z)u - - INCLUDE 'BULLDIR.INC' - O - CHARACTER*(*) SEARCH_STRING - - COMMON /CTRLC_FLAG/ FLAGP - N - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - E - COMMON /NEXT/ NEXT0 - - CHARACTER*53 DESCRIP1 - E - FOUND = -1A - + - CALL DISABLE_CTRL - E - CALL DECLARE_CTRLC_ASTT - _ - IF (TRIM(SEARCH_STRING).EQ.0) THENM - IER1 = .FALSE. - ELSE1 - IER1 = .TRUE.I - END IFP - M - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string enteredO - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURNB - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - END IFr - a - IF (FILES) CALL OPEN_BULLDIR_SHARED - r - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - IF (IER1) THEN ! If string entered - IF (SUBJECT) THENO - SEARCH_MODE = 3 - ELSE - SEARCH_MODE = 2 - END IF - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3C - ELSE IF (REPLY) THENN - CALL READDIR(START_BULL,IER) - IF (START_BULL+1.NE.IER) THENC - WRITE (6,'('' ERROR: No message being read.'')')F - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLl - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - END IFT - B - SAVE_STRING = SEARCH_STRING - SEARCH_LEN = TRIM(SAVE_STRING)R - T - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - ( - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.P - & REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN K - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last_ - END IF - IF (REVERSE) THENT - END_BULL = 1d - STEP_BULL = -1R - ELSE - END_BULL = NBULLR - STEP_BULL = 1 - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR.O - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR& - CALL CANCEL_CTRLC_ASTN - CALL ENABLE_CTRL - RETURN - END IFE - ) - IF (FILES) CALL OPEN_BULLFIL_SHARED - - SAVE_BULL_SEARCH = 0T - DO BULL_SEARCH = START_BULL+1, END_BULL, STEP_BULL - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THENF - CALL STR$UPCASE(DESCRIP1,DESCRIP) ! Make upper case - IF ((SEARCH_MODE.EQ.3.AND. - & INDEX(DESCRIP1,SEARCH_STRING(:SEARCH_LEN)).GT.0).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1))) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')')T - GO TO 900 - END IFE - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THENM - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900U - ELSE - CALL GET_REMOTE_MESSAGE(IER)( - IF (IER.GT.0) GO TO 900. - END IF - END IF( - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THENC - FOUND = BULL_SEARCH1 - GO TO 900 - ELSE IF (FLAG.EQ.1) THENT - WRITE (6,'('' Search aborted.'')') - GO TO 900S - END IFl - END DOo - END IF - END DO3 - L -800 FOUND = 0O - ( -900 IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLn - e - RETURN - END - A - ' - - s - SUBROUTINE UNDELETE -C5 -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message.E -CR - IMPLICIT INTEGER (A - Z)f - . - COMMON /POINT/ BULL_POINT - l - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - p - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - a - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'i - o - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENTn - o - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')')X - RETURN - END IFT -CN -C Get the bulletin number to be undeleted.I -CU - ' - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?X - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I)M - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error.A - ELSE( - BULL_DELETE = BULL_POINT ! Delete the file we are readingD - END IFP - _ - IF (BULL_DELETE.LE.0) GO TO 920 - I -CL -C Check to see if specified bulletin is present, and if the user= -C is permitted to delete the bulletin.N -CS - X - CALL OPEN_BULLDIR - r - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - M - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?M - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IFT - N - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,S - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner?- - WRITE(6,1040) ! Then error out.N - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?E - WRITE(6,1030) ! If not, then error outN - GOTO 100 - END IFw - END IF - END IF' - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:) - END IF - END IF - E - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration dateI - WRITE (6,'('' Message was undeleted.'')')D - ELSEk - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)p - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSEi - WRITE (6,'('' Message was undeleted.'')')T - END IFG - ELSE - CALL DISCONNECT_REMOTE - END IF - END IFR - T -100 CALL CLOSE_BULLDIR - C -900 RETURN - S -910 WRITE(6,1010)I - GO TO 900 - I -920 WRITE(6,1020)T - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.')A -1020 FORMAT(' ERROR: Specified message number has incorrect format.')L -1030 FORMAT(' ERROR: Specified message was not found.')U -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.')R - , - END - N - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - T - IMPLICIT INTEGER (A - Z)( - V - INCLUDE 'BULLNEWS.INC'C - , - CHARACTER*20 MAIL_PROTOCOL) - R - CHARACTER*(*) INPUT - 2 - DATA LMAIL/0/ - . - IF (LMAIL.EQ.-1) RETURN - U - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - l - IF (LMAIL.EQ.0) THEN. - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN - MAIL_PROTOCOL = MAILERQ - END IF - LMAIL = TRIM(MAIL_PROTOCOL)m - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%', - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1 - RETURNc - END IF - END IFp - f - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"'I - N - IF (ILEN.NE.0) ILEN = ILEN + LMAIL + 2 - M - RETURNC - END diff --git a/decus/vax91a/bulletin/bulletin3.for b/decus/vax91a/bulletin/bulletin3.for deleted file mode 100644 index 7576249..0000000 --- a/decus/vax91a/bulletin/bulletin3.for +++ /dev/null @@ -1,1885 +0,0 @@ -C -C BULLETIN3.FOR, Version 4/27/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*107 DIRLINE - - CHARACTER*11 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*11 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - EXTIME(3:4) = EXTIME(4:5) - READ (EXTIME(1:4),'(I4)') NODE_NUMBER_MSG - EXTIME(9:10) = EXTIME(10:11) - READ (EXTIME(7:10),'(I4)') NODE_AREA_MSG - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.GT.0) NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in.E -C - BULL_POINT = -1 ! Init bulletin pointer - C - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory filee - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THENi - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START. - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM)T - IF (DIFF.GT.0) THENS - START = START + 1 - CALL READDIR(START,IER)G - ELSE ! SYSTEM bulletin was not seenR - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IFL - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIRx - e - RETURNn - END - E - Y - D - SUBROUTINE GET_EXPIRED(EXPDAT,IER)s - - IMPLICIT INTEGER (A-Z)- - 0 - INCLUDE 'BULLUSER.INC'e - e - INCLUDE 'BULLFOLDER.INC'I - = - INCLUDE 'BULLDIR.INC' - e - CHARACTER*23 EXPDAT - CHARACTER*23 TODAYs - n - DIMENSION EXTIME(2),NOW(2)a - - EXTERNAL CLI$_ABSENT- - 6 - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date' - 0 - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - M - PROMPT = .TRUE. - 1 -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE.N - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE0 - IF ((DEFAULT_EXPIRE.GT.F_EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.F_EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THENB - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IFS - IF (BTEST(FOLDER_FLAG,3)) THEN ! NOPROMPT was setu - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expirationI - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IFA - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4)F - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4)D - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF. - WRITE (6,1035)E - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE)E - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00'P - END IF - ILEN = TRIM(EXPDAT)f - END IFn - END IFI - END IF - ELSEl - RETURN - END IFS - . - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IFf - b - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - a - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND.A - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specifiedE - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:)M - END IFM - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return valueT - GO TO 5 ! Re-request date (if prompting)E - END IF0 - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - IF (TIMLEN.EQ.16) THENO - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - END IF - E - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's' - IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND.= - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limit_ - IER = 0 ! Set error for return valueC - GO TO 5 ! Re-request date (if prompting)t - END IFt - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:),TODAY(13:))C - IF (IER.LE.0) THEN ! If expiration date not futureO - WRITE(6,1045) ! tell userl - IER = 0 ! Set error for return valueR - GO TO 5 ! Re-request date (if prompting)e - END IFa - d - IF (PROMPT) THENd - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT))R - END IF - END IF - - IER = 1 - N - RETURNR - ( -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.')v -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.')R -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss')Y -1040 FORMAT(' ERROR: Invalid date format specified.')/ -1045 FORMAT(' ERROR: Specified time has already passed.')e -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.')B - U - END - i - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - ( - IMPLICIT INTEGER (A-Z)T - - INCLUDE '($SSDEF)'s - , - INCLUDE 'BULLUSER.INC'F - _ - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - R - EXTERNAL BULLETIN_SUBCOMMANDS - T - CHARACTER*(*) INFILE,OUTFILE, - t - CHARACTER*80 MAIL_EDIT,OUTE - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*255 SPAWN_COMMAND - - IF (MAIL_EDIT.EQ.' ') THENa - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THENE - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)) - IF (IER.EQ.0) THENL - DO WHILE (REC_LOCK(IER)), - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DOD - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:)D - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IFE - END DO - END IF - END IF1 - END IFI - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT)( - END IFY - I - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IFR - - CALL DISABLE_PRIVSD - CALL DECLARE_CTRLC_ASTL - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (OUT.EQ.INFILE) THENO - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT))E - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND)h - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THENu - CONTEXT = 0O - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (.NOT.IER1) THENe - CALL TPU$EDIT(' ',OUT)A - ELSE - CALL TPU$EDIT(INFILE,OUT) - END IF - IER1 = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - ! TPU does CLI$ stuff which wipes our parsed command lines - ELSEu - CALL EDT$EDIT(INFILE,OUT)h - END IFp - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - r - RETURNe - END - w - l - i - - I - SUBROUTINE CREATE_BULLCPe - n - IMPLICIT INTEGER (A-Z)n - c - INCLUDE '($PRCDEF)' - - INCLUDE '($JPIDEF)' - l - INCLUDE '($SSDEF)'_ - N - INCLUDE '($PQLDEF)' - - INCLUDE '($PRVDEF)' - B - INCLUDE 'BULLFILES.INC' - d - COMMON /REALPROC/ REALPROCPRIV(2) - ! - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - S - EXTERNAL CLI$_ABSENTE - U - DIMENSION IMAGEPRIV(2)T - . - CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15 - L - STRUCTURE /QUOTA_ITMLST/T - BYTE ITEMF - INTEGER VALUER - END STRUCTURE - M - RECORD /QUOTA_ITMLST/ QUOTA(3)I - F - IF (.NOT.SETPRV_PRIV()) THENb - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')')T - CALL EXITR - END IF - - JUST_STOP = CLI$PRESENT('STOP') - , - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')')u - CALL EXITs - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THENT - WRITE (6,'('' ERROR: This new version of BULLETIN'',U - & '' needs to be installed with SYSNAM.'')')_ - CALL EXIT - END IF - END IFD - S - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER - IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXITA - END IF - - WILDCARD = -1I - T - CALL INIT_ITMLST ! Initialize item list$ - ! Now add items to list, - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM))( - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID))p - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = 1R - DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP')I - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.F - END DO - IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,) - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')')O - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')')A - CALL EXITX - END IFU - E - CALL GETIMAGE(IMAGENAME,ILEN) - ( - LEN_B = TRIM(FOLDER_DIRECTORY)I - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C6 -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed thatW -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory andi -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C0 - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST'), - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:'I - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR 'E - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11)F - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionI - X - I = 1 - IER = CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN. - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA' - QUOTA(I).ITEM = PQL$_PGFLQUOTA - QUOTA(I).VALUE = PGFLQUOTA - I = I + 1M - END IFL - IER = CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)I - IF (IER.NE.%LOC(CLI$_ABSENT)) THENI - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - QUOTA(I).ITEM = PQL$_WSEXTENTE - QUOTA(I).VALUE = WSEXTENT - I = I + 1T - END IFR - QUOTA(I).ITEM = PQL$_LISTEND - QUOTA(I).VALUE = 0A - I - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0))I - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))D - END DOT - 1 - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1). - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1)T - END IF - X - IF (.NOT.IER) THENi - CALL SYS_GETMSG(IER) - ELSE! - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'',R - & '' does not exist.'')')3 - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IFR - CALL EXIT - ( - END - i - e - E - I - - - SUBROUTINE FIND_BULLCPF - T - IMPLICIT INTEGER (A-Z)r - e - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - l - IER = SYS_TRNLNM('BULL_BULLCP','DEFINED') - IF (IER) BULLCP = 1 - w - RETURN, - END - ) - - & - X - LOGICAL FUNCTION TEST_BULLCPF - E - IMPLICIT INTEGER (A-Z) - T - COMMON /BCP/ BULLCP - LOGICAL BULLCPe - y - TEST_BULLCP = BULLCP) - 0 - RETURN( - END - , - . - e - y - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z)e - ' - INCLUDE 'BULLFOLDER.INC', - S - INCLUDE 'BULLDIR.INC' - . - INCLUDE 'BULLUSER.INC'' - , - COMMON /BCP/ BULLCP - LOGICAL BULLCPl - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSe - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - d - CHARACTER*23 OLD_TIME,NEW_TIMEi - t - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME)i - - BULLCP = 2 ! Enable process to do BULLCP functionsD - I - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP')I - IF (.NOT.IER) THEN ! Can't create mailbox, so exit.C - CALL SYS_GETMSG(IER) - CALL EXIT2 - END IFR - E - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - A - CALL REGISTER_BULLCPE - D - CALL SET_REMOTE_SYSTEM - A - CALL START_DECNET - C - UPDATEBBOARD = 1C - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = UPDATEBBOARD / 15 - END IFM - E - UPDATENEWS = 4I - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = UPDATENEWS / 15 - END IFI - I - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - D - DO WHILE (1) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - CALL SYS$SETAST(%VAL(1)) - ) - IF (BBOARD_LOOP.EQ.0) CALL BBOARD ! Look for BBOARD messages.E - I - BBOARD_LOOP = BBOARD_LOOP + 1M - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - T - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))Q - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folderM - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messagesA - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Do empty blocku - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! cleanup at 3 a.m.) - IF (NEMPTY.GT.200) THENP - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IFo - CALL SYS$SETAST(%VAL(1))s - END DO - s - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND.B - & NEWS_LOOP.EQ.0) CALL CREATE_PROCESS('BULLCP NEWS')A - CALL SYS$SETAST(%VAL(1)) - - NEWS_LOOP = NEWS_LOOP + 1' - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - _ - IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Cleanup deleted users fromI - & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! data files at 3 a.m.U - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN$ - CALL SYS$SETAST(%VAL(1))V - END IF - A - OLD_TIME = NEW_TIME* - CALL HIBER('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folderu -C which requires killing process. -C& - ' - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER)V - END IFM - CALL SYS$SETAST(%VAL(1))I - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL REGISTER_BULLCP - CALL SYS$SETAST(%VAL(1)) - END DOT - - RETURN - END - - - - S - U - SUBROUTINE SET_REMOTE_SYSTEM_ - P - IMPLICIT INTEGER (A-Z)( - B - INCLUDE 'BULLFOLDER.INC' - D - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - ) - CHARACTER NODENAME*8 - W - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)- - - CALL OPEN_BULLFOLDER_SHARED - l - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL SELECT_FOLDER(.FALSE.,IER1)a - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,' - & BTEST(FOLDER_FLAG,2),NODENAME - END IFS - END IF - END DO, - L - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - RETURNT - END - N - - - L - SUBROUTINE REGISTER_BULLCPL - X - IMPLICIT INTEGER (A-Z)P - H - INCLUDE 'BULLUSER.INC'B - C - INTEGER SHUTDOWN_BTIM(FLONG)' - O - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)( - T - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8A - E - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)O - I - CALL OPEN_BULLUSERP - ( - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGu - END DO - e - IF (IER.NE.0) THENf - DO I=1,FLONG - SYSTEM_FLAG(I) = 0a - SHUTDOWN_FLAG(I) = 0s - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0h - END IFe - b - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)x - t - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I)e - END DO - E - IF (IER.NE.0) THEN_ - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGO - ELSEI - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGW - END IF( - ) - CALL CLOSE_BULLUSER - - RETURN - END - D - C - Y - E - ) - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - $ - IMPLICIT INTEGER (A-Z)D - D - INCLUDE 'BULLUSER.INC'. - ' - INTEGER SHUTDOWN_BTIM(FLONG) - I - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG), - ) - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8( - _ - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)' - L - CALL OPEN_BULLUSERI - I - DO WHILE (REC_LOCK(IER))E - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGD - END DOR - C - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER)N - I - SEEN_FLAG = 0 - DO I=1,FLONG) - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DOS - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - W - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGM - END IFC - D - CALL CLOSE_BULLUSER - I - RETURNH - END - P - U - = - F - = - SUBROUTINE HIBER(MIN) -CB -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes.= -CS - IMPLICIT INTEGER (A-Z)1 - INTEGER TIMADR(2) ! Buffer containing timeL - ! in desired system format.O - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/I - - TIMBUF(6:7) = MIN - E - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - e - RETURNt - END - - N - F - SUBROUTINE WAIT_SEC(PARAM)l -Cc -C SUBROUTINE WAIT_SECp -Ce -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z)C - INTEGER TIMADR(2) ! Buffer containing timeB - ! in desired system format.I - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/1 - DATA WAIT_EF /0/D - ) - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - TIMBUF(9:10) = PARAM - T - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set.A - e - RETURNC - END - L - D - I - , - SUBROUTINE DELETE_EXPIRED - . -CI -C SUBROUTINE DELETE_EXPIRED -CO -C FUNCTION: -CL -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files,L -C they get converted now. The directory file has had it's record sizeM -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed andA -C was replaced with a 128 byte record compressed format). -Ce - d - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'D - C - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'D - B - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - M - CHARACTER UPTIME_DATE*11,UPTIME_TIME*11 - ) - CALL OPEN_BULLDIR_SHARED ! Open directory fileA - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present?R - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls?A - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')D - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked?F - SHUTDOWN = 0A - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1L - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN_ - CALL CLOSE_BULLDIRO - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update% - END IF - ELSE ! If header not there, then first time running BULLETIN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc.T - END IF - CALL CLOSE_BULLDIRE - R - RETURNe - END - d - s - e - - SUBROUTINE BBOARD -CE -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins.u -Ct - a - IMPLICIT INTEGER (A-Z)( - P - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - E - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'N - F - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - S - CHARACTER*11 INEXDATE - CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH),INTO*76W - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX)F - E - DATA SPAWN_EF/0/,HEADER_Q1/0/ - 0 - CALL SYS$SETAST(%VAL(0))E - 0 - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - E - CALL INIT_QUEUE(HEADER_Q1,INPUT)t - a - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1O - $ - CALL OPEN_BULLFOLDER_SHARED ! Get folder fileA - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from filet - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)e - END IF - END DO& - ' - CALL CLOSE_BULLFOLDER ! We don't need file anymoreO - CALL SYS$SETAST(%VAL(1))_ - D - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - C - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - I - NBBOARD_FOLDERS = 0 - : - POINT_FOLDER = 0 - L -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - N - CALL SYS$SETAST(%VAL(0))V - 0 - FOLDER_Q_SAVE = FOLDER_Q - e - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - R - IF (FOLDER_BBOARD.EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - _ - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1( -CB -C The process is set to the BBOARD uic and username in order to createT -C a spawned process that is able to read the BBOARD mail (a real kludge). -CM - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - R - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic0 - END IFt - - LEN_B = TRIM(BBOARD_DIRECTORY)E - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errorsS - D - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THENT - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)/ - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THENT - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)')D - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL'A - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE'_ - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'READ/NEW' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)A - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSEB - CONTEXT = 0D - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THENM - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))i - CALL SYS$SETAST(%VAL(0))) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THENN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//P - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF), - CALL SYS$SETAST(%VAL(1))E - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0))O - END IF - END IFB - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM)p - o - NBULL = F_NBULL - I - CALL SETACC(ACCOUNT_SAVE) ! Reset to original accountt - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - : - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD( - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1))t - o -5 CALL SYS$SETAST(%VAL(0)) - n - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM)! - f - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username: - ELSE IF (INPUT(:5).EQ.'Subj:') THENI - INDESCRIP = INPUT(7:) ! Store subjectU - ELSE IF (INPUT(:3).EQ.'To:') THENI - INTO = INPUT(5:) ! Store address, - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - T - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO)E - FLEN = TRIM(FOLDER1_BBOARD) - HEADER_Q = 0x - IF (.NOT.DETECT_BBOARD(INTO,FOLDER1_BBOARD(:FLEN))) THENl - HEADER_Q = HEADER_Q1 - IER = 0e - NHEAD = 0E - CALL STRIP_HEADER(' ',0,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP). - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTn - IF (IER.EQ.0) THENu - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP)l - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - NHEAD = NHEAD + 1 - END IF - END DO - r - FOUND = .FALSE.o - J = 0 - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1U - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS)O - FOLDER_Q2_SAVE = FOLDER_Q2 - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM)_ - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD.NE.'NONE') THEN - IF (J.EQ.1) THENI - F_BBOARD = FOLDER1_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP)( - END IF5 - IF (J.EQ.1.OR.F_BBOARD.NE.FOLDER1_BBOARD) THEN. - FLEN = TRIM(F_BBOARD) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN))N - IF (.NOT.FOUND.AND.NHEAD.GT.1) THENU - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)k - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DO - END IF - END IF - END IFM - END DOE - END DO - IF (FOUND) THEN - FOLDER_COM = FOLDER1_COM) - FOLDER_Q_SAVE = FOLDER_Q2_SAVE - END IF - END IF - e - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - ELSEe - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT)L - NHEAD = NHEAD - 1u - END IFi - e - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0)s - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - L - EFROM = 2 - I = TRIM(INFROM)S - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date$ - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DOT - IF (I.GT.0) INFROM = INFROM(:I) - ( - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER)R - C - ISTART = 0S - NBLANK = 02 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IFN - ELSE - ISTART = 1W - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ')A - END DO - NBLANK = 0E - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTR - ELSE - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)L - & .AND.IER.EQ.0)' - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO% - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE_ - NBLANK = NBLANK + 1 - END IF - END IF - END DOF - E - CALL FINISH_MESSAGE_ADD ! Totally finished with add - F - CALL SYS$SETAST(%VAL(1))E - T - GO TO 5 ! See if there is more mail - T -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input fileE - CALL SYS$SETAST(%VAL(1))F - GO TO 1 - R -900 CALL SYS$SETAST(%VAL(0)) - . - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRLT - FOLDER_SET = .FALSE.s - - IF (NBBOARD_FOLDERS.EQ.0) THENe - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER)a - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM)S - REWRITE (4) USER_HEADER ! Rewrite headerA - CALL CLOSE_BULLUSERr - END IFo - CALL SYS$SETAST(%VAL(1))V - S - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & .NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) CALL NEWS2BULL - CALL SYS$SETAST(%VAL(1))Q - - RETURN - a -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=14)N - CALL CLOSE_BULLFILc - CALL CLOSE_BULLDIRI - WRITE (6,1030)) - GO TO 100 - ) -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.')I -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - ( - END - D - B - R - / - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - e - IMPLICIT INTEGER (A-Z)S - S - CHARACTER*(*) INPUT,BBOARDO - . - DETECT_BBOARD = .TRUE. - m - LEN_BBOARD = LEN(BBOARD) - 1W - $ - DO I=1,TRIM(INPUT)-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND.A - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND.S - & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR.M - & INDEX(' .@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0)) - & RETURN - END DOL - S - DETECT_BBOARD = .FALSE. - O - RETURNe - END - i - t - S - LOGICAL FUNCTION ALPHA(IN)W - O - CHARACTER*1 INU - = - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - O - RETURNW - END - L - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - ' - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIPY - E - BBOARD_NAME = FOLDER_BBOARD - E - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN1 - A - BBOARD_NAME = FOLDER_DESCRIP(I+1:)' - R - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - ' - I = INDEX(BBOARD_NAME,'!')' - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DOT - L - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%')O - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - A - RETURNT - END - 1 - - - ( - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z) - N - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - A - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - ( - CHARACTER*132 IMAGENAME - , - CHARACTER*(*) COMMAND - T - CALL GETIMAGE(IMAGENAME,ILEN) - O - LEN_B = TRIM(BBOARD_DIRECTORY) - D - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE')V - S - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')N - IF (IER.NE.0) RETURNO - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT'I - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()'''L - WRITE(11,'(A)') '$EXIT:'U - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectione - - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',V - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - = - RETURNA - END - , - , - = - SUBROUTINE GETUIC(GRP,MEM)i -C -C SUBROUTINE GETUIC(UIC)( -Ct -C FUNCTION: -C To get UIC of process submitting the job.( -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC( -C. - ' - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($JPIDEF)' - m - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list7 - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist1 - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - : - RETURN) - END - - $ - M - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -CR -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -CB - R - IMPLICIT INTEGER (A-Z)D - Q - INCLUDE '($SYIDEF)' - e - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*23 - E - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - L - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - R - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,)U - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN= - END - - D - Q - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z). - . - INCLUDE 'BULLFOLDER.INC'S - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - Q - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - I - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointerO - R - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERSE - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR.N - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD.NE.'NONE') THEN ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:)E - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IFi - END DO - END IF_ - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE.L - ELSE - NEW_MAIL(I) = .FALSE. - END IFI - ELSE - NEW_MAIL(I) = .TRUE.. - END IF - END DO( - ' - CLOSE (10)= - ) - RETURNT - END - - F - N - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -CI -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN)s -Cp -C FUNCTION: -C To get image name of process.e -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagenameo -Ct - d - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($JPIDEF)' - o - CHARACTER*(*) IMAGNAME= - - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listA - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - L - RETURN - END - - - - D - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START)' - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - S - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - H - DIMENSION IN_BTIM(2), - , - IF (REMOTE_SET) THENN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START)D - ELSEE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START)- - IF (START.EQ.0) THEN - START = -1P - END IF - END IFH - - RETURN - END - N - P - E - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - . - IMPLICIT INTEGER (A-Z)D - 4 - INCLUDE 'BULLDIR.INC' - P - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - N - DIMENSION IN_BTIM(2)N - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURNL - I - CALL OPEN_BULLUSER_SHARED - n - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1U - CALL READDIR(START,IER)t - END DOC - - CALL CLOSE_BULLDIR - - RETURN - END - S - S - S - V - 0 - SUBROUTINE READ_NOTIFY0 - C - IMPLICIT INTEGER (A-Z)D - C - INCLUDE 'BULLFOLDER.INC'( - E - INCLUDE 'BULLUSER.INC'R - C - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - I - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE5 - END DO0 - ' - IF (IER.NE.0) THENE - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0A - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IFT - A - CALL CLOSE_BULLDIRN - B - RETURNS - END diff --git a/decus/vax91a/bulletin/bulletin4.for b/decus/vax91a/bulletin/bulletin4.for deleted file mode 100644 index 7b713ff..0000000 --- a/decus/vax91a/bulletin/bulletin4.for +++ /dev/null @@ -1,1799 +0,0 @@ -C -C BULLETIN4.FOR, Version 4/28/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*23 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2)))n - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DOr - . - CALL CLOSE_BULLINFr - CALL CLOSE_BULLUSER - t - USERNAME = TEMP_USERi - e - RETURNo - END - b - g - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -Ci -C SUBROUTINE COPY_BULL -C- -C FUNCTION: To copy data to the bulletin file. -C -C INPUT:o -C INLUN - Input logical unit numberS -C IBLOCK - Input block number in input file to start ati -C OBLOCK - Output block number in output file to start ati -Cc -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C. -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. Ther -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - A - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - L - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - E - INCLUDE 'BULLDIR.INC' - I - IF (REMOTE_SET) THENG - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXITL - END IFT - T - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DOI - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - D - NBLANK = 0I - LENGTH = 0_ - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUTe - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH)r - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file.S - ILEN = ILEN - 2 - END IFd - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THENS - IF (INPUT(:6).EQ.'From: ') THENe - INPUT(:4) = 'FROM'E - END IF - END IFS - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THENL - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT)Y - END DOU - LENGTH = LENGTH + NBLANK*2n - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DOf - -100 LENGTH = (LENGTH+127)/128T - IF (LENGTH.EQ.0) THEN - IER = 1L - ELSE_ - IER = 0% - END IF_ - L - CALL FLUSH_BULL(OCOUNT) - - RETURNt - END - i - t - i - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT)L - , - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - N - CHARACTER INPUT*(*),OUTPUT*256m - - DATA POINT/0/ - T - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT8 - POINT = ILEN + 1y - ELSE IF (POINT.EQ.BRECLEN-1) THENE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUTT - POINT = ILENU - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)L - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:)i - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN)D - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN)l - POINT = POINT + ILEN + 1 - END IFA - ) - RETURNM - ) - ENTRY FLUSH_BULL(OCOUNT)L - P - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = 0 - O - RETURNV - I - END - R - + - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - n - IMPLICIT INTEGER (A-Z)R - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - P - CHARACTER*(*) OUTPUTU - R - IF (REMOTE_SET) THEN) - CALL REMOTE_WRITE_BULL_FILE(OUTPUT)C - ELSET - WRITE (1'OCOUNT) OUTPUT - END IF - L - RETURN - END - E - U - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z)M - ( - INCLUDE 'BULLDIR.INC' - F - CHARACTER*(*) BUFFERM - ( - COMMON /HEADER/ HEADERM - LOGICAL HEADER /.TRUE./ - T - COMMON /DATE/ DATE_LINE - CHARACTER*(LINE_LENGTH) DATE_LINE - N - IF (ILEN.GT.LINE_LENGTH) THEN ! First read?I - CALL STRIP_HEADER(BUFFER,0,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN)I - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - ELSE ! Else set ILEN to zeroL - ILEN = 0 ! to request next line - END IFC - - IF (MSG_SENT) THENY - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IFS - = - DO WHILE (1)N - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record.u - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records.E - END DO - R - IF (STRIP) THENn - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.OR.BUFFER(:5).EQ.'Subj:') THEND - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE.t - RETURN - ELSEP - BULL_HEADER = .FALSE.Y - END IFI - END IF - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP)H - IF (DATE_LINE.NE.' ') THEN - BUFFER = DATE_LINE_ - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IFH - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - ELSE - RETURN - END IF - END DO_ - R - RETURNH - 1 - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURNE - END - T - N - SUBROUTINE GET_BULL(IBLOCK,BUFFER,ILEN) -CF -C SUBROUTINE GET_BULL -C_ -C FUNCTION: Outputs line from folder file. -C -C INPUT:N -C IBLOCK - Input block number in input file to read from.I -C -C OUTPUT: -C BUFFER - Character string containing output line. -C ILEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -CL -C NOTE: Since message file is stored as a fixed length (128) record file,S -C but message lines are variable, message lines may span one orY -C more record. This routine takes a record and outputs as manyP -C lines as it can from the record. When no more lines can beL -C outputted, it returns ILEN=0 requesting the calling program to -C increment the record counter.N -C( - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - f - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - I - PARAMETER BRECLEN=128 - e - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(LINE_LENGTH) - t - DATA POINT /1/, LEFT_LEN /0/D - B - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers.R - LEFT_LEN = 0 - END IF( - . - IF (POINT.EQ.1) THEN ! Need to read new line? - IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file= - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO. - ELSE IF (REMOTE_SET) THEN ! Remote folder?& - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - ELSE ! Local folder= - DO WHILE (REC_LOCK(IER)) ! Read from fileI - READ (1'IBLOCK,IOSTAT=IER) TEMPD - END DO - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - ILEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine.A - RETURN - END IFH - - IF (IER.GT.0) THEN ! Error in reading file. - ILEN = -1 ! ILEN = -1 signifies error - POINT = 1R - LEFT_LEN = 0 - RETURN - END IFY - M - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - ILEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record.B - BUFFER = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) ! Output line.E - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0- - ELSE ! Rest of line is longer than - LEFT(ILEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - ILEN = 0 ! Request new record read.E - END IF - ELSE ! Else nothing left over.L - ILEN = ICHAR(TEMP(POINT:POINT)) ! Get line lengthP - IF (ILEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover bufferO - LEFT_LEN = ILEN - (BRECLEN-POINT) ! Store leftover length - ILEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (ILEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message.t - ELSE ! Else message line fully readT - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output its - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURNf - - ENTRY TEST_MORE_LINES(ILEN) ! Test for more lines in record.N - ! Returns length of next line.O - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - ILEN = 0 ! record, no more lines. - ELSE ! Else there is another line.T - ILEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length.E - END IFT - D - RETURNO - 1 - END - D - L - ' - ' - - D - I - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -CE -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - I - IMPLICIT INTEGER (A-Z)E - H - INCLUDE 'BULLDIR.INC' - D - INCLUDE 'BULLFOLDER.INC'. - - IF (NBULL.GT.0) THENL - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IFd - - IF (BTEST(FOLDER_FLAG,1)) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER,STATUS='OLD',S - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')E - ELSE - WRITE (3,'(A)') CHAR(12)E - END IF - = - CALL OPEN_BULLFILL - O - ILEN = LINE_LENGTH + 1 - E - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENI - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENO - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - U - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IFE - -900 CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2)C - ( - NEMPTY = NEMPTY + LENGTHU - CALL WRITEDIR(0,IER)U - -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURNB - END - P - T - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -CI -C FUNCTION: Computes expiration date giving number of days to expire.N -C - IMPLICIT INTEGER (A-Z)L - C - CHARACTER*11 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12)B - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP',U - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present dateI - L - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - P - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - E - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE) - LENGTH(2) = 27 - END IF_ - L - NUM_DAYS = NDAYS ! Put number of days into buffer variable - L - DO WHILE (NUM_DAYS.GT.0)S - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN, - ! If expiration date exceeds end of monthU - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month) - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year?I - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27o - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit! - END IF - END DOt - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new dates - - RETURNO - END - - ( - I - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -CI -C SUBROUTINE GET_LINE -C. -C FUNCTION: -C Gets line of input from terminal. -C( -C OUTPUTS:Q -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -CY -C NOTES:I -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST.R -CH - - IMPLICIT INTEGER (A-Z)) - E - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE). - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - R - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/Y - S - EXTERNAL SMG$_EOF - L - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT- - LOGICAL DECNET_PROC - E - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - , - COMMON /CTRLC_FLAG/ FLAGT - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPT - - USE_PROMPT = .FALSE.I - t - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT)U - R - USE_PROMPT = .TRUE. - a -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - e -Ct -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE andi -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1e -Cg - i - CALL DECLARE_CTRLC_AST - e - LEN_INPUT = 0 ! Nothing inputted yet - u -Ce -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line.L -C0 - q - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTI - IF (IER.NE.0) LEN_INPUT = -2 E - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with promptC - ELSED - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompt, - END IF - D - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - N - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT)L - = - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input?E - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of lineE - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DOa - CALL CONVERT_TABS(INPUT,LEN_INPUT)C - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IFE - RETURN - END - - S - F - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT)n - - IMPLICIT INTEGER (A-Z)c - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - u - LIMIT = LEN(INPUT)E - I - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THENn - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMITu - INPUT(I:I) = ' ' - END DOd - LEN_INPUT = LIMIT+1 - END IF - END DO - R - CALL FILTER (INPUT, LEN_INPUT) - N - RETURN+ - END - P - a - SUBROUTINE FILTER (INCHAR, LENGTH)_ - - IMPLICIT INTEGER (A-Z)d - q - CHARACTER*(*) INCHAR - I - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10)))O - & INCHAR(I:I) = '.' - END DOG - R - RETURNN - END - - i - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character valueR - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - q - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routinee - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - t - COMMON /CTRLY/ CTRLY - I - COMMON /CTRLC_FLAG/ FLAGt - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - T - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...')T - CALL SYS$CANEXH()u - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXITd - END IF! - FLAG = 1 ! to set flag - RETURNP - END - R - E - ) - SUBROUTINE DECLARE_CTRLC_ASTn -C -C SUBROUTINE DECLARE_CTRLC_ASTi -C. -C FUNCTION: -C Declares a CTRLC ast.e -C NOTES:N -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -CT - IMPLICIT INTEGER (A-Z)' - ' - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - e - FLAG = 0 ! Init CTRL-C flagU - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - R - RETURN - - ENTRY CANCEL_CTRLC_ASTW - E - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - L - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOI - & CTRLC_ROUTINE,,,,,) ! Enable the AST - H - RETURN - END - T - F - = - D - SUBROUTINE GET_INPUT_NOECHO(DATA) -CL -C SUBROUTINE GET_INPUT_NOECHO -CT -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -CG - IMPLICIT INTEGER (A-Z)B - _ - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN. - ' - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - 7 - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READITC - E - INCLUDE '($TRMDEF)' - E - INTEGER TERMSET(2)) - O - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/L - G - DATA PURGE/.TRUE./' - j - DO I=1,LEN(DATA)W - DATA(I:I) = ' 'I - END DO - E - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),U - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.E - ELSEL - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),T - & TRM$M_TM_NOECHO) - END IFO - U - RETURNS - U - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT)A - C - DO I=1,LEN(DATA)I - DATA(I:I) = ' 'D - END DON - , - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.D - ELSEA - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),A - & TRM$M_TM_NOECHO) - END IF - _ - RETURNI - - ENTRY GET_INPUT_NUM(DATA,NLEN)a - g - DO I=1,LEN(DATA)s - DATA(I:I) = ' 'P - END DOE - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),N - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE.U - ELSE' - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,,, - & TERMSET,NLEN,TERM) - END IF - C - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THENL - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM)e - END IFM - H - RETURN - L - ENTRY ASSIGN_TERMINAL - 4 - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST! - r - FLAG = 2 ! Indicates that a CTRLC will cause an exit - l - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20)M - Y - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID)v - a - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)F - U - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPADS - END IFH - N - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - y - DO I=ICHAR('0'),ICHAR('9')= - MASK(2) = IBCLR(MASK(2),I-32)) - END DOM - H - RETURN+ - END - c - e - m - h - i - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH)o -Cx -C SUBROUTINE GETPAGSIZ! -Cs -C FUNCTION: -C Gets page size of the terminal. -Cr -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -Cr - IMPLICIT INTEGER (A-Z) - L - INCLUDE '($DVIDEF)' - ) - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1)))n - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH))i - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - ! - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,)1 - Y - PAGE_LENGTH = ZEXT(DEVDEPEND(4))T - : - PAGE_WIDTH = MIN(PAGE_WIDTH,132)o - w - RETURN - END - O - E - - - - LOGICAL FUNCTION SLOW_TERMINALN -CP -C FUNCTION SLOW_TERMINAL_ -CE -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less).E -CN -C OUTPUTS:h -C SLOW_TERMINAL = .true. if slow, .false. if not.i -C - - IMPLICIT INTEGER (A-Z)T - I - EXTERNAL IO$_SENSEMODEs - L - COMMON /TERM_CHAN/ TERM_CHANH - T - COMMON CHAR_BUF(2)g - e - LOGICAL*1 IOSB(8) - I - INCLUDE '($TTDEF)') - E - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,)N - ( - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSED - SLOW_TERMINAL = .FALSE. - END IFN - / - RETURN0 - END - / - I - R - Y - SUBROUTINE SHOW_PRIVF -CL -C SUBROUTINE SHOW_PRIV_ -CC -C FUNCTION: -C To show privileges necessary for managing bulletin board._ -C - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC'U - R - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - E - INCLUDE '($SSDEF)' - T - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - E - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT filep - l - CALL READ_USER_FILE_HEADER(IER) - a - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not presentc - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRVl - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')')E - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR.M - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IFp - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IFE - I - CALL CLOSE_BULLUSER ! All finished with BULLUSER, - E - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER)L - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)))u - END IF - L - RETURNT - _ - END - n - - L - A - SUBROUTINE SET_PRIV -CM -C SUBROUTINE SET_PRIV -Ct -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - , - IMPLICIT INTEGER (A-Z)o - e - INCLUDE '($PRVDEF)' - G - INCLUDE 'BULLUSER.INC'L - I - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - S - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA',I - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/A - ! - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - / - DIMENSION ONPRIV(2),OFFPRIV(2)I - - CHARACTER*32 INPUT_PRIV - n - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THENO - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - E - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN)L - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDsa - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER)I - END DO - RETURN - END IFC - ( - OFFPRIV(1) = 0D - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - U - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privilegesT - PRIV_FOUND = -1R - I = 0D - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = It - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN_ - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN) - IF (INPUT_PRIV.EQ.'NOSETPRV') THEND - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')')O - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSES - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)o - END IF/ - ELSE - IF (PRIV_FOUND.LT.32) THENA - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE_ - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DOU - I - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - M - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1))d - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2))( - REWRITE (4) USER_HEADERC - WRITE (6,'('' Privileges successfully modified.'')') - ELSEA - WRITE (6,'('' ERROR: Cannot modify privileges.'')')N - END IFO - T - CALL CLOSE_BULLUSER ! All finished with BULLUSERO - R - RETURN - f - END - n - w - o - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -Ct -C SUBROUTINE ADD_ACLr -Ca -C FUNCTION: Adds ACL to bulletin files. -CT -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.I -C IER - Return error from attempting to set ACL. -CR -C NOTE: The ID must be in the RIGHTS data base. -CF - IMPLICIT INTEGER (A-Z)U - ' - INCLUDE 'BULLFOLDER.INC' - A - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*255,ID*(*),ACCESS*(*)G - Y - INCLUDE '($ACLDEF)' - U - INCLUDE '($SSDEF)'E - . - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,)T - IF (.NOT.IER) THEN& - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER)S - RETURN - END IFO - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,)A - END IFR - END IF - END IFN - IF (.NOT.IER) RETURNE - E - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - E - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)L - RETURN - END IFG - T - FLEN = TRIM(FOLDER1_FILE) - a - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//t - & '.BULLDIR',%VAL(ACL_ITMLST),,,)I - IF (.NOT.IER) RETURN_ - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//A - & '.BULLFIL',%VAL(ACL_ITMLST),,,)Y - IF (.NOT.IER) RETURNF - U - RETURNI - END - ' - P - ) - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C( -C SUBROUTINE DEL_ACL -CL -C FUNCTION: Adds ACL to bulletin files. -C6 -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.S -C IER - Return error from attempting to set ACL. -CS -C NOTE: The ID must be in the RIGHTS data base. -Ci - IMPLICIT INTEGER (A-Z) - O - INCLUDE 'BULLFOLDER.INC' - e - INCLUDE 'BULLFILES.INC' - A - CHARACTER ACLENT*255,ID*(*),ACCESS*(*) - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - V - CALL INIT_ITMLST ! Initialize item listF - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT))o - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist) - ELSE - CALL INIT_ITMLST ! Initialize item listP - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistN - END IFW - R - IF (INDEX(ACCESS,'C').GT.0) THENe - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)f - RETURN - END IF - I - FLEN = TRIM(FOLDER1_FILE) - T - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)// - & '.BULLDIR',%VAL(ACL_ITMLST),,,)I - IF (.NOT.IER) RETURN$ - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//O - & '.BULLFIL',%VAL(ACL_ITMLST),,,), - IF (.NOT.IER) RETURN. - C - RETURN0 - END - - L - T - I - SUBROUTINE CREATE_FOLDERL -CT -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder.H -CP - F - IMPLICIT INTEGER (A-Z)P - _ - INCLUDE 'BULLFOLDER.INC'o - r - INCLUDE 'BULLUSER.INC'n - n - INCLUDE 'BULLFILES.INC' - I - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - ' - IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THENA - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - L - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - e - IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IFR - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR.E - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')')n - RETURN - END IFe - o - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node nameD - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B)X - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)E - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND.M - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURNs - END IF - END IFe - - LENDES = 0, - DO WHILE (LENDES.EQ.0)o - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES)S - ELSE - WRITE (6,'('' Enter one line description of folder.'')')' - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')')S - RETURN, - ELSE IF (LENDES.GT.80) THEN ! If too many charactersE - WRITE(6,'('' ERROR: folder must be < 80 characters.'')')! - LENDES = 0S - END IF - END DO - M - CALL OPEN_BULLFOLDER ! Open folder fileR - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0)( - ! See if folder existsR - _ - IF (IER.EQ.0) THENR - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IFE - I - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN( - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURNI - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'',I - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THENH - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURNF - END IF - ELSEI - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER)) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IFP - END IF - FOLDER_OWNER = FOLDER1_OWNER2 - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present usernameT - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - E - FOLDER_SET = .TRUE. - V - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)F - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)P - ( -CP -C Folder file is placed in the directory FOLDER_DIRECTORY.N -C The file prefix is the name of the folder.P -C_ - N - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910E - ELSEi - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDERI - END IFT - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))R - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,S - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')d - ) - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER)e - CALL SYS_GETMSG(IER) - GO TO 910 - END IFo - S - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,r - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THENr - WRITE(6,'('' ERROR: Cannot create folder message file.'')')r - CALL ERRSNS(IDUMMY,IER). - CALL SYS_GETMSG(IER) - GO TO 910T - END IFs - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THENN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)S - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))E - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1)M - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1)M - IF (.NOT.IER) THEN - WRITE(6,O - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER)R - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1N - END DOL - A - IF (IER.EQ.0) THEN) - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')')X - & FOLDER_MAX. - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910B - ELSE_ - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IFC - T - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0E - NBULL = 0R - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSEE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name?t - REMOTE_SET = .FALSE.S - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER. - END IF - REMOTE_SET = .TRUE.) - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IFI - _ - FOLDER_OWNER = FOLDER1_OWNER - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - A - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0)D - M - CLOSE (UNIT=1) - CLOSE (UNIT=2)e - s - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1F - READNEW = 1S - END IF_ - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - U - WRITE (6,'('' Folder is now set to '',A)')R - & FOLDER(:TRIM(FOLDER))//'.' - L - GO TO 1000E - L -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE')L - CLOSE (UNIT=2,STATUS='DELETE')L - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionI - U - RETURNO - R - END - r - I - U - INTEGER FUNCTION CHKPRO(INPUT)' -CL -C Description:I -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has readI -C access to an object if the object's protection is the ACL.R -C( - IMPLICIT INTEGER (A-Z) - v - CHARACTER ACL*255 - CHARACTER*(*) INPUT - L - INCLUDE '($CHPDEF)' - R - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))//. - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary formatt - IF (.NOT.CHKPRO) RETURN ! Exit if can't. - . - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item listE - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END diff --git a/decus/vax91a/bulletin/bulletin5.for b/decus/vax91a/bulletin/bulletin5.for deleted file mode 100644 index 45b9c26..0000000 --- a/decus/vax91a/bulletin/bulletin5.for +++ /dev/null @@ -1,2051 +0,0 @@ -C -C BULLETIN5.FOR, Version 4/28/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_NEGATED - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot set modify for remote folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - - RETURN - - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (FOLDER_NUMBER.LT.0.AND.NEWS_FOLDER_NUMBER.GT.0) THEN - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*1,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.25) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1 - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & FOLDER1.EQ.'GENERAL') THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IFy - e - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SETe - REMOTE_SET = .FALSE.s - u - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"')O - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folderf - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THENC - CALL OPEN_BULLDIRI - CALL READDIR(0,IER)M - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIRT - END IFL - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folderi - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away responseD - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SETe - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin fileE - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSETL - E - DELETE (7)A - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBERE - CALL SET_FOLDER_DEFAULT(0,0,0)I - FOLDER_NUMBER = TEMP_NUMBER - F - WRITE (6,'('' Folder removed.'')')) - L - IF (FOLDER.EQ.FOLDER1) THEN - FOLDER_SET = .FALSE. - ELSEA - REMOTE_SET = REMOTE_SET_SAVE - END IFF - E -1000 CALL CLOSE_BULLFOLDER - D - RETURN_ - B - END - - ( - SUBROUTINE SELECT_FOLDER(OUTPUT,IER)L -C_ -C SUBROUTINE SELECT_FOLDER -CL -C FUNCTION: Selects the specified folder. -CT -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted.. -C. -C NOTES:- -C FOLDER_NUMBER is used for selecting the folder.E -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not haveL -C a local entry (i.e. specified via NODENAME::FOLDERNAME), thenS -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z)( - E - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - R - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'S - / - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)'L - E - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - E - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - I - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)S - P - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - E - COMMON /TAGS/ BULL_TAG,READ_TAG - C - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM, - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - _ - COMMON /HEADER/ HEADERI - N - EXTERNAL CLI$_ABSENTF - G - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - I - CHARACTER*25 FOLDER1_SAVE - T - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder hasO - DATA FIRST_TIME /FLONG*0/ ! been selected before this.E - - DIMENSION OLD_NEWEST_BTIM(2)& - E - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR.S - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - A - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - P - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THENY - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - E - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IFI - R - REMOTE_TEST = 0 - 2 - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0B - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')& - ELSEE - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')D - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1)H - IF (IER.NE.0) THENC - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')')( - CALL CLOSE_BULLFOLDERB - FOLDER1_SAVE = FOLDER1, - CALL NEWS_LISTi - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - END IFA - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - A - IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THENR - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THENT - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1F - IER = 0U - ELSE IF (INCMD(:2).EQ.'SE') THENF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSET - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER_ - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER)3 - END IF - - IF (REMOTE_TEST.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!!e - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0N - CALL REWRITE_FOLDER_FILE_TEMP) - END IF - END IF - F - CALL CLOSE_BULLFOLDER - END IFT - R - IF ((IER.EQ.0.OR.NEWS).AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allowI - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIPl - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THENR - IF (OUTPUT) THENL - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')')r - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN_ - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IFL - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::"n - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'//L - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET = 1r - ELSE IF (NEWS) THEN/ - REMOTE_SET = 3/ - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDERt - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM)M - F_NBULL = F1_NBULL - F_START = F1_START - CALL REWRITE_FOLDER_FILE - END IFO - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Copy remote folder protection - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0)L - ELSED - LOCAL_FOLDER1_FLAG = IBCLR(LOCAL_FOLDER1_FLAG,0)N - END IF' - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - CALL OPEN_BULLFOLDER ! Update local folder information1 - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COME - CALL REWRITE_FOLDER_FILE= - CALL CLOSE_BULLFOLDER - REMOTE_SET = 1= - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM)I - END IF - END IFM - END IF - END IFL - 1 - IF (IER.EQ.0) THEN ! Folder foundU - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1l - IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::' - & .AND..NOT.SETPRV_PRIV()) THENI - ! Is folder protected and not remote? - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER)_ - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER) THENR - IF (SETPRV_PRIV()) THENe - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')')E - WRITE(6,'('' See '',A,'' if you wish to access folder.'')')' - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR.E - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER)E - CALL CLR2(SET_FLAG,FOLDER1_NUMBER)d - IF (IER.EQ.0) REWRITE (4) USER_ENTRYi - CALL CLOSE_BULLUSER - END IF - IER = 0N - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND. - & IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IFE - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (FOLDER1_BBOARD(:2).NE.'::') THEN - IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE.E - END IF - E - IF (IER) THENU - FOLDER_COM = FOLDER1_COM ! Folder successfully set soE - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THENT - FOLDER_SET = .TRUE. - ELSEM - FOLDER_SET = .FALSE.R - END IFM - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDERL - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIPD - FOLDER_NUMBER = -1 - END IFL - O - IF (REMOTE_SET.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<')S - IF (SLIST.GT.0.AND.O - & FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@') THENI - REMOTE_SET = 4 - ELSE IF (SLIST.GT.0) THEND - I = SLIST + 1* - FLEN = TRIM(FOLDER_DESCRIP) - DO WHILE (I.LE.FLEN) - IF ((FOLDER_DESCRIP(I:I).GE.'a'.AND.N - & FOLDER_DESCRIP(I:I).LE.'z').OR. - & FOLDER_DESCRIP(I:I).EQ.'.') THEN& - I = I + 1 - ELSE IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN - I = FLEN + 1A - ELSEP - I = FLEN + 2. - END IF - END DO - IF (I.EQ.FLEN+1) REMOTE_SET = 4 - END IFG - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND. - & REMOTE_SET.EQ.0.AND.SLIST.GT.0) THENN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')')E - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF( - D - IF (OUTPUT) THEN1 - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - ELSET - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - END IFE - I - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THENS - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN& - WRITE (6,'('' Folder only accessible for reading.'')') - END IF. - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IFS - ELSE& - READ_ONLY = .FALSE. - END IFD - - IF (FOLDER_NUMBER.GT.0) THEND - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THENm - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2))L - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0R - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THENU - CALL UPDATE ! Need to updateE - END IF - ELSE_ - NBULL = 0M - END IF - CALL CLOSE_BULLDIRL - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IFL - END IFF - E - IF (OUTPUT) THEN - IF (FOLDER_NUMBER.GE.0.AND.CLI$PRESENT('MARKED')) THEN - READ_TAG = .TRUE. - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)O - IF (INCMD(:3).NE.'DIR') THENE - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only marked messages'', - & '' will be shown.'')')1 - ELSEI - WRITE(6,'('' ERROR: No marked messages found.'')') - END IFN - END IF - ELSE - READ_TAG = .FALSE.R - END IF - END IF - - IF (REMOTE_SET.EQ.3.AND.OUTPUT) THEN( - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND.. - & REMOTE_SET.NE.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)B - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find itD - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0I - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IFC - END IF - END IF! - IER = 1 - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')')O - CALL SYS_GETMSG(IER)) - END IF - ELSE ! Folder not foundL - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0W - END IFM - - RETURN_ - L - END - U - - - - _ - SUBROUTINE UPDATE_FOLDER -CL -C SUBROUTINE UPDATE_FOLDERE -CI -C FUNCTION: Updates folder info due to new message. -Ct - o - IMPLICIT INTEGER (A-Z)R - = - INCLUDE 'BULLDIR.INC' - e - INCLUDE 'BULLFOLDER.INC'I - B - IF (FOLDER_NUMBER.LT.0) RETURN - o - CALL OPEN_BULLFOLDER_SHARED ! Open folder file( - A - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - E - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)F - E - F_NBULL = NBULL - R - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - a - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message?R - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IFO - R - CALL REWRITE_FOLDER_FILE_ - D - CALL CLOSE_BULLFOLDER - _ - RETURNR - END - R - T - E - SUBROUTINE SHOW_FOLDERP -C_ -C SUBROUTINE SHOW_FOLDERS -CT -C FUNCTION: Shows the information on any folder.A -CO - Y - IMPLICIT INTEGER (A-Z)I - R - INCLUDE 'BULLUSER.INC'N - - INCLUDE 'BULLFOLDER.INC'S - D - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - o - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - D - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - & - INCLUDE '($RMSDEF)' - D - EXTERNAL CLI$_ABSENTI - _ - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & FOLDER1 = FOLDER - - IF (INDEX(FOLDER1,'::').NE.0.OR.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - RETURN - END IFT - A - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileT - H - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//i - & FOLDER1e - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')')I - CALL CLOSE_BULLFOLDERE - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THENN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSEF - WRITE (6,1010) FOLDER1,FOLDER1_OWNER,F - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IFN - i - IF (CLI$PRESENT('FULL')) THEN - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER)R - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THENE - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remoteF - & BTEST(FOLDER1_FLAG,0)) THEN ! and private?L - WRITE (6,'('' Folder is a private folder.'')') - ELSEL - WRITE (6,'('' Folder is not a private folder.'')') - END IFI - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1F - WRITE_ACCESS = 1_ - ELSE. - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',E - & USERNAME,READ_ACCESS,WRITE_ACCESS)L - END IFR - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THENR - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSEF - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '',) - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN). - END IFD - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THENT - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')m - IF (BTEST(GROUPB1,31)) THENg - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IFE - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF( - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRET - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IFI - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IFI - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IFA - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')'). - END IFS - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IFT - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IFI - IF (F1_EXPIRE_LIMIT.GT.0) THEN. - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF! - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM0 - PERM = .FALSE.) - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.T - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THENA - PERM = .TRUE.) - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')')T - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND.L - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')')) - END IF - END IF - ELSEE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.T - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE.I - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')')F - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THENI - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')')E - END IF - END IFi - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IFs - CALL CLOSE_BULLUSER - END IF - END IF - r - CALL CLOSE_BULLFOLDER - E - RETURNU - P -1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12, - & ' Description: ',/,1X,A) -1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12,i - & ' Description: ',/,1X,A) - END - I - ) - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERSF -Ce -C FUNCTION: Display all FOLDER entries. -CM - IMPLICIT INTEGER (A - Z)U - - INCLUDE 'BULLFILES.INC' - A - INCLUDE 'BULLFOLDER.INC'N - P - INCLUDE 'BULLUSER.INC'T - : - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGE - - COMMON /CTRLC_FLAG/ FLAGI - N - DATA SCRATCH_D1/0/L - D - CHARACTER*80 FOLDER_MATCH - R - CHARACTER*17 DATETIME - P - INTEGER*2 MLEN,FLEN - O - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURNL - END IF - ELSEO - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IFE - N - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counterm - NLINE = 1O - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE._ - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IFr - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THENR - WRITE (6,'('' Fetching NEWS groups from remote node.''. - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have''C - & ,'' to be done.'')')_ - CALL CLOSE_BULLFOLDERP - CALL NEWS_LISTN - CALL OPEN_BULLNEWS_SHAREDI - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER)) - END IF' - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE')T - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_END) - SUBNUM = 1E - END IF6 - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THENI - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER) - IF (IER.NE.0) THENR - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER) - FOLDER_COUNT = -1 - RETURNL - END IFE - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN)O - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*'o - MLEN = MLEN + 2 - END IF - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)R - END IF0 - F -CE -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memoryF -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.0 -CT - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1o - r - CALL DECLARE_CTRLC_AST - - NUM_FOLDER = 0o - IER = 0 - IER1 = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THENV - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IFE - END DO& - F1_END = MSGNUM - IF (SUBNUM.EQ.0) IER = 1B - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - END IF - IF (IER.EQ.0) THEN - IF (INDEX(FOLDER1_BBOARD,'::').EQ.0.AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))' - & //FOLDER1 - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',L - & USERNAME,READ_ACCESS,-1)D - ELSE) - READ_ACCESS = 1 - END IFS - IF (READ_ACCESS) THEN - IF (.NOT.MATCH) THEN - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF (STR$MATCH_WILD(FOLDER1 - & (:TRIM(FOLDER1)),FOLDER_MATCH(:MLEN))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) IER1 = 1 - END IF - IF (FLAG.EQ.1) IER1 = 1H - END DOE - - IF (MATCH) MATCH = .FALSE.F - . - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Folder search aborted.'')')U - FOLDER_COUNT = -1B - RETURN - END IFI - ( - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1, - RETURN - END IFf - -Ch -C Folder entries are now in queue. Output queue entries to screen. -C6 - ' - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - t - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSEp - WRITE (6,'(1X,''Folder'',X,( - & ''First Last'',/,1X,(''-''))') - END IFE - F - IF (.NOT.PAGING) THEN - DISPLAY = NUM_FOLDER*NLINE+2 - ELSE - DISPLAY = MIN(NUM_FOLDER*NLINE+2,PAGE_LENGTH-4)N - ! If more entries than page size, truncate output - END IF - I - I = 1 - DO WHILE ((I.LE.(DISPLAY-2)/NLINE.OR.MATCH).AND.FLAG.NE.1)b - IF (.NOT.MATCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM)S - I = I + 1 - END IF - IF (.NOT.NEWS) THENE - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF' - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL, - & FOLDER1_OWNER - ELSEH - WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL, - & FOLDER1_OWNER - END IFB - ELSE - FLEN = MIN(80,PAGE_WIDTH-80+56) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+55)L - IF (F1_START.LE.F1_NBULL) THENE - IF (SUBSCRIBE) THEN - IF (F1_END.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1005) '*'//FOLDER1_DESCRIP(:FLEN-1) - & ,F1_START,F1_NBULLT - ELSE - WRITE (6,1005) ' '//FOLDER1_DESCRIP(:FLEN-1) - & ,F1_START,F1_NBULLB - END IF - ELSEN - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN)I - & ,F1_START,F1_NBULLw - END IFm - ELSE IF (SUBSCRIBE) THEN, - WRITE (6,1005) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),0,0 - END IF - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - IF (MATCH.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) FLAG = 1 - FOUND = .FALSE. - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - CALL READ_FOLDER_FILE_TEMP(IER)T - IF (IER.EQ.0.AND.STR$MATCH_WILD(FOLDER1 - & (:TRIM(FOLDER1)),FOLDER_MATCH(:MLEN))) THEN - FOUND = .TRUE. - END IF - END DO - IF (.NOT.FOUND) FLAG = 1F - END IF - END DON - - IF (MATCH) THEN - CALL CANCEL_CTRLC_AST1 - CALL CLOSE_BULLFOLDER( - END IFA - W - IF (IER.NE.0) THEN ! Outputted all entries? - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - ELSE - WRITE(6,1100) ! Else say there are more - END IFE - , - RETURNN - i -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12)E -1005 FORMAT(1X,A,X,I10,' ',I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/)F - , - END - U - R - SUBROUTINE SET_ACCESS(ACCESS) -Ci -C SUBROUTINE SET_ACCESS -C' -C FUNCTION: Set access on folder for specified ID.) -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -CL - L - IMPLICIT INTEGER (A-Z) - D - INCLUDE 'BULLFOLDER.INC'O - R - INCLUDE 'BULLUSER.INC'F - A - INCLUDE 'BULLFILES.INC' - ' - INCLUDE '($SSDEF)'& - - LOGICAL ACCESS,ALL,READONLY - A - EXTERNAL CLI$_ABSENT2 - - CHARACTER ID*64,RESPONSE*1c - t - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THENR - ALL = .TRUE. - ELSES - ALL = .FALSE._ - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE.E - ELSE- - READONLY = .FALSE. - END IF' - A - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder nameO - P - IF (IER.EQ.%LOC(CLI$_ABSENT)) THENL - FOLDER1 = FOLDER - ELSE IF (LEN.GT.25) THENN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')T - RETURN - END IFI - G - CALL OPEN_BULLFOLDER ! Open folder file) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - R - IF (IER.NE.0) THENs - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THENF - WRITE (6,0 - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSEn - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER1E - CALL CHKACLI - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER)d - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENE - IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,s - & 'Folder is not private. Do you want to make it so? (Y/N): ') - IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THENC - WRITE (6,'('' Folder access was not changed.'')')U - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)S - END IF - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)A - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')')O - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE_ - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF. - ELSEL - CALL DEL_ACL('*','R',IER) - END IFN - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER)E - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN)R - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THENe - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)o - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THENo - WRITE (6,'('' ERROR: Cannot find file '',A)'), - & INPUT(2:ILEN) - RETURN - END IFu - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' 'O - ELSET - FILE_OPEN = .TRUE. - END IF_ - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2. - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1)B - INPUT = INPUT(COMMA+1:)U - ELSE - ID = INPUT - INPUT = ' ' - END IF - ILEN = TRIM(ID) - IF (ID.EQ.FOLDER1_OWNER) THEN( - WRITE (6,'('' ERROR: Cannot modify access'',F - & '' for owner of folder.'')') - ELSE_ - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER)& - ELSE - CALL ADD_ACL(ID,'R+W',IER)1 - END IFR - ELSE' - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN)C - CALL SYS_GETMSG(IER)T - ELSE - WRITE(6,'('' Access modified for '',A,''.'')')H - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IFO - END DO' - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THENd - CALL OPEN_BULLFOLDER ! Open folder file - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP - CALL CLOSE_BULLFOLDER - END IF - END IF6 - ' - RETURNH - = - END - D - - n - SUBROUTINE CHKACL(FILENAME,IERACL)A -CL -C SUBROUTINE CHKACL -Ca -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check.s -C IERACL - Error returned for attempt to open file.p -C - R - IMPLICIT INTEGER (A-Z)A - W - CHARACTER*(*) FILENAME' - s - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - E - CHARACTER*255 ACLENT,ACLSTR - N - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - E - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - F - IF (IERACL.EQ.SS$_ACLEMPTY) THENN - IERACL = SS$_NORMAL.OR.IERACLC - END IFT - D - RETURNC - END - - I - I - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C1 -C FUNCTION: Checks ACL of given file. -CB -C PARAMETERS: -C FILENAME - Name of file to check.1 -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access.1 -C) - ' - IMPLICIT INTEGER (A-Z)L - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - , - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - C - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))L - - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEND - READ_ACCESS = 0. - END IFN - ) - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then ofA - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IFR - _ - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - U - IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THENF - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - END IF - - RETURN - END - e - - - D - SUBROUTINE SHOWACL(FILENAME)t -Ct -C SUBROUTINE SHOWACLT -C, -C FUNCTION: Shows users who are allowed to read private bulletin. -CR -C PARAMETERS: -C FILENAME - Name of file to check.E -C< - IMPLICIT INTEGER (A-Z)0 - - INCLUDE '($ACLDEF)' - ' - CHARACTER*(*) FILENAME' - F - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)): - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - : - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)a - s - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH)S - I - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - $ - RETURN - END - C - A - S - SUBROUTINE FOLDER_FILE_ROUTINES - S - IMPLICIT INTEGER (A-Z)4 - S - CHARACTER*(*) KEY_NAMEI - T - INCLUDE 'BULLFOLDER.INC'' - ' - COMMON /NEWS_OPEN/ NEWS_OPENS - - ENTRY WRITE_FOLDER_FILE(IER) - I - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - D - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENI - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COMF - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DOL - - RETURN - O - ENTRY REWRITE_FOLDER_FILE - N - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSEL - REWRITE (7,IOSTAT=IER) FOLDER_COM - END IFD - L - RETURNK - A - ENTRY REWRITE_FOLDER_FILE_TEMPe - t - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMR - ELSE' - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IF( - T - RETURNC - S - ENTRY READ_FOLDER_FILE(IER) - N - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENe - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COMT - END IF - END DO) - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - F - RETURN( - D - ENTRY READ_FOLDER_FILE_TEMP(IER)F - E - DO WHILE (REC_LOCK(IER))O - IF (NEWS_OPEN) THENA - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DOE - N - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1E - N - RETURN& - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - ? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER. - . - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENa - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COMO - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DOC - * - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - , - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - L - RETURNF - E - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER)l - n - DO WHILE (REC_LOCK(IER))I - IF (NEWS_OPEN) THENe - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - , - RETURN - E - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)E - I - DO WHILE (REC_LOCK(IER))E - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DOA - ( - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1A - N - RETURNO - L - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - P - DO WHILE (REC_LOCK(IER))E - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - R - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1& - - RETURNI - ) - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - I - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM( - END IF - END DO - O - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1M - = - RETURNP - ' - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER)X - P - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - I - RETURN' - R - END - t - d - SUBROUTINE USER_FILE_ROUTINES - f - IMPLICIT INTEGER (A-Z) - E - INCLUDE '($PRVDEF)' - H - INCLUDE '($FORIOSDEF)'E - N - CHARACTER*(*) KEY_NAME - C - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - L - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAMES - - DO WHILE (REC_LOCK(IER))L - READ (4,IOSTAT=IER) USER_ENTRY - END DO - L - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN. - ) - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER)c - s - SAVE_USERNAME = USERNAME' - - DO WHILE (REC_LOCK(IER))Y - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DOd - e - USERNAME = SAVE_USERNAME& - TEMP_USER = KEY_NAMEN - F - RETURNI - - ENTRY READ_USER_FILE_HEADER(IER)F - _ - DO WHILE (REC_LOCK(IER))( - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DOL - E - RETURN_ - E - ENTRY WRITE_USER_FILE_NEW(IER) - L - DO I=1,FLONG_ - SET_FLAG(I) = SET_FLAG_DEF(I)O - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)O - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - - ENTRY WRITE_USER_FILE(IER)L - M - DO WHILE (REC_LOCK(IER))N - WRITE (4,IOSTAT=IER) USER_ENTRY - END DOf - . - RETURNP - M - END - - E - E - N - - SUBROUTINE SET_GENERIC(GENERIC) -Cr -C SUBROUTINE SET_GENERICe -Ci -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days.2 -CA - IMPLICIT INTEGER (A-Z)N - I - INCLUDE 'BULLUSER.INC'i - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - I - IF (.NOT.SETPRV_PRIV()) THENt - WRITE (6,'($ - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IFA - M - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)S - A - IF (IER.EQ.0) THENA - IF (GENERIC) THENN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7'n - END IFe - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSEt - WRITE (6,'('' ERROR: Specified username not found.'')') - END IFI - - CALL CLOSE_BULLUSER - A - RETURNN - END - S - A - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -CC -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -CT - IMPLICIT INTEGER (A-Z)D - , - INCLUDE 'BULLUSER.INC'L - A - CALL OPEN_BULLUSER_SHARED - m - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - C - IF (BRIEF_CONTINUOUS) THENk - NEW_FLAG(2) = -1 - ELSEA - NEW_FLAG(2) = 0C - END IF_ - E - IF (IER.EQ.0) REWRITE (4) USER_ENTRYI - S - CALL CLOSE_BULLUSER - V - RETURNN - END - C - 1 - SUBROUTINE SET_LOGIN(LOGIN) -CA -C SUBROUTINE SET_LOGIN -CF -C FUNCTION: Enables or disables bulletin display at login.E -C) - IMPLICIT INTEGER (A-Z)F - C - INCLUDE 'BULLUSER.INC'D - C - CHARACTER TODAY*23A - S - DIMENSION NOLOGIN_BTIM(2) - E - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - N - IF (.NOT.SETPRV_PRIV()) THENH - WRITE (6,'(c - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - E - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - c - CALL OPEN_BULLUSER_SHARED - I - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)E - E - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)P - IF (IER.EQ.0) THEN1 - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THENE - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSEw - WRITE (6,'('' ERROR: Specified username not found.'')') - END IFE - N - CALL CLOSE_BULLUSER - < - RETURNI - END - - Z - - - C - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - I - IMPLICIT INTEGER (A-Z)i - - CHARACTER USERNAME*(*),ACCOUNT*(*)% - ( - INCLUDE '($UAIDEF)' - T - INTEGER*2 UIC(2)G - a - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT))T - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST)I - A - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - S - USER = UIC(1) - GROUP = UIC(2)S - S - RETURNI - END - - Z - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - C - IMPLICIT INTEGER (A-Z)' - C - INTEGER*4 EXBLK(4)S - E - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1I - EXBLK(4) = %LOC(EXBLK(4)) - O - CALL SYS$DCLEXH(EXBLK(1)) - ( - RETURN - END diff --git a/decus/vax91a/bulletin/bulletin6.for b/decus/vax91a/bulletin/bulletin6.for deleted file mode 100644 index 9c862f5..0000000 --- a/decus/vax91a/bulletin/bulletin6.for +++ /dev/null @@ -1,1699 +0,0 @@ -C -C BULLETIN6.FOR, Version 2/22/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IFB - E - LUN = 0 - s - RETURN9 - END - r - e - o - SUBROUTINE TIMER_ERR(UNIT)l - i - IMPLICIT INTEGER (A-Z) - E - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14)t - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/0 - 9 - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IFa - e - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - N - L - SUBROUTINE OPEN_FILE_SHARED - C - IMPLICIT INTEGER (A-Z)+ - - INCLUDE '($FORIOSDEF)'C - E - INCLUDE 'BULLFILES.INC' - F - INCLUDE 'BULLFOLDER.INC'U - - INCLUDE 'BULLUSER.INC'L - E - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - F - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - N - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1.E -CA - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/L - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/L - L - CHARACTER*25 SAVE_FOLDER! - DATA SAVE_BLOCK/-1/ - B - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/E - U - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - U - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - M - ENTRY OPEN_SYSUAF_SHAREDT - LUN = LUN + 1 ! Unit = 8T - / - ENTRY OPEN_BULLFOLDER_SHAREDE - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED! - LUN = LUN + 2 ! Unit = 4E - Y - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2O - _ - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1Y - F - IER = 0 - + - NTRIES = 0 - - CALL DISABLE_CTRL - D - IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THENT - DO WHILE (FILE_LOCK(IER,IER1)) - i - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,e - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED,READONLY,E - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')I - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0D - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE)E - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THENU - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loopN - CALL CONVERT_BULLFILESE - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS_ - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IFV - _ - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR.E - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCKR - SAVE_FOLDER = FOLDERR - CALL GET_REMOTE_MESSAGE(IER)N - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))L - & //'.BULLFIL',STATUS='OLD',N - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IFR - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IFL - E - IF (LUN.EQ.4) THENI - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN( - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILEY - NTRIES = 0 - END IF= - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IFK - ( - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',R - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - I - IF (IER.EQ.0) THEN - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE)E - IF (ASK_SIZE.NE.FOLDER_RECORD/4) THEN - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE,ASK_SIZE) - NTRIES = 0 - END IF - END IFL - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - E - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',S - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - & - IF (LUN.EQ.8) THENO - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC)E - END DO - END IFB - - IF (LUN.EQ.9) THEN_ - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',g - & RECORDSIZE=FOLDER_MAX*2+3,E - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF6 - : - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - CALL OPEN_FILE(LUN)C - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)'): - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IERL - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IFN - . - LUN = 0 - - RETURN( - END - ( - , - 1 - - SUBROUTINE FOLDER_TO_NEWS - F - IMPLICIT INTEGER (A-Z) - & - INCLUDE 'BULLFOLDER.INC'T - = - NEWS_FOLDER = FOLDERE - NEWS_FOLDER_NUMBER = FOLDER_NUMBERG - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP(26:) - NEWS_FOLDER_BBOARD = FOLDER_BBOARDS - NEWS_F_NBULL = F_NBULL - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1)n - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2)I - - RETURNT - S - ENTRY FOLDER1_TO_NEWS - T - NEWS_FOLDER1 = FOLDER1S - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBERO - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - NEWS_FOLDER1_BBOARD = FOLDER1_BBOARDe - NEWS_F1_NBULL = F1_NBULL' - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1), - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2)E - , - RETURNA - r - ENTRY NEWS_TO_FOLDER - E - FOLDER = NEWS_FOLDERG - FOLDER_NUMBER = NEWS_FOLDER_NUMBERT - FOLDER_DESCRIP = NEWS_FOLDER//NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = NEWS_FOLDER_BBOARD - F_NBULL = NEWS_F_NBULL( - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1)C - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2)y - FOLDER_FLAG = 0 - . - RETURNL - D - ENTRY NEWS_TO_FOLDER1 - . - FOLDER1 = NEWS_FOLDER1T - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER4 - FOLDER1_DESCRIP = NEWS_FOLDER1//NEWS_FOLDER1_DESCRIPf - FOLDER1_BBOARD = NEWS_FOLDER1_BBOARDR - F1_NBULL = NEWS_F1_NBULL - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2)N - FOLDER1_FLAG = 0 - - RETURN' - - END - y - a - l - r - SUBROUTINE CONVERT_BULLDIRS - E - IMPLICIT INTEGER (A-Z)h - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'H - D - INCLUDE 'BULLFILES.INC' - + - CHARACTER BUFFER*115S - ) - WRITE (6,'('' Converting data files to new format. Please wait.'')')I - U - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)N - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))R - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - U - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found.R - L - READ (2'1,IOSTAT=IER1) BUFFER - E - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - 1 - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))E - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,E - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',+ - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - U - IF (IER.NE.0) THENO - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,_ - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')E - END IFN - R - IF (IER1.NE.0) GO TO 800I - ( - CALL SYS_BINTIM(BUFFER(1:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM)D - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - E - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFERO - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1M - DESCRIP = BUFFER(1:). - FROM = BUFFER(54:)L - BULLDIR_ENTRY(78:81) = BUFFER(85:)R - BULLDIR_ENTRY(90:97) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY, - ICOUNT = ICOUNT + 1 - END IF - END DO - L -800 CLOSE (UNIT=9,DISPOSE='KEEP')0 - CLOSE (UNIT=2) - -900 CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - I - RETURN! - o - END - n - u - f - SUBROUTINE CONVERT_BULLFILESB -CD -C SUBROUTINE CONVERT_BULLFILESD -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletinE -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -CA - R - IMPLICIT INTEGER (A-Z)O - , - INCLUDE 'BULLDIR.INC' - N - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLFILES.INC' - L - CHARACTER*81 BUFFER - = - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))W - & //'.BULLDIR',STATUS='OLD',I - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',F - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',O - & SHARED,READONLY,IOSTAT=IER) - O - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - R - OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD',L - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - B - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - T - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - C - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - _ - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')S - K - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8)N - NEMPTY = 0Z - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - D - EXTIME = '00:00:00.00' - ICOUNT = 2N - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCKS - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(1:80)//CHAR(1)R - DO I=2,LENGTH - READ(10,'(A)') BUFFERE - WRITE(1,'(A)') BUFFER - END DOI - CALL WRITEDIR(ICOUNT-1,IER1)U - ICOUNT = ICOUNT + 1 - END IF - END DO - C - CLOSE (UNIT=9)D - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1)N - E - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - RETURNE - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)N -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -CE -C SUBROUTINE CONVERT_BULLFILE -C( -C FUNCTION: Converts bulletin data file to new format file. -CE -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -CE - H - IMPLICIT INTEGER (A-Z)P - L - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC') - E - INCLUDE 'BULLFILES.INC' - E - CHARACTER*80 BUFFER,NEW_FILEL - U - WRITE (6,'('' Converting data files to new format. Please wait.'')')' - - CALL CLOSE_BULLDIRZ - O - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)A - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - CALL OPEN_BULLFOLDERS - C -100 READ (7,FMT=FOLDER_FMT,ERR=200)O - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - = - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL'D - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)( - ( - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - ) - OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))R - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - B - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - Z - IF (IER.EQ.1) THENL - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER)N - NBLOCK = NBLOCK + 1N - SBLOCK = NBLOCKF - DO J=BLOCK,LENGTH+BLOCK-1R - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK)E - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - I - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF= - L - CLOSE (UNIT=10) - CLOSE (UNIT=1)B - ' - CALL CLOSE_BULLDIRM - GOTO 100W - _ -200 CALL OPEN_BULLDIR_SHARED - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - S - END - - L - _ - SUBROUTINE CONVERT_BULLFOLDER(FILENAME,ASK_SIZE)S -CL -C SUBROUTINE CONVERT_BULLFOLDER -CA -C FUNCTION: Converts bulletin folder file to new format.S -CT - IMPLICIT INTEGER (A-Z)M - C - INCLUDE 'BULLDIR.INC' - F - INCLUDE 'BULLFOLDER.INC'L - = - INCLUDE 'BULLFILES.INC' - N - INCLUDE '($SSDEF)'F - E - INCLUDE '($FORIOSDEF)'E - N - CHARACTER*(*) FILENAMEE - - CHARACTER*80 NEW_FILE - D - WRITE (6,'('' Converting data files to new format. Please wait.'')')_ - L - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)W - 1 - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']'))T - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - I - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',A - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DOU - E - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - , - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',R - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE')N - ) - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - S - IF (ASK_SIZE.EQ.173/4) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)= - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPD - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - IF (IER.EQ.0) THEN - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER)) - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_BTIM - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSET - F_NUMBER = 0 - DO WHILE (IER.EQ.0)K - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)( - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPE - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER))_ - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0)O - END IFL - DO WHILE (FILE_LOCK(IER,IER1))8 - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THENK - IDUMMY = FILE_LOCK(IER,IER1)S - CALL CONVERT_BULLDIRS - END IF - END DOR - IF (IER.EQ.FOR$IOS_FILNOTFOU) THENO - F_NEWEST_BTIM(1) = 0S - F_NEWEST_BTIM(2) = 0E - ELSEN - CALL READDIR(0,IER)t - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATEn - NEWEST_TIME = TIMEc - CALL WRITEDIR(0,IER)E - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IFC - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER)i - & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBT - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIMZ - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - A - CLOSE (UNIT=7)A - CLOSE (UNIT=19,STATUS='SAVE') - O - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)= - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE)' - L - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionE - , - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - E - RETURNF - END - _ - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C) -C FUNCTION: Converts user file to new format which has 8 bytes added. -C' - L - IMPLICIT INTEGER (A-Z)= - , - INCLUDE 'BULLFILES.INC' - ' - INCLUDE 'BULLUSER.INC'D - E - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*11 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME/ - B - WRITE (6,'('' Converting data files to new format. Please wait.'')')D - E - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))D - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'N - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - T - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',E - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)): - INQUIRE (UNIT=9,RECORDSIZE=RECL) - R - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')')F - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)R - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFO - ( - IF (IER.EQ.0) THENT - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',1 - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THENN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)h - CALL SYS_GETMSG(IER1) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - CALL ENABLE_CTRL_EXIT - END IFU - ' - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'XL - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0i - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR.R - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50C - IER = 0F - DO WHILE (IER.EQ.0)M - READ (9,'(A)',IOSTAT=IER) BUFFERU - IF (IER.EQ.0) THENS - TEMP_USER = BUFFER(1:12) - LOGIN_DATE = BUFFER(13:23)B - LOGIN_TIME = BUFFER(24:31)( - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))( - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1))X - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,E - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFE - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM,R - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,P - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFO - END DO - END IFE - - IER = 0 - T - CLOSE (UNIT=9)O - CLOSE (UNIT=4)T - : - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionN - E - RETURN - END - U - ' - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR. -C' -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C, -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - E - IMPLICIT INTEGER (A - Z)D - H - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'A - S - COMMON /PROMPT/ COMMAND_PROMPTS - CHARACTER*39 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - ' - COMMON /DIR_POSITION/ DIR_NUM - : - CHARACTER*3 CFOLDER_NUMBER - D - ICOUNT = BULLETIN_NUM - L - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THENL - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADERR - END DOR - IF (IER.EQ.0) THENR - CALL CONVERT_HEADER_FROMBIN - DIR_NUM = 0 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURNR - END IF - IF (IER.EQ.0) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR, - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDERM - END IFR - IF (NEMPTY.EQ.' ') NEMPTY = 0F -CE -C Check to see if cleanup of empty file space is necessary, which is, -C defined here as being 50 blocks (200 128byte records). Also checkL -C to see if cleanup was in progress but didn't properly finish. -CD - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THENR - WRITE (CFOLDER_NUMBER,'(I3)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX(_ - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP')K - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IFI - END IF - ELSE - IF (.NOT.REMOTE_SET) THENN - DO WHILE (REC_LOCK(IER))E - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRYL - IF (MSG_NUM.NE.ICOUNT) IER = 36 - ELSEA - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) BULLDIR_ENTRY - END IFD - END DO - IF (IER.EQ.0) THEN_ - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN, - DIR_NUM = MSG_NUM - ELSET - DIR_NUM = -1A - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURNI - END IF - END IFP - ( - IF (IER.EQ.0) ICOUNT = ICOUNT + 1 - I - UNLOCK 2& - - RETURN. - L - END - U - O - , - M - N - SUBROUTINE READDIR_KEYGE(IER) -CD -C SUBROUTINE READDIR_KEYGEE -CD -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If not 0, no entry found. Else contains message number. -C$ - _ - IMPLICIT INTEGER (A - Z)S - T - INCLUDE 'BULLDIR.INC' - M - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - R - COMMON /DIR_POSITION/ DIR_NUM - - - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) BULLDIR_ENTRYW - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBINM - DIR_NUM = MSG_NUM - ELSE - IER = 0 - DIR_NUM = -1( - END IF - UNLOCK 2 - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - P - RETURN - - END - R - O - , - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z)E - T - INCLUDE 'BULLDIR.INC' - T - CHARACTER*23 DATETIME - _ - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIMEN - NEWEST_EXTIME = DATETIME(13:) - B - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,)R - M - NEWEST_DATE = DATETIME; - NEWEST_TIME = DATETIME(13:) - D - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - E - SHUTDOWN_DATE = DATETIMEE - SHUTDOWN_TIME = DATETIME(13:) - C - RETURN - END - B - D - M - SUBROUTINE CONVERT_ENTRY_FROMBINl - i - IMPLICIT INTEGER (A-Z)_ - S - INCLUDE 'BULLDIR.INC' - - CHARACTER*23 DATETIME - S - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - l - EXDATE = DATETIME - EXTIME = DATETIME(13:) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,)' - L - DATE = DATETIME - TIME = DATETIME(13:) - - RETURNR - END - 4 - W - L - 0 - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -CA -C SUBROUTINE WRITEDIR -C/ -C FUNCTION: Writes the entry for the specified bulletin in thew -C directory file.D -C= -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS:S -C IER - Error status from WRITE. -CR - M - IMPLICIT INTEGER (A - Z)L - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - F - INCLUDE 'BULLDIR.INC' - O - CONV = .TRUE. - O - GO TO 10, - T - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE.R - R -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBINO - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER. - ELSE - IER = -1' - IF (DIR_NUM.EQ.0) THEN_ - REWRITE (2,IOSTAT=IER) BULLDIR_HEADERL - END IF - IF (IER.NE.0) THEN - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THENA - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF. - END IFA - IF (IER.NE.0) THENR - WRITE (2,IOSTAT=IER) BULLDIR_HEADERO - END IF, - END IF - ELSEN - IF (CONV) CALL CONVERT_ENTRY_TOBIN - MSG_NUM = BULLETIN_NUM - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRY= - ELSE - IER = -1C - IF (DIR_NUM.EQ.MSG_NUM) THEN. - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - IF (IER.NE.0) THENI - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRYE - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IFY - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXITR - . - DIR_NUM = -1Q - . - RETURNQ - . - END - - - L - SUBROUTINE CONVERT_HEADER_TOBIN - E - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - 0 - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM)E - ) - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - : - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM)F - ( - RETURN - END - A - I - = - SUBROUTINE CONVERT_ENTRY_TOBIN. - 5 - IMPLICIT INTEGER (A-Z)V - 8 - INCLUDE 'BULLDIR.INC' - ( - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM)L - M - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - V - RETURN( - END - : - N - F - L - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -CO -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file._ -CE -C PARAMETERS: -C FILENAME - Name of file to check.E -C ACLENT - String which will be large enough to hold ACL information.L -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - E - INCLUDE '($ACLDEF)' - , - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*)E - B - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - , - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IERo - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF< - F - DO ACC_TYPE=1,2 - POINT = 1& - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)F - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+1 - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST)s - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(1:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE.r - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THENC - START_ID = INDEX(ACLSTR,'=') + 1t - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THENR - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND.T - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII))U - IF (ACLSTR(START_ID:START_ID).NE.','.AND.N - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE.A - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DO - IF (ASCII) THEN - START_ID = START_ID + 1) - END_ID = END_ID - 1F - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2P - END IF - END IFU - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THENM - IF (ACC_TYPE.EQ.1) THENe - WRITE (6,'(s - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN: - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)F - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE_ - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IFE - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)O - END DOR - R - RETURN - END - = - G - M - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - C - INCLUDE 'BULLUSER.INC'L - N - INCLUDE 'BULLFILES.INC' - R - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))N - E - INQUIRE (UNIT=10,RECORDSIZE=RECL) - e - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')')e - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')f - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF_ - D - RECL = RECL/8 - T - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - N - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)M - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO2 - E - CLOSE (UNIT=10,STATUS='DELETE') - Y - CLOSE (UNIT=9)F - P - RETURN - END - D - R - SUBROUTINE ERROR_AND_EXIT - E - IMPLICIT INTEGER (A-Z)I - N - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)A - CALL ENABLE_CTRL_EXIT - L - RETURNT - END - I - N - S - X - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -CN -C SUBROUTINE COPY_ACL -C) -C FUNCTION: -C Copy ACLs from one file to another fileN -CS - IMPLICIT INTEGER (A-Z)S - I - INCLUDE '($ACLDEF)' - C - CHARACTER*(*) INFILE,OUTFILEW - T - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl outputI - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - A - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - D - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) ! Create character string toE - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of stringT - CALL LIB$FREE_VM(ACLLENGTH+8,ACLSTR)h - n - RETURNh - END - e - u - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -CT -C SUBROUTINE COPY_ACL1r -CS -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routinesU -C since must convert location of string into a character string. -C- - IMPLICIT INTEGER (A-Z)_ - D - INCLUDE '($ACLDEF)' - T - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - E - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,)N - ! Read input file acl' - ) - IF (.NOT.IER) THEND - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENTA - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT))D - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlistT - IER = SYS$CHANGE_ACLE - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - L - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST)A - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first( - END DO - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - T - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output fileE - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:)))O - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DOC - E - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN_ - END diff --git a/decus/vax91a/bulletin/bulletin7.for b/decus/vax91a/bulletin/bulletin7.for deleted file mode 100644 index dd42b18..0000000 --- a/decus/vax91a/bulletin/bulletin7.for +++ /dev/null @@ -1,2042 +0,0 @@ -C -C BULLETIN7.FOR, Version 4/28/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - - BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(1:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_NUMBER.GT.0) THEN ! Folder private? - CALL CHKACL - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - CHARACTER OUTPUT*160,TERMINAL*7,FLAGS*1 - CHARACTER*1 CR/13/,LF/10/,BELL/7/ - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER(1:TRIM(FOLDER)) - & //'. From: '//FROM(1:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(1:TRIM(DESCRIP)) - - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_USER = TEMP_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_USER = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_USER.NE.WRITE_TEMP_USER) - CALL READ_QUEUE(%VAL(READ_TEMP_USER),READ_TEMP_USER, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_USER),WRITE_TEMP_USER, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - CALL CHECK_ACCESS - & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,,,) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(1:11) - NEWEST_TIME = TODAY_TIME(13:) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - NEW_DATE = .TRUE. - - GO TO 10 - - ENTRY NEWS2BULL_ADD_ENTRY - - NEW_DATE = .FALSE. - -10 CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - IF (.NOT.NEW_DATE) THEN - DIFF = COMPARE_DATE(NEWEST_DATE,DATE) - IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_TIME,TIME) - END IF - IF (DIFF.GE.0) NEW_DATE = .TRUE. - END IF - - IF (NEW_DATE) THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(1:11) - TIME = TODAY_TIME(13:) - END IF - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - NBULL = NBULL + 1 - BLOCK = NBLOCK + 1 - NBLOCK = NBLOCK + LENGTH - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - CALL WRITEDIR(NBULL,IER) - - CALL WRITEDIR(0,IER) - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal timeb -Ct - IMPLICIT INTEGER (A - Z) - l - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - n - IF (DIFF(2).LT.0) THEN. - COMPARE_BTIM = -1g - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1o - END IFo - - RETURN - END - - - i - r - a - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -Co -C FUNCTION MINUTE_DIFFt -Ce -C FUNCTION: Finds difference in minutes between 2 binary times. -C -CS - IMPLICIT INTEGER (A-Z)D - L - DIMENSION DATE1(2),DATE2(2) - N - CALL LIB$DAY(DAYS1,DATE1,MSECS1)i - CALL LIB$DAY(DAYS2,DATE2,MSECS2)e - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000E - U - RETURN' - END - C - E - U - S - I - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2)E -C$ -C FUNCTION COMPARE_DATE -CD -C FUCTION: Compares dates to see which is farther in future.V -C) -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -Cm - IMPLICIT INTEGER (A - Z) - g - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2)n - o - CALL SYS_BINTIM(DATE1,USER_TIME)n - e - CALL VERIFY_DATE(USER_TIME) -Cf -C LIB$DAY crashes if date invalid, which happened once due to an unknownt -C hardware or software error which created a date very far in the future. -Ci - CALL LIB$DAY(DAY1,USER_TIME)t - - IF (DATE2.NE.' ') THENt - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSEB - CALL SYS$GETTIM(USER_TIME) - END IF - W - CALL LIB$DAY(DAY2,USER_TIME)W - _ - COMPARE_DATE = DAY1 - DAY2I - I - RETURNT - END - - L - O - SUBROUTINE VERIFY_DATE(BTIM) - ( - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - ' - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - ) - IER = COMPARE_BTIM(BTIM,TEMP) - M - IF (IER.GT.0) THEN ! Date invalidR - BTIM(1) = TEMP(1)s - BTIM(2) = TEMP(2)N - END IFN - A - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - . - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalidF - BTIM(1) = TEMP(1)O - BTIM(2) = TEMP(2)O - END IFR - 2 - RETURN. - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2)? -C -C FUNCTION COMPARE_TIME -CL -C FUCTION: Compares times to see which is farther in future.E -CS -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - C - IMPLICIT INTEGER (A-Z)E - CHARACTER*(*) TIME1,TIME2 - CHARACTER*23 TODAY_TIME - CHARACTER*11 TEMP2t - - IF (TIME2.EQ.' ') THEND - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:)S - ELSES - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1)))N - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10)))e - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN/ - COMPARE_TIME = 1/ - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IFO - E - RETURN - END - -C------------------------------------------------------------------------- -C: -C The following are subroutines to create a linked-list queue for B -C temporary buffer storage of data that is read from files to beb -C outputted to the terminal. This is done so as to be able to closeT -C the file as soon as possible. -CH -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second containsE -C the address. The address is simply the address of the 3rd word ofR -C the record. The last word in the record contains the address of theL -C next record. Every time a record is written, if that record has aQ -C zero link, it adds a new record for the next write operation. M -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA)C - CHARACTER*(*) DATA - INTEGER HEADERE - IF (HEADER.NE.0) RETURN ! Queue already initializedU - LENGTH = LEN(DATA), - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - R - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA)Y - INTEGER RECORD(1) - CHARACTER*(*) DATAD - LENGTH = RECORD(1)% - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXTR - RETURND - END - E - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATAM - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4)O - RETURN( - END - A - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHARI - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - E - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN)' - IMPLICIT INTEGER (A-Z)B - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LENN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0R - RETURNE - END - , - , - T - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges.E -C - $ - IMPLICIT INTEGER (A-Z)E - B - INCLUDE '($PRVDEF)' - D - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - 1 - DATA PRV_DEPTH /0/ - 1 - COMMON /REALPROC/ REALPROCPRIV(2) - E - PRV_DEPTH = PRV_DEPTH + 1 - D - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privilegesD - ) - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1)T - O - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - G - RETURN - END - Y - W - U - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C, -C FUNCTION: Enable image high privileges. -CT - - IMPLICIT INTEGER (A-Z)E - M - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - E - PRV_DEPTH = PRV_DEPTH - 1 - B - IF (PRV_DEPTH.GT.1) RETURN - T - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privsE - H - RETURNI - END - A - D - ( - SUBROUTINE CHECK_PRIV_IO(ERROR) -C) -C SUBROUTINE CHECK_PRIV_IO_ -CE -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C) - E - IMPLICIT INTEGER (A-Z)T - Y - CALL DISABLE_PRIVS ! Disable SYSPRV - I - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - P - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200)M - ERROR = 1, - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0I - END IFN - L - CALL ENABLE_PRIVS ! Enable SYSPRV L - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')A - - RETURNO - END - - E - SUBROUTINE CHANGE_FLAG(CMD,FLAG). -CE -C SUBROUTINE CHANGE_FLAGL -CR -C FUNCTION: Sets flags for specified folder.E -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -Cs - IMPLICIT INTEGER (A - Z) - M - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'u - - INCLUDE 'BULLFOLDER.INC' - f - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - i - DIMENSION FLAGS(FLONG,4)u - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - l - LOGICAL CMD - 1 - DIMENSION READ_BTIM_SAVE(2) - I - DATA CHANGE_FOLDER /.FALSE./I - D - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBERr - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')')A - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR.A - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IFT - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')')- - RETURN - END IFe - l -C -C Find user entry in BULLUSER.DAT to update information.f -Cn - i - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - e - CALL OPEN_BULLUSER_SHARED ! Open user file - s - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2)A - T - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entryT - D - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER)( - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)( - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)B - END IF - NEW_FLAG(1) = 143E - NEW_FLAG(2) = 0$ - CALL WRITE_USER_FILE_NEW(IER)D - ELSEA - IF (CMD) THENT - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)( - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)( - END IF - NEW_FLAG(1) = 1435 - REWRITE (4,IOSTAT=IER) USER_ENTRY= - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IFP - s - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONGE - NOTIFY_REMOTE(I) = 0 - END DOR - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER)N - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IFT - 2 - CALL CLOSE_BULLUSER - I - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE.E - END IFE - C - RETURN( - T - END - 2 - C - A - R - SUBROUTINE SET_VERSIONR -C -C SUBROUTINE SET_VERSION -CT -C FUNCTION: Sets version number.M -C) - IMPLICIT INTEGER (A - Z): - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'M - - INCLUDE 'BULLFOLDER.INC'I - R - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))P - : - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - A -CE -C Find user entry in BULLUSER.DAT to update information.( -CP - : - CALL OPEN_BULLUSER_SHARED ! Open user file - C - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2)( - ) - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entryI - R - IF (IER.EQ.0) THENT - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry( - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IFH - - CALL CLOSE_FILE (4) - RETURNN - F - END - O - E - R - R - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C- -C SUBROUTINE CHECK_NEWUSER -CT -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was.t -C -C INPUTS: -C USERNAME - Usernamet -C OUTPUTS:l -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - r - IMPLICIT INTEGER (A-Z)a - a - CHARACTER*(*) USERNAMEs - o - INTEGER PASSCHANGE(2) - o - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLSTE - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST)d - s - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yept - END IF - END IFt - l - RETURN ! Returnr - END ! Endc - - s - i - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - - IMPLICIT INTEGER (A-Z)- - - - CHARACTER*(*) INPUT,OUTPUT - T - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)), - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlistL - A - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),, - & %VAL(TRNLNM_ITMLST)) - G - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN)O - C - RETURNH - END - L - O - E - D - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT)- - D - IMPLICIT INTEGER (A-Z)D - E - CHARACTER*(*) INPUT,OUTPUT - U - PARAMETER LNM$_STRING = '2'X - L - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))M - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist( - G - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:TRIM(INPUT)),,%VAL(TRNLNM_ITMLST)) - O - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IFA - R - RETURNA - END - I - O - H - INTEGER FUNCTION FILE_LOCK(IER,IER1)E - S - IMPLICIT INTEGER (A-Z)Y - A - INCLUDE '($RMSDEF)' - I - DATA INIT /.TRUE./M - I - IF (INIT) THENR - FILE_LOCK = 1 - INIT = .FALSE. - ELSE) - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THENS - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSEr - FILE_LOCK = 0I - INIT = .TRUE.I - END IFF - ELSE - FILE_LOCK = 0 - IER1 = 0I - INIT = .TRUE. - END IF - END IF - M - RETURNP - END - P - P - ( - SUBROUTINE ENABLE_CTRLD - H - IMPLICIT INTEGER (A-Z)G - ) - COMMON /CTRLY/ CTRLY$ - P - COMMON /CTRL_LEVEL/ LEVEL - i - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - O - COMMON /KEYPAD/ KEYPAD_MODEP - % - QUIT = 1R - ) - ENTRY ENABLE_CTRL_EXITs - G - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0S - IF (QUIT.EQ.1) LEVEL = LEVEL - 1, - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THENe - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IFS - E - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C. - END IF - T - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,)V - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL UPDATE_USERINFO - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IFI - QUIT = 0 ! Reinitialize - I - RETURNV - END - a - - SUBROUTINE DISABLE_CTRL - I - IMPLICIT INTEGER (A-Z)R - A - COMMON /CTRLY/ CTRLYT - S - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/$ - O - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - ( - RETURN) - END - , - ) - - F - SUBROUTINE CLEANUP_BULLFILE -CR -C SUBROUTINE CLEANUP_BULLFILE -C, -C FUNCTION: Searches for empty space in bulletin file and deletes it.a -C - IMPLICIT INTEGER (A - Z), - R - INCLUDE 'BULLFILES.INC' - e - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'' - - CHARACTER FILENAME*132,BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - S -CO -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - G - DO WHILE (REC_LOCK(IER))f - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADERW - END DO - m - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THENC - E - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - O - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for''H - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)), - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE' - CALL SYS_GETMSG(IER1)E - END IF( - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - END IF - H - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - D - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - . - NBLOCK = 0 - E - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER)' - ICOUNT = BLOCK - DO J=1,LENGTHF - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFERL - END DO_ - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100D - END IFA - WRITE(11) BUFFERl - ICOUNT = ICOUNT + 1 - END DO - END DO - i -100 CALL CLOSE_BULLFILL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',F - & '*.BULLFIL') - IER = 1S - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETEL - IER = 1( - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IFs - I - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',I - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,E - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THENE - OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))I - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',U - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,N - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')O - IF (IER.NE.0) THEN - CLOSE (UNIT=11)u - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF' - L - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR',E - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - T - NEMPTY = 0A - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - P - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULLT - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)K - WRITE (12,IOSTAT=IER) BULLDIR_ENTRYR - NBLOCK = NBLOCK + LENGTH - END DO - 4 - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIRA - CALL OPEN_BULLDIR ! Open with no sharingM - V - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory headerC - G - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//e - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER)P - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//G - & '.BULLDIR;-1') - END DOA - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*',C - & '*.*;1') - T - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN_ - END - T - _ - L - d - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -CR -C SUBROUTINE CLEANUP_DIRFILEE -CI -C FUNCTION: Reorder directory file after deletions.r -C Is called either directly after a deletion, or isA -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting processG -C was abnormally terminated. -C- - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - S - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVEe - i - CHARACTER*11 DATE_SAVE,EXDATE_SAVED - CHARACTER*11 TIME_SAVE,EXTIME_SAVEU - L - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATEN - TIME_SAVE = TIMEd - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIMEM - L - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL)U - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file, - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)e - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DOU - IF (MOVE_FROM.EQ.0) THEN ! There are no more entriesY - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER)T - RETURN - END IFT - LENGTH = -LENGTH ! Indicate starting point by writingY - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative lengthS - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletionI - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1S - DO K=J,NBULLD - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY)I - END IFR - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q. - BLOCK_SAVE = BLOCK' - MSG_NUM_SAVE = MSG_NUM) - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THENG - MOVE_TO = MSG_NUM_SAVE + 1, - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for anyE - END DO ! of the other entries - END IF - I = I + 1 - END DOO - N - IF (I.LE.NBULL) THEN ! Move reset of entries if necessaryR - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL$ - CALL READDIR(J,IER)$ - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1T - END IF_ - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IFL - M - CALL READDIR(FIRST_DELETE,IER)B - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative lengthF - CALL WRITEDIR(FIRST_DELETE,IER)E - END IF - D - CALL WRITEDIR(0,IER)K - I - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE0 - TIME = TIME_SAVEp - EXDATE = EXDATE_SAVEE - EXTIME = EXTIME_SAVES - F - RETURNG - END - C - E - SUBROUTINE SHOW_FLAGS -C0 -C SUBROUTINE SHOW_FLAGS -Ct -C FUNCTION: Show user flags.E -C) - IMPLICIT INTEGER (A - Z)F - E - INCLUDE 'BULLDIR.INC' - / - INCLUDE 'BULLUSER.INC'S - U - INCLUDE 'BULLFOLDER.INC'O - ' - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - E -C, -C Find user entry in BULLUSER.DAT to obtain flags.K -CM - IF (REMOTE_SET.NE.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user fileN - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX) THENC - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURNr - END IF - I - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(1:TRIM(FOLDER_NAME)) - L - IF (REMOTE_SET.NE.3.AND.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEND - WRITE (6,'('' NOTIFY is set.'')'), - END IF - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.A - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.O - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THENR - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (REMOTE_SET.EQ.3.OR.= - & .NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THENW - WRITE (6,'('' No flags are set.'')') - END IFN - O - IF (REMOTE_SET.NE.3) CALL CLOSE_BULLUSERE - - RETURNY - END - H - - SUBROUTINE SET2(FLAG,NUMBER)E - U - IMPLICIT INTEGER (A-Z)i - - INTEGER FLAG(2) - L - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1))O - I - RETURN - END - = - B - SUBROUTINE CLR2(FLAG,NUMBER)F - E - IMPLICIT INTEGER (A-Z)U - I - INTEGER FLAG(3) - E - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1))) - - RETURNE - END - D - T - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - L - IMPLICIT INTEGER (A-Z)E - R - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))D - F - RETURNB - END - - & - - * - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL)L -CO -C FUNCTION GETUSERS -CI -C FUNCTION: -C To get names of all users that are logged in.E -CI - - IMPLICIT INTEGER (A-Z)X - , - INCLUDE '($JPIDEF)' - G -!*** MODULE $PSCANDEF ***Z - PARAMETER pscan$_BEGIN = '00000000'XE - PARAMETER pscan$_ACCOUNT = '00000001'XC - PARAMETER pscan$_AUTHPRI = '00000002'XI - PARAMETER pscan$_CURPRIV = '00000003'X/ - PARAMETER pscan$_GRP = '00000004'X - PARAMETER pscan$_HW_MODEL = '00000005'X - PARAMETER pscan$_HW_NAME = '00000006'XA - PARAMETER pscan$_JOBPRCCNT = '00000007'X - PARAMETER pscan$_JOBTYPE = '00000008'XC - PARAMETER pscan$_MASTER_PID = '00000009'X - PARAMETER pscan$_MEM = '0000000A'X - PARAMETER pscan$_MODE = '0000000B'X - PARAMETER pscan$_NODE_CSID = '0000000C'X) - PARAMETER pscan$_NODENAME = '0000000D'X A - PARAMETER pscan$_OWNER = '0000000E'XF - PARAMETER pscan$_PRCCNT = '0000000F'X - PARAMETER pscan$_PRCNAM = '00000010'X - PARAMETER pscan$_PRI = '00000011'XU - PARAMETER pscan$_PRIB = '00000012'X - PARAMETER pscan$_STATE = '00000013'XM - PARAMETER pscan$_STS = '00000014'XD - PARAMETER pscan$_TERMINAL = '00000015'X - PARAMETER pscan$_UIC = '00000016'Xo - PARAMETER pscan$_USERNAME = '00000017'X - PARAMETER pscan$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER pscan$_END = '00000019'XT - PARAMETER pscan$k_type = '00000081'XL - PARAMETER pscan$M_OR = '00000001'XN - PARAMETER pscan$M_BIT_ALL = '00000002'X - PARAMETER pscan$M_BIT_ANY = '00000004'X - PARAMETER pscan$M_GEQ = '00000008'X - PARAMETER pscan$M_GTR = '00000010'X - PARAMETER pscan$M_LEQ = '00000020'X - PARAMETER pscan$M_LSS = '00000040'X - PARAMETER pscan$M_PREFIX_MATCH = '00000080'XE - PARAMETER pscan$M_WILDCARD = '00000100'X, - PARAMETER pscan$M_CASE_BLIND = '00000200'X - PARAMETER pscan$M_EQL = '00000400'X - PARAMETER pscan$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER pscan$S_OR = 1: - PARAMETER pscan$V_OR = 0 - PARAMETER pscan$S_BIT_ALL = 1 - PARAMETER pscan$V_BIT_ALL = 1 - PARAMETER pscan$S_BIT_ANY = 1 - PARAMETER pscan$V_BIT_ANY = 2 - PARAMETER pscan$S_GEQ = 1 - PARAMETER pscan$V_GEQ = 3 - PARAMETER pscan$S_GTR = 1 - PARAMETER pscan$V_GTR = 4 - PARAMETER pscan$S_LEQ = 1 - PARAMETER pscan$V_LEQ = 5 - PARAMETER pscan$S_LSS = 1 - PARAMETER pscan$V_LSS = 6 - PARAMETER pscan$S_PREFIX_MATCH = 1e - PARAMETER pscan$V_PREFIX_MATCH = 7 - PARAMETER pscan$S_WILDCARD = 1 - PARAMETER pscan$V_WILDCARD = 8 - PARAMETER pscan$S_CASE_BLIND = 1f - PARAMETER pscan$V_CASE_BLIND = 9 - PARAMETER pscan$S_EQL = 1 - PARAMETER pscan$V_EQL = 10- - PARAMETER pscan$S_NEQ = 1 - PARAMETER pscan$V_NEQ = 11I - BYTE %FILL (2)N - END STRUCTURE - ( - CHARACTER USERNAME*(*),TERMINAL*(*) - i - DATA CONTEXT/0/ - S - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item listT - ! Now add items to listT - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlisto - e - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IFf - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(1:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.) - END DOh - - IF (.NOT.IER) CONTEXT = 0 - = - GETUSERS = IER - a - RETURN - END - i - - C - - T - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFON -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -Cy - IMPLICIT INTEGER (A - Z) - R - INCLUDE 'BULLUSER.INC'a - e - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)e - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./D - T - EQUIVALENCE (LAST_READ_BTIM(1,1),LAST(1,1)) - DIMENSION LAST(2,FOLDER_MAX)y - m - INTEGER TODAY_BTIM(2) - E - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LASTC - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IF - END DO - END IFV - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET'_ - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - END IFO - M - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2)s - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT fileE - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_BULLUSER - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER)E - END IFT - IF (IER.EQ.0) THEN- - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1)I - LAST_READ_BTIM(2,I) = READ_BTIM(2)B - END DO - END IF - END IF - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - I - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIMI - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU)))C - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAXR - LAST_SYS_BTIM(1,I) = 0D - LAST_SYS_BTIM(2,I) = 0 - END DO - END IFy - - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1)))M - ELSEA - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2)))( - END IFE - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_NEWS_READ - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU)))( - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSEM - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IFT - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF) - T - CALL CLOSE_BULLINF' - E - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM)' - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ)O - - USERINFO_READ = .TRUE._ - G - RETURNU - END - E - - - SUBROUTINE UPDATE_USERINFO' -C) -C SUBROUTINE UPDATE_USERINFO= -C -C FUNCTION: Updates the latest message read times for each folder. -Cf - IMPLICIT INTEGER (A - Z)N - O - INCLUDE 'BULLUSER.INC'A - C - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)U - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)= - S - EQUIVALENCE (LAST_READ_BTIM(1,1),LAST(1,1)) - DIMENSION LAST(2,FOLDER_MAX)T - - IF (.NOT.USERINFO_READ) RETURN - E - DIFF = .FALSE.I - FNUM = 1( - - DO WHILE (.NOT.DIFF.AND.FNUM.LE.FOLDER_MAX) - DIFF = LAST_READ_BTIM(1,FNUM).NE.OLD_LAST_READ_BTIM(1,FNUM) - IF (.NOT.DIFF) THENT - DIFF = LAST_READ_BTIM(2,FNUM).NE.OLD_LAST_READ_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1+ - END DO2 - B - DIFF1 = .FALSE. - FNUM = 1( - O - DO WHILE (.NOT.DIFF1.AND.FNUM.LE.FOLDER_MAX)I - DIFF1 = LAST_SYS_BTIM(1,FNUM).NE.OLD_LAST_SYS_BTIM(1,FNUM) - IF (.NOT.DIFF1) THEN - DIFF1 = LAST_SYS_BTIM(2,FNUM).NE.OLD_LAST_SYS_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1P - END DOG - * - DIFF2 = .FALSE. - FNUM = 1R - T - DO WHILE (.NOT.DIFF2.AND.FNUM.LE.FOLDER_MAX)n - DIFF2 = LAST_NEWS_READ(1,FNUM).NE.OLD_LAST_NEWS_READ(1,FNUM) - IF (.NOT.DIFF2) THEN - DIFF2 = LAST_NEWS_READ(2,FNUM).NE.OLD_LAST_NEWS_READ(2,FNUM)c - END IF - FNUM = FNUM + 1M - END DOn - W - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - N - CALL OPEN_BULLINF_SHAREDR - c - IF (DIFF) THEN0 - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IFp - n - IF (DIFF1) THEN - LU = TRIM(USERNAME)E - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))D - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF_ - - IF (DIFF2) THEN - LU = TRIM(USERNAME)= - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))T - IF (LU.GT.1) THEN0 - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ0 - END IF - IF (LU.GT.1) THEN0 - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1)))_ - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2)))R - END IF - END IFL - - CALL CLOSE_BULLINFM - R - RETURNE - END - 0 - 0 - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - R - IMPLICIT INTEGER (A-Z)g - - INTEGER BTIM(2) - S - CHARACTER*(*) TIMET - p - IF (TRIM(TIME).EQ.20) THENR - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM)T - ELSE1 - SYS_BINTIM = SYS$BINTIM(TIME,BTIM) - END IFT - p - RETURNT - END - - - R - T - SUBROUTINE NEW_MESSAGE_NOTIFICATION -CV -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -Cn -C Update user's last read bulletin date. If new bulletins have been= -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit.n -CW - C - IMPLICIT INTEGER (A-Z)p - n - INCLUDE 'BULLFOLDER.INC'R - T - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT= - - COMMON /POINT/ BULL_POINT - - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - N - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)) - i - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHA - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*1 SEPARATEA - _ - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUMT - ) - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - r - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - T - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder info - ELSE IF (.NOT.LOGIN_SWITCH) THEND - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login timeN - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER)C - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder infop - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN. - . - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)B - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag$ - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1A - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENU - CALL SET2(NEW_MSG,FOLDER_NUMBER)M - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.A - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND.D - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM)C - ELSEf - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)E - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR.B - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1E - END IF - END IFS - END IFE - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND.N - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messagesR - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IFI - END IF - END DO( - . - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THENR - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)S - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM)A - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time.D - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF) - END IF - IF (DIFF.LT.0) THENE - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(1:TRIM(FOLDER))S - NEW_MESS = .TRUE. - END IF - END IFL - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - IF (INCMD(:4).EQ.'SHOW') THENM - SAVE_FOLDER_Q1 = 0R - RETURN) - END IF - IF (NEW_MESS.OR.NEWS_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'',2 - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0T - CALL SELECT_FOLDER(.FALSE.,IER)2 - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN1 - WRITE(6,'('' Type READ to read new GENERAL messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0_ - DO WHILE (NEW_COUNT.GT.0)( - NEW_COUNT = NEW_COUNT / 10_ - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletinsO - ELSEF - BULL_POINT = 0T - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)B - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)m - END IFe - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEND - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM), - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1F - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER)N - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERM - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(1:TRIM(FOLDER))= - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(1:TRIM(FOLDER))_ - END IF - DIFF = 0N - END IF - END IFR - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERM - IF (BULL_POINT.NE.-1) THENO - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THENI - SAVE_BULL_POINT = BULL_POINTE - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORYH - BULL_POINT = SAVE_BULL_POINT - END DOS - END IFE - END IF - END IF - END IFI - END IFR - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS)T - CALL EXITE - END IF_ - M - RETURN - END - S - A - L - U - SUBROUTINE READ_IN_FOLDERSM - U - IMPLICIT INTEGER (A-Z) - F - INCLUDE 'BULLFOLDER.INC'R - E - INCLUDE 'BULLUSER.INC' - R - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM0 - DATA SAVE_FOLDER_Q1/0/- - = - COMMON /READIT/ READITM - U - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - I - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG). - 0 - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM)E - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - SAVE_FOLDER_NUM = 0 - T - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1A - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENM - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.R - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN1 - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSIONR - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR._ - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR.e - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -Cs -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed.s -Ca - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THENI - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - CALL MODIFY_SYSTEM_LIST(1)M - END IFS - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DOM - - CALL CLOSE_BULLFOLDER - S - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - E - RETURNU - END - C - O - L - N - SUBROUTINE DISCONNECT_REMOTE - M - IMPLICIT INTEGER (A-Z) - A - INCLUDE 'BULLFOLDER.INC'I - D - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - S - FOLDER_NUMBER = -1C - FOLDER1 = 'GENERAL' - S - CALL SELECT_FOLDER(.FALSE.,IER) - M - WRITE (6,'('' Resetting to GENERAL folder.'')') - - RETURNg - END diff --git a/decus/vax91a/bulletin/bulletin8.for b/decus/vax91a/bulletin/bulletin8.for deleted file mode 100644 index b577e2d..0000000 --- a/decus/vax91a/bulletin/bulletin8.for +++ /dev/null @@ -1,1874 +0,0 @@ -C -C BULLETIN8.FOR, Version 4/8/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: MIT PFC VAX-11/780, VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER NAMEDESC*9 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - CHARACTER*1 DUMMY - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY',DUMMY)) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - RETURN - END - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*9 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*6,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*25,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).GT.0) THENa - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST,L - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THENa - IER = WRITE_IOSB(1,UNIT_INDEX)P - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX)A - END IFA - U - RETURNX - END - C - O - R - SUBROUTINE READ_AST(ASTPRM) - N - IMPLICIT INTEGER (A-Z)T - I - PARAMETER MAXLINK = 10C - 1 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)U - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFR - M - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK)N - ' - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - I - EXTERNAL NEWS_WRITE_AST - B - EXTERNAL IO$_WRITEVBLKC - N - UNIT_INDEX = %LOC(ASTPRM) - N - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN' - Q -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - E - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - B - IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.15) THEN - IER = NEWS_WRITE_PACKET_BULLCP(READ_EFS(UNIT_INDEX), - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX,' - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX)A - ELSE, - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX)L - END IFC - - RETURNT - END - - - I - . - . - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - ) - IMPLICIT INTEGER (A-Z)M - % - PARAMETER MAXLINK = 10) - A - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)T - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)D - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - S - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX)) - RETURN - END IFT - - CALL DISCONNECT(UNIT_INDEX) - F - RETURNN - END - - P - I - N - SUBROUTINE NEWS_READ_AST(ASTPRM)F - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - A - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)S - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSBL - LOGICAL*1 WRITE_BUF - ) - UNIT_INDEX = %LOC(ASTPRM) - L - IF (WRITE_IOSB(1,UNIT_INDEX)) THENR - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER)L - IF (IER) RETURN_ - END IFU - ) - CALL DISCONNECT(UNIT_INDEX) - - RETURNL - END - U - , - E - M - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER)T - - IMPLICIT INTEGER (A-Z) - L - PARAMETER MAXLINK = 10U - 1 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)d - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFE - _ - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)O - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSBT - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - S - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX))D - I - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - _ - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)),s - & %VAL(DEVS(UNIT_INDEX)),E - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST,) - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,)R - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - A - RETURN_ - N - END - , - _ - N - C - H - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM)o - - IMPLICIT INTEGER (A-Z)t - i - PARAMETER MAXLINK = 101 - X - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)T - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - D - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)H - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/O - E - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - S - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - I - CHARACTER*(*) USERNAME,FROMNAME - ' - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_ASTR - T - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - O - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - R - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1) - IER = NEWS_SOCKET_BULLCP(WRITE_EFS(UNIT_INDEX), - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IFN - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - N - CALL READ_MBX(DCL_CHAN_NUM) - W - RETURN_ - END - . - ) - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z)+ - E - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)E - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - ) - EXTERNAL NEWS_CREATE_AST' - - UNIT_INDEX = %LOC(ASTPRM) - M - IF (WRITE_IOSB(1,UNIT_INDEX)) THENA - IER = NEWS_CREATE_BULLCP(WRITE_EFS(UNIT_INDEX),, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX)O - IF (IER) RETURNC - END IF - & - CALL DISCONNECT(UNIT_INDEX) - X - RETURN - END - - L - A - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - A - IMPLICIT INTEGER (A-Z), - T - PARAMETER MAXLINK = 10 - O - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSBD - LOGICAL*1 WRITE_BUF - N - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)I - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFP - M - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THENU - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX)T - ELSEG - CALL DISCONNECT(UNIT_INDEX)U - END IFE - R - RETURNA - END - E - R - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - ( - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - M - PARAMETER MAXLINK = 10 - Z - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)B - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB_ - LOGICAL*1 WRITE_BUF - W - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)F - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFN - DATA COUNT /0/_ - E - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)A - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)( - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)R - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*25,FROM_SAVE*12,NODE_SAVE*12B - U - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - ( - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - E - START_NCB = 7+MBX_BUF(5)R - S - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM_ - ELSEI - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX')N - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - I - IF (IER) THENO - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - X - UNIT_INDEX = 1X - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.)N - UNIT_INDEX = UNIT_INDEX + 1 - END DOP - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - D - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAMEA - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IFI - X - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,)1 - I - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1E - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0N - END IF, - D - RETURNN - END - ) - - F - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER)N -C -C SUBROUTINE GETDEVUNIT -CN -C FUNCTION: -C To get device unit numberS -C INPUT:T -C CHAN - Channel numberL -C OUTPUT: -C DEV_UNIT - Device unit numberH -CD - ( - IMPLICIT INTEGER (A-Z) - D - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listN - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlistK - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - N - RETURN - END - 2 - A - O - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -CT -C SUBROUTINE GETDEVMAME -C0 -C FUNCTION: -C To get device name -C INPUT:N -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C_ - E - IMPLICIT INTEGER (A-Z) - A - INCLUDE '($DVIDEF)' - N - CHARACTER*(*) DEV_NAME( - T - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listN - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN))N - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlistO - F - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - O - RETURNT - END - L - ) - I - SUBROUTINE DISCONNECT(UNIT_INDEX) -CB -C SUBROUTINE DISCONNECT -CT -C FUNCTION: Disconnects channel and remove its entry from the lists.U -C_ - E - IMPLICIT INTEGER (A-Z)U - U - PARAMETER MAXLINK = 10F - E - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)T - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFP - M - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for) - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - N - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - R - IF (UNITS(UNIT_INDEX).EQ.0) RETURNC - O - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - 0 - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - L - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0I - UNITS(UNIT_INDEX) = 0 - O - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IFR - - RETURN= - END - % - ( - T - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -CL - IMPLICIT INTEGER (A-Z)U - INTEGER TIMADR(2) ! Buffer containing timeI - ! in desired system format. - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/N - E - EXTERNAL CHECK_CONNECTIONSO - N - CALL LIB$GET_EF(WAITEFN)R - E - TIMBUF(6:7) = MIN - o - IER=SYS$BINTIM(TIMBUF,TIMADR) - - ENTRY RESET_TIMER - 1 - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - P - RETURNR - END - A - N - - T - SUBROUTINE CHECK_CONNECTIONSW - E - IMPLICIT INTEGER (A-Z)F - E - PARAMETER MAXLINK = 10U - 0 - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK)T - A - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)1 - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFC - , - IF (COUNT.GT.0) THENS - DO UNIT_INDEX=1,MAXLINKA - IF (DEVS(UNIT_INDEX).NE.0.AND.M - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN_ - CALL DISCONNECT(UNIT_INDEX)T - END IFE - END DO - END IFS - L - CALL RESET_TIMER - L - RETURN_ - END - J - , - N - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - A - IMPLICIT INTEGER (A-Z) - J - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*)C - H - INCLUDE '($UAIDEF)' - W - INTEGER*2 UIC(2)I - I - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - R - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - I - IF (.NOT.IER) THEN, - USERNAME = 'DECNET'X - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)X - END IF - D - RETURN - END - O - E - C - - C - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME)C - ( - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - _ - CHARACTER NETUAF*100,USERTEMP*12 - S - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - I - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - M - USERTEMP = 'DECNET' - X - DO WHILE (NUM.LE.NETUAF_NUM)_ - NUM = NUM + 1G - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF)R - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN& - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN( - USERTEMP = NETUAF(65:)E - ELSET - USERTEMP = USERNAME - END IFF - END IF - END DOK - R - USERNAME = USERTEMP - C - RETURNO - END - T - F - A - N - - SUBROUTINE GET_PROXY_ACCOUNTS - W - IMPLICIT INTEGER (A-Z)A - F - CHARACTER NETUAF*656R - _ - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/) - A - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100))L - C - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)D - O - FORMAT = 0D - U - IF (IER.NE.0) THENR - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT',E - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)1 - FORMAT = 1 - END IFI - G - NETUAF_NUM = 0! - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAFF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:)G - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64)X - SKIP = 4 + ICHAR(NETUAF(65:65)), - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DOA - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65))_ - NETUAF(65:) = NETUAF(69:)C - DO I=65+ULEN,76U - NETUAF(I:I) = ' ' - END DO - ELSEN - NETUAF(65:) = 'DECNET' - END IF( - END IFM - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DOC - V - CLOSE (UNIT=7)V - A - RETURNC - O - END - T - A - / - S - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX)) - C - IMPLICIT INTEGER (A-Z)D - A - INCLUDE 'BULLFILES.INC' - 1 - INCLUDE 'BULLFOLDER.INC'B - H - INCLUDE 'BULLDIR.INC' - H - INCLUDE 'BULLUSER.INC'C - S - PARAMETER MAXLINK = 10T - ( - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFE - C - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)O - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)E - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*25,FROM_SAVE*12,NODE_SAVE*12E - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - S - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - T - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - N - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - A - PARAMETER BRDCST_LIMIT = 82*12 + 2$ - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK)+ - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - D - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - E - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*53 - CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE)S - ( - INTEGER BULLCP_PRIV(2)P - _ - BULLCP_PRIV(1) = PROCPRIV(1)P - BULLCP_PRIV(2) = PROCPRIV(2) - - ILEN = READ_IOSB(2,UNIT_INDEX)( - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER))_ - ) - REC_SAVE(UNIT_INDEX) = 0% - USERNAME = USER_SAVE(UNIT_INDEX). - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)R - NODENAME = NODE_SAVE(UNIT_INDEX)S - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15) THEN ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USERNAME,PRIV_SAVE(1,UNIT_INDEX))e - PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX) - PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND.s - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THENT - CALL CHECK_BULLETIN_PRIV(USERNAME) - PRIV_SAVE(1,UNIT_INDEX) = PROCPRIV(1) - PRIV_SAVE(2,UNIT_INDEX) = PROCPRIV(2) - END IF - END IF - END IF - I - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THENE - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THENa - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:1))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE T - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:1))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folderC - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE G - SYSLOG = .FALSE.R - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER)T - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:5))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO) - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real.N - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9)))M - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13)))e - ELSEG - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),N - & %REF(BUFFER(9:9))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1)N - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1)) - END IFC - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24T - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1),E - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1),N - & %REF(BUFFER(17:17))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEND - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),m - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))' - END IFN - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM_ - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1)M - IF (IER.AND.IER1) THEN - IF (SYSLOG) THENL - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSEe - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IFN - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBERM - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX)L - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message lineU - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1A - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP)) - CALL LIB$MOVC3(11,%REF(BUFFER(58:58)),%REF(EXDATE))N - CALL LIB$MOVC3(11,%REF(BUFFER(69:69)),%REF(EXTIME))I - CALL LIB$MOVC3(4,%REF(BUFFER(80:80)),SYSTEM) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)A - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000C - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND.E - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IFC - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present) - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0. - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBERE - WRITE (EXTIME(7:),'(I4)') NODE_AREAA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//D - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IFE - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(84:84)),BROAD)S - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THENT - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(88:88)),BELL) - CALL LIB$MOVC3(4,%REF(BUFFER(92:92)),ALL)E - CALL LIB$MOVC3(4,%REF(BUFFER(97:97)),CLUSTER)$ - FOLDER_FILE =E - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER= - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFILH - OENTRY = OUT_HEAD(UNIT_INDEX), - LENGTH = LEN_SAVE(UNIT_INDEX)E - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)G - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THENN - CALL GET_BROADCAST_MESSAGE(BELL)5 - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin) - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - L - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ) - IF (.NOT.BROAD) GO TO 1000 - ( -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodesZ - TEMP_USER = ':'L - DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME( - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node thatA - END IF ! originated the messageF - END DOK - IF (TEMP_USER(:1).NE.':') THENT - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE.V - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000U - END IFM - CALL SETUSER(USERNAME) ! Reset to original usernameD - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THENC - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR.O - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IFC - ELSES - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER)E - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127))T - I = I + 128E - END DOS - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IFQ - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entryV - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE =I - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERF - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THENS - CALL READDIR(ICOUNT,IER)R - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:9)),%REF(MSG_KEY(1:1)))O - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1)))N - IF (ICOUNT.NE.0) THENX - BUFFER(5:) = BULLDIR_ENTRYO - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER)E - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),SBULL)E - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),EBULL)Q - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERU - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)S - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX)L - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY)E - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)F - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE =O - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIRE - IF (ICOUNT.GT.0) THENL - BULLDIR_ENTRY = BUFFER(9:)5 - CALL WRITEDIR_NOCONV(ICOUNT,IER)R - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THENM - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE)4 - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),IMMEDIATE)L - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)R - CALL OPEN_BULLDIRR - CALL READDIR(BULL_DELETE,IER)X - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENL - CALL CLOSE_BULLDIR, - BUFFER = 'ERROR: Cannot find message to delete.'E - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000T - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENS - CALL CLOSE_BULLDIRN - BUFFER = 'ERROR: Insufficient privileges to delete message.'E - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRYN - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE)E - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read messageO - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT) - FOLDER_FILE =L - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX)E - DO I=BLOCK,BLOCK+LENGTH-1A - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)F - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX)A - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTHV - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)E - OUT_SAVE(UNIT_INDEX) = OENTRYU - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)) - FOLDER_FILE =V - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - CALL OPEN_BULLDIR - CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP_TEMP)) - CALL LIB$MOVC3(4,%REF(BUFFER(58:58)),ICOUNT) - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIRU - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000A - END IF - CALL LIB$MOVC3(53,%REF(BUFFER(62:62)),%REF(DESCRIP)) - CALL LIB$MOVC3(4,%REF(BUFFER(115:115)),%REF(MSGTYPE))E - CALL LIB$MOVC3(11,%REF(BUFFER(119:119)),%REF(EXDATE))7 - CALL LIB$MOVC3(11,%REF(BUFFER(130:130)),%REF(EXTIME)) - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV()i - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR.R - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000E - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX)I - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX)E - DO I=1,NEW_LENGTHT - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)9 - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin. - IF (NEW_LENGTH.GT.0) THENR - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1L - END IF - CALL WRITEDIR(ICOUNT,IER)) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1),T - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General?= - END IF - CALL WRITEDIR(ICOUNT,IER)V - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE)N - DESCRIP_TEMP = BUFFER(9:61)G - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)! - CALL OPEN_BULLDIRi - CALL READDIR(BULL_DELETE,IER)n - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIRE - BUFFER = 'ERROR: Cannot find message to undelete.'( - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000I - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROMU - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIRZ - BUFFER = 'ERROR: Insufficient privileges to undelete message.') - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000N - END IF - CALL LIB$MOVC3(11,%REF(BUFFER(62:62)),%REF(EXDATE))M - CALL LIB$MOVC3(11,%REF(BUFFER(73:73)),%REF(EXTIME)): - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - FOLDER_FILE =i - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER)( - CALL GET_NEWEST_MSG(%REF(BUFFER(5:5)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)R - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) E - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG= - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0O - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER,N - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER,D - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSERC - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BLENGTH), - CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),START)( - IF (BLENGTH.EQ.-1) THENO - IF (SCRATCH(UNIT_INDEX).EQ.0) THENU - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF_ - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:13)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:1))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:13)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:17)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX))9 - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:21)),FOLDER_NUMBER) - FOLDER = BUFFER(25:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER)) - END IFE - END IF - END IF - -1000 PROCPRIV(1) = BULLCP_PRIV(1), - PROCPRIV(2) = BULLCP_PRIV(2) - A - RETURNB - END - - E - Y - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - = - IMPLICIT INTEGER (A-Z) - _ - INCLUDE 'BULLUSER.INC'U - - - INCLUDE 'BULLDIR.INC' - L - INCLUDE 'BULLFOLDER.INC'E - Y - PARAMETER MAXLINK = 10U - _ - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)E - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)o - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)F - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*25,FROM_SAVE*12,NODE_SAVE*12T - R - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX)F - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)3 - % - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN( - F - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IFS - U - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND.g - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND.F - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THENO - DIFF1 = -1N - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND.) - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE, - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN_ - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IFE - E - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURNM - 3 - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - L - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM)I - T - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM)A - R - IF (DIFF.GE.0) RETURN - _ - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)T - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN1 - I - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX)W - E - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - L - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)E - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)I - N - RETURN8 - - END - E - I - N - ) - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME)( - T - IMPLICIT INTEGER (A-Z) - _ - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - E - INCLUDE 'BULLFILES.INC' - I - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) THEN - PROCPRIV(1) = NEEDPRIV(1) - PROCPRIV(2) = NEEDPRIV(2) - END IF - END IFM - 3 - RETURNB - END - ) - R - D - SUBROUTINE GETACC(ACCOUNT)M -C3 -C SUBROUTINE GETACC -CO -C FUNCTION: -C To get account of present process. -C OUTPUTS:R -C ACCOUNT - ACCOUNT owner of present process.U -C - - IMPLICIT INTEGER (A-Z)f - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - F - INCLUDE '($JPIDEF)' - ) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT))B - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistB - V - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoV - 1 - RETURNF - END - 3 - , - F - T - ) - SUBROUTINE GETSTS(STS)W -C. -C SUBROUTINE GETSTS -CI -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS:E -C STS - Status word of present process.F -C. - . - IMPLICIT INTEGER (A-Z) - S - INCLUDE '($JPIDEF)' - D - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistI - U - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoF - - RETURNA - END - R - - e - B - K - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - V - IMPLICIT INTEGER (A-Z)A - U - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - X - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - E - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - ' - STATUS = SYS$OPEN(FAB)N - IF (STATUS) STATUS = SYS$CONNECT(RAB) - d - LNM_MODE_EXEC = STATUSE - E - END - ) - E - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THENW - REC_LOCK = 1 - INIT = .FALSE. - ELSEE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - REC_LOCK = 1T - ELSE - REC_LOCK = 0, - INIT = .TRUE. - END IF - END IF) - H - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DOW - RETURN( - END - R - SUBROUTINE SYS_GETMSG(IER)E - - IMPLICIT INTEGER (A-Z) - N - CHARACTER*80 MESSAGEL - B - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - E - RETURN - END - R - - D - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z). - R - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - . - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - u - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - U - RETURN, - END - - G - O - 0 - SUBROUTINE GET_NODE_INFOE -CO -C SUBROUTINE GET_NODE_INFOE -CO -C FUNCTION: Gets local node name and obtains node names fromI -C command line. -CL - L - IMPLICIT INTEGER (A-Z)E - - EXTERNAL CLI$_ABSENTi - e - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10)N - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - 2 - CHARACTER LOCAL_NODE*32,NODE_TEMP*256,PASSWORD*31,TEMP_USER*12R - E - NODE_ERROR = .FALSE.E - ( - LOCAL_NODE_FOUND = .FALSE.O - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THENl - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1L - END IFT - ) - NODE_NUM = 0 ! Initialize number of nodesA - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',')C - IF (COMMA.GT.0) THENA - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1): - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSEO - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IFU - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1) - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)N - POINT_NODE = NODE_NUM - IER = 1N - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD)N - IF (TRIM(PASSWORD).EQ.0) THENM - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1E - END DOR - NODE_ERROR = .TRUE. - RETURNM - END IF( - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"',N - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')')N - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE._ - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)//( - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED',A - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER)Z - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM)Y - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE.) - RETURN - END IF - END IFE - END DOK - END DO - ELSEK - LOCAL_NODE_FOUND = .TRUE.O - END IFX - RETURNV - END diff --git a/decus/vax91a/bulletin/bulletin9.for b/decus/vax91a/bulletin/bulletin9.for deleted file mode 100644 index a229a6e..0000000 --- a/decus/vax91a/bulletin/bulletin9.for +++ /dev/null @@ -1,2141 +0,0 @@ -C -C BULLETIN9.FOR, Version 4/10/91 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF (FLAG.EQ.7.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=13,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(13,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=13) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (13,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(13,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=13,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=13) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=13) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',)- - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',)B - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',)t - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',)E - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',)E - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',), - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',). - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',)e - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',)m - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',)E - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',)' - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',)w - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',)E - - RETURNI - END - ) - I - N - SUBROUTINE SHOW_KEYPAD(LIBRARY) - 9 - IMPLICIT INTEGER (A-Z)) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUTD - CHARACTER*(*) LIBRARY - W - INCLUDE '($HLPDEF)' - - IF (CLI$PRESENT('PRINT')) THENN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - ELSE - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE')r - END IF - ELSEI - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IFU - ' - RETURN. - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT)T - IMPLICIT INTEGER (A-Z)) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1S - RETURNG - END - . - T - T - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -Ci -C SUBROUTINE OUTPUT_HELPm -C. -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library.A -C - IMPLICIT INTEGER (A-Z)L - = - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACTu - CHARACTER*20 KEY(10)m - DIMENSION KEYL(10)& - L - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - B - CHARACTER*80 PROMPT - _ - DATA DISPLAY_ID/0/,KEYBOARD_ID/0/ - D - IF (KEYBOARD_ID.EQ.0) THENT - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IFU - S - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - E - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library nameF - I - DO I=1,10 ! Initialize key lengthsI - KEYL(I) = 0 - END DOe - i - NKEY = 0 ! Number of help keysR - E - DO WHILE (1) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen= - M - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - d - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND.6 - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - I - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spacesE - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DOR - E - NEXT_KEY = 21 - I - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search forT - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next keyE - END DOD - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key stringB - KEYL(NKEY) = HELP_INPUT_LEN ! Key lengthT - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1_ - END IFR - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10)))R - T - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1R - ! IER = 0 special case means input given to full screen prompt - M - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't updateD - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - F - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - H - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopicL - LPROMPT = 0 ! Create subtopic prompt line0 - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1_ - END DON - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IFD - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IFK - END DO - ( - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - P - END DOE - - END - - C - O - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL)/ -CY -C FUNCTION PUT_OUTPUT -CM -C FUNCTION: -C Output routine for input from LBR$GET_HELP. DisplaysR -C help text on terminal with full screen prompting.G -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits._ -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -CK - IMPLICIT INTEGER (A-Z)I - U - INCLUDE '($HLPDEF)' - A - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10)_ - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - E - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - G - CHARACTER INPUT*(*) - , - CHARACTER SPACES*20 - DATA SPACES /' '/ - K - OTHERINFO = INFO.AND.HLP$M_OTHERINFOI - = - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found= - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that= - KEYL(I) = 0 ! were inputted, as they are, - END DO ! not valid, as no matchT - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND.E - & %LOC(INPUT).NE.0) THEN ! If text contains key namesF - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match.R - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys thatR - KEYL(I) = 0 ! were just inputted, allowing8 - END DO ! this routine to fill them. - END IFD - K - IF (NEED_ERASE) THEN ! Need to erase screen?K - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic.R - NEED_ERASE = .FALSE. - END IFN - , - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counterD - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screenF - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input?A - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired.N - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN enteredR - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent outputA - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to outputI - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IFP - HELP_PAGE = 1 ! Increment page counter.B - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT)e - END IF - END IFP - I - RETURN - END - = - I - U - ' - SUBROUTINE SHOW_VERSION - / - IMPLICIT INTEGER (A-Z)P - P - CHARACTER VERSION*10,DATE*23S - E - CALL READ_HEADER(VERSION,DATE) - A - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - X - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - END - T - - C - A - R - ) - SUBROUTINE TAG(ADD_OR_DEL)A - R - IMPLICIT INTEGER (A-Z)P - _ - INCLUDE 'BULLDIR.INC' - I - COMMON /TAGS/ BULL_TAG,READ_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./, - ) - COMMON /POINT/ BULL_POINT - E - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - P - EXTERNAL CLI$_ABSENTE - C - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IFR - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN0 - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THENe - WRITE (6,'('' ERROR: Message was not marked.'')') - END IFX - END IF - RETURN - END IF - d - CALL OPEN_BULLDIR_SHAREDA - H - IER1 = 0E - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT).AND.IER1.EQ.0) ! Get the specified messages - - DECODE(LEN_P,'(I)',BULL_PARAMETER) MESSAGE_NUMBER - - CALL READDIR(MESSAGE_NUMBER,IER) ! Get info for bulletin - H - IF (IER.NE.MESSAGE_NUMBER+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - ELSE IF (ADD_OR_DEL) THENE - CALL ADD_TAG(IER1) - ELSE - CALL DEL_TAG(IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Message '',I,/ - & '' was not marked.'')') MESSAGE_NUMBER - END IFn - END IF - END DOD - - CALL CLOSE_BULLDIRE - T - RETURNU - E -1010 FORMAT(' ERROR: You have not read any message.')( -1030 FORMAT(' ERROR: Message was not found.') - P - END - N - ! - y - SUBROUTINE ADD_TAG(IER) - - IMPLICIT INTEGER (A-Z)n - h - INCLUDE '($FORIOSDEF)'= - L - INCLUDE 'BULLDIR.INC' - L - INCLUDE 'BULLFOLDER.INC'E - E - CHARACTER*12 TAG_KEY( - Y - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY)N - _ - IF (IER.EQ.FOR$IOS_INCKEYCHG) THEN - WRITE (6,'('' Message was already marked.'')') - ELSE IF (IER.NE.0) THENe - WRITE (6,'('' ERROR: Unable to add mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THENY - WRITE (6,'('' IOSTAT error = '',I)') IER7 - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IFY - 0 - RETURN - END - E - Q - A - H - SUBROUTINE DEL_TAG(IER) - - IMPLICIT INTEGER (A-Z)m - s - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'Y - Q - CHARACTER*12 TAG_KEYN - I - DO WHILE (REC_LOCK(IER))D - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) - END DO - IF (IER.NE.0) RETURNN - - DELETE (UNIT=13,IOSTAT=IER) - F - IF (IER.NE.0) THENN - WRITE (6,'('' ERROR: Unable to delete mark.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN- - WRITE (6,'('' IOSTAT error = '',I)') IERE - ELSE - CALL SYS_GETMSG(IER1) - END IF - END IFo - e - RETURNp - END - i - - - - E - SUBROUTINE OPEN_OLD_TAG - Y - IMPLICIT INTEGER (A-Z) - & - INCLUDE '($FORIOSDEF)', - P - INCLUDE 'BULLUSER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG - L - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - p - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)R - IF (.NOT.IER) RETURN/ - ' - NTRIES = 0P - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE='BULL_MARK:'//T - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,) - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER))N - NTRIES = NTRIES + 1A - END DON - _ - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)T - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IERU - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IFr - - IF (IER.EQ.0) BULL_TAG = .TRUE. - o - RETURNN - END - - D - E - - SUBROUTINE OPEN_NEW_TAG(IER)N - O - IMPLICIT INTEGER (A-Z)A - L - INCLUDE 'BULLUSER.INC'U - U - COMMON /TAGS/ BULL_TAG,READ_TAG - i - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - f - CHARACTER*64 BULL_MARK - P - IER = SYS_TRNLNM('BULL_MARK',BULL_MARK) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: BULL_MARK must be defined.'', - & '' See HELP MARK.'')') - RETURN - ELSEn - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1.OR.BULL_MARK.NE.BULL_PARAMETER) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)Y - CALL DISABLE_PRIVSH - IER1 = 0U - END IF - OPEN (UNIT=13,FILE='BULL_MARK:'//D - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW',G - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1)L - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1K - END IF - ELSE - BULL_TAG = .TRUE. - IER = 1 - END IF - END IF. - N - RETURN& - END - G - L - K - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY)O - N - IMPLICIT INTEGER (A-Z)t - n - CHARACTER*(*) MSG_KEY - t - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:))u - t - RETURN - END - . - S - - u - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - i - IMPLICIT INTEGER (A-Z) - T - INCLUDE 'BULLDIR.INC' - e - COMMON /TAGS/ BULL_TAG,READ_TAG - R - CHARACTER*12 TAG_KEY,INPUT_KEYS - T - IF (.NOT.BULL_TAG) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - A - MSG_KEY = BULLDIR_HEADERL - L - HEADER = .TRUE. - GO TO 10 - E - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE) - x - DO WHILE (REC_LOCK(IER))Y - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER)u - & INPUT_KEY - END DO - - IF (IER.EQ.0) THENi - UNLOCK 13I - MESSAGE = MSG_NUM) - END IF - d - RETURN - e - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - p - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I))L - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1)G - I = 9 - ELSE - I = I + 1 - END IF - END DO - n - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE) - - HEADER = .FALSE.p - p -10 DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER)I - & INPUT_KEY - END DO. - ' - DO WHILE (1)) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY)F - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)i - END IF - E - IF (FOLDER1_NUMBER.NE.FOLDER_NUMBER.OR.IER.NE.0) THEN - IER = 1 - UNLOCK 13 - RETURN - ELSE - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9E - ELSE( - I = I + 1p - END IF - END DOL - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIRd - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSEs - CALL READDIR_KEYGE(IER)U - END IFT - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:))p - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13_ - MESSAGE = MSG_NUM - IF (HEADER) THENN - MESSAGE = MESSAGE - 1e - MSG_KEY = BULLDIR_HEADER - END IFu - IER = 0 - RETURN - ELSEN - DELETE (UNIT=13)= - DO WHILE (REC_LOCK(IER)). - READ (13,IOSTAT=IER) INPUT_KEYT - END DO - END IF - END IF - - END DOU - - END - U - T - P - e - - N - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALLA -C folders. Added per request of a faculty member for his private -C board. Changes to BULLETIN.FOR should be fairly obvious. -CN -C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2): -CM - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC'A - INCLUDE 'BULLUSER.INC'I - N - COMMON /POINT/ BULL_POINT - , - COMMON /TAGS/ BULL_TAG,READ_TAG - A - DATA FOLDER_Q1/0/ - C - BULL_POINT = 0L - I - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART')T - & .AND.INDEX_COUNT.EQ.1) THENL - INDEX_COUNT = 2. - DIR_COUNT = 0 - END IFO - _ - IF (INDEX_COUNT.EQ.1) THENR - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM)N - N - FOLDER_Q = FOLDER_Q1U - P - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE')a - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_END)R - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED_ - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IFI - N - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1L - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)G - CALL NEWS_GET_SUBSCRIBE(SUBNUM,F1_END) - IF (SUBNUM.NE.0) THENI - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER)' - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSEn - CALL READ_FOLDER_FILE_TEMP(IER)E - END IFt - IF (IER.EQ.0) THEN6 - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THENE - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))( - & //FOLDER1 - CALL CHECK_ACCESSE - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',S - & USERNAME,READ_ACCESS,-1)F - ELSE - READ_ACCESS = 1 - END IFU - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1A - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)O - END IFE - END IFI - END DO - Z - CALL CLOSE_BULLFOLDER ! We don't need file anymoreN - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - WRITE (6,1000)S - IF (SUBSCRIBE) THEN - WRITE (6,1025) - ELSEE - WRITE (6,1020) - END IFR - DO J = 1,NUM_FOLDERSl - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THENa - WRITE (6,1035) FOLDER1_DESCRIP(:72),F1_NBULL( - ELSE - WRITE (6,1030) FOLDER1,F1_NBULL, - & FOLDER1_DESCRIP(:MIN(TRIM(FOLDER1_DESCRIP),46)) - END IF - END DO - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - READ_TAG = .FALSE.R - IF (CLI$PRESENT('MARKED')) READ_TAG = .TRUE. - RETURNE - ELSE IF (INDEX_COUNT.EQ.2) THEN - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN1 - FOLDER_NUMBER = -1( - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - T - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0N - RETURN - END IFE - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)O - END IF - U - CALL DIRECTORY(DIR_COUNT)R - IF (DIR_COUNT.GT.0) RETURN - S - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040)) - ELSE - INDEX_COUNT = 0 - END IF - END IFO - I - RETURNA - N -1000 FORMAT (' The following folders are present'/) -1020 FORMAT (' Name Count Description'/) -1025 FORMAT (' Name',70X,'Count'/) -1030 FORMAT (1X,A,1X,I6,1X,A) -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...')6 - ' - END - t - p - m - - e - SUBROUTINE SHOW_USER. -CC -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users.o -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - T - COMMON /POINT/ BULL_POINT - D - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - I - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - _ - COMMON /CTRLC_FLAG/ FLAGB - P - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - P - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX)N - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2)6 - ' - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL')e - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER - F - IF (.NOT.ALL) THENA - IER = CLI$GET_VALUE('USERNAME',TEMP_USER)N - IF (.NOT.IER) TEMP_USER = USERNAME - END IFA - _ - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THENE - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IFS - E - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)A - , - FOLDER_PRESENT = CLI$PRESENT('FOLDER') - - IF (FOLDER_PRESENT) THENA - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z')M - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME) - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER). - CALL CLOSE_BULLFOLDERL - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURN - END IF - END IFG - Y - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THENu - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THENA - WRITE (6,'('' ERROR: Invalid date specified.'')'), - RETURNR - END IF - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURNR - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THENR - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURNR - END IF - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN_ - END IF - ELSE IF (SINCE) THEN - IF (BULL_POINT.EQ.0) THEN - WRITE (6,'('' ERROR: No current message.'')') - RETURNY - ELSE IF (NEWS) THEN - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THENL - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSEK - STARTMSG = 1 - END IF - P - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST( - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1)O - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - ELSE - IF (NEWS) THENI - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU)))H - IF (LU.GT.1) THENC - TEMP_USER(LU-1:LU-1) =S - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))L - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IFT - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LASTS - END DO - END IF - UNLOCK 9I - IF (IER.EQ.0) THEN% - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1G - END DO - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND. - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN= - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0E - NEWSMSG = 1 - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBERN - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THEN - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0L - ELSE' - FOUND = .FALSE.I - END IFU - IF (FOUND.AND.NEWS) THENO - WRITE (6,'(1X,A,'' latest message read '',G - & I,''.'')')I - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THENE - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')')F - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'',, - & '' to specified folder.'')')O - END IF - END IF - IF (.NOT.ALL) THENA - IF (IER.NE.0) THEN - WRITE (6,'('' User info does not exist.'')') - END IFl - IER = 2 - END IF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSEU - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IFD - ELSE - WRITE (6,'('' Entry for specified user not found.'')')E - END IF - CALL CLOSE_BULLUSER - ELSE - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1), - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND.C - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM)O - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THENE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,)O - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IFC - END IFL - END DO - CALL CLOSE_BULLUSERO - END IFN - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLO - R - RETURN) - END - - N - F - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -Ce -C SUBROUTINE INIT_MESSAGE_ADD -C= -C FUNCTION: Opens specified folder in order to add message.T -CA -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROMF -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS:L -C IER - Error status. True if properly connected to folder. -C False if folder not found.f -Ce - IMPLICIT INTEGER (A - Z)R - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC'F - A - INCLUDE 'BULLDIR.INC' - 0 - COMMON /BCP/ BULLCP - LOGICAL BULLCPA - 1 - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROt - CHARACTER*12 PROTOCOL - DATA LPRO/0/0 - R - COMMON /DIGEST/ LDESCR,FIRST_BREAKF - A - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPE - COMMON /MAIN_HEADER_INFO/ INEXDATEn - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIPE - A - COMMON /TEXT_PRESENT/ TEXTR - C - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROMO - R - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(LINE_LENGTH) OLD_BUFFERT - L - COMMON /OLD_BUFFER_FROM/ OLD_BUFFER_FROMM - DATA OLD_BUFFER_FROM /.FALSE./N - N - BULLCP = 1 ! Inhibit folder cleanup subprocessT - * - CALL OPEN_BULLFOLDER ! Get folder fileT - R - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER)I - E - CALL CLOSE_BULLFOLDER - E - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - RETURN - ELSEI - IER = 1_ - END IFi - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - U - TEXT = .FALSE. ! No text written, as of yet - E - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder) - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folderD - FOLDER_SET = .TRUE. ! indicate it - END IF0 - O - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - $ - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - _ - CALL OPEN_BULLDIR ! Open directory file1 - M - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCKM - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0F - E - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - E - LEN_FROM = TRIM(IN_FROM)N - F - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1F - LEN_FROM = 0 - END IFI - ( - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THENC - CALL STORE_FROM(INFROM,LEN_FROM)' - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocolF - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP)' - IF (LEN_DESCRP.GT.0) THENe - INDESCRIP = IN_DESCRIPD - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)R - END IF - ELSE - DESCRIP = ' ' - END IF - ELSEP - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1) - IF (IER1.NE.0) THEN - OPEN (UNIT=3,STATUS='SCRATCH',FILE='BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IFN - F - OLD_BUFFER = ' 'T - - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE.' - R - RETURNr - END - a - ' - ) - SUBROUTINE WRITEOUT_STORED - W - CHARACTER*255 BUFFERS - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO' - A - CLOSE (UNIT=3) - - RETURN= - END - I - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C( -C SUBROUTINE WRITE_MESSAGE_LINE -CL -C FUNCTION: Writes one line of message into folder.Q -CA -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - A - IMPLICIT INTEGER (A-Z)R - S - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO( - CHARACTER*12 PROTOCOL - T - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPL - COMMON /MAIN_HEADER_INFO/ INEXDATE2 - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIPL - - COMMON /DIGEST/ LDESCR,FIRST_BREAK. - DATA FIRST_BREAK/.TRUE./ - E - COMMON /TEXT_PRESENT/ TEXT - W - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFERC - I - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(LINE_LENGTH) OLD_BUFFERX - , - COMMON /OLD_BUFFER_FROM/ OLD_BUFFER_FROMR - DATA OLD_BUFFER_FROM /.FALSE./ - G - COMMON /DATE/ DATE_LINE - CHARACTER*(LINE_LENGTH) DATE_LINE - - CHARACTER*23 TODAYS - I - LEN_BUFFER = TRIM(BUFFER) - U - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:LEN_BUFFER): - IF (OLD_BUFFER_FROM.AND.BUFFER(:1).EQ.' ') THEN. - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER. - OLD_BUFFER_FROM = .FALSE. - ELSE IF (BUFFER(:5).EQ.'From:') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:)S - OLD_BUFFER_FROM = .TRUE.F - RETURNE - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:)U - OLD_BUFFER_FROM = .TRUE. - RETURNE - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THENI - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR' - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSEE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)s - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THENL - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSEI - DESCRIP = ' ' - END IF - END IFE - CALL WRITEOUT_STORED - END IFc - END IF - OLD_BUFFER_FROM = .FALSE.A - RETURN - END IFM - IF (BTEST(FOLDER_FLAG,5)) THEN6 - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE.E - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THENA - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSEU - FIRST_BREAK = .FALSE. - END IF( - LFROM = 0 - LDESCR = 0T - RETURNO - ELSE IF (.NOT.FIRST_BREAK) THEN( - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN, - LDESCR = LEN_BUFFER - 9: - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM_ - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSEA - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IFA - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1e - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM)a - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM)p - END IF - END IFe - RETURNr - END IFl - ELSE - RETURNe - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty lineO - CALL STORE_BULL(1,' ',NBLOCK) ! just store one space - ELSE - IF (LEN_DESCRP.EQ.0) THENn - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:)N - LEN_DESCRP = LEN_BUFFER - END IFs - END IF - IF (.NOT.INEXDATE) THENe - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DOt - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER)A - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THENR - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1M - ELSEI - EXDATE(1:2) = BUFFER(I:I+1)S - I = I + 2_ - END IFI - NODATE = .FALSE.I - ELSEO - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-')R - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2F - ELSED - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4i - END IFe - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DOL - INEXDATE = .TRUE. - END IFS - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - TEXT = .TRUE.X - END IFE - - RETURN - END - a - f - t - E - SUBROUTINE FINISH_MESSAGE_ADD -CF -C SUBROUTINE FINISH_MESSAGE_ADD -Cf -C FUNCTION: Writes message entry into directory file and closes folder -Cr -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -CE - I - IMPLICIT INTEGER (A-Z)I - O - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'n - s - COMMON /DIGEST/ LDESCR,FIRST_BREAKI - R - COMMON /TEXT_PRESENT/ TEXT - N - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPd - COMMON /MAIN_HEADER_INFO/ INEXDATE! - CHARACTER*(LINE_LENGTH) INFROM,INDESCRIPI - e - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROMO - - CHARACTER*23 TODAYI - I - DIMENSION BIN_EXTIME(2) - ' - IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM)_ - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)o - END IFF - ELSE - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IFN - F - CALL FLUSH_BULL(NBLOCK) - S - CALL CLOSE_BULLFIL ! Finished adding bulletin - R - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - RETURN - END IFU - S - EXTIME = '00:00:00.00'U - IF (INEXDATE) THENM - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format' - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great?A - & .OR.IER.LE.0) THEN ! or expiration date not future) - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it) - END IF - END IFO - T - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time?D - EXDATE = '5-NOV-2000' ! no, so set date far in futureB - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0- - END IF - END IFt - i - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - E - CALL ADD_ENTRY ! Add the new directory entry - ' - CALL CLOSE_BULLDIR ! Totally finished with addC - L - CALL UPDATE_FOLDERR - C - RETURNC - END - I - E - R - F - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - M - IMPLICIT INTEGER (A-Z)E - T - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROE - CHARACTER*12 PROTOCOL - / - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(LINE_LENGTH) INFROM - M - INFROM = IFROME - _ - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1R - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = ''''I - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.'''') THENN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' 'R - END DOL - I - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:)D - LEN_INFROM = LEN_INFROM - 1 - END DO9 - Q - TWO_SPACE = INDEX(INFROM,' ')' - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:)T - LEN_INFROM = LEN_INFROM - 10 - TWO_SPACE = INDEX(INFROM,' ') - END DOG - S - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK)0 - H - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - O - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - = - CALL GET_FROM(INFROM,LEN_INFROM)L - C - RETURNH - END - - _ - SUBROUTINE GET_FROM(INFROM,LEN_INFROM)_ - C - IMPLICIT INTEGER (A-Z) - E - INCLUDE 'BULLDIR.INC' - R - CHARACTER*(*) INFROMP - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards.A - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@'))L - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DON - S - DO WHILE (INDEX(INFROM,'<').GT.0.AND. ! Name may be of form - & INDEX(INFROM,'@').GT.INDEX(INFROM,'<'))A - INFROM = INFROM(INDEX(INFROM,'<')+1:)! personal-name - END DO - - DO WHILE (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name)U - & INDEX(INFROM,'@').GT.INDEX(INFROM,'(')). - INFROM = INFROM(INDEX(INFROM,'(')+1:)F - END DON - - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) - I = I + 1 - END DO0 - INFROM = INFROM(I:) - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.12.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''') - I = I + 1 - END DOE - FROM = INFROM(:I-1) - - DO J=2,I-1E - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THENP - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO/ - , - RETURN - END - S - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z)I - L - INCLUDE 'BULLDIR.INC' - R - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' 'M - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:)D - LEN_DESCRP = LEN_DESCRP - 1H - END DOe - y - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THENK - ! Is length > allowable subject length?_ - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//' - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IFR - ' - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - N - RETURN - END - I - D - ) - E - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C& -C SUBROUTINE STRIP_HEADER -C' -C FUNCTION: Indicates whether line is part of mail message header. -CU -C INPUTS: -C BUFFER - Character string containing input line of message.F -C BLEN - Length of character string. If = 0, initialize subroutine. -CR -C OUTPUTS:: -C IER - If true, line should be stripped. Else, end of header.) -C' - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'A - B - COMMON /DATE/ DATE_LINE - CHARACTER*(LINE_LENGTH) DATE_LINE - D - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - RETURN - END IFL - B - IF (BLEN.EQ.0) THEN - DATE_LINE = ' 'R - CONT_LINE = .FALSE.N - END IF? - - IER = .TRUE.$ - T - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuationR - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header line - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - IF (REMOTE_SET.NE.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN)E - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.'L - END IF - END IFE - RETURNE - ELSE - I = I + 1 - END IF - END DOO - N - IER = .FALSE. - CONT_LINE = .FALSE. - I - RETURNA - END diff --git a/decus/vax91a/bulletin/bulletin_ann.txt b/decus/vax91a/bulletin/bulletin_ann.txt deleted file mode 100644 index 17f16c8..0000000 --- a/decus/vax91a/bulletin/bulletin_ann.txt +++ /dev/null @@ -1,342 +0,0 @@ -From: ADVAX::"BULLETIN@ORYANA.PFC.MIT.EDU" " " 30-APR-1991 16:21:38.50 -To: ARISIA::EVERHART -CC: -Subj: BULLETIN utility. - -Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Tue, 30 Apr 91 16:19:21 EDT -Received: from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP - id AA09520 for ; Tue, 30 Apr 91 16:05:01 -0400 -From: BULLETIN@ORYANA.PFC.MIT.EDU -Received: from ORYANA.PFC.MIT.EDU by mcnc.mcnc.org (5.59/MCNC/3-21-91) - id AA08259; Tue, 30 Apr 91 11:29:23 -0400 - for ARISIA.dnet.ge.com!EVERHART -Message-Id: <819B16569FEDC00303@ORYANA.PFC.MIT.EDU> -Date: Tue, 30 Apr 91 11:14 EST -Subject: BULLETIN utility. -To: ARISIA::EVERHART -X-Envelope-To: EVERHART@ARISIA.dnet.ge.com -X-Vms-To: IN%"EVERHART@ARISIA.dnet.ge.com" - -You are about to receive version 2.04 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -As of V2.0, BULLETIN is able to read USENET NEWS via TCP/IP using either -CMU, MULTINET, UCX, or via DECNET. It can also serve as a NEWS gateway -for DECNET nodes without direct access to the NEWS server, i.e. a DECNET -node without Internet access will be able to read NEWS. - -NOTE: The following commands can be sent to BULLETIN@ORYANA.PFC.MIT.EDU: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. (This does not describe the NEWS reader -feature, however.) - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -This version includes all necessary modifications to work under VMS -V5.0. However, it will still be necessary to reassemble the ALLMACS.MAR -source under V5 and relink. The V4 version will not be installable -under V5 due to a change in a shared library which BULLETIN uses. -However, relinking by itself will not be enough. You MUST also -reassemble ALLMACS.MAR. If you only relink, BULLETIN can cause your -system to crash (the BULLCP process will do this because it uses the -routines in ALLMACS.MAR). - -If you are running a version of BULLETIN older than 1.52, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. This -format change can take a significant amount of time if the folder is -large. If your site has large folders, it is suggested that the new -version be installed during off peak hours. NOTE: Problems can occur -if the old version of BULLETIN is run after the data files have been -modified. Such a situation is possible on a cluster where each node has -installed the executable separately. To help installation, a new -command procedure INSTALL_REMOTE.COM has been included. This can be -used to install BULLETIN on several nodes from a single node. Read the -comments in the file for information on how to use it. - -NOTE: The BULLCP process should be stopped using the BULLETIN/STOP -command before the new version of BULLETIN is installed. It can then be -restarted using the BULLETIN/STARTUP command. (The INSTALL_REMOTE.COM -command procedure does this automatically for remote nodes.) - -You will be receiving 19 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) BULLETIN10.FOR - 13) ALLMACS.MAR - 14) BULLCOMS1.HLP - 15) BULLCOMS2.HLP - 16) BULLET1.COM - 17) BULLET2.COM - 18) PMDF.COM - 19) MX.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. Otherwise, you can delete -it. The same applies to MX. Then, read AAAREADME.TXT for BULLETN -installation instructions. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@NERUS.PFC.MIT.EDU ------------------------------------------------------------------------- -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages." - 3 -Added capability to specify file name for POST, REPLY, and RESPOND.i - y -Added the line "In a previous message, wrote:" to the9 -beginning of a message when /EXTRACT is specified6 - E -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and itm -is called with the username and subject as the parameters. - 1 -V 2.00 - 0 -Added USENET NEWS reading feature. - s -V 1.93 - 9 -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - t -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible.2 - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder whichD -has more than 127 identifiers granted access to a folder. Also correctr -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - r -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL.U - T -V 1.91 - F -Disallow SPAWN command for CAPTIVE account.b - e -Fix MAIL command to correctly allow passing addresses with quotes, i.e.h -IN%"""MRL@NERUS.PFC.MIT.EDU""".e - e -V 1.90 - s -SET NOTIFY now works for remote folders. - l -Avoid generating notification message due to SET NOTIFY flag if the messageh -was broadcasted when added using ADD/BROADCAST.r - T -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages.T - D -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages fort -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - e -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups.e - e -Modify HELP so that it won't prompt for Subtopic is there is none. - w -Prevent screen from being erased after exiting HELP. - s -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used.g - v -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - i -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message.n - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time.t - e -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages.o - o -Any BULLETIN interactive command can be executed at DCL level by typingt -BULLETIN "command" or BULLETIN "command1;command2;etc.". - t -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only thei -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has beenl -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has beenL -removed (previously it was a synonym for /EXTRACT). - o -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - E -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the commandf -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start wheree -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width isf -larger (i.e. 132) than what the terminals are (i.e. 80). - i -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the- -BULLCP process.- - - -Added ATTACH command.- - - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - L -BULLETIN will search BBOARD message headers for a line that starts withn -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It ift -finds that line, it will use that date as the expiration date of the message. - 2 -Added /REPLY to SEARCH command. Modified so that it's possible to abort out ofn -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searchingS -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETINd -would abort totally rather than just aborting the search). u - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this ish -combining the DIRECTORY and SEARCH commands. - 2 -Fixed design flaw which allowed the following to occur: If a folder is aa -remote system folder, when BULLETIN/LOGIN was executed, the same messages mightr -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - i -Optimized code which caused slow display of new messages when executinge -BULLETIN/LOGIN without /REVERSE for a remote folder. - L -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect ise -that users will not be allowed to change the setting. The main intent herer -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder.i - o -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF wasc -selected for that folder, and a non-SYSTEM message was also present. - t -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show thats -there are unread new messages every time BULLETIN/LOGIN is executed, rathern -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed upL -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vax91a/bulletin/bullfiles.inc b/decus/vax91a/bulletin/bullfiles.inc deleted file mode 100644 index 440329f..0000000 --- a/decus/vax91a/bulletin/bullfiles.inc +++ /dev/null @@ -1,29 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF IT -C IS NOT, THEN THEY SHOULD ALSO BE CHANGED. -C - CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/ - CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/ - CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/ - CHARACTER*80 BULLNEWS_FILE /'BULL_DIR:BULLNEWS.DAT'/ diff --git a/decus/vax91a/bulletin/bullfolder.inc b/decus/vax91a/bulletin/bullfolder.inc deleted file mode 100644 index bdb8e3d..0000000 --- a/decus/vax91a/bulletin/bullfolder.inc +++ /dev/null @@ -1,81 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)' - PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,FILLER, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - - EQUIVALENCE (FOLDER_BBOARD(3:),F_START) - EQUIVALENCE (FOLDER_BBOARD(7:),F_END) - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,FILLER1, - & FOLDER1_FILE,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - EQUIVALENCE (FOLDER1_BBOARD(3:),F1_START) - EQUIVALENCE (FOLDER1_BBOARD(7:),F1_END) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A25,A4,A55,A12,3A4)' - PARAMETER NEWS_FOLDER_RECORD = 108 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_FOLDER_DESCRIP,NEWS_FOLDER_BBOARD, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*25 - CHARACTER NEWS_FOLDER_DESCRIP*55,NEWS_FOLDER_BBOARD*12 - - EQUIVALENCE (NEWS_FOLDER_BBOARD(3:),NEWS_F_START) - EQUIVALENCE (NEWS_FOLDER_BBOARD(7:),NEWS_F_END) - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_FOLDER1_DESCRIP,NEWS_FOLDER1_BBOARD, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*25 - CHARACTER NEWS_FOLDER1_DESCRIP*55,NEWS_FOLDER1_BBOARD*12 - - EQUIVALENCE (NEWS_FOLDER1_BBOARD(3:),NEWS_F1_START) - EQUIVALENCE (NEWS_FOLDER1_BBOARD(7:),NEWS_F1_END) - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vax91a/bulletin/bullmain.cld b/decus/vax91a/bulletin/bullmain.cld deleted file mode 100644 index 08e259b..0000000 --- a/decus/vax91a/bulletin/bullmain.cld +++ /dev/null @@ -1,30 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vax91a/bulletin/bullnews.inc b/decus/vax91a/bulletin/bullnews.inc deleted file mode 100644 index 512b0d0..0000000 --- a/decus/vax91a/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*10 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vax91a/bulletin/bullstart.com b/decus/vax91a/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vax91a/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vax91a/bulletin/bulluser.inc b/decus/vax91a/bulletin/bulluser.inc deleted file mode 100644 index eb43584..0000000 --- a/decus/vax91a/bulletin/bulluser.inc +++ /dev/null @@ -1,49 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vax91a/bulletin/create.com b/decus/vax91a/bulletin/create.com deleted file mode 100644 index 15120ba..0000000 --- a/decus/vax91a/bulletin/create.com +++ /dev/null @@ -1,35 +0,0 @@ -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN0 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN1 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN2 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN3 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN4 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN5 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN6 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN7 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN8 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN9 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) BULLETIN10 -$ MACro ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ ON ERROR THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC BULL_NEWS -$ GOTO LINK -$DUMMY: -$ FOR BULL_NEWSDUMMY -$LINK: -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vax91a/bulletin/dclremote.com b/decus/vax91a/bulletin/dclremote.com deleted file mode 100644 index 97f40f0..0000000 --- a/decus/vax91a/bulletin/dclremote.com +++ /dev/null @@ -1,32 +0,0 @@ -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET diff --git a/decus/vax91a/bulletin/handout.txt b/decus/vax91a/bulletin/handout.txt deleted file mode 100644 index 0d7fa2c..0000000 --- a/decus/vax91a/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vax91a/bulletin/install.com b/decus/vax91a/bulletin/install.com deleted file mode 100644 index 263ed60..0000000 --- a/decus/vax91a/bulletin/install.com +++ /dev/null @@ -1,18 +0,0 @@ -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vax91a/bulletin/install_remote.com b/decus/vax91a/bulletin/install_remote.com deleted file mode 100644 index 5e9e9aa..0000000 --- a/decus/vax91a/bulletin/install_remote.com +++ /dev/null @@ -1,130 +0,0 @@ -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL diff --git a/decus/vax91a/bulletin/instruct.com b/decus/vax91a/bulletin/instruct.com deleted file mode 100644 index 49627f6..0000000 --- a/decus/vax91a/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vax91a/bulletin/instruct.txt b/decus/vax91a/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vax91a/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vax91a/bulletin/login.com b/decus/vax91a/bulletin/login.com deleted file mode 100644 index e4302af..0000000 --- a/decus/vax91a/bulletin/login.com +++ /dev/null @@ -1,28 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vax91a/bulletin/makefile b/decus/vax91a/bulletin/makefile deleted file mode 100644 index 8bfc4c6..0000000 --- a/decus/vax91a/bulletin/makefile +++ /dev/null @@ -1,78 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.04" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vax91a/bulletin/mx.com b/decus/vax91a/bulletin/mx.com deleted file mode 100644 index 4be2ee9..0000000 --- a/decus/vax91a/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folderm - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADDo - * - */L -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from)n -{g - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */u - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */y - n - /* Call BULLETIN routine to initialize adding the message */ - : - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - }o - u - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine toa - add the line. */i - m - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */v - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */: - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - }t - c - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - i - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -}t - - S -/* - * - * Function: scan_for_from_line - * - * Functional description:g - * - * The routine scans the message's RFC822 headers for the "From:" line.P - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:"F - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU "s - * - * but MX needs* - * - * From: MX%""r - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */O -unsigned long inti -scan_for_from_line(struct RAB *filerab, char *final_from) -{t - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */b - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */r - int i, j, x; /* Work variables */8 - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */r - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read,* - check to see if we've located the "From:" line. - */ - b - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */l - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - * - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - s - /* The "From:" line may actually be split over several lines.u - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it isn - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */r - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */r - }[ - ] - /* Now have the whole "From:" line in whole_from_line. Sinceb - the real address is enclosed in "<>", look for it byo - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */R - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length *// - }e - else{m - j = strlen(whole_from_line)-6; /* Don't count From: */n - i = &whole_from_line + 6; /* in string length */o - }r - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */I - scan_status = 0; /* Set error status */y - }m - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - }B - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - L -/* - * - * Function: forward_to_postmasterl - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder,u - * this routine is called to forward the message to the localt - * postmaster. - * - * Inputs:e - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folders - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects:A - * - * The message file is rewound so that subsequent calls to this routinen - * can be made (in case the message is to be written to several folders). - * - */r -unsigned long int/ -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{n - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - o - static char *error_msgs[] = {s - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"}c - }; - u - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len;e - r - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - t - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255;r - subject.dsc$a_pointer = &subject_buf;b - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - A - address_itmlst[0].buffer_length = postmaster_len; /* To: */P - address_itmlst[0].buffer_address = &postmaster; /* To: */i - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */B - attribute_itmlst[0].buffer_address = &postmaster; /* To: */S - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */g - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */s - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - m - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist));e - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist));* - * - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context,n - &bodypart_itmlst, &nulllist)); - if (x == 1){A - status_msg.dsc$w_length = 256;o - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status);{ - elser - status_msg_buf[status_msg.dsc$w_length] = '\0';o - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf;N - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - }F - v - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz;i - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - }i - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist));r - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist));o - i - tracemsg("Message forwarded to postmaster...."); -}s - s - e -/* - * - * Function: log_accounting - * - * Functional description:a - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the foldere - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS statusb - * - */s -unsigned long inte -log_accounting(void *folder, void *from, int bull_status)c -{a - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - t - int status;n - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - p - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - r - tracemsg("Writing accounting information to accounting log....");a - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */e - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */* - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */r - m - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */n - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file");t - traceerr(status);u - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - b - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -}d - -/* - * - * Main routine - * - */h -main(int argc, char *argv[]) -{l - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - * - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */m - - --argc; /* Don't count the program name */F - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */e - }h - e - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - * - /* Open all input files */ - I - tracemsg("Opening message file....");g - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1]));m - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){n - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf);* - }u - else { - tracemsg("Opening sender address file....");* - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3]));- - n - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - s - SYS$CLOSE(&fromfab);d - } /* End of "if (argc == 2)"... */i - o - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) {r - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%");n - } - else{d - d - /* Now add the MX% prefix and the double quotes */F - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */S - - /* Make the string repliable through MX by adding MX%"" to it */T - strcpy(from_line,"MX%\042");e - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace)n - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */- - }- - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */a - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */F - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */s - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */u - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n",. - folder_name); - tracemsg("Adding message to BULLETIN folder....");t - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user);t - if (!(bull_status & 1)){t - traceerr(bull_status);c - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user,& - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */n - t - } - } - }, - rms_get(&rcptrab); /* Read next recipient */ - }p - _ - l - /* Close the RMS files */e - r - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab);s - e - tracemsg("BULLETIN message processed");o - exit(SS$_NORMAL); /* Always return success */ - ) -} -$eod = -$copy/log sys$input MX_BULL.TXTh -$decko - MX_BULL - An MX SITE transportu - March 14, 1991 - G -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - = -The following files make up the MX_BULL distribution:t - e - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - t -The current version is 01-001. - a - _ -WHAT IS BULLETIN?a ------------------t -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a messagea -need be sent to a site.e - r -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including theo -Fall 1990 tapes. It can also be retrieved by sending a mail message tog -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands:_ - t - SEND ALL Sends all bulletin files.c - SEND filename Sends the specified file.L - BUGS Sends a list of the latest bug fixes.: - HELP or INFO Sends a brief description of BULLETIN. - o - u -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The= -build procedure for MX_BULL expects the logical BULL_SOURCE to point to theC -BULLETIN library. You must define this logical (or edit the .COM file)m -before building MX_BULL. - a - n -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - b -1. Using MCP, define a path named BULLETIN as a SITE transport: - l - MCP> DEFINE PATH "BULLETIN" SITEd - s -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct):e - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>"b - r -3. If you don't have a SITE transport already defined, simply copyB - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - = - If you do have a SITE transport defined, you'll need to merge the MX_BULLR - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - l - t -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to* -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - c - $ MAIL - MAIL> SEND" - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITEr -agent, since the @BULLETIN path was defined as a SITE path.A - f -To facilitate the automatic delivery of messages to BULLETIN folders, your -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN"""* - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN"""g - ) -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL.p - _ -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - t - MLFAKE/USER=MX-LIST ..../ - o -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - ' -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - I - MX-LIST@WKUVX1.bitnet - _ -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder." - n -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwardingi -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mailt -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the messagen -to the Local agent, which discovers that the mail is forwarded toe -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, whichr -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - r - l -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - i - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUEf - r -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. Thef -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file:f - t - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logicalo -MX_SITE_DEBUG. - x - d -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - r - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - r -If BULLETIN returns an error, MX_BULL will forward the message (via they -callable VMS Mail interface) to GOATHUNTER./ - - _ -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address) -for BULLETIN messages will look something like the following:/ - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - i -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM:L - N - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - ; -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - A -Note: MX_BULL just uses the address it's given. Some addresses are gatewayedl -to death, leaving a bad address on the "From:" line. This frequently happensr -with messages coming via UUCP through Internet to Bitnet, etc. - d - -AUTHOR INFORMATION ------------------- -MX_BULL was written by:l - , - Hunter Goatley, VMS Systems Programmer, WKU - a - E-mail: goathunter@wkuvx1.bitnetd - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226e - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deckc -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1.M -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3t -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a fileu -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it up_ -$ close tmp !... -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:" -$ endifi -$ exit 1 !Always return success -$eod n diff --git a/decus/vax91a/bulletin/news.txt b/decus/vax91a/bulletin/news.txt deleted file mode 100644 index f18daa4..0000000 --- a/decus/vax91a/bulletin/news.txt +++ /dev/null @@ -1,102 +0,0 @@ -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when a -user accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. It is also possible to -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "FALSE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. (NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). After BULLNEWS.DAT is created, it is -suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the file to be -compressed and will allow updates to run much faster (factor of 5 or more). - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. diff --git a/decus/vax91a/bulletin/nonsystem.txt b/decus/vax91a/bulletin/nonsystem.txt deleted file mode 100644 index 17511d5..0000000 --- a/decus/vax91a/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vax91a/bulletin/optimize_rms.com b/decus/vax91a/bulletin/optimize_rms.com deleted file mode 100644 index fc0b91d..0000000 --- a/decus/vax91a/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = P4 -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vax91a/bulletin/pmdf.com b/decus/vax91a/bulletin/pmdf.com deleted file mode 100644 index 3eda3b4..0000000 --- a/decus/vax91a/bulletin/pmdf.com +++ /dev/null @@ -1,1019 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized;L - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return');I -100: -end; (* return_bad_messages *) - * - (* submit messages to BULLETIN *)* - * - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval;m - line : bigvstring; - ier, done : boolean; - i : integer; - n - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN* - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name);O - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length),] - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true;R - END ELSE BEGIN - warn_master ('Error opening folder ' +h - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true;t - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill;E - ENDC - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *)C - E - BEGIN (* bulletin_master *) - init;M - dosubmit;D - mm_end (true); - qu_end;a - END. (* bulletin_master *) -$eod d -$copy/log sys$input BULLETIN_MASTER.PAS_V32s -$deckk -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound);s - d -(*******************************************************************)S -(* *)1 -(* Authors: Ned Freed (ned@ymir.claremont.edu) *)s -(* Mark London (mrl@nerus.pfc.mit.edu) *)n -(* 12/28/90 *)e -(* *) -(*******************************************************************) - a - CONSTm - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC'r - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC'n - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC'N - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC'a - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC'n - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - t - string = varying [alfa_size] of char;l - - VAR_ -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *)$ - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *)m - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *)l -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - m - outbound : text;c - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC'* - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC'N - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC'i - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC'n - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC'n - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC'f - t - (* Declare interface routines to BULLETIN *) - r - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char;o - var ier : boolean); extern; - l - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - f - procedure FINISH_MESSAGE_ADD; extern;m - - PROCEDURE warn_master (message : varying [len1] of char);_ - n - BEGIN (* warn_master *)_ - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message);s - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - ' - VAR fnam : vstring;e - i, stat : integer; - s - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true;n - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL',l - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%';_ - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN7 - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABELo - 100; - t - VARe - line, errorsto : vstring;= - bigline : bigvstring; result : rp_bufstruct; - header : he_header;x - i : integer; - i - PROCEDURE try_something (rp_error : integer; routine : string);, - r - BEGIN (* try_something *)m - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100;s - END; (* if *) - end; (* try_something *) - e - BEGIN (* return_bad_messages *)c - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit');( - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname);; - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt');i - try_something (he_read_header (header, qu_rtxt), 'he_read_header');n - errorsto.length := 0;a - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN_ - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i];l - END; (* if *)i - IF errorsto.length > 0 THEN BEGINx - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto),n - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr);o - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *)s - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGINr - initstring (line,0 - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend');N - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf));] - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4);, - catvstring (line, errorsto); - catchar (line, chr (chr_lf));r - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf));g - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf));r - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf);_ - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address);u - catchar (line, chr (chr_lf));L - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf));( - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf));l - catchar (line, chr (chr_lf));R - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf);s - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend');r - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring;* - retval : rp_replyval;* - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - N - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN] - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name);Y - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0);T - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier);P - IF ier THEN BEGIN* - WHILE rp_isgood (qu_rtxt (line)) DO BEGINL - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD;m - done := true;h - ENDd - ELSE BEGIN - warn_master ('Error opening folder ' +R - substr (tombox.body, 1, tombox.length));C - return_bad_messages (tombox); - done := true;I - END; - ENDE - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - ENDM - ELSE warn_master ('Can''t open queue file ' +1 - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - l - BEGIN (* bulletin_master *) - init;o - dosubmit; - mm_end (true); - qu_end;G - END. (* bulletin_master *) -$eod d -$copy/log sys$input MASTER.COM -$decke -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ !R -$ ! Modification history and parameter definitions are at the end of this file.t -$ !_ -$ set noon -$ !o -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE")( -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. -, - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'"c -$ !c -$ ! Save state information, set up environment properly) -$ ! -$ save_directory = f$environment("DEFAULT")t -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION")2 -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE"), -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto outu -$ !a -$ ! Create listing of messages queued on this channel. -$ !e -$ if p3 .eqs. "" then p3 = "1-JAN-1970"n -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp"d -$ define/process outbound 'dirlst_file'o -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made7 -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ !l -$ ! Handle various channels specially -$ !D -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channelr -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channeln -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channelO -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ !r -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read.' -$ chan = f$extract (0, f$locate(" ", line), line)r -$ if (chan .nes. channel_name) then -n -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then -; - goto list_loop -$ ! Found at least one to try.' -$ cnt = cnt + 1e -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TTa -$ !n -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script.t -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ !n -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ != -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. -t - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the maila -$ !r -$ run pmdf_root:[exe]masterr -$ exit_stat = $statuso -$ !n -$ ! Activate optional cleanup script to reset terminal/modem -$ !u -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then -( - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ !h -$ ! If master does not exit normally, then try a different connection.- -$ !- -$ if exit_stat .ne. 1 then goto list_loop, -$ eof_list:) -$ close pmdf_datan -$ !r -$ ! If we found at least one connection type for this channel, then skiph -$ ! the attempt to use the conventional mechanism.h -$ !' -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master:_ -$ @pmdf_root:[exe]'channel_name'_master.comH -$ define PMDF_DEVICE TTi -$ !) -$ ! Define logical namesm -$ !w -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]mastere -$ exit_stat = $statusI -$ !d -$ ! Activate optional cleanup script to reset terminal/modeme -$ !r -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TTo -$ deassign TTa -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1i -$ !( -$ ! Directory channelh -$ !m -$ dir_channel: -$ !s -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ !T -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ !( -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1r -$ !e -$ ! This is a BITNET channel; use BN_MASTERs -$ ! -$ BITNET_channel:m -$ !e -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ !' -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gatewayi -$ goto out1) -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel:w -$ !a -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ !N -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_masterE -$ goto out1i -$ !t -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ !e -$ CTCP_channel: -$ !t -$ run pmdf_root:[exe]ctcp_master -$ goto out1R -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTERq -$ ! -$ WTCP_channel:R -$ ! -$ ! Define other logical names -$ !f -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ !o -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ !j -$ MTCP_channel: -$ !e -$ run pmdf_root:[exe]mtcp_master -$ goto out1o -$ !s -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ !A -$ ETCP_channel:f -$ !t -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ !f -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ !' -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1p -$ !l -$ CN_channel:e -$ !c -$ ! Define other logical names -$ !e -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277q -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_mastera -$ goto out1 -$ !g -$ KER_channel: -$ !n -$ ! kermit protocol is slave only. If we get here there has been a mistake.o -$ ! however we will just exit and no harm done. -$ goto out1" -$ !D -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ !o -$ PX25_channel:c -$ != -$ ! Define other logical names -$ !- -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ !c -$ run pmdf_root:[exe]PX25_master -$ goto out1n -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTERN -$ !a -$ UUCP_channel:a -$ !4 -$ ! Define other logical names -$ !t -$ uucp_to_host = channel_name - "uucp_"n -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmpc -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfilen -$ !. -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll". -$ uupoll 'uucp_to_host'_ -$ goto out1f -$ !t -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ !f -$ XSMTP_channel: -$ !m -$ run pmdf_root:[exe]xsmtp_mastera -$ goto out1e -$ !t -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ !a -$ DSMTP_channel: -$ !q -$ run pmdf_root:[exe]dsmtp_master -$ goto out1t -$ !c -$ ! Handle delivery on the local channel, MAIL_ channels, anda -$ ! the DECnet compatibility channel -$ !t -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel:g -$ open/read queue_file 'dirlst_file' -$ local_loop:q -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list)) -$ goto local_loopn -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1n -$ !t -$ ! This is a SMTP test channel, use TEST_SMTP_MASTERo -$ !i -$ TEST_channel:s -$ !e -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1l -$ ! -$ out1: -$ delete 'dirlst_file';* -$ !t -$ ! Common exit point - clean up things first -$ !f -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_datan -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT. -$ deassign TTt -$ deassign PMDF_DEVICE -$ restore: -$ !_ -$ ! Restore saved stufft -$ !a -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ !s -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel] -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87e -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988e -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminatel -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988l -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988_ -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DATe -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT tot -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters:a -$ !c -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed./ -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTERT -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod : -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You mustl -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, butn -there is a small bug in it. The following instructions are for V3.1. It willc -work with V3.2, but V3.2 does have shared images that can be linked to if youe -use the MAKEFILE that comes with PMDF (although you have to modify MAKEFILE in -order to correctly point to BULL.OLB). e - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it asl -follows: - c - LINK BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB,m - r -and put the .EXE in PMDF_ROOT:[EXE]. Put the new MASTER.COM in PMDF_ROOT:[EXE].s -NOTE: Check your MASTER.COM, as the latest version of PMDF contains the code -necessary to check for bulletin mail. However, it will not necessary have the -latest copy of BULLETIN_MASTER.PAS.m - r -You then need a channel definition like the following in your configurationn -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMONp - s -And a rewrite rule of the form:s - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want too -process this way. I have the following: - P - info-vax: info-vax@bulletinr - tex-hax: tex-hax@bulletinf - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletint - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletini - ug-l: ug-l@bulletinu - E -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - o - a : b@bulletin - _ -will route mail sent to a@localhost to folder b in BULLETIN. - a -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders. After -doing so, restart BULLCP using BULLETIN/START. -$eod s diff --git a/decus/vax91a/bulletin/remote.com b/decus/vax91a/bulletin/remote.com deleted file mode 100644 index 9ec5a2e..0000000 --- a/decus/vax91a/bulletin/remote.com +++ /dev/null @@ -1,48 +0,0 @@ -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP diff --git a/decus/vax91a/bulletin/setuser.mar b/decus/vax91a/bulletin/setuser.mar deleted file mode 100644 index de8fcf9..0000000 --- a/decus/vax91a/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vax91a/bulletin/writemsg.txt b/decus/vax91a/bulletin/writemsg.txt deleted file mode 100644 index 56d21fa..0000000 --- a/decus/vax91a/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vax92a/bulletin-net92a/bulletin_howtoget.txt b/decus/vax92a/bulletin-net92a/bulletin_howtoget.txt deleted file mode 100644 index 7e891e6..0000000 --- a/decus/vax92a/bulletin-net92a/bulletin_howtoget.txt +++ /dev/null @@ -1,42 +0,0 @@ -From: MERC::"uunet!CRVAX.SRI.COM!RELAY-INFO-VAX" 25-MAY-1992 15:37:04.82 -To: INFO-VAX@KL.SRI.COM -CC: -Subj: Re: Using BULLETIN to automatically send articles to a remote node - -In a previous article, psinntp!npri6!richard@UUNET.UU.NET wrote: ->Message sent: 23 May 92 23:22:01 GMT. -> ->I am using Mark London's BULLETIN utility (V1.81). I have a remote node ->that needs to automatically receive Bulletins that are posted in the ->General folder of the local node. The remote node must also broadcast a ->message to the users as with the local node. -> - Do you mean a remote DECNET node? If so, then you can create a - remote folder on the remote node that points to the General - folder on the local node, and then add Bulletins with /broadcast - or SET NOTIFY /DEFAULT on the remote folder. - - Note that you can now FTP BULLETIN from FRED.PFC.MIT.EDU or - get it by sending mail to BULLETIN@ORYANA.PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file. - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - - Mark - - - -Mark - diff --git a/decus/vax92a/bulletin/aaareadme.txt b/decus/vax92a/bulletin/aaareadme.txt deleted file mode 100644 index 9f27e09..0000000 --- a/decus/vax92a/bulletin/aaareadme.txt +++ /dev/null @@ -1,218 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) INSTALL_REMOTE.COM - This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows - a user to install new versions of BULLETIN on several DECNET nodes from - a single node, rather than having to login to each node. This is - especially useful when a new version modifies the format of one of the - data file. Older versions of BULLETIN will not run with newer formats - and will either issue error statements when run, or may cause major - problems by attempting to change the files back to the old format. - (NOTE: Don't attempt to use this if different nodes are running - different versions of VMS, i.e. V4 and V5, as they require different - linked executables.) - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compression that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. - -10) BULLETIN.COM - If one wants BULLETIN to be able to send messages to other DECNET - node's GENERAL folder, but wants to avoid running the process created - by BULLETIN/STARTUP on this node, another method exists. This is the - "older" (and slower) method. BULLETIN.COM must be put in each node's - DECNET default user's directory (usually [DECNET]). Once this is done, - the /NODE qualifier for the ADD & DELETE commands can be used. - The object BULLETIN pointing to BULLETIN.COM must be added to the NCP - database, i.e. the command - MCR NCP SET OBJ BULLETIN FILE directory:BULLETIN.COM number 0 - must be executed at startup time on the remote node. - NOTE: Privileged functions such as /SYSTEM will work on other nodes - if you have an account on the other node with appropriate privileges. diff --git a/decus/vax92a/bulletin/board_digest.com b/decus/vax92a/bulletin/board_digest.com deleted file mode 100644 index 5dba320..0000000 --- a/decus/vax92a/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vax92a/bulletin/board_special.com b/decus/vax92a/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vax92a/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vax92a/bulletin/bullcoms1.hlp b/decus/vax92a/bulletin/bullcoms1.hlp deleted file mode 100644 index c532863..0000000 --- a/decus/vax92a/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,933 +0,0 @@ - -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. However, -/FOLDER is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers so -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file can -be specified which contains the text. If the editor is used for changing -the text, the old message text will be extracted. This can be suppressed -by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST - -If a mailer protocol is needs to be added to the network address in -order for it to be sent by VMS MAIL, i.e. protocol%"address", the -appropriate protocol can be specified by either hardcoding it into the -file BULLNEWS.INC before compiling BULLETIN, or by defining the system -logical name BULL_NEWS_MAILER (it is the same protocol used by the NEWS -feature in order to respond to NEWS messages). The default protocol is -IN%. If desired, you can specify the protocol with the address, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, the -folder will then be modified to point to that folder. For example if -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be shared -between more than one node. This capability is only present if the BULLCP -process is running on the remote node via the BULL/STARTUP command.i -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is storeds -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information isn -only updated every 15 minutes (same algorithm for updating BBOARDa -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the usern -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY/ -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command.a -See also /ID. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLsi -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info.h -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME. - /REMOTENAME=foldernameo -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW forl -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only withU -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEMv -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command.e - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.t -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, ap -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is nott -always true, as BULLETIN will ignore the CTRL-Y if it has a data filet -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT) -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format:: - - CURRENTo -2 /EDIT -Specifies that the editor is to be used to read the message. This ise -useful for scanning a long message. -2 /HEADERy - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -1 DELETE -Deletes the specified message. If no message is specified, the currentg -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want thee -message deleted immediately, use the /IMMEDIATE qualifier. - - Format:C - DELETE [message_number][-message_number1]m - -The message's relative number is found by the DIRECTORY command. It isr -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot beo -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This willn -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. -2 /NODES - /NODES=(nodes[,...])m - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specifye -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on theE -other nodes. The /SUBJECT must be specified to identify the specificg -message that is to be deleted. - -Additionally, you can specify logical names which translate to one orr -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subjecto - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message.g -It can be a substring of the subject. This is in case you have forgotteno -the exact subject that was specified. Case is not critical either.n -You will be notified if the deletion was successful. -See also /NEGATED. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting messagesm -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name,p -date, and subject of each message is displayed.l - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message.e -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /DESCRIBEo -Valid when used with /FOLDERS. Specifies to include description ofO -folder. -2 /EXPIRATIONA -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS.r -2 /FROMf - /FROM=[string]o - -Specifies that only messages whose username contains the specified string -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.d -See also /NEGATED. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don'tt -match the specified search command are displayed.e -2 /MARKEDp -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see alle -messages, use either /ALL, or reselect the folder. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicatedi -by an asterisk). Using /UNMARKED is equivalent to selecting the folderi -with /UNMARKED, i.e. only unmarked messages will be shown and be ableh -to be read. To see all messages, use either /ALL, or reselect the -folder.e -2 /SEENi -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlye -seen messages will be shown and be able to be read. To see allo -messages, use either /ALL, or reselect the folder. -2 /UNSEENl -Lists messages that have not been seen (seen message are indicated by ae -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWSm -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current messages -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used ins -conjunction with /MARKED.c -2 /SEARCH - /SEARCH=[string]e - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.i -2 /START - /START=message_number - -Indicates the first message number you want to display. For example,m -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunctionp -with /MARKED. If no string is specified, the previously specified stringt -is used. -1 EXIT -Exits the BULLETIN program.t -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified.o - - Format: - FILE filename [message_number][-message_number1],[...] - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5.e - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Copies all the messages in the current folder. -2 /FFt -Specifies that a form feed is placed between messages in the file. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file.s -1 FIRST -Specifies that the first message in the folder is to be read. -1 FORWARDt -Synonym for MAIL command.i -1 Foldersh -All messages are divided into separate folders. New folders can ber -created by any user. As an example, the following creates a folder ford -GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder.E -GAMESe - -To see the list of available folders, use DIRECTORY/FOLDERS. To selecti -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, thati -user will be alerted of topics of new messages at login time, and will -then be given the option of reading them. Similar to READNEW is SHOWNEW,h -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command.r - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in thel -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SETh -NODE. A remote folder is one which points to a folder on a remote DECNETr -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)u -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/u -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, and -giving access to that UIC group. Only users in that UIC group will seen -the messages in that folder when they log in.i -1 HELP -To obtain help on any topic, type: - - HELP topic> -1 INDEXm -Gives directory listing of all folders in alphabetical order. If the -INDEX command is re-entered while the listing is in progress, the listingr -will skip to the next folder. This is useful for skipping a particularN -folder. It also can be used to continue the listing from where one left -off after one has read a message.l - - Format:N - INDEX -2 /MARKED -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED,O -i.e. only marked messages will be shown and be able to be read.t -2 /UNMARKEDs -Lists messages that have not been marked (marked messages are indicateds -by an asterisk). Using /UNMARKED is equivalent to selecting the folderh -with /UNMARKED, i.e. only unmarked messages will be shown and be ablea -to be read.t -2 /SEEN' -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read.a -2 /UNSEENd -Lists messages that have not been seen (seen message are indicated by aa -greater than sign). Using /UNSEEN is equivalent to selecting the folderf -with /UNSEEN, i.e. only unseen messages will be shown and be able to bea -read. -2 /NEW -Specifies to start the listing of each folder with the first unread message. -Otherwise, the listing will start with the first message in the folder. -If the INDEX command is re-entered for continuing the listing, /NEW must -be respecified., -2 /RESTART -If specified, causes the listing to be reinitialized and start from thee -first folder.e -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format:r - LASTe -2 /EDITe -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message.e -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commandS -is set for the folder, it will change the default to be /HEADER. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format:N - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying an -address that has quotes, in order to pass the quotes you must specifyW -triple quotes. I.e. a network address of the form xxx%"address" muste -be specified as xxx%"""address""". -2 /EDITf -Specifies that the editor is to be used to edit the message before -mailing it./ -2 /HEADERc - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be usedS -as the subject. -1 MARK -Sets the current or message-id message as marked. Marked messages areC -displayed with an asterisk in the left hand column of the directoryL -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id messageo -as unmarked. - - Format: - - MARK [message-number or numbers]l - UNMARK [message-number or numbers]- - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGINs -will be used. -1 MODIFY -Modifies the database information for the current folder. Only the. -owner of the folder or a user with privileges can use this command.s - - Format:o - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted forf -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTd -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST e -2 /IDs -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presentlyt -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAMEi - /NAME=foldernameb - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID. -1 MOVE -Moves a message to another folder and deletes it from the current -folder.f - - Format: - - MOVE folder-name [message_number][-message_number1]k - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,g -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPSo - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group.A -2 /HEADERN - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied.e -The default is /NOHEADER.i -2 /MERGE -Specifies that the original date and time of the moved messages arec -saved and that the messages are placed in correct chronological ordera -in the new folder. This operation is lengthy if the new folder is large.c -2 /ORIGINALr -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned bye -the person moving the message. -1 NEWS -Displays the list of available news groups.i - -Format:r - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed.e - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "x" means the news -group has been deactived by the local server. "=" means the news group -has been renamed. The new name is shown on the display line immediately -following the old name.r -2 /NEWGROUPo -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. -2 /EDIT -Specifies that the editor is to be used to read the message. This ise -useful for scanning a long message. -2 /HEADERi - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. diff --git a/decus/vax92a/bulletin/bullcoms2.hlp b/decus/vax92a/bulletin/bullcoms2.hlp deleted file mode 100644 index f227032..0000000 --- a/decus/vax92a/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1060 +0,0 @@ - -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with > at the -beginning of each line. This can be suppressed with /NOINDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. In -order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply surround -the exclusive text starting with the line "START " and ending -with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have -just read) for printing. The file created by the PRINT command -is not released to the print queue until you exit, unless you add -the qualifier /NOW or change one of the print job's qualifiers. -Multiple messages are concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected and /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header. -If a "search-string" is not specified, a search is made using the -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for -a match. If, during a search, no more matches or messages are found, -the next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the last -message. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster.p - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" .h -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name]a -3 /READe -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warnings -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. - - Format:s - - SET [NO]ALWAYS -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format:U - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages.p - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30"w -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The forms -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY.a -The time will always be 00:00, even if the time is specified on the line.e -3 /EXPIRATIONw - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature.H -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be:e - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT/ - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account.x - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION.a -2 BRIEFs -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa).e - - Format:" - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand news -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERh - /FOLDER=foldernamea - -Specifies the folder for which the option is to modified. If nota -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENTe - -Specifies that BRIEF is a permanent flag and cannot be changed by thei -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier.c -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed every. -time when logging in, until the new messages are read. Normally, theg -BRIEF setting causes notification only at the first time that new messages -are detected. - - Format: - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for theT -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges.g - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used.r - - Format:e - - SET DEFAULT_EXPIRE days - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages.i - - Format:S - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory. - - Format:s - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - SET [NO]EXPIRE_LIMIT [days]r - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information.e - - Format:h - - SET FOLDER [node-name::][folder-name]e -3 /MARKEDI -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will haveb -to be reselected.s -2 GENERICe -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format:u - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for thea -same user. -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new messages will be displayed for upon -logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to bya -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. -2 LOGINf -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command.s - - Format: - - SET [NO]LOGIN username -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node.e - - Format:e - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder.a -3 /FOLDER - /FOLDER=foldername, - -Specifies the folder for which the node information is to modified.S -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are loggedf -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared.g -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users fore -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specifiedr -folder. This is a privileged qualifier. It will only affect brand newt -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernameg - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY.h -3 /PERMANENT - /[NO]PERMANENTt - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN.A - - Format:t - - SET [NO]PAGE -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format:e - - SET PRIVILEGES parametersE - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers. -3 /IDN - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.o -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format:o - - SET [NO]PROMPT_EXPIRE -2 READNEWu -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command.d - - Format:i - - SET [NO]READNEWw - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder).l -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new userse -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newy -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERI - /FOLDER=foldernames - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENTr - -Specifies that READNEW is a permanent flag and cannot be changed by thee -individual. This is a privileged qualifier. -2 SHOWNEWo -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN.o - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format:. - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersh -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newn -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERa - /FOLDER=foldernames - -Specifies the folder for which the option is to modified. If notp -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENTh - -Specifies that SHOWNEW is a permanent flag and cannot be changed by thel -individual, except if changing to READNEW. This is a privileged qualifier. -2 STRIPg -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped offn -before it is stored as a BULLETIN message. - - Format:i - - SET [NO]STRIP - -The command SHOW FOLDER/FULL will show if STRIP has been set.c -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command.D - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.e -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGSn -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for thet -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected viai -the SELECT command, information about that folder is shown.s - - Format:' - - SHOW FOLDER [folder-name]t -3 /FULLi -Control whether all information of the folder is displayed. Thisf -includes DUMP & SYSTEM settings, the access list if the folder ise -private, and BBOARD information. This information is only those who -have access to that folder.a -2 KEYPAD -Displays the keypad command definitions. - - Format:d - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either the SET KEYPAD COMMAND, or -if /KEYPAD is specified on the command line, the keypad keys will be -defined as commands. The default settings for the keypad are shown viae -SHOW KEYPAD or HELP KEYPAD. Settings can be changed by using an -initialization file with DEFINE/KEY commands. BULLETIN looks first foro -the file pointed to by the logical name BULL_INIT and then for the fileO -SYS$LOGIN:BULL.INI.R - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT).h -3 /STATE - /STATE=(state,state,...)n - -Specifies the name of a state for which the specified key definitionsh -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when -a key name has been specified. -2 NEWt -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you entere -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format:c - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this.d -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGINo - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDERr - /FOLDER=[foldername]b - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups. -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSIONp -Shows the version of BULLETIN and the date that the executable was -linked. -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBEn -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read.B -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format:g - UNDELETE [message-number]p -1 UNSUBSCRIBEi -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See theu -SUBSCRIBE command for further info. diff --git a/decus/vax92a/bulletin/bulletin.ann b/decus/vax92a/bulletin/bulletin.ann deleted file mode 100644 index 7cf333e..0000000 --- a/decus/vax92a/bulletin/bulletin.ann +++ /dev/null @@ -1,425 +0,0 @@ -You are about to receive version 2.09 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -As of V2.0, BULLETIN is able to read USENET NEWS via TCP/IP using either -CMU, MULTINET, UCX, TWG, or via DECNET. It can also serve as a NEWS -gateway for DECNET nodes without direct access to the NEWS server, i.e. a -DECNET node without Internet access will be able to read NEWS. - -NOTE: The following commands can be sent to BULLETIN@ORYANA.PFC.MIT.EDU: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. (This does not describe the NEWS reader -feature, however.) - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -This version includes all necessary modifications to work under VMS -V5.0. However, it will still be necessary to reassemble the ALLMACS.MAR -source under V5 and relink. The V4 version will not be installable -under V5 due to a change in a shared library which BULLETIN uses. -However, relinking by itself will not be enough. You MUST also -reassemble ALLMACS.MAR. If you only relink, BULLETIN can cause your -system to crash (the BULLCP process will do this because it uses the -routines in ALLMACS.MAR). - -If you are running a version of BULLETIN older than 1.52, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. This -format change can take a significant amount of time if the folder is -large. If your site has large folders, it is suggested that the new -version be installed during off peak hours. NOTE: Problems can occur -if the old version of BULLETIN is run after the data files have been -modified. Such a situation is possible on a cluster where each node has -installed the executable separately. To help installation, a new -command procedure INSTALL_REMOTE.COM has been included. This can be -used to install BULLETIN on several nodes from a single node. Read the -comments in the file for information on how to use it. - -NOTE: The BULLCP process should be stopped using the BULLETIN/STOP -command before the new version of BULLETIN is installed. It can then be -restarted using the BULLETIN/STARTUP command. (The INSTALL_REMOTE.COM -command procedure does this automatically for remote nodes.) - -You will be receiving 21 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) BULLETIN10.FOR - 13) BULLETIN11.FOR - 14) ALLMACS.MAR - 15) BULLCOMS1.HLP - 16) BULLCOMS2.HLP - 17) BULLET1.COM - 18) BULLET2.COM - 19) PMDF.COM - 20) MX.COM - 21) NEWS.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. However, this only applies -to PMDF V3.2 or earlier, as later versions of PMDF have the necessary -interface code for BULLETIN included in it. In that case, or in case -you don't have PMDF, you can delete it. The same applies to MX. Then, -read AAAREADME.TXT for BULLETN installation instructions. If you are -using the news feature, NEWS.COM contains files which pertain to news. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@NERUS.PFC.MIT.EDU --------------------------------------------------------------------------- -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line.n - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width isX -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for thed -BULLCP process.t - -Added ATTACH command.e - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message.s - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message.i - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETINt -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this ish -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is aE -remote system folder, when BULLETIN/LOGIN was executed, the same messages mightd -be displayed on both the local and remote nodes. BULLETIN now will know thatr -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect iso -that users will not be allowed to change the setting. The main intent hereu -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder.t - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was2 -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show thate -there are unread new messages every time BULLETIN/LOGIN is executed, rathero -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages.g - -A major bug was fixed which was introduced in previous mods to speed upb -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vax92a/bulletin/bulletin.cld b/decus/vax92a/bulletin/bulletin.cld deleted file mode 100644 index ae9f5d5..0000000 --- a/decus/vax92a/bulletin/bulletin.cld +++ /dev/null @@ -1,43 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vax92a/bulletin/bulletin.com b/decus/vax92a/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vax92a/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vax92a/bulletin/bulletin.hlp b/decus/vax92a/bulletin/bulletin.hlp deleted file mode 100644 index a4d752b..0000000 --- a/decus/vax92a/bulletin/bulletin.hlp +++ /dev/null @@ -1,145 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". - -NOTE: Depending on how the BULLETIN command is defined, triple quotes -rather than single quotes may be required. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vax92a/bulletin/bulletin.lnk b/decus/vax92a/bulletin/bulletin.lnk deleted file mode 100644 index 9f20262..0000000 --- a/decus/vax92a/bulletin/bulletin.lnk +++ /dev/null @@ -1,11 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.08" diff --git a/decus/vax92a/bulletin/bulletin_source.tlb b/decus/vax92a/bulletin/bulletin_source.tlb deleted file mode 100755 index 7fa5e25df8de46eeb565a283d8ecdd1dea4706df..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 894976 zcmZQ!WMBxBWEW;;U|b`x4EGRX#vri}76t|}gqR6Pte=H}K@A~h3KBcd!oV;EA!Y^=<6vcA z;6sR+gTy>p85k-MViq8=HdY3PPY5wfkk}zs28IiaJTTwIIr{nCVr5{EK@xKIak;|^ z@)<&vn}3ib8w0~GBvl?h0ZMEP3^oi1RX%>+AfYyhm2RFsuEC(NS7BpdD1d~Wo4=2X zD>y>HsXren{s)W0G}ssz8X%tXb@cQDB_~ZbP$~iY)6X>=>?e@W6G&);219(L!v=~y zAyCN1gOs_1`uawKf?Su4f#DJ)HG(DLoUPdy80Il@IS08qhPcK#`}^9lF)%1F^1DWa z1UWi~#E1Aefkd6y7#OB8aQZrWyMh8U&W(+MVF3f1Zv;rPkPVcgIY2gnxRclz7@8O% z+>nTnIcy9JFBmuid|li?vS-;C7+M&)gIz0ZA0Ycz;En?n3|4VkGz)gJY-F0&AnB+y*Hm7(bM@U z6a9BX?CS5O?t86nz1qF^|KETA|NsBb$i&RT%Er#Y$;HXd!^_9dARs8js30sNDkjb# zAt@y-Bl}-YUO`bwStUUAy_&j)rj|C7j;@}*!D>SzV@(rNGjj_|D{GtIwk$e!_709t z&MvNQ?iwD3o?hP0KEHfZ{rm$0{{^`QGoKC#4GWKmjEjnniH(cDkgz8)DLE`9H7z|O zGdSx{c1~^{8%KV@-@>Bel91A}%<_u(%Bt{cl^Ubky84F3rsjy2*0%PJ$W8;FuI?VI zV%9vNUcEl`{OtY-{D~7wCQa_=nc^@tNO;=x83i*v*=OA^b(}rtilEEfdAalFFYsNs zXmOy{62GPTy33Y(tXR1!X7!rg78`1#)~*w&yPCHCqUi>ujrTT*Zk7z);wG?FV%v77 z9bAPwckSl3-m|yfWZxn8{cDU59K3sQ{h`BVM~)tQk#oH0u;PiACr_O|qilKB|J-@G z3m0vdU6bOwbos!%^eb1dnV-9!qJ6{Wrp&EmvGV1|#BblZd+*1I`$uITMDr#+YHXKm3Gf2svU1U^Zdh$*tHceCscdAdi`eQ+nRTupDvjBKI4P*$4_5dK7abs z_x1XUZ#%2LFZnU)=c6wP-)8+fzisO8cT4{~dC=MXch2mxRjohYG#%;qcWUADk2iPx z|30_(?dx49H_m9^f9ulr#rw8)JzICD`*F{fO>KKGPkDIb?6g~b7WX)j3UiCGw3nsGUza9GiWhr zGH8Is)fvh8K*CO-$cIi;~s00pOBELHM+b^HoT`Y#3v@bOioG7NKd;WnwgyymYZ;0$8pEc>hWfhN z=KJk!tt}m$5k1{qz4QAfO`Oo*uQPdy#`I}ZXT;2zJ!|INbMxl~g)dsTVDW~?<;#{X z30$*!)yfrnwrt+Cal`s`YooUA+PP!LTTnGqjK8o0{Hz{JSR^q+;5 zjhUSlTA;A-3knGR5oX8};gOP*5Em0wkp9gkqp6{;rmCW>q^KY-Co8D+_t%bSQz;=% zJ6juTD@zM=GgA{|BSQmyJzX8`ub9cLeP8*#@P8igEbwX2 z)Q#xtG1p?R#$AcOoNy`eV$y}=^C{<2&!(MDKb3JZ^F-G1 z>|;4ca}Ve3&)-+Dw{TC<&f@JQ+e){VZ7$zbv9WSP)%xmnHEV0v)UB#t*|4HclCNCQqI;W#ZJnX}!~XW^~Q$oYgVA zeNNll)_E=Sn-?@KY+Tf^xPD39(%NO!%d1vYt}I_wwz_0Z@!Fzwh3gA8P$Bi{w{{Z{pv@eu(}Q`6c|D{}10^ z-hbTxx!6a`5^9$tAoGT1S;ERB?ZIHi!0=z5f#CqCH2GgoN@;TSG~;SWF9*~z;o;_G zVC2jGEi5D`z%TNLLG-V@oUDvAxIp>mtnfYnR#<4k3znZv6`f<#|*!yvJ zNhrQXk6d4u6a$%s@COg%i0%rEb3g?HMe^XxGb3tE=wj) znlQP4O5fC;XN+b|mji+LgFFZcpsqn0?XvBM(Fz3_lch zIQU4=(ZFN=$9+%uob*2BdD`QQ+gaChF6W&tI9_zPWPjQAip^E)YgX4SZ&=(kzh!pY z^p5deqk9JT^&jXx)P1D$So?|AQ_W`@&(&V2zEpmt^jh(a!dv-wa_?n6NPm?2B>7qV zi`Z9@Z^GXNe(?X~{>Am1;}82^wtuYunVCk*5>Vc!HXfQ~3GPr}Vc=jexUz5m|G$6# z|9=lIW+0s#2oplqBgRXhT^zI?4rruA6*5kutD~=HULW8fRA*cQ-Fj z4__Z|zrXVh5`Y(?jKDZC=xG+3^_Vmf~x1heti+3MCy#Ew# z`Sr`^Z}Q)N|6rf~^UwDi=jwm`csp-ePk{dK|JM)fo;;y2Lx>{t>1_twtE zvpZTVi&OnPnBKj7asR}Osf}gHL4o!>|Nee?{`hi#OLJ|6ubslLQ)_ax)Kvxfcz?cr zb!YXGDSb&{KBjuw?;kz9d;IAB&Fh!vhj@EBSeqG3|9|t~{FaRyW@e`)#6`NB$jOQe ze|`4k_JzHx7R;}!D9_4F_j2U^eDPpgLs4|Fs|G*YrL(6uty{aaJIde2Kw09-$-~>W zuAJD_SyfUH<7}j+B*Xl4S#@HpuBPONYghLzY_D-LR}>RqWx01~`=Zj^6qipQkL6j3 za&gX?Wg)f8@XVfGp-D}lwkjfX-55s865Kh6e3>C!mT)jI{Q3R=KL|-T9(c&m#?0{N z|9=J$@gIM$=PC(h34@L8pli*wi^PC_{Mv?`TkY1TL8V#-}7FCBAyhT~b_B2r89wva>QX($iAE ze|wZ17wf6^^8VHHYiGAM)@4Px8Opb{wlqTqTxvk0FXd&WKR4`SO%Y zQ!h?CH~sXCQ!|gxIyU?0oWpYu%{w@M|AO5McP`q#c-xZAOE)fCzkJ<_)hk!6TE2SO znx$(OuA8@h?uJ<#XKtFddFqzQTPJOsxV>*j@6N7Wox9ujwC!!)*R;R>K<&ZmL*<9d zj+7oPK2~@<|3u!&+*8@7)6b-xO+A-%KJh~2#js1kmjkc(U-i4@d)@1X`%Twd&bOWJ z*xj|gXMNx5f#pNAu-JEm=0C>m%W@`CR}KEsRuAM6<#{{OFs zlqUE(JxFB<3pWQ3FCP!TfS{1Dh=_own79OJ{8dFpMnP6XPF}%42h>LSV_~9dqvimb z&~Zud(e}^@iO`MF(=RXx$S}-FF{&vsF*Y@0Ft7Mw@x}6mjkVPqTRZy=4ve5~kL!~a zZtk8Qf4v?A`1|?#c;5*8e4#Js->(Ca5#eE>A;AnE_RM*E=S(wG)Rl%bP;({`Qjqkg z|Ni;)>HWL6_w87@091fH|Ns5{%S&6=%$N=$Ooj5*aLeHybk8hqlwrTCM zc{95^Tbug(dcjQ}&^Ru%jCu6%`qhhPPaiqBcjx-mtClXBKX=xouJ*>PwA8rhNMBeIPjmHf#CzV>w>>6f;^rADoZk1 zSlKcZ*b_N8x$=rr^SOD7c=`BCKt&3JsE8PYxJ3HDct-HBi5!!LyuyFPU`e+2FFl=$ zIg%K|ufON&{Crm$;A?BFDa#2eCxQYY>iOsp#_hzWCdb8)n>vM^Lql;h*!;s|Gn_!0R%>Ra^Jm@l!P<37Z{O?Z>| zD(OY?^OR?)Pt%^HKhAiR`7rBV_T8M@xwrCe=HDo|UU<3aQt`Qxv!!RsPM4pkI97SI z>PYqBnnSe*>kicKZ`jwkw`q6tu9lsxJKDClZ|&I9xv6Vo_lBPJy=(i{^sk<m@$9myjgQ*&zv)3?(})n=1*NPdEul*6BhR`>08>ntY>-mimsKN zt2$P(h zp8~)5fAjv~9xY4ADkX^1G&IW+g{vWVSvGCpdcb(#Cp%;=2f3^u#0HfmEUd+B>^U4I zoOxVD1>8Ieys3Oi{J8>&$!UTqnL@(pBA_OUWW1DgK7&lDtb)AUe?3JerGLtd&_YE= zyG;GBA?j3)CZ`p{@B2H;UG0pGd@zP&|NI0^d%nDS;oRvHM-T7YzGd^ewX)F?GuH;_MyOe*i;C$iPqBF&(N=}v@FFRI#q~cKJ z!Kwq*`)l^r?y1{dzpG(K_wr*%!-@c|}b?2(CmE9|PmiI2}TiU;5!s3aG zCM}%2V9NZd^QO(6K4-@4nKNfin>}^Tl)01VO`1P(!GwkVi~1J#F6mj?y{v0_=ZcP% zZL3;Wx2$Pi+qAB6eZz+Ojdh!9H`i>b-deS-a(l&&?44P=GIl5IiQ5~qFJgcAfv|(2 zheE((uK~yWkNchQJ?V4G`?S{?&$Axq+|RqA%;VTzx4B_;)AE+ZZSy;3cTMk^+&6fj z|4{pp#$&Z7s!vs(DL+?wq4-k%mE3FDH!^Rf-$}lg_#pmK?32i6p)Z181-|ir=lj9? zljj%rZ!YNAE6ZrRgt)?iL{&qxEHU5~l-$4-I=S=VJ646?j0`p4HLak*5(aP+1z!gz zG&J-oXuKptft4*apFI;aC0xYA%a_P6z)&hERICSGXi{P&RVl3_6E7<#uaK-*pro#x zqoSFss-~f?QBkg`m7=Yqo5Y}JXrP~G&1l3Ftz;}`|KHH$y{Q>&DyPie;TN-`zAo$E zG+S`@2Hrdg3Jl<6`!~N6)OATm?$|^@J3hZZ)?~S|JiT}I)PX&_*Eh#Th6Z{&*jbt> z%1TL!3G=f=WJ+cqsbi5<0t32`w|A?_~D zjuz&|Mh0rq5<=W9T&+LazO{et_}uxS>s|NTo;STO`(E@vpYUYj<4F%EKbUfV>fLE~ zrr(}%bLNd%*JfXtb9wH?dFSSzU2uBg$wem?A7658>Ct6JmLFbmXyw6G`&RE=vuo{+ zb=%i(-LPfj=1m(nZ`iVK>)LH=wy)l?YUj#bD|Rp4vt;k$eT()lJh0&4+(UB?&ptBi z=*(j?j!!=^?d0TBlTJ@K(|@+_T<`gw3*8sHF1257yV82Ku=TFuD(-s zH~U`t{fGzQ55pb>KMr~l@YMgA-*ev=J}7W^adm+v3%e;$s}J`Rb+1X0R|W?8}^ZZR{-(Zu*u5D(Xf<4g?u z>lqlpD^30rYLbBEL1l>oXyI!~YB5J5WW8E}UM9alvLHigzL0Q+h>ob3cxAdoJa`SP zm7KhSrXoXsJ)#(Z;N7#41?D7))hud2(y6(Q$b^_kdYEtf%5m)w=eHrKYR4x z*43j&4(!{rX7#cq^CwQ|@9Sx(j|vY9_HeYb)lyTGmz5D=&1A{?nf)W@d+yh~&-tGU zJ{Eo`dSCpey@_4?Uy<( zc3$W@-+iv4muy(Ne%adPt5&RBxnkAw)l1hbUb|@B!u1O_%-cA3)11w-x6Il)bK8vV z(|1hUId#{R-IMoB+S|RaYk%i~j)U!o+77oKX*t?_tm$~;iQ1Djr>aj^oGCk-buQt2 z+=YmXp_f7~2VDug8gR}3y59}on?AR^Z+qSGyz73??Y`>+mxs=eoF3aev3zRr%>238 z3)7b-uZ&+CywQHE`cC=19MagUD0u8u06g}}^N0H{*FTQ`?4#`xqRIwR6%Ea@BtT{2 z<`Ye-vf8fvRlGBJ8UD#LfEy%44w-<;5|&g}1vYk$d`_-RZk|M5KK^0>LA}acA%>DX z;UW=Hu@rHMQXR=;(0Y2g_-y$C1w}?B<#d%Cbp};6^>Ql>YfVip?J^xEU46YY16_?+ zdqWdrBhw@^hm2??^M4kGoX{fWFTaE1e*>o$Q-9FNE39dvrNYYmdrwcTx2?WR5_Gf` zR)z!x2K;#Q>g9_kkMG>Rdg=VB!@HKwojrB(#O{j1xQOtO-~c;WVF4a?wq%x+KdHac zex`rV_?G!K>r3|MoKLwQ^FHLiFL+n@w&->7^O9$!Ps<*aKdg9AdB5sj_1&6VwKwZ- z)L(D7)_A4qa`VNO3$5qc&bFWFINf=&>qPhQo@2d7`;PPh5Vf zr|+1tede}VTW4>Xvw7~Oc^l_%Sg?NKx8fQbm#-25YwolnHY3GDp{k!}2^zQB2*SWvrK>NYAL#>CKk2D=^ zJl1f${zM(PEU7w^bvEH#%=swrJWeRMEb+hQcis1f&rPpep0_>jxZicV=X&4ef%8MB zM~+BkiOEajS4OY3->8Ah63ALL$k;1lt(wqpLD*Wg(RK-`#RO66hh|x_;DDK`(q;jL zWlRAxSQ#EL{1Og z5@r$+6)O;zkgSxFj!%)5$z_z&lV?y+WKdF80WE^n)X~z>exISMr>_6o;4gf@#OlBG zFHrHJ!R+WzsOzK|0-EMUDL;IT*jPXdP{PAP|6Q;aW50j#V55(*p)hNCSt)!<2EE(! z{Mr1bGCx}@QxknvK8~mN?p`^yV_s)-O;%cRY)p8NhohZ=lDw3-2zY@CXsHVN#0|I~ z^yB-tuU}rjczEa9nbRka9X+sX=caXQRxe+=c;SLMGp6))wYSt&l;>rqCq+j^h6V<> zIysnYtH?=82nldaDfGtW&wKkdTQi<2)+x;*j9gsc76 zdaw7~=)T!;tL=8{orb&h_iFD~Kd5?`@F?za#FMb6A_rM3oOxWO+&LvYxoNz7{3!zEf(6CNLc${H zqWNOtWlWh8k_=Lb(lSZ1*>du!ItqG<%1Tx$sugOCn(EqGni}yw3_801^eQ!AYw2|@ z%+)QM+1yc@TTAK%}+ym$S=$rHzq?%J_s!OUrW zT`hGrRar41ULKCN)|UG6(h}lAG0d@l;=aXyP56@dIq6gKhm`lJ@6z6;zs`7-`8?}c z_S2jvxsUT6QeQ^n)9{i>dw}mX*k_@s_9ts zk(R@)huRLdAL!WMxvy()_nw~Jy*vB1_ivl9b>ikpnbJWpkF#UNLLsj8)TDPhB%*?c{Zn)=%6pVPpTM z-pxH*y0><2>)77DqitvFuBP3Mdm8rE@2lNkeW37Q!lAgs(MO_=Mjnee9)2S1Wbmn= z(}8CK&ibG8JMVkJ`=aM1_secqT(7!ZbH46$!{MggEt}gGcg*ja-7~$9SVOPkJZ)M-fyqEeQ`BChX=x32H!e0fy2_TKVa{lG`$Nry{Wwb0Iv6vuA`4BBj zvN!{TrEX5$wTkDA(2Gol3qSv}H~eP?PYx4NqQJ@$1&&nCbgq&V?tC8JL_WwG6VW`e zO!4Gm2}vd?X&Hu6*~2+<@(Oy2N@Z!vmFfj57gTlB)HO8XHGdsCprxX%tCOueL2rY; zL9Ugd5onQ#wWfu6k-a5@l{KRyctyRTQ|;e_SuW1{uCs;RkSB@%2me+Q3Jv-9{>-t} z8L;M!0Y7qw=X6|vti1Bfhu$KNQ`&s_I;&bJvs*lwlYTnhpt$S1dy5Uvh%ckee&sv_gK52X0 z{;=ag=l!lb-M4#g_1^5e(SL2im5G-pU7CD;%Gs%>rk$LAV#bk~`)BQ&y?4%@xx41= zoWEni_J!LPZC$)&$>yb-mTg?Ve#P3AYgVmVy>iWpwaeEnTfcO};*Ew*&9^-}Srad*A1Q_d~Boo{v4AxIcA$ z=KS38h22Z-S6a~ZCGzj(KFEHQ`2_0Yh<_FRCh}eIhrmzXUp&9Lq3cUV=W&QC8c0?& zG|Li~kThe>Mvfg!@1z-i$V0m~xcfAS772uPm60ixnT0hGJYJH^rNGU@l*!9iki;Kf zEFfrADkPjEBAOzmCoZAG03Lj0l#^FrP*ze@QB_m_T~VU(S5p_Volon3rKVw#x>8!S zQ649_=z#C|QxX34qN>nMLtZo#xd8&(x%2POhqtd^UcGYZ;?V;;x2{{Wa{k=D+Vbr5 zGh?koyj3fLf%KDN|@gEc3C%#L1ll&^>dFr#Yr|C~J9%nwvdYJtn z=YH++TFdYXGib$zHR+mCTyO#Y0}2Y8>XzEx^~*?>8oa}n7Mq`ve`@L zESbA_-lF*n7c5vfZ_%8^vzN?TI&;~K<p;?wJ=;KObNa1+gFe8b9 zGv+=s!+-vN?2sab5kmd{kEdvXv`bRia@aFd6gW7!^0_O)!> zBVFC+x9{Jbxhl+l|KdC}z$@dy3tmBOl=(3Z`WH^y8fq$WvVa>TW!ZwP_YXAM8}n3P zA4Qqh9~uc&_TuTitCubwK6G%;uGPz%!_19T<)lPF(>xe!T|q-8e}4Y>`sLHx z*DoJGynFuK{@vTxtXec{>ZIO|_O_~utcY-5FHc7s3ll9xX-NrDApt(#N!*jaPx&_W z^R$oCKg@VH^UbVRv!Bm-HuuTANAn*nxU=x~qFak^F1fMv`m$@wudKMd^6aWJt52;t zx%R}m^y-*50eRU;Uu)VZx)>$I(xso<=?kc^>>C@TLDNzt=u*yx+RNb9?Xl!R4dVC%ey< zU(CLmelz&4{X^}i@-O+{vVUa$ivJV)&ow&sN=gwywA!IrmUQTN@A77Gahl4QBgfDH zS~d?JF!@j1lrVUGNgfL;TQNIFNe*Wk7k6qtPckoG5x+p0U~XcHP(gZIXIVYwy zbE5Zn-?9Fq6OK$gJn7Kny;Jr~-92sB^qn(yfah^G&)GD0!@M=~S1wq-aM_}zirw5J?9Uj>|wt8am)cl#*bCVZ_FAZMlzt(!A{#Ny!%6sJx ziXY`Z$$XanBK1}Bo5Xi<@R~K<0$mM#oEtE+9xyI5f+WNvsT9Oe`vgjhSM2 z=ZG^rusiUd5w^nQKkOI+NPh+!d6hAhi8+ylHB*5tA2OB03mq*f6)h5z5SNrHVUU)Q zla*Icd=H(ysnpUe*4AOn1NCh*nf_N88OAdho0{ms7SjL9*0Hm)XLg7-fegEzF0k`( zf11I~>S+yKe+DfsyuA*pD@FawNwyV*O$PtY^%G?Ia-_exmZPo~)QG^|Cb@9p@PXZ{ z=au=I8t7_B2=TN1`26nvm5b-jo;kK}&HT=~>a5t9$Ovx_H)nfuGecEb86Hm1?qkf! zou40HKDl@2>gAJ%_V3)WearflE0!*tJaIx>O<@YC#pL7ZU}0>eCNCz;$2FCG+TZDa zW_+LdZPwS>pXPj+`*z-&`L7qeTKHno^Tp4WJYM=}*~8@zR@_~Ad)2MgH`m-)dwt!t z^_MoB-*{@%@y$oK?A^L&+pg`~c5L0bdDo`h8~1Dgw@X$XSblKXp(TeGA6ayC!Lhl= z=bV^*au&Q@GWGnF3zIJPUFwClOFFK%-)Ozra;xcfBX}OC>VEly^oMDWk{%~KiF+FL zEckiQi@=uwul!$oy>Wl*`p)IO(+9_oHlHj%>wnSys`X9fyYdgkpK`yXe@p$5{44%X zN!_FR zhYb%J?={_RzSVNG^#*vY+WF3NU1z(`^qlHF*>|G<_=IBTMx7xY(CUOIey61S`;ep*l+ebE! zEuWY_HG5|I+~kGvOQTl?(6f+`$6g_O`$T^T{S*N2?c@2&4O*+lI$D+xT|khaaA=k# zCJIwKu4D)Z6#S8Akg;cAsQC|Smw@JliR$KDWn{`{Rsikp1C=F-pnZL*d};gwm4ZUT zr6LTXC1T?75-O7Kb3ju$vU!?{3i5JFr&W|y)zvgKbwEuM9c?Y^Vhv*>L*4%uqV<>< zf35EShcfp1H$ceQ$?^A2^Rply zD}dY+`tj}a%O}^*ojSH_+t!UMm(H6zXUfFBu9l{%g5((R8aF>L2RkbZV*@R9X(6`OI9sjy=cwCwF}nGUO#KYjE&RbXAVr*-n*k`XZNno z-5q<{_qOe8-QRqm@nFND`onccYK~SPt2kbMqU>bhsqE8PXEM&FpG!HPa3Stu?4{7l zAyejWXt5_3#=+N72*ps6_u3LRZ3OWV%0Tt zHS@LfwRLs$7_9X*k__w(jg7#EHd-=TTiM#${LkiO`l|%#@i^GqxyN~VdYq0H_WqZZ zp~#Qg@A>`f#gl$Nhp0ol)~}gg9cgFCk(UcQs02}>{Q3I+?W?=juU0$GOmiw*uP|A`ky_fqg^6kN7XCt8FCBc`1z~`6vUPFwRxZiQR>w3@SzVid8hmPQO z31qy)^aW(yD`*Y9+B?PP{t^O@mvH}M`#(A-Onmu3iprr`mhhy6 zu)17w;;`VoG3OWKgMNGP~M0&w8HrKIwbh|7gO4iFYU6nS6W7t*JMs-I#uT#eCF}o{e|00 z*H=!j?cUhDwR~ss-u#2fN8?WhpS8ZIeN_dIm&pH=`z8BZ;*a=W(SO3D<0YgN5G1G_ znq^6Y`ATLH5y>?i2P)+mK7fue0k4|JHqMGo4BReZWn<6JNG##VOy%S%;^s-_&Ed;d zD1|Oq6H^f{kdTy;k=BzfmSd35Q&7}o0-qtB_D@|$gHcmkOBZo!Gz&wex!M1Ucy){4 zhwZI7Q5U^h{{65zMdR+(i>FU)$ko^4LY)+b?$P=A^2+5iM-J{;zYcUF?99pC9c@jG z)#-835uyHm9`1Iwmd1uk@^)~xW z&g#sFjYP`^NzWH3s z+168SC)Kr9G;`yuwX@gE zSv7a%ycP48FIcv4@uEeG7ox3uowjD`+9~jLuYH?)xAbi7+Sa+f9lE}xVNdp9wn~axVCM(1pN@0hfF)`&{w9>UGWYy4wxc zn=asU)g13S+_SlF^}qspuA0eHqh|)swO^>cRDGrVTJa5J-7Dz)63I^z;PYNVYt@9| zYt=YL&o3dNY#>$X&@4+-QZ(7jLfHimEN5hRXAhgf!LyA+AQbjsmMpL##E?3tYbP~OCfvSoclR9{HiI%3u|9^RD zoQ4L!jgs^sYh2+A)foQlVQ~6;VSY-0x~wDzYKI0sW&Hi^(}(x3Upjqg_pVLr*DYHx zb;{(4{hjq?+0jvvAwk~mZVvWVrdmpJqCx^Z++0yC(Z6DT#{NKBL;o@5L+bmqcj<33 zUT40_dYSzq=Xvh4yeIjO3mz3dD7sgCx8zRg?Xp|tH!E&bUaPuVeWm7d?ZvwD_2(MS zHlArZ)qJw$MC&fj&vUGItVXIc23waar>lglebRUGIjH`jng;GSUYpgtkttu z%~?5j#k}S7mo8X>QI^bHHDmSkHPhBkS~p>RAAGG^$JX|3ZQEOSwCrq#uAzsNCDjM3 z4pkg3KT>!!<5>FfWbmAD?CF>@5og2Cg`E$*5PUK4lK*ADE528Kplj7!Z@Jud2Cr4K zyKnoz=Aq>yi^t|q%$}M&Gk$Iao)gx7tpOb`0qyOBta}BmRTKLz@O@aMlg=!93I%Mnni0&AC)>sN{R~cD#{hAI-tEc>T3D&`g*#5Qf=Tx zh>@Ye{|qxdO{U+!E^b(}sJ|{N#y~|8<&^qwA79?Me&P7xeLJ@-ZfQ&i^>xtK)sd6p zUUDvnkjsXA1Bu;xJR{<^*Odm45(?rPf6yuD>x>(;i-?VCC_cCPPQ z*S)r9b?>UamHjIwET6b+($dLGrYxMgVA}lY^JdJQIcL`F*|X-%oI7LQ^!d{kOkFr- z(d5OGmP}kaVOihu-W5G7yH|Cs?p)KcwtZdO`qmB28=FwhRV&Ki*(I{r~|_!4M%AVIL7u=O8g(M_2Js z2}vnwZ+{tCxj^t8e#IW)Dq%&cYB|Yy>bdS|MjD#sTG~39x`}!P`UWK#Nhu75sYb?( zCZ=Zj>PqJ67XPfREdSdWDA<;j+QEik-J`rb{@gWYMm@nXEBx2tHIoc+P2xl_{Qddv z<+J;Du3tQV?(E5~8}d7F}7G5bt1bVQ!|cB`+ex#mUZE$WrvX z_(#e2(r;y7%fG<)#XFX4U%GAC*5zAPY+ku()yCE9 z)~s5)a@~sc%Qr0BxOCH!&5O1y+`3@f{Oxmh%-K16*NolM_e_J1mrQ`}$LT)Wb*%Gv z$BFint*07J*Pp37TYIhsx*sR|a@>{Jt1;K2uSed9xM_FG_O{I(>$_I>Ebp5>FnOr= zNcXYM6K(jN7AiRVIKtrlIG{E3yni5b!fc~=T98me5U+G-mL(h>PC`u@6;4yC7u;NU zpmFzukJ1dk5C4Z8*T@KJr{G&c4_@~g3_1&mgOe+OnndM-$(s@y(BQ#vVDGWZ%>A{Bsa&8kLOOU zT`_M;Z%uZLw}+dx3?D1TdiuAoZr{3oa_83dtClaDKX>}n?&jj6!rb&^7XuY}X>nd2 zu0FQ@pA)`M{5I+9)Gt5bDqq7Jnzx`hYKDoytC-$;u}k@ zExo+#((>~w&aOPO>cr~fYmTiwvTpzSeH->}+_h=P=IvXyZQZhM^Y%?UHtt-vYt8PJ zdzS89vTyPJMF$ohT!3`0+O!jsPfj}3ce>|H*V)c<9p~FGv|Vhy)N;A$O5@drYxURb zZdBi_x>b3*;!gS9vU{cXOCA(F%z2dcIP*!`)0AgP&l6uHyo`Mn{W|nb;9I+QmhUY- zn13|;Wcu0Ui}6>rZ>rF>YO=qj{)qh*_{aaBeRQ8N@dX44Du-rSV&D+e(V&(Xa)Xtl zEKu40faIG3d4})(|K%7M{{8#U&%p2l+(rTQXRu*#yCf(WG+qKaRLzf<&x2pURWM#i zSVUAoOkBcK5?qwX>nL1sR8)#nR`Ca2mJ^ntsja21b4Zs_U(e8hLDR_n;09w2Qxh`= zb4v@W)1adn?N=u{gd*GGm8sj!vkH+bQL9d*jXT#?@U8K=;Zs?FCX8& ze){&tR;vNFA#tWAvNr6tAq`Q~!Z`#Jx|f^Q2y zE&8zd-IC`^pDlZ`{LzYsD<7=7v-;MWn`>{ZyAEFWdS=s!&BwPK*}8w*zU_N=?Ap0w z*S6hT_H5p}Y2TXts}8I0nS6HAxxVwg7rHODU247D za;5od)3wIy4M=54>AjNs1>kkBDUXw%Bt1=d7X94$h22ZrSC+3W-k85NeP{IE;Dgpj zwNI*_RlX>HRr)6PUG|5}PpMzxzXksAg4fWqjjk^tp@bk_>Ch}o0vH?`92`aGi9FIT zcqeJ|^MFX*cE%5NKiC->>i>f-^8+ti!&Z!d#lU5WE2|?LXsH_Fwk-|tanVxJkTYHt zm7JA*K`j!E3!1@NjM|>MI(qsFaRE98hPp<^hfG31HJLm%9ARAN8&%4t(no;k;0Z$iy ze0+4?L_b@JmcKv0e|mHG%!%Vun(ON-%KS~VWO-R;OvfllT7SHH`r!8ElSlS#U$=JE z@}=|VHdU6F7UpCn1bTb8*;!fWYfFjo@o;m^WSjME_SZRI=6;y>ZvNW^uNOXF^lb5y zC6AUqTy_V37Sg3P=hvQFcXs`$4aYX_-?Vr0t}Q#a?%1|%`_>&>plj&Y?_INR<^B~1 zmK|JjXz}4iM;0DkaBR-;*(YY6oN;RU>1k)Co}GMd()qp%y%&2fbzknf(s{MxTKn}j z@EZEY+YNVW?pEKcx?l33_+inbg2%Z}GM{EVOM9O3BKc*~tJv4kZ^GVsy>owW|H1mB z_<;I2Asl|3zQJ7FK~6lbZoDphj^JSvQ1e7gT%uS~N;*GJ z26T3`qCcailCv^{imtkvYJr9(la`gXj)Jb9zB^=Q*xc;@KRwV8?1`{Y8y$7q3xbG= z;j0%lJQ#ledTHnF<$1cq=kqBcP%8wyIv(8B2@LS}^SyHE@al>Bk_mrbJh^}G`0{xZ z;$v(LwN;d)B!qdu#RRArL29u4{QmL7^`i&&?^wHP>HN8~X7;zYR25~Xr9_5%JJ@Kc zsVa(zig2*Av6M2G{VD%Z@vZV})tBl|HScTR)xE8M)9||S74-ZP*m%j^F68q|E>Ao^ z>D=VAQ_f61Iqlf=BQp-oJP19%1av>nPPFq&Hmq2`a^0#m;PXqCty{8w@rFek7j9ax zdCr#ETW4&WzJ1z`sXM3an!J0`p1!@k`+D|wALu&Rd8p%X+mTl2d9Mv8>rd64u02z8 zw)$M<`HBnW7t1b{UM{?ndo|};*7eLA88_2!rQS}ylXN%nUc&vj2eA*MA4NTmcoO*3 z>zT)M`xn+PEniu@Hh*LG*7Tjpd*csA9}PY!f0q9u_f__r%y;P@;@~?i`2O(z<^IR@ zpL4VDqEaMRTTygOA1InkAwQy9{d>8mxcRGQj#b_!h2#$`Te< zHdk=7#KRLbVB)C9uOJX4s38<8EF$VJ#$YS1sUwjgDJAVIBO4hYC-1DFsIH{!qN2*6 z7ObujqN$~CrLAM6tEbOtV3==YYyxVeFj`t!`)J$PrrOy%I97&xIXS;~b8~h1<)rKG z;b+KnLCe$2`@gSGgx~5S|A_%AL4m>GZcb>(#pvHLSFc#d+6yMc$K7*COi4~UY^Nl~ zhF*%C78NPIKcA(lvZB1~UtLt70dsYKW|#~smIepB1N7(k!JQj&(h?QrBzZr-e);10 zwR5LV965Ag&-Tr0mMmU4Z$eFRVQh?vgs_kRKi~RwYuBt^1-^ZB$zsq&r1K#6lK%bj z@y*>kw{KiJf9B}=waXSQm^)|Ylu5mv9WBijrFq#|NpaEcHm1gEs><@xQrsLH*f;*% z^keh)E#J0&-S%nwhaK;BzTNd|_p?1u_deP8c>kjV4-Y;#bnEcVBiD~!K6du_$rHy; z?mxBf^xiYO&+a<6UrG#r0Z$>v$p50FPdI9zG`?~|EBhB^}DL~j|Bl)64Gb3IgpJ4LC|HNzYYcJX8rs7{>ouDB~fgsr3br2Ee;bN`-{r$`5yVp;hI51~ce@A;w ztOT}B4Y-W?^YO#GS1(^Yee(F>gZtMmoj$UE@2>4zw`|_9cKI^U8L;!FPnkTSwW+b8 zIxRWQ#@s|vawhkzpR<3=`8N0KyifDrE_k!>HF%%!qosG?=e=HDeSXckwP)9zS$}fF z@r}ne?c2O(%kHf^x9!-zZO5ja8+WbWy>8E%y{o`|oFxYr9h!f5?vdHxJ1wT2n0j*3 zsfnli&h(z`IoEx@>q6(nwo5ISo3GSgt-Drxz3N8A&GK7iw~Ox--7UPAcR%Mr*2DBi zDUXw$Bs`6NX7}9kg~dy=SEjFx-x$0Ft)W-`AP-$bFa1>tx*rEJj{{k&HaaIveEC3% z%Ar}7I0$%mZ`$IrOmE>6r$$YQhpQRCHB>Mhs6X%>dIKo_bLl~43A|n6$-~PR@6WFw zAgCwg=qIcxA}VGmt|1{Aq$B0RAnhv?X(byXC$FWTs1&TM;_a-emZ~1A5vH!M>7xZY z!$eO%z`)(m$jR8mR-4mQ#mvIo(#XmUa_exoxuX-K^F>g9$K%%pPj4>+A3tCJtAW;a zW&uor*+KtSLmMW+7Vo1E8S4tgKvvZsPEAR^C)_WH)-Ji?AoBP0o=gc*=#u)Q2Q5ua zYW}}Cv0-_BjJ*;s8&z(JaeBX}E>({JWF>lJ`zV_zoioC?Q*eEX#IRT!@9y1u zcJ1A{Z~Ojj2euyEa%j`xjYrlUU3+Zh@uer0oLqcr(dmU}=ANB>Zr1sk7iL_Xerej} zsaGalod`WUy6aZw?Y29ucU$f?-EVx*@UZ?-<>Rs^B~Oc=6+JI}QSdVNRnF_IHyLl! z-=(}y{*d%B;ZyYI2=E$uQ^UvzSaB7|ewJK^CiBIeh4V(LsAV+k01o zY;9m?F*-0D+3^4GykO9v2xxOoe|CsEXJCAwDC%7}LBGG>zkcoXiDO6iObBzb))h|t zxq0KvItwLcP=5y7G4)@+e0u--<>OoDP9ERBZR@(VYgR2?v~d2E_NvPK^t9v{FAp~t zXFDrPa|10!SqVWNt}2%5Uo}5!ztw%N|Jd-M@m`T3@t1Z-3VDwDU>Vqwa@2 z4|?zR-RZwQ;pW5}lP*ubH0Au%v(wH@KLy<Ev{vEvha_?ZLxue8DEy{f!ZelPz)4tm}zXD7mb_sa6geQoXkKa*1&@~h~Z2pS%VGt)4)uzYW&8OWex&0=HgV#jRn;OKNZ+u6m{Ez;NB(BtqP zPp^yKqCUQU!T$FG7z2ZXLqdzfgu@SQhzJvk)H8~Tj){ovk8@6lPdpf&oFtKwn#Ppw zmcf&inSD$>M=}R`8J<{0H z-1O_pth&-%TIz@qP2kLN5p9ttV@>4;?(Pf8X9cyLau}v3=X;t&11UnNd-Y z`S;IH&>7eF?_SzDw<<3y`Rtj~r%s+Ye(dOx!{0uAeDm!5{%u>kn@{xOwN+?c2BR+`N0^-sSuI9_)R%>(P$K+n;QD zy8hXc=L=rUemV2i^w-ngOnp1)UEllO58WTTK6QR>|I+rg zxBOqp|MZm6@e+~>2_h8_&9bB+W$Im#hK{XePfUK;JYZlTad#iAEb-ys4C3PU3*qtQ z4dn~w7f^5!bPf*?a(849_7n+&%@E7V`O7OPx+y8E#5<{~sNK_0kJWH3(9}%I)6&-Q z(A6u|(bqR%F!a_lGBq(aE6*unRJSnK{aX?NIs)3-%JLs4lcNJ)ywA3n>%a9#J=8^;{4p~w3t9^3oT_O&~>0Z z+^NiIf6{+te8;$J>kasf#+Rip%AS`$gWlWssODkq1L(bdx0-G?-)KSH+jky(7Sie7 zQ++4Dw=LMRaML2tnFH&Wt^=Q6 z0=u_w$=b#17Oh{nVZp{Zn~={On7nh+t_i#Q_w=CM+t+-w=~(0Oh7rU02u0B(B zw(?xr`9f&BB>hV2)f8~MBo5jx@w)49&;GvM1KWo-k1WCaaZI0?JU4z}^wJP~7Lw{) z`FC>fWj;t_y_*~~k289w1(5{<8OnxcS>oWhQHyom+ujW!I#QMrc?|6K3_tD@e@hOu zEOB9X<=|xC;tt{Q=jG#fRuBjkj2Chg_7o8f5OWs?_jTMfIc1&Xf_>z@{S@-8H1rgG zb(EAg0erKfeEdtALMe{ACgCWuS#JM{H>hK0;PfSSaDo(na zy?^uK;k8TW4__>xim#Pl;CEWQ zu7B0=vhjJ-v*yPwk6ItJ-D|(wai{Zk*RAfGJvVx<_g(3~JmJE`bCb?aJ~QPs^iB)V z8v3KNkD#rg-??PR((TK(E#JCg%gW8GHm%;cX8qcA>(;JcvtjkdRhw3BUb*6Tvinrm>CQ9lXWP!To^QF( ze6i_L!{z!bHCL;zRb8)ykG&S&EdY^aUc|hNdKK|H{Ef|9 z>vwAJA!DzQ^Ij#siG3ISA@Wo37w>P-9iXFS2^ob1ky?gkS<*0rcb}8N2J^KnC5aCh z{v2Xw`0<^D!;qk538*OH@^|Fs(Fovm@&%vx8XWJUpd+j);sa`wcuF!zNy|j&frn0% z5+jvU-5EkuY#CM64At}1HB>Z1wY05tboC7M4UI~TnS%UGyg`Q{>1$hCS=!jyI@@sC zgGvtYA=3ZczgZ6@b}lTSkMx+2v|eJ-|x@Gm@qdbQMS03$JZ=hHm$3p z$-z#Dr>GEflg`(VAKtvackRlVBL{bF-MD_$l1209OrPA{+*nqeotc !p@M?{dT zn4{!p>5sDS<=-m4RDQ1dRQ(=&KhCTA7Y)xFpEW&ge$w)|^-q_~-%nWuW*DYlM^~ zK5Xo+94?#+T%O!K!T!AQp?r?~0^lve8e(qZ5|SZOdeRIs0kU$=e)0;DI*OV~%C;)1 z>S_$?oEn;1nc6ChIzf86`i2I&M#d&u-lq9ZOlJD;EiKHge8X*RtpC^9{j;}na13;U z_H2HqCK_scd-?eL`Th!E4h%}SHfBXCQBJQeR*IYNU7o%E%cm$ltcOT{yL(~T zl6kTAGQ#YCzrQ?x{NSR6H8ElCLfqI-iiS)i|M~Id-Sa1pAKbrp=i1dPm(HCza(M5a zT{|{ySi5R=cUyC9d1(pwEVtyOXfsm-HAQ(jX(Z z*YjS@f3e`%!l#QKEq=J<_R?F+ZZ5yE;`++VtIk62v^ci@=!QcZ4{X}Mc^`OAcsuy) z=qDY_SX!`4fOwch zo~ERff;4#PYm}n9l9isaj*6|LYP_1dhIWKzi57#7wyvHAqkgf0q0v1X(D6uS4DXrD ztt>6VtqpCAz^9t*c5?pj1u0HKjlEBMdYEXbbNc!Ebd% zrLK$J=X=iep6NT)e-b=ia$xfQDf_1GowjHCt{FRKZlASn_EzxO(VOOPgx*cQYRSr_ zE0!%?zIesLl?ztQTRnHp?6tGj&0IfY!}N{QHcj0;Wy@rgv!h|>y|x@^hMxCYeYEOW zV_#R}-%#T#vgEdo$)%^zFzyfp@*{d4bQ4 zwg!)vm_9XtpE)4^TJDYPTbXy#;5$GiK8b%8`y%>P+^m zsAy=GB}x-kxN$U?=vUZCG<>jNVBoI-ZRq>({~!1aX~@PtJSWm$Wprg?W^shoespA%4Co+*5x}`!fCWjE^%v%z6XAYYVbZ7;@LvwPjbAUtV!(<+)X7 zSD#sPV(pQ22iEW3uy^C0O}jSl*s>jZ*A{54+J@ch_pIByb|0u+0=m-zbl29xqjQhV zhPF$lot}DT%Gt@_y?s3wyDxQK?zqx+we?!_^`;w*H|uZJ+^)V;dAH(TIdnfx;p2iQ zc~5hnWkdJlB!KthIKQ)gZ~4LEqxmPZ&!%4tziNF``>ygs8GNUO_#d&qqW?tx^YVlkhRGamR$!oks@;5#jtU0GP!LfAPtJ-N6wc;a<< zK^+|bR6!vH;UET0kzi3VKXDZaNj*@BA}6n)qzD>uRaf)Y@Xgm`($Z!GA4cz1r0-;S z+KSWINNabR$$L`|by#s?mh<1o(82y!oXg+U8KKTfzOZ3eP$~0oS(xA1L-Vr}?ARb{ z(@=*_{`~&*?&XVTpbp8MD;JI(-LY=bf_Zai&Ft)`FUiYHiVSpju(h!^7fR+x`I-77 z?R)ySjIWtrvOZ^j%=wV}Ht$XT>w;H>&x@WGKPq`xdavwm`R$5Zl{c$yR9~;TR(rMX za{Z--i;d@-&NZKDIn{cy?L_-=v~$(=fX`^$K6%@ety8y5+dO^KjEyrl%vwKt?VL4p zSIt{Ff5n333zsfhvUu^5g-howo4tI-is>t-t(v-e%9_b*C#{>fe!_TuvM3b0x#?@9%@f$@W(KNP{Mz*_~e>UcGp5|N7O#yOz(NHDzL7Z%=J*f}ORQxUi4_ z8*3a({7;PYUf*TD&3cplI_G8X^So#IPYa$DJ}!Dx{IKL+>D{tB@UrAu&E?ulbr`d#FQ;7>m2JPsG=ew@)h4jCl{VJ${oX)gR!CYYS|M#z} zWd>Yq?=PG?a(Ly;-gXCbQxjn!J`OBb4FCK4>c#zgw{Kj#xO@AW70VXSpV-w}Us+mQ zn46uEo?>ThrYtMKQ^8XCv+76n_nL3DU+ccqe{T5H__66j^ShR}t#8_1x4-Oo-ubNS zY4?+!$GwmG9`-+&aChRJNw+57oN|5Y~Q<&IU`R&QOiW$os5o7QjKuwmo+P3tzV-LiV?s%^`+FWs?Z z=b~K;cQ4p8Z|~fFbN0_ZFzeuqL(>mWJ2Lg?lw*^RPdYK-WIy;Uq;Bw8NNpEdE;e6k zy4-lB0lXil27G==`R$TB1$XoBW!+DEkoqtgdT(FMv*_pEFFan_ys~_43_kBw5oO)0 z1b9D==ueSfg1`Cyfc6Qq{~sMMAzUtyqhe^5B`!)%?S{tUQrqHXBv=Hc$?6=|=_f;M<^+E-~Ycs6JGe5otPSJimQGo$UofgQJY zclDBarQwRguO45$aOT+I1B)is73ZWUCB#Iy+Zl)oaj>&>w70c__wIq##X|S&{QLX$ z;}g*2&Bb#^_wL%UY30&|)7l#9YYX$TV*@QrO^nr4#6|eHJGr|4bpP!6(fhscTmP2{ zpC^8r^kMS5DQ~B~nf7}6%NZ}A=c+xL`*7Za`L`F`T6lBOjm6iOTwZ!<+4<#XSDadT za@C2|N7fu#dk}oC+MbO&H*Md%ZOhiJTefZ9zH!Hfo$Gh4+r4(rn!PLbE!)4~z}$m# z4$VG1>&VQbGmcF^KJ~W%kXk9Q95Z9Z6n$4gYdD1VjvCi`9HhxAX$UlPB? zVDmVm<0a%26$JGR&9cNHOe4fNbds=dn%BWCTpvEjGt|{XPA?&T9*339k)6ZGpEHEZ zgPVt!F9@`|k3q;)SY5ba+&mZ4kKe>D9;+c~h z)~#N-e8J2q?ahs~C20w9k(OpAk`h8Z++5ilIe&A1W1Yu&Rr#{&1^5oor*)6(A2mE| ze9&~K`F6{#)|+iN+OKz9>%81`0X&a$w(oTRsR<`09-nk<^3f@fd;1Q~I52ZR^!$=t z^LEbPfp&h$`W0(eu35Ee^@=si)-GMQc>SUc3pdW&G0&_-7}l#)-TLo8og3`t@=j!t>QcR_i`U( zq5E;fze4&rpmXR2e)Ip~`^)=}{Xg4iABSMMK#qc;S(Y$G_N)l%R5psy+2GFm;R8Pd zsDA@GXaLmeAdIgvhBAS-_PKI!h6Hi>aP#o`JMr-gs0a!P2aA-7dWrdoODITsN<~P^ zXv)gT>u75zFeo}JsVEz&s#!6qYieleF*s^->gnn*y6C?*03V2??`u{RAE|C>VXkYH zY5o5QsQdu+aq`_3+k(oIKRL-)Dl-z5U?(+#?zZ^%>;CB_C8@Ey>%s!uwJ_Jy|Nivy z#l7oSFI_ykcgLD#3ua87*w@uon3tO!ZD($*Dla0G%9Zvv{b$CH%vcKkh$^D%7 zG5;qo(OXN%7joX@(Dei1TWl5jQdTFmvR8{sztZ+YMLxZ`lw{+`W!>j#z( zEgqRYHhp3Oz8^>Jh4M?qS8}gq-^jd`ekb)_@`J=j@lRr(MZX9`&!LBny@Jjh7#({h zr<@>0&(JJO6mGRGiJCYifhje89pfa~1IOzb4t)O)-6u>;Spq6beAw7If;e45xZM4? zeVuuD`S^nc1f7J0!$cxPJ;gM2#UmvYB&DQ7Wn@$26qN$Nr${s8XlRCm&XCsA ze{aBOWSFO6tmmz6Vrt05V79y1#JtENEg3SOWAEVay}P$=UN~{&(6+fV zCU&|u{>d!SFYd_SztAE?@rtx*t ztLB$2&s(3hJ#Bx|@woF**Te1yJ$HI<_uc5fKH=KLtI&PI=cb*VerCq0nI~r*pM7-B z;kgIr9hkp=!M=ri7wuWRYspUVy?ux^^c&W$U$<`k+6`;KYv@;OS+;fQwk6va?^w8V z!LB*GXYZM{cjmt7`==e4dT`32$%iK$nQ*l4Snu(k6I~}ePj#GbKht`) z>o3(^t_825ue@Gyqx@#!t=!w$ce3tg+)KZo`XKRP+@qMs(NChD20pWYZui3YrPeF8 z*UE1c-^#s{1@Fg^`XmXzYfJD4kN&fEK+vNl9B8smLhF$|=Yz zDXOX{8~BC#sHtnXm}qGR*_vxJgm^O=f+vQJn0%d$(;UrAP5zr(Xn~iffe#@_iFS6X zD=jI=_jmc1mmA<}hTI@=cXPdvY9k!-_t)Y1#f6D69`4FqoaxXLULh+_zym9Pe*gUP z?&Z@b_wQZ3c=XV&oeO47omf$nlaUl3=;dH z@S*U1(c9uTC9g|gmAxo`UhxcTyW~22Z{PXOa~OO3j!Zr{<-pYa)Ami@J7dqx-LrPg z-acpB+^zGr%-_6V)548NcayJPv1;YYRV!962lsJcXEe^+Ja@~St+Thy+&*K+^qtdo zP1!wp&m=5;oc7~wCt6RooN9*O0a^>a1GMr=`PH&(+1ImfWZq1_m3%wlPTbwtdr|iz zA4EJ1e-!rE?uqqNt7rPpbzW${)O@A(S{~)zKG<3{A*4GkxJTEjky%a@s3F=bpm`hx(0Q-m31MD727XV05KTcLVMEYH z9Ch(%2`2+dDQP1a6Ili;W5^7StErNiaxkZgs+ya#x`l?OmUfV?j-I8yK>(wlp?RGV zX!O;$*xQSR$=o7W&+=E8l?V7JXVSiT_XCXHo#PP0>)g~9_#{@cRh5!F||K630 zrA6_vE-L(N*_eYR5x>8Gesc5J(L?*UZ(g%%`I1Eo=FI}FN$YB^&CAS4Pfd&nbyt)V z7vaj`$o-r5C;w-`kHT+7UyHw#d@B7|_M!ZJ#kw~D$IXvg z9=1McyW4)J<96q*t{dIgd#?3f?YrE6X~KDoy?sY!9iDw~&Vjl6=Ix!oXTk1;yB6(S zykp6>rCXP6S-xq-#+4gZtw-9A1G*n)@#ckF=5C#{ZT9w=J7(;hzH8dK@mm9IV;pTDR@zaR-gdC)j z!h$6?FP{rG&C6J^5VCRRe=El6X!m>Um{4w{m^Am_-Kj0syxbhnvqeA$jzAA+T|8M^ z>E`s_X8ApkgG9E1jv3kT_t%9JdzQ`YXm4wB6aIc|^OE_qr%mjvueH5&@xu9YNN0*b z4k7vT=IN8GM-Ly|zHQ68wX2uUoil4ncSE|GAU`|X?{C+yTs(hf-`4g0eO-;Y$`Z^^ zpFDo_@WK6ickkT3b@RscYgeya{`vmS?Hkw59zU{w@9v#DHcqH34)t}ix6u-L_5*Z< z#`AldHmocw%+JnDOG%Cn@b_?WR+SVJ72@Oh{ORL|_wU}mdHw3;i|3y|ynglK*~167 zE?+u*>d=8*YgVmTv|!$hqJo^Pq`1i7ARkvp6-B8ppWeNEytJ|cw4*2^H7vx>+fz)%KJPX14j9bNZIPFX=n&(JJOIwmkJx|AT; zkSf8hU|t}{aKN4cRBRjo7aQ{6O@9CX|HnC}11d{2Sya znbW6Dn%GlWT9BWck`xv0>F(;JC@am!Gn;$P&$-{`eVzYh!RLh^7rk5jY{}E5kC#1K z{&2;Em3LO%hTe~JZT;m9mo}c?bZ+z6EoZi#+IC|5@f}BY9^AEm_r5)Q_U_oXegD=2 zTMlkIwD$0tBddBE;=>$^qe!Z&dxYD_573zlP~sN>b=~3rR!?vwYKZ6 zH(G8s-)g$uc&8qGr$xns@`q)QN*)(J$$OgfEbDp3i}aVNuaaLUzDal+|1R!*%!lZY zp`QXj`+V{K>h;azyTcFrpLV}&f7|>~{wwoO>c0U0Xjww2Tp&k&XqF`nOhRY04pvBK z?KsTJR>tthv7X_;f8xhXKxGN2i=)q>0J>|7mw`{6U%(H%wvLX!p1z*0fnlkMp;5H4v5|=>qj#8@1$eB) z++7oLSxydUilH4r>@azEt%zdwhIl1;%|gAql|??d^SX(@>j z=4L5BUcJ0`p{Fc2-bPoL7uJSBy5Hi{`xlSz+`e-0*p~Hc*Q{7Jf9|Y_Efs|s=}ECs z4)(ShigMxt+#GBb%#}Z@zE^*%`C9u0<&4JHt_)GDBEZaHX@lh~6ci_WXIb8^o;{e*7kG z)C5+RaBy-laP#=N8YuAc@v93sdI}1;3yZjk`iqH6u=q$yg*fR+%LL2H$r~y-D=MWb ztGKADsT*r(Y6WTQXy^v$Y5MAdj%-vlHcHYlG0ibEx3J{2Vz9Qcv-QwtvJZ81a58ar z$#X5vaC28m_VCQ~N=eiL&F0)M3AZr!FUk)LDCJM{3J!{8Gz+m53a!h9Zp``j%Tze_ zcS3yJ|FFb}KsNAU0I($|7t0F^(ydtYKOe0v%Zl=LXvT8q)}J5mU%hmeee3; zPIxo%^`z&MA5VES_2IM!)9=ik%qlCxtPvV|NKZ|^B|HAgA%`5BI z+Hcg}s=QN#uP>4OBJoumd=?U9yaaR>(&!p`f<*$^3WjD`(!$A*AfRTqd-XE{Z|Gx`XHZa7&jYP@RrT~y zSF>~0($wJ8)zQ}1GcYtUHVO_fE%r4tFIb(!WC581?$3?%GPSQs4s&!Uary_^B<$jB z3|gM{H*QN9$Vo(42zgv3AwKT+ z)x&l9DG}k0I?TE6UmjXpo{=8tZ>A~Ef~6Pq?aPZN4{u+&c;U=}J-c^+?(`+a@} z(0S4S@m#hAYnLd1=5ajLK}$>A1OyqNg-Niaj+CFYj8BlPqnx~glcA!jlCptHh^nuq zODKbydVq$jx2BenKWG<@v%Z0$v5~QfnW?#@g_l)0a&CthlPg!ULEm2G9pR~)W1o#Nit_kOo-%O+=~s35Pz!=S;)s$8H_ zt)>bdfYngf>(}QtIISgV`0tl3WRwIv7@MExU~e~{3r26`Hjvy*|>k$M)>nv32dLWeaD{ zm^`7cqp7y0GCM0RH90;eIx-?Gz|Yyi#7J6@mn)yW;7{R?qVL7uz;nXy%HLMJseE1a z3c7~=N&Vx7M~x4g?ls?Sxzl>P?PmK8@EZC{&^7dsvyhHVIz0Ihe0|C8nLB4~pS=x! z7Se`=>ldwCyas$0((>g?S1eh%c-5lS3y{{mPTw?b^VBU80Z<``0#aEZ&;GGkb6N!2o(U zxjb|~j?_2WNUHg#?Crg@s2(q(xb% zMJMO8vBty}#f80({}rjIz>ommjZ?yu#-5(>o4GbGf-5s?b(Ah=VPZ~pQts)ze;42b zvDyDulvZR^)>K#BpI={BTV5uAv>-;DkAnqty9IQ!-`!OG-4#NhNt}y^4{Q+V|8eii zJP~1D=nbFXYc3{DobYY!l5|-KQNj5)uAVx+XUoQwvszQ)?XATynkaw2e|h`z#gj|t zP8>V9bNl)=tClTVIA=m{XLEgBRb^JRgPrt7sZD=2|J?F*>*sBswtw95VduMDZ@}%6 z=lh=Re|q5Y!AFN49)57-&e7Y)ZXLgQ;`+&Jr!Jp9f9CAjGv`j8KXT#F#r>D|UEX_T z*VP@@wq4(PWAn{Tx7OWWerM_3#rGE6pZj3;!?d%};npRwS19PPi#|K$G5jLzfWD-y_-8=7T_ zLQvC!#)Ahg$gO+2lJCka&4gq7OH6`vtqk-W86vzv!>*qGTE?L!uDPZ@ zX6DXHjJg(J%L;|d z-@mwcVSaOYer85$g1woEkRbYg;h$gMy?*)Z>4STxPaN8^dBegP6DRbx)@3DGm@CUm zhzoFauyy|K`qBNp=UeZWzR&%iCVZUuVba^lZ>GGO`h41x>5peTn)z_n-Pw2M+@5=D z-p%?{_?Cf7te@<#E%K#-|O> z>YvxXsCilas^WF_oAkG8@8po?am2ogeiQkQI16cXKMvUi1rZvDW?90-z~LO>8S!QJ zt*D&vOyNz6C!M0!8EYgq)GzLTBg0mA&|bcQ`8#{V|MysnmaB{kpf&W6>x4n0B?5v% zo}hL~i3aE@3tMR!S-B8bd1r-0MWsw-l{C=GlHg*^d@XIAAl=-&B)?>JJ(qGfeKi9o z!-8<56n*0&6T=)(d18@TYU%4}?QdgX8)|2-?VzRWsF&{KtmxwE=3eRHSr+Ei zujK9H>&M_9P#73w6ddAV70MVE9uess6&)Fq%^9m27awh@nGl$mRcD-(T;r9Jnx2+n zni-XqZIhFmmv6GVps=WTmMT1>+RV7I&vzKI(ha^! z?)$gTA3r>MeCNicbEi%o-oAC?`n9W;E}k`g>cqCD#(G()BVtE?9{X|p>xnNX-<^7U z`pucwXJ4Ire*Wo&M;9Mnx_$Z9m77;DUps&O?2QvQkKa0S`_P^JclX`fdwzJzMvD#f#-Hm%Uo_df}S|Z|A<7^M3Y+nIETpn(}$_mq}kIeCzw(^P~G` z*RRgs9e>*Yw*G7R-z+oQ$04F)_}ZX6WMVpyJ<`@#P3Y>mR0~bC`5cCS zhY#*qTgLz5+Q|(o=gqCD%!*Qy;Nd`8rq{maXzr;i;yuxj~&nSEXLb=fgCmgZ*K za>9MA{XZxCnD}kd*U6u!e46@k+K1`yX1tyGX4dQ3ujV|T`)uBm`HvSoTKI6$gT?ok z+(WvX{QBz4Yc8!lzwYe%QyWffJih73=0jWdZ{4?T@Ah3gcJADG35e7N1;nYT@bmXXb$K6P|Hl`o(FNre2f-}a#OVauatXuG89dBuyumkF=pU&p?Qerx~E?!DCq`H!-n zAot@)BAtaK06ueo`#%@^XjwvXK|zFup;?v)x^Sqdi!d69_}*_g)PJ14q5gS2c$Y9g zWbHiuE>7rG21X|4|KPIZJtr48BdBS@1Ud)_bjz0bFA2%t%q&vU^JQh^=6pq7s8>7UnQN3L8lC4r$wHQ z;`H?Jx_eE6$H$vN``)?34oFwx_&&I}Vp&Fls7U1fIM3*)e}_VxwXPlya^pZ+j0P%J zz}tw=FAsI(`}^|6vx7UFDQ}@T7554dD-t@no@M_}o zNlzy~neuq*qiGMp>q~CVx-t9moJ(`h&O0^##De_`_buAHc=wWBOLs2YzI@w?tt+>z z+Pr$xnvH8WtXsc+-G;Rrmuy-H-rF||y0>pCcyHf?z5Ve0I9-Q3k8~Vu2cKU8+K*Fz zy6#NvS;+Y%KNx>B_@w_?_lwR~b?DjAO1~6;%l(o4EAvnKztrfQFcBpK=}LxX zS;EBW!NH`!>9b+N41t5K76~UD7PFemFduQ`arn$!^P!fZj=!#+;lY1~KmYj|K*!QE zeE47g|9|~~|Nr;@?~lLA$N=f%FmiDIhc-&y3kv-Lb#s_Ny&P#~(4mZ=GZ|G>)mE!( zT-DSH0JTN*4KDmPG`eVPVrphSU(@1>rIn2}i>=*#dk06Mdrrc9iKmOSQMWKDI|!HLikqeZX1t(7%Oq`RxLqer2?ulLvq#0vSlvkZ0T z%s#WD|LCDL;4aGid2vFh)`v%wzVEjr+>JV$0tC{MB3diwbC z2Jkh&H%}GhnQQI-{^8QzWfhXpdw-!lm(D_CY5palmfC#mm*LxZzP{PlQ5|TcDk~%Q zY2}PsA5#;wy*dBp^yH++`Px~laIyXPc4z07_3KtGoYI`1=I8FH4%>P2?CF!opWi)x zv}^0ewTo*?T%GJKl;os1-+y`a?CI_6mv?VpI&=D@zV?>J%A#B^7w2zZzkoLG{CWH2 z*0xQH=1!a3-Bnha73*(hrmrZ@%l-Z5>#4nM^~s)Ywra}qzkdFBe!i+WDgJl#pZ$L~ z|C{~4HFdOILV8I-SjW&TOBfl17=0ZYRXAMQ7Nj+9&`@NP)?5Ac?fSj%fB&)Fc9boU zJ!j2w=kwYiB>-!SUq_(2|n-ZtfnQUIE?*d=xZ% z{jLi7vju>!Bo|-^3y-)W5y>7E9itK}5*NQAAu%bLKP5HI!y!E*Gb>x?P|hF2yxjbP z8(T~Y4T_3S+%3r{RV+Jsv7EDF#e%#7o5~pOsyz=T>{#=mp}MDLMoI1ImYO?t7DsX- zD(YRP1dGjU_~9cX)X~`VXF?BiwY0X);cXAO*Rfi&Q@pFEdx=x8q-bCN z#0iuBPM$jD?KHpX*W!F<&73i3_S|_vKj&Z9U9@n4qv_(KOFkb9lwZ0meEGSpVXIcI zSgo~YqPLsty0stIrddhJZdk8cw{0t^IGW|Wec7&^JN~WQof#Dgx|ZBiuRqJ^-~o3# z%R@I$9j{eaf)+;KS9KNHnkk>Uv?$hJAGDM3a=Mqb^uxK0RmJ9N;LU)bvgy;t|g2s{L!+6 zaKS)^ilI}Mkl{JHY0+Ys%)r1Pz`(GUfq{{MfuSVs)PBB0QyCZ;_!*cOWbJqvWNoY- zFogwgO!%RFmIo{*!60k1=EKJgNykhb`)p6oS|)wo3yuHH1WBL*6$kGKewAZra|ebn(iaeak;KZd{`jZ2J71)@lzX z2HAb=46=L9iZVo~F$gfoZc=AhS?Y7NY3B~h6Ne9iT(wUXBKrPz=MTXsrp))U39JfR zk4;LlFwQLzhlc%m&S$1x6S;h;Yrs;ti0!1Hgsx!zk1bW82 zR)4j`g$D{;SR)%&@UkbYq0avk>d!WdVi(Qqf&`4h%9- zQ_beEE<5QPwrCm1+-|myl`};TZBv$JFkHPnKi0y)H*eFXiMK5MZ)wh+w0!!@FPi7> zeqoS=%5F$^K6lD3>$y$l@*J;uacQj^-ZE$~7_KfaQJBAC^5S{CmQ(K?wbVRY`YFiE zAk_M~r}dTO70os^8Df!&Io1jck$uw~ZdJ1@aV?oP{fTBy*7Gg==Z>+T@LKS=w3b`) zO9LB&)=ckz{3|6H0=S|-&ECz=5xJkIsh!VbYcb0a;im#W&nh#hfZeiH(dmU~;!Z>U zC1<{NOkJ^ZZt(*Dlb26>DE$4gdS~r>MRl+$Q^V`kwk_wLvu#peHD~II%;z#Mf@n>5etWg8`Zby>v z^^@M32d_BJmzL{vHrOcm)n)3^gXcV(yskLP?Mpn*TcV7jPBW}URj557Y4H-6B0KF$ z*F*+TC?8Kb;=0;*xmCe|LvQoWCT2f>p|CZ~plw4e12e$yBgUg$VGDqVx z(?IFjj-2uaR0{3wYnuA)OYGMR7vB}${R&F8s;H$++Tpu&quZOnxWs!zfha>5(h^c1V+b@<;_@D~)S zUa)hGnatM*U{QULjYO7B0tZ3_rPCqjH-=e8d zbBHOu!jaYa#Ayf3dIlv1%ggac4kS6ROPF;h1*F96I@g5@sw|0|=YtLkd@>3+Wlykt z2q30>0OiEx`6%Ussbdy2=L>n*|I5m|U(KKZE+77C&SyCDHI846VLAf?Lu}u!8m7uE z#l{|LZB%L8j6OnkA_#26IA)N!a`<1N$t~|?unrGpy1J_0F0`YfsG894b#I_Ek!FkY}+sXp9b^3_{6UEgm?Q? z1#k|OVbEAQ!*%QbXH8r6mp$C$wY9kEI$XSu5n&KCGU7R1*|3cIf$D4r0%hAeCJm3Rx4TUb$D2`10Ju4?ozMQ!IrRs)KU9 z5;)fjOjEjOy+puf%k+d*n)9`0&(NAZPb+Zwsbe9{)d!TZlmY$7?FiEynC%D|a2de= z4qH3o_YGl&ji&3l#U@!^J-1OdglEdJX^W(3*NRXF)t{)X2;R`i)04zlw}Z;ASB4M5 z&AZnKY_o-yTp(AcubP|fD|}#mo)}}jzvtQn90Dvu(f#JmS8hgfBnlZgXipisf@4H18x_fyH|LY=7I;?isx;qmH@d5 z)aFq_Y4fNokv22rE%W>RAg88b4U1LW_3aZJ`6U^4YA^D5eLivZ++=Hh<{wwjDova8 zrFtdL^ezTT20Pvy#ZA$@AYWZQ^Ayw@SQvT0Qz)blRwj2AuL3n66CG{Y{=7 zhcG7D^{=B(EKp}4ri{hb2J5|Y&horP6l=P@FE$N3_AfjmKM-?7ybi>^-w# zt6$cc0L6WaOTVjw+hEvQUmz38cO(gi_{McbZfUbKw-Ji}^8M74n-d_dFHoZ3sm@!V z%m6C&5h}yhaCocid+~m%U-R6_EK@;|v2jwk2+sDG48tr21_n?oY%a7+mt>f;E77~I z_&cNG>*uac3B%`#y5^D>T7QR+W!jYS&<7;zwUhSsJVDwdvdz- zG&XB>POZlHyE;a1b~fsPT|A3{k>NiWOEMTf-><~LES!Tpi*p}HiK-9Hp9x3eFwR;x^5M*v&5tyeVQ?+_i3>;TVa+>rk$yv z^8(ps3)6eC&uu_D>Npu>=a^eZZ4`1$1o7vIG04`KO*^k$UW%|#F{_Om)NhnzkgaJ{ zEGY;--p2IlW`?-Lq&M1GX{=d-J}L~LJ{$=1G04_b$-1&{@UD6OhoipESeN;p%tB*%(!DBlffH>rILCMB@G*A?&mq_ zECTJL?r2qqcTyeYL7~ac5Xtw)_lH<4s4rUQ=g(ljOM#ssvd+){jO%m;HipQ$Rc9}_ zGBU(72r{xa=sUf z-l` zY}L$+91R98u#67GELh*}$)_mJ3@4YB^I2}Dy^%?|&BzHZJ9>CoTcm{N*vNrZn?A^O z7IL|=rC1=)c0$1dP%rRCfP+@2CO;@fBpCwjW(V!a5Upa0*lZv){rcS_>eJL$&0*R2 z5uA_NU78vFL*yCeFfcIu)PA?I@UDx1bmnsfGZ_yHaA|f!^!~+Nzm-8|DS^!5yQcN! zNQ6pR7r{gWzQMH9z8p8+U4*%Q1!$Ic9W>M(9)B>LLzs}LG8@)5(Rs9g$r{o z3nx#!@w9Y%Scc+;bZ5U+&tm5YH;TwGyxiOA=ho!f=KT5K)X8lOKW4w!<81siqGd7v zIv+-c_Y6F+SW*c!ey+>|i4!}QYoGTBDDuF1^^WcVe5#;uKLrkV4u)!h$n&3_-s&(i zfLh<+5a;CaG%*tqNM3i|?XjR2L+8=QrD@wYSg0hvwA`x*N`0IRk#*`P^|~|^SQ+>k zUe;}Fxf$D6lDO!kuaJi#gD}I(x=7y}YPN=AlFT!T6k})DNEqxk~%PX5?k=c)ixj>wDX6uUB4fJ6e-g8ViUp{5x*6>Eh$P zLBI3kCT+;8&5m@-auj3OSRtwG^5SFM%D?9No)O#kl~yjjR;?k-V0k&8DMHxxo;JAQ zc0K!T%@PKF21_v+h|p>=hPez34Chj^_3tzAF=&2%WzM*U+r`bSYEQV50F18_cZ@?2 zBq9hCIrn8Y!!?)w?_MgPv;-PgDzUWckZK4h?fMgyxNGUdb#F9eQ&dY;mGgH6=#;W4 zX)$OPD{N)lc)mK7SCfVRt?G=dQ_D}OEjzVrx!0AIn+&f$@SE!EdsQgpHkYkDgXYob z7dOTFS0^95_;|0-nvXrJ-P^8je4wX1yFyYqDI6YKYSJ3iR%NL4cYA<~8C^d8 zN>GjQkCQ>xX0oEfLA@|=9b~7*Ap2>u_eEFH-c6d7RWma{J=;IEX<-U3!JGd#B$~ct zzCPD;`y&Ny2H7N*>0D~g4o$JQ_W8I4GSzTp_?NATQ-9$zElS&c8j~Ws62m+O28Q~! zZkNqhO(kU+R6t`IX&gsgAK2YhD@zyQh4-ERTz&LGXyVjGKhG32g8EDx46-&t`&RGa zI}Pgd@iNFBx;n>tb%VFX1I3-n3@i+?HBNKX8Dwi79eyP;;nmhnQ@GMNe^(q_vF=k< z99!LIql*=nn%YxN{BnEm$g2ube?Wvm_K>F>_w)h<$?g5C{6hY^%qlyl%*r5p=%9oa zC@k)AGsqqS*VzYEWh@x@7-SFKys-MA*=tkB2_mJE!VI#9DzmNku(Ye|R(SaJ2=6)k z+=f9CV(NhjjQl4%3um3#mhIt^ZN0}O{G2k_1j!EdhAvLUdeip>H`p0u5B2K0ns+eB zG04_f>xM57Q=FSN>;E$0RwhOE`BMwEN`G{5a5JSqU6loPl_<L((=%L7BnUFd9)jAoKMN#gqriZ$Q3;=olR78c=w+hV3W@=DvB?vR zKqZKs2!rgRs+?uF7+z-_K6-`gz>r3%y3@~=M^3UjHn1dpNJj2b|yd0ep50-TwTrpR;YX5Ggg=u=q=TC20COkuD zE1M95ID?@@@b^^zxyv`KoU8mW(7fC6XqfSI{#l?=SBPErQZ*;6+A15jXyR-=wodt% ziEr*GNBEfVebKDkBr=yrP=yO&hQ2(=g+HR^dK_UW|30&?XgRx^wR*+nGSJZRKNY!i zstoMlkyq*KhZsOUVqpl4Y13k6C}$`~njI0Dzx)7Xb|jvGh2g^E7yL>L+Dff3UId&#oDO6W3Tj?D#g+VJsC|E$O)AquW7m5tr z494?#8TEyEo7fpd!0i||hI!z|DGx(kU){x+Tk;RoxEbtN8Ro2$pBKxZ&fu|XrMc|x zl$D0<20a3aD^DuCn%~e6FX*&!eI!?%VAv!Ph6M}^3^#c57&*(B8B`dgc6gZl6@07f zsARc2*EnvH$nD4<@^KX&y`q!sidTqC3;nl(6eD%7R%pl5O3~~ZbS{K_vW`${szA(Ja@82NI zzyY#v(Oy-LE6TWhtI4RwJ!L^dU`s&GZw3{HrC=YivhX)Vba8dBnV~p^VT#;>zi$PV zbh31Qh+bU&jyFt&Va23Ji#T~2HMR-+GA=$4l>ES_Ac*lGvqD>XV9O=uE&FY&L8@Yt z7cy<-k?PXW5wiXxsH7vfgUM|#OM9mO-ykk#Z{0uq`foy17|NMeI3!;PSQ5>k83uD)cvbze^LP!hWrXIDeTGLOFQ&bvBGH_h4L zA-ZtUAqk6ME(uq2B?d-@`waXH%MS>cicGAlSitgvf5uEj26l!y>&_qJI8(#G#jx)G z0+Trz$t-CKj121;l%V0V<%9j6H5@Wa*)!^^TO2+xY!K597iU<=z`)=zG4$V|MQ(x; z3{RQ1t`X^Nd8+KW>ijW|H#(xe&vk@3W5htQ%Ksv)mjhz9P|0dVh69haUtXSeF#4eK zf~0P?HbY^Z)T7t=9tb8jCgxmJs9=y`P-obEeV>NTDYYDzuZ(vmEnW0-PO4I(*yXt2 zK?e`J-|Tq7yld%(E!XGSFmQv@e`li5gUxMB44e#e*727qJbCbED+3P$l<9fuzyxKG ze^eNjKbMaSGig)|oa5*`F+;$HA!+4?11lc;If`7&3U55c)l^iXV8UQ5!K8im=e)VA z(&WA0?fd=i`c5wOtOv7-&F9H2{LJOR!P6LOZhS%JW3++LhNGEnm7M6QWpbX~(SO?RUbgEB*GjETtP za-G%FJK4TUaL6$Tv|e2)sgPB#Si!(jcwQrE=?hIz+6!3H5IE`3D$VrmxyQT{R<2!V zdF(aI+=D(Jx(#BM@V|H_5+<+AV7w?TO;h`X_@RP{^R14$IvZ9V-&7?jVL9=<)S?Yp zUYj}|g)s0kES;bDOf+$aM|>Nrha5QHy*E6QAjq)pz2TW{Z7gngbspq~cRo4?YN@Vg zP=xrzgtcc^Yi#RAn>Y?c5ji8I&2GCaH63b-FRVJbwSxUu74@ z#VV+i*`Fvi7s zVpD64?=z?}#O`~)L8;(kPopubXoimJPU*;Vr`Md{@L@q{$|?(|uBOSn51bSkR2YnV z?@JpkdG^gVGOH#*XLWejfrU)18rx34)8Q3mPJO#|J&%8&G6Tc6`D`Bpm1g|o;E-e3 z;<#~c#v;vxD`%CaMg5SE<2dXZr~U(EC!?rFI-|Puf!2~= zW$ImejQ!ZApu~su7f-$Cl?*EWEw}JS-(8)V7mOS=XIKCti4w@?1(*bb1koRT*C%Vn-c)bEv7yxAzr4Kd62vkYkWxkgB-GHP2NrRatJ)IiBe@-OJRPSJX2l zl}cuCPXd)Q@m`5#kkq=3!=`!WSNAR3Svt=IasNNe9jLIv0G#Ufir6wpg6g4;r5d&l zzi%tMyzcX>TAE>ZH*O(Qs}VRi=sO><6<}DW?|fi8oBx7+=a)>;c&7s{L7=8@SYxCh z#lqjvqB`q*kARhf@1%gnSpgBU`@Q27859_{AFQt7FFYSOMU>Z|FQmAb)A9XO*V~)9 zoLRG+rW+Z^s4=Wq#OUVp#wf(+85fh*Z>7jBAM8Wsa>XuqAX5Kf^=#KeO#1_4z9^_N zYz<@73g|9kpB=~gVP&X^^q22m&);l2Tk&$K`+_^VfA~W~R=@bjpv3T$>8Z}Fhl@hL zu5A+c*yW=8ip%3`drwjPmIvYH+!mV|V>C3tY7##7#^2RZ=z6>5`aYdM{GrR4{=7kBr_~FeOLB$VaJD6<68H{~p?XLI>>I?T;ojCm6>!QtS2GJFsf57bqb%yd6!iV$v zL>QJZFfbG(z1_NAr5ogu?<;>_&^F;dypO~# z%hMI-9KEv1tg6v&7a1j0w35-4?z#e52C}%Rxq<+E4#5(~>R*DTd_- zCfG$R*%zTDutsZz>zhm3uFK}!-6pAjQh|$M&N}_ohiX13aC4|Z%EO3j=`$+3+*AuY zIBcDk@A|-_B*uD0#r5FHq&QiL)>9i)R2Y^QFq(P>PCK*+B+Jzj6?Q?4i+fR7bZuIM zCgUNaG@VxWL#iNKGqm(C2+iYVjEnOyj&bk}60v<{&w6N4!>lDMB0>YYZyZ$t*DUj` z%*9p;sWLn-1GNz4oIWsgJd6|xTo@N+RL>#D5XdAkuT@GwzajAW+$K=X^1N&chnsA< zQPOm~_U(~brH-1XLiE=**?TWc3SRun`9R{WY6c#L?co89t3f%b$+HdACSt$7izQ+$ zAHzBjLqf2_?&!{Bb8ve=9O846*Rv1R3o|TbU|{%W1gfu9bVLHplGMR&WWT$7Lewk) zhIL>D6LXs_=akJ14-|2>v79!}ZTrrEnst|Jx5o+(apj@C2nbz#pWXswoXX6wGpyAnFPK=D{{YPqJY_lyQaEk-w_DS> zwT7)cc+}yATJm#YSO0lsy>a&>K8kdGhFsFMlE{+4YO54%{ zmweuLNK1twHZzHHktB0Em)3dgiba0-z@hCLd_W_Bsl;*3 zkH>;xTH7K{Ej{Ek-7Uf41A~P+gOtH!t`FKjuIQ#54JghQVOYk%z>vwp#=_5#y|IW@ zBv8+*_-x?1sB0Pleia%FY7DXKuL&y8in^w8;ojrj9Cx4wZBU6jXl0tRS48Nn)zt$t zDsaUlC|}B7yss_D0BN;}{dtu(aYF!0onV(Vb9xtFz+{z>1=9}toKjmOV8if7L7c%@ zOm=~q=L(0lx>qz@KqbKD+h&hdB^lTmE<9$?THpok(GCUwP>ROxD6Zf;lo5N zCq*9d&a`bRG1HD1aLzJ{Wa@dPwf^wQ1@*VG<3-9E7*rT4dKOOQddd$fh)*uMIjJC0 zYfb*79ku?6lFDqN0sV~+7#Unu7=#4$9ZmQyY*LtT#DG&kte`Ap|GPs@UtjC#Ts&aV z7PeaMZIY8Z!}GFR+3`IuxlcBF# zD=g5|mNMzy<74uAwo2ap;0PY6E*IsEhvnZGd2{nCGN?1ixeCk_$ox5LLHDxxDHA4v zW3YlnGz)Blt3a*$L{M2F3vT6r$||pd*&l@}LAJ3nNT^FL0gb52GsrX8v74>R-+Fyt zi|a(jIUW(Wvi$>!f8PrYVm}st_HDHagA9Y+HsR2XB3e+9AZXKYV~Fp!L+3z#1z`?` zIejhfwbuVu1lhpMaPOQl12@CJ-xFu+a!!9*eo~u3p5fnRmWq?QQ4eotdG6roUGeOj zZKiwka}RmXU9F45CAAsU;VPmHGa>^_7ESmvQ#+(a!>A$HB_b>D{^T-~ioP!spMcf` z{`82j{V)S4gLx_*d+al5Zi0>{E?-MJSZSYC4f ztm&xApusQ?;+`dIHYhMZ3_hduBlc5R#Ft5oSJ&^}@FVt^Zz;IwH2s|%;R;&y$$yZUfeYMz<9`vhQ~^>~vFJ%j9P`-_5~0Dg zzhgs>ptA`FsD~9AJWXGSVSD+uP}W0M*CN8SYHo2IWM=3Bm7L3?8b6tOi_D6DzxxO`5@Uc(cZ)h>xwD$_&rTsuE+$`Y%lP?K*u9 z-0b9c-Mouui;<0YX=3X-hk(Tz49X0ba;!vq1gkd%nXLZaFTmO}NhEA}@wCpC$W`LU zQo|J%1pQTFP-4(nx=h5N>%$e0S?e4YfO!I4Z(WS1nq2&>Aaqz|g&f0*E3ei$bS!HK z)W3Q5gN|o_r^(#SJ}NpoA}?DDcPfEGtNdg(gEE81s~@qS#B3`1-@jU#zb2$1-Z5fH zS3n?WP=fW4#KsMa{(yQ?vB?M5b1XEw-sO?#cvL{2WzNzsE35ZUovKu@;y9>xqE+!j zS%u-Mp@F9K#|c8h3@aHJ7!D}x$T+lF@j)u6X4)Xa7TEX3Y3o&qjT@?7Dl0J<^ERrEh|p;2QjF`EzHv6!>hnxY&I(*1-&{9keEl~Q zTo^5Ctaght>^|+m5c_ zMr7mCDZLdM;67y9N{%^F+OL-JZAnu7q@c_Y8*#`<&@6SDabjFk6SAf&nrn=*ytOz~LvmN3>UEMMPp?vM9qU1_lP#<_C-k zk(#rZ+&ou3&2G|@k|@1%vg59TGDD5JmKOsHe?y2+u*)P@k%=s#Ek|7-&FRLapyq4Y z9avsvC2ed-1u{02Y|xc&wrGPDKQpK!wqj;vR*%G*?JmrRXK)tG_$H^y5WDaXW8S6{ z%3oBMMrJ*%uSg88b=aP=GQ%o;rpJtjw04f=~qLZrq0`~>K}GL(S-~p zB_T$V-ZJpRMv@vC4;vYW{&Hw2{cxP6qJ%`~;v(5Cy5f+)lBmtScGO?n|zBt2P6j^RtkLhlZ_ZJ^l*cnJ+E-YZ#H_!+cyL?oL7 zYmTess2e>6b(uMJDcr3U^=+0FKFE0j$=^m3@vow@MK!fBQ+OEd4xNH;|G#FL{t^F}? zdZ1G2!dqOtu}=Co8T4FO%1tMf%-PxEv3u@}-BKP(2dA;Ag4#ad-k=h+PsXAL8jpz3 z(h+e?Sr!*%G@qM6kYNs5CoGi#CB`GPbPQhY2o41GI2?V?`Xp6|oK%)&SgK>ZWx763 zYiMx3RoTg)WWGcR#Y0As3s_itlpy_3P{&Z3VGRQVLqsc~ej;iQ5tQ;kJrl?{N*J=M z-Jof;L1WFVO;fy78DtoarwDxYcktku%;3e~-D}yB*urr-rBO)4pliY!kV(@MCT2+> zr~Q@{Gb6R25zoiUa6$RejZg+ThKze}Hi7Hyh$%<3G!jINVm`$@ue~_yuIT2DMd}<3 zuNuBQUf&RC1e%wJm4cuaixNYfQr}!I30LRIt|sjbkhHgGv6RoM3Wf{Hpas=8>=+s9 z859{jUWpiVwW)PSXhGVytUXN|BuqrWJ;rHV+(#7|)EHhBlqnuMutH4kcwS$DlBiqo z$Juz{_e6^0c-CM%9> zBurVdA?wxI)FXP4uV&AFTr4Kc`^u0@f_2(211<(|p7u|BcK-Y{czHhS`RS(Voo_$>(6Ym!APk_PLcP~fK zB#YdT)u3{Cfe5JOBqh->L75?=PHDG4^iWp0MRgXFn_#5othemt z45|zq)3h4c-+x@KG5M&5QtQ*D5k5h#8b_Q|nA$}d)-fwVUx+!BZ^92IOIX|9ee9rrbNglg*xgcO^?gWV$t#BnXFJ85Fy){C}iXM zK&4xQPlaK-xS&{yK|tw65d*Ioik=R;JH6pH? zOnnl3$=A(fs*Cg@HPr(lmr@!(EeGXZSdQmrs9V&?xUM14#3WJ%TyCo|c)Zd|5aIO| z+j!;q2Q`<7RjW$wpPtY$g`uOmt?O)8!c8OY<9DmRC^Ed_$Pn+;U|POm#lnt=kFmu* zVPXH~wCes&o3%7>&*bQf#tgEcS%VE%x+D*IX-%oWpraJp;si>GjEfo0HkoY#&&{cT z#)s~**b632-|NG;xI>`UT~HJhf=-|^P)xX2l-EE{Uzwq!UHZ*G!Jvr9iwwz|t)FhI z6Hk{4^WD59@2cz0b{@7>E4Jw~urnO3QvQ_h=MEl~li%ibaECIi)Q#K1CDE!?&^;}A zwMb7$7tf&s${lT?msQlSgXVAqJ}_*Ej07n;)TIIt*&lK?Yv2})FZ(+= zZF0^g-PZ0(PuzbGg(Y!CN{U18>w-*aO#IQ4iLv54CFaK`yci-h@#x_bm} ztYJ`N5K#EV1!@nRUa+v^(5BYuMP^?PF~3-_gr#G~>b>8N&ZtXlUD0gM#jtd~*OX(L zI>|?@KzZMO(`zkQF7)eV-LDh`>ZbHx2>tNkW9s$9(r^WrWn2=f%9;!vzh*56UI-dK zWn!vho#gsq_K7Lro`UC69-hq05{ki|``%cIyijD|Vh}h6PR`SZ5=7NS_r^l(yVshJ?av|VI5I9CyYO+La8B`gT>upUt zwqde_nqzRz^P|0rHdo?)FWPVg+-3_{czL-+`I{uryf3JI^t? z!(DVUht`6)4FBoQSMpY$=h4w%*zDTtWMZd!cZrC*M_@q^)0XS|BqpgQHr{u6{Iqom zO9Ml6-4xv?3zQTXgcvq3FfhC_@M$_8Y;tPZlb5NB96_d>5z`KL5Y%o;^=_HEs9l+% z=5_EK>oP-;FyF{k(WM&Y25uYlvcLF<{%{1MzaX zn^^<*QqYK-BE!G`g_&|L%VSrG7&D%5WI9`!SrOd4hC! zhb#LQJUcTxVw#ifgWw2_ML8}ls!~_D-@Yt5wd~1BDFp^~hOHu^A{=Gh+^%6i7vIUX z_qeEcRS(q8$~w2Fvm+{Zy6?&4w4{rmU30OqGiE>O@H#uwe4|RY#-R;5fp-0l2 zF>&G2WeODxGqg3<_<`oqS6hBooAy+hL6zY->$a{W>$%G`LD3DFJc=~|8D%Er-2AeJSyMzC zyV=fyhm{w`T(pT7TM&69NUMjZW9l1a24#j78*7dTF>GXDVDO%F=#_`)Ld`P)XWv#k z-PsHp{k{=l_egcc%+u_Q_Mn+fJFXROEl2wn%VcE7oPAqul%WySsLhm~{Ig@a!%vL` zQi5XE77PmD5&4j5!eX7al3^ySJxotGN$i$fF67I&xJ9yRpUzBK29H&m-Us!Sbh1L^ zPedqn#L52fjZpcP5}_qx;FZPz8u?dd&}deRNW2rdvdULB=X?AL*YeG2Y^K@KtqwCoC!RjRaKNrg0(9+k!Ox3WLnTkBrN@5eT5=uQg>3_ zapgnKN(@V7lMJ;)47lRdX0f_n&`Db9zg_c)w(Em{MkkTmksJbDa!R1u!oWuRl#5`B z!3U?7rDE;z5lRKDJ(H%K6iNsQue24bRbwy?HGCGdup#h+*9wQn0tPWGXO&{4_?EC_ ztgqd8$Gsy%rOk6fuc82G+)Z6d;=v9RnbQIbo(jdQFkCvLw1BC%-y=}1`{AW&OT*sF zE5>n(X4JT3t*YUK#?^?c{H?fZ{&LFQ^u5^!~Ph#R9$eBiRkwCpCHSOkVJrK?yX6BMF`$VK}Qa?G1BVe563hrzPfM!T*T{IiwUV;Z)P6mMXqAP;x)Yu$%@TwiJ zn;jh8pji?}R<7ls7E#hlP`s%#tXSA67$_bVnCtSF@zK{w;CYU{_fJ)IPl{k&;m|Cj z5XL7eeH65I0ix1sYiUcz0nq4&fcMoiPm4vu4n~3|>QqmwgG!jW3!04$0>PEx+pzXI zi7BdLB7u{?O%P{yZe&PLP>T9FrDQV5G=UEc2H}^KBYL<#Xa}&rzuI*`)W9n!BK6$l zqb|V*G&X>0ue)dt#qS ze5hdJzm9Ly6cmHLJdpv7g@Gm)7lKzy37DA}D7|tL7c&*p3Yh$djbY9@A%@Ki3=I0s zkJlw4v2wQIn;2jMPku38m80(fK;7&I7s&Xg!#Iaqzmsn^LQ*t0J|WQ|B?qL7Iz zyYGfW;AL?v`==@AnCfdX#4;UN-@((Rq4U5vmZS8;Jb~{$N(TEx4pn)Z1o$x~scP@- zbNC>5gjfm55f~PLvq5p*p%Xxf>KsJyA#QJcr#>%^bdm~L&ZLpiwD*psOr8ebj0AT zrco%U4wknE_iEw`8-mZOQDJuu{d{ zfGfWf^KMWb2kSrnGHTfzayG_J15`yT6@W@3ou!As zOWIVG;cJsJKzlon9heyeE*vzrHFxDctgm>exI5C0K^nA{$id|Scvf|mE4b!8C3<%G zZEX{74RGt2JvM7%lN2mt=7=pr}SWWWR!1eC*SX z+|FQ7U;wQQIBf04;cag&#bA0+qm=J)_W{t{>xL^coF&{ku5(%)UaF+Rz>xMQJu%QM z@hiuPgaut$pal$0mK!!c2zQy}ntVjSmvM255-5LwMpU4Af(4wmmxjy$Pl$V-QZxV$ z+%TP1XHa2?UHr?rWoc9U`IJT>4aT(ZnoFjE%+!O3p8&00J&<@S_=^IA1gO>uh%q^@<-jWCy>em4 z3W)8K4stSFP&SEHVsX=PU{GY3^x>7vv2X>6Gf&D-Mo$acd#x=jO!ib)WJ`wArF1@> zl_3nO3@=Ozxj!1)co!8tEZQ7h4@`Tgq?H*qiaRug8rKyq{FAx=}4};S`?pP5*Cm#BNVfJg~xS(LaWdRhmYr znjt)DY7DW?dHX{gCm?WA@71rdpn=EwvV9|oyb1U|KbKS&o zY`TKf!C2lUDuzByd<={X`{6SJps_GEhPtNRQXZzD^v3@p%v6M78)*I)T1t%ESvEF? z3yYIg96FR34m|!oRTMm$rBK1(0Gjs!uP+5nShs`Eibzxe*Q!gc-fQQ8XG_3?N>%%G zKr`G%9lz8S9)v4IGO94tRL8rrvhXu>ENWin@&Ggh*ReEUW9hwc4rwU~!P18=R~i}B z7*-^+f=8jfr$ya`v@#+!XC<{S0?&SlikYtB7kvKytVpv5bo7Se1+RXK+9S-fSW;nEc-i`O+VV%r*{CdmU}07z8yABBFj)`<;En+u$_T{ zVYwxX4Z{mT=jj5nR}+GcGB?N>mT+D?{7n%)exgvpz>u2pCP}G-Uusv&fuL6Ah9dD^ zJEjCfw@ILG>znLp`brGPH@P(y9lBH*@7j7Xp)EAHZMlXD!_y?=d3xarJ&ndoLF>tN zSvl=^`5! zF&+~%HJ>g}vR>ruW-idm#s!=7C%JO}cm4`mH4?j!TV&27L53X+3=I5rrJFq>9+-D^ zKZ|5t;h=j;Hm6GT!1Az*&T0%%7w&7%1r3EPoi5i{wEcs9NZ{H6lIHU$HAg>|gs~H3mL#dS^Ko1X;`_%g7+lpaxynSg`2ZE%B3!Kz7=d%2&0fB}$rz za3(p;Ox8-QES0mxxt@{HsGVc3k;^$x$wzuyg*6!$$q>JuaRI0$1e#TeILZrMcX#n% zKG*+7P(A{U-GEmgfY;r9GrAbit?vbKdB7Y{XXYYf)+8;^8qijaHGPnUQI2|f}+>Vy*Q%xf|lwWsv@q;8+Z3 zYzb)B1$Vt5Y->q(N(vA4ZBe9u?4UIqGt`GXBjZ!|T6f@9j?FR$<_Q zw%7NCFf!aa2wVF#5!6z8E+2<$?bqDzuG%d84E9nCTbHJbzF;u*bYjiQUFfDbYah=; zNFQ(t2g8NM{R|O3fu3p%RXmbmT5I0>thjR;ln)Y|5=#Ya7@FGj7EZrrzE;{y7L8g(u|uZFL_5ACZZB`gI&8EzGK(oy;Txya+ipjwfaq3#z)!%+#(;>-jQS^upwUdHfHNChF1x-;UIl8mthkcycH>H0-mS}3=Nk-eMk;DhLs1Fs#zvkx*Hnw3R!%a^=2pe3RRi{@rJ4IHdylc^;c8GKey4ZK;#F zZJ_r!B#W)%)_ltn?*9@DyBHW44s%2HJmfbnNoRPZ%<%cN%;5yJAFdL5m%dA+wXOio z!fpbGZ&#TD1D_HCA7;cpNz=n}}%6T1IvLpp~X!%HDiRR*bD zEjFMPBas|(3})Ke2~(C>UQl~FafZ2`;HH3JV{UKICWVbo4#9N{3Jk`L-K#Wo3T_A* zf~NAq#2Uj7Xm}o8mD!f=d^B(4qlYRCPvvHBoXfj#gHWVwQ&rBfGBcZl`HL1VT?QJ_ z?_ba_Fzw1h1yGynecV$HZiaR5<5)E=ToTyE2=N)LPx7v`iSHou0V9popfe003qU|q z#~q-9$QabXD@Z2lb%@s6n6-umPcl8?CiufO!ZXQy2dl~r)x)m8s-JmZ-~)}S1WXh? z6b9b*P@yqv7UQCC>3nxVP53ne+ct^(NlHh_iIMD}8U9d)22d|DYMrZu-X&16>a%2D zwIIW81_p+y9_wB=-e7cEdgC1E>>pzdm6j~-~@h^=t>#?9!fs8Q~<#75||Tb}}h zDrEF;Szhjj?9bxUuKs3UyGS!ZL_+TpIJttRNGs<)0JVGtTJ&s~KtW~Gt<)_Vzl3E$ z$El)2P7@82d=phSS-JEoNq|a!1OE@wH@;}SXn%i6xo7A1^NTbSru2Z)qI z7$Btu++A8`U5%WAyFPS05!v;DgN2{LI}wxyA{5mbuI>z00;P|lfZ5txUmcH4+s7j6 zeGtv5Q`8wWK)coK-x+;Y&2TYm;GTG$)5;=25MtWt4?0~sVKozl8kDq7t1B@Wi*@w~ zW^-vzys8M!qMupzH~Ow`s{5g5duT@Wf1RockX!`H73^&r(OrA=z!ocm)cpb%M4F10 zGyPDSqR^BP=rC7WQJo=b-IZ1BZH19sW~JH9v9tGYSaZ)lLlm@Atze>@#4&A9HygAY zMv-Bu>|tPFxT0~30cUvffKreAakCy- zboYTmGqW_oYYm?dXx)0m8i-4S6xA4fbeuSqI>cD7>~u5>&$`;5EPX6h^Tw66yk)un z4sELXzaZ3vwdWHgEcg*>G2^Uv92pA`Z=c>d%??FI!}NnxUQNWH)T*^xTN6n`0gSVLmws$o#@zN9&OJz zY}*@HcBky{u-|?{bIrMQwqx?(d2!G}nUyEwI1X>t0QC?1-S-5UD84ifznQPVz{T*? zi22?s2i>O56QH>4=O~@41s!t{XV?om|AhrsGJ)LLb8y9JE^iaiiDA&y{GgR>gv%vR z>qnp4Nmlk9bZ-TUsSA>%n**m${mU5BAu;9Z8gR2ng`q~@@#r?D2Qwck32f;HEudHe zuAzMsuTDwf-5AJHCwT3F0K=;d(s!7I-b{L^^w;*YYQ}PqFW8gVIUa*{2eK!zdpvdU zcD})81L_|@Tk%MCgUVSEaF1?{z_y?pimIS|30@t)QFG0#NubWg0sTW>Lc0&@Djd|4 zgcL?)3gFRe0_ChbYB>u^0qm}eCvY;XV|QKb!0dSi((+S)_V|My8aIdOFFpoZ@p@pA zmXl)KOTmy?5lt@?6~TR-4!uBuqh$dT^#V6u0T;vZlt3$8zAPXMh@vv!`zdFZybq;91{RL;8p!hZS7z7xWuYDTC+Y+EKBiOPtQK&?L zmEl6NUn>uT5_qitsJoqK56 z4L_5o@}Rv!HjtTwm3lVK9UEMN|9wzl5MkJE@K$ryz9lBm4WFRKm)wTw<)@bj`8)pTr zz}*DU3bz2z=&#kXqEJK45LHG7(A=E|o>gm74Eq@v7~;rSy9O$4<>$?15CezRl?YI~ zFCwf9v}rURG*!UDFlXI+7wG&qi(e~KsYaed#Hz3w_W;oD3Q(P-?Hc?qKmnYt#gC=3 zVXh0xi1Tk-!E=u*WQEEyha`TJ>7gd)r+>ZlYuN|+fFP!l&Qqsd_!U8AdB;+oBgq{n zy)I6%cS$S-FAZIKC`nS0JZuepK&)YgZkOFz~t$y4feM8L>F#Y3E7vw zX$H8V6UHFLaOq!T;0m78!6r}TAFppvTE%@{K}kn&$EWs9Yz!BY`!)pd!u#^Gij*Xq z*d5l0fa+iHs>h9dpz*$Bu|=Yj6_L_e#&oR-5^9d>AQLu8xXx2%D8CT_YHS_4#M&X% zz2V*_F5!$2E(uo-S9XcT4S_C`Tt(Cwz_SQW0q>@m@YShmx(5X*Nn8z$YY#SIT~f7n zNmsx$F4mqVCR+wx2I)qjpksQ=1UTdv+!Dc~J-nciRn_M%%*=DxH6H3Qh=6vVG;*y! zmp<1Iv`RsU;Q(m9|gJ)WW7>-Tv zSTxhC2{iTK$us#u0Lvj2hV9`A6=JSet_eO$J+xVIRvcu3>a<68rSV)mjgy5Ad=OF8 zU@%Ty#POrKVp+z$k~f!5_Xu*Y)|jz0Z3k$f6Dw#LdfLjHOT{$J6g3&7E(CyTko_SS zThg6P0@Lp@WvFdAb2X+SKH^x1B3GKGP~O9t`)nia7*rV4Rex@JJs-3h}m*XqzK0WLbCXG4T?3--M9J^oI|RTX6G z5s(?ZT%hIJ+^*m)shc;fVAwB|rlC^%%qv%R3utA4G4CHPr2;K*4^TmLhX$Kks&~YOkL89@o=4snlf*+6@ifb+0V|Y8(f=dl0-jx|MxCK%z15W6t^XHxWvNO@ zEJ)2WVK91nB1$Jvs!M?3AOizKzk2D1d51u=^annH#?W7FPYc+{5j5&}$-SurFshbP7a?fk8^UL*dnPH|7J70$I^i>`#}+ri>m5(0J#DH6pgs z43`e9n7(53b|Q;v^%T>T2Ca!$0$wkr%23V(@r8$u+tQ#u4bI3b|XEiq7hRquthGZf=M>)b0reZ!?0#}3SF;u2Z3!KyC* z#DrP5zfV!oc2d+RubXajjp1295HEuqgTNi*t{&uRZmyOSS7!Ica&fyp5VwZp7MS}% zqcSZ;DB{l2#sNat?TRC1Qoc*~?BUOyc0w0ot*6 z>43%tkv~e{l~JqX*faE2U+3Jl!R7PIZ>yBF7o=RUzbFjfr{B2rfq0;TLIp#_S1X6& z$X3_hR<0{8Vho2E7#NBc=!R8-M&`_?adn3XYJpZYfH%5kZF1lguwhtpozseC(Rzn~ zl^P7MV%Re-wJnzWQFbgS!ZdYd-qnS7JVh0wRzA3!!LZ{bld49-6>qNqMGXcYn~tod zeD{JQlnSK#svg{y^ad@uKDfSPjY#9|f-B7T&mH}+=ITQQQRohnr5rJgiw`6$)9C$u zWvZw!s1Cop%&?3>oWaBEiDhboT4>yYr&Fhx=-EgwTK+(u|1@~D2q(k8>&pzCTGJ1! zfzD((%=lY{LHat&k?7bZcFT(9OKz!>G!0{1+_7c}+ZC>vt}m`GUZIj`eNkDN;W^`L zl{QZX?_Ne7;drjZ3-%Xl(k`3|3R`7aUTNd{d8Xs-i=f_K#kF0IXT2j9Ir^Sm13A0F z`{4VW)m$y5&9e^YE_ITv5NJB|LQw@Y9^$!i{mO+M9%7(|YvRNkixs_0=1XqTN)zM> zt1R7@ZYU$nuvOD#X{TyMsa8R+U^A$^2mtLWMaS1K;>ITMl>iR%=W1D%pV|XYpYW7<#mZB>>oK)4{$Z4AJuXCqQDLs;nYr;!ULWSVZUziQnCTGMgzJB z{@0leRdW|~r*{VWTT{a9(BeE7#L6SorveGyCc z%`hu|6_oAZ*;ENyTk!9H+sFNhejZzXs&PJhIWxHO@Ej`+jklL#&ix15*mjVG;Y9)y zLx}++gVhWMhPn1)ATtXOf6bRLm-*jTcsgH%HAUK-5$Gr>=65A zean~lzPbLe1uw|rl)A$<5TAo4b#L`FgBEr!W`7`b)4)$&QAhKgJ=isl#o@|4FV>ur z%a**bDM9gh{ox9k4S6%(Gl(!qF&t%J0J#|5fAyju(Zb)ghj*;{$NPBI_k0OX&fjg7 z3}APBtWho8lW6l^Y-wW6uMYE`|Gb|iLFzwdL@vphp}6@C+jgx3?i|%VmcQ;B=re%L zI>^G{aSR%YGKz`$Gwd0JL3#?C|Noah)_BppXSNih_u(1_aj@uS@3k`xeQwBa7nsvG z@c{4R`olI*yJyE{owf1P*qV4J?Z63;#2+DOnqXj1NoImzdsc=E%nyV_!7U64X#X2J zw0y+tBIvpVP;z8sI1is6XJz=uT+rzS?vL=l2vdZOBn;;5awx1i`9NBr-ciFU z!;3}FsMVq6RKhZFvv;Y8f*M1tnX13w4z8GUd3$}Hodhq?z49;^bS{ZcSoK@(NAq<5 z@LyHeVK8nfwgstC108j;i0M`9w-U=#(Crx)MOGXZU}Rvh3c8&d{AosEM|FY}bU$an zIz=W1hLR;=Yj5ezo^-q?YHR34&}b0 z_^97qLT{1FDP_a_Ia3$?oOg7!14F0AZvL04i(V>yHM}aW%<%o}f?kbw2BngRf*f)T z6Lq4dD%4EzZZ-VC!m6L_tZ&o6cO7(o(W(Vv8@m^7u$mp4wr{e88e`b>Q1B?I9OFS| zh6hVQr+TR~a5BW|fd~9=Sb|RqWJ5YxL5$(w<#RRQ)f5bQPSXW!n51^KoVcql&hYQ{ z8>7#2p9y?mVA#PK>-2#m`=pM}vjpVfnyE(C#&gIls;%?!mgjSQfD6z1G7g3QzEL=V22vVSS) z%s7Ftu4Ua2jbve+KY9i?nx;za0DehNOire%CxgO8N8o|t0e<; zT>#lYVGdp4IgM+@@fTk-&&lo%QE&-9pyAng3bAJ3g(3q#c$f6e(=MP>>#fTS1HmU7 zfzK0)%~3ZBJ)p56B;we=%L;a&*0W*v0!UVNdAse`nF9=@?2@3z{s`Kw@%P5Fx?hUn zBm)BjJ0obEFm}+b@duTN`s-b;a51dYU(eFZ>vmU%4>Z~>1fF35r4NVA9*y7?l;GJ{ z^cBV+wU7}=klKoUIvSuMl_^VZ_<o*|aK^2eGl8d@BurC?mEpqTwc?8y6d5>z z94fp)OVwLkJ=Zv~_AseBJg-f?xps!Dh%V<6d3jJz_0jaolI^Q zFQf>bReZqc&@Zv8<;4m%#p(bPo0^g2R=n^eW1|^0SGcx4ZK--Xd8;uWYdOhYj zzo_HL&DI6yzzf_eJbnf%Fl?Q>pc=F?Ln+c_;yG=Oz%xqF!`mPWqntpa;HnJxMyDwm zmxjc9Sj2?J4}r;`f%yc{%^VkPc(^1~HLWt5Ot%T!f>zN>h!}9`n6jN?S+3CwI%Pp9 zUA)Q4`RKLE_=k#5tL84K{;DVqu31wAU9H}0yBKyaI0PAh>IzmgVDSRaf`GQqX4#7j z!F{w645t|w7^t(GHbntEWgm1ykq*0Q*(5nYtpL#GhR$ab8S~f8(?6}O3|$S2yqgwD zVdcJ_1%Dv*#$JvfCpM?8pousJE>OF}*?Vs=1EQZ`ym@-y`qi@OmMe~n{U|d7pBcr< zU=@)y5ps?z6vv(VPIgm z!F2!J(V$nQTOaEODyr!>tI&85OXuJYE>R@E^+SvF?@&dW&2e)r(FohpH+@6#WWTqr0TDeGF ziQ)Uk^hU+b11lN!H*v+hdaze1!~qm9#?z9l14Ua|zjD+oG5F-99|oO?W?++D+5sAo z+vwyVyjH0ItU%(y?VC2j3{nQcCXl^7L5yEP!F9s{+)o6}$8s{PV>f7bVRyb!25v)x zWw0Eve0XyhgN<>FO4L)Aq6fEk8f9p#Y6!Wnug(z5oYi_p=?jPLRJCaVEcdt) zr32p_ZtXbwh2hx*ivaLes1E^O6d2?fzMnk~fra1|YC#cM z&pw4O&}U#{FmBXNm~sX*r+QlHDyVhNyWp8yVkeuasWA(Gg9alg&b(8P2ZBZ(f6UFD zdeEozz->Jh2IGz8F+SjlfGG@bx9S_XRqSBVy3)w5sL|tep%!#j(}M$|491Pw>uU}F zaoMrA`A1yi&5D!b(3b>V|ZSM zd`3gXifN)@S_%~mDmsD|AKvyXz0t?DA|P8y4Kzx<;mWJO$~Ie0eOSUI#&C{-fuV`r zVOzlB1+l9XbS@(ABvt_R;-@Utl;0#C=+V~Qb?wz(F1%H>cR__4(qU2l}cR%+JFg957iAi_8 z$jK~~HqQ?s3JS>^!Tl~y@SU@;)(|g4U0j^UEbrgUcTyM+D1%3S&-ct=;AU8No@f7* z+NWipQ3A+rnQ5Ck6V1avXfNWplk}7e+~B_m>9}gZQqg8?sffvO6~{#_DVMjc4;Ufm zHh|B3mWG%b#sWR_8MNYF(84>=C%RYgaMDvQ4L(p`5p)DageFvTV1y}n^$w@b)~lw+ zE9NdRp21nSQHenwv}!^A!dcBVejT%Jf>)~wct<+!6KL!Hb463HY5{`+!&QvKot0i2 zpV_0tBmVOA28NT$pgudeeIZYa_Js(;c?JdsPb{Z(fJS&hC#v3JkOG};YB!iqR0WS| zh{DD+0%sRWyd3pW>kaDaxxXa*Qz0~DDu9@zr(8B40H0@xL0^~Epq=0T8sXC zU)sv3YZ?IyxV>5V=Vz#Vd$hSqQuLI)NFd}Kf|YtU%@K+!493$k5_l>kLFd3P$^o5h z(mP#zlF*y~?21wx8=kg4X@1ClC zl|hq1jNt+U1H;vcC;9ef>4#V^0-udLQ(w|kMYZ8B_zVD1G2XrN1WY%7YS&0(VNe9^ zyKhN-SiizbbeF?H&3~ut6C2|#O3%G^`3ycexO*~#IKxpZh(UTfTP^+^67pT1$rbo7 z;2d}#nkoYF8#B3gEE5#Xx1k}P$ya`PW=T} zOY8rK0s#j!7P*7#@6C!=c+9_W-Tn2Yyg^Hw!I-xvi2Zc1zXVYaB z)Mp%Kk;+T}o%~TUFKRhUgJH{C1_4l>G?`!8;L&m2Cxv-OKon>^l7m5g#^EDND+TN& zLE(Jfsx5u5--VTWHjW#DOk!rSUlcX)Qe$9d5K>yfzztHn#8>9fe0CRA202Xi;7JUJ z*%mGK{2crcJt8nwU?V3jg_V<$!5=iM4cZQ7#98LdfbP<{YoEL&l2)w(bh*W{EOfWME);bJ5LYjo(lARUEAg?zlph95z|0 zF{}{L+P2a9qtYQEU*B)VW!(*n4?O&lwZ677a0Rofg->+)fcC? zeB+q3U{d(=)I}>#)?K}3HM3U{yzZ$bg+Z2qL(bzs3_p0%(nBYyYqC>Ber0LarueN} z{d_??|M^i)DOFo>`t+A?I*7l$iD3wswL@iOPR#fS} zSMuf=hb(x@h#cq;1rCPf?jX>aOO}ib`Jh$EcveJ_)8_<@Gk{0&?ryL;mv_5o`hxk< zQ*=U&r|%E%a+7D=AffEZGkJmLnpyfP498_SOs_c|3tAJr!lAnVy;28Ao&90gMIZA5 z!CR@+y!BNXDpsxD!>8VzxxUtLnZAzcP5)ld7EejNMUd%c4(*n;YZw_+7*;$^%m8is zu*faTz)&tEN%FnB15M_9LaNbnN!oSndDG(us zOAHJQpm{maSj+oXYb|KM*(5`(lEtKi^WbTh;01hwJHFi#PyWT#l99Ek9kgn1^K~oJ zDGwaiGA(qFZK~h1bVI~N24%Ifud55=l7qqfj6Tc;&51A9+Zwi%|I^klhgd;Vi;uoc zI%ux&FD&8|)4k0ZTvrr-9REF2ogo(7)naw3e#plv3;Ap~91~g6 zw{uuDX>7Y3_j?ogWOmk92?1f7AKjh16jXNE>1Z%qI-}&W`O)3GU|*i#6Mr;yQDIqk zgR;fe>+=@eic&ZAzS{MkBU?dj{lE?Vq% zJrJl9ugb9W?!jewx3zRGuBj;hZgf#(Me`@cYQa{}ylhtXTq&)?3)}-M8Ppk!r*X;I zz1^z5V%s&(wQAJ?U14~ zCt26tECN*^_^7+0=f*z={IV7I#xU~x?mFr&)0F50p9G)!2eUSM; z*MZOvpjl*aXa*`=N$C%3>jtf;)?yF=uWl`o-x!*bb#-wpm$!-OO>gii^8X(;gYQUN z2Vz|4yQ}n|L(Z@pa(*mmv}!@*lT>gTS=@4T!9qxXF(g7`)2Zhg+k}1pA7=l_!Jx=6 zHUDCO!wX+?g58r!c5N=O)G0f|iCld|+q* zC)i86jz_nF6D@}vLqS)Of+B;lujND?0~Jt5Y9Gr*56}`ilcz35pcA(?Wr!M_0^PwN zRbkfkswv{*@#M?5I({)9d9B*rxk^I^eDte<|HUc7CjR(5(BrJ#=5sznzbxE6C%FfiO{(Nnat1Fv3HV(@qcn$5wpk5nDn$^tbEf*E;Z zof!6UsCFoHvGK+_eE{tzoi=rmI%GxJqMzW+J{v)|dw>q_1uuI)4%+d2A5^FEE{Khg z<=CNQ=)>e87U=Tyjg`Zd4yS;3ad#v#M0r_aCQ7Is^weYkt%YIvzhmv9i4tmz4F#)8 zr#1QBy_InNnZAz0w+8LdtA0yZB22z;*@Ms$N znzJ$`rXMljv;y~)K({|>fJe#0B93)9f@=?_+;y%iOg6HB*U-EC-EsQN^aY{}R~Z-> z1iv0Ih%*+1?hjkX#UsLe8MOYq51gMzd*PsSm_hv^*ov&>;MF(BIvzsybHU0PfrZ@t z9)6JN$q(R@r(j!Rz_XK27MO)+T?OrQ>ROr*yxr`^)}P$`A5|EZ?ybL|HH*ou5xTtr zwyntJ#UW+TGU>ycHO{FpEM4TGxO;}1 zVQY)w_kWQltUZ$i!82-*eNa81QW1-r9ghkzTw`Eha5FRjtp=Mo$4Oicbk;fO>^KoI zZ5ET(1$V$hl+uCVc&|rv#r3s`BT`9#&!~R-qON@b+J~k?->B3@L;+{#cfX!f6W8r52 zZ8p2Cik>d8ZZ@l8;Dm>+5x9H+?UNE?SpHms;W`5YgM1vw-HIrS$3S5}-$e;@z82^< zv1ShyP(2Q99kS@n0&P=-bTf{8SYtIwx_RasGdI7r;G3Z;K`ha3a=Kw<_Z$jtrmWgD_i1%0r-y$XEpM*!$R$gnd_J*rJFuBxjrEL|=Yk-A!B zxl;nioGA=~JGkWRv_M<$)v7s_3MRP*E}QixQG~&`_efk#n7**D$FDPQFDY2 zfR6;9xHKW;Ix9s=+5o=dD@bpqWQ=E*6^aD#z?;R1X274gp# z!1L!Y*YPpb2{^^7XX?G>FPO~Apbr{{0*{Zqg@z&W_*nN;?FAj82REr6^19e_P@{%H zl|kT29Q2HSaF6IfP;_i@&vj0#=9v$~6L)xkN5$+wD-sr^K@Jx_5)?K;zvZEleQ8%W z^kfu+BBlAJQ-ndgMo%hrtvPS-xyvACiT+_G6@TzAtIGyb%wy!=B4KngtI@DX1|V?|NS;`8Me7Bq4=aRu{UacD(u^Dk!#FQ|BV+ zg7-is$Zk3g=v=p*05p}dwjNv8&0|R8twCAA48ZKCkk7vYmmZ3x| zU*K*H$S%qt@T?3tWhf4glmSYq;1SdFxJOLYKzrOVPB!LHb=W_lIc4Rnoi%;4&fD+# zqoBlKJS~(Bbj-kn4KABM*zXb8az*6B+Z@?$@30^m+K*5!_v4}MbbWZqFebf0NkMJc?j{QgIkft%qH zbUZ!QX9H0=M3UhaX#QVeaNLYVk8xbk%pvMHF1A%^qOetIYtsHRx(2*!c;mRcA!I42 z*A~3=juw`Eg=`ELjF0jOv?($yXK-8<1zusQupoMGeTzndhzQ3;rw(cOGFQLCWJuvFDU6m(ejmK7U3Okh`1FwB|4aIxf< z$n(C~RVpG3w;321mZgApB|k3>>*KMHT!P5$$6(*3j<20`M zGr@;3A99))+7xnh*#@iCEGw1T($_LnxcyXSkOSr63tF>^lp+}yAMm8*B4cWSVqCjBQukt`Ag+DPUTw7vhtDp3JxPNmnDI(1wpO!)};jvlR>9q^JZnG zvGy=&yMCTIb1CG6zmnD8`!{H=@jDx1$MFNS3ILKSJj4QzbS2yrN?e)|#u?4ZPJtaarLYc_?D4|r5jpW zl~%K??2?7#dhl5fpuRLHl0Y}iZBQz>yK0)H%MwAzQe2RIVH~&hL>caY+JE5D5Dgtr zAG9LJYdiM^r=w{$vF8dV?$hBYEs=n%a)IpahL&p)r(GkRK{piDKqFG1J268(d;rbAY@QBT2_j&_ z5VSe+p5PQ~g=)_mo3+4pGhEi02;K7zN=YoBqaQfAUBftoL=%@9I_&ZItfA!zI(1E% z;i-}~gWML-wS17p99?Ns6+({$X*0+vf)2N{d()`M0IBaQo52w+vQq(6M}bQ_S=h`ZC`M<2532zm?5WeLsv{Dq>Jj<|v@6+|H#wX^ z6Z@*ztyTtY30J2;FEL}Xs%tn1I(gCf$hzIr9X~K^i1Tc%0^QQF;@y;%S&g7>$blfp z0Ui<73?dA7!S_E&?dafo&>hgkvB;Hi>Kc)=-*w_xnLJ!>)_Uj*`--pZU-?f3yoz?k zH2o);>uXm&c*wlJBV$=&jL>0~1KLFviWLkIZRwzU55PA8^fnM{> zMJ9fU;1eg(jkhJ{$bnPa8okxv!pfGZiJjqqx1oRy!=ji12Wta0$o&n7`^v-^{>^SH z%mi(ZZkT;Rm8HL-O;54tyCP^+ZBMSmbnL5YH5gn|M4 zUo^9ABLgQmv@|ki&kz8g1+C1W0UFx^trkv`ItH2*5an1AQt$1nnIJOp(59re4U@c7 z8HimiEY5I`fq{XvHNyl}3mcml!9t2&FF#|O1@0;8*L&r@}ltT+r`+VCJ zqNNTBQ_t+5PI97L60G16va7${D?EBZyDF5V*25x zmkwx1&C+40fXq92yz<~#zaD&6DaR|u#xBSOj1hf}I^E{7In-pgLcMq2t$8bG9hZ@u3czJ03=^{(c^E zTQ+OYBt_7;BIy1vC)TJ8v57j1z^8TY@w*V|V*?b6()r&u9r@unjJbhZ=djN|iD8Wy!aU<}x5v4;h8*JW6ZyM`X9A1zbnvgRG6 zOgsecAE|)$o$EsGfrx$X^=nJ2;l(v^0m>}1Ty>T*>6)_ESc{*sS7NBy{cFM0qbmaR z^EkY(o_TuS>*9jQmZV#^K%>IQ& z?#>3yZMEtQHQBQc9ln(vuhJd%e!lD7hWvEpQ?fmRYr3Oc4<;~-p=%?zRp z4_qxhIR*Ya-qyu-Rw?Y)mH7^v#JRw=EMznglG1OzW|3`TZxC%<{otW9bTsX+lS44a zskuU${YUmpR90gEg?EGhTJRxG9gu~@uLMlRn%EmEK?73>72CMv{wZ*R=DmA%e(&E< z%)r8M!FXzyJcGw8A5~AD$qhQZbrX5Szpil-I;>J57B=_uF1d*+D`Xf%Avae@wq#Vz z%=n{MneDu|qCXzA_vt-+cN1u*4Ld_!uxGwi88gWJ=LCD2N<|nRfYyIAs6gg`RyKdv zSrZa6`Jmn^E(z64zQ$QRWr3OrA|7IU{VoK`sDWBZEeq}(1f7-~0-jqrkiJXc)dO26 z(AHkp&oz-BHYo|H34-$0hAC24<&|_E7}vgfU^@xCJ`vVy2DwEFK)q;929H-aD$*yrs&s37dS%08BqnVSYU%2fWU{bnEN9p_$#id@ z!@GN07eHs(OI-+kaV`ZHP}`3agjtE&^g zI#ks5>AK&@st{`|U;v$Zc;Z8j$kI(QiA(uFbDt8d1`alpkFIF`9@5AyDt+|8K~~U- z)rslgUCn9?&-a}Rdi^+0Mp3Ci>~h@iAZ@X|LO*=mwM#$DJJjSM#lBz3##KQFd^@R! z=)y%VW^6TCqP@zKPo4>R^x$B1&2p9wBTyCMRm8G5;V$U5yH^H2OkCO@X4buWV9ULl zV@~hvLs|R`4;dI3<^@*2?M@N=qb7CUPA&E(uPV6Ci8wj&WJ;P=VIt%Fm)*yXad7|X z`mlth!$)!+>pz8kN|CnUT_;Db9IWQ@1`Te3FNa9me3{?zqhDU!vS)KrHk>M0sl=ec zz+h)EZR*!)pj#9kyt#I|A;DnslKX*cxmZdiu4=Cg_-7d7;wtaP$fwQ_yY=w<)Rl)d z7H(X>d5TmQ2b16`j+pAV-rHBDu4`)dk2vOVphdxkg+UoQruOQAttf|}#Sc-D%^aXz z>pE&o{B^B5xjZr){Z|>d7{K$p7nTan;02YkppynZXdA>Fc|U1;7U-zfh|a5uxl+n0 zS~JTR^PYvo&qL4+rc3wMFLOFO)6Pl6fa{o=ZkPSHFQC&Yzi-*avxRjbbZTuXXx-iR z@Pr*tBzvsF4(GmlU@JMVwJR5NF~?`v(e2%@QUm%wfZM7D=ch0T7K4=ZDrueOJpIbg z^RZoNyjB%vWv4!bwL{jA2Ybbt2>hW$-ff45)#73>3N6&&eOh>%FDQYkrc+K(TU28^!>DjJ?o0r)3?~1%JrNK;Q>EV_ljvR|u zt`9&VJtka!IaGMTI&#Kmza;*7GC$48$888C34!2KfRA0&*XjJq{yJd zkhQweXxD{bR$D_&tTMb<`iibwo_1l#4{CClf?L*C^|V`aa)Y+0Hd(b3;Z%>N(?6_d&g_AM$y+MyZdTK?y{qTf^v? zK%1bFj+V|J{&t3t1qDVK8dv2&=LVhIb}C_62IwZIC>?{ARa>1{vm!lNIZwM!3IvUP zt1*<{V0oz~cqHCpW5!KT(c~!>=+gS>xlYoB02k15?v)>A-t@LtXISx3StM-vAIol? zuyqYeroZ_$KnJ)@klh+8a=SCF*2m)XW|I&eH3kLno{NeTd2Q)|EWxWwpVFm0@>`y-hW|=iPtazl4I)2$#Fccibbg2`nrvI$e*km_-wKnEH{c$h z*jmtZQsjyg%XOK$uB2?}2Caf{f6xWKcVy`g`M3%X&~-RQHo^>#85kH=H?^OaFkI36 zy<*Y1y?z%~gG#XmmiXrp6z(|$qzaq zIU4i!0d7mNGD?F;rx= zu@o)*e)jCg%6vWLvd9RPzwZ*BxI73Kn08fBEcoDIb*A*kTB;0?9aySdX_{;LW+~iN zY5EbNrL%fBcyUWYsKSbk2iKo?3|ilknZ$XJ;bYLf5F>X3u4|@?&nXq0U`%?dqHb>b zT%|d*ts8Wo!6^eZhK}Qh*(V+{b25MSPAL+6Zivpp4ZBo6ec#!-K<3S+jlv917#J8< zMq8%_uT*3BZpbxZR&jc2dMghbpYNM_NI1G$D-z|`5VCplq5m!p(+Jkc|I|rp+ZyN;E94J!-Kk+jsXo7 ziYXU1ftNgkP8s}|dfh&=Y^7`0Qul_2Y^_uQnLcqv&`c)pAFeB{S;{5JN9HLNaL6%u zqF+Rn`cnY3azf#kXa{WQiN72VNv~s0r;RDp1*h-16ZC!nx&3X7i|m#|z9vAB3BCw}5Wo4A2v;@!IA2vgCqFncZB<^KB$b6vX&??Q&M4I|`- zLPZ<8Z!G=PK3V8M-iDW<4Lj0B80!Vj=WKfWDa{mAc%0ent`7?JwWX&#l)FyJHE7)9 zaeI}lrN0q0$j)Z$$#Z}E)cdOX!jI&3Fld0%@$m{SR^_G6t1K_G@0OUwEZxPBc&W5O zEgDoWy>ieFQ%buKpryhPo7wa`<~h@H56HFHzKN{=w+mK147B?isNk|0e3`YnGH6}< zksxmO^+rlM$wvfu7nKQctzHef$T!K$;bN40`D2dN3`Pu_-_GjE;c7O`KkXLJqyH$m zcX|TT@w}_5jeB&Z|Gt*9i)-SPv41V(!TBKf=8NRZx^@a`3=%B)vv2wNhq4Wz3mkBaF1MUC4H$icll)S`g zwMqV-=9<%*P_Mml0-fJ2o@}L~%wRk%Kd;Ya*{h?x{H5n!|B&sSly^y=)uMr$+jS9W zkZaGEjSN~00_O~j{6)CmvZ+}x3#U45gM!8x~nGs4y^WbGUrNWX-yBk!nKcE|tx_zBJw|BO+Fm`O!JM_U)j_at%Jn zzD*AA(DlDdUrra|TD=U^VFGnN+|^Fa<@%s)5VHhyuU(U;0{DjCUq*MpPCE^DydcAK z(E0Ds;X9k=E8gDEiVZ;{a2lX+zq=vpR@n6v5pUPc3r>I-PosXw$8nsx8#1ZyozXX$ zw++`!G8LwD$ZhyXLK>T!)$-FbZ@Y zee9YcF3g|~Dk)d32-5;he{Q@oyYH?HN9)uR5*7mclrDEEFVV2bUSHd~gI$e5mEp(B z&e9&wL&U_No>BMwcjE>P^w|B#TpauaAIDrz0_smxy&gf=X-o_wqf!dSwxMCr%X zvx{`(8Pvh$WyK631u3x8r-yx5!(df$x^HS|`=%tZ#NUoxWh=`xPcee#g3o?yo&xG2 zHLTcs%6{6UFV=E`pw>Zi6_3kXUblrtYeYL19fy{{AGBQz4`_VP)sYrUw6!3(j~AKT{N)qJVbUNJRnX4-l}Q;CB? zh~WhT1H*2a2F1f+P5U$%tRkAY7>X9Ws1#mQ7G0a>@UpbYuk~whQCB1QR*R6+rw%0@ zzj))DB53AbcmAZjpq0%we{{C)3-mJ-aEVy-^UN90!5T~l-%r|p=&&jS!?*ctA3L8J zGkdKUE&-?QMSPz=NX~Nw^+G~*wZ+5AVn8?Pc&y3KO%r~Lsu=@&o`P%m$nZV3?<>7|u7X%^?=ooZvvSP3d`10qM0(j*FXx@M8^?j=z zJUp#^!SGARmig(f%sr12FHSl!f1}8uSHa&GhG&SWGiWk6FG!A2x>Bm~xQgX%yRzUb zt0{$`^S1W{p>M}|kZavx+~pw+3#;Vpio zYkzlI&zc9}hkDu>SV5^v^z6|DJNnC2yD`+$obaiUi zHplABhiuP5weQk3f($Pi7#Lz0wU)UAJFL1M7u|f4Wqy?FGKMD(7e6lpC4E0|tSK^R zGJy8KgKlC7kx+HZZ-_<+{`MA~SH}@w~S5g-On~3SxcLhc+dN zxx7`l2tHdvmEk#0m569dE4YiT#SHd|8tArJ&^6IdgD?4Nl}>0s%%IF5wd2W7F1b}( zHw1xB2K;@cHZsEXaquPIE~^uV9W_@aX-=KR0J%>i-E~7wCuG<_rC)iO(#7sWt5$9V zwVJPjT1_968DtoY#eTGExL-@+RB3yE`xM`l2j&-R%x-~hyOoXxorWULurXNAT(t9^ zscdu&Xr~dS;xtl^x&9Z(tp;Y4*cNQ}KJ@3M&})?}~JoqMW^v zCAz|J)rv4d4rOHqW8NRl6>8uj#@97Ew%F&D0zZ3dS$f4b4P(!MmEUenUJsh3y|b@; zs^X8UXPFi`q{gdsFY;N<<8USJsE!khpX`%|F}D~%W88cUuNW8@G$AWiM8tkvIi-EU zu!7~S`9z@u6LdJa|EPhlB0IPebhl6jtG^(FIzx^ARsq+Y+jsG7`2=bk7O5=tkJbza z-!}@nzhj!y(Pf7uW^#b~DeRRN8aK~=(0Tl_2y_+691gaQ^sXm6X1Fx3*xMy7FwN;` zUQf>lML~vF2Ip4IaP2s@e93H)(h2RwGr@Bmpi_-Oak*6If$ioQ8IY(1pWkujgHGuO zgMCq95qteUD5`1Ff(DA<*2588jk`=UaMcb-y; zo8&h^@3rq*r=H<8O1d#Gvij}nywKA&SD1q$*1mJ~*I}pv<(4$=t&0WIrEYJ0oS0E6 zE;duz=!Pq!>DKG}O1LFbH?fFJfb!k(3KNqNRx<-#VSE+jLg72@YA}=bdfLo`cvs!t-Hn;?8^-P>gt)sm9)~ zYnV*9y&s7Nu$(=lufQM`5Z1h6ug+QrFXzA|8@jGZL=~p%r%To2j|R==saiCVd7?29JyKdoC@M6A%eZ z>{)ZgQSMxzns-BB?9)<M>GLM-+>;h4ur)jaq`)|4n!r}^nk-S> z&P1ULAzBQY3|3qhyH0KroSO?%TbL<#L`!PL8|}yI1Exf7pTZUFX{UNO1yrLxUs@>; z+bF<0{h4D4YfqIYXNJ~He^2w33@}$IbjhhR2r#^1U_f@M=iybFExrmo=c9fwGCmjT z1@#Anx{r5Xc&7u}_p>zQiQ|>H73?go;I+8xX1G?Af`efTzmr`RT+%e z%5CA=P|_auJub4uN)g&nm}7cUDk=QnVRfsy41v2lK;tY5OBZS=>3|Z`ie{TRp)Bj7 zuNs9PJiMHJEtAgOgRhEACLh&E(g)p=x|Y?I^?!v0=w<_@0#Msf# zxec1lzWJslz|ca4!8lCRrpEOkhhXNBe%F~>ukTZMHxqR0$)Z5@uuyZb=*s-TF4au31#Y&Jw{N$C5Tl?J22gIQjN5)5xa=YK`a<)5qwIurMm#m;G5^Ch=b z&CCFoS9*JWOu(B*HXL#aj0N2yzJ@`WA(m;?&JX9JOg?CHoR%;It&U4@I(xwA!l~)8 z?1wk2*f<8PWDsMhK43caQrPsyu#>$E(JNXuw2C*%bshlC?I8Dbxj{W$&}hiflkrG4r-R0Kb%Z&!1+GMV&|bu33#xa)C;N+l?prlY z)f5E}>nnh7W;n^g!LU2#{-WJIwWiP>7mJ=0Hq#b?E@6oPt*N~PT7-9X%F>V(;4#nw z(79zQn%_(hZ;n%c5i;w6-Qq2r4OK15nhe{+T|CM~ z*O$r5wXjO^gv^!Vu5=FL2k(Uq#FrW&OQRQ822+kSM!*F&hI|BV4;Ue zzE#=DphQPDX8oM5w+oUCKw~|i(OQjJSAV;AFu64@opA5~_w1bbXAuLIkGlexazwu)?Wf#mDPx(-NjwwSSE4QCX2MIt_HP_FF-4VgaA;0J`7o zIH=X*V6i*bIBwEM1}=svf3M+c2?pOs`UAFqRN%o@rP5 ze*30#9DK*ap(#;hnqiXfMaQh(f<-SF8B`gLrd&@fmCR7J+$jbzcD-;(SNF0x9%2%c zIAp+<{sEo)9~)s6E)Skxi$|Fi6@aC{7jy2#OFc`ut_n({;QgGj`+{_graqZibtRa| zN3|0w?+6=!S)|U!urz?BPBoaDVUC}Bxny-;nF0$3bT7cRjD-umIrjQYuUiRPMb;4_ z$mO^bG@Pb-Qec-yZGsx89}vKPdGgXjP7^n>&N{XXvY~Fy(zjOYz4uSKuwj=L+Ywm{ zb%yV<_w<vhr5w>K?d*CODYA0r>E{}2&b6PM zkg&0cbp_)`rY_J)tDt#~4kkxe)*h#}?x2bOp5~Gp-C1^LXh(tWggP9|!obc@!@iK) zKfsLvKhW3?72D)_hcgZ&;KC0rvOQ$S<6 ze)D$U_UN8Jbz=k1*jn`E~ELAy)+mvg=%TNJurJ8S5mj2}hXx2+gLC)DH zc8Q(B0_`-x5Qn`N=IOPsxEp5r{G8UQe++sqm8@3Z*mKz!K5pt%fS$J@dF{dWT?`Lm z8l(1Xh)P}XqQnWb5eRhPxDaSo7P5b*)77Uih~u^H`g6>$!mQ z31}rM=oYNa(DPc^+tPKzY9e~@WeOCmfVpRsvx}?brsPWMSb>458dk!;?R(%EC zT3*35HBo}$BLf2iC&;&^yRXcWJlyiPFacJJsod@d?0vaou>uV1^7$X%4t^n2v}m?e^ULXWp!5e_0}LL& z*83ae`XHdc@d0B3y!u|`(6HG=ft}&|)xGymb$NnT8}Vs)7G!xas6o~l@!aED#3<`u zEYrpnBf>1)V|=;;e0Q?cg^wmnznxm7uFAk$G3&8`$CL9BTpZm;3^*@XzLzQsbV}Sh z`&{Mq4c%UwI+Rv3vomNhYk^iPILHHTNu7bs+Ip zu*u#PDi)>+QjlHQ3qU!1Nsdd4s?>h(d!S;#E?Wb%A_+Mp;pLpHcT+GkC=|6AJYIor zW7=>vb%E|0hYq$9o3n)yBGZm`>ECkdJ@f{AmU!?}!CNNB^i&u?+GfvcOkJR>66q2+ zX+hJ1I|rACd8Nc2&fqH(+#T}IFh)y-;lRb|TROa&Kvy-pYwY*F_p3xkBh+%@8i$T$ ze}cOYa|?={vIp(nf}Pp=N%-Y82JPxA~VNRvidhy_?CgQ;zMG0{?Rj_FqRf%vPS0!6UkYi$7VidShbgBYKv9!k%^m_0>4yfGQ?Us{4jdP)m^otu7@F0rO3JIFask4X#MBBlR@1+YM}H0o`VDBrmCy= zn&R*3@PWd)&x~aeg9`L4+|5=0IRX!8Xru{-{3xjoJ)ptS4Z6uy6Lj08kUD6M(zz+1 zMtg`xf(Ymy5D(Bi&$L5}^g^T;MjJZsndBu3y5;SF2I2!Jb^y$^!+ zo5^*hef=l6s3CA4==7?Juqi9W+T$Y@NiwHq z9#}Dbk;%CaI$b6A!f%L#`HH%G1a1sD8}lzt{e_NNm4Y|}bWN(dcQ4XKDjFgv<(Dw1 zM%bb#qZM#YX%@4Dg>X9P+%NEo#VvOQIKcHb^labfR~=cUQa>+YYGQYQ-S2YfCHUsz zPT7AP+Mv0KX`n;G6GSBDwRW9tV{>zfeW9_aig)#NQQa%aP9GQ=gupH1Fws+&9`N{x z2=NH$KYbepnsl_OX6X)OtYdxkU~iNlhce`zQ%P`nm^?#~h(6p32gvEjI-+7J1|JUb zF-R~xFALZRYP#EqoPG6I*@bcOfuIu!4_al}80PeuS={>tnfae~FdB4e8}xSFBVt)1 z(DN}AD;TC6JQJeDAOza+(6Mw%Z^s4~Xxfv+*+PS!y-^Q38;&Q)@zAGfQnnbf$bN|fO%0|UdHfUc!h&rOpQg&Gai8Lr;UwVxIh8_*Ol2%4w?9o4ZwspG_i z0}B>%XkBp0oO9^Y%IaoQ1~rBiK@t*2%RplpCns$vaXe9^G6uR)a3DkcM zS)eY%V2rzuuK?=%V(H^!nC4^x>Op9O#+-&&AHS^mu`FmG_U;%$eSA=2O3@U3wN&+U z_!@~NEE7O?8+tTxH5G~5YQlQ=PT;$wgdfcdOnF!@&hU+afuSN%c+IR$Q@Bh)D>DSZ z`*l+kK&9O|Z2~k>^k5nwsr=qq&LgO z)tmiHH=GL7oY%$V{6LdIks+3;>%i&<4;O>Z+0EKCU4cnGQY3ZN$vW7(n)s3 zL53|1eXF_-fvaT$@5;_KoP3w(K@!igJ1UN>+6oL;cSiq^U$r8vcBb;By+Pou7U^?0 zM10)J{NqRLC!s|2GM@`n3W3V}W)BrkhB@bUUla*dz2gZzKf&zA7p;)u-}At;J{xQo zO=R3S$yEBZ`yLmO#^4*E@zJOMsvAzVvepGpcD!QGsA%ZZ`JITqbEvcjpUMs5)G5$d2!}=AwGQh)R zOVa)eGJI!XU;yuMTwt<)L06LX-Z!9Cf|B4qNQDMuyRpbLkWZ)fK2?rWQUQF-X2 zoec0iPXW{>RD_*9+GXTw3|gVNX=BY1?}Q5hkW~^3V=gK)s4yIF3|qs}mcBBu_Q3iM zttQUZ9CuDMM4UWz?319rV?=_;zk@FnR3WEvJAh8O5$t;VC3S{2bQ``DD6CngNink@ zN>&H;!OmGj1|23q#+|lt*oYonKjGm`jaAPM?G|8dg7&h4rmv7V!>Gy-YnHf_349f| z?5#T?Pl`a}4=|&Dh=S^h-bV_c72q)y;&MSuF5otN!j(dGD*|X(EK^w$fkSI1M%6%%3QNoXB({oohXp9q2kq!$%4Bjw35|VC25ARxXG3qB~7<$HxCG6a$(-zl*ecy9Q91A;s@c;tW3+7#Kk7OLl00<^$2w+({GnOpD`? zpmI=PXPCpsv~Hz{2!kr5rO9)T3sm}_U*vJNwOsLm&Qkxozt^rgleG2vJ|h+H)^-L> z(0a`k#~qgbiY>`xX>->|5CL65cC$b5l7&R;sRqtdiVamfpsU$IX93h$uNOS^^_9y5 z(7MetQ+hqRyY?*lns~nU)js2I9b%$C8&w%%+203h@Ar;tg5-Npb3C+>f$@5X*X9uQ zGd!QZdx?H5U=U<523^KD!y9s>-RGJ}$h;Ql9I9^`S|VYqxV6711t$i=?k`+gq;&Ju zU(iLuPeE%N5(NC$E}ALD=q+?u<;0vNptbZrgj|fLvVbg_ETQK39CVT#a%jO<^?`=H zn?N%U^$g$ZRtV)%Be{*ih5uFQHKupel-SAFkG78m~0p*+M2q_fs;$ZHRVFUlBRZk z@QADrN7#=Yx#}7W#=IM!gF?CCVdSLAv%lS%zG02@l|3!0ldghpb=OKw@R)s!W2Tp? z1cSPmhGXLbr{(^I?`|xe9+(I*)LaSDo|p|;6%+?Lw-qvHVEbT}S0;Ew9ej=M1|~<) znrF~{5fwZw3Qw-pmsz>|3_mGrFkIbuAuplJN0Sj;WlmnIRB*9o1`j9C`Kq}Kf@32V za&x~jd=UObQJ&!eXrK;sK_|?USq^&`+#bsJ2-HpAqXRl40Xh@G3++2YXCg4%s0cZP z1iS*-Gm+*q5fTi)7#J9cpN~+1)eAW0Bg8?r}r1`WE(BR+H-)9zFJ-t8#hKGlw~4d3-#fLWLhi9NSeRH^dd_HK z!8Cma6^0sabAqQwE!ko& zyE|nicgAcR*sO_3T*TxV zP_p;hJcaA)rAa@v!+3(2Jgx~yyQ(;{I_~V2W6*}>8RYppF^(O}f_zw3FVk7-1fCaa z0Uy;W32NQvEqX4^@P~ncp_D-lJYTW-I;R!rWT^!UI}R<%amiWe#%Q*eYtcu|mugRa zkH71Yv(;e0Gh2~T&mgW8*Vy;hapPNMMF!9+gMS@s}xkt6s(AVZsOCGD2t ziX+|!;~7L4t{NUrGWT9PLve~X>wfQh;GQ{pn;brVul{9^9(Wu;5$hOt#2J_K%^?pK zNz4eF&JCK0$=l>$iCA|EpF$0pp%c)=vxB2s)*W03X)$m^T4pJ+kmph65fSbb(_ja?6Lc%YqDb%>e36JO zo;jR;wh4_w;79`v95aEsE8x>W4rm0#n4H&gV3qP-xv*me#9fmlSs5-E@4gbi0BYx- z(c7wK=)(jm#ipNH)f9C^Z>7xnC9fHLC$VhlKEmTn<+yZ3FkN^n^PqUYHLnWu?TfJa=hckMP)UH6*J;O zgyujFBC z_8nfZK_{%{qFB}xEmhFm7Mn1`KL!Q{kVSF}eUn=lR5|@}v)HCJZkv!I2q{>a{nt)m z0*&>6uJqj95v%oILT}Mx{Y=5BES^a-So#C%rtkUs(js70ky2!%9q5$OpUWZljqQdF zHtko|*VANN0Xj(|7IaDpcv*rOc(5z%{d~pbPKBz{Fb1s*v4W^pPLo%lxpQOI=7&l` zho1y79gsM?g6(Yr2j{&D?la9B(+>*Ac1;>Q@-}zul@2S}wboL#wSqF{Cd& z(7>g6)~v_`4-tm{3=9n5Gha_0W>5p|+E>*8j|I(L*5Ku^#L}s2QS@@~K$1jZ)e8+J zPOTeV3W$-BsZdv61W!wC2>5U7@bnPVe(<$#4HG2P4k}M!mhL){bo4u@HyV3s2Vx+h z>j3DKY7M0a{Erqh{ow+SNX!WETyb8O;k%)vkcLj*hO3|rXooiKs$QD$r|+V7>4a1A zK`G#xtNEM;XqAQQqv(q@H#Q%b;PN1(A^za*opxq2IIB-!RJ7S z)h<}r!Sz9V#Q{?{o-ojk`$qaCp{!dwV$&+jVCU#= z$eOiupQ@`fyEuCiVj_3-T3IgFoSU~*a$6wMVC3} z=?Ae_T8M+!RKj|TeBiPm_rly~+r!Pd8SG#qIY^rsj+VvUkvQah@d|7a?;;)Ex{b=9 zd27&2#HNUyOd&ZUprf5!B7E#^Dq28`eqM!ELpF6-gXY^IW91QZ`K!OJtZv>Al;8pG zBXW4VKH!n+ipV<3lV}k9MU;Vok%0j;j&XF?lZ|n!_Np5CFhy{IdM+OXw6<~BG`B6< zCch-g(0Jk50ycF9C5ELXn-pI?IQ@Ro@v4>I%v8TEOE$j_D)^Wf>s&>qiEfT)R%I}r z>-V8XaKSC_oQWRX6HiPzV!){o=_2^Um236UE`K&&*MsX%C^K+^%GKr3rAm`sz++1G zHqoFs1&;}z1J`h(9H9NJ6G7`^Ao;H~Gj9U3E1MwDM^^ z+$_+^I+Lz~VoIv3#5-UksK?xU^WdM9=ZyD^gcX_!5asn%EXl(jmzh}c{kbCYY&j{p&toL$Q z+879mX7D-~Xzvev{!Xlk{IWTU6$~m&>1Rycc&6;mco1%qRJhVXUzx!ed>VAfffch^ zU5Yst$j#n3w>w1;a-#jBbBi{vl5k>BWq1_OFBBPM87>`IG22zAwJY~weZ|9t8KC7BkeO)~DF#MH28Ozg$>31r?{ZV* zX4oeu(#ym<<-H5z2P8Ld1Bb(Ic<^Yf{%PQaCl zXMIJLYthEo6)W@tQ-5B9>|Lpd*s{yz>gld&ESLK2K?6TrbsJYsThF;`?K(@hMmq)> z(B9ic?glYS;#ciu*}Burw!zYemFd++$=f$4aDc*=KY>r1hhd-G0U4pjY3-onr9rC; zAR)VL1L*YY^7XrudvyPqUli zl|Z`#lSMdI98b$hcV2OJ>r2Or8sQ2e23;PU2|GOYhg5gQfO@LCBU$TLg2vEYAKhNG z6|{r)+onHym9vEcOkx)aHFmSPJ(TB}@KoZnIxEBXToXBK&`F@i(L#EvDhwHQN>hAY zU(Z&_yT5t5XfMm9{{6FVe+O-Kx)D^OsZ%$7Pqq>VgYloo%q!Y-=P@!MT2KNEb(>Wm zZZZjPPZWCdrfman1*DV#ogGv+ea}@^#nWLXA7)P%W?*7uU{Ec}O64w;jqd0=0NyzD z{K0nx1%?-MqHa2Ag4Q*6D@F>5dAVD?v#pjC73+&jZ2=uL&B1WNczxj|V+Kz(hNyL} zd;Bhla%{OWg~?6O=`17@zn`?7=RA|F{edY8Wp}GzDl0M=>t1E7%psp$;vT68Y-!w1m*6yv#m9FRfQ z(#};^VhYf zR8%+J#_#$KLHWmfLH#U$1}=um7v6chI~Q2|VwPh#>0-Au;kjrpgA8Nx1s~RE)>j$Q zkNsI*a!Fk?oXRG^@bZ(-jq<+tLb>IunG!lUBLyKMb~ARn+`hYtK_baXfk7A|wl5=} zQ%LDz*>)|4wiyBpLJTj@cE(37=AEQ}E4s<0$l%DwH^LZV?8cyz)4;Ygtz4YjW1m~3 z5awdZv_**@V(KA@M(dX^^pfMl8K5F8cU=~RG8!Cd31N_cs5!#dA~WZ|*Ot3$xf&Fg z&Dv&Iry>NEQTlq+WzpNbPzD}DMR|x=8c#V>0ZY%ps~i&MZPvNTe@-f&5?m0d$j-zd z4pA|0t=rOTTY5h(_vJg%rQzNXc7j0;BC|#D!7NZv6&SI^TsAv4-)4~vqm*cof&wRl z6axz*14CvqB%o$8@IiDi6e+ZUoUaHCxrU$}-VleXsenQb6h_Qb4jnisa7*FmqP?mf zA&8J;)Z}aP>1`-Xp5Y1g&z3~SNghz`E+Vkd^cT9m=r$22$j4`|;aIG#Sgx)ZVFNy3RYcCA-}cp+}z5}IgNF@g06 zgA9cKIchqCaObw&pwJJ2c|Qu~v&pPpD!1N+u^tc*KE%KSPh}3Ln+(v>+2Ih)i0fN= zKdLvCu=2j1;l<1eF+a}8LzF=j=Br85d4h@zTFgA|tqj`mjzJJ2{&|w47hhY&a<7BC z?lW-1Z295!Xb(pEP+)+XoBPOUF+weelCcs4nu{<}J_p1_ed+z^sZIe$s*`45Wn^Fg zr9Eg&%dLE`2h9x=K&}Vnq})eE>d-KnL?Be5_HGe*4NblbQV=(NX+Ai2o8do~3F{Ul z$_8H*4eVoBt3Yb3Lv!|IRa#Ou3QB8m)__{OBkAmXmWqO6ob3boWaQlS1mWX%I~24*5EP;oO0l4!5EsJqULFV z)~$k7tUdGR=S@)Blwe?EWMJrwj{=3(k@u61KRlSAhU9WKHh4+dw>HRN9W)=cD1dwn zN*mxYCP-vVfR#5^;B7D3&}5W#>)4OU?o*Tg~#Ae-qXvRcpa}IU4)k8GSpMbSpc)=cO<&PeI~B(EfM@E6Aj_0%*=$B$wgsrFm9A z*7&P3Jum;Foc2~?ZwR}o6obMpu9%A=6JBjy1v)w+Lf7^pN3YgJj^2_3pc+R6l0LT_ zx{xG&RvDVim7t-w<;rg)|hpdl{+bsth0Hwmo_kzinFWMB~3+{k!W;@y+ET`@}QnvZIj+aae&dDIkn zHe^HSf<8oE&Qt)!A}IAIhs*FRJ9#DybD9;wPGwMmsr#II{op|X(7<#6 zw7#7kn>F#03=e2tlvNd)U%{#-fVQ7#$U$>3??V}$lW7HeR*F8qo58Rn?9LXIdv44Q z%uw5!1GpB1TY)pVG*c#`H0OAir4R~@QI@+}(EO15$VeHH(qBk$3NXO(9;9VaP;&C| zhlGOVxjpuROSCg0j)zDoKuzgO?}wIMI({W3j9a&ZYnK)U2Ew&9fjXH18oS_HD^vQh zzZ|HfJRk!LflGU?sUDcrtay`$QFHB%m4XI&Ji!XkP+ZK5sCyZCVYSQ)(7j++7=)p* z2=$vO)3M$}H3l&T4n_tBgs)((yOKTY&Pf*@Z#M>=V+s?hV5wC_36dLHIzSCBkkfiY zE{U4-d^(sg3!a0yA!?u{qb!7%W^v((pITCc5mSO8n`xUhEQ!L(j5MBdgpCW16~HPS zcuo`vfx7aZ?kZ?21ynD|-c5a@4J}td`S8-k*kk*Y7!)A3hW=9656XU}FZ7cAW6FAT zg(g9>6Nfm%zyIM&(+}-4<`&PCe!L!5vI)RKV@sxnGQ%t*|BN+ zSb94k4U`s8T!P9~0jF4YVMqbOc@U~{3+uu@zU%OCmWH@4_zi<1yh!qd7Aq>S^7*ns z9L#48pjr-O_Uw(kkD<*eAqGxH1_mDvXo-WG>fm7oEd!T@cVbxN!V3$>#i5K0Qhf~k z4FCQwKM!g{hcYr~@wq85$TDbNVAFiMRgZC6RAKNNhQ_GEW#ODrg<$VAgYyii^zg1+ z>)oKr?!4>2fj83j?%ddpj-t~ar(PfW3wXIjaRxL9EceV49bxFaXQU$ z#bW0!xFYZVfa{)oZ5PB^tgLuI?I&={04jPWJC?~OKwHn&DOTN5BB^RBk37T_u>9H` zAonZ{yCY)lupn&C%g{|SJqip`44O-fKdY|T@@QFN%-S7iK^Nk9Y3CVlOFZ*J0jfLw znRh^;L5kEdpS3$m()O{4vOAk4OCR%DYaqj*x#VstlJu6{XKFaL_}X%gne|92LG*)a zVwJfw^&OXrn)5!+I+|NH^QTZqRN?H6yvb~85H+XOmRd>}b-QI=>GI|*o*~1ta4ApL z(WNbxK74Iw76nQv2!L~ck-G3)J5Yveys}#aCI1T~FHpQIk)|NUz{SV_tFw^O`4%r& zDiwpIvMpD#L0Kyf*31fm=JL;wJ|;A8rtui_K-Eu4T^+d6RvO~o#Y=Ufd%Xf>cswh6 zC(mPCCu*L^#|o-9K)pJ+D^1%Zak&zl!?3y!>JF<3Uw9mPVEvago^p_D_bEZ!7hA4m z!~7!*4w>DZ3j_*Q7ap0X54xFAnE@d>J4*(#AmxPug9u!0^}b6|?r(lh0*!mXdkF&F zSHxGVpoA-WZ!|Pk@F~XyEn{v5&CB5C-j?}!pcA|xJy=|AyioBX1qE0+)R#V=9TKK$ zfiVBUOFo$YMBv>sP^%8TJqPbS&j?mTb*~fyHzNbX;B+;-pEN^R=L&&-5-%*KX0&D; zO;KP_LWz|C)`qVWCW~ALH*oe%|MN7qX4*`3L57zy(9W=Li=={Bk-`K}3k6g{f?BB1 z4h(u-11*cer4YP+R)D*8OJ+|jgEETk7cL%)kU9+O{XDdFFz7#TsLG2N(0{BR~t=;& zfchS*QO8|CeO2(-#_S|^58*1q$<2xaPO;0C;H?Co!x7k8X%Y-Vj0_CN<|DV&prx%q zL9;ldL_Ga1VMDQj%IsB~OzXBhQg{#sx@i#9bKl*$zz1}KA@<%2)W1ZO@0g{y0oGES z(pEMiG?u2xp!CrSM8iI5-Z)_`y3=KjAhXkdQAAE~nNh;Jm+SMpdGlpKC&qwBBHpku z@PS%7e3RGZX`R_!UH45-gyG~0l^G0*t!6I1ldWfVJPeiKX;ct{iEfi#wCvsR#q-FF$5qso=7Q|uFFx$afM`JESBK8_+^XEf71}>1D zXmspXVvKh3pH78X$HN-(Jns~DoxUMl*mvcWB)3Okv(3Li~ z>o#l*X#_1Gngu#3^d_i14eE~}#6PVp692nbND(zgo;ZK$`qgk@6I{ zGXG3wJd)=lZ0Cc1E)VY{<5~`1oVkN?S)}mD{*7#xtcYMI+HK4i8Hpj#@loK+q zVJFA4=pSd=Geus|yvF-W@b!U^xh-&w_2Xjfv3ZMSIT)3op(ny1!N|Y>TT4l7D_8@y zmQa16mwf&rU&{i}R6A&?1ftIaA3r*yXDWg=qF1o{ip$C63CiGgP;NXNf0f11THUc( zhjv%jl?i}Wk18-ISgrA6Tp6d`y0kb>`OqS_uMgjBJ6qAIp(6r0zEz1qVV7QzyugK( zCL38ULiWowIh!?bPrSMGSzf)&48s^jkeX@oT3(w9y4+^y9J5`adwBD)7kd9TgYHo% z=y){u&W(dA3<|r7lx8Y9FDMU7T)DH>|04LLQ>HG-X|ryB7x9(NIO>(JB+H<%tF_~< zR>49g@FqD;sr2o+$Gly*PKRBWDHj2+W`)kfJbN4qZX@SUpJmdvw7(qMfrroa_q~TS z|94+`vd9?PPlmK7AgeI)r_YKhQG@l38?xSefm@<)gC=*Mn*r-VZoIV{$rNb$drwyg z()y3hI^@|D9J_sm5@ICG_qIg67=t7u0|U5l1}#*W1!=LDtvuHz0eP~WI*CFlEhKX2{^l@#FK5xjN%HfZuO17)~) z>$D`8Lob1P3$T{@QRG(i?kh_`ZEtwL#K!N%EVXhY!Na$gs@eLzI0x@zfLp^Z&_ELQ z6PhCh>K{Ye&8f}zU^W$9l!UcbQ$fr0)xqut*V}J`Cd;XpsFR&y5&8X15ZD1(s3R!E zr+ra|fB&DW&JWt~`H(-$0}hGi+e_8vsH}jEVcgSQ1s%8joEKPRkW#jiQ=Lr@pt6i?92{un(%~-RHKDYq}6>sh0lbyVnxvSV&*`eCR9)Bwq?b#T&BLL&s;fY`mon zYJ-4UESobzKzR$EtE3bdpdkXvOSwJriVV=P<Daex!(?*Td^56?NCM>_+gK4)?^edr00q@%OPO=DA@(Ha0s+; z`aNS)Wlf)ErUHEAEvIbe&wOlSQ>dd-2=#0|EFO4gAHXa15bBSa^`sIuACmWXcP_{| zw(pqdc?K1Xy$mXD4-SI%GRQC(PW0Ej@lsidQDsT;#D@;u3O<-z&*5kz=a0?jO^A2~&kr3Xh4eDSFg% z+Gt~Oy~P!y3b`tx{K1vUeHF!{|x*PJyYkLdoL*%7Lx|5 zH=t^{3nPzB=lI^kp{*CJz{v2QL5!i2UG0LJ-svAqznC9s9Fv^RD(6t|rUKe&1qs2q zV*ehg92B~)4)&7}iml@R9;rBj%@Kg4Cq@lZF-gCt6TGJCgVGQ`I1Np=7K?K_({fDK zTa`fo>^9kQ9mhuVrN@*Gb1Ik=rhb9U>D{PWF_k za22!u7Yuu3JVg+c=@}RfEQw%dkY!|Gm~NBKz`*ceZhc51595v_U)N~=5Uahsy8B?r zOE$)gwHxls*Vq5~`| zI;>PX8#E)rYpKyPF*Q%Ux5h1V%wLbS<>&yqJ`F=k-Q~ zHGN7RYX7Ejfvl3cU>59hOgJ;lT~I~XUh1>FW33RgV7yYqs(XPfCy!{m_Ua113QlTV zA$~CEYu}`Z2|j;xO_e|n+S}1}q9SY01+ZaFY#N8OVd${EW<9F0Dn(rEiNMT29b z#!|4*lp{?kkMdt~<^;~qX^}E|H}OOp$k~7N6~OLRp(c5P!IY7SL5`7up((}9$HB<> zfhwDsl44b-rM1wV4vqH(4lk@lcRtOu^}3~(&C(-%*rt4y?eo(*0rzy7XQZvnJ=a&~ z=i+lqPkEQTU-I50|LJd@^kdpZ-=HcLF4x!GH;oxQoz>SAi^)EcgD z_R$PKr(gX1@8(SIzHfzz7;0^x`i=LOCj8?qB&HM90spAPFvx8hg?+#CS;&M^8twB@c<(m@|XCD(W z{t#Q-V|Afx>H#m?gvL+j&vl;gO+GadbmoJI0he97x#A%sH=P_4>+f@?dxST3Cnc;} z#GuKzG&Zj+t7MC%QY?5kf9cMfop)fy@pL8%EpU(kpPTyR4Z<28$N_LsKjhX8ko>13F?OZKGZ#_bE?4FMUh)rTUNl=vAKFxl+);wd_G&56`v( zqVb+{Y+HsRZQFu}%kC-|toG#=teibz`?+OV*Vq;pRuwB>)ZBID zfaUHi&mY&>9o~Ji*rssYZdQVF5}U$_D~h|OzP_OJ_2{WmgH&?{b4H;XS_S*h@a@gg z53#EN~L^9&@J&gpG-s64L;+KKnG=)2|;vFBe+-4f=l zKiBK36~FJA>VZ=~)z5OKy=D`!vwPI)n$+LM;m6mwVUOPh%U`SqnHl{015_O&R|fDJ=Zg_x^`t;6rzhtK-8%=z|`al%*YJ>^Hm9x5{^GUiR)zhMDW z@8{xl_r8Yb{RtQBSMwycK46>x5moO1Im)bL=F=9}n+yk;6%q^U-i3H{JSu%x#B#*D z;Q=FqHj~nU0zpj|j-Dl*D%?MH54$cAU}jKYWMEJ<*!7}h)$11v6e<{w%<#V1VQbx8 z{A8Ko)`h2a)OC`dxCAsF`?+)S%|upB_W4m?ZQJIG_I5l>{bl4bZ?3yl(d8MpE~HKq zo@Sm7O4S{o+Mz*&>>ADbjIvcFPnH?7Cam~;_N<`x)cS-eR`MS_zy0x3VSKA3Xk=Yj z$a2K{!pq<})@3Uv&6u=VI1v;*!HW9%t3a2rBxvfaU>6Bg&?(7eVPoNEn0)i*!HKhv zT?sjHdUlpk$1n8=F78*(3>u6TB7$OG{1^Ux<2lHDAf;?t#~qVp%beowg@88h9}J2J z;MY*n=}v9?_Q{n)jzMknaa<2ZV)UBBSInQU-r!~#{3QS)5Ons5=b9+zV1=W)~EyRT@En9->B@-H% zehI$Sb#y9!btgh4_ChV!%GR%pn>&_sD=>+-aL!bfx}bG^ql(2>Pp31h6=pZpEcZHS z#oS>j^w4L5f#t1Z%kG9uD(7NwyR!GrO`+ZkueQC=OJ2`oKK035t-ABQ+g_*Me!6l_ z*~(pR2PT!Rlw#5oTdBXy+UB)$(Oe-XouK$0YtgQW4yQk~HAII6WwZEfUt-ex`N)>D z(yT3^^9q^$)GQcx&0%6tWMp9I?v#1z@7dbm!#N%I3W@c}xyO zfNr9Y&{I;G@a-NWB&7Qd%5qDtzPa=Cgm3a8#@kk)OL%!qpPxH5L8VHzG2q`yOLfUL zDT}svTl4knORk)8;(Nnu<+~~Q6R$LE>g~G3Y*-lhR>g(;SGB6esoQT$zNqRd?@|_9 zsef$lsh>+`mt=`1ygYYDDbp+7LVoVbNnu7Dhu7FFo^t7rUgha8S_&zb#QW6dt`y2- z;VkrFQK^0TrB$_~i0jrfzv*h;TY1D8O*O-x>j-lu)GhfKcIKkZr*LR( zGfdWO35__mEN|lG4aUch239qE+n%0S8OEp;F!|=n%ZaR-A=<3D!pdEngBO3ED!1V8 z+nJ{hHk&EU;&m}u@9up2RDmE1e}l$si85wA#?Z|y_7i>Dj(&JC>G>1xLlZk1)$MOY ztnyg?BRF&SnLc4|5rKp9IXan7P3*FB|GhsLc4s zaeTtm5~U{~g=~*B6FD2>GFHU=T+Ym(#K^$la6II-N?W?z)}p#~kDNcwH)_rE*JYY) zDbJO#q-Ea3JBBm4_sS+ZIXL-rNOW*6-?((Z%vb>My;#ddE=1-EfOv{)x&SuU#e&Vs=FH>=ty6X_&S9oG~M_KKLf(i1T~IIG21% zEt?aupuyqlyvS3DMO%93vaawvb=$5I)c9ShD{g32{BQvur+e^H&a89bGh#I^ zg6=;^U#?Shc?Q$eT1Q(2Q2rJXlW46s@ZuMcz4Ioe?8!32*3jS;$8Q|!zM!|a=f3Ls z%$5nxwhw|MG?HAIdz5*^XTDi>y}s;Kd0qaA3A1j0H?cFA)_d$w#;(}R^|gj7-iMg1 zUPYD#Gxb<9%v;$|)f3KqxG_op{M<9=-t$TZ75|Ps5*lY<94NzAXkl+`_e{B ziW`Gn&c3Zq5qr%mnb*BUyqN1S=!Es?tJ4yvuKF!lP%=yKt}i%|O}Z~_By*>N*?qa> z#k(o(PnH$d<)0{sW|5ikhu!pugT5jYgEAun!wEaV#7R|RYOM>8nn`8XN=sbmO`KPm zGqtHuOs)BG?^d22%Yt56re5D4lh*i&Z?fW+tvpK^s+Mls>~QJxyPtFCPY^r%`OCY{ zyDu_aD7!hSLYkK$H_=V^G3VsiTT#dQ1pUAKEt(#+F zG32_S(*(LFymxigF;Avju1YCo*93|#&-i2~;qq4)ax8TM=)|P+em;(QQo(B7fel^0 zvU}Vci{dhQ=4h^PSO{r3#H_rj#v;KSce z-mF}rtPs}}{(Q3^^gvO~gei08?yzwG#=;*ZYQVLmOJMhmn~}~Ze3Mr-1U7&jCf)Z= zoijtcbHYtdGf;K=>@&Z<3*%x3-=ZT$d~OSkbY{-wumrUlCP!_Np1o^pa2WW=y~#H@ z7b%e4i-mbf zwLf5FID5_*W(J%{#^L~DyHp;E#><&FU12&f43%}9AcWa)$ zvPSvat=}!IyNf|mI;~xAe;PFvU5~5oPcD5T6FKeMt?6G^Zn?fs;}ua3g-2n{^bSkTvv%hH)B+VK!-#0xT z!FWNLA)3)RqZJ(bxw5h%SCT=enQ?iajrq5xiscEH1nW6}X{OD^(eCW5UqM&EO*<51 zJl%e^9OF(Vx5m$x+YY>8xp>jh@dLw#S08d7)>kO*a&g=&>;ek&(5Blx(-}l>hh3LB zoS=608R&GYz_oGeFPIvnL1(#~eDg+DR^<8euhyVr91~a0JUu_OzafTk@qwS2&Ix6C zuQx=wCOW!;Zjqj~vnH?XkiW@%7Q;qufg>DA_itLCU05c{k;Jm`zWHPE+kwKNtXoaW z5Bb+|-6%ig-?9)j9uM9DD6Y#s%lJJ%2p*o0<9QJMT)rv*&)F5N4V9 zb+v=TF@?Z8FZW$u(!Iz!W1q;En>pY5j%dBu%z5vY`N5sJ50n#K+8c##J>;@waA)ML zsFAf`(Qy)&vv;uGAa!Ta@iVu7`*qJ)xVL7dqv8_P&x!%NUKD*?%C_BOyU%JyLq<>W zCG*bS6!e(;1*m*HOiaYq}d%c^VYn$&K8L)Cj>((0L~pQoks8t#vmy4f{t7Sq1DyBi3Inz88D_+k zGAUM6G0ez3{6Dbm#go*XFZVTSw%O(|h2MBTn}M-(gM@4RI}z1$j28_bblN#&EvvoC z>BF9@^pig!mH)&$=^2+iE?Tg=99Jt)WYA^os=MFwc^~JoRQYxCH|+LEWyr6qUwz+v z_TFOKbBuxV|M|Ke$OzQ7y*8h-_n+6?55cn*1?|uGD9tLn=RQxNV@*6OlM!3zBfsze zE|z67AHU$7Cl%au{ULvurcN>_pNNzkJj_?$VryMk8gMC=EvohC&rF5z0~(f`hR0ul z3V)>sKb0dq*L2RD+`u_ez&B}{h1K0HLUnM)9wDrGyRWS zuTONklpe%!*p=hqz7JM4LITE!67_Y0)(x!!{>f8z@tv5i_HM_S;vUTtzR6x64yiPV z-Zwq2ktWE(%%IN5z%c23re*1b_Tu9EJ)3RH7d-&k2^=r9#_DBQi&dk1Yr&!?%M4xFm;Px^6HHzQswix&CxVI* zqsS#yYgZfF2hbLZx$2Zi$=-Pzb3dd~mtX)8uh@i}MyEl!R-eN9t8Z|3`T=;9LN zP^DgjbobZ1KkfJaOlUOwAY^GN{ya&^aK^UE#S6Uo9C#T8j0Gkf5xQXHFyrv2r=Z!4 z3)A+`)OVaeop*6@A82>(uQP=?hhNmJxt3VU^Jub2VY@nBa`<96W)G5`-3}8@WDRG=e5TFnj*g#GB(tviyq{X zm)F=S63f+nM2z>dD`+c_e1jKMoH6mxg7nV(`8|w%W>wM_VImbn$MSS zU#s-_XZtGS8Jq{16%1bO2v*zt`P9bsk*9vX%w2t==HJ3sJZVlJ7&v;Y-c30f@yg29 z?zGDxolt$olTM_uZe&mG-4;{;=l z%NYl!1F7H>k)A8sU3&u=7Lnbv98|{@t2=?3B`+38bSz)d{5?cL#DHtgeD4oNQ-5t^ zOM5yq!RbJ1*#eW6ZJ^;Wxkpt;H`Z92S~ERTU2(Ymm*ye|2Ue*CTYs(&<^|P>_uklD z@fV!7>Cx_IJC@%P`s1=ngR$I5r_Fu3&GIP^)F++XAR!m~X^xZ7qK!pTcT1%lotPLj z85tN%!u%HR_FMc|8Pwneo!!O}vcPdOht{@3j8#GpP0pPHWhceUpkBA;pZ1>@XKD$` zCgdC|Gt;>JlYYb?dsS6EmQ5XKqg8paWQ^~}@a&BCl8$CU&K z*f2O5=9;>#Nnh?~&I~Km<+gY$3xL`;0`AjZcwP~B-n-GHt&$;bQSp^asnCOB`7-BO zT3=Q?%PgdnwqSZiXJyi@XT3~^w9fBf1h-ra{C#fkxj65XabA92qF0}>N&ohFlPBeU zn)z9}fJuAq?Mai4HTEqpWM#_AN-JfUpwY#3E_bEZgwzdtYtt^My%3yY@-C8f!Q)K1 zBF1$N4!&pC@G%Iv20A7$PoBK)&n4$$f41iHRlW;pmQP8j=GpQ}>8l~=toh!w=hH4f zwmZ5rIo$V8$v3MP-TWzu-w(XjNLciO#bqYXbb-I?i%&N)Ff`=+Dfu>o;pV0d)jkb5 zU49Ne3?92L8yH`i;`u$qHuIE>BEbq1n6Q z3QXY)$t*8rQ7Nq#Hw>0fSU%%YhaazKNzRO5W(F-r28J(Eq3;fV&3`*P!J%XK<&_JY zp1psQy<&mOJV;qB6vewyQ+k0M^D%YM-8QVCKE>glw%4E{7c>sz{DI-a-v(AM&`sPP zVu37mf{BvBM+8d2w?rN?a^nd!2Mx6CIdt4znb9*u58O%xO%uSQ_vIaXW5yFNjjX?{ z+8glJr`_ayWz4gmA4)7+F5fU>SkpddiN$IAml8Xb&3iT92C;^LGVcu63!sbX0@y1p z%&ozhnpNvJQVrF_&R}Al%>f!ju?qfi-mZOnq?dELrKiJgkCro#PJ-$D`U>#C>zUTB zwFM2(!Ax)+{PJvNe|Sl!YIMKOEn}XE2O?7Nz75<=e%j4i{;Iq&UD}vR9kBG6U?S_h@YKB+QMTv-N5}L9eDbfBcbK~Un;8kX-kRLQyWss7CrD0Tb%Hh?|tk>*B79xyQ^2}9<(o8V8UV{bihIJ z(3>MntecpZDsH)|eQmkj89$wXL(EaqH@PQC8X5#}%nL~S_vhN@ir0TWhHO21Q?>ta z^Ff=3Cw!B^^^`&d1L#Q8fX35Z6ZW6yx}s$6q^ZDdt8Am|tf|0#cV5(WN1o3yY3*@a z#aGRJIpLXQ|7n}!=^$@6p4u1k;e(@VmQe>YgAOAD!!PxSL`Kjto$hRVc2@1HF$0YX zoq`T>IHbmlh=t@NA35aZ`B=b)VF6Se*5m_qd`0;#fO>IxQo-O-UgvQL7yAp%^K&&o z!*EM$s~A{BqaQNdG)Yl~#QFo@+bd;k4ygqQfznmetl~)r-#}WKs#~Ozg4y3^f;xL# z5~}Ixyo%<%npPUG9@w@Xb+9>FoM7y57%9j>v~xPx$0b$YId*o9vWX zkQ6<|mreUl(#(Z>YXrfi!B1`Iyb*;Y?-*T}B3m<$Ci!Iqlq-YpP|sd%?Md)=#!ndWf4@ zDOP2kzQ6eIrTLt%Ssb#e~_StD|?~A3nXEZsM7oO{Lc=cp5m&L4m2Y=2zzes=K z`DxD}`KmH|{Q^-fGt*V}Z%)R~v$h6x0!*2OTEu%U#{O~d_;yS9%BH4ozsm0S6z_Du zQ^uyu{nPbY$IQN5IAF7O4bPv8hDX>L_`{&wKn@fU28frLKEEj5QNO99= zgw84^i&(D-3yc8Y(~=PBxjEL889X9zK>YVPW!bPFKYV%{mNEtXRn#bF?b#Kn^5%@` zF2ke%ONSo{6$~@Z`1yj=I2@R|p+}JUmEoNE>z;sTY}1q5uWE61rzNIGpAjwTSq-@^ z>ExRb$S?!=@}$(Ipa$RNwgWb$D|a?0H?(wARdM~d_uaWP-}%yaDbwsXrg@n%`*dri zZ)USx+U~jYy>)iSg{+RZXJ?+W56iMteIH_aFfkW2kpHUW3^yC+GW$b@DXP*-({3@S zGL~C&i^$GTRZ4uYAyqr;qwC6sz)xkF&dHO1rE%Sz7iDg?GJn|x<3q(W_fG!s)X3UT zC%~cR&0Ho1Jw^rwmf5cs)SS5wDvu%d&6#gqYW0k@ndP$lLy1k3dV}ukl%%BF$!3>< zW=mHpg$OJ>J=NX>MUme>zYoF-1#ZoJe@Z^=-1(zcn~e8ANd^@^P3k4x>2+6^=AEf= zIx|Q1=1l+NJ9hBKrdcLd7OT0u0FP15?W;VfaPW(}McbMs5$&!Hs=`I zlrwD|g;M&LXZEB!AF=3d$a^FwnC2qiVZqsA#$d>p-qB(qbkQX-YM!H;n?M&IKt8pvJo++i5$xW}++YGsGH|EI&CfU=U>~1WcDzzHi5qEz6 zMvT#&12iGIGyhoRJZt8+mzfpL`7;-<{?octt=jV(tQTAV()wZg3>7QhGiyJIPn-2d z)zZ3gXJYo;D}VSVeTim~Ir=kmL1#kEqB);0Up*DY_<`f2*SYhMX-G5ByzbMpGo2QQ zOKFAwn+Xn^t;XV(Q?qhjaNy$S9V!j!?CU3!|{>BEh7LHzI28w{Ogm<>dYx zyg&M4@)@yb%kOn_c%&WS0as7YW7bE=_gG#0BfGCjOXKC6pF6i6UtODio}VG$`085q zKWoGqzRgX5dt`we^Fd~X6*supU)+p5#&5L2Htwx;bzQ@4|1a_PIqi$3mI>FH@x8Eq zm>yMeXrFLh7|+5lb0vE3z$cV=js#yhSk2{~vZ^7lsBGHD&C^xNVwW%LYpCE9uwiIw z(^EXfbaY>^*v?EJ@Ia=+2L=wQT`kb52NuRDDxm4-`0|K{kDc421$MBg##LNt^mIJT ztdQ|SsOlxWHxbi#q0hX_VdMKX1tkF!Hi8R~TIOIW$GX4^8#!YVBh?qJ?owiKW%S^Z zpReUO?clcqOCtS$XBwMW{qD@W_G0pphLE;Zk$w)3CL3_2+8)}>#l>>v${7J0h6L8G zzxx_BdlmA!VJ2~F*VL?HiDbLYJUPww?Q&oFJjNB029i>9|GJoGfALIm&~m=2qptAL zQ=)Z~+`~v#)~0QZWsOV>28;|0N%wDVJj^98udkxBbxjVB+e4SxyAK($ExypoTK9EQ zztFTiPEj%Ys+M%omZLY<+Aee0xL&AA+IAx-PaKSX!s5yv^Cb0@yoBEFA3DOE0#|&V zDzxn4o6?|b@52yXH%0f!0v?4lWwxY*1m$y&jr{+m?PIBpGwV5L`OfIG>I>uJ8+jLh zwz>Dqd&#!bu8X&P?UVp_p!pIf1+`zcNQX=jfR>WzLvvw?$LBAaCT+_<9=`mv0Gd&k zIa`%KDfz>o$2dzC7IOt)Fshgn!@oQMEd56|~qwzFku0(UZgw}mWEdtUp5 zv+2aIPz8nL2^#N8)+e{P?&$8AWKn%U_mNPPplq7^e0}R4mW-z!KOXx!1Z1EdlM5o6;rftSHfXY7JDzuP3dJ)micIW{pj|xV=?YgNBsuzcRWYmLjxh-aLgr z|4p7w+sEs9U--$9{|O70&QxKEDRHS~;Qq;4WL6i?`t`;p;TfR?+RtA6JYAe#2pKYY z`*YKSR8Wi5Gk{;vFL_4F#8b};=WkC+(LcXx2cz$tI)?D6pIMqiT6Zw|-T|GP86^6M z%>;D#;H@K5=a)(rzEetYVo`DI{LM32C+H{NbdC1QH#()P?{@vRr8MiX|-M#@>J!-PhK@;dBy;3Q?V9Ki4M&cg=|T$y}Jz02tN~Pk(6Bx zYNB`Xc`+`A6d91kWLW1nUzMwM2PT|p?aJkm;pn%u4g{?ra%E5bs~2=Yqaknwk9S(S zD5wD(a8taMRdn{LqC-Y(d@cSatUZ&2jh^YBkO-<>?gttpPk!J~@#f{Fl$FySDt!rB zcP>&*=)j*76H_zS*GA6ws(#yTSeq!x%zkKjL*NCm;~#}jrbO`c>s2x{7%?(1`0Z0j zP*zA&IPt{$%;U9(za$v=gStGkpp#vW&eH`#9&A#2@_sYZ))SUG0r#eZ?#HsIFU`{l z+R2DmeFth}y#Bo7O!3dC=?vQOY3*^m404Rp@hi%fInP?ox2$O`(|0SE?L{+|TzO~` z2k)Aklb!q@6lPh@(QLunv-lg(ZhF;`M{*J))t{^g=<+g)sfQS=P8F*!2lWT7GMYEah);(02UHwY6C+<-;y82e zTr4OFRUKebodCKcdCfZ>amYPgQ|8Rw4C*6Ybd>ISx?{!_(48+E4k>YJah?WuBofn> zdx5%owlC~juWVAu?&wuoZGG4^?7h4qsJo)h1v2-U5-7X2aG7L?IUZHm@+fBSmtIAe zMgwr0{^ZS-;L2Kd%fX1g?obWJb!yEk>YGHxJOexGx zo(T$*oaPthCnA(O;$&I!85}0>w<&)G8p#Cpu3Ul{%9x5LnI3VQc!;s8EXjo3Ost8$ zf%Uo2G!B_2c88u|M>b~tH#b+dfx;y1MZmYn=d))k+m|{sGZ=&Bf0q=BHcqpj8ma<1_cWXqv!`#dkD2LmBo@+AMsukI%rZV^$=1z2m{d%4@2Q-1mhI z(!HED!BF%2@3cAA<(5p3R2@DrG>9?^ChX`CQDSkson+wC=wq~VUEh%>QE6terE9t4#46bclcVJcI852hJOE#}h z-?4VrZ9TbxVdb40nsbi%O{u>Wx%*Pw?nz<2yBD0#)Cpa{_o*PS>{Ge%0f8_M zIR?(|&&7}xlMbozS`|M)bMkDez2M&U^KGEqQWIJOYj&RZ>j$lcnydLI{r(-9#=uuK z4ja?e^*~LtYv!&0-+)T{gnY>2L|69I+Tb7OA;b4~u4T@bV=%N?-PG=H@_P26`Wf3n z=@2~C1RB0PxI!{%dh3drl6sZb*h@ZZp8xZ7XK*kmsh0%U83&uG_U}Hr^AKagQYJS? zQB`Bcn%BW|tji2HZ?*t?96ExN6)E`b%@>Z2=?n*%8Nygx8X(EpbF#v3zfBYF8^ySA z2{JA2_FFCm^4E-o&NtKN=I8bOxxyPc;aI51lsRGThxWX^@&-PbIHmVSG5^AKn@?nI zznb1wtSZM)xlbp6Nde52X59AhBg2W$sV5EPq95Fryz`;y)0fu8p6RQO@R$ha7wm;IF_9AX5?F-3+nivy?L>pLyi5Z zr8U#a$u{?G(l1WG@O;i*W(HHx`cLPKmFe2=F0_`W!rvW+KU*3xaKLFe7?hF2Rx zEf{#j8S4ekZ}FO-waMv*+vecSph64QlzQg*hV8Aykpm9NLedij*pGUGUAZz`hP#*x zp6Ga^vIvO%oOdYEUq7A zW?E^2#}3SF;u4YKcHv*WjORSpg68vD3US+<&KVfZoGWX&X4a+_)@iev zxI|{nb+>}n|58`wm2_S`um!iZjLeyx=gfCI2*07H^us(*9khJ=PP2;@m5QD`lNk~t zQyaKuz4hRzU{KMSxRS|@)3{~D-LUzRd1Y0zvxR$^8O%WYKg2-?+X_qzWm~b}<_yIL zj1xAvECbz3E%0h1>%O@gHwW)Gj_hgTiV}H6K1UHfSeGDzkxCqs%yS?ik4%NC zof;N-PhNVeZi(TU6{$9fo4lh>-!OdCxv%~54WqK2SCuS_6MW0(^B2wtK0DJk_SNAM z8^N8KJ~MSd7jHs_$wSXuKVa*m>MW2y!HeEbrGTC3+d7MaGCx_a|p?i_TVA zk#OEG?fD75d%+Q060D*-G}zQq3_cv1H}{p*!m9$(MiMKmNeLXgyyo9<$I2x`iM60f?RUxw+CHXgQBexMoBgW$zFStWgM9@r{2H;ONED5$$7 zFoVUTLs>8~$#2yi*ZTEWzI{p4kTU6B(Xe7K*Af$v!(7MIS4BgX0xz6iRC>;6BEvIx zDgEtS8%nmT9jsfsHOfNsa)m_I3R zQ~Glk(0J|^sif$;Kc|#T4pQi8G+qiCHDCfQ^DC;m70h1wBY^+MlJk}&;cFze?7H(N z-Y?Bk8`XNv21Z-3*A4WsGkTauML2uH0wwr~^zaUUl>4L{O4)FPqTL zUne+ace*IJlj^lD@Q&Zto44ye1ZR25! zyRmsQcs-7+$oxrpL7=*DkppNcp2n`j3KnUqURK*dBhs#i!1MOt)~bE!ET@Z{FLr(L zKKbU(HD(42Mg|5@Q;f6z&dH8gr#r@7f3ENrm6biI@!I9N5_ICZ?YwbvYQ85_z!ADueJuIZ`MQ5LSy+mQ0;S%9n|V>t#S}#ZBkj0 zf7SA|3zPRVPfdAaP+2Xs$AB~8X!%(~t`;UY&qaw=>PqIlnrRPqKa((c1)4(ma`x;* z$Z{6P61DC?hQ)o>k{i8a7d3$+<+BGnWc^|A;$O}!tdcw-v5bqKsAM>MFhW*{qL_d3 zW+!N2&Z*xC0$=?%99x$6R%DSwhY#pv^5^>`mj@QWa+i|`2W!uy;`=NsuAv4-6A#;} zb3bP~I6dk37q{~5o5VS?%1=N6%jf0G<_+pvbh^I^{F9#U4r-WyXKwzyN)rspVP>#o zWMF7z{<5X!@5=wj+Gak#K3~%+zvus^Ng1Dgh35SF^UGM_>O$97-KxE%22(Hp_?phJ z>(0_^pxapO^vhS8E>JnRGPSt-RH@B9dA;(Lrp9fYzaL+lzWd6o$~hMzW%)1G`>7Uc z_-yicY9;sK%iTqv%DYQW=N0VPXeF2U;tj|7n}Ubr4%?L4NG$vMbRAnzW$n(@jZ362 z=w_~Yd{8M%GU0T8`e}yfnT&T!nq9T7fBYbH_o2{JE4ejGE5F!3pJ<`Sc%VMgVSABm zfAh*zj?%dirv+X`@V{6ltrN7fk3CzX-utRmz4z3wn>-8W|Mae!vz2E@s_N2xca~nu z(ER$#ttR4ppTM*!zg{v=+xN?&YTi+g1-i!>l^eHNsU*%jEyd_9_596=Zg5W)G>dlA zwO+yf%XhEb&)}6F;C&R}iJ6BI;5CV$Nu-EX8$6o47_P=8m6d^_06bR*y4uqbv|!Yq ziAQ7+U(yWqGb>UxSTAUAZ9OUQ#VhxC7N}Uh=(zG^!pcLS$Xo|1WR&3gMGUwCHi9PE zCd-4G4AFOc8;w~-Gq_qn{roV{`q+cVK($p^dGZ4vN7h+PibkOz(f$(94BHBa&AWKE ztU3_t%BahD)zF}~k@?}q^yO*knN-H(5Cra+desK*P`{GGYzv=@_? z(41c^trb<@f8NdLS|xNY>KI?G{k6X*e3Q9WF9TgVx^ZQ+b*gXco;@qUedv>rWjtMy z96x_IG~|Ki5VMRreyKkxsC&mE4a)VPHm6~MLJerY0AxQb6YV?VG9v8;?vg zXmCOkTD9$BN`%gu3%i&{E?}9vtYOv>J;?pr(`V0>-FcEp^@R!R6_v7;OyWlmn6UA+ z9G{1+gf)*`@Mp4u;)5R^ARlbGB4XS&cWJ=JwfR$md048;vdYxFJJKMxcR%=Z=jO|d z=EuI%qGI#PUX_4u6*BQ&t7mRqSi0|xRYX?l&YLSQpViyykqK52#>`;N$iQG>rE#=t z;eHdvgz6;z1)df2!W z)a`47-Y2ieSgQ{14xTwse%25aIdK1jtEekA{~oq#B#1~9FHF*wS&+V53e?~O-%7uG z1*q2ZJCD)g&?o~9kFE6Iu6aazAyY4SL9ok4TZ9f3DecAOG^GbK#-1+_s z6UP#e4WPDz%fXA!mO(bKf^S^}McmKbo%7hi^)QHMYE}EpX$i=H%V6V*bEY;;3<7OP z1x0vP3HZRR`dYsH%}B26hqx~C)b!Z@D$Q+5(^i4k^QE_5e$32Z!^ps}*+=C}(7rdj za?6@}FFywJKq)7}C_^J@WmV?M8c=^8?88Vd&~b~G->^t8Kb}6*W5&|7=}}9tsmlT# z<(OGk1xj^Vv#K&r{#mQXoNHoz)e3a))2yY7U<1Hzn}gSauYb}J_1(KAmP zx(!+@3>w$a4XXhUQ5wu-sp>S4Ty6Wja?jVfS?4XWR#OYXHIL?w7!$ACsS%GD^ck5L zY#A9CsuO>nNVxT^_gl!kLddGchc`g&QY#HpNuAJ$2j)VDRbJd&3EL;R0Gxp#gE!!g zSxM)qL;pc-|4pFXGVHF4Wwf@fU1!<$P-)8*kq>Ws=FU|BIT*Zkps`I)F#^2#d9yO8 zJOf?tyW+;SUC$)iy1~VO2&nzFs96be;V#3h-)VEMy|DAKbpF6_Lc%aZtW04smJzm(0#)72OfQ{D?LA$On!UH?EnV(qwCryz=4@ z=yGNO&>|*b@$Eaq5<(U4GG#1GY7Sh%V{UDGE8^|itFet6KG^RO_@HfR{dM=*txeFY zvnM^8GvACQO?|Vn!aR*|g^-I3I*g$EfjNGNLPA2_z+HOv-mSZ|1waa)?UP*o{cgMM z?<;#9BRmU1-TKKN-Olj&odvl^G>lgmw zGM1q9I17J2r4sg-WuO(%R_?m70ToiOMUTH~0F7E&M7tl%1Fr#Q=VS(5Kh99W#8U`f z8=l4X4m6I!EK0{pr#3^aRClWroaW8^hIrIOlC)!yZH%TTp$w!xBqKzQCFkFp+}%N z<2)o&)G#fLiTP{S-ORX4r9M~rC9Xw&QT@Wn_DXd3qc z=~3b7TD$VW!{)Bs9*HR?dz)NCEX4j)roDF9#l*Zkdn!_+plc>+1ucS=Nafi zu;ZIr!klwJH~%_+VA!xmWTsZalsOu^g8%ru(|md53V1y9Src`3ZE5knXG6%E;*bB6? z-B4W1%%b7DsM*5iZQxyu)o*S6m>?}%Xm156K^%DV<^)9ahXd&H;WgmajG)-_<-Coa z2N+r|-{6hc0xj@xoUZab>8K8)YIo-mXc@JU=fKlr+C5!AY{Ao2*) zDuXv0yNbbWkbp+Evr3?Zy<=|C5Rf_0&EUag<(5NbtLOPe|p|=NI)2$%X=H z>S7uX>^C}a`YSthi{9y)Xq%a-Ch%G4p-EX^)GJ{I28a90_brWNuYFikvh0KWvIQzV zPCmcnT$bs}Kvs9I5}14syv(yLt@eF-n0z?s_yF(>8feESxa$pGDkv-?ere-*vqf7h2wyhK z7b)>90NMc6UYvpDwukuJ^HU}?R{c>X!iVzdwcKU;4y-p|6U;&O&zOJWdX%M63Xr*#4@aY%li zZsUAx$sOlo6JB|LfK7$^?Nd-t?6aKvK(zn5<7z!Yj;HyptY0NqvnDFX^$6$pY%QG3 zVDYS^DcmNGeeEt6g(>?*#jYfatZ?nCF!bAFcP?<~`AQrk`V?oZp-`^J>%1>uuH?rTDegm;ynXbCBW9i0?ZVJ77j~$b$?yX&a8g#&bWx@hb`bqS|Z(!DyH5;$* zSX%gF+n3yw^@1Mv+d}SVqlhsxI5ILY2zuOCd%ExXipb>kh2D=pXap2W#J2$JSBQf1E=7>`rM7ny$N{)TKHTu zah%T4@@czP#SevK%>%fyzR#3AoTMIh z)-Ptxg{%(Wq>mMI53XPEXW`2CvMwv$YhK&|S$enq%UzBqE8lCr6il^q@C{vG0h z#l`K;@pHlaZU=wOdvnQ$fzdPVmB8IouWuh{$m98Zu#*U$M)7 zd-w{6g_`H*COqEa&)=}-{=>c6+c;vM*S2cd$uTnMF=<_}urHT;$x-o-gYEC-%J?l# z9~e9$z-N>|CW~zA;@?avle`|$GHDkW{_ z%?)ad(u|3dCM>VJ(ifX{ypxryLxHpMmHS)A(g426F7sOSr{640YGhLKQ1Wl`Ee)7A zHT?mDsb{6r9j($y1ycHl7u>nAO^WrR$(E~)=S2P;)+v`|-Q8~gZc5;ZFRjgu%}l}k z44{TzfD+?!mGkE3LCq&gzsDP+K&w)@Um1cH9BYe$b{3hj)NFi@Se44e;LOOtz}^5` zo7$lNtwfT|Q@Pbbtq;7X!qwZ?F!=^(X8f0%FUcA%zHI&J*b!rJ{F}kTmjq! zoHV(??rX2E`~sdFmosx@1-V78K5jYpX?sZIyod!WD(5_)?E#pX+-Qbk#=uie=VS z*p{N3ij1Lrne*({gso*>6t;FYbVa4?CBBZRtyx!Bg|03WS~P9J)D`VJ6u2%Xx%w+9 zW_2`znw~SXSYN*}vTiuf=?$KRw~S9?|6rNuZJ=_brK7RHKKa(O-X^_!=NdpwjUtZk z#^9=Qsh9bKm^s~@G7CIsOqh4Xt;aW6i-X5OU+}XK=S0Ep8$VxZ4&1O$eYc4)xJJ7< z^Y((ZsRwH1erCuW)QCtwF2TF{?t%3kD&5CA961vd<_S$Z5yH4w<9^vSfi-2!`;{i? zRLxx=t=t9`Eqk)TigiiVT9IiJ88=Rv+WS;FPU%kQVM!AaLmTctjy2$6u^DG-nHgLd z85oSu9T8@j#E^5YZ;fUKh*(hX;AGOdnZeXE@-_oIAt17y*W3{C6~hb~pdI~IWUl>ahJ-0^5Vco0t%v?HEFjzQoKWDQIzBWM-DY0z9D zNORf(dEqwge_#(pBuX|1*6?E(%f$X+U(Lh%pjer=^YTf#{7x@ImJfpo+a(m z7=%s*$$MVt-ezF`wFN}@1~a{Px@0bXz&rAkkcv==b~=M_#a$1pT*fN_(>Ae~%6c~i z&-Vc-3YshCpr5Mg{oz$;bz%ZY7bkauQ{*Y3D+)7y3Vk_gqWWRi#F7mRQEN6$QT1S( zc+04PGbT}G>mdea23JM~h9|2X8aJ`%`cw$YXYXM-%rxV`?g=F#Yzx#=HN7wFW{(Nh z+{yzsR$U_FF@p$WiyB12;B3(BOs@yA9=AA|1Nc)ly(i4!S^U{~&H;Y6OHw=z3w2UE z?WW9_!=ozCAk%eVFW8Kr2#JQ|Q$f=fd}k@vSeZXds6u?wyhMg5P4CF2CoM1P*bEx| zl{2Fp89s?<1WbD&v&wR#1LKkeAs$dz?mFzi@<0w0bc<7S4!`hWGiWSV%#{7hc_95% z(6od_snbDwcP~#lAnJChhLv$f=mLkxrs;wuxz5aL1+5cV7+z}zEYLaFQm8BB@l(S>$EcTYPi}~IoHTFCrD(Ud`CLWOj4yp(;EeYK~)&z)P7)%J$%VKep? zH0W=ORAOKBw={*zb&^5X<3;iidHV z=ElgjiE9NzPEFr^WxL9s>_2P{?>3#e(IoS`qOgnalfe5eQH-8Nu72?oomGRTYoBmb z|H;x*@_w=!mrD8t59XuIZ=4!Sa=nduCR#bFyk4Mgxk7cbDd+cWp{j<)WlfFCP6?km z$p7;se`UtIxyP6p+!z@cu2@HJ`}vxWZ&&j(ogyJYh3z|qeyYz@l>M13VR=_~X63Az zfxMQ{k3HNC6u5(h_%b?5Sdu3(%D7tOnq1||*0sIpbtscX=xFT!$?X<~I|LbAo&+rT z6*6C@VK;@RUlo{d&AwmTQj{9CN3$kXGk~^G)+O1E$uZ=0#moj zTm2i z+_P7x`--^sX&=rQSy4}ME~X1fQY)M&k}DgrVEodnfQKKWWus!s|GJ)`ZCSN>%B`fxtK02(MjbLvMmajw~R&1 z^VV7ghOZzC*T-q*FbPMfXujkGWeiR=4PNdErz8)shKuG>rIu^uQINl4J!ah$ZmW6; zP@uej30i%5nn7)YhY&-}GEmv$rxS3ms89WRcm*w zQ~()h5$HAzELyG&va+IF5|r5z4}je9uuRgE!Eq{Vq2oiz{1!Pcfk6>CIuBgo;(%?K}(Spc30Kil(hXt$Z=r8QXNMn$L*h-=Nw@5*u|j4Af39hmyc0H05yS^ z?sNpzB-0j@FTS!JRBU&vd}UW+096kG&DMIKCouXv@KVm?5@1}hP$!j{!Gn>3fwRgV zw2gg}ka|Kjl5xfd_r^^urW*1*&lJJ=h@WpQ!hB zgGTNNR~%k)IqXBES4*(U-J3vJWs2$w%Z(0|#=e|7lUNvhK{?g2$yLk$a^ zG}Sv3oX&lmU&11vQm6W9y$h&VzA$xaT_h-FSjK>o-5%)oNo^E;G4v35c-nT>WMpGBhj2FSC9cxeV%DzSXH%=&eRj{z>2@KgKf|= z_h2g!dAKDoJ9!hIlcQ0-;MYctIc^W$UMzewV~%rD*p`c~$xH(2EA3JlBzsqg$QsIo zlx&cAI$@?zvozy@73{35{J(ZyJWww7deZTS2NUE#K`txmS!$-nPzWz|CW2cMRu^X= z(iNoCTWH7#E-&A{TMKS31QmBPsDNUiyJ7jP2F^X)o(vyAg_p1kJA)8owQ+sjYf!bf z?*=%qezY+$c!JLVkc$R|=ll#GP|fEGE!(fucmKJeR9fnM<-FD$w*}$?cMmYE?GW0$ zs5dJYl-|F-ym$0 zg&JBwjTe;{Vc>H0REREP1*put*!o)qlFnAEGMIwA&a(8-g(T@-Q(utxxfow81(nBB zg3d3~1X++7!+8K~Qh=0GG@C)A>!e#QLX1^yvmwbjp!w2+ie#T)rf?}w*|n|=pFq0f zT(-X8@JX1s@aGnZ~xcb+?UNvt|3hx}cw3d##U zb3qY#-|!AN4STEKyz2=n%-yp=$^MUUI5@%Io~v>ZB>eGi7BhnvBLlbyoY$`nHqqiN zSEaxNkSXQmlgxM-qd{$<7*FlJwvy)xouw|gfr{pR(Yhc@@6H8VBYV*N=F-U~FSjPO zp1Bn5X7+0RXx z?mOV|pKH<9$%isosu&xSRT%yUCKV_%beve|@O7n~p;RE_(OsasTxYa{OYK+eJ+M+% z7o377b1@mDXnJ38I?~yv$MDA;+%}l2#c{wb@|8@Jl&qlwg9u|atbJf}1T0@#>dzo_ z>XOO9?n?p_t}QZQnRAi>($)kOxfiN;fsUz-da0}I{F}>YaTBNjOI+J@Wt9Rby7q~J z0_XZw+svigdw3GHJtV*ay};ccAv?os~_XO4gILvIA73%r!loBHQ9| zD^o2>TVsx!!u>sh4BduFcseF$@2i80l-qZsXM>t1uXg+QF*A5GGBCVS2l;!#f+tWW9;oS+8&dhiVM{h8n<+#E;MxhAUM0_JhD zB0potBUf;a^82Vh*F-hI8B_m-aONA>2>{%IQ*5*p5ppKc8@b)q`ufCZ~h{si0{y zmWj{g|8%%F;*CUf$h>7NdJdOvO8GF%0_D*~iwoX^BYM?pWyTflo2IDV2$&T%dl}0* zlS$9AR2WbQ&AD?sT3F>7IOer+B4w6$2Bf9oMa5y5J1U z17lEKnUw6fV)0?l83(4iUD7M%JfH*W$`lJ(J8<~~Gj*$M4WG`i#vRn#Q$PG-4%nKg zS3(WaAm8*(+sM1vSn>eK^=T`-8LSrTq$29=f~6BpR%kM4V9pP zi<<&koPEkC`MSGwDU1E3xL~Hvb6i}@1v6Ng8GINS80?r54B1TEDoM%1xqKEI0Z9-+V3CcCGcs2x?L}qFJl2U;1if+JgV3-PBW-|*fr5) z^?ZgLuygw)o+Zu_icsMMwML><88rk{G?vbLDsybzG_zH!t&QUCEtk$zu>z&t1q||x z8zhs-?f3dZv-vGr*@VpQniF=#%em6L%k-IP)mDq0q8$=9vp1jUU%6TjHtj^JmS> zlFQLw)m!q z>w!z!{hOVvn!x4#)+?%@1`cDY8mK^>(ak-xpBq%d@@g1^DB)61?Y*ffCtA2~_Hu*D z^~0PoCz`-2j3GLw?E;y|#NZ1$|HHmeaeJYnZ`In0wp}1!+Hdg$6zf5U!Cuo}=Gp(qBX*tAYlRqu z@fFj-;s5=z2PjQcm!8zwo0_uN`{=}dM<*I|DTCvBvBjn^8IX^b{{W>_n{Z`tu<;$8 zxZxsjY zKXMJ^kpCIr#@!r86{L#kUh5LJEw+%NrN(C;sJ~LGoOyj4Bx`3C98U$+C$5ti6hKvn z*_5Cx->TCdHl@+vw#~lVlcH{eBl-@wPr5+^+I@VUds2P*MgHXzf2n|)=cPVNea|Tx zYTtU%Xu^cu*|`kNjGHy^JAJO7GPvglZ+}}a7X~Itdr#~XawP2s|tg}rYWi`4$4litmtsR*l4zjRq0|o=LuzS zJ4&`SJ)U+#<+uByyEMzu{uRz3&(kY@aYQ_%kvvsJKRLp8n@)Y|XbMP?4P( zrOVi{d5Wrs%8Rgb;9~vCHwGrgsxWVGc?*sLP&Xw}h4FwJsO39vT`A{=O*{`YW?bA6 zI5&&4AuI;m2P!l_rvH3`#2pR>B_T-EE5GX7Z8+_i0kqL(e`Qi;%ZdHUi>9_*=D0Ft zF1yZC8KG=thK|i4^Ir)s7A&>S1YbPCUkDo1{2mKw1jcvDa#&jI2UUh*o>sjAj9||@ z8hloLF&R9PwAH->Tnim^Ijv_L-(+VDYG;RVD_-&pW&*Wh0v0Q`RYKC%8JM187`IHdT#b@06uF7q3Y$E;)LvDZss57+e7g8$-vEsv8X2 zQz2FJJ7eJnvDM%)mn3$NMo@e&S$T#{eW8460v6UXtWwZcQ{_vhWsLEcc%yeND zXlVC6=d*ww;U6ZG7!=m?u$~gS{AFI3TkGsp4`zk{(EP8g+BL6yNy%w_9{tLYBFDf= z>8!HnGi7kYzpljP%S2G=aowo{RM>gTf~&YYwv$pE)IpVja-QepIAIk@MwNA~0-)09 z@Xc9sYd-se3NiOPpzK()QW;Y2%DS{(sZ_BnRQXw{0#$*6zOQ_0K(HJc)v zkb2Exp0lQ@gUbbp*d6|$HdN1&;zXu~UQjnWpla#1Os@xA%nX5y3=GQPM%uIot|8rg zZWp879$o�)T9==&FV&RgKQUNk$iNo}t|VRdB_Xgo#FX96Q=^!JLYe}RalWwdtS zd`M7LWkTu#uL;7SR-7jDi42#eFFGDBSk!z}qy5YjP*LD!3-J@%zReNSLm1c?pBGjb zz`A6ObCA1aR|6+*5w?V6@0&ZWuDH?z9$mW>@&vUqC|AsMgtYP=xE=_;+6C%vyksw8 z0{2Yxy_^qlf@d_Q%QJ!dBt8OX&&O$9 z1{&3lcMFQGGX&Q!EK9F!&h!Ee+`SWF1{HS|{s!$LAYV<%>|zABxVc|TsoOFOfl4Mw zbS^mRc52hr6(VbwZ|^zMu6YeK)^$5r=irs>OW8+fE{gy)5SbZ*7#SF59KFKLehDO8 zygXuZoc6lY`qLO?T={cZcwgLL290%APub)F$v&W5u!#jy^MLx@Zw_PGEyOPxisp#!0Cl|jx|T@Jr~=nr$*RxJf#=K4hG{Z@yPqBx z*3JQUTV91MWjNp#nWZers3GvhOD8CPjSlmS16Knle%UPwsXS-(M)!K1ov{ow8SpM# z6EeuvDQBsX4jO98TE^S~~`9}bhMc%FpVpsrb_`m49w8}u<=0uYjsK_>$ z#E<}*T=)X1#6Y8Cc}I6-f|`Ci>OL#fTwZd$>wUQ9g(c!@c3p)aUixa06AXPybIhzd z|M*t-%-*?+c`ZjEsEWRMV^L9>m(TMl(u@u+e2|g74la#rkdxa|z|(iDS__#${V4cg zY^ic4+c92Hqrs8atNC&7#9|N7?1eNBgBh+4u1SV60|O%qxEbN%{_q~STnh=m&J3-} zz`a~hs{k~_3z~_%wq$$Hkx@g;M@vg>nHho^85lqu^@;mWGW1z=7Uh}PWzuMlgIR&7~&u0E)a3960bIp@W zdY8(@Ig`aRmu^=-ye{_1KXC14?D!uv^eW5d25Jl%9M{{l4O|)eTmYGJM^GJH9?6tV z+yJ)m9`9dJZY`IP02|XE>yielBg>sZrWCr*@n9Fbz@`X0gVXea z*0mY=oInssCozDhy+I`p ze<72&f+qV^7I1z(5uU{E#CPsJXg1h&Qr!v_24T=3Yk1PcUrDJmH5*qiR?>790JX|W z`5b%uB=}ybgAe0XXP$9jd$b7S(iI-RsyZ2-fF=vC$8ub*80X6r|If7-K?bkg~2g~lZ1kI@YXj1+p(62PdY?j-Mnn>q&(-XiI z%gL*938(wjai+fquU2?Ou|I^Qz>Px1pvc`lAw>NUxFfj$k{CeceP7oSVGdz%D`>?{ zaGL_0zN{2{7=%D=^oz>upgFv73D32v5|C7A8~a))0o1-1^R$X;0?(Uunu#%{AXP4Z z&$U4&8mbm;fh@Q^3$EN4A#)8XFT(ObBfOuz4J@Z5fU@|7bu5!tvVf|SXm0~hpwx3N z^IR{wzWD>V#3`Gez^6JxZEskN`k^JD(WAv+wf+h|Mh%NOmiHRP2wGlk{4%u<+-BU{ zpuUm0Mcp|G(nbZ(C+4YdWM0C#cg7j8_ikNnM6^Ygf%Dx~K9+-U%~#mEA#d#b)OEQ`!C22aJP3o1eefK{yaoU&#HHC{?Qt(d?gz>scBBy`pm zyiVnX>q;($3(G+j@;X&nP(pH!cqKGn;hpw!L;S*5ddL5;x-bJY)eDvY3kM8{3+chW%}@bV+B;KXfg*mLHn z0VtjBHtYe9yjdCcq#QE1wB&o&k+%jtpq3st4`>$q2h(9t3Hxx%MaIJ(-x*adGrDMV zE*E^kYLm(0vyiWIE2NwKwew=fuDK>m$9fazfxCUNG7b#46yzDrKqK5Npq}YT&@6pW ztQ&ZG7uH=}4w@Q!Cg%VyEEV9LMn-VpU&)ZXZD4g7RH6T8hK!PJU>B$@nDj8~WVjvJ zBkjy5`kBGuW7hz3^sXN82-lV}?{{UOF}lLaA02xUQY=V03(>mm6lYIQo*;7aPqpyQ}NIEpTx(n{`)l_qPggTr^!0xMkGP z*_3l7vpuCk&LCx_E`uVYhQO5tTcn+&`3n~*NMC*WXo+8n4|srgmXNhT(=nBkr!3n+ z=InO{=iLPhOzxB^u=ILPntGB!jce1z`gWOP?BHpb-GQ$H%OwxEIGS0#nQ-{Wf;R8~ z@J6+-8gr*;oNzm9y{4*%AKZcnUw@06S(x>v#%I|u+hgqDsziM0##_bH7=1)i7R!}K zFoNg34IDFtr<6=S&y%o7LHg~U!�mdBBr}@P%Gnn=W3lUb8Ik3=6mtiJM}kxclEx z6IHHF7mM0M#q(IfD@E=lZF((c5ICVX?|!0bX|fu4q9SAC##cezA_5@sLq8)*ABHis zg6a+1(v_}Wy38{)PPje)!M56rL7MTld0G>AJ=M`;OfkWl3Lxi{vbclwfYy#UzLzWT z1T^gA%c;C!Ho@M(Z8b`e%&-|1g#-C$g=cng2891T$-QxFtGI=7-_x~ z!1%=27nCYm_c6}^wcR0$*E*YWzVz&4&fo#n^K45km9|a<>&$%M&(JFh(psF<_(=^M zPPq(1j8&CPJ3zI&Pe9a0hstyYVb+@&vM$d#7Z`$S_gQ_a2Uq%oQ(uVs2lWQfq>O=M z=04A+;Q3(3UuF8oQlJ8|Yo4L#PMNn39EaX2f?|xho{3|*p?73c@)X#4u{M8dQ{l9k$LbapE?#N1kHO;#sFzo*-YS1L z^^N7NMuCjeKAn*l-Ts!;Fvi}UWa0hwrDB@NqU)0ndD*ePPCwG1FcCaB%+yc_?JiWr zG%nuVW9x1$&{R+@@w@X_ubx>N6U5x2pa^qN(%5`v$_&xmEqsgSbK)pYG*s0TZgDWQ z>0DjjKI7tna4Biuz)+_sV>!^l&-*Gmj<4%CYA1WJKjf=cPI4dR?`^Gpn<@q9KKKPI*3PY8f=-175Gz z+b8ktp`zSwyIUtN|DOEwjy%M1V$%-U`n~W;^E%UI#`NOVH24_pJdv6Aoh^9)v{<6-`9H`A6ZhnEy{mg;Nx>vE4x!6ijhg#H4h?yaZk%0lSm=5N+s9PG$Dl@qSCmnPZ67aO>b=argDt*{y zrlz4IgB;_5jKy*SiWjcxc5V)tFPG$|TxF}d=1K5|IyW8;A;@qBC{}(Q$#}5Z7BYGZ zo^BFuLtXp*rJf;X)Oq?(gGR{Ba4Ws${7e~M|bSwvN@65UnZc+9= z(0%Ti4{A$hvgCuR>Q(c$f(Gr>!Mq=@*K7sV^CC^#?^o|LeYy3~%BpL#m>HrO85q7C zIwEUW2kKFF&)eEw@g^&CaT&+GzC|V5gqLn+`6ceBJmJ0PLxG;A(rMsIzD&8Id0n38 zoTb0M2pCIUeC?U2I=|_wagxJ?iVoq+mQUS;r>QvC!E8D(8L&!NpZfRZ**p*)jEvjJbP~p0A zi3Qg4G?{P%bo+FBBd5-!E8>BBz^k;r%mW=S5Di_22_B+*|L5SbpsnDc_Bw^G={#S+ z-Z9#D?IS2Y_H{g3>Z$KjQ(gm_{}EbLk-2nxJ%bWsiiOp_%}4jC?G3vl9=ONkWozgD z()h`7+UF`O_t+dsw!gUJ;@^*qDp{bc%I%#P^VSklCf6Qk$L_t40_th5(u@ZtEd9mI z5W~p85Heqa*Jgqk=wuVQM;l)+?oFF$7|EV!*yy4QYSvZ;Nw~fWoW-e{<|;k+v9}tI z%+Fs4Dq0zMA|Wf;;o>IGPXhgaT^_q_onXia zDfw&sx!kPIMxYi(?8Jmd;_}FZvDp_+ZDMPt+xo8T(D74 zJe0}u$ySr6%o(&Q0le-Typ+x=X-0c{#hYIli_5BQjOM2)JX8VAk4-+5z>%A>?8uso z#doW17OajIN?&Pbd!)zhOI1+B$>j-udn5!@^%JHx9QbgGN6L8Eq$3Ik{kZN){w!#3bGOpw9g9=$v2k_Q4y7WCelo3`(b z#DsDc&OnO7Ug{y*x6d}`EpvKv4264t6g@NBZr-B9+54Ht?7N&`$EG`w;yUBkQ3ut6f z;r_;pB1{aij0_B+s&fo|LG45Nm2W0%HG-DMRg}u8moR}E(ef+b^o3@DhtgqN4i+g$ zw>E}cyW%7a8IlnznFnquGJ2=S@y!0U*@PXe)Iq>IY}&C zdD8XyL~uFc=OyI3;kSu!`bxX6E7MIDy<4tl8VIfMPCCztfTU5R)CpNOv|el$QmOdh zvImzlw=ZNp7$}Ot9o|`IBEi+jgR85*9Rk;ia~u;G!6T+|Q;uZ`Fz7Nqx17C<#jbY= z+ZJK&1JP}u#X!LqHP+4$0?m_wdkCOGc1O@~V8**SOYhG~J+uNmh;H>D2*u;s#)CD*&2XD?joxn6Ys6qQ+^(%B&S+$WoK(AY>~ z23W%XnGR?)_C;FA?u3wR(BOdN-mICDS3%PZ5>Xjhm$Hvew)CDHr~Phq>oQ1jcDW}j zQSz$XtVt|KltHui&sTc;T6h*@o%H}U!Ga~PCVbCSI~P>@D)@Yc%U%E2tVPgzc~ZN@ zMl+@cMaa6EiUq;bXBA9RNSh^8!ORfH$iN^zX`bX&aFE{H=*m^<@nAkPizj$c-sf_4 z6XOB@a8Mg|pN}+y3S;z_X%l~}&;s?x4_oe2;GF`lKqK6?fNwmA|b7t8@01Q4ToP>jHLp<2Tz}+@l#~Yd_m@>ClGygAbkkmNgd8< z0`)2nHA*q>_BSq^_9}ROm7DUbx>rHMuqx*Xc*a-)Qhzq)*Srdve9VCV@{|Kgp05=q z%s6vZ0F)0sN^J6M!NU-rw|Z?_V4cXRPj?;>cMe z<;km2a_Neb@Rw-|9U_~)hnRS2gI7FUuJH)w_63i8fEJ)R$qM~=f7z1>G)9@)nOWs; z!0_WG7r2Rc61-~b?K9`7)ru1stS5nrHow@cL!M2+vD;VZ7=y}W#y56nK~2WmSCYLe zey{ZQodWH38~K8!A;F^^2d%exNG}1E?XR+wEkm3YAlZ?HAs#gTZ(F+3Gdbed4pVUX zyW(6H2QDKg6?-68jUQKf`$~Zexb@PW44^`2!i$PKR?HS$X(oAB&Q4(fk58GVE}z!Y z{n>dAX#VfkGlugFZ7i_a5f}HG9(DeY8o4YC0)EO9^4EYb;rk}g51JLddJ<}aZeHg! zM&(AcnVP8kOB#}5KUvsFoN;CY4|u;Y3uamXT1)VSDeGqHv*yOmmvf4cSAc42$n*3a z2sBt+xVU(Z7Xx@`G0s6ZS^AiP0c52IVj}_T)8>PgJfKxDp!FAt9CcA=rUlC4AwJWuDi<1_WGqQh7cJgY zwM1R?GTW5Kx(=1>4i&@f4iyn$6M4p#=@o7&Gx--X9y#(y(6cQmh}rmqyUNUGObiK( z3=9rJmjy$(RxM0A!LwOVT*hOW!lXGax1KCb3VMFVZO$VHBi4yeR4%D8*Sk#8be~+c zVuq}jS&}&WqzxS^vW7i-LVW66aLn1-BT@i`+S<59J8##wh4A2mJ|UoAI|G-ba6 zg_ryb*D6j@3F$dtV7S|I0?&b5UV|eC9JGCI+&q+Y&9Oj*jqT7mF*d`u0-i~?6ek@y znj?4SfQZYa#R9I6lD;t*8?a7%()Y0Eh>xR6=gcM#A!GT8DNaW}h^IX;ahb?EQDtFL z2A8n0_#zK|(apTV!Rjs(jROwlfBXyc*Rh5Bfcfo@N*sa0gF!7Gh?$?B_deBYngBXwJbL zm;co%yc3t$w@eE#G&yu+%Wn6q6*D+z^v)>iU!yqbOZx>4G3kqP4(`*cm*};ts5N#r zimgsMbRg%*+v*fOB~M+KNi#G%R18ZkRSFHy8ZajcdLGKG@Qm>>KI0JKGU<%M|jpTfV8Ji7R=Ysdbq&V{V5Ev$3G3!n1x4r;Q!mH#yQ4 z*q&G-%gm6-$iQ$yMK8_j%mMj{OY~1XS(?NmqP8%}a6^O7p(dZCGQ~+eXIxYo%^27i zr$x?aoY|qWHH~@o!lXlqNol($s)X>^CnPP~J@LpJ7nPOmT{jo1EDJWD#Mrz`X3~t< z4i&@Q0-kJXN|V00t1OH-vWD4m!i?V#r~Fc$#3SL8ki?TzrUbE~k>%Kf8C{+W4WuVJ zn@=)zneQ}o^U&JC`D)C?*mJwcfIs*Oe&gZcXP#zJW-Wrj}9z3x@yKp z-=uv`S}#41vaC@soX_WDmc(?qCG$|u5te0~ms>#Y-`kYq@}GG!*wayGR9z-XG|z~f zF@t3p#K0`s895<7+qr~T<=MB!lWr;ozBAO$Kqw!5(aRH?j->2J zOIe(>D|Et)#S`44)^thUS9vDmK6ze<&jBu>Vy;go+)NUg8Il+o7=&hUo^dlt6q>;a z)q1DhW>cWyT`i9@H7AsH!;bdk3ti^>2tL-|EFi?iP3XfCjSuzy)qkf9Rm&5jM(S>TNB zwy|U8#$~tE&M+9HCB7>1U`tC>Ghp6qP@b4{NNE!8GCwB3Fz1KZlcb`c1YfOX@sih; zB$Z9oZi?}-D8KPteDlt4{4)a#|LkZ}3E_F4s-kA>GP$Me;ohDjb9BQ!^+hj-N_J*C zSUXj%oU!hd$C>xO9%>{JgOz?sHu8-DkXi)+^SoS2V0$ugH1vm^R}A zfm^`>QA`(~95Gc<%xk+}HM{{Q}hKsysqnuHB*+ z=ZCC2AtRx3oK4-u_K4daw%unJM{J1@{OkI(t0ZxPjPx9VuL9B^rQVq7>$Q10IBo3c z{I_Vv^K1{>5Fe`sl{6_qm1XZupDa!Kv4cSmmaEw~h zB^Yid6dZ1QvZYIrU!l{omm|pe=mc|Jk2AF{6U0_09husDf=OuBNazmEy%5`gr>uhPGj zF8joRg*{*PwtWdQjGa1hMy%@uXmP;8kjluwkSCa;@N2S}lG?Ay8e)bQ=Zgsc^<-f5 zoTTD8N#!I@7wgeSszq&$vRw)c4;>gQJLe=Ov@3Bqu+7`!a?W6bvtWvwAj_dfrcXka zhY#?%PLOmJIB{UIm^M@k|6BJ3VS+4&G@7Z#SUi9!u<2l4u)Yj;0u4Wp-Gr8CEOb_$KZM6&rySfy>W#{n_9?r50 z-bZtC7EYS6_=cmt=;n>BUS^N(WKQ^O$YK8Hpj(WIT6#7IlcA&gV__O!Da4tRSxZ zp_OIl4C4g%cM;;s9yUe`lO}!inB0}v<*v74Mw(n_96Is;F!w7q)C@%$aHpj zRwYl;7d19l6V__Gh$8Sa$k005Cuvdq;zsU?jHu2?YjJuAyrL>)vQ?kx31NpcoX=9*a=A22rU7nAp_;j!}X;dG0`o1T%{}{`H z$tQNXiU|ud8#-*fv0{da-$}QlOA5WzT&#D*G@sTixVhMn@rBB!JV?;yu(U9*%~^gT z=~tJ|vz8NVM%`~#oPdN^R>zCoK2N)z*la$|X1?h5o*6SFZgA|l9JDPs#c-yJ*#yrN z7zuHa;RMf=QmvdAp7*^c-PUNnS$S+pIN+GH^ZGb|_AWnIWB#f#GJ%#G_9XjJl3Gs7);WUZ(sY+WVSwib!{(oYLznw|gPl zkA4w|JQFf8_ejXZvx=KCCmuce;ogiRXWr!cfQ+umK3UbFv#k9@QWD#u_eQ;sjvhI3 z;K0gbDN!kgmz8!q9@V)wgGZ)n_DpLXH8r-Vl`}-{6kYN@x}>6;$K>>zoSD6i5*?k5 z-~{i@QNiV8oh|ll(V1gM0(7c`0;Vf-b2274F)(O|*>YyYrzt8jFfcSEU7XyoAyv$b z=|IbtMutNSEDQ@GzNjn^y>Q5lfq}t+hrwZT*Fy%`X&07Ezjw;u5U;A6ipk5_QxjXH zy?Q({F3sO-)KlR6Rp@gNC>wE#ZZ^zrJ$iHl`wfYXOoy8}KIgh8HwsTpN+S0kWNzpGh(xNKWI`(E`s@aAOn;StBZ^)&_mei}@(&5Lyq)QTq z_U)hX@7;#?`fYEttp(Oe-I~+5!BEn6I~YG)wU8BACxqS5qGsDz;4I5xvU0{p{SBHS zJh?lQ)I~2do{$SRJj1{{K{?Ry?YgNVO24YL!c(lGr5|_MFf(L;&VSxwYRJBq&0g9Q z($MNP`Xqd!Z1#4+0)|bSZ(4z}^sYixX7_zI8}ed2&+scq7n?_$Khj&ra)@D*;l=yH z4*NoSIKnS^yX^OS+I8jBHR;qR^Vc4KRyx~U;ICEhqpcC5!YT|G7+xt9E}7o(Z&8u! zyv<+TBrPYx)VMCLfcOEG{7}7p1`CI-u_&{ThFXXZQ;V6tsB`qXAODi9OmFyTEsI@{ z>m+>my_Z?q+DWoM9(yed*<@(171`x#>+&T#WSs}wJvne>ZS^V>$-kDs`^V*RcHF*H zmR)DNe@31R(qa1*wkdmR&YAs_WM>4ObUM@TW%kTn)qCTD2%at3IoG9bHwsUE6QwHs zd3{Q9UC1VpZn4!#eviG_ewl7-KW4V{tP@Bq!YEKYvz%uJa_JH zx*QELsbl92h?9i>QO7z}dsFslx!KKepVN4+9SD87 zd1A@po;9JH7FWzowVoxQ8)nk!bi}9Qh|H9H$;Q0TNnlq*D*X}-S$86lD2-Qg z-zsh~(7HKe{#2c#Nel8-cZZ!k_DB2Xj2GbnFcZvfFc>U~cU*j+@x}EF5sA->CoKiF z?~0|ujRg2I4y1iKbL`IwPza@GXGp_jjXSj^Uo@`%TiXi>wWPF1S&-nJ-ZisNTXIJK z>fHX-pcrA|aanRgKAc-xaH10Tx-t>|vLHhh1}mqHH#(TtiKRWrVpLe@>924nAc;lA zk3N%qWSv(eZmO3#hmd>F#}T-&3ztsN?5c$Jy`g4sTi)rn&(VTcDk9yzT@S5;JhN8J_%?Tmr-S>4RR8cBGeyN1-i6<2 zVc5~IFyf2Q#r1(ZmDIJ~Y&N4-GnZDwp_{D*HK%8F77h6n2e0EuRo=Le6YIrd) zFr4u|dSROOtdKM7ijIC4cP`$!$n$7VePeCC;asVlIIXrP7TH0DjmK}cbUplE`0ek} zC5A1kCWf}Z%@!sJX?ghku9apM)=HZ%s*-kUpX?0&g?HC0d<`)CvqnMs;@15A`qkz4 zk2&y)US6SKn5)DXb#uFE$eB$|M^ygg>Wdx@VeOpxG(TReZ912b@!9*=0t_!}d-$aN zGh3L{A*%8$hc{JNt1ZIOY*FKat))BX@h)F!7O&;zpmpMar%Ss3``e8#Yj5w(&t5U( zrKn1pUcL2)C6CwCv%d5^s=*|5xo`hl5Mz^I@Q>U6zs(MBeS2Ve?d*rQzAa5k`Z8(8 z-9NcJJVzPSJAWR$zc0k6CvKBqr<-;0eLIU|d?4YSt1liqb7#Bhku$ZwS!C1Q4-}Tw z-+#t4-3okm_r54yRgLC4H=3Qr{Eq3Ma{+{deeP8cO4lD1CFFajX7_u1|7~-dC z3$?jb=fp`%G44GW*=+hjxOaV}`6-X@``()6KX|e4?Y-@WcYkl2-evjC)8`!bt$86n z@9jEw23$Yp5`WBP|JNl+Ro^|&sF&u(oLN*WBtH33?IuCl$=jA+-Fo-8nO@pOJI@s} z`o5oZ`x1WrT=?~}_qV5aJzQP8NpShMx3hL_tA={#3)nk4uWltbo1gMnUVA$?&d2>i zWS6VHU~S~Oj&tCYwdC@?w`Tgws_*kX@!&4o-=q@4v$5$&$)ziNE=x|Fcgu6_yj4fv?|ulol92Ao|q`Mrk+)@i_uSL^D;0u zCy#aI!XznC6*YF>w+?+<5~gc;fWm5LykpWL{oB(nFid-~T}mr0(lJTx7c>>Uyp~_R zQet1bVCTt(GvAgbRjgDnbpLw0*CKn`TT8p`<+qx8f9}&cnuKtb!smUg3|*{8lav?i z-Nlmh>-Bcql{5D3dZM~ueO_nffuVt0tBv>mGtZ+c z?H6W+oblw)J#qBOk^{3seD)iy@jUuQE8GX%%h(}t&-AvMsIl+nx$2_DPMdQ#YN_?? zQc2U&`?fS`)>T!*+QN-{LwX9Xs!C5})+^(S$x)Aab3kUt4ac;N92acv4J1Q4!$h1iBW{01~Hrs-Ye-*b( zf6>_emVe>gt>M*u_rGcAl`T%2I&f9X)zYApPytv|~sA zo$K109I>UiaHD(SMoz}p3M$d>k4pyVuw||E?t7HPzVFd(kRz-LH>wLR?QQJ6(b}D> z%&>wXD&t_;qoia%C9l~6+Z{6e9W!1ls8n-_TNiMOS96M6e-OPdcl4;*k?@-8YjJNa z>u#Uf5djL+h#VK)zbfp1SZUpj3M`J2*K7sM~Bylm!?D^I1iwRJ`M7~3}42ZbiRDwR<}~((kxG(YV$7#JY5p`HEw`xu!_pv7vjTyR%O{V>0e8eT1+O- z*pT;PdY9lOAG1df+VbvR`__ITPD@SUtcqLh?m)xz14@Q#6>d%M;`A`?*&j)_&N&?9E6LBk?VJH>a7k+1m{GdrR&SRjvsmX% z&PB2ff0i~Jz2kN;NQW(fjms=eb}bkmo2YYi(ey6Cn6oNr<{jJGx*j@TQZTf41XZ&F z#*7-1*=}~E3*=fXXr0TsNhBt!Ix}G|Ghwc>1+rXavTMs0Cw*HyGv|m;OU~%lyh7^j1B0UJ0kZiu-k$2yyn^|m-GLY*{& z3S&p~x(N5xXIq-yb~oMaXnWdKy5*Ls$Q$o1&IkQm58Ay}pB}K`b;ed^TM35Q3+MBE zNnm)>UT1WnnQ?>Uuage^YzOjQtAiweLnXJ>2^E(_dvEM0RPo*@(IseeHbvp^o^7_9 zWnpYH;mxvLH|M7rO-PK3?!L))^o_r<=Ivbi? z^kFkPlRaDZriA+@kUcO*Y^xKxylZXmNrUyhnRl-R=_DDQ$<`E;W}F_dfn6lW2@(VI z91ea%gn~3PLp~z|1LI6gCHq2pCZq`kuU3Wy&NJ^P4Nbi4TQ+PB*l_;W$xM+P>8lLA z3lipko!nekB+nYH&Sj=3HBI~4#Vr2?3BMO5uopQTT(|ftDDaP3MZM(|$x#z|eS z-~W;V=)hMb>|-}FA3v)a+@5zCE|aNg%TP3I)<%CZR7VLQYyJ1_k3 zPS2xn;(0d-Za=tecEaWKO>M8_zCD@|zoVY|iQqnP5X{>1ik2N_-aYJ+S00|H8dTSk-dtIdo+@%A_WL z(^Jd!`J$d1a^}c3m1VMEPN0rjh);X&Nw+J9mi%q;ob9-%Y;lrR>KBz|@@n7?VttVG z7ls{i6D4PCkq%^5m!Ew-J8pZWNOw)=3xBQfCwZdo_cWB5844L07|IPZvmZQ3Zr=M$ z)h!65hEwpb=hLp5hZaT3Sr48hf37}{;it=_JgH>Mp~6I%Gh;fs3jBi<)RR@ruWN*9YvE`#X(1=95dk_HV$jLNGOo$ngw=G9K2kl@n4xcw$*Ay*Y4Wrr$Bi93 z4=h<4vFC`1+FMpNU4|nu373L&G{nH6enD+9q+RsmU(&K&U9k0vpc72TQ{ zqQjP8x14oBM1W3G0z+SuN7ApNC{X+Fy}nwnBBZ!4y-u5*bmrh$c_h>?N8zGwJmQg6fjIc70m%ak9eFXs*4 zYa6a1X1I2@&e27>3^y1WLV6S$Jd#qjF^elq+ML#@65`{aFlol_&2J8{c07^Uf1;&J zP({G=%*DuUZC!#a0-k3q?Ov`|IKTc-1bkh@Z!OG>A*VB{kYmw$!FS8_U5?|V{sSZ8%=V_>(9vwoIFIQJQw ztOn}^>Z08(4U;=IKzk+)=T=0RtejDo8Zo)+X6U*Xo=fK&i+nNe7A%cfC($AKqNmI9 z{8crUKM%4PKP^oY-V9N=H~P598XBth}RodS|S4qkodbR$UTQIdtA60`k|TR%CXyN)`#V|)ypQWofkS3BG|c9cc&C&Mfy7q(wTThDVuce%#& zFmOz4ye4$%uIiHffQ=p9f((jA9~2gNrt2xz_Jg9#z$xW{%z4jx$q9YkoNi#l>(iBG z#g!Q#rtWGf@rhseO-{6X$BcxQ69<+GT`HY6LGH!rtKXhxvHvRC8XJ@AdG3!m-x#sKMMRa{~-lzDr0>U`PP9#vhs} zaxyYlTijZh0o@@Gy4BxG9{F8md@a26%@&ZrLq>0x8(=+cA8j}ne3@$V?8i4aHgve0d49blV z4l*gQH077Xwsq}YH#aC7Z76HVEpL#`C2acX_$b@^YP?@Gzh5af~S6zAbpWS=z4X z-GX=T-g=j(d*o%QI?L&RA07!uIRl!ousaQtV}S!E|!j-GzpF zY4WlY8)I1+Nk@2bV5~Gj|{y<)e$#1t%&6tUIwhiBIj>UbgDqCCQ)jrcCThXgZen zIqBKGg%gu5PVVp!)CgZvYsfDAIj(uH+og@55k_|d$K>sm%z~Os4AO$YuN>t(`G_eHwnm=a`N!tbL7 z-32vj%+@o{#-6?y7#KK;3@tS`D2NNkg+xr~mTZ{KUu3ArX(5}jy!q08KCk)JF}jbE zF6}Ur{IRn6lDw5hFJqUh&+B7XMY?Ac%ma~guJ5s0HjU3KIqT&D6SXybUddvzQ-XAo z>~dpdnGFpLT-le_mIg>&4rgB~&G@z?;Ma9W&6fWN5E{sEhv6THUoQp9!7%@ebXNu$ zo>bhTCR!}y#0_@k+z_Ao$FC}b40A2+8WtDsPG0t?jDL-+r=QY6TV{qbkZ$#f5Bg?y z-L^Fl-(Ibk_x(WTop+Nx3e;T=7ajFf+2Q}V?ER6qexR=KWRHUR$KKxSyggTd_q3?` z#0Pf0xAzKfuT~JwE1$dLF7wQS-TDv9f_2!89+u6wGJkn|e+18&qi^jxPs}KJV3POU zQ)Nf8pVGm(&>^+r2W9tXXyEqH9FCnH!mcJc=y zhQH^0cg>l-<=Re9Q2BQ)cCrD(>7AbDObl$`qKyqSn0M5zWwP+HY@q~Y1!v&|Ix7RH)uy*X!mQ@C=g}?B!e&V?Z(MtI;~Qw%FLQg}+x^Mhxfehw z4cxi?2%hO+-6^q5my5f|u!c!t!;DDVFikP$@-$JlJBgx6a$KvK#Z5Uo(rm+SzussC=NP}-C}q6%_$yGeHGOSMqhHk;Im?3$ zcbOT=85tNBCoQ|C0$Nt*dE6~%rxLquSbVc-!KYrMNiR0u%DvaprReYLq%ZgvB7K*m zVLw~;gC}{P8z`%GCyv{vivpyrZ>BRt<(*_SizWttO z$O-KLnS$C2H)LNY{hFFszNY&jgY37zM?XYyUuzdSy5uAKHA&IQ4Ga}AXY2$R{4v@-I3JKb*Of$UJlBVXGt_8@8+!5_MNpjy!45 z(Bn&4#q&B^(rm&?qc!=dHyo-NWM3YUy{5*X&S+p1+E)6A4`dO@Wy*eDQv+5Ty^-Fh z8lq#S6r38tHcMKJ@xzS1lbp<-1sTqVNQzxHv{YP{T;$|)?(_zm2`i0qip*{}EIVZ& zaUw*L4dkK(kpKP#9jICv|6%={PbfW!nlrUx^% z4zn4BwtaPHs8I+`l>jMgW}MN_@Z-R{Qybczb~P?FT9ddl=>bzSn71oSwZ)a8W`RD_ z196Q=xgW|5b&ZprHVShz+;=}&xI2!UPecJWEjBB z_@S6#nmN-vL5BSfCqKD07;LPOS3M0%MfW*&bWeI(%rH$DvSRkFOvBU6DLU#$bU~|b zZ&@;&zN``H*AcC-Wx2wZVuoqU12^pvED%>c{hR?!(LI<+=1jMqykW>%kn&Te;c0Kf zZjDGg_5{mkG7V3e7%CYV7>+GT+O@({Vn*krrv(-l8v9Oi%1#yrFLz`;sdLVPJ>}FnqrC&Kz~o$udsaL5Avz zTgg#?F}mhL)90GlGj>>WC^o_{3sZx^u!8InmGBlf|^bYosq1zw9;Il(93C88)n9 z8scM6By>4X&v(U)zKN3={ipfO^iEbQ&ODQ%w-mHg?cfPdABo~jr#nmwZCMxkKD)Fb zDlZ7OC_2|@dfQd7H$9;7dNM{T?6hx}tIrqpqcU6W^jK!>oT)Fmnezna(In+pMUlt) z5>D)hK7F>O>*Pt{BX`nM_P8JYb4o?8ZT*DFjX!&O-bzZo4>a6wbhE>!r)TocE%T?% zE;MAhqR2dXrwO~;u}Ceq15Y`Vei^bbRDs6-?k!HLOLf|qp&Z3vYuG&TqnYw!$J1vG zw%qCAbUuByI^@iHpQLxIqBub94G6vr>CD0cpD>-#{S{Ql!4-lQCU_qGqJ0>$rsLD! zqg$-6*VP-QtiClj#AiuXb4-s#XSI)Yokw@5;h!h%JZBCbfA=W4f8~q~e?TjlYg~T zGI4q7&6E3kZyr6qEkbni<941mkCOYtl9S6mZZx$1d1FRwP0krVJF{m(^1A~KyFWX# zm3`d!dckJti_QIWPamK6DEV>Hq|eT5&%%?-KW${T{c&S%&6@*O9n0R{Qj>gf@c6qY z$-=X~upHto6<}asm~df9J%bP<3uy6~gVW@B4m%be;keN;|7ygHz}~wZ@>e5v#P&kE za10HVD^-kQGjQLU>LVUR#pH)V~?L$`iEi^FL^``tPX?;BlWf9wBG=YEsRU zxPoUZ>)xncX0|ZNY)+El-x;@Bx^5P9MXI`_)4E$La=9p8N3 z3YW~0WjuaUD)_b_&l^v}TM`}J4-cD)1$VFPU3nC&EIG??t4MboWO>BSx?e6?HPe?26u%_7M_g2;hlULemy3GzSbmV2+ye#6(=Tft0=dT<)laiJE%y_E^ zch}JaB?s*sPJu);#iR@Sg5T&ZE0c9Oyf4H@>vhDL8A=SFW(KbjG*<#wT5#!RXqhEAyfU2${ryNk7Fh`)dT?PfeZm+7eLf4YG<-O?30>n2&#tmSk@tfb>ne}sO!TT5;^`42W zy~QbdnfI8lPyefsLuwFrT^W(ta0-*q6VZGirBV`oH_q`qHKLMj<}G#JApDAz_q!=SWN7 z+^mI3EbNb;84Ld9(h7g#Ub^bI+okM#YYs~7(5f|?ls9FfPwY$U(`6=#QEM`UT03S6 zbXu;sy~pY3oWna_dV-f#-7(BDtp}&xnY%8jv!(N1JK%4!544)GK>V>9$SqN^FO5r= z-iO$EWu@O|!;9+!eZFXCEU<04w#Kh?L0I^&t?RxRX2-rv588Nxvz=6fDh zTBfVd`0Tod+Aq-%=c99)3XLy3vCd!qDujKRVV+Ux()j^~cN6X$vEf)y2@<)s>(X(T z{ceUA*Dt6J;n6+j+YQ+hqq*<%Jq_iVyDnWnaPqiY5NP!m@13JNPF|U6_pC25x>O+; z;(+w*7OkU?AYqZx`+m=Hws_=~hAGSpwV?YyyzWPCTg-Ve$#t@Z%b6CBGmdwk@us}; z+J9}T-LstDfTa;%R2IcAE^>YMi1E=z%NK5vAd3twvNy2RE&6D>{`MXzt+dWU;mZ!3 z4HA=AYX7~EeXDnNi<%f{Mmw!^6|?=WOXoL>HLx;!^vGo9sU*_ji1GoY*f0m zzw_Uc89uQulNZG=p7A350>cx1)*OaU)0xDKW9MoeRZ=T1T_w^zgZ;Rt+>B#8B42yi zf7q;Dd)*8+H*^5J+%1UFMZvBBhn4tTu_g%xGeay6{QE;+Y{ul`Qq#cFak6AS8TpuE2Ujy|#m%YU5m}q(OK#1C; z-^LSp1el?NaT6{aS@I)lL*>dDWsL`aacH&eSs+;^9M&le}PdS7U>xzUbsfu_+HsvbGrqZuVU<x5O^i$u)|q1wK-?E`7$hGSQ2sM z=m%NO6o-GCC*RaPs-*btT;A_^ZZ<=a?i~{QlpA?u=H87vlLwl@Y}j_;TjM&`<{3L? zd~`hN;J#tw^mVM=oFJ1W<)`qRnR_>GmsrjNGxeR_v)&%a^%FXmCM^ub;>LCwk}FJi zul@d*M}aK~gcc^u=)2Jocw z=SNv(54`UCX)Q}P+n^xsyva9WLU$rthRPaat!1$ja??Y2FEt_xnMz!osAW&D}@NIGvDXHr)NLx&LLgd=0PYW>416 zmn@3qyvz*sp!**-d$Qi_ux{IUXZpKld(RJsyWcnW?<|qGIhvFpd*e=NDU-*!J{ zcz-{5{LMc8c}aqo<(%H_n6dX-PD;Y7+7H1Ur{DukE%g+6Nko;;7 zNM$jUds~5>aY@9H7YnYXnp)^qo;)AMN6|Q%ly| zEhy=Ile0YHSWua=(X>s%?>6)-&2c)=`TK$Kv`qq&4}&c*ICZtEx$9+~_{*h9-!^yi z{Lu)1UA!|YKfv(rTP5bTTOH3!tQ9M@M1lg^!2GJM;=kUj03QmJJ7Jq`;_kzM}{ zzc|z%IRskbm!NP*pxIO>oac+X4yebSu#zV`Vx7c|SV_=AKzRFtnW2G^fdSmgV1CP3 zqEfG!z&v5U$cDzd;GGYk&Kjs4@+4=&pQR1FKIhm@$8+5PmDAtTCpP};Xf@Rd&taLv z!gcq*M3wRbm4Fxjj$dH@E65G93$${H_rT?~tkNe!B&Y2c*)Zex@e3l|GcF&$z+9X@ zaaWHs|CUq+ImQ<73Mc!vWf5?r7T70&8a^;(pcc}G7{d#44(^|(Gnp~`^k$SkF;VQz zKOLhDyTJnrQ19(Hps*%!r_!^3h9*ZLWKu$TYQ*6p*E8pmUw~|8U|_f(e@2Pnz`p$w z8}BCGkMGGSzwurC@_kveg-Ji!mL_oeRVbWL%05=XTq%@JPpd{bj+;XT6V3 zkV*H|Qu|;5nQEOC((~bXq|@X&v2uxrZ9>XIv%Xv^Y!}SaFicv&?QkoRaf$5Y&oUvJ zV)Hv+Y%g+sHf>Q=&IeP_MueEDcG8~ar#!?PwqQ0zX3TlMz-!|S)kXJDiDoLBGP3Kr ze!a2h`ku&U(}K`n;C4wY!zDS^vT1KKoVG+ zDD|WB*!4YmpV@XXERhv+xMj%Qu!SAUKJM~Ge5$q)v%{_9Y{JDCKy9lggonBXR|**V zF1o!ZOzBtmDbbmX3U8B(1Csb=nMN@Gzx@l;M*}TUW>|7Jvd5#fBU9+^Gt-q4|5m6N zUW_-nz^d?e1H&b`7fch%A{a7{>mb{McB$ds4%Ipeq)v|j}th9Mm@DmytZ zO1LBo-F;T8wy1tVk?So522sZE3`=Tr_`E>svme~Ql>Gs`#iE5#;qAFivZ6|9aY;@l zY!_#^Y_BxDXn(;$ykW~>CJ*a0#tGkG?Ea2_ji*E}x-YKEF)(C5EA66aet9L~e!S0dh7I@Qd439LT3_I2FympkG2_}@ z-J?miO25{|O!V7*JGmKU#riMC1J|5=I?ip9_3aSTp5>yLq~?;u_sZ=3jIK;^2ew07 zZ(EgbKOW+9Uef5o-rcdc@A7?NZs28RC{tc^KWdg&9n*nhF8g_*VhiLMawHfw zWSwQZ#?N53OrGJ5gFV9y1BQg;sPgS1-BlegP8Ycv#aLG77{D8{@7*L{vNJ^U8!GNP zEB%6Q-fTR0M8+h01KYX<(y2@28Q!ETuasM~Sz;oW;AIsIZSNsz z)|eropI7bKf=JN9c6){!=iP#AUD9v%aS0mh8!AdQXZS3-y{EV1Un9&b{~ehBG9(;k zXpo)3$naa3p$zJ!?;S7XSHw&_`R?0|1W=BuSlsi4x#4e)%2nr*X>V5u7=9KKUS!yD z4B?U-UeUuByWc2daqr9Zoe20)R|3srDz4u_lHk=9J zF<1!hCF?HqJijpeAcy&v1xHs&q_ugo=`Fdz6Ml(LCFqSySMSSdNt$BEUB3M9JSDpF zbTl;9BKSXow`mAzZbKv-i=zw?=I$zKN=MCBMyMR&)Z8{(S!kVA^>k&YjS?0|8E(Y( zop4Y(>bK;^j6BV0Nf*6b{?}`Tr(C)#2Pq9-D?(ti;j39-cg*zIXxJ$t&CFcO z$DAOnS;mmSkf6LEw2OrSw1sKz)FgAJsHHa|HN_YhW`UOa>n!wK-{mOrur5KF)3<6u z33E?@{f3DxYPJILiMb3<7*y`?=cwqlEt8qp=&Ahe{$0KU`*-&?&RDv8ujA1-)0HnJ zxqkT`vhKu1w>KLPMmB@@lB|8V4V=d3Ma}XmdXdMzX#euSJ&j9uuf2Nrm_rPYucZ?6 zXX%YIwGP__8~%RM!Q+#AX9=q}?FL~O#GUa#0E?)vS%;jmwJyP3uLX+oE znHb~kj^8p9|J`M{eN%`>XLBRygnUrL8iGNCN#DgMXT94n{lz0b=7uPli8D6bNt8DH zoN-$)#EkvjhQ`S!@`@jH@XT>3tNxV%+WH5Y{|Bv3l)lBV1iTJSq}yqZOBwg)iQidH zUo?Ajaohci-wL+OE!?uVcFWb{3F_&a*QRg2o4$E(2#>zZM36=D3(M=k9j9 z{ZHVQ_m=D}pzRheueK@QxEb8LO*QI5lOKg-51!kWy@j=5Mp^GR&~7(QC5B%NSBq2)&)?o+cyax*-Wdl4 ze;yQU?EP^iqk6V7lXT&Ojz3R2WGs|GESq8%KADNVD^Baa)@bbY*fEJSoXPOJbZ#~0 z42#`4@&g9(N+dJY~rx`i{t z=Zxo(yJl*l&I!v6^e-Nj6`N-LMuY7}tVBZb1HRiGizO2JlN!!8TIVPv8%Q=Uj5y+R zkU@GfGea9A1B3C7X-R^c6B>F?O2%+cxNzhVWQun73x>@rBodqq7bXcQY_Xf7q1J1^ zp||T~VngrGPR6nqrjHnB^fLVDWHftrnn9Sk(6F-iD9@I-({~L ziLpn3juol*GGN|qd7$keV_8Dh;+*Sdo<6a1TMG@F!kZ*lY!2LZQr}E1c<~#DWo|cp zdN(l#OQ-JM=E=6q>{MCqWS#@d-EM-0)yk$Nu=$ys`j#<8*5aZ@^`bzrh9pS05wdM- zvO`y9BEuV%2}!qD*}OB7SQy$t_rEb43Lv4}O$;myGn_!%GuiU=qt;$ZW|x|#J?m0( zGQ3y$W*xXY8KHGpYMM6NzW1(vi4u}fURih>sN?y>gZmou;S$n7t+?C z2R!z@A;xfmvTg)FkFp`Jz{K8$&M!B@UT$ROJuT|{a-%e(@XL*BFM&=ef)<5XsasN4 zFveDp6(X0PuRV|Y=!S!r%t1D{?b|OAmwm7*$S`R_uJz(13&q=PJ0+ee+6m^J zyIrEh&z8g`ZC!~{;uB|d`$jt-HR$d3I5Yj?wE)9(2hq--TQb?}-gnd-GME%#*dpPU zRF-?I@xHZEX=#Vg3W{v*d*| zgj>=y-`Nn&zu=mAwkYZ`*1YeSGsPigaT1ICVUIH`DrFD8_nlDZQ3jdv>XiV%kptT460deUYICD%$eDkJJxAs+b=Izwn3W*Wx$?B?8}FkRSPq{!kU8PT z?%CS{44ar4Iv5!k8WU3z^gQ0YStdK`-4jKqemPzbiIiof~qI0J0p}dfu2gwqh zGwlw6mK45O!lDG;Z!`U**gv0bNKEFfY0R?^rOXB`CaRs8^YA>mOzVJbvkjV1v(;D` zebu6W7~kYOAfk4gamJw(>krlLDO{7^GWaBJ@&&D9+UK+FL;5D!4E}`&8Md@vVDmF% z_{Mqo1W5fZE0?5%1g^=sv9d~>qRz@~6K8l|+WvjT3AV>_!jxAOhc_x z!i`OC!Huwv>}0tGHx|xNNs^GPXh@Q0@sR$^aP*js!$!liz943hPLkY$h%VPN%p%?! zJyy(^n=B#u<6ug){G(elQZ64;nLRB@aB@x*d=y)C_O|YmW@nZnI2i8FJOC;3W)^no^77;cz-(u|p*6LkK^7DN63(E4u3BK%3dw~wZH zZ^2XWQl3Wy%TWlXEv^nlqId-}KAB1r;_^`!)Gppkbmx&yk}lvWHJN z@VO@L?mBcX$dIKwQRP{H2w30SFUxvo-rFM5J>#XX_r@F0Vztg^n_;ZaHpukb-Hm!} z%q0;{llM&o9oBKxTgBw%(&dmNIyil+MAq_vrsiDEwC;QBeRRon-OM1v4ypz~f*B`yr!8X`nHpqX*7F)~M`+jC~brg9+0w$m#ow8=;1Y61B*dcaV2c=Tm3y--IG1-4X4TKTlfK=Z)aVVNpca4L zty)^<&8AoC{p!s$=(I5(6L=LQm(HBWKHLlpBHb-&e|6p&9DZ@|}RBBgiYM z#6Tswua??&=UE{>dF@9S92|_MB|UEpJ@fFEjze@O14|d{Q5J?SMh1pOo=4}jTqp}N zwB6jux>I6O?x9&BJfGK}<+I@sC=+vi8*pZk^%}Nifmh-dtmvKT7HBQ9`32wV#@!lO z)eBavU6{nQ+ zIXdSo-|EIQ6H=`mr!9?8IWj#pqG3jFL)qOe-sZVHdszPL&SZR`x**J4mjSAF>1;FM zl*leuAKeq13?~E_)_l_nGyJP?`WVB}MY9XsJ`@AkWNyWVNS9Fn;DZ)>1DmUTSU5dfDJO3 znmD^N(R*XZ%A*_Za%5ch-Cc6|*a7bY`)7+WXowjKdw?ch+Rn!v)l!QQO$1M<6q{ME zVe50+BtAjsC^JJhBLjnyqLhZ+?rXl>hWd>EApvlwJq0v*(DH6WS0?|-V+==?^q%FE zMezDGru?4(Dk^phr6cI<%nm07%R?)!2xh;+{gW7uZMz_7o(+p__Ab~-NR zEMLsa)eDnmFegY)mwU4-^4Cmvd8dzW9L^j#aC6p?Zwv|67nmDz&#m6dDJuMpZ}kjs zh8&QmEA}4NO4DMvE#a|Z#)k5UqjMM%q?z>@c{3)1!!(!S2167hiqPfVH$jS1$|H`J z+&T+7=A&irVXbA1Zx{78wsbxG%C~yP1ZRfoB| zZ(5dZ7U^!8v1vAIM`w3tef!k|vfMYz-ljcH%J@;VhV5O%iEkTb_cAi9SeSG~;>tdj zEk-L?8M<73&aK{P$iM)ehZkdJ{%}@5+W9EQ4cRbeS;uK>%{g?R$@IT*oAY?$T62!I z_Y}6YG_Y;qjLsL3;<>Z$@T=MJWh@Lmj0_A9zR8B&|Fg*ul1ndadk@V;pd~4jK!=O5 z$ff&gx%~h!zi1!cw||C7+lC!8IvjItLwt@O-Egbp{_KNk&$gdsFgH^(-miN!NxAC7 zZMz5TyC>f_(`(zA6v3PFZ2Q{D_sbNF_rEpSpX z-jTUxdGkx=ls?)nTXCuInoe8jnVZ))7aHaogfXYbpI1A&Sp?|>rp&tAQV~-wiN4gE z_ts2bZyE2gtOsvi-`s4vQ+9^P;jCHr&D4H*Nxjf(3qAMXcH^9b+cyYKPKxmDN;K7M z6NUH`N^Vi4M%hzs&&UEE63U$y;#0%{*=>Jua@R>?5peuK)=BtkrG@VVP5lrix=Zcfq5PWO3Rn4@lUw&!$*8os?) zZa7mh*<9(lAZQDUyJZS{S$4+ZtPFNB-rNY@T%H`4bIP}5G7t6@o#3l^G~w?N#n}Od zzn$(M{nFlZ7Icu$zV1wZ$=lvXRTyiMpP+IwL zU0c^poiDLxF6Q2d(@HD+5_`t-9)xw*ZO*MW+oOuN{hh5p1UpNIIal|0tz5Yqx^ge} z_6GA)9ud5`ymM-DRKP8_1G!)i`9$#MLe~VOHk`1_&VVkz)Ma-07U>K-142?^(|IXG zy9=T+d69jl)6oyCAC~uWESH=r%y;vjK$O!_9kxH3&oovWEld(){wGqr&TA^C=w^uz z%Vz|yIn~k?$@3%FCwA@1J1b@|G}s@VlNNe!aZ=W+bw|6v+cWJ}f4Z?p%A!&^u6ggX z(%I9YLmgoIZ$Z~GoMxCu9Yj982T6)7w3R_AgT6G``KC6()7h%grI_37U{EHy?fjT8wi4=iRSChMo@h zkIs2!U_GJW#J_Xz*BxCoFwzJr-ImSa!%F^)YIX)ejOI= z=MrwQAKwfe_?l)s`Bt0orjxZd|q$3 zyJE(dbALNI*|*$O3-S4XXa0;i?i+ly)K)(K$Kw-lByK@R@5}mk=NZn}e^*ayQks@z z2=a{Zog8S!JNqClyAb9Vv*y`rkDkp7(J|9f%LEzVDma_dHAi3c^3k34hFb%Ud+*~+=St&)iZdK>pgJ-WjN@Gt0nSB$Qk!OR&lG6${>n=|+{GecP zBkInZ0H0F=ip<74ZgyvHcQ({?Zs9reAWiy$XYLuEJWw`=97uI!vsbK23Mai;#(EX8K=GQ zUleh~rT(G=X#e(6m-?U>o_OaLo;%Odq+PHbP>0+?(ktSl!<>v+SLJjE{lKi35Hww-ztGes6Kovbn!E3%*@?{oI4J!w=FP zC$TheNX|HT)^B2*wfE5r2XyL_iYCNCw4Qf6WBYyiy>ov*9=TZ^a%M|$z0jlfFSouu z|2OABT6EwMh-uCnJvzeFw%*l9+CB5ix5sJk0}U^q`$wMcgIt=}-Kj=9udveinvwbNdtyX8cq zXRdkI4L!B3e|Owec0S6&Ah=1;c*jjMhTjaXMVpOhTsd}BNpG3v4L3HmUz^tc+Vp+J zjLhf%?kr9^GF6TF@~=(&KTekMi8}vlQv=O(L%qFEXDKT*yET9p_2z)rg@IcVYmK#* zHSfzw4>=?GVXL9QY|$!o3_U(J)5*ohv7h8?adkger+-oVE(>hh8#;ibGhV^ zv`f=_PcG5F?RE4`-X30=RDs!^@n&k1_vQHb@EnV3Rlu1>#uR>6!dDe2Y+hARwWE84qWPSM=Q>!Wb(+(Lb6&`GFm0` z?I3>{8XCZv&_F_=KKwn(5g=LScyzPK!>t&oUf$v3qAnZ&+N=k`37rEA-} z7P@{gyD(4xn~Fy68P9-Qy$x($vuruNqWMLgyC3MPvG2Pvz3U~@!RRx2P}Xg?KTo=2 z*(Yw!eZip6cp*;fnMu?387zgMhLMkAMfXfsnP`4dW95q59hpZq?*5Tf{o&{}=c5;t zD!N~`SZtf#<*C%PeTH>g`EBo`0y<6GXUKIVN3ZEh*?pHIW5JS} zlNW43?A2mmU}l(vy#6;=nX%=)e%mw9iF}8%b#EZ8Kvxr0{!{qv@6j#x=l1QFVAMK{ zy3(%}yvEmd<&1MdCPH#xo1nK%1dZ_SKeDUql#7gVLXz07%Vf6LZcWiL!^0Ib)XV^K6-H z*UY|4HxJ}oe)V{Z;bvcHXduV3n=RAi`*nHd~DCnj?c5Xu*_hFnGxoi2JPX z;aNVLmlmg6E=8Vk){g2rdcg8tbVp@|tM^8aj{CE(f6KTfAM++x&x|eUotf@Y@bV;Y z{>`9$QA^uzI`l7VZM-`*QP=hi+q6>~rpcv&oNctQ#LVFK7ULZ^Ku0pn46u^!@R&Hi z`xB%O!KAST^8+Q*mzRXd`yru7* z_&AA$XX)m~Qh^PB_g3b_@Gvt>2A%&DXeAxN&UpK>M8@MJj=oDb9WHGtHoOp|la#Pv zomeht3s$V|EztHYAC0+=F+BwVR?-;`>f2)_GC&)mW;b2B>99kQEjwae#$!=NgG0QA zpe0w}ty>U%Qd-|QAF8U|5!lW=Gr%g^`K8Xnq#!pDeZ#pDn?NEU6I!}nx{Bx1UW>H1w%kvX_SIn3qc+}gcy6ugF8u&Uu zm>Q6A(atY(6okFfg9EH?ceFj_T45@E1ElO)fR*%#mP}NZx4-4Txp2n3 z%V!+idv5u(zX|X;pP9Bm*)4aia~W9c1;NE--xYTYKJU80V>wwd{gwiQ2;;O}e?TV< zoLOdamdD5J#x>q)NrJ|E59S?_<-TrrLh?ojkL6_Jc{6z|g+GgKlP+A>(aK{fd|7aD znXuTTIaiTp^u))9nQPhIj$&7xloK;&__x1tb69?vC> z&PmDhK5cV4ElW@29oeZQX7uEYTgr)IS0XZ4nPAvLM16FHKNp5&Zi72T{Zkn``Xn)aT(Hrxz}%65$j zza<5K|FM;KXdSC`$ENZ-zI zB*ktwtd>Nn0HB;1)4LQc&&>+)c>pb63_r#mHc>|T&mbuRC5(h0lWcRi23dHAMm zagy1$nKS%dZ*z(sUY3?*)g%$kFS_}`8MiY!x7wsH!`#2MQ?L1nmt>TA$?hm!Ish5_4YBRqZ8~e z7)yUly=2zCty8V+f#>m?I~N%j8ve0Ad*tYnS0w57NE;r~pvg-PEk zXWi^5-n03BiM8gfeIY#m{fwn2UQ~{r&i-~uhP1eI^{ksKBo5l0%{k)Z`=-|S4M_0t z|I0oxKCAqUr7y+_-}V!>*1QEOdaT1s)Ijbj4uqPnrxv<=X77!)oxIKUY4$AS;Mw0PSmb(c+Gf!Dq2q@(nx8tcBm;E*HR$SqBtOyI$4ODkXEp}A-u8CCxkEzA z-H)UAj93KM1{55@*}t)qcHHj#x1N2Ig686^e&mLobj$} z%iKW2YOPDhj<$4dF-#Q6G+(sZ1GKTKQ|Yb4eWl#rO1b`8%e-|>a$U{^Z?Ny$QY@00 z-68LK>sSzX*^|@Erx$wMUgu%G)x-M2I*;An+`b~+jmLtx&4Rgo4c~Te0b!BuV}3_J zxO4kTPgGbJt9|KO=Z>-k`4hL*PBc?|u+xKE;PO5X>klzY&YqFI=6&>yH@B}L`;o28 zy-UT`=xQ+bW-MGez3XPD*sLTWhE3q}xMxOXyjq&{ZE5SW83hi%-yF!)H9335DR^Iq zkImJZq!@G%rFgf{;QHwnLUCG7bbVzoT=5B>5y)m z@1h$zsafl!O~CZqkPX6jz>_I8tumlx%O6CGK-;1m_}_sg zSgsf|g7Na+WBACDNbwBdIhkg{`|-yB%CImcZf5mW^> zgC^e_k{Erp+L%jju!{QaW{Qw=n zIhS8@hF+cYvB)yzTOSqge^?uqDshwveDTF9MQPE?(Y&53Bqn8f@J^I$-r#>UpK*a6 z|Lxu`&UI}nAw3LNCrBw7vn3XH-#--Iw>RXEn3?*~zA!ly#dV`JjeR|_i zc;DG08(Vw3UIsvYyf36j;jw3sbILIV9i8Lb#>u-{d%HZNOqWdWdbvmn z?5Q`78e;p3a-KnDR2C+AtWx|MU}&>S(bOf4=aApkx660^J+-m)YIfq{q-R+k`l7~r zAzE|t?tmfy;(~QrP2g1+dG6*tYw!ZI8Dsn|4rlPskZI zAJA1z#=($~)My6zN}MO};nF0t1TP`2wk4qJrM^WyhUA<3_M6ow&ii|6<77E|DL>}laEzHW0-CGhpEX=o(f zIml4uc;w_R!GFjbj&=0favI9ww9@z)a(P9a+g^K|;cwX1)}?s3G(}-zmOsN5W_5;J zR*biLUod49FJV2+a)Iv;OU7%K4D&_Y3(igy(-C%%7N7jCG-ZLl!*AP^y!=ECob!q$#o$}$4rT*VVkYP?%-8tr+0Dc#HK9pTltN}!Fpj*P_gXI4%3xp>yIQvMCHI9O z9W|FPQ%iFAb_Ke2D^0Kul0nmw@)jz0Z2NAw9TYVnTmZSC=b?$%Xc2%OrNQ9Bd!2RP*$)oAXX&F-?jgeaLfHLo$R*BoZhGuL@ z%M_0V>9FxlO@tmrVu*!iZU|Sp{&enH8gb+g$e}`7ZLhpE(_~NFJ*Fd&tSQD^ zEP3W!yM*nP_&Q*?P^=_L~RpKt>*nwGT&C&EP$=h9_J38^fo=ISF~G z5#Icp8|ChR2PmF}wQc=kAPrjKatR?h6Eb>{29=DK1nq5y>4ZwYDv}0^)`8432IU?k zyddI<_t8109-93RHf%chuxwh_Ov^jxf($MBw(E;tp01|#?1iJX_t6i*vsT0@{o;Rd zV^5Lmxx${kfo}6G@086pUzjxQl1r|OJI}_u>}x@nE*$a@-YWQ=|JIzsoT3Y$Rl?v( z<(B-Gw|uuwI!eE5zrho*!SF77uFnqnBuz0x$ps0?Mh*vqbdqk(c+Ie@FvsVd1^C#( zZj-?ID`(Vt3Sae3Ii|3t@w<01T5Pvu zv7ZZNXYO)6b5RY>L3#etSHq%4eBKl9RMAkO*6*J}a(P83 zr>I?GEBmpub?r)tdow(4cQEh2H9u?HU&SqE46hgr>Q>!cxAG=LmD!?5+uy-w zx7oM2ZS?4P`Rb;gX>`X<$D20voOs&HTYV4-B zXUJU1VK)kG+Zw#NcBRBTpCw1nC|v@X>b>#B(j+OLB}Y@-mdHi~Z$29$IZfb$^I5at zREZ-k3)8$ef+OI>^e#b(iQ9~|(zuk~I?V0Z!oo0@k%6ID;nJ}yogSb8QRa!$k{B6$ znHKP?a&&ueUr<}dAi_3N0IVA?A@C$gtZ+f^OAfOo)4M!bbyW@dnP$FSniS;debTL@ zNuyePQI5F_Xk8TZsePbD2gPM4i!a68arw94=&BjL3a8XU&ZId_S-UVPBVFC_t>UR` z0ft*PPo81gvB`YJjM_7xR@=#&ClAOk%F*rE1WE$4($)8}+*!wS+jGmIEgK&(uy8Oh z$~hC$u}NRldCpv)6*HdQ^mICNZ}a)7i3Q*1_0HrD+~&z3qsp*g@zI?6j!g^2Nrna6rF8>z%$SPg?qAan#~V8gpmQyoV$SgG+2(90<2|uaf6ZIX z6Wa?}80LZY|GzYw021*$a)IwCi<~Fhz75-q74O5@(-rOq>6kIya@@Bzew{?u!-y`P zn#A1y6Y|@WET$a~5pc_>NhLf@?!a_rj-ZTWH-AuF+y%H(c<7QBH-wuEPmZy{cDfE}Q- zAfm+Ws0;fx=6RbY2(&Zb=6n*#&~?<|+~v(%`Etw`U2D{3U^uD-yBX@pmj)Z}jS@3B zE5+EV9Oi+Wy`X~%;i>yV&P@635TFysWViOzE}f|i(i{0$1Y|`yJUDKYf*f}mN@~fSI;lqY$w?T)no{;p& z{r}tHPsG&e@0ghx<})%dI6^jr+ z;eV;$d$fK#XXt+fQ;BO%9bWZjyH-Ds=;V8~3T$=jPSve00$B*w3EFs>A8NKTB0$G% zk!_1VgY-qYL+TBjqTP%f>|4$-K`!iCHNAn6p#d~NBf!jjf$xwyIA#z;26I0Cl?h;_ z9gGYMBF-#HI_JEl_oZ9QU5*{y9KRI=ZqLYbiC|a|ao|9ZB%7fDL$E>(Qv>XhJe~up zE;q1jm0ixj$+(nx!TkG%RiGWQw+&-fG0TGY%0hR^Zd%yrbX4hC-@^kzI$+xucpfci z;L8SY479!mI?_sL)|ca&i7nErroZUvN|f4iv!y{ZY9j-4@Rp?4MR&GEh+Z!InYTCO zjN0_~W*7Xmzbz1zE{@kOTcCG5ciE{8Gk!*G6zQIk$9AL9IrT=&+8d31nu*0*lak+M zAN>|&$a3t>wIxYr8u!g5a>R6 zaIk>RGzZ@}16czHo*MkJB*{#6@`Z0pl71{UwFd3_kl4x~aCt+FATx9D)->bHvwTOB zG{l@YN`Q`BzP^>gpuj2H%=pOd9W&NtGbSjouf18Uu&vNA_Bzvn1DtDb$_eB@PTIAO zwV_dFOPY04nzV6fcG-iLYj5(_-UJC9zA#HR!?NYtdNBsJD87YXSF<+EFkO4Iv2H8F z1kY?Uy=AYX7$ja?niZ>XkMGNB)&`%b&7fs*t%2MOhPj-en?O1&uYh~s3=ChEBwd^g zI-NN!Yv&?$(aGr=NEb0(loWLiY606-HOJsW5l8Mfi^K;q9k+sAZ#2Gde7jufjl=gs zC%5@GK`YqS9_IwDDN5@X2D$32oH|d5yn4!)nP~bKJQcY0rtpx%X~iwq9=C9cUjA5k z$lMEKl>&_b-on#EZGzP_(69`GcYJ9%wz-) zmX;mgHKQ&SbiAj9Lwl*)(G7LS4AqaysI#0o+Q-QDEa|xTjgJSce)U>MNgSUeQY>@% zp9SNr5FYjy8(P%<-qbz}J$mc;2l$2nTnBUs3X564TblIiI4ASNHVK|tAw2ed!m|i% zWNrD~*n6ZVvG|O*8S|4rY;(Gc4JR@ih;&!2n9*|0FncZguWj@0TPY^gW#8zKXlPLr z%Vn6&Py^ni2I)#($gYq>FR@^0A5OFEoZ%`ieVI2ad69i*lHlaeHjw7FNVkIc;VrI- zj(TnW3@l<#lF|<}#q>;UEOk5jrQz0$$qP1scA=h$36S2*edX90)~$xcj^N|bclQgk zU2|-FE5MrIZ0Kp@ClSHU`b~XBt~CQI|(W@Num%-pah&;q63Wo`^Gk0idjQ zdz|xY05iiPQ2lRh?LB40jp_D{w|30<@VKRy zqk7JT{`A+=wI3xN>KA77YdUoA*-fxig$$_iMH=>t5+u8u%Edq)cc9Xi58r z$1RQdx+|8mXdPA3Q~P6)_+UxNmC`SZ)L3GewlaKQ5pm?G%1evH1%8cI?GAT2EI7HM z_ag=x7Jx3_YP{vY;1I(WMTUBYmR^PxssW6T3I#dLMWERj9xvD!kp04!|A7wpI8xTm zx^qU^VTX+#9en}o*R`<=h+l5If8v1o^RuSw+bqiW&RIYG=AOmRN{#s0^v*O(cyttB zXJ+Vfb!thBi{<5Cz{~KJfs4t=LtUWw+MVw1%)|L94`zSf^-x!@?Lgn;#{6^D47-lj z81*Mz^mbr-`6Om1Bg2t7aIVQ7Muq^LD$WxMbGNjcGc>%{PZMNFxF6qh19Z}Y+ZJn` zw8rf-qCSWTi`~-@yC3f(ib6NA`f!vDO8VQAl)r<2%?A@yyjvh6bJBjB;g5~)H zL$in;UdU$3&r6afIWsdXW@KQZ7M7I2fhEQ7n|g`AmEbW{X% zxdiv}jS>@?z6BXpuk%Sdq?G`gQp`&gDh@axq}66W)l-_`8N;;OTsPc~zFBY7IrGbg zI4w5=?a4FV$xRd3ppo#kZVuy7rDr9nMh2UWEY~*h`UD<$r=7rD&$?zm6IcZU^IMS( zKe=ukn8kE0j!psX zzgAn#qpthALARaFTqyzD%gQ)IuleYcJ)Da{S17JuR^(bX?O@;8>a(*=BbdXNo_D*{ zYc$D`%dG1<=CNot7CfgFSfzh_-|$V~mP0kiTHjp^9nU$$g#TtqS%mXgN3lu&NNbLr zauBqEwbZidXvSYLY{m9u0woY|1@Q|MxR$hs3U4jYo2g%`;^a+93N z&r;1>HamR9j5r3_C*CggfjgCq8xoGQsk_)7=`}Kv=lCY|#%w)!Wpe{dAFmoHe4(QH zX<7nn+CX=f3NtkDu}Nucohi3*<_xRG1W;Z)@bbo)GdFzBgeXWHO>S)GkDcg*l*yTEu^29UzX~faY=r8 zi(uZ0xJA0_85%--rZZS|Tx_`-U>M8vB4I%(cUcCHw1r9A+zg)XZcmm4&5h2<5$9MK zmNGIhbT{#~+u?P|5nXRwlZF+=FuhM0>>l74V5 zKwfkP_67#gV8*Z>DIJ0qte!afVIS-7e@P*N+XN?H;y!zcdjp7GyHq?uIn7(YWO`h~ zjN(76-W}I2ahLO$uVKuUX4~t+ACvgux0D3KfdHT5OU2ph;+eU-wRILInQi=X=)n8z z1pC5PRhR6St=4VQ*BZ9*HpeYuUuW>6mY0ViL1WqDOWe%+*EgoVYuOvZBk85j^JgDh zS)YF*hI1Jh7%rGGY-3;n?aaTtQ25*5qZi5!u?fxHu*~mUq=Kj%#mT)QFfGutBjOcDLG zF!i1!L2>70m$;dI=WZ~ayJ5yMKM95a9U<`fvZ`(e+^&S~DG=JrAbs&-OvLfHh8cQu zH^eb1tnrgzIB;N*aM`XeIO;qH=|X5oGczoMmZM!q-OlLj-LUx!(~&ukg(LJCzkBQ7 z*%*+3&Ex1|pr%amJ|?l?=XO0w69r~|ODukKn8A$c*YvoC-W?%TiFGeoJ7(_Z?`||> zI1aTL-3*2XNGZ)c{m0>FpWAt_oRl}4Z=aLk^|JNnpG27GnS=7zrrYNvXw~1S`M06B zq3lm$?a#wzOt(I^e|^e-nhbS-EuVL5{LAT^@7t@8tJ5Uxk(&VQhUytxIysZbayRf@mGh;lzzSSNPXfI zD*^H~XdJ`&dXr$@i-T@!ngtRVm}Muot!)-a0MQ2>jxR|xFbIylvG9x2ncC7sPG6m* zcdNO*Gm-?0<6|RyzWi5*EYk|nX9Q&`(5)prbJj*CT25>}`ox9L?1E=-gx`|{=5n6b z8|Iuim{g?1-hHxDCg*_@Se$`@L0C&nSWAp~rb+8o7KY`F3=G#r%r1lnM_BtNGQTx# z-FjJsje+5U8t6^}P-$niIH_pXAt9zinOq?EgE!8v^*s9JMf*_)P(ga-sw~gGO$G}h zcn*Y%Z4)&1(vNx3e%EjfxCV@myy51uUv_1W1CP&&2p$K%Uy01N5)8iss}dK0Zj1ER zKf(a&w}Ju&gcpF%gnkzxetA6)Y(}T&1N1_x-~W;>NgPU2U}IAXdh&dcXmOOWj-Fc% zn+o%C)5AuYZGk#bYamM_!H1MKg7=55Tq=1jH||XB*$vz7GZ?I4=KK<5m@xyfnmjMo35h{%(o=N{C9%dBhyzW zzMiVBA;!G>O2gJK+nbUMFU0dk>~+i#>29>V(y+Dt0;q9wSEG&B<$kRxS5IdhTBtw+ z2Qp6xS!DAbw5-^5a+l%-H%U0eo23`<1%Pj632cN*+Df$9qm{P2>NgQzUA5?`bG6?{2>8?9-9=Iq6zg zbD&O@(8cLbyJTD$%X04Z8Wrubh)629mcaYR<#Bf0_DaL-qX#v_n3o4OT-D+;E2v^q zS>D~u`$mheY?npEnf(?w+}`N$ebeU)+aDtsyg$Zp!)l8gFCQf^FHd&>8RhfkyNGZt z>>O8+FAe;))GS-BElKioLbRe+KJA(p;*+jf6=az1b#Zdn%^uK#>dPw+o;wl3^IqdX zQdu7N;s_bxi{{FLvtnSR>yZQvyI zZ{8`CXT&w%eRlNC9WgiP;eszC>X;c;GBPkcKs#PA{j{tZ*BhPN7h5tmF7gyn zN^??qwjl4bT8NHXhz{GYvkgyTTsLrva(5kNn6sKgOt|)YsLz*Z%)oKjh(86isM$7& zfcLQ1)Emx~f~?p4{V(Yd6T`Q^M++pHRZR?2nmM|=6AxEP-{4ewqu#N>j6s2M+l*y% zUgsvLcNo-4xPdO~x-M2JJtLHR_i8b-0x6dpdIE{igVN?I9O{D{yte)zxLIE$hq$wdNu26NatkF=HqNEvYLKG zNrZFQ1g~NCGUl)eZsT^jalmrJJ&=hRXNrzy3M4W=KTu`O3$p2gxMIY=paV&Z?k6p( zU(onMJ43``gS5*HKY>J%ZnL)x26@UXw|SLxmT|jC992r2CJCzM<^~$doY>IPz?}xl z%M%0&4)QQFtYTzf$mU;ou%*kh;Q}aY%uM{swlGkK?U~WxTaY`6`yTK>wQo7Ip`{_} z%!aB{q7wuHx+S;8?PL;S$}&70^(&guVWULGTMkGOVsKY5XKxYf(WD0%?i;543j-hd z2D#p)qpV#Nd`A2dz4frjF+X*}Tz>cdMe9P_zg98sN zuS^e5JpN1-bda8D!PJt)JvE;he?tyLyv?wWVTTa-+{wll?=wa8)qcHO-J&MpApzRY ze{@M^E02t=P+6ghj-HyYcFKbn6F0DJnY*EJvHKxVKE{I~Cxt>92u_pZsz3u%QzRx{ zSdt&s20H9hX`yHRH~0|M>#5*@UyqDS#TBU%pp)W-W_|gt1sTk$4=`ks=luOIX_72w zcei5owv+|yq6}rSk~+FMFa2XkpRFsoVs#kLc~ipxokvOEY@&@WaK$Z>-gCquc5Bj$ zaN)y-g0w%o7)9Ngxj3>+RV0d)3mFOM-oQnEz%afsABk zFudRe?wOTd?Rt1)&k^t$hX0ruRx>g%Z2y}50h}0R)^;vLI*~5>XhEQ`^BGrP9_fpM z;VjcmZRmZ`q0OYOb=Yi?@;VL~t-~5(%$BvMLL}WbN?1hOeqGCx9b~w&L8-HI-)}9o zU)>C#$qw$WqizQ>c^ed#DYNqtQwFb&4WEMRe{v=$CroE^ z$Yo({nQ{43us-8%6NX*-_KXZUEN8ATa3onJeYldu`sNZt#p7j=B8?h<-JfFX~$rAA@ghMb-e3t?GQ?Z)G;= zl;}=t#;;Oq8Yk~QD}AF^W}8BLppJ%EWeCq%DF)ReD>+wulVZ5)#P{2TQB?S^r{Tr< zpa~+hH14qR$3JFljJ3;EU+}NgRP9e|Hx}f4 zaFcv_Y|Dk*dk$Z+O}flCurU;gUuHU*$8JrK(o#Ec*Hd3qc#m~wXI(Gbtqlyn8L|?h8fIkraL->k zqpw^Ybaq%~`O=o8iz*AYo?7}&Yx<$aoh+ww5+(%3cyTmv&zKi-rfv7+#`|xBEGD!@ zYPoH(?zD`38pOkM=NbbuPs?0g9)@S0M^)M{fbW}vobkkFb!$oNRBvY4+)L|DEd{Mq zy7rOts8T$5GxN{Lr^DLSj`!x?3z5b=T-`F=*&*_+7)yu$Ga5K~=z5 zKI(?snWx&BtM4%=Jk)NS@$>!=BDG3avDXPo}SOD@2Gp<%|# z3x_ns_Oir0(tdf6lbK;b#22B0&h;tk>Yz~ywGbbs7BOaN#Db+I^E|6kI*rki^Kqz?@y9`rM(7_ke77OP~(htD?Xg zNA*BgS#9W!-Oy+)#%axNl=Gm^_0YLS9%j%Gfu0z1@tda9TcBYA$iC#4GU=a#40U-L z&Uzo+!p$QlEFBko$DeeFeY;`h=7d7S#2;R4ud>?zA}P9N$}J`?+_pYt!Md^=iDEi> zYCI4P&m%YNnBfUAb*)xnp`p)5uywP;IJ>)NJ^|ZM7NV-7mo^EaS@y6TPr~9Ps}(Jx zT56B9C0}${N5sY+OnUW-3$zerr&i+r&!TLG&KoN_@Bie=UM|GOU|3qpx;TPIM=MeI zodLs)fQ_JDMvE&?ST>oT&5Zi{K=ISuw-pp4!|%L&nA_ zB1*s5wZfOwa`N;Ry55?4V8V>%xaRr2OOm0ZrIxWw&f61DR#%taT3=9rV2k!7~2$oGiEIi>kx=5Gd1H;uI!<~E^80RMZ zwK~Aeu%3~DL5OKVJiEjZ2c9DiJO{o{2d&e%!9S;V8i?`j7fX@?8|b*_l0IYob!qJD zz8pQ;!m24bLtA!@-^&D%?ir>p6AT5!g~gVnJeX9nA?ngW4KdD*(N+;N?9VBv>8a^> zoIIfVGGY7DW{AceDza-j6B9(bTR6%azkZZU7Z8SP_LE=}gLB?jHwNkmJ^J2vAn&OK z=&pth3aZT0mo%R}Vz8m5%Tvn3^NcDFb2lSst~g@Cq{fvJY|}UoAJ7ov4CFq1;GH*n zvqT4Dm+KiG9_DQ2rwmIXcrxB>_$DBAG%4X5Lj<@xJA)@&!fm63MHK^&!op6^k6RPe z8$~W3Vz}X{04hApzRZ&G@QmR(*ffQwgeCaK((Hq6ag&)f85tOU`~#hXuqDXw47=vb zrAa{r*(VQNVNRII*T8#*LGxujL(YRsj2r&3A7ImyWtd&hpu?8*ONQ+L8o{QP-uzUb zRYxz4)zZk|IOB!_hr2Z|=gfgCN$2KuTS`~x zJ=5t)I%mdYBwGA!@r=!l&y&tQ(|DGnoUnGr=I2T0VC$1(kIo6y5lZ5Ul0ScR&e^~- zH>V_>ODYpD7W*7?M)GJ=(#6RQ1{Z#1C|_q_cYB=-iY%y3k!}fwF4r?R{|g*tVo0)M ztY6{DQ1fTzNrxM6^E8xqoOih4$HbuU>^oaE2V|8AVw7JgjrWK1-jFkVS0}28DreL+ zGnlND;Jc8>>HBMQcpGRQKxv`p`G@e{$om8Vw;c*BH()*!qH&d(0|p;=0+EkWgh z0-F%iveE!Pg|sO4r%7q00ewk=!PBQ}iZdI6P9puBFlBMXkuBF9cS=;eE8N=Ay->5< z$iS8T=|3wC@y`iUy1Q@cmm3v?vp+3+y&xv$Oy#?j2kZDwoxR|=b9%+JhUPO?8tkBi zzFYeE5zx_PZOiVQba>XAY?UkHywRgW|DGX(p#x}1q{NJ!g=hZuCbO00$rRT=230Xo zA2pc$g{DSOA*&$l=7hQeBH)2tj;VGJ!(MqF{qVq#?b+k7UoFv^&t#^1*{+n3y8{|~6wX_^Z^zVE3zI4y`mu@K z@tR+teRR&_pp|l3ZQ}1*k_m9m(2vn^0w z5y>LJ%*?>dz`Wtb#teo8WrhTX1m#@4Akfh)$MbX}GZ>g6GdYVF7hPONSg5h8$4OEI>y?jPv7kCqECxdd(%%L^cW5 zYpSqorc887x~0f)$RMPVKXBG zL)Xj3ODmHg1`#F~oP7e#8K9M%N+*s^Q0RJX#>5xIabyc${$7?pQ=E+W^FiHviD%x5 zoEwWPUYqP;4A80S{C4;@^MTtplkPDvm@%b!C<UjhtzVTf^9RlbEj<45Yrbud~+_3$%254uMTeA zp#8~ACF;zw2W{70K9Lcq6Q|X-*;;Z&ch5D|lr4{vg09TvnWOt`t*lYh-VmPnGIi$k z?#kEQJz+6EUArbXZa%t4_e93k0K+p3y^0_yZe~f{E?4Qz;Pc-ZK&wJus78IikyF-x zcGveCJn!CZy!l0Lwj&RyF z8GVZb_@d{Hf|r-~9;oj>8>glA%1bhY^1$Iwv znNfM`MDrbvJNCIL%5qQKijHlb$g^{z#DWMDPKFsL9V8gO*yge@D6rkqVVK4s*1>qA zL-Ov){&y@%Q4^aC6fvU|zBpxKdkffl7Bph#>|uj`^D<^9piW4 z;c>9m{c~i?Vy z$0OsCIeZ|{z8W^tCoykxV{JVsB{g4Nlq6>OXn9-L!%)#{OOmFo+AuTZjFQ_Qo+mcq z+s?3U6YSRF*(LeWc*7YsHs%5+>1%2X?--&(bl7ZkdDy1iJfQIGdtD;)hBItp#_eV~ z%7^~8oH27!P(1Xv#pi09<8&>sP>DH;kV5(cl{FBVmeAINZY{q#cdq4A+93F_&S{sl zB7&YNt;irP_)eXfVJjm8!;;;COduYZp14zxX@ekG0f;$4z#vqbEq2ugi5Z?plav|W zNth)_UtB536s)+VcSc@|gY0x|v!q>uO#W#aW=ePbIkw0+NuQ9k;9Sks-8f_Atqm;= zD{mQatmcx=uxv5A%^`VWqS%_Pf<^_)nP;c#M(}J=WM<@g^t~?8@={ajr8eF>FAqG6 zcErZvSYr$kCj}vK|%)3qT4{ed(f_> zqqf;BXTfekp)k>Hf(6l{Wlqv!pMyos44g&3Ig3scaFyFo5| zxsbQ}y(Lkk zyO-m;Fq3d@gil)TjRP*yVj$~4!DW~jng|L-l{H#CLXQ>+8ih);C59$)7H)f{7Q8i4 z0Hp3=ozsGqykM7KSjF3Yat*KajNFz34$=(Fj8}tOTSHrOS?+|j&b`nEqg7evTxfHQ z2)zM{%*IYLurCu9@p7-`lAe)q_|U3D;84GFwJjGEE*$JyInY$_V4a!H8ZDi)Rc1Ph z39HO_4y`(rq=3v5dbEz2VH+a@gV~#PAfzL+Vnd6?Ee^}T@fS-;z{%%*s+=ynxLh3tOkX9_smti-W)SlLDLd457{H29KrT3 z3lv2{k1~{>tl0}n17edSrOhtf<=|Y+CEWlzrrl-7{0UZwq{ELa3ONLop4GNed2Fo$DZKB#PPIOlzU?cB$n18xil+|G19_{9KD7H0w=(fDH_ zm$b!kV{k5K0o@O$z{Zxg;!qts!*)>n{}8CaDVoO(UcNXP)a?gdQ(Wdgd8NB>2j}8l zI(u0TEZn8TzyPBe7^FY`?mwYkDzI|3v6A8ZD~>D)4DVJqdz`5)6<}Ntk;B4Z!r3r~ z*`WD;DyV_OaA6x&Mq{WkqBES#aKll+jm-}Iz3#!M~2F5-j!LXR7;mp9tFqEqrt5%695Y9uNp9|x zY|Fd-5h-y^oEIit5V^N)S>~L)d*(5dKcDs2XYxGzxvx6aFk_Q_w`1J@{?n5driJTz z-$=Rr^lZ&j|4l)@)5;!KY`**_wT>hGZs&1#791iWgHJOBsvt=Sy^dG@K9NnYr2>U6_FZqr_oj*iA%s#x#h5 zA!E?wPAY^iRs1r8QQRdxOhd`h^}r#G)JB`#@)I6T)>!)XcsBFt%V$-)rx{vLbn@Wp z%4XtD)V$y)93ei*XxsHo0+tNce-AWZ{KF-9jhmnCHVdoo@ zcT5NG@Y-0P>VFZ=$iq@>Ud8ZDS!+Mf5?T3$;XeicY8A{~U^1)BKyYe2+oisK58b`T znpT(gEoYs)aIf3NFO1uI%DGEsTdqA>cEjkvn&V9@i=uxqM6=C!dF0pUh~JA6PajyB zVelm~NPLUKOCNuM#$KaW%x?@7X4zip`IhE7L--IwblN(#4OtAa7dK>G2o{duNMs8& z{k-eGj;EBN`TV)RzYGlocwSy)Hkj696lA1icR*y>Onw8t_0kg;hL|eFG2WEu z*?f4~L@{mCcco=F4zYVK_ehC!t-Yf#(d*g`&ZaEh@<7=Ss*8Ef1c)t|;pVA$PfvNR zn*gs4Z>CBs!}`FWYIU7(cM#(=`_ZWm220%e4@4N9>d>9Ph@~u-t)c8QL%8fT+2kp{ zzb%*yx&m$V<{Xk~+P%`x_q3;*q-L*J(yG99ijk|HwXFD>yed$ScYDzp&cOUc5Oedt zvz!;Te1EKAEOrV>nKE(RGo~5&x#k>NIf^z60{Qap3~sB9){5|l6h0JrHX+S!Rq*Aa zUrY>p85tO4?OB8BUry;4OA7sPVOxTt?ghzbOt<^h`+9}WUN~*do2KDxC<781G zqcB_MT2f_*2KR|>?HkgfPHXz#? z8akhtVXN+O?TYTAPp2Kcat(7Og$1<4=6rd(ka0uajmr)%MNV&D@y%e~t(V+Ektdc$ z1n4kwW}cg-yNvmo!jkO1unU)0No0OE)YW&2J<<@M-C8cVZG+(X264g3(h1jFukbd7 z+wEcuHPtXZVQSaXgW@-g3bdqtyeWUMZHmD8 z2H6)JMqrZ68{ac zTbTo8nq(yk7tOWmUNftTadV|YQefA8hLeoi?+=vO&%1T-it~nOY1P#_9Mg5ToNChC z#;}P)VKw8XV;?%X7{#17q&^5Sk?<>3Zx?&=NpI1o-OkoU3s{d=sBXyP)j2!0rmvyH zh&}3K;-$Ss9U8?8R7>yH@peTA?P;9KYVagzCbO<+;?p_#pU!YrSpI!?p-(2`q&v4^ zx~kZsh{qipPJ3_*h2LefV>RIXepI<8gkSPvO_(Rwvts|5jt97X%r|l=t z626+}k5j=XIb|`On2pOmAIQoKU~OaPU}z2Qu;4jZ)ZVYG9~=%#BGe?d zoIVh~aMwxUl+&Bce^#0OW?{~rulVktB+R5)S@0PRMcExoM^7bysnVP`(OZD*8f4`X=wlQpyQpkQ|cH4+yXPc3R zw4qw%Xp;> zOS4*LG#x0J+;~JhgC*gLq}%DohdSrgnE!37u>U?q^2=$5Q}yj`+>-NRIhP)daNU38 zE9>dh?D>)N(&JxG@6Om!kdv1v_;=R-S5Fk*Iqc_I@`ruRWrj03j46T+VazGKyzhf< zs{OF3Kfmu)R88Pwh5hOArjZ|9&&JoC-&YV_6Bs_}{^s>h#NtiPnsbX*b2I16^i*pM zZGP;-^gCha#y|6F8Mpmdq!_+Y!ZJW$b>!nEDW=vPd2|FU4GOZwsNkOV%%f*xigi|Z(hGx zEZ!t${%mOjf&n3EpAEqE2<^@RM3T3dswW#emZcsARd->0;3dxogY?CuRM zb++ek@PCt*mUw*J)O^CaZ*pgKF zH)}%Njk<)UrQcr*mNJ&+V7^TrrfS|=DGUUi?wpv9w6wKNmIdbU*UMtN#_$hX5&X3cLboL9RxG5;bTgT?+`k!y^vc5iN&V7_4! zLtBhi@q(pFYf`E>I#z0#hpKMqQM_sy9`G$SBK9WNzIlJ1^KA)<$!+{-`sqv-KWIrm7g4r+jhX>{5~1}5u{%lWflK)8H!+%w0YA)4aJgdrpc;+~2&u=X8wA>MMTJE!E^j z)1GX5c60hi75zmIyS7eWYr!{(fAY~>?w-$YPCI6cUo1F!>rB$r#`sO&J|=E+n6Q)a zlg;l*mKR*FG`OGH*J<=}W#Ng81Is|Epe2J{=jx$rwkiK>8KVmFvgg&ZiWCZhqHWIF zzX_5a^U~vOTw`1gi>}s*{v-9aeP1Jw!L_YntfvoGep8J&;%cIH=orJg(iLhOQXgD# z-t{blwbqvR@mB6hCQsu%1nLFbZu)h1{O@4iy@@YGlIKWcC=@B zqVsm=$myk>UhxR*o+YO@tk}f5`SicvOj{1|_}87^=VbF&DQan1RM6a4?sI2q?@x~} z5U3Yid+Pl33A0!?{#t!h>9mVeP2*F(`(f6x^VgnTox<=aQ)HUMzr{uh%#W+TJ&ix& zy2a~l$b)O|`|}(=Rew7gdBoKuX5)lSt#ht#loyMYl(@fH-=JfEN1L`-+_pzum+Efp zHZs_k9{)_BUXV9jXKjvWv)b>Ezo&vCdR6<6?iHdJ;$|i6OzoC&O(<3IO_cR{B6cli z+bW9#bs{_(`=>^pN{n@Ownx)oRazA7yH`(dX~o%d!Pr#~Qfn=IbxE5NXt@ykQ+nKs^= zCAKt*U%bK;)1nwHkd33a#1Nov|b7<}6iSuG{_VzOo%l zul8PaO>fb|uB*&?&)9Dk))BfmWk z{swa8Q9rON7copXd9Yc&%Ki9(A36CiFM_?pav*ib-MSgs`5*%=zy|8b7yQiMF7E>t zQjjbV2L!m=%lLuC98Zo?~xtaMR?Y>lU89ZN#vYJ<3a{;8&vNpZ(iSPS2IA1_iC^ zg;V?G$|NcyH2f1TK_*uC{z&BSz;r$tV|4tLE}HB@%*>>eKzDRFjX%F2k_xr z+VVSo@*6Y%kC=6+TC)U1BzgQxYyzJvno(f z%yf92yYkRCW?`LY3@aG@npu@++}xwf955@^VEMT}?5opiwr$T*dZZ-fvY|`oz)e2u z9vdBtaJ?1x`K);&bwoJ0i?$u+Qx;i$rm6AmhQ9|`xKA@VpUJs5jZvdS?7@Pse*?=4 zjLu!sG3waS!6v9<$-QFxVLoO4(7TdpIIP^817(=C;Mcn|!TmKJ#A zf$NslWl~2Ld^@aTd~UOTLI*R$5k>}veH~GZSLZo*d3jHHyK3q4hAii$0{j=nFK)Y~ zxqIK6(UU;?sZ#C3@`i(F*_?x`KfudS7FVr9ZkJW3>zXY8OKIXETy!ho1peE=9YZ zfy&C@rJ_^!-rBR071V^tTE7!qF=d{uFQ0w5N|)&*_$gI!Y$&o4QQvg=X|$(3SIy3=HWZy(f(oHZQKTRG!CJtLUNW`dHwNfy0GO zE6p0C)VL!;>dIeaGR3-RTI|1-+HjN4{KOj#(OsRh=JuXS;3;l?y6NV1k=2!woLjlX zHc8(-c&F})`|`#LsTSFiTT5ODT}$)p-#IyEn#sG<`aVlqI```>IvSAqWvcbbRL{rz z{v2}gs*l>)A?D0eaO=oi7l(~U;u%xBoir9-=w-g$|2_ZupYk0X!CTH0lt;0K;kvn(`&yG6@{W_utCI}0g9uktDAfv!qYz_ZSRckPO+!9|dut?JPia?o!!V7jjk-INi z+BT#f*%I7x$))v(o2zMyEZgZ`>6Ef5D>)aYh0hj}d|WC~CZVw6|Cf&{u3IMD42=80 zWV-tfe-(p;f^)-$!winP%k<0`LV1s-#WQa8Uw!yQept4}h7J2%Sq`-)hEI#Sxv-3L zTT*TJsmbk$R~N7tHR~#`l4qF1SbH?{@hVY;dpc81^$v;XGM`Jl;k9y8#R(5{wKY;A zRy?QsU!8T*e&sr2QEE-0a89qPs!9i|u(;|UEk#EeBQE=ds|;@sZ{W9OR26ApY6_ln zIDwyO>m7ynN?QA^znC<>J8$9bnmL^@&H8Ofz^oN}`gjVN7>+SAFw9Mv(!D{ntJx(k zO}_o$s>UNSY^#^$U2>_t!WrK1Ced-BOtTr=ZT`ZDgbD-Jh@ynW4YTCJ`_9@XNbx$P zm~iQ8XxwF6ox{Iny|kdr^p#@!X4naNH@OQM->B=T-)zxc1xm1+EqKCsm8Qvk3oPB* z7L^zEBWdk%h6)S4LWws92SiRcx^Jiem&FeXwdCFyIBl${2)LByn6B9s zsK4aVjuh?#d$c`Q#v#u4f8)j`5J(hnXv0*{Z%sY2Nd|&4s_MAzl7jdy}nWURA)rV1Ynrg~qJ~WLv|h-o-s6~D=0v207`S{<=s_rY(Uv4M0&*^CSc;iCd~xdl%g zaB7Kr!611fv4M%<1nB<9uO}jBUK4b>H1FPe7KXOB>?`gG23=6xd^ny_w=eA1l!nQX zr_LrZ|5Wn1xTtgI?S|OMtW+5V=ID+4T%Ycr&=}f0V?v{8Qf6>U+C+IHVdW#w5*BAJ zo_uWIxk=wv{Qc#uqd2jZx4QXU5bK^UO@lUGf$K(3;z3=YkP`>iY5%(C8Y3xdv>_`% z#Aw3=0gofBk~iELZw5X4w{tCH5?@Nf^{0D3h$lAaJ~m28xazPuO!ivlC42S9I?%YIEL@)lkHx^PZ2FLBxBO zU|NUjvi1lkC2r|&Vy`E$-2|1i!t6$%$|X_quulxbX$8&0o5JRuQj9R2FvEGn9=DJU zTQoh)Sf?;fI<>`#ajr3+R#apN-@#os-bbj+J($3?Np8}&RhyPByLRx~W8WvQKivaG zyUGE@2vdzyiV-KgvL>3(x|8xKN&m2u=z6;&TYob){VOvlGU|4Lf>ADf?(TdfhTF(Ki%VA|nOMxH}e?SHxh zZmck3G;$HU_LI?s$w2Dn^y96<{o%JJ3V$g2CA+`yTe}i(XQd4D?S2F4O*}KUu>QDPA;=XSqV_F;?e!l9DMpFjH=tp@<8MlzuQ)(8|VG~fYgI>nU`#JyKq-zjl51M3L^MUYG3Zk&c<-H|Ls!OyoPbmR{o zE58%EY^vUjGY&Bio~gZBwpUJD+jflAATE+)>&lfyjBCWFSSzSJWx8>S-LN^7d5N_6 zwoB?qq#iMKo#-~WDh6_CPVdxH>=Pcg9u3)WJIg}lDf5j}zq{F2vx%oC#O5s7w30z{ z$>9_EVp>Z2heULh`jXgoZ@O~of*3!zy&xpQAIAGZoPS%7#M=C>6UIuJZ(i&0mbgqh zwan@JPP=r;M~e;?g58)T#=q^@B%x5n!#*)9cw{CCg(hm-F9=V(%HVXg`KfF!TdkDB zI%yYXhEt3T3~?rp%VNJT zEd}NITOXy%CU%m{sbDB5qfN%^OtW+IfH@(<8Jw^ zIKw@gJJPjpXogRi@+?%_{;ByIDVYc6Z+5W>R)UP%^`|Yg`Ou%X)*GD%3^d*xR&RZ{ z>DYv#{JmKW%@Hf)w$}FB_LeTzkUFrSM7rC}cLUd!&5n)^j60SHT-Q@(>t={qGUImY zhJ~ID-aN&-dpfR*?`AWo_!eXy?j8HQg1yKu^^=RO#+HfmgYaLL|0a+>Y( zPusUMYKKW{Y1=1nV?CzL-8g@1+Jl>VvtD!?ow>%rR8V*#R%sTWlL)6EgSfifV7&#?!y}rM9GKooUm=4T(pcC$NRd zGH@Q7xa-L|-)YudEB1>dG3m)1ImE}z@^#|3H~IWgysa(a*&G`;++x<%*sZbudTXCw&B^#5cTKPbwXIRXW9Q`7Ilb= zv5Xe*)VXlg>h7BjhbORB7BWmw2$F5H-s@()>0s#L)~aa=1*}U;T3ut-KI8htuC*mNM8MNj_d?g%ScM%&HJ;r$({S93VJV~QW3l8ZHzN-$ z=e_wcJmSmMB&LZv%y;acT4oeK-*il-R<2uREw*6}gcq5){wr?|Fk=x+FHw z6`Z_<1(>6Y?U@+PfbM_alN52jX=>2Bjl$~`G*7M$V`DblkhOr{a6{GZe@W~1J!>+J z?W{b@eOq5OWzUL_XPb0Sb#K@-ZDyB5gy{`e9-a3mW{XBl5l?*0A*mm?j3X)GDuYXN zQ|poNMFvR;zdx?dlv;diy^h7Kh0{;=c&!Nw^xVDDk6CqxkVvC!pmc0~DpTSNWUCyh?+FTzj%y_N7=@ydl7RXO9U8(I#?o5x7laBDGr zPqPn5>DbY0@$$x5%gt@3&qKMJB8!_!oe!jP3x3}DO2Pca^uD=Msv1kxoEC|kX!!e^ z=>S{8A6~~dORjLQX?QEUNSW>1dv06j9SL~h zZn*g*a{lI=%M47M(t6P#Fa28G+|}^(QdUaE-P@Tn-X%0Xmtx$((V^+Eig|-TD^oxN z3%4W_!&ycKhMrjGrq&R*OncdF@^M>&Z!FqSd4MNi^|p+IWmo;yo{ic4BIV$f&Absa zcD?&*q!Y`0rpj^WEUldjd)N$g53%&fx^7K^Sy$62rOxUpRna=-x4ZLwHjaRKT-N4XxlTByExxUt@6U|Rn39h%^ zV9cg4FDq-|%TvqZ0xpR-1>7=B|M{I&XWpd_%hQMaBm+1+wZnTW?!NZ+;ha6!T~TK3 zmR0kv@3njN+WV=_z88}(tu8yoQJ6cMVKSqF@!dm38V7dH-jI6besWaqTutu?y`>`3 zIq%}U*56urBqzt|L(hvdT`U}0Ow-&}E9F((U1}C`WPSGA4y(U16GMn4hV@n)TL>9@T#89%CL+hHG(nwI5r1g z6PXlri?wK5B~PBhyu8(pP9jmFg@<43l`6VKY+!3Mm6+=4n7jC4?eYe@>>gGVXF>Bl z?;_@2bWTutVg%-VZEX*c*~^&1uMo{9;mydnW5$`aGj&CC)nm2V13a#G zKJ2=FbK{D0emD1c-F8}dd3|nX+@2S+MYzHbbg$^1Hea}VpXb3_PbvjXn-k8(&DFJ2 zaCWiWZqdC}dT*kVZi?~p89$g9&M`7Dh&nihgk1@owPM1h7vjgw%72_&8@D|$^8j}= z+di()AAXE${Th!lEa#VD9ga=^Q0#x?F!rJn0qr98Lt{WjLUBdxHa`Qp`}$nQ#P3QsFkDI5&* zntIgv-bJf5QXY#+ZHyqPd?!1=R zKZ`qIUus3MAXocEmhZRRc}hDBq+~ChX@AKkB7R`qfld2&abJ?(qCBO**^v_{-0Exp$PvS~6y zQlhph^Gs(ymW>;-9=P93xPEo-f#^!{p4BZhoN-bsf zfPCwrB(^Qc>w}_l_o5A13W8mS)^Y!P05a+zNaE86MSkbN2-69RHQwxU;g18ky)!^$ zThOErir<|ABTN~DT@$ZgE&Koq(i4Fq+k*T)DAuim{=M+fmj`KA#TYB+CM7aXsFh)qSbJobXh`8hm;U?bXG$Xya83HTC&%0? zH6_4qc-F?ky+EKaUi!`XEdlaB6jpx{Rk++dJ2aZ*$=)tiMu%^OED2kbuBbL?>CJiZ z@wa6$^J30-Tl*zm2_&{SF&t<7JlAsaZMDyRB5e=y?)=awXLSZAO7})qCWZ@)3=Dw< zNgn10AU+J$fcRvS*1E53stXSs5}CjdP#agSwqan633bc5)D35AIT?@@WwdM{U>lo>O|d z;y{c7LD1 zb#UQh%+9fDN5P`w@1LLHMa26)V^Bt2Q`PpvV6FI+@cyZn4V;$mORQhkTFuO|bw&FU zf0r)|OYi82uZs8QsSWvf6HdUS>Vp+$j_4B^+ zE#qKfxX8%BaG-wfhsCvtitVOKmG?FX6zpf}-xRCEH-Ue9qiR*#^#vtOvR9Km|8gC> za+_b^O1P+?v>5w}F4ZrqL*l<(dsf7@L#JJ&<2GLA&oM26+RAmI zq8E%s%HIh`WnMnx5juOL$=9ew>I`!>Z#C!p8nsA*bqmX_^R-U%7qp5_aqEBj&D(6v z*?zNG-`v*5dHZND_!r=Pe&g{CLaiEGuDF`8ei6^gjI)&pTh!3`Uw@J20P-#j4t1@%Cy4qCP ztQbx6JyTWYCiF_ZI8#@eku-hdg5A@(zopIy^|G9j*qYkSCl}3TF}t60-|2hLq=M5A zKPuf^t$4yO@k_GEoML|sopozYZJ1HKm+{Z(Yfk@fZQUEgFvakU*3uZy#I1b#OEtIg z6f73jEy__4@UBq1;63l*Ia8S)mW@-I$^}F;0=-U5^gpWS(LV9MjuBrRD2NxCA8C!f zSw7u$s$I^}TTf5sy*#|?VBO2Z(;E4EZo1?|>^bMQb9$m~sgKqvv12T_NzYBP8wMK_{jIB=eyEzhs!CCZx;0Dp`>FUZgENi6RSTb$n zsY%Gw=!l5%oRXNBy4rCq@50m5R{JGP7mVNVb49}a?zp)J@4Bz)dd{zaLVn$0x>V&Qx4@=wYcr3J>W_BN{DUVJof4WBwyi>R+pM@3Dp#+FZ*N++ zwR^*Z6LGGdoPLZ;CJ8LhdANG3V$sd4@0)Yq?wcye#F=ySo7MEKjGSwv8u*1GOhvDI zIz2K17p=)lA=V#X#c-X8;W8rw1HXFC;)k&tb+0k(m^1UryW`xe*<;jV-Xz*=z0A9B z!UP!&CvZuoUg1`frdY_M)%45M{^rc5uhZ`+AKMH!<~;!`kOE1C~%x% zZ14FuSMbhS@f(NTRyS+@{LZ?PSL$JC&ju-zbL*M}_g7t+5HHrn_glk-VNb`biyt=4 zD!t*Z$o9bX%5$~lY`zjchAq6^>zzs`9~4Qkb^+_pu_JoH-OY%S&Z z1p6cRJ}a$0{`#E2Vosh@htA;9knAyaqW*?I@f$0aoOtzdm+_GdrqwwOw^<%>O%N>G z8sxyla0PV#r;UV9SQNFV~+sAwGqz^~4sfO;vl|@fgmESSShd<6iX# zKksZ8tr1(n@jXl=D$anIYceWyfajk|{&K9(^;pDl3w{3a;@NvlHGT-TlByK@x%jBE=MNF-6)+~ zbJsQIXJc|}?Dd!D^&Xv4xS*M^^?99SY*oU3v)#h}WfxgP7aP}ZG%ETf@>S98{FB%P zU^2liXMWy0oyQMX-^|<+^eg0~R1D`DsV~#yZWtBtSJQK%E-X*hiUcRZx>7sYAYYn-yo{J<&!~OV<@xb{sYq*nZtHO`f2GMVu(KWgEfq| z?E|;Yk%d#-XRWYG+IY6ebfs<6QL{ibUy=Jd!J?oc+sQ}tH)JvB?LT1mD*GNoq3o(1 z9LzbAZ-26e@ydKYojsp%gTTxt|36IL9OoWR`r@1@#&~<}mZ$~KfcB#(CK zbq=a$loFg*v$(#g`_iY>JD;mW;ET%vkH_zKv=-cO6!2L06;z@BIp%uJmHi+q$8Gj) zryiP#Y(CJPwOZ4%{q~chcef`kNpy5wk^lZC)581rHXq~HxBudM>cF$@Awnhxr#*^bT9qmh6C-*}dWukMz?7I5t)_+cHJR+%CBRREo#UGFYd4|P|NjvWa=!Cv8*6jYM zKlxOeJ=@(6f(LupOc*}9u^9h4#o!}lr!-^sdDZOd4;x~*zQuA+yI>jP>NUePV>!>= zNdf9Y`^0pvSo_3si=8r)-Y2HBec>V>t=WJ1f^LSasNTHgOQqno?LK!kB1|t->PF-_ zx9&3MUI6YkU5@7tN)x@{|G@6wS5Sw3{r8?NtC=KPwg&I#XqCP4 zNuu!0V~ztER`DyGV=O*aEWKM4oI0ClrO_wWFrGt^?g4!6m(BmLbCVUGZStdSjrbIc z)&voiM20u#GrV$F1UTGW@_G?}M_dczHXaoT2JVlVzV0%+%{Iu~o$~DAMX!^As^SM3 zB1}KDGj0%QZxUoq*!d>Z;JyxLEl9_i5T1ssc^RoCJPo1D6F!LOCl!L2UWxFtGomDgl& zX}41sz`Ybji%nxxGGkZN7U!+Kgo} z+m$_DM=fA9nO|zs`lRiWR?M3^l|MFXjyYa!R&!&C%i;n}8>hMmh)0+*g!?9*?qK(s z&(@HXzkhObx~%Wd8PT_QGCSunw3y~S6*|Gb4YW+g_Nqu2uZh#=gr9+~EoM^=>UE^0 z>D4M}De(h8zQ+F%U$|lAnibu} zIfx+AJhSjv&6dZvcs&$!-)@Twn6|8;XM66Uf2&%52^?nH$RL>+&T7E1dc_ZYr^Mf% zSMVIUbzHFFV#&UM_8*E2vl+p&w7TY@s?0IoQzzS@{ zJz*kS1jFRmiu72}&|7Pw0H{)%bx!=1fViIxQ`Yu7AyYdtK`A𝔧S;==`UA9d72t zdbiDX1+{zAm&A%5P|*3lST#G>|U{y8^#+hBSlOJbk@TM1g7eV(VK^}`2~7pK?p>Tv2WspR;uTIHd0oiy)i zHVacJF{6V&FJ(mNRf}@m)v-!g2C8!A_O^lYj(cxgX!F9}wx_0M0R2 zMVPvVP7vU$3k7AK*)s!EH+#L1ROFh**FS$>9m4`f(1?o3T>UGGdUGmRF6Hf9sg+*g z35qP?AJf34!}2v<0XKLmlxAE34J|DD+-h|M7O$y1`k=sl%JDs@BCqOGx(VaFQkJ!R zkBbUcrzZUs%{f}9Ui2zwLsrB4n+c~6FxtG%h}u@1{^YFg%G*0XhdaCtWI5WB{#fp3 z>LD55;Pr>4M6%_NPq>;G!3&8R;H*)>$=(6L2IOX z*!?z4h}-yU#+7xvIZG2FW*uMJuw;$M+87~|1FIY(r4tl)DhgK2=bd&sj`j1|U2b=} znHX+@+J6V8&7Ar2aF+QNqgk5|u44SOp7k_nIdN{j=(-NGC!rlzFK(C+t9Wd2;?)vy zwG?e}4^T<@Uh-BS!xXz&uX-mw6mw!KXku}4KkVedweWdHglX^gRhlKqlcQ%FxL zpvV5OS+c+cP%7AIa!_;GQA-ZE)W_7qci6xVWyEqpsycnnfH?dFeNX>?0sW4{WI zA=CP}0H>Gzt(q+7dO@R9rN)U3r$ZK9wO_;7v*j48L7imwOIMAYNlC8W>yZ}us~~ZuV8hE z!4ZxYHu$tMEVc#@|5>bA*uG>{THN<}1$^Sy0v9MToPH&v_iC|&>w!It5n;~@ zmddbdF+Jlwu*s@j`;SI|U_)vtU-*l_1xf}>G8m>^wTy{57!@EW(R7>f^eZNYTZ{}0 zGV4|sv57K%W=n{idw6TT$O?`b=39d6`#e@~?7f>9%WGT67hdVlC<-?Ir##&F?6(>L zf(H2+%Ri=jtmruTZo|4ZkfSaIE>K#L|4rx7HU|au7rhU^@>x3eZ@63Z#91gyc^+d4 zpZN2@1xi=8f6sAvvHkm-tJ|43adb|4rnfbBEeBHnbeDjPaS(0G(vB%2O8lu6Ds; zqT-R|6F~N3XpLmT0;xVo-dyp=F+R*#0n6Mp4Em zt<5tRNPP93`zCR*X>elkY^(3C+xaz1y<#?2-QEj2tUxoMv8iL1(|trpP9yxy`Jlgt}~dpjcqy7z%<1HlsqR~)ZtOqWjL_vpxuN+>#{e!0L_YLPH0{mv1}@Pvq%`P+k``}I*yucReW5< z(w+NmU;S0S2`w@@ElWfi>@7_`9Cy+Xb?8~kCg8v~ZTU5Z>6wM*-IF4BfgIfF$hDen zvjf*^w&xC9r-QQ_PH)*U`)JS?SBZqv5BP#2Of?$kBwl4OVpzt=(H%fd?f-e}i%juB1=PeaXj;EL81UG*fXrZtpVW8a~5r$4?C zPwb6W``(z?pTm`KVzEw3*M^z;pslG}1HZUx+}X6VVx6>4NI+X!0H4~lkB_w1NPT&v z{btvp^L2vPcBHm_6x|lYh&+W11x;F zAIPmSt78dm(OkS$NV#UGR)b^2{6+ds597`rEsjlJ)U?T{d6V(RnwIq&vH}=Y6R)eX z90JW4RrZNB+lFa19E_Zmz8~swt4Hnut}~3Hv<(l5_p%zKM0kRvRu}5cd#xudI%VfV zwx_8{KdZ|lOeHp0zuEP`aR+Eps=2HkVo(uCH8=#bob*;G`ADvvD)Er}Khuq^VK;8- zJ3ag~zx%mWLnqg%t5+7V%!sJtsEIITn909ePbw5V&-S*weeIOoZVA;5jK>zd=UdJ8 zX#1gc-qUXDAClV6bE4*k*UwoIZvRXZuReJBZo_LW)`y^Ztd9F!(VFGLrv={dt!6v@ zZo`DLbAlNfT34*$0oA_iXWQJ(o$|&aTi}wZyY`DS5$zIR*d3yNYH&E|-qO-PbnVx+ zCUL?43=E+4V;l?&VZ15~3~!bRol{_{UK-jqHGaxYj#N)3hP#Xm4693bG_Nz*RXE2~ zD(S*v)9Z`e90js?^LKDWKhfZbbNRu{@a9yU_F`s+Fy1aEhHd{g?bJ?oKl!DsHZlCP zi}72H|8JD1*se{oyS{GI&pfLc2fvglPxDyK^E%ukPAe7%1@F zYTBu3ZnF1JdaMSe%^7AfEr$}L7``XeJ_!$Yosrc)72L$U1#V(aGFMcc!b-hg~&fma!J_Ut_GuT*VRmc4HK%15;!M?!fr? zboPF{!f<&0#VMy2bxBA)IB|jDaH3t{{ME^!9}G$^>+u#JmRrwoYFA3o!2{3wu3vej zWLW~r`p%{Y0(c!H3}eI(FFdW>$ash$`q@M_iB*l4Pa4Kt|G2Q*;J`FZ)=LH<&G)1d zR0>_4QvwMl=;1vOj#^dEwRabb>d-A=JuJPyGH84d|e&Gql>?+iMiO(o7OukU+iNW z*g~`D2vdQXx;lmd3~t{~i?)CK=bRq0H>OacGNSpS|ISASDI1f#YEO%{3wDVHas{lr z(Ql*Ee97DHn?Xvx*lDmCj3?bAOfOVy+i=7n%!Y~K9wP$-SJSRn;u(cask^SfP-y{e zgRthhc}CN|WgE{OwlY?OCx>&sf8wxqyPd`vcShjP*+)eeJ{a8odm%&d2G8cZ+u!%G z8m;15D0__a+2k});h5%M_crh3{XOfR&TL*#5!rlZZTeM)_UQ9MIvXxJMcw_T%-?Nr zt>pF1#1r?{+yg67-v4!tltS6-$fUGyJV)>CV>%_)+Tm8Ku;nkuQKz0u)@!5W?Avxs zF{@#i!3Z*v`QO^~s|Q+BD#RX1i^|?_zI@o{+WQ~w8ujAeeq`^9oDViM_*&WdRgJHs z&kHe2R?mLCdET?xTQ@xfEd{)=>+2e+nwgD3;?)w@Hj9YYQDyBo4;+NRmCNVGkVPB>lu&CURwA9ec60G*^5wKe7T)fDe1n_j7x6$$BN*X0P{8nnQnxongpL6-BSX!na-Z`?hZH>(|8JmJm+o%=Tv+Y2RDTShZ%KFr6=qFc&#=|}nl?xzRD zxgtdl={NMX*l-n!IJi6cUAW|Ow&5=aH}|@{hjN=LdwE5?HtO-;6mZ-)i|?jh=)2jW zPUkrSHxwLodcGaeEm*!&v_mi{X7@vFiA#B}S(h$5@JJ-7BK1c6R`3qGsTba6o{s2D z68(4^(XYIGhwBK3;kvsLqCA<~zcv|#CS2t*G`;{DaH!_xxVxsV4HQq$d{QG!XT(a1 zUHb05PWlbIw8+#|;`Q2xr%jBrd6o5J1!HM(tbg{33${kDClv5ptW{ZZ_!lD+!vjVJ z1~1Eu4zHf9_^mT8>@Zp*wIEb-8;{JhHO)Q0Oc+9(j~3qYW@gqu#1QRf{6qB3t~Im7 z3scV&hVce4HN}ccuz`lEeD&waf_a&_pYH7~dBJ8bb{Rf_G7eI2Jh7~Gb9vb8DVU}oFB zxQ_Zw>%Nv%a~;}|waNF@C6wl28rV6c=kC2+bLgHPJPiz-I4+FBaT^k=;KE=4}0Ps#f#yEUs(SoZJ5ehJ5flx@5Y|mcsp)I68JUHEfEv zpR@UD$V;h%drvHtX}WC&ngYq*Rb3fl@i9Z}*2+vv-u&P1+TFMh)?~*AJGuzuFP1#3 z!0}_f@bSLQe-FsK-r)Ad`rNcY!AvcV^-;d8?Be}K6OQ?(nuuOe_jhTEu+miZi*>9B z%+%7bDVVol+Rbl|#OCd4VptSEqwn&TzXxQzU%9Rl%aIJ7wycR^VSKiaNv^%Yai=Q7 zHDYUYCo_Hxyl9=v!Wgx`Wl3j-y}|KMRfbzYs^>3jV%Q$9dR1MqXn%k~LyOAZAK~jb zB&$CzkGXiXZpDW8QzF?;znLz#L+E1NoYG=@m&BV&Q`HvzwRrt(U;C;YQ!in#xa69t zSE8609x^g8OjBF*cf#^Ky3Diut2 z^US%jbg%x5d8(xoV`nE+WqoIQsvlu~>{{1Lr;Oi}zCtna^kI?yD2vsGHJ@(6PXO9O9&#L~6br(djVc;&{?y{x4Dea|=LoVO;sc&14t ztZCtLyj!j9&+Ev<@Q9ItL1zmWm!O8Kh=<$hj)R9ZCGIh-Ugmwrqr)weRewqM(p@_Z zH>B$Ep6^(>B1V4V1{p8q&0E#MlRQ@-KVuSa0)I>IFMu7+gRhcA~l6aJTX<5Ig@#fRK|4%?=xP$yhkp}oDgq` zVm;fvA$3LDgH$$?1FIO<@oqTc@Ur)wVuy~ho9zg~vyS0K zsrO+QcK>p^wst`{!%dG=|Kyn=X1{0MTeCVGl-!ly=0up@Ft^qTJb2A&jli8ihx-@n zQqylWMZBoaIwBV>%Jo8e*SdluJ3(WTEotqc%$#ZMvC}yoflqYEDvL0^U~ipMdL#5Q zlgpg$4V%OSKiy2!zLuTJah7j2+rRX7U1c`zQcJTewkv|S3xcIL{hRIT{vD*b=ibf4 zs|iJA5lM?uBNbm<-5aW2>!@=j31lnCeGCvgkEFMUGCzrzpSB_)KTuX7;<$i{faz6r z&YitQpFH$tbMYobDqj*m@@~4jqFAnzPNDyI#vHag6Rykl#DD6T@!)~;l*ah-z%36R zY|ed+0xr@0+fp2!$b z#&#;@irf4r(|1-?+~}FUdRgoF>7Z8Z%$YCK984>^W-(r!!klvO?13NqHyJBA)|N*u zZJ5RF&1$aKRZ-hsy6a+7#s-tc+<*Cg)a`MIyW^r{!G7BKRMX0G(ALczHK0h4Gy%EF z?a1rZ%btB_F`vBg__cjZzgSu&+%(gYrF&(5`B{J6JrA@E*=xzMbzlmuvcGW5W(^wKV^J)P2i`CkxK6 zm~~27*KvjDqBEd$!mRh`YbbNCK+OGD8&)s7%Dxelrj<$r*XJLtTKh))|&%P{y z*`3QmFH3X?-QjWId?>i$+BNAQh4AdD*ZtHLy$X~~3J<&9ft95tcidF^dIPLmH|R!g zkA${e@<`w9*(i%Yn#ywkvQaee%OV{1~DUrds6P}5*o$*5r7IAdvY=9P@& zY<|W^T%R*BJOSFr~hf26r? z(NwM#k|Kgf(iq;VR!umeAH(;yH6@|==j_~eZh_N50{*+W{kR36^4*V{;L%u+#lpC6 zs!nn{w*dF|;Po;}=e`;6*=-S@r0N#4kipSynnYpip&FMt4|l6HM)1wvz!lzpmp_cB zm@%pM;rGVUtZCm2{Q7vSl^(I=+8!trvMFCvSNei^1xIPvjQ2M~j$H6LSYRW|)tR{z zykh*(hAggc9>Rg%@24&a4#;qu)4f78pjPUblNOg_JO|ri&g%!iF|*|AOgX3VvUJ1W zgw|5Y=2eoNFQz9-zFKG(%n~qbx?Vi{ZT_%`?vI6;O21Mg+Nw0HyBNAob&18W-{wE@ z!I8-@Y*t5|WZA*pz3Pu%URb|z!4>A+U%3}JC@#N{$p})?*qi+Ls{fxaaY7MX>e1e*F=z(mA|B;?R=?iT2CAd)qQJZy1T$ z9L$^d9a4oilQR#TTcnt> zM((1-KG}Ju%QmFCfW`sOc&&N+aLuYoOB+iU_%;6UbMkxtkVWCr(%xg|3bYp3#e2rC zp2|`#5+J|+ioQo5OYO%v?!P_)v00n%hdX!&B>a^;zESFi(W7<_uBSSo%(wY}7Uqa8 z5d1J9lsVc>W=X4Xvp`mB#^vq}OCvl#C?zej>WGy!rYys9Tj#DzK8x^@`(?S$ZE=C#<@8{rUb2(i|bZjZTL? zuVgEeXy3?GQM0;HmW?Cpun6zG#aRit4E>A>{JSM&WdLPO8Lj*~Bp(6l*tcaqINwk}S80k#_x95+7Lt*W>;NmFZWzq&@#B`quSD0N$?6j-~@6yOsnw_&)AO6(;!X|Whv0$^o zsW)q6dz)mtSg(cYX}@C-Dr&mM#PE!ff#KydS+;erQUPdCPG_~)rC#Mec6qasTqgADVKCvUwHq+dd7T)?To!go0!7x>l=jLs5{{ER+mw2Z^xc~>$HON zXR6fS4;#)j1Tv&Zih3^!Y`XDRcg@-grW+i$`Sl$PdgnPi9MF<%s93ecwE99E$LcrN zW43NM%yG1-IOpw(L*E|Ht=gP!DX?w^N7a=#?MF5|2;PzR?yzzB(XXX^h4ZDoJalK< zw(saqZd=mR>9CNuEZFz8%p<$`S?{Op{+1zj!SY}2-59=z*3MbBryC27x-8g{@$J@x zGfbb(tNUJiW6pXqY{&KqGjv{fPgQMr13n?InTg>!==@i`<-D97oeL%%bbJ2educJm z2}g>YlOjH7o-XY8ZIR}2Y6geMtpxL{A}nv`7G0M+%VZV)T;Ti9c~8L_R?KUd7R@<9 zx1)8FyC>MLD8{comTMx{-BLKopFLgpG(!q|!0hN_MQdW4KbGj0iAFtDIGvdI_m|$R zKStA~<;s|!=~d@{^ZKaBu#VAo+LiTtB2}ixy1EB#4NSjzw(gvHZ(Mcb7R5~Ea#aT( z6RQ&&r+h0dX6L!UaOO=ztYpK9JB+W{m}i>pie)~f{5k%B(66cWWt%n}idlP8`>&k# zi|hP!%diT%(ZrN_$ynn>-q&#Ri?+X?#aqKaK|APY%p+6_2?04dC9&1={uB0$TQ6?wug+FBXE@yTOLg6(C!21E zU)ehGa%<}8cW;)=YEnG(Z0Ev7Y3GX+VhjbpthmYFnRsw{!QDIU>F>H;gJN#^*;D`K zwK>$zb-wfb@OLA2ArYA?Pn2#QD~w5f{r1kOx)b7;s&?l(u3$avqD|wKJ6d)f zC|YyAAu`YIVH=ai+QZx;ESol*d$E@%TQgdMnc)Q^1A|Rozs3LB!<<{zscldA;VQsw zs{bnK$SIEbE8MhBhn%@OYp>8E*$n|lS7(TwOl@)7A2My_4fe*T&(;-emVXelIell< z=K8gaJvQxI;(dk1_RU#-ERNf%y7PsH^X!9Gi{BgR1l;`faL=hf21$tl%o|Lyf6Pn$ zw%)?R{KHiS5w-$d&sl0ab%Gmb+1|YRy!f8U$F8LC#=@mCm+DM?BPz0{t|(l!`puO^ z%DlO3uY1%^ZP>8M_0Xy_=jZh4MK9ZZLhxaKQ(s8g@7qbfsoLVdzMqcSJ)`~UG4H_i zmf~kd2Tt+0^b|0=2{K&#BfjCrrm5@~QxaQ$&bzyB*ISd`!>sQ^;x3&q`rmqwVNCDI9?g_s(i-_JPzT5ozY980rws)_{NZ6BL ze)`h~P}Th+fLCV;bIc8&ZQ0D#j7DdgG>aE-cvdoQ+vI)qfD=PQxAu+1>ulRvTN00~ zy>{V349lcVtxKk+hA^*YQ*dTKeL25jhky)tE^P1B16orUmNJU?gfTNQykulx*u6FL z%h#X!U(}*Yd&Q1~6_jjV#2??%5wy5#W+3mHZ@&!p6#dUi*ebr<>BFfX9~wiOOH4P| zY|vzQWb|-Dw?JT4h+#%3^Xk249)37=t|sAXf`EJkOF)^!#~GS!Px<8SBc3xJ>Yvv3 z*XT{rPVp8V6}|O;5>gZj-MprqniU$dDkUUM)O%vY|E-T079?alPW z=m#eX5)>{rY~pca6PkW~m1Hv%*t;A*tcFhlxDc*iFis_*_OoO_7nONneDH#9;HYcWOA>vc%yVh zEVJEeMX#9I`M(qI^E0etG++Jn7pU`OxrUd!lTm!qmm6CfeHkU)Y?4hCR8qNaoI1WW zQBm;0r3d1>%{Fi;96q&X(dNAqrf?-_CvQ!>%Ft_;bH0x8d77g+_;d<||5+QdHpGiE zF}z}AV3@Z2-C3i_yFr~=SLrZbmz7+vrP{-8Uu@!C$2-mR)rNFdM_*Ru{j0RXmZ#}= ztZm3%#j|eJDxK+bW^pZ2UiYeFFVh+iIsYH4PJQFzd&T`WGTCFnnhSNgD^@CqMX_xC z61O(J>Coq2-7EUnm~U9u&z4%zY8s;}{=BQDB>XhjW3}mb?H(vPin!g* zR`i+EPAzG!e@Cg?_6f(L93%WEoSgS|YG`YlgU*7c#k<;WtzX8;z5kY|>4YsMNh(HG z5|`56JUvv`x;194;+Y(dRZXoOElfM#d}HL7+_YmegUcCq?n{1(mKq%98`kkpyPUQ` zhI`lXuw;QVPa^~je0d#y*6)g#sJ+gbr}EY5{31X8l73SYo)c?A7SHWtFtFUPf_>)H z@V8UA8a%K6YCAmHtY{un)P9xk5zHB@HlKT;tgF+uMCW4llf&{|4Z8&nENo*4H<7uw zGIt%LHG>bI&MU{Xr=iwQ84`q;_C>wFJ1OSc<&MIqIq@NN>m`!83Ut(7J=!o~_0pK7 z4tl$54>-5!ywhRu-W~P8_tMd6A=fTqD4b zCY*9@j#4$Ybum$%OUlYB+iIN)g9gzC;sUB4onsvRHazcbZx z71$lmy(iXzNk;e26TYzMPn&0DIc453(_3^lRZnUUxYO^kPMvJY=cBUNql^*Jydu9qQVSCbgJS-!2!VQq~Qmy?}NeK2!Hf`6sNwE}O>i)Ic%^FD3)#IQtR zO@y4m6LC!r?WOKhZA3LWt~w+wQFx*_@A>puQI(*58#xp_I-bYvdG}S2UH4xS!#18shqM3WvNI$mM6Q(95&NpJ`O~Vo-sXDnSO0Nhi8?05dAq+{tzE36;DwUbex4;;YB$+13N(l*wInJsUJ!a}FlqTs1_AMz zZJ^|3{AbI=tPc%#w?TFJJiS-lZyjs|=aw|iRbc31JT2tv(7IvuGPC)Cp;uctOE-$I zb!QMg)HCbW@xb_WE5BVU^#A5IbiG)@EpY9+nS*P8p%7?a_@aZ63zQNjPPyj9vQ6HI z^*~UR&;1*JKP;NNsBH3+#*Bs?^JG9PHD-RvRKA+9^>|um=kg_YRd$}Oi)S=FeI|!t z)9Tr7@#fPRHnl$u_;nx=bZW#2v1vYnT>;`|x%z*PPiG z>TVpp*`+vDwD+O&Cnkosj0_C+-MkMPTUmsn1U80WoVu)`Crj3~D00jBn$6ox_JC@I z|0gm+nKw+hxN6xuEta{yi{JD5%&LxHpP~e^*M-wado}CKwGxMVmVH*N4x7f}EG_Tq zrd@s@VG`4mAd5)T>7b1)f=*8hA0AoEskDgkmafMH?}IU=pi1_!Ip0F(#jPEUx3Ax{lRIdaitrM5K<|I&8ks6?d}Ph1$`9GtzQ*Y$VS#)!oZXB2j>S-4U(V$Q`? zi#+wZzg730HEq*4VDbEVaIt(_y(l_@jGb|2$-us+WRNOC-kMZNo z?&rJ2URIn({GsQVZStcy zZ@-aIgt1`ytXsM(5-;kk>{H$`@k_S2qGS9TXP#%FcXi&JiAfjfZaFTjQQ~@6=Z!{3 zdc$ciR)?@{moF?5*>gFgmTTTLjehlj7aDig%zgywUZ0V1DU3Ds;8+@b_m;`8d!T)C z33WO~b)ZS#Gh3u%!g&|CzYN)K)+?7%=1>}@&&wWl$LGp{x{d<{3Qi)|Wp6lrJUi>b zcTjuyfX3WaQX-BoLn>$SG8A%t{0+)E%NCWa%G%IV)rLB zAnU{GFAtrs^)m=)t2$17qr&8HCGJ+#<4*14&6)~fYw`ns8ZbG8Fdq?MP+C80b|_z- z9_XSJ3nmAfEWL)G*W9yh7CxKk{jjZjQuBT;FaA1vhRuv#e0C`p1R0W+s;rpAufX8) zcIj%8HEvENSVsJ5?V99W#ecl09CWiN*`Je5vg?w8iT5rfac(e0$@D=tQ zf1cU18A<AR)P-0DcB84a6U>^ zI#o$$kFxz)!7Rlnk?Qf!T5ryavoWPJ&L1s~<*65)qWniI`Nss)Ql4l{)m2Z5We;a% zb6g5LcHeN#x4@32Ue`7zN0>IOOOCiFx4vP=igIuxxmNb@CvchR`>?g`Q?}_Jt>7OM zgx^SP3-Ss%S#8~R^_swvwSOAw4rj@?Myz^L$;-N$?Voj9ZG?~D^s}`O;);WcK^6Iq zQl4sr+ukZLEMt^9Re!uyc<;>Be4lq#tm}TTzUfj+d@75)QIzcAFt1K6$&-DF*SB`h z=-#nONA~c#*Kfb==+I_PKd{R2uAxr8p5i(g22dYw=KP(9ATA7j0CHhj^OBGU&V9Us zH$Xwh-^TG~*EWUNBU2ADF??WTU;y!%K>WXsEMdGQEgWkEy+6!dz3iy(FHr3o%%ikH z^!Do*Hvy#$Sqp4k64=AE7EB9X%vz~1&takVf~!GwA&zk|2gMu>T{kbW>U-dJY5ng{ zVmh1Icf6mMTpT<9jOv87*O@=EaHSs)iVRuU964M5uB6E81)fEbAqP8ILv$2R+}zsu zR)i;8V}F(@MDSv*J#!L{TP>+`H8o)sM`ix-vO;&yY; z=$U-LGKS~2qw9oSK3xwwzfENfzY+Q3$l59ML&I78bDqfPEqc2^DPf;lx3JCHg^ySQ zn||M8xWdyZl^s{k5S4k{LSv4oI!DNa6&s(GzCURhbL6(8>yF5-4ser}ciqXBRR_Q9 zn7S+MxTy`J%W1F8d-dv%fTjj{W)%x_wNB&nczdg(Ev@oz>|x<~Ek~q66_i_|S4uf_ zM{6oRkkR9jV;5bR*8*PbeY-3`aEfGQ)0BfDtijIgPabILHmM&o-FsFzDR52G%7v?| zH#aGOvIh?n!$(F2hIc!ru5#p5SvzI7kK#P_S8-aGxfF7Q4bA#arba2wy;ADIINL8r zm7^1V zim20B9E(`K?`2#eDP($W&pTVigS_G@+&(M`J9F<89Nc)oWx}a-P4YSF&+=q8Z%Cfo zx#h=(!ZYjV-F0w3va$BLa7ln(e?Q{_DU)4_ckl41ZFf6S)hN25P^pdY)ZgDs4rUC} z4QGvxv>pc!k%-*1SSHnw5s|#^bQ!~R##c_D_L*d%^zo49pJKmeWEs>vp0VUOZ#X-* z4@=J485XirezP9AMi%43ixhYxnOSgLLX1|?( zHoUC9Q*d{~0ha^UMAnrAyb~AjW|ocUlFIq!)d@PUDKl%s&ZSRQ9$e76Ch z_H0-pl99N4jz-H821!nf6a2IH9p@GQW#-^&k&?$YIa)bo?*g6`2h-Lc(PUZ3P{nES z<9ln>=KK}2m&M%7aCyzGkhJ`ZX3J6rcTS5RAa}A~TUg^0yy(u_!Ygmstu|P-7Kl91 zV`NvG)28OGrnS>YS-I)BMn;|7KLdQVR>`SXvw9m$atMdf1zB6Ao z=jPo6Dx;sRW|0YD-k|y*A@NjLenMUV|I1m6MMK_;Gf&+<&5$QY(opM0O#MxLKIto; zT-7s=TrxVvHqV3kYPj^1k1g&87!r2y9^D!|aS`i#Gf=zy=uT0V0Fjz$4b82Z(R($O zmL9rv@LO}}-8)yWvwx~Mq}-6xFm(dcf@$m04lX-(wuvJWR2VI`p7$JLeRlXDC zTJZc?*s2+AdxDoMLp->~D|Tz_hSVb~5{myWWon(hblEjfHtn%^z#rQDvoZq|HVlt6 zWxjD1XtKU%xXtfVob0c8*;h>LsgEKj>!w9tH_ESR+~g~GVbgLMpN>{n$yrP$eT~=L z^=AKN-m!6c3`lI}>`xN@uCJ5r_h?UKOqja+9mwy^o36L7I>@laZk47NcgxI8SEV(0 z3Vt0>-0=6r^RtKMp9LKZ?UzxzW=g<`qo0(w*sW?5iITs%Wd$n}$Kp`ggwreXm*4xW zaMeU))5*2H0>|4*<}x#UW@KPcb(<%HewdY&;|Uf=x;6Evvr~ z7lY)d(=jGCIczwWTW_& z(46Yc2hzZm-0=&)R_vYrICV~!7eCnW2QKWOQ=!Nhd&!whnHYVC{ znqVRSZ1&exU%L%lPd|t_bJI(6c7)z)tJQ2B=OX16Jp9y{|HEUu=f$ZJoq;R;CY|=` zRhSwt_O7wQsbcO~R}+r-vs(%_PfIHnT$UmEap~q7hDgf>b~B@eTWb~Oz3?&CP!>M@ z`<>9`bn(x&^KP(quFeB*$cuabvE|m2^&vhX0k=MCi3*=Kd?ysl8&uxODfyuD=+q|* zQ#wzJD4D;uoDFhT&0g;_T}PuUU&JQ;0^Noryj!90YHmgh!{h6oX&*oat$DD%=~GjD zDy#e__wvq_Yy!Kyee|?Vom}c76I?&EG<5uSHF@cfX7xJFGV|}J9>zl=x}RU@8UAG0 zRK&oa^NzjSG?2x=gyBc%v$}#4Q6`30AB0ao@+35wVTVtw=~}n7@hzHBY+rUCS#zU& z`ez%VVBTeOJwX<{y0^~fNE{Qx7e)q#7R{(-A7YcPMXZdOt|L|^XmfF^L;TZSPbTbU z591B8-VhU(9T?coqVDDPQ87o z*u0&2HCt7ALS+ok0TZ{jZUMHVL6K)RHAfpi_EXkw7EYiCv6W6Lvp6Qhx7m z0@vhIKYF_@0%9sPssz7=-d(}c{`rX8haTy5`FxFC3+ik)hA&)QCz-13KjnM+N1ne{ zIr?|@2~`SYoO#Dm=W3^!_G8zIoauqZ^H#Q)2HezJ{OrTJcwGt4CsSs17Rl%otq6OQ zuzkbf3GC79Wf+2Iv!~p8#P`KGE&A=3(%EKHwri=ZT;}Pc^dipk`_j$Rc72n1+<8o1 zx|{JC!;LzQyJoh@LI=+lJO~$w`lj^Zb@#V)#zXc@3||=;7|zTC@1u(ot_^I5ooFk3 z?N(xNa2O+F=BX3nH`L5N&I(-q(|$4MrvyPUSM56!uFp*r^U(}A;gWf{Y_@gHfsme6 zUCfnAdsRzs7AW{HscuMTJT$d|?b&9Ahxg~Qa@YrN>=QgG9MqJudd7!H@#|%Rq5%sy zvtu7vZJBxJ&>_v*2PQ8M`A7?;aX387_{Ak1X2a58e3r3u?Xu&)6e^ZaxwD<~=i@f- z80P@N9p=9qm7E`&B`rxdett&k+MMN@9BF4IliIljjKqwXd;{5p%voX@1Pte|R+5!= zyBFi5rR)=P=2A>fohv&tBk%c!j8mJex_gBMd#*^hT#bCAxRvp-3TVhji(PO9hx9L} z+TUW*kfkk0a*teu_Tff@*Wz93Q|NV(e zdG{P@yXLfi)7%>?^8$1m4nE%$YIpz5(u8$Zrn<}HyD~O3)@=DOA@j>;|N9!Jo*lc} zS^YwK<*Iq!=l3l(sn(Q!#y4aCIW{e$bUC9XTOZ$gF-h_5wz!13opu|#Y;W(+N-VO{ zi+(p~7a4a;83%wG z8^6BI>+Nbg>(-ICpz3f;pVf@SX3^>Mo_h9PVw3wHt~2e#=9{3FrC#2S0z+o#Qc{sT z=Hq*Jnp!bTXDkID0-Cd(Y5UgSidPoQ?q;-3W{~hz2upTO3S+-fm(b^{SIe;NbccjN zFI$?5tb5VRxoO8zS2L|sWbItyu;yISV-*`^tIb^o%%Tg=rRi-Fvu5=_d+);4saDTJ z6PVZV`rSyhx%x1Sf5P0Zw0sNEfXT}bJX;&kGka;HY7SSNlV#%R1MHEZu{n=IPr2Mm zdbc&0lWmfXg0Md)U&$p?@kDQ}=-*r!;)g?z8iYNYw(!R7^$*RqeY=_zIK|IPcSzy!c-qY4cFU#MK^DSJJc=~XkoJPO0eJ&xMJ73 zVM^D6gzwBOrpklN?;iVq3nqgoMh83p6`+mc9>(&yIy|j)$Njm( z8Rkvs7h}58w;@usr23Z8GC#ex=AiF+xAvC_N-StR5yN8C-H>SaJR)eBh*8k1jcnf*zur?;)i=GVfZ5wzo97W| zaSG2nj>Di11^?~Uuj(15Gn#Yrg2m4ywj^F;g`C2h-wB_SF|mXxqJoQT_+a#))YqP2wMaGu_#MNc~UGT2fxk|IOaZMb#X@2pMX zQ`7JW(}qV}r&k{n5SN|%3e=cWD`;IC!MuGQOjrX;2n2An>j0BSz6nXdyK ze#m`j8r!s21*_Rl@I82>R{EZ0&9V~F#R|V49?ps@o230_dZM;}=DnZVvleZdd0C;S z=?%NK&Q#Ik%!W7g4~Ol$w5RxC-l^Oxyo(ju8JkNTG&$WIrBb%8>S~N%D7M<*+8WV= zb&_K8-3EF`M89P}SkGxATWEQ}L9ln1#rq~1HXgC0DWaJynG>$A(qgM)<%-x*Sif#V zeB06EmwG-v7WC%!`cvoC!Nn$WoF8PCwWvIQzJ}2oEBWO`sVfL^;OJwTz?l^Ju-3L7|7A< z>5(#Ji=M@%%N!B&|G(rleg1NPq^moqjqFq3mvHsKPaYkA#tmS7O~pI*{p5w7yqj^y z&BvNoYt;g6v!GY3-xLZNSBXco^iJE#De#j?bi+&6Z33L;8+gn(PlhVTeV=#0GG^^T zc4%o}lBc|EZj)H(1yO0uuT0ewb}(G!*4dTGbd`I}F}K${1%Bp6DTOy?dRI>Ns|X-n|$MO?x#HXz@s_g*uHx#QZFVjeJ$Y&x7@)fx^OO+(>#SM zP63_*dK=nxyR|KZYko6ri(+yWZIQmgZ^#RF|F1{Ajv6ioqAk-ad7Kibt$g72ydd~gTe7}=Wvafh=~}nek8i9wTNAppILtT5CrM3O?Y8Hgt!2Bn&;^+l z9B;31ePUTSs}}71suRLBzYqBeuK+Kn=VtxHa(`cguO9Q^g$j2L6y2zc2Ceb@&SC-4 z%f#>#bpHRH*?%1-E-aKbe0xR52_*;*xoKNB3)VDp-S`p|87z>OAekcsvE8vrdRtVfL&UaGp#-{1g+>()Df%3YxMl#xEj#g)QI!|9a z%XMcD$Ky-eGn6JqZpbcPJ@s|uhAahLiETWZ|Er2uuM|GDPm-^k1*B5w{+^CTHxI9F zwF&>dZfxCo^;E#_gsTkmV>hIF{7gQ4w5Ge|soBr>&nejMr8+AHU0exApfRk@Pp*T403|Al9-L;%02Toa{an0^4rp$ zVI$)PH|6%Y+}f=UGV@+s=G<^n{)UcD(Xep@o*B$ z7FN)b+qI2K&Km~DUZf`uT+cr)s;$)T$yca-FH^?tMA-34ZV>; ztg~-lIT_z*Y2EOKk=cZyI9UC}8^+m>_?FCkv}k{xlojKq>(Z-MZeGO1@QaawfsHl) zRm#JcjQ=Hvyd*Rwu*!)Mw!>+gpR(vKdTUSnWBA$f7brp312!3I;i|FJS|(qELP zv9BZS*v6gLnNv6?cb!;S7x>A=HJRNs*SC=Um#C$y zuGhQ>)6z`}IeUwQmbd<1qEw_6HN__I;tfaNyb}Q~ez9|O{XSpt%`0o4sjBm#3>KqY<*;WhZBnLd0z-Jz_k%33+&_cC<&GIvNId?1G zebpJe<6+ZXUQmG5EjS^NXzj5>alN&QUbOjYkxlxC9xw|&aOU1^w#6ug;RNF)NA75; z2_<$PHn!@9GY4D8Y|9H<@+GF_tFBVX!q(WETZ)>+wr#jrbiA>94Og_!zp$fsTt!b< zyq6Wb_I}cxTl){y!~y2!@wEd$aSI_8tD&dnSs-bv}tW_^)pL)|l@> zvr<9E>^5Q$?1~gj2xn7Di4aY0XjDpju&H$Og3G0XZ1Nok)^{&4n{+Pq!Y_7D(;HV^ zH^uP!ye+u7D{{`IV!>FQMsQ~U8@+n#q{67F8uNJEf1R+-GRiUD|8T|AHE$NoKfvm+Wsb!O;ghqq+nQ}AvPmCRdZggbksQ&wT6 zH$T${m)pk=Y3MF-WHo%ea$f*Q>4gj~g$u5m|d80Q~$rkg4`Smphms>AdT!Ut@YwftF)o^y2PFIN_m$Z{+Nz`i44mrEmpgTya z{;d6JzKF3#?ZML!-W@MMcbBvVOU2H8Wt6mFTiYc!-MeQuJqPbSU|f5jL+DW8h481B zlI|9)S%^FYC?LU%p3+>pANFQ&NK^m+*G+t`?L5r7>KN5i}@lirF$f*=T&8yq+!s_59};A zSY9zP{9$BZ;N4=$EB<$#RKdmby}d%~6py&>pTxLMVwX)*JR#t?__op z>SK@;KeT0nbxn+UMij&M3ElsSY-hL5nPk*zK8@wFQytp{jsqDi+Wp+>RW-iPnRR$t zS22qJZFl2dsH)j@s;x&>@7L5bFIO}EF=I6^^LKd4C$TT7@|czSf}(c*L+mGy8LBP# zWT+$UJA1Xl&21Z!7H_s-*KfAf-?nj+nXBP7d&aFiA69;g;a?!w5ZDs;W%}{f%X7T! z<3abuSV>5%k=foeaak?c9>l`htk6zzI+^w>k0^?vd9iY2ucO!&a4wWRsE%z1{m zHW3e3;S&XU)ti~5!Iy_vsV`X7IFED1IyHeUKe`z;cFOPBp}4-f)}t|G!}85Z(QCx( z7z+-+?%R6!|wm$J}|$|VsebkJ({|lm$y-Q#o=$x-_i;vUvia5 zIPGzOe~lC~!(T=Q2AfCh)0Tfqvn}`ol6diuUF^`IW=_rBW*emTJXjQe^5A=AhIx!$ zymn7qX0nFy&iQ3~BT33(Z)0;q?2d=88d$WNx?JmSO}Oz_djjZg52HNM>-OzDT6ANE=}Jw{4V+HR6^XwO zN;SM*+@v0Mc3x}xEQg%+3}6wuTh(|;ik4N*F_Cc zXReZ5@0XW?0;INB^$0j<%1AqTcumg=znzq{;m?+&Qf*}&`%vbLr^}!2a;o)cY%t7e z$YKh8vpWA($T<2Y=IQdk97j*_K8^fzIdO^RR?d)# zsiC(|WxWdy7hbXN#S1ALCWe2E3=9{yv#vSga>jRoT+xn)O?fE+f)+b?bZX}92=4Gn z`dpM5a{@yqxSM(KY zYNEv1IL{eOW~cTXf4x;#HFr_dB=f_GEs(=Py>4-=-gdO5?SX38n!MBpcO+Id>O4@L z_L}RfA}iCe4UDTeLjs?QFEV^#YG{&_{vurKM)o(+KcO3%-)r&BbhFPgdu8*cH#|N) z50s}u6~YgmyP#c|F1=yyu9MOQ6Rq~&OrMbpzM)`KdGlFWJ6G9vGeq>>2?#yDb3C;6 zUvPfH;?lrBHV;d$m^V(DlW0=CG+pAX?$YE%Km8+S1%Aukyi=cH6Ql2fTGlVtSsPXc zYtBxR_`SL_Q8H*Qn}n}IYK~WuiDco4Iu_||Twj}vOncJSo1C4b+B&7mG1Gm$nO7gr zhyD5mw}bdTggZ(edY{-VL6dBV}SOn=2k27YZmA01cXPwdjDxa9F>-UcfO=qdSA?jtn#C zNRk!z^q1{ooqKG9+hVopT&yAImt8u&H+eTtWsQ$ym3;vcRQPp=Wxi6yq3pSzbOl1Uo=(tz?r{6)&5tZr90kj{`D;?T(%KYN0A@f%0#*>{adF0vakvb93MD)jB|< zpjc!8KAHFFB?)>=EMo=yHDc(VH(ogV&X}1atoKiE!PK z;eKOs_|h+shRURbNSO%>liNa>Yi1_Kp515O_~pEDW6lSk6scPO1IBqfj_l@yc9}bN z^zK+RLwbh(j)z?D)mCtTJ93JT%pUD9-_F*>Bf4F%|D>9~u(g}nJBL}4)7O@HE!965 zBFyomb;hGkxe0ts3=B*R49fc>YtEMmhFw!)vPrwKmGjCe|Cx!}Wou(PB*S>;EuNaN z^YPVUp6v})6Q0jHp4KpJwj}6K&0{wt7EYGj#xtkN3zKj1ex7~oyHvx5tx3i+ z5_!!UBLvJUbUPJTPRFh}F-<+{Y1yqR(Wd2XKhKuV(YY`u`N243iYywZQQkHNGFUH<}>x4V>rrKn!<6FclOPP zizZLKvE{;gv28Q{l;|~kCfyL@FxqtFNvmmtP~majt(yBT_H!)wsS7&x>`{(`>jAf< z2~juJ=4CMKe7I`vr#tLPkp&D#gyZ-m-(C@{Sd{PWTHMY1es^M~HfI)BUXs`U|emmA7= z-f^g&zJ0{8DaW^O^_j4F-<>1n*rgffvEGTfnzTQoO_q%#YJrn2c@=ua* zBc^o5>ZGGnzReS>lVOzT%>mt%c<N7r_C0O=4wA zCEt~2Obkp+3=Fqd$2V%TpJ&R;yVP>iu+b}sWohoh71evr$?CIik%&6Sl&9AtryY3y zd4L$#4$DJTjyq?1v#nuh>sjr4%2mVmPG-b|XAuf-m2RYbetT8FKSTLB^X%ZF;Lv@` zmVz9mx9rU^!S2L*JJyvs-_e{CReqGW;Egp;gUVc~3QzB6Qt1)diOX3B=Nltt~}Vp%xL;VWo(jL%Zz$G6tm zY4P9@JJTbMkP*Ak-I^Tc8)UZKpZ2b>;_gzjMy+4FG8w+I%sDK&q7*cZ1S%nWZ+B!a zPh)Qi@Lf>V=z1d~u{hwvTW<5S`#^IqUz98wSnuy^c*`99bb*4v<^@p)vXzTK8;)D6 zm~Us#&(+^`{9);S^CNe4el`38wVg#A8N+xTOjIJmg;%J9YR4o{?YKlwM)upryqNf( zR&N&bBpl!g`N0(BIIV5!n!|SUrp@O2-ElYEp*vUSFgF8p<)Q4kuevV>%dGjlm_5YF z=aBGJ#n#aBF6#^HPgonBnEi>`ko;Q|A?|xa{g4{)n^Pky+vH${ibfx6W2) z5jzp<63qV5A+_!coOg=k(hTVsjt_{{)#5eb|Jmks^hxobX-f(DCtZ&0I z-q>ED^op^A(_xlP;7?J@SeN@xniwP;HXZeyl6KkfhKE|gX3ZO$swZo0QfZid)^oy+ zR|e0So4&FAQJmM&;Ktx4DEz{#(&=cc@ZPzW#Y}O2`<0e+Trk&^*F7SnsjGbY^ok!B z&3`7l3o;~cWoBSuVqh?>ObTLU_?mjlSMga6yEyv=(RG#N=ETO?FDJU?^ZeA zPtoRMdCR-o*+%dy!x5Ix@l9Zlxf~TZ=GreBk(Iwj=20g{21|m7;lbNM4?*jczof0R zI`jPWA*cIGk~d5g{Nl@X<*0z0Xyl?7vt80XO5bT3zX*Tw#n0bW;_2en2&SdCIU4jA ze@gqMR=@O-bVF0Xtqz7CMoAkAyecJ&KOH(luT z@2!0PVan50kHZ#zc^SX(tcHdu*Fz24yAE0PZy)V_SUdAkK$dB`WzS}FhR2)z#M~KT zTzEM)-2Bd_cJ{0?!$!sky``HH6C&HT?7#j-^ul}%`NNa%DN1hmp6Z-bacTA4CA}B2 zjY1Y_wQ4Si4-DVTzR;tp`wbHVD-#35>9!4t2P-%8oqg)_{y>fgkAKzH#kbg{7$sa^ zY)y-?IGcF>X_KXL_i4xdO79Ky+ugVu-%4jNTNyFz=s30hg!LKkyH9?q*)KnSDNXr^ zcxp?>vfBBJ>}~{tDuly(rnqlWHs27!;Oxg;wbW*zlFmxd^`VetX;uoFk~CV<>!*<6 z|6!$B_(V(NZthFQpC8q^-b;*YNW5WvwodFoTD(Y*8Q2JKhxs5QGW*jKlL{?ggg+5+ znQx;guj_L0tXl*VTMEOuT(d($8~iS_Ewz5D;cyq^y6!7!`}H~9BQNb}Rt;uI{JX&| zCpW8Av06Vp_Zveb6Wbz9!=~l!CU~~HFxqd}D9GkDcX>9a$JaTD5Xo1Zu zo92yzkL3PWHE&urVag?uOs+HMA0-IQ`ytAa#lZJS^5V>;{fibT734GVib($YQR#A> z-Me^Q<3+h;7qHQINLgbfpHa+wy{B`%lBD-PKVeq>|^ZVnd9?* zWtQ>kmGRuY3k@ce<)nq1JU&p`G-JEgx1?fro@Iio3%7xqDvu+ABTNefS2l!R7I>>z zvHa%DB?>nGSDriJlW$};yD8H$DqWP4*b=cpi;01aiGjgM!Te|ZRneY^2FV9zGaFyoDvLQV3mm*(BYfun zcM^6rBUndN@y&xxz*}$u? zaQF1Wt?q#h>jcX(Ufthy{R(G^|5hJXWtS71Lkx@xKJC9=GE21KtnP%_R-3Q%yfUj? zl+XQS*|}q-#r?^}%xj{A*M@v}$oc-&vu6`Bb26RZg)H2Au#2Zs$<}gO??U;LhId{$ z=7C)3`9-&4xq=kez07}+O&|U&w^BCV`_Sy_j;!S@9v05Kwn*lL@XtJUZ9H{|X7yh1Wsx+id)aTpBSEL` zY^j{;Q>f9}Qgd)(tm{(eXJXa~4Qx!284A&hCBl@pDIHtf8z;)OVyRk^ceTm(A1e}$ zr^hp{l{8H{^4^be>jWvoM=7q!Yi2f`|C3m0Xc83gx!p9WC1i75o`;q6MPEJP5MQo9 z4F{*U%}@ElB&541Huf2)v4+j`0|oB!93}>KQ2sZ#9m{F5)V%Mo{I!fH7YZk)ht2d( zWP73>^?dJ6vC?g`Y`j&rrH zStc@pu}Rswmn$Rv)fUf-Q`?f3x|L2?b@R1;f~mgg+Iop7SSAUSycYNummct6&mVVPu3Ex|pz^|FH z+E75WxaM8F&BL!;0cSqGRC~(F-*9$&Ld|i#!+K&K7ONWGvUe~sa4<129Nc>0!=tDQ zufDUcuXb9T{cxn`sMA>mv+3Qx3nS;+>Ye#|`B>c55SxvX4JwM7A57NFH@mjE%4VZ! z;o;C7QB7R|;0sgo*^^Rhe~Z2TmGJCQ8~@@hoQFLYAM8l(_RUtN309?Y=QBA|);M#eO!8Olc)?`X^rlE{%fpOANX=W(^ex!Q8m z+#Hh*B>Y|&^)Tju+iQ_W0S)X1H|koFBt>dic*-Q+2c2ilDFLm-U1~11O@3j7ChLm> z3GEYk6~xV5ep?xfFHfAc=p}1TW<5ak=U?6HY4%bqdE!y1(54q=9!I~1eR7RX45f=o!?ku8Y>rY6n0qy5#_JFF*A&f-deK=>7|g`L z$;80WE8)L-->Uf;nR^-8#J@Y=7UR)7bLyGs+>FeK)tXNef@YsS`gg|qi2jd@gv%uK zzs4MJn{VlwdUVr^7Tw2^IaA(K0|%qQdz$2~Z- zhGk|(`u0b`_u4jYj*k8LTyyC~8J_6(?8~keGfJOjP=9l!#<9}jstUsbMz0-g>ZOPN z)h@J~chHuxajuis-UTePnOf)YgG3+RWBAI(G*kY(42wm3xA3DT=y~r_+XWBrU0J-~ z#0Ai)f-8RoHU;?p`^uEfvp?#rJLkSyN2_U|3!fjWi_iVa^jq#^Yt@to+#xTf9eu?b zcHo%Kx5c0}5@)wHFYs{O(a4(kIr`9E;cYxC>-@yBnF=>8njLM+IJe;NQI%RyuMxEP z@S$0OLMD^v%qRoL1;sD zrt>bQfvt;2(qXlrX}MlBvum5o_I{1mZt2?(3YXv7e_VM=E_>SXb-gdP3+nxftZ3`@ z6Kh!;-q+Q*WEPvlwg)F%pYQYg8dI`Khqcn_N>*ZLISh-6c^Rq^pt02;9_E6 z2xRq?}-g>Rqw3_@^7UBu1mjZs%uAQNISdlU7x2ug$^@k3A2*zXqC~4V&k4NLWj6&a<$y zJq7+V9rr(8KB>X%V@u5zff;(A1OoT7^)rYr+_yJ9{6622pxWPJ)pvF>@QO$pHH0Z= zy^Gn#*2QC)Cm*;im@~y^)yvScM^vUXiH9)AKH0RAfn~>y^>fv`);`UC&RH?{H?u#7 z?)7uRt6l3v{HMG$@Zy|cP$v1(X0wS+McdKMhmU3kEvy#V8noncOS;&iTdo^C^<;N# zjGPe>!zXp`m&{S&PZtk4x3QmJ@juXJ;-!}K6|U~rA9u>KZtUpi1=`jGSBca3=~ zc=AtX9uj6~4?52L#z`h&&CRX7ERQ7lzP;!E znsz?xMC!Z+%ivaZsa;HMp4Go3q!?l%3 znP-Ju9`0Es?aNyDwuN_gV!#KZeT%ifEoCwYU|px>=C{FbrL}g(w1nDF^HZr?gC{4Y zERbhrZm8JxU`3luK-W3OrVWY4yWc7tKDof!qtS(-rvLu;R}5=J>#~>DnJ^13l(>5R znOgHI#tDvhKQ#8HU1QoSsLeaqep*UM3o{GjqKkoi0x?zzzHYH|f*l$1OkAuv4z-;% z(5R3UU?~0aFZAwhCl2ula({ z3s;ewy^`%j``M7oMd4l__+*ZzNo~Az;p{~}{qGfP&Myo5E@bqGYeUD*4=v5o3_Lal z#y*9;a^_wiST8x9uTErQ;9+85*vRnGAnN!@voryLoTX1zPKsB!@hc}wRMVq4cK&)D zJ)4IQ*qHgx>{us*cG_ajWg>0sgDl)+k*T;PWm?_TwS1&!7C2CTVveCym*D^r`w8SDgfrkmFF7=*oJe_Ww^u<*pO0Pd0x>s4RG zfwFq>MzM;7b*dcwKlH+MuYD^p1GDA)-UsfT_FzZUl@|4^CtA~%&-&0ZMIlnWowZ5% z8&_GeZtQvCyA!JeG}?RQXKz=YTD#GzAm>ZR;mSu_KCH56(*!D8dq=9}5U!vAe6 z%lj)aT%3XrS0=bE&bq}riN##lUw!F>3o2U}y%^<|<(^#pjA=&x!D0!2jT{aechx1J zyNy=cnoLj+0UahYOY$LTi0Qch)hk?}t}ave#Ex@1UTW-GhxSgL%lX+Q>eV4P!FelI zhi=?ttT=CikV-Vq!w)kO8XjZ@-n%aoXdxO9zxH+e@nqeKMSHG)H021fe!Vi*YF}Af zR{HaUw!HHgcm)2mE$=#9q4a6@W}yYQX5NZ?7w|SFtMS-{k6X9SJT5$!`@2j9kD-Hr z+(*{b+lwAn?wqH-=*&5-^1qdfW@ z?-4z?epOZ6_g@{elDApko|`=F?gR<5O@}wlp0I&unz*vy+{g`=n6;XIxfa^`PkC9@ zTEXFvcv_(OL6FYu$ZhBO4LKOPzBaTRwX;96Ve@4^*9s>C7r}WQ3GzuHk!%X`eZ57K z1^m}cvofDoa6tXqg^-q|Ny{Q1>rA+=+x6jyjOb~(;Pgco0(-7*+kWRth`l`wO|1!Q=f`A(~h4LoHj1uU&olG#i1bbdet+bJ(mw%b^Ea8j@omVhanC(7sQ+~ zc^&Ssf8p1|r5SSVWz#0TQ+!=~zbtJ1J4NfjMptdIi)O431>*z0i1S`wSea5LCU@-F z4PP#upp7QmG=D(E!fcK`yTQt(5 z+STog-)yvFKDBK}n$EY}4=wAuOn33l`w;af#KHd2_nNg%ZR!_z8N@vgS|8a~ak|!H zMqdZ>>(@S!GEcsmTRvA8U6cQ{K!SCP!jJB+YuCNmsBm0w~Yt>9?IPEz@mmL+hL1iX9GZ>a&=Bsk{{zOR0Dy z@vP?6ngt@&I{V^zPcZ1O`Kz?#_^e;7%{(94^+gy9Bo$kuJQQ>E#aMIf?`cZOc{<## zP&)Ny4g0^3F3-P4#O${+wRWt~u_!Q{5M6rxvrB!SZ*W0Q;>*92TyHgfh*(!`d6qpz zh1LIP(y=+}OIS`WljbS@DB5D_&v2=(HRI#=x(Z3}cdhmn);)(K3il@%WPWF6+3Nl? zai&$bz5w4xmNP|On~!(>616X~-?xM#0Uii}B`lUpY9q|L1tx|wZ&@##!k4N4>u`XY ziuCPo%KXK4rC|YOsS&j|l_Ym^XYc0-Xq$Suz&riPGsB52BB$TvCz_hOGBfZqF)%c5 z|GUF+lSTU$ZnvNhA!|g>R62Q0$eCefDjuJ|eU>^y`nIVZflumAB)v^_T3*>M*wv~P z=NWwZu!nH*w3VCZ2!*tTPSgE5F*^TN46A3X8f$JK8^c1zDfeDhHZfSZXIE$KlyBe2 zcR@e%g6lhW4u#VmsWZE@SJr5WT<|l@sQID2pz4a%gvgT6_cxhND6LtP)A)YV=^b3l z{8TojgdAt6JjBS~F#V)GgFwUqFQya1d_U?X{x{@>Ifv)BGH&Zx^6YH7q2}6}wze#T zO9ip+SC?w@Y)DnRw4rUu<_O8dvqG{n6iz88!T7Lsb_d(n(m}UA~KO{HwIb9X1jby=e!^SYRLujygMUo@LF@Hk_CLLMRsqxcP z7VNcA+)@5DY>PzKDY3_qP0FV)72dXbt=ZTRq4?mF%gLg;XC@;K$IeqD_ zI>RnTCI$ge|L?Y@Yx%+XWsyF|tc1R-mfKje?Vzxzud4{?#?Y=g&t7z^CtM3Q6F-=x z7%9ckpwB(&VCA9d=E6aeiJ#aH`tWQxoh@ziG3DipZgmqwruPR*uLavRL|8via%cF% zU+%N&>|3kwS=asU=gEV@n)$@?JeODEhRvT{jLaK+O3&?{bgF$n)2sape}ssHr`tZQ zWSDm9K=>y$PDVz(O3qC?dbZ41?UlNhi}i~86w4tnbop<ph#sWjEpF&&8z~ zKQq39*2#IjPn7>DazJHGl-g5H(T9gQX3J~NFuokCP)3nICgb7rap{64XqK`rs2r@sFR4tcj5>#WXzE+n=|*tI{L=AQR9M^rg8j)5G=^XTVW<&+aP&?q-z#_1dr$%7a(KYf8tC~4?bTSA;Fr@uuSXJf`;?5$gm7FcJ@yv&w ze^Vni`O>Kw*RCean)q$kjrHIIJDSCR&qzJ6M0ba7Ov|A_-G+nl z)lx@=wHB?iOUjYRSH;3m+=53$mUAvkP@%re5wz35rJ9Kuf z`kup>a`9}@RW^|IZ1t~y>ZmQ9>aB3@>Vf*#ue(yJKyIyyvQGmY;kRP_ZjRQ)Q4G!d zCrM6GS4dvS_*5{|E!$5~Y(uBf0SV_l*ZZ=~c@9)LYBD6yVcXZzpN1f>&AhjEwd0z@`yb@xFg{6UFtXEG9LZRlHS6be|J`AjHJL@a>}D!Ue3x3anRbG~{>eeJ;1{m^b6!iR-d^UVu$$XVxl51Qs$#PM0d3_ON*K zho2xdK1N@5NPRin_xZ=UL#a_`K}On~fAw+kDW)08qU*wJ7C!qq@zC3zO}kc!Pq{9t zl3IH8l#uL+brFTy%lT6B_1uqqaADukwB$_VrLa2wlx+R5Cr5?DuhlC=^Zw#X`5dsh zF>PC3*v8wSLLm5!!?(ax#xomdD12<0RerV5dU1^73h^nrOB6N31)?nFzLg#Aimps! z%g@)7vU%3|Zg10)oTU6z_Ag7;?p09yXveUF@zJSud?~9P8K=E%-x(;e;D-2>+BHwT zJSr4+%lj+n$1*(YlzOt2@qmq?c=qZAG>E+Zzp}z1|7LuQdz8SBglqh257d|(5*TNE zbv~5ta^dVLjnkkos?j}Uw@RnMGE888cYp=Q=bHyWWr40?gL+5{|Kdj@W|0 zaHYhK?f)OOZTNPSi9wi&f#HSWqk8)p4YN5I8d(#ronPMbL0+YFq0^(zWmjh}T@~vg zk#IWW_57{@hl3B&em=H&Hl)C1HzG5`#ZvpP~KypFv>^lcTz8^qd|}JA1TP zwmwu}MawU7a-`?5tE?|Uhl0Pw|hdsj@06h zG463!xxF58O`5bP>nT&)Vn%`d)sB&MW&2l@J??BXjn%bg;9&Z&+EhKYNjmn5xNv!Z z;M|hH_-A(UdAg1dx{V}Y2k)E`-r{p>63KWX;f8pZx^mAv~o?lOkBuN^ba7nb{j#znwp~HtQ9prxQjw~rjQ%r2oy}aBsn)krOTC2MbHeeldS%Uu5F?xcW6t--uMQ@6~Bd)#^AvO(OsSz>#ILCR(xirUP? zAi~7JaP@&abB^iXhaK#BY>!@^Udzsu;T5cK{#|>3GZX8i>Dp#2%N@EH&9*1TU!Hxn zsuSckH+AM5(+h_gX0M3aOpA!9_E~P30qa|?W27)Oyxv` z)^6%z4V$A-Hve_oTBaL0rCDvQEr)(G9AO0A8n{`&S@v0MDfq(W&0l-fd-QYR5RpOPw`&G9u>|i)He`)?Jfv;*Gthla)nr{vC+pl!J z+v9}77gg5-x69sk&N?erW4TudB*WeB4s4simr{GAgQ=< zyWEe2^#-n|dE8shvQN0nAa~)zwDMXZj<`4D$iMNaU2h)9!KMu z6`_|`rELkHu_!f7;n2DW_Ej;GL7A%=KfTW>zL|MvV*HZGjF9B@8R-sbEl2Lnn&B_D zEMulq$A+H_o1_mgb91V+NG{l9(kvw8p(D+fYx<+hadvx%j#1XtEf1bgZqsI z#LOto8QJck+zB5dw>}jNUB+X0_1K|+7v=3z;nf*i1d2n?NbU?`Wjo1WAa-W!N0(1L zC*G`RFFAXW>s2DdvwdlwkVd3FS{Xl(Offo z=FN@i?z6V}ToDXoU4Fsz+b*jKU7$w$#_SwZiK5ku_d%`G%t}*9&10t_|lt zE&v_cDAyWvA-X2?nb{ld1-F7Y{8n-^DE|KV@AKgYb`uY6RBSo2Xtrxth)!#0R-kZv z_|vYV(UzH^VazgNPmKx=oa=iUEWqERRV@8Y^a9@(23GzBvIgghLFY;*%xgRpn6>oU zGd_9YvujvBx22y5ZcGf<*ndeZ(fO--2hJ5}K=!{-LaZJKhWPr*mE&wV0o5BNayKuYg7G}dep zm=VT1<=zV3j&Fr52_m<-VnMzJFB>!2n7qVr)`Pf&+^LU^4yA)ul9epH$YK8FF~{==??iqW49O7#P;FJ&?Vj#+JaE(a`+fuBl1Dt9Dg7 zKQqhPhIQI}l5-6XOq=-Oz&5ELPOD?*`=(e(HLOW2uDO=n!mxbGQ;mZg8}0SXy`{nG zIN7&dWjM)v`v^k{@9f8$<+}2xNt%NU&@4%a<_*}jt@5f=gIRjA+UxQ^%2VojlNv&e z4m6tl3;D@?vi_3>>(lUR356Hp%Os{)eOjHn?M~J;EMS#>bjTGP#xlzl1PB~Wnfq!_c`TpGz-nN#c((m+XP zwdUlDOr~#)j;vT!bbC#ZJ6Bl36t|<`e7?9M#-i1drTlWA(X0n?&sIJ-B&>BP;Xm_jdty@ymt=zo}dVD2&`R{D5zv@(bWcTr9`;XsS!#j&R z!7j7QqDO7V^qq1)KDKljILVl1Zx6m)^h?&Becy%k7Z0uE&HO2A-=1~$jGNZ%TGlJ| zTpN>XR_A|LW>|5mcC*)uZ(CB=2+WHGJL4jkB|rE$U+Bf9i`&5$m)<{dy}qh|76d%C43vJ+rLAN-%iD8zklvf zo%%8CSiyq5oA^R1k2Y?TawuF7%f>fjmQ=!;sD!3{8>F;Wg&sU~?}QF%(otko^fZkkya9UeBj2c)!a?0ibAZ%EibhBh{!y4_|0K%+psVz*7QmNx58~% zh0}ZsO!g*U^UhrnF!ffz!s9=>br0u#YGLS6;B~crkZ}Lhj=}}KTz;8v-lf=oQjk6N zG~vFHpm%Eco2Z`>?6u9(KvOMM8|`&0}VU}cKY&d+z`59gSn+k&Ai{s zx4hl^*>CNH$$Dpg?MgKEF<}xoV5K z>athu%a!xk7OYuzCF^q8%A)j}3al!Sev1uv@V=ArKWB;6U#)W7Ib)Ob)sxruXE|!6 z)wa%i*#9=J@aRTC#=}<~9AjrO$_mQ;&L6=!>|E;V5hfQV&jWn*N8SLhf3G>l3ZoZk?@$q%HW5prvFqf4~M>d}B z2nHX$d1aHr&9_TKW_>bU(H!#n&isl+nN^!RtU*TrOJ@GbTz$~a^!Adu&-^z|IJiP4 zk9B{~w9M2`E>99O_XO;S{2&|O!o(oM#K6F~jYlPG+tml5o7XP;dUfXGF!S#V)&z?9 zEBbAma8H9xU-LvPzsyPDv!R!>-uwWKnim9YUdvXo;$~Rz##d(wjVElp&D~U#Gd*z5 zYgT`qsF^YcgfkcXy5($KdB{2F=A{U=sdxAN(Kvm=0klWb?d8F;r8T}f^5L7;vRz{8 zT)XW2t22enjk;pIiHDD^-n>=g%TZzVZ$2BEl9gH3STLs=FV7T6{{Fb2c4ut2`kvL& zPt^+NHH25FI{L4UUvr{a{nVClcU4E75ccm1jXS~vZ^ca0O42Ymwp$}t&-*vm3vXfn z+&&e>%@^PJ=mslK!kO7V97(xrQ2J#y!+gds-Fu%NSYjjS$+Np9`8-3)8b;P;t`+mnPTSdb{qUs< z%>~<*%`~l>VVd?sviH!-AB!$#CKu0~qAoSb&woowhL)GQgP~MF%{K!BjnlUp!I$x! z(e#S`eI+LK`K#Mm1}lDO0y2fsb0tMp9T@2zj9-16_MLn3XS%zbq`>%+=lWs-%Ww$B(!Ok_W@%yrS) z%_X2Hd+h0hu+v*!-3FZ#ZC9SWnsJGFnPg$m&9}@~Ba?a+Z_Q5owm|eF&yma7GAczW z+t*j`&e;9oJZK)}zjQS3fn6IFCnzwz>*ZxUs5y1p+GUIu9#5|Mu@_G8(A`(MW|_^! z-aWq_1qRRiVCTYgHKuBgmfO_P`*P`>&TlEyIa!#w9j|PttNBiaR4Z*0Lq#<;+WC zc8K}9BUG1XLu%E%8(9j`d*3Fp`|wU)dr|w~+C@y>P3bblyXDy#VoFN%9L>G|+Lqno z`Nq6CIC$QH4NC;iESITV?c!U>l(yOK`Z?ilDYYc~4brAhId$!xo`{Y)=r@ny!-tGQ ziO3r|x~2~~8yJo+WV#{1!q;;3_7R6|9~f9S&XP|4S@0{7zC7wijWQEh6UxxUPv;pr0D#LZqWBo(=)-Mu!+@3#dL6N4NR1A{@-)W-c4 zPDfiWKXP_hRkPz`U>jH4j|^ijuLVr2!#kYW-^TCe=$RcdP0Np)aZ2L(K`3-V~ztEtjm{y_I71{R8$DHyYoY1;g|G|ezV03bVMQ&T3=LN z__wwDzz$o6HH-&N@to0F8L=_7DdMdAwd=Y^o^rmo-O#1VaN(W1#&NgDOU?^>Z(}&) z?flE;VcL^4kKi>MW6L64H4X{ODNkL>wIpfcRRt%jHS!BY8iIC(R&_N;>#C_0>{!e8 z+wzW{vXDW~S*fXPsTE1v;{tYZd9;6J2DfRKuCv&2HA#uB{dQJ^arH|DdGvgVrhB3Z0&|}{om8Q`SPTF-2?{8&2=s5h=NU3mw zt&a1?0}5du{G3+@=Wa2na$J+fdLTDr@y4jY!o0M6=jzQTaxYa~O;YU=-NSp(b!p?8 z6S+Y%#8qY=wvT>*O>WelLk7+clWoD3P zVqmE7eyZWP!c~cJ{vn3wW5HLi#m($})~VghSD0fu<9do2|Kw$Jo+~e5T>We{>%uT` zT_&)))Q;r!+>Ep0k4}wsmWk%&a+I0f82`v>pEJ(|@uzR~N^7Og3coxRu^{e5gGHHr z3&V*6mfIKlVu}>)c8>e5c>4bv`Ws(!Wt-rNW zcbWT#^m`(VDcwAL8-IyjxD~kEw@a^2^^3RE2kt(db%pVD6VonEZScRC)bV!u!nP*m z?(7ifx`}Bwr!@Fq)N)`*`FN4}2y@APrS~VExbEUSZno_XXrE?fN?~vC>es$MLuV{X zy~LAtJtF4i7as4=7pgtHmghg+FOa<2(WhhMPMvidqjk2&ubROLvMj4~rC9M41J~0c z%@VthJvy}`J!01J8_q$;YPBD88g7$%z-ws6&&=Ck;Hv$5{o3{3#@8|JYnb)f=f|Ig8ZmslGE;u`{H^u2{(ty1 zVva6KKY1jpZ{c3o2v^3>t zm*31;&3MLfclwcs95(S%;s<^#?Ryr!a6{wiFs%&GAlSvM9oC@9utys=mZ_NAc`fQu zv@2e>V9BWsON<)L*x%N_V{m@meY(Rqe_D~DJ7|PPQD)242Mdc6KWAA8UiX8DIqT14 zl-crg!x^tM*Y3MvZvSp?lTtag=9XKx;|Z~dzYe9}T9143`yY72&ZgX|zU9Xh<$TVv z=bQ}j+uTf5xM!Q5>JodG)_>_`;>t&No*d0uQE48sbC=J%3pR-jy2W#vw@IDo+PPQn zkF|+EC8gp3qtiofkK9DzyoAesv6J0meHb?d?`PTh*(H)mWH*-^$IY@8h1w@l!#5Vr`SqwF zvrLlPPK^2Cg=g=cw!E8oyr@Z@k8iMa)E=g z$+5D!FAN`3{`S?ke9GS#?C_dj@6ejvS=OQVr?sd|saj+Fn?b-o%rtI>?*q;Q9xH7p z#7f_om6xQpUo5c0bEQsq>1~Epj3K_K9X`3ve0B4f-{CdC=5}ZNxnk<5GdF9w^eoR4 z2_oy0H?2szws&sV>mQ3|eam{-z2850N@i1pmD7Y*;SSlpJKua04X6!J_7(76t|f9| z)r)Ix3TGqs1}48%WiR8(;MI^<7Vv0y4;4Ogsmf69j6>Fou3rb%_fKo(iQd0xT^G-m zm-A+PZ89bT7qwE`sS|3lZZ+6jo?BKf+jOVn!18Lxj^vJ;%H3`Gs_A875Ar|@mkqkYSytQa zVRU%)vBdSzw5vNG{b0&m_*{63ZG*N;^(U9Cxp`^xA~vzENLw!$w^jT}oWLWAq_Eya zzxNtQ?2yeiZdd>HYth60Lkf+zH{R$~|JBf-$zb;Tmz;iem0L-g;8}-84(VS^W-%E% zM-B@}u&mpY2rzeh2k04c#kv@^?DM%wxDPWzx$ZO4HB&V+`(g ziCrkQ-qxgBJtp^Fu+F*!bN?N;SRywbQ`GbCkU94BLFnlz|7ON+)07x#umSlB6EEw%nW`vGf{)K39W+ z@^^+)Zj1}67X|f(&;C-Gl(Kn!gP5;sGgmtL)BbU-sIAIKzB^siKcw!s|9^*5 z!Wxb{8G~+y&Nvc?-U-kK_GtNL}@9 zmg_H@z?GBikI!M)rJfb@Bs}bFyLyYlzE3W<4|!?$I^Tclcr4(Jme!N-X?Nb)D6)K- zs{U#p-*(gfps4^=)Okm2YG>%hc$SF?YbTBK^bz+wELg zOqdM14i+9MQ; z2XyyX!F79&3eeSKJgm$cOt`1_ta^BD`G?fPUj1W_MO;#MaI>k{OiW5|ND6PUo%%9WUjiXr_3keu=0%-gJHax!o$v| zrx^}2#_%|7x#n<4_)u-+2Ns4L5h1~pQiX(2aLu-)}|vzU6#hJ$}y&ofPlTEHc`^WUL%MZ01_yBVi+w)@Uo zkz;&?<@yhqTghvmDSWov?6{SIt^V#sb0rkiU);Q41;~zd`wfB;TdGg- zNWEK>@(L7ICpPY6S>qLZscp$##{&&w9iJl7Jaa#}q(&PyhUx~m?zPv{R_izvw4m!$ zf%tJXe~a1P3g$W7M&7TkO}8nkP?V6g@jt*F!n{X7>{qk8*j;glKGmP*ZRwGj4dPBB z(>}WJUT?c^S?!tGAbzMe@{EeFbNvGE_`CpIQvH2-yV&_R4M*T}SKeZSfOPR-@;I^|# za`x#}>I{n+9YnR3>ZNRc+G$cGnq9KZMzN$>W?shCRS~_LpK?BY;$6AuTIW+~)Ao!Y zUtd0j%Bxa|;cI(dFy`&P!5AFO{87Yzy=q?cj)zUQe&UQzOf_w78e8j}V|Ci*hAW>? zxe{jL@zzMo^5sL$1<_i+PbMDp=J)@?ZsEr)8r2hN*^|R?Jaa*j+Xk(PhflB-%wbz4 zK5x=g2s3Tjr|L$h6B$k?GJbTgcqnz*>hjZN0xXBZwLF~e-`W74V0+cn(bTnJp?*RB zH)hv1lkI|n-|TAbUNeN3mc1g1G?+Vnr+i;p)qKQN13bgj*I9qFcksMEqncm%G@SuC;gHNTkmgg%*ge8vTxhb!5wSH-f- zj@fF&#GuB+z;H$5_)V>bvtj{#dQK1XGLsWEzG#2qyRnJCSInt)Yuk<~TuqbiJbbNS z-~Qs-aseTWT^(&JTV^XwjyITeBGX}Uh10_v(F1ASa~F39M5|1+b}`Ml$&+ig?Gv|; z?2@=+MxTy^HGX`5_Tx!?iOfGC%fG}eEC4O4Nj-Yeb%mtJvMY^suJ;(D%VZ^4+B}(0 znjKf)pRnX(a2&&3VXpMm3}(@LWnx=qIVO6^z6gIJyCL=ZL`NU(Bd)ycUEFWZxSFtj z$-ZT-vEXX3hg0Sq#cBx!4eb!$ncqFdt%I|?{+iu5%;1F5rUspP0fi5@%uu}g zlgCAK#`)#9q*q3Kask%?GaPoz29Lw|wF>TI5Ic|}zUNeTz>Wsca=97TVt(s=ZJK1{ zY81u9pw7g=!0qwxdOX*6HjYzik_K0D66Rh0=yvnAoI8V?_7V1Xps}Um8wy?r=S-aU z?U-)LN2nDETfkOm@;KK>WP*;Ro zETL3}=ciA-RP(oBlm7W$&7Z@e>j9@|r0?A)oben?i!ZM_F4%BUOV;6gOBeTY1D=nG zOBlrtq)dOX2ITM_Gq;>;TO=OFIKG^{NYYea`Tx%1{DuW$Un1ri{tDcd?e|iWbR-f=Q^ zJ?zeSp7yOKvhMnamgEhB^Rp|QKEzfyxrTi)wK3e82ug-Bn?bqbTZRWL zTXx0G^3;j?cXy-}G87n&Fj`fw)CpZs!t`c_$O+}&jK{9ri<(_3D9XFMrIa=7Fz14j z46U_Z+l|kwEWw&59_*DWLT)K(Z0s*f1&Y&ky7H@58MsXao>MU$ZOow zp?F-lc;mMA#t7lvJTJvIWNlP%WYP6~W3(hXqW+k;`IFN1{4d4KQ@?#!QV^V`@6TnP zYW8tSLGURXO@)<3tmdjbAC}|O3($hMxRUR_D!7=k%rPG6D4>?666{4PV#;=Z)P89v{ zMXtl9kD(_i@sKuTCB|ajt6~S%ZS*ROZ8@}d8o#-n7f;+HP zR=x?9=~O-7+^l?}uBG+pq03A^QzQ)|WNa3=PDnj6`P95)vJIbG_cBR*iq-@ThbH!) zXN%!}Fi-cC^=^*VZf*IznkjsHj-;Oxonm#T_+h1k*T3TD_ZS>cd*?ml_GUGBvZSR{ zw|~PCc9nHjXMWl&V2m)bv2z9I_BH3=egviRrAI13shr>3?i35yi>D;s^?vvRO$Jlj zZa3_kSiDP0Zh?Tm6|W&^?JDausizj;)q9Z{oK6p)T{+f~d&s+|VBLa{2lMV;V>km! zK@09NB=bIg*{9JDDce>TcylhwWQgk#Xz9Aj`biPgj|;th6EsR2JcHMYJ0UNUW1%WX z>*~oMm&6?ukayd+;EhPc)TGM8e(!xiF5WcO5DGs z!|&lG;LEsS=T&J9CI(F=28RBmp9f^vIBto)N=j}>3ckqj(%{qVqwBi&7`S$G#;@ zT>3xt2;+n)?vui%Ng zEh{ZH{JOfg(Izk~+Fr(0wZ1j#+4?i zyhZvPl}GmMy=LxOlJUc!NA&XI7pWaDCrDiTAs?s4|Kc>Cq}1jSWW32HwJ*na+1NEN6^Rni_Jxnqh(4>*;Z7r_O}TdVZ+QHcTaR z-su~ON^5w`YIsApo!;Td9g%*Ep6gI{txZ)wtM(_khBEhYwrn|jJg2Q1Foi06kzdv=xNgqW`oJMf^GQR}`$UCI{2 zpzJn@hcS(&ZS!MFk6-w|Ggw}5_w|O?wqmPW-ZC?DG2FfykiM}{$fkTvo#1&st)^e8 zmktQ;`m|@!21QQ}PKnuqYlEz>KJ)ryWwtZ4THcdsWkl}%DD4T4IV*ObD`mEv$58dq zzsp&8E#sOEKNPRMV^_No^=6s!iG7Y2r8|~4$9TqVV>t6V&uLPGF5864Lx~e=(hW=N zzDHH0e9C(5mwQEgU&Z>^p~?G)miQiX`HWEz(qNuPKsf-{|2rTXDV&8%GrD+v&y3{t7FTG95(x7hDMJIU2Nz z`)7(hUvlA;d-qZqA0A8-TB2rXv)*TkKww(CvxC=krxGvaGM0x2<6c;aW(zE;U~27K za{2AM@CiA;Hl}!4m)dNSUl?Jy^!EgRK4p>B%dQl<3&_3k&3(3d>U`!yE?kOVLNwE>UYka-U^~Y}8TcQV)0`wb3b=S8@|*Pi(qK zx1;CY%$*aj`^C+DujBT2l^)l;f&eSeLSW!Xs#FR@JvD=$Ic&rt;(PH2Ks7#xq{|eW` zAQPK6m!=2{?)tDqQ+-|m$BKPhz>Ey2j(l-vZ zOuKdCR3~2!TWVs`&s3pk-hw2d>g>tW_nS@0Sr_79%Xpw?SJvhg+f3HGUU|d)ur#aw zA_L>6+PRD;&YChCRlmBYQ&$ISE4x{%ZM^CrGx>(zzR&*7XCtOubXJ@E_3-HnHbx-N zbS?Yfw!F6BU|~nF!)xE2?uygWL@%5R@l{{FvG)VRN`*-I<$IHUfKTqf5M&~)B$2wS zZ4IwZl9NviOIm=E+O&;6Nvj#9)HeQn@bXv3QuX5E>-y0_?ff2-y&g+!Ysh?>X88ep zH)5vR#;womDreZ;$TE1ggT##y|Wz5EKM{P991g}XLxi~Tq^0L zo9nxYpk;DqT^%8+Cm7Z9_>v2>fO~@An0&l>rHcp?uoLi<4soai#IOZ#Fk*VDf#Q`eLRO; z5A0!#=y?D$|fB+?3&I1i+k>(LNh!x)T^AI7sFZLI zBGc&k*@xwfG{YuFi|_vT&oQl-753)rSsT*>qFfnI+jejHIaPf_fUrG72O}E;m($9< zt894$t~|SPbj7Af)h|5)tldjRcs`u~O9{Mroi=+_(Bl1C%JBh3B98($ zILZ7@HwoRKxz1_PRmo7Z)h+V`7bTRs-Bswf>0@HhWny4p=n1pAI#XOrZ%zfvrM#Uh zwe&9sr9R<4btix|p@;j?4g1BMKBsxRe2?m_IrKyD(G549%zO96x{c~y$lMgT^+H4W zvC*Tg!Sa1M*Y9jt%Xs3(n^ghg-6pSW4fT}ctnapNx?yTQYxDE(Qpp^KQic6B8_pO{ zcH5fvyfe7@VTi-oMSoW%O8F-&ObccSC|JC&r|0*?{}QJ_J_O%VmNwdITc`q}OX z<+kLsnJb%;57 zXpLaF-8u2Uh?iDLBv)al6B}@Hbb6 z<1*e$s~5DHg2qkDuBb0jj9gcBt>e^(Ft70W6Vxu4ZAj@|@uzQo8Dp(e)X7&X5_?zh z)(JUl-+Ij#@V+j}#GnTn|9j$kBec8Yh{CmX5n}8q z7Zk6>U4J%FyfAfUP-3`_NvIol(%Y`wZAPE;)5E=bw0;^Nxpgah<7)qyN~Y!;x4b!y z=M<)@Ic5Dvrz{LQ z_O6rHi#am&t6|69O$9en-bx$^W0sXXqNgk-Hsv3a4BJMBvgP>s+BaQ5(4gU(_{dimep5Y}k=|WZ90c+>OHX8Bawh zZi$hX{`Bn;NArydd*lClH0mkKJuCk9CoY+1;f`4G4wcGF+EaaxiXL}+Di}V`!ZhW# zr4hqZoA7&?5C3}jFnm?owl7E7Og8kxai!m^bx{?PA8%>iW;FAk&(@H%`TUX8>zfyY zPFKDuapYQFM(W>Ro31jX*WQdN6E$r4lC*zcj^6IBzPzw_cTma4ymwztuGv~1BbR$& z%zJ-rs*Gk^u;H&$qs5Y0lN?XXSlL##Dt4yIlby+5wI_8J2sRu&(RX#dv)UoogcUu! z8zgRS{Pp#e%MOkin;FHFt;6Fr51v{PFjtN+t$bXrltFgVGeCJ;PtMZ+c012uwgJ#^+a<-gpj$jMrJDf_#!&Knhm ze#TQ%F1@#n(^r<;u#-ijOmz1KAFe+}D|3%bd-gYXqf_#{jf#6O-Uca%vo381l_fdZ z3`S+UwXPi9)$>V-c~4Kp+mcRsSY}^;Yh`0%j8*+zR;~j}E(+S*6?}K}R^7Z0oRd~A zRQA~1CK|`-L(ofqfW?!R7f)vxy|tGKD@1jD!5X6u+VmRwvoako5svf{B{>+hN+T?dsW zD+3=*+}%_0_RACL=<>6@&))ppdu(-?)Ln%g2@4oc%!ms;lgH4NX(Fn&^LOC$;|%IC zyU(VEFZ^9lwY(u>n_zTk9W#Rg69WU2;OjQw{Ux~^G4-dMil+@_B_<-v2*MXvObbv z=!ym9uFL`@|2Z?5LKoa%5Rsgx0NR7&v{A{T`pS`KjX6fkZvN|C&2VZ_L|(_EM|Cni zTc>s(2=&cTE|U#i(e0`^jc?J89X%Cqr_9dqK=_fXZI-2;Lqg8pErDH;WeT8e**=P< z8@Jxvx=ADONEow6z>#O6My)4{J(>}CxajVO1zW%n&i`BqFC%`gKH8gLPSMR@7JvELe1Dnsr zWd?P)H`?WWJD+iH_WI1_ejVutHr{+Mo;R(Dxs@BV@#Id9sm0;5dc~z{?){K4pM5)k z@!4^!q6Gzs4Z5Gtp1qd$ZLQ7vpE;%<&YvwatxmAwb=cYS%F$tyiAiG*R-MA_N1Va&RD+k0<>L>Gpd zzgj&{-7m*v?T$w`Ry0-3Yw%tC{^id*+n4H}H5S}(v&`s}%d|%3oeQH3EV9dPcYkPT zFf}{Cc+TklHzgZ|1|Q#JBCP+eCNzgv*{%K^_`G~y3TPjH*1mc{F6#@6Qoey3Szi~$ zP5_O${s<6jnivKP@*^3^OP)O!R-U81L5KC@lHV-cZ|mPBoD-2~mSR}7aFJ1%!@&cG z%OpdOJI-VHaYbz%qxS-du-}Z!q(S$)Tv{y99%L-DY1`5{nVK5HQL@)~0=SO12}~+l zcI)c4857EEqIvCPx1BC+{nf#!wm0Zz$crOgnhY0jyfs=SKkuVU*UBqxe~m19OVB+v-!Dwo{~3m+ZI{J2nuMVX1g z2(?enJESkV^Ww1%+Zo`oTj$`0V;%L4f6vRFnaPxVgW+nxMb1xB&kN=`SX!8! zI``1V(Ckh8@E1^*@w=~6T!>xWB&lu*cMSxu7{AgM3Fyw06n$7^D#E~K;mT&%^r2%((^6j<=QZ0)11^WX zOE^;};`noZ=cZ&w#pS{ZplvMS43SN@7HAkPTJ+HD*5lUdJxNc$DStk|Xw7}Ikjv?h z(?y}V!5ju%EA+2ewlX|sn&4P15O!^j6NgeUm*7%n-o(RgYs9CtB(7){nW8!4qjP%B z|60Zt(biy&g}Hu;i%J$K=G>U@wP}*sL@SSjvy~*5^81|FuWzvA^Omj$#}_?FQMz!} z@?w!|Wk~AEMIRk~qi??dYPSBs5~)L92^6toX^qV9dn8@POCBWV-48ewD)IZ!IjIyPbc&Pq$>B`9zMlA*s2J6AufAEGfw0 zP~2!eBX>r{rn~EIY%SXV_S>m_yJIeX*mCv3<+9y9RbRVT91wnLd$}w2MpVuetH}Aj zYu~A+l(jP(E2ywOuOFSgMy6EV- zsedThqTJianmZY>9siPz($%2&6v$RFI8xL-x0JxKP9=i-O8=8h`CTz8p6DwE$>Ipk_-vAB55s?tG||ov1fq;Wr>36lk*35wf&Op=$N?3aj99z z6@|5j&#-Uq^}N*eK7LGjnoI(vHe?{Pwl?hp`g6s@WyXXi#<2&l77&q zZM9D-u)s?6$&ocUY!KgaJ~T4^4tE9+$IOlE4O zc{p}+bGVs&c$09=+V?HX!49^0vS+G#UcNL8XAP?rT{T0IwfEMdpYo-=wbhNHp1Utt zFUWL1%zV9nSKB@fCI(X`28J{bu8J!+S8^LKnUruNE7PUf^PhXHbNUj7M_>6eb~#Vx z<7pDibiNc9pi;!|@W=ms-EsRv`|7TkesSG8TfVgHl)I?$l1coMf@vO&v;7vF;dX3P zf3P)dZe`;+->IpYwSuoI=6|RViV~fDZ;!+CWv84DCV7^8<@9Hq7ibcqXvGDxt-*^^Y)iFJA3m!lJu+-D>{@#lfLLCB>d4UpxI4r9LhB%2|@P%4=4h zo|Ei*VOjsvTyI_pzqk`JRq1YwZfxx$<;=)Th)F>UW}n`)+P_3t*Lyp}7^RZpyVE1* zzhH`*mJvSR;rX&vM_xXwD*M{mw^U$$)ANi;v25!WZM<@|T-JYyXsI&GC#@H+gzLJW z?O(I&mrIEAvAL=XL+7pFnaWYgn&;YMxBHh%3!mAnZ*4x|^KVS7ul8{J`tp^q;N-s^ ztN-0$ITZD@bJGb2?h_4fRgXNs@~0*^?P1WzH=BNJJtf>UA*}My-2*zMnb}j-FJ*be z`uS8Y`nZ05#M)0TPs-DGW=~a5T3@yH6N}e6N5VlSkN2o)# z=Xb3QB3uQB&ge0-r@9LsSaa6k=U=JITK-Gi({#UZ&zr&0xq4m3zhd#ZvXTNR0(;Kv zh+#91Ua_NKR`gk^Pi$|Mm>A5M7#MD-?DD8|sa|x5qcSVXZ~tR+y`qdQ9|YJl;%{uo z30bGH#lnBe)@0|UOcHaRE`H~#0lF{^ti}3MfT~?FXg@bZ&xD0uw+i37r8}+Z*ktt7 zNUvvREF0fz(`o+~GXB~2o6U5I-j}QjkQXInHoHD4PiK8JLpNzXv&`nB>m3@I4&*XS z+BK)(j98Ls(#kazb<*1vCphSY+RT>V2uXBPe{p-`FV!WX0fG#h4l8N+zFu~>f8SKz zqUWsrFH%|=R=jjI5xKvnq8HrRcKn!QYVq-QU4)ZhfwV|~nP$uKko~i_aeE%Wx-n~R zT32Y1{5nO^WSJy?MW_}wN-#v4Yx zeOL8W*EV%A6g68~m^nqr%xRIh5*EzN9T<=j`*}adjs+$U<}sgF2|l=8-yv!08u2NH zcP2lSOwjuAjdhLSJjZ2Cd16N=aGtjgJ~;8J)KBLm#jD(>{2E2I!t_8|wp`9DP~140dB!7j{nf`^*WFbnL>A4mRgI82Xyur_ z!$YV@n`O!Fo2f2MQ67TK4CYJ>3{N70n7P;GF^YNSGE8R_3DRKs0#bsmThZxj;1T?;Wd-If*3tDwW4;~H{TL)+{m-W#l6Q?rMa*@ zW5E*TmpY3QD$a0pWB3Tw+V-+gSFP`JSvt(7UF6Q=A~H1+B3n^^`4=Fz@^ zKRA+ZXe>~j#+b6W?&-raj(D~OpsQVeb!xIL-5It0bjK38OQ!DHFJ6OouN~;p>}{T4 z=)WdLF>0FnC5Nw1Sq0~PP}%VN!HzdSwqK6f+EgC(rtN`0zoaE|0Ndiqj;+5BuF6~Y z@vyh7lFdWU1|3H0WQG-AO{3>!{K^mG{||1TD%eKzD%?A(rWUn$^Ha|AKOTnabg0{K zPEZwHlhT_NRH6mM2cW@}I z-WU>A@{jvQs!P`LLp`emKRn-LnS7Q0Y&3r{C<2Q3%bIi+FWwKX6 z^TLmfVH+bBZ_?Oj+q3$z>u*V$#s1I@*ZZn&7?&-XajaLt- z&)CpAK_nx?i}lKtQ}fb#*bK|=vmDwwS8BFHcloY%rl>nS<))%1h1oaCERNmcF+1kl z(X2auiqE&~Ffj|@SzIOHT96XIKqMg7Z718a*{a=F^bUR5-Xn43#?&ISjc<5PhBe=q zkTdVl8Qx2|K_!xFZmf7v`%)&-O*#JQ^rHto>J{gtyy(vOE@*u9(Aln2tGW&T>OST< z`HcC55pzX?uW;1fo-g8alh~GKCheT!nlnE(*J_`3nd2kKF+}TEw7loqdNMxqc(|kG zf%nRD7`?3dBuhNDNm+a?&hg;r-?+`|d6NR~3a2M&vP`=cvkm8OaI4&@5VW+8C7_0$4tA(A^0;j(5O|!servq z(AR20X!>29FqI0yW&2Z;_L|8%Op`po%-tZ)%{9lVJ-Np7YbejWzzx5V$`LU$B#5To(zkyd)CA?9T?6E$gnYZecvVPe#>tAlJ?5&?d z<$g}+c9^!7?VrMFQ2EYKc<^BrD8mUkOykvjaPX+3QZoO^ggc6Ug~6doACl557v_hQ zu>8?7{4qg!THxHyvEW>^;7P}`kEH|`Ta zexE0mow;Y`39PWvU-Yh;S)k*p(iz7C#*2)(yERvE+?oB?VIt^qfYf7RC+rqXj67NG zD3Y4jar}GTH94mR0{eC>=1j3LS1LIZvefId%P!|Ox3w3&F))0#ee@PetJ{F6};72 zO6~^lRF0o@;azvGSn|DFSEyQ zpHKO(o)|L~N>9NzXb@LA{w7`oZ#*)U3B1&CW(McC_vD`NkY?>(XasZF{k&QEUR^ZEugSSN44K zNfq0>CGY!;m1f7j@tK}IR+hM|>t~YVF$0E;j5dvtYp*kgG`7}x{ygwFo;yUaa+j!u={&amn1yeqqSuZn*!H7k?+aiikW(agK=LK~OprJUH|TGgHGoGf_d zXwrc+^MFp)rp+5)w?|ure%;8)60Tu(pg$lt|oPg%yC~6>vrUoTPNG)q?N}Ul6EXD zUZ?7-u)}F1o04;HjFiGa>n|$aMf`0#z#h`_t4yKnYubI5p#2;ZKG+1_GjIGRdVyc&f!;A* zo5t2_S3}M;9ldh9|JlWMM|U)FdR?C%x@j8`dV6y}D8HnjSOz z8=aNBqF1*C2bz~$FDk67OvNr;=PFDLCvo(Zq#k?JH3q2#OAbg;@1w2WnOFTdrmw4 zNDy!e+?}*?>fgmH*0NOvUeRM-&Sbnm?ZUoA=k750%wuXhtN=PMvqZoyMc~CMGtd>;e5N;8f?kO{3gkL4RfT2FVb!I)tsDyaTx}Ih+-n<@+%~5R zZi|xS_5QXv|FuB}`@^Sc2`?3D5}0OXZ`L+j`^ND`Saag_wCRd(8#9v{vc8F$dXyYY zjM(|&^~RT>rq25BMYdV&Uc=0zEzZnf0~-Gq2(~^Fw3czkY}?~*)dkiq2itoNZ@pJhyfk+q@6UO0N|i$Vn7lUm~J-x`T0t zmBE@AhqYzvOgieazc%RpDXYhSMG43mdLA{M!6#!!-8|(`E~Ou-~8@aoTr^=jKa-Yo4kZ)rnqE zTGM&)@Ou#c*^u&R6FA%^H@kMlNM zWpKKiAbvPaOkDp-C)1p6k&myq<>MIj-RFlr%-rhQlEjf&dN@tY^wCvu)*pTM-oGyX zDks==km+{gyu1ySvv?T_1CM(oHt0_FFu##iutxfgQTTgakx5JjyAHZBh(t^6lrt(n zeE6C`xF>6LcZ}6MkH*#vdH(M}+w(eS*B&*r_FocFa$?29H#Qri z^)(8)95wD9n)>IrQ|-_5=Y;1?JGF>Qw|tJ-J&r{TIg+vS=c<>zW?ky9sI&A~-GkfW zd-;GehE6qVGp_yMSfJrddWe1g`)4DdHfv<|ab~!{k^$!=M#6Vk|*- zVQM!_;ss5>6>BRjzR0p?PTleRm`>-#t?j2GEX_kCG7hIR9`gwNDZ9T=_0`m8CEXWI zd`}o%VoCw8Jq{1-5#eh0XY@I=>*WDqtwZkBELZZ(&&V45kMI0+qUJzr*>1FZkPq=eS&NAlzS~IQt^D$xWCp^ht zmCp!IzO!xPVjbU%GSw4PZddI1lDl}~;Yi-?xo+V|-)v{!E@1>~{Y7{z8VLbMf2zD>qlYHJIqMW;#RoyaFDxMJK1KvpB4?S*WDlsqOER2RfEh zS9x<>%OTyz#*F&Q zk)y$7pcY%-lKj<-8WkDhVfsm#r#dh1a*&yK;MMicr;_XYH|%Vl$`r*K8*ccw5~Oy) zgN19^y1(RhWN(pbwqcymD`+c_BfD|hY-YAI{jQ;4^OBb2uWod4zro%f{`snFNS&mI zrqRoaq@C|Lt`!Ay>!0r5#Bm1P|G4;&BbxV{OrpHPUYB)xi$0xp@Zt^^o)@voB5C&4 zJ34Ivi8oH4-tY#L#3S%yGzro%Zmm4k~_%l^uY3QYoEDB~?H#9&~uUl9S?$%|P z%{ZkzZ_-pguZG5C}glC7Q>r+&T4xY5Qi(mXq&TRY;6@XM@? zDPFDXg|8fG5ByrjwLJKPUttN?p*QTyT9#WgrN#e{n{`6i;Pe`wzKTcT$7S>vL>!4{ zeCtqpBr0!_Pt_g9O)KUG8Cf@JFhsjO{Bh6u%{3+ld(irSFYBtVK+d(C`)VHw*a+9W zS5)G!e$1L=t-EYL>%y?udQb%PIV7!S)UY_OSNv7(No!e~`lSd(ng0qKe=B|o(+}DA zU4T1fW<}PD;1B7BuAoBr9cv>~lwoZ6o=2cyyuj4CmMz}wZE2%6cmSXs7@X=gR`oLWLJ7`f~)e>-(;*t@Nns~s;bi*?)6WwbKqJk9l&!az61F|9Z8lXM2a=t`+N}O9Q%JsHp6CxG1nB z*@Yo2w_jS%sXWCwD$#$U@M&rex? z4QkXagPZFjvQm35@I>>@`IQNh`?BMqkvIm>xxY*~GHhs>TV$&ML0 z;cIf9W^SLqmaT4P&h(Eym5>c&ObiZ83=FHMU7T>T>}Z&FeQQoMuZiQf*ki`3ws||e zz88hG{Q9=`_!xy)e$8SPz_?o;_!4uoAI>@Ko zPPGY^b7E_QSj(bt8|26Wh1+4xkrQ%3)-vSmc%5XRd%@$W)Ax0^R+bCrUV7Z-EhCvP z`0DoWc!pJsylf2zTcz^nZhE`GvKM5Vce#Nsm$Makx7)=vp@$;oZNM zt!n9Uy~i^@{V-%WoG8HPWtq|Oru|oFH)p}p;~+1`%jB+he94;%^719~1F;`E{K6JY zJk|Oxc5CqAl}|TKH?S=@EF9f0t@nQaZjP^S9eBUKwf!B(z@vA?f+2eSoZs70?4R&| z`s7ry$?4grL;?Oor+Fv-4cMP$_^{>64bj!nKV|mc$YRjke*+ZY_G}3jJdYeJc0wIG z;i)*N#k%mRcr8B>|V|;hWd8Q6iZ-`#W`&Dx{eN3J#XCA}M;K;bx(!1>qgjJjEK_w8VFnU-fg|a!SoMZ^x;FAM~7Rtpl8EtIzKf2PHQh){n+Zo5a9Q zxH3-%EffNKnBR0wU0c(}oMSqnxB--vJ|;7?9afNQnJx`+WReB@4bkYeHr>oQrXD@a zAQ$@oV%x#Z!nlJ~YGured!g2>j(MO!h|rj<3$mQ~dzyVfO2!?x9!5|YEEId>>8RcJ zru~m&+%Ap-x+!|{Y=WTUW)wDBR$NV5#Lj+0R6Dw|ojJ$!#}P(Q4m{q^D8bjv5y0i3 zIpK!Po-9Mdx8JsFZ;Ptza=V!|Az(4g4c@+-cVH2*Y9%-#R&zM`fuexz-PyVYCob&h zm0&*bz^T`Kqh`fTeTW-us&c_8(k3GfYJ8*jVo)gX7@gRB^+5sHct|9CTrhK~LsIdF zRY#AU@j1WlMwaN5g^W&{Ot)P|#n>n$b*Cng345m*KZpJ(*4@Gz?? zgQeiB+l^8?%zrm3IX^Z_;$dj!etSS;O2xqyj^7r`eDMCYO>@a@D;^~WO$L}n`?7C> z(&eA6Ii?;zqCmmXe&;{|DA_Q0H6D5PAherv&bm}k=jdPd&8&iFU?u9c%y*7nHuQ(( zjjRnXU99dD)G9Mr3U0Xjt3bTvI#<_+mY%Xx2Ol)83~f@f*%)%@h#oi&He#OP4hfg>))r3EXtxif!7qL;?>ba&}MtZx*y18%IyEksVVSL?> zuUT|koaMagC9~4fXFYi==^9X}?dE$TvE|^g$xVyZo)`!%j+oS7_JM^<)}g90G&v`3 zN&4|?BEJm|$hm2VIc7G@n()`7ReshbHdDpl6Z3T@H3_rbI4mH~y^ukQXT#|g5fhhH z7A}9`%AuF#`*6ishDnTvnqQRJ*F@+nl|1Xo=e$C3Zjhr#Q$cgkGJ)nx7AsX$mW4?F z{q58Eg%-uHy>vx|73hwsZ-b&~`>^t?E;h|yykM+6J&gM@~+NiA33 zm})JkIvO)i+$AGZk>OL+ik+w4vvM&pI5ROY=<2d`>=Da)@@db8g-cr-dagUIZL`r2 zQ;Ck^(A*=I74x)G@%hcAtp&^5bWK*6xp>VFdQ;cZo4h#e(#Io<+B7+qh6d#{Pw29U za!gO@oyINjVAf>0c^)4bSL`(|W}a|&@6(g*>Khntp7^|qBP5Dr_a3n<)-7%Y=a*lZ zv-@uUpTt5Dg=NdWO;221_ws3He7FXa2HR4;J8$bY9Gay$<9ZHAM)Kv;PWfz+px{}@ z?#i|CpLXjyb=QnzWyfOC61Qs^I|UAL_0C_l@^9)5*7e4EYnFYx9&xB>-CXs$oB)BPE1MLK2XzTtOa7BT``h$Hahs{4k9Yh2&elm>bp4z#cT_yX zQ?plx@4jO{98tjgZ@2I69#(#?oeQQhCY?8XyMANK*58sgg;DL-KeKFG6jVDkK})pO z;lQt5nGB74eyy9UUQ-m?Gx>tk8`)W#@2q>y`Nr=0?5TGaaj@MmnzdCZ*Yw8*U+E@E z^-aFNPjBF!mm;&V1>|0(D=q3~%mFToRc-}v9_U@>d`^yyLqS^S+=}kciQk?7MXbB1 zdg5m4k;F;UCcRuSw=Me3bg@}!Yi{tYdR2M%wKCsovtKV?@#_6vrs1Zm=&FKvxIzz}_G<@}`8jS+0OjxeaSwYSR8>oBrj z{gcPP#QIM3gT(8r9?X>!*{_gLZLw#9e#P=1TnAZmnod2Mv6Hj!jaI?V$eNAZ5(%d> zvbL;ctL@#^$=Gqjw9z2FoweyW*OD^(O*?vHTbG$<%j|Ao+;--6Ml|n-ye+=3-pq2C zvH9_h31R#7wtmn(rF3b_g|l0yz&Q&-n$YK5AtWxSH;>>wj;SKW1) zq383X;~`osEV^A69QGV%Z>_#n+C&iFpe9ZXISQ%=xjV<}{mY1rxWa z-a2nk~pGwLFJ)_+>8fW=e1>nR|+s}RM?~Q@LtY&`A@dZ z>N@oBL=fu(#mfvy>}zi@9I#m5bzrH}kHdNa+6$%yo2u4Kd$8l&GZCd&p&ovI2^Y>& zy-8;^U7jSG$63A>ni<@|dbI5#OVF-@^Udt>p#>?K@&XUIE`Ab8idk69b+I7uJ_{3r zD-#1l(6Ivlw&S&a-OApg4edV69dkpbX>AL=&k{7NK)-c)TxdbcN~RAJG8r~9mnAbi zTDjSJiI~5_+J_u!Hf^mWgJ?uYDJMjk~=1zzU||`z%5GxYmenVg0-Q z!J&|&yBc`>6SS>fYx{8DcY5*YWvGsf4nHAUiVa?0XCDT%U*C$1q?JrBz+PF#aKi8JCdS$N z7aX50Zm_c`yl&tA(Ivk!PBH4Ju#c@G*y9f`^`+KDe?IYM&8+uR#bnnV;1c0(VA^&4cF@yKlWFS(_E{Wz*B;4e)+t9#swIyxhw^iRh%RXd6p3VQcWV@tDXTzi4x%(c04mzy}W^CSy{a^8w= z5O*njdOj#8m#=Zl)bb@aZn-K=)2h7nHhc9!Lrt@$PhXgF-kFvE_;IjFWdDcbcmEmb zNKY~gXA|=0K9rE6aIt~o&zyO+F09%MJ}FOAYIKZbc%+r;z^$}qN9qNSja#q(HS2hE z>etTO5MwpUqj?J+*r+6%xn;UW^iy#c{R#ECv(JOf-4r8r z?MFQK`tuHtItzR&p1OxP#BQC{AF)HC!RfoV*ijY5r2T((>}6Qbxa2c)21|m-X&2DQ z`Hy9*(=>Sw&fUPo;0`+fQRG*u!rLDlKQk1kU08qhu*&?vkNnGAjZ|{i@u%GG zHj(Yc^Dl3dk4@#`vzci3z5cYHwys3NX@!UBxg3|)Hy#G99v1m6sHHbYLef6S0Cc_8 zhkbDYn`~87?`{7iRkTe?q0H~7zlR?5rQ{~;oR|32 zy(Es`^W@jHH4;VJq!idJXO}-qvs7Bd%A7Ov;e^eKe*2@EJ+HA{dn*}M=aT+q!j!!G zr*1`wM)TGb?aM9jeeaxI#1wU-eWPTCn0O1>OQlS?Z3?% z&AQ>{A$J#UuH|bO)V8j>`l)4B`PJNv7>38tG^r~;}l*{W+_zUkip%4-;!kB-WInl=OrkPW6y0vk$!1hzP%{@<;S< z*B_I{ZXT!Z1s(OX7cdzytYfSRXyLCZKhOrcHz!hY5i9r>n<%fWN~g2CUzwTcHGJ$2 z*7aYp!o2Z%;D&X(IJK9@Pn@q-Fwrp~Di7jvCuEnWS=%fuD9~-F-nPs=$MGQ(g9j4> z!xYg2OT;)jY!*I)Uc+O`poB2ebH&py+Mh17=oxW*T+QqXG0n&bW&wT`@lBD%&c>&;YN zU7yo(;?@Bz+rukv-V~n{^fFpfWKP0rM@G%tHhnw{g-e@qx!G z4F`VlGU&k`>=2rOhYU;S~G7|(`OzV~_8e`w4HIsNt-rb(YPvr{t} zFN8JE+kLy{M^4w7?d%PlS!s2yb+g_aA@s*B;ovfMD77#m&ak3Yy)U!upsQqIt_05dHq4rt*pUY&N%QgtdCeW z_25;80@DM|%m=Qw244Y{H3=CE6}_cy!JrsZpXwMCl)5(NQv$;(Mk$7MY^k}-bIPBk zv5IYFWzLbD@PY3`S87ycA6vs}#~3Mwye$tTpK*#*ZB^KCBIa@X!;7gi)Q`CyHSjla zcxk4&Yt!6Q4mSQfZU#B%E_i)PCkvErkDD^Y@TSaNdp7oqpRoUut9v77Fgb!G{(>at zq-TFV%&|IAe#N~5b?L860$yyo`YxQ~(3|pYU1|GI3a6ajG~Kn(=Hm75U$@4~_<#9& zz-%2;)m0`L^R-=#=?k`@r+CiUZDP8ipI4ch3a7e z+YCg_BXgcQiTU@exiWwACZPpdS5$ZcK4@Z6_MQ0;V}|E>3u#^=)tCipIZAhDs}M z`HEhc6~rR=d*Ldh0-cc7>Ae#{h$hLrSSxQO~&xx!)}L7qoE%s`Ri@{KX-R;ZS$0=HOF|7dZFxts>;gQi0b z27Pa=-|~pD?wG)6a58nN+wz;SGdDl%T=wqlqJ}?W%naU43=BLQQUih*e`Xmh5V>l@ zdLWIT$A#Hp?Yx^GT!O!+6;7@JrQ8$K7De&?nYw7!1-&~3OYf+DQj%ymwe9fpt~czD z>iOR@OgRL)4(S(<$NeOxJ3%4gIZ>8V7FDILo;q2a{pxFFh6#*oa#EMqX{`#MmYI4s zYUPTsW|x^dt4<$a+tj@SE9$*AhQ;C5)dY@)EzX_Oi~N-qNNJ@hB(3Jn z*=Mn1{Z(Z#^NycNc0N4<0#i0Qidpv5Bwn22_7J4~n6SgG{@KTVtxgD_Txt8cWEJQj;QX*0?C)+Xo7w^TB9spfXh5J6|QrHtlF z0)JA#imJMyn7 zodDHC3U@WONj)g$nJd9?Y|@4E!cT3}W_>mGj%B@YNoj4{ue9|%yo))Put>QTd*7UG zB(au#w%;vHrz3(cnsWnB&qE12Pz9VO;~dVs zrEj4y^U}&pw}=z%kylpSl&(@;b62BCZlX(8@oFZ;mA(tOL^cFWUw5WW#!W*^MIdwz z@6CQ@1~Ue0U6#n=(-*FKKSpm0KN{A2IE{-o&`=%tCdB1&muA*0Vh=b=bddeKja_k5n%RZ&u&x z!0*_z?e|I0c_k5xAO2FQoa*ziM@XhY#l?KpvTKw6eqi!8o3+w^lDPB6K)%{ZEeB%n z6fBfy&~mD+KF`-uSAAaW`?G5f6BWwBty}Wf<{_hGLcz<(+w)pd!!qG_r!4)xs`Ti--7@=gu14{yL>F(> zd%Tl9>`&X_oQ|H#9+XdOp zqVKqz6PBC62r_*>W7bB;wSQmSwpt^$K%|dXQKgLix0vvAg(q(G3he=wNZRq60_~jhigVoHXA+LrPn3$XlsLlX4$ob4Cqs^%>$_(#NAEB?b+1@|S!cLI zOuWpELsMBRKe*@YnZDtELi2=b$@8_fV$b|Ne37hH%T0KTX8Pwu}Z4@u* z{cP2-5;EHgQup$1E8Co(TFAStOnAlAgSi`4w}pMXpRoGiLblyJEB|p#oxm5qb63yx zZLHDmt_Ow11$UU<$PP}|_HJ8Ic68lTZ@CSOyxXLvTzzY_bAD_dAzYEbg-%boS!Ptuv3cZF)N){k74$Zy&A)cUmTR~Z)G%nc8&_b*el+MKkDRh03`ROSOVieXuY?E>~T z@*2eOhMakI)KMwXjF(}$zQH^T-GrB)S-6%nMG3y09c?vZ-(lH2v9hmG8&q{_=k4hD zV845>Ue)sTt=hXgly2SfT@WT_ynF54H_?^v-fWZd;8rM;4ElGVVRrMwg7(=<CiP^dNQ?bBjs%fBD*e!}PbJ;TjQ-zfCKT2*3CqCXiIY z#Qjw}c;l2M=RslprE=!4wDY&Vsc`)1xLzT#;2y(b&Ld457>~#u$+qd)Y|e1oD}p=D zeqC8n#7tJ#Jr04K*-E<@b-5JJpSg8M;j-KOG}bA#tPXb44BQEuydt<)Rr*}bWzcCj zskK;4)DN^pr8M+UbinLcn*sz@YtFA~485@a*{)+gAD#y9Fh6&XL8K>W%OlRDV>hK6 zK1Qm0o9^Ehuv$A*x>U8n_n*QHxBD!wUf+7rys5d{DezUCjpG@MYG#Mb#cT{5ZR&fS zjS}9UZaeZ}$#ni@W-}D#@l0KD%HPM)z~-gwB*yA^GnF>=y~Q67Tq+4}|7&#u0EEM>@7o5X+kw~_ba zwjG~bDy^ooCMC_Aail~xUijQMk*N!XLVvDINxt>s^82-u!M(9+s< zn*(2oJPMe#L|;fLxa(Lx*ufiawJ~~0e>HTQ_1Ed;lTO(mM&4y->lS$P%Y1T~X74f z(j)y49uYWOAt9$wR`-QrO>NnN6)jsIi0n?YS81EdboH$2uC^uC2i<8Q9XV-ruso%rx}WvZX7{7B86N>)Er- zaK(ewv3ty!83LIY7|z{em~v6$cpf;&6KbxV3@W+Il(L5LH`j~vTTC__T-E#Qty+iV zf_n$noaHsj{gN5xuzy(%kAGEr%7J^+dBI6L=l5-S$m!r0lr-#b@tAoX6}h}({WTVL zsd-=cPB!e-pWXd@mq6Sbg?WYwcUC{Jcx3&4zeiR3kqr-mCzq=-f7{o?Z*J$su;+%O zP4eqWaoi<+S%+HQ-#MC-V5Y+SZC{RFxWcp_4F}RE3l+I}MVdVFoa(Z4%lT5XQ>^dy zekc&`Zpq?qER=CP!U0K~k?P#?Uv*7bw^RgkRBU625HNPw+o*K#ai0Vv zOD@%zbWc&T=gTDZu59y)ijB<`$6R)pAH2xXIP1T-=X;AL=|tCwU$We{^4n~%*kiH$ zde6p!^X<*frK{Q>*3Rr%nznvt)XzwD?%M~&W-Nlrgm2r2p7hy&H<<~4WJy`U z_$Ph({L)PuWO5c>(|UF`u6A?yt^)t|&CzpTB{ozsZ!Qzrz@WCeCo04Obm_LMyLhH! zt{D?U5EBDK*s%{m$+>QhmWTF=$f+IS*mvt__2J(}s!i$~lN8eC>}8BFym{cqn#rx7 z6S$EI%8hJCi=2DF3N##!GPS65NT%mAY!h+4WUbOXG47K~;aj)m2^H)gdqTN%8k}s_ z`hAU8+54CyuSL}L(rVeOb{`IyrSr_coP8{=^;g>Z8j*-@r-qAD>m-Bz!Kx9CgvtA_ zsQs^Hy|PR#>zj^e?x*|V4u8!hy?qsWxia4RY%8#AP!D(!aGKBf{+iXZHnBz@mN_6S zF6dXgYTb>jr3q|iVM4S~$5T$7D?(8>H2ejoopRvjX>Mw;U(GaU z-Ivn|&PLqqayOJY4}1My({f3EbpS`g;=L=kocD@qJgR*yBXENITV{Tpl?gxQ%)6Ps zbisjHBHc{lvkxxZvR$W9d!E4B7F)-cni64$<}FAOjo6nIDZ;wa_CnL8&;-ja)ukK$ z?_*daBHEyPbd#BIh0-gtm5d5JZdE6Rk8YK2YkD~MDW|@+Rb->6wu{&5Z~Lp(RVZ0C zNhcotwDVEtlNH|@*|&um)Z{TSR775M<5ilF ztC<*rnHU&CHyF>Ev7%Lr@WT=Lx?l?|Fx9ChLw0-{7(fC%v#K9#dA4phl3c?Yz2*d{`SMAy}gM4AU8>+-6y&(fIzMR`_+XBU=)Ft@E}`w#Z<*(mK8^Xw8Ikt~|T;FVyUgFiYkA}>u75Wca42Lm>Gm1T6W|Vs|D9@ck$uS`&Mj+BRVeX(VOYTU_3BDX=tO8| zu!jTV51+S*74d0l;KkgLrn3t{x1@B>Xx3eE_Lx`yzh23oO_vr5%)KPOmU~~%v%Md$ z__baUWs#V|r4%M$Jnz=Z&RtC>=D*b~uS($dWxU#dQny0nGmBW1p=_A`v1hDeQ9Pzu zOuComsbAXsG(i|N{W>$?gb$w^vUe6uXj^oa*xbSWk^( zW>ANdrfjV1hg6gIz01qG4w|wuHV5{b3LWWLUe+~dxuDCxoP5LMds^8z3O=s=wDiZ! z;*bE4*JsaDKXOLzJU7n-^%j{k(HTA)trn|BiG#FNEncVaz(}iQQPYf%SNt;ndkg%G zo|Ve{S?tw5bB3k43paL%f|O+~3KaMt?4pkX+;!~zOxCU%2lR7J`@kQu| zT-&W^?V#ulPj6?;+tK0iD0zMNHYweh$Qp_0-8Z*yN?V(|nz4f|W4a5V%rRY7JT51A&emEHEEXlwFX zZX=GIXl94ionL~U7u^QQ$A}(K$T$>bo%8W&*6}Fulz`gJpiN7MCb&9T)~#Cgy!7}n z2c`qO>#fcFI^uJjf97^bf7*4O-On|6`NK7zKBwKkvuZ_R?!BUPAxGUmTvtyD|KJZ~ ztCN&e@_%68?euZU0w=MP%^fFa)fTT_Bq4R3CF$smS=wyOo~FFFRC;GQWXlGxypb5T z@rU|C*Zb4l5)@1tXGK4r!Dyn@>zT1JW#vq^3rX`@#H1V3UDCzW_yPnsY`w8<#&bR9 z<&a(Gvm-lx`n0a=YGZ89)VOXvcV)wmw7aj8LH%~s3A@*_UGmLMVzBrjwrz%j0At!# zHY2lHrjLp?|B&1R8ts1>l52Wmc}@~Tnwyj!>jv$NmoJjJxvUQqJ!b%&-qjUoqc^AG zi0kgV0nLXJT$48Zy3urKt!Ghisx5dM+v)$J-K?3@ADqsRJLpta{JmD7KS6Q#N?yt7 zvsoJtMjITMrg`o}1n)N^BQ>@K2_hb+PRy{b>Ak&DpMhKNCez1~1hXcF&PyGeS+39G zPAHzuIO~0PvasgU!;GNGhb@n|j#YxLhk4{YE0l>LoQZ)!GBSn_c8RsqO5WcZ`yvBXv?zq}JQH&>|yMw>@Woh8m=pCP?MCGl!k)4{c_0Af$_0wjbPFNhqd?~RsU#z_g ztT6EO*{lctr_ZKtFy9*ZzNsYQd)dtu83!A-b{ud#efIUO_1grKPQjFD&xf!$ar|s_o z*`hX2Y#m#@KesyDrncAmzf}*Oner=N+hWtj8{WA$()UGjX+;?vnD*07cTbR8$jJwD z#MZGr^5a%#3)>-~(HuCx?`>VnwX?ppp^4>(q{Gsi6c{=fxdlsh%a_*0xZSl-YFDh@ z-0=!DK(Fv`FL!ve-11goXI+Okepk*!Fg!l)bMp{LMG;tq&2;W?<}Lo*>dSQ8JQb4o znOW90ILR#zSfkpm_%7|?HBhepSrD~D>d3vvrAZA@zi-T4F>_#T+ka_fZ;#~LX-<$O}lB+1&^k!zAwbo2Prw8rZoQ*LfP{yOWyC%N^)%noY{-uNvk zmFLswZR@z(Z?opmiiTZHGZd>g_q_%=yMc)zl8J!NUfDmp>0H{Pb8WVw zIX6DCUvya5!)4r|@aey36{BdApWuQ;ZTT~lnq;e8JC91ICI}p~4oxYTS703KuzKm? zO{xFOnRurqYza12|NW7v@@8`RA_K9c5U*IrGXmwCB_zOQWBmz+aORAOjD9=<;VR9b zBx$U~9K-9P%)G~n=h4}y>*?HK*OZbZj1Fk4`cI7!k$jNFz-M&ebVtimX=mf2*Bz|4 zue9;Rx7qt_oDn{UFn-1ru*=-l$i>SFoF3 znMX`OF7(d3!zYq-kG>Gg`<_@KnQa!;eY;koePhsK?;UsB8Iv~63^>?!x32K}mUPCM zE0>wCj+_q)qa(dM1*Q&VPt@L)ESxXw^Ks|#5^nF*LL;d|d*$Ppc5r111TZ$R7~Y)8 zsLPaR@uTNX>XN<3Cox4GHZrKIZKzme>~QeMR^}tZvOLX9DX--&>*{Ds`F!y0z5eJm zr)S&+6|xg2f{x8ge&;p6Mz?v%`J2=3>gd;QOGwq7)xkdbj&}6gKbcR~O%V$Hv~glI z?}T|fcjkm@ELe7B&Vd5M)`sJWk6-=e;O=f`uYde1)n(GDX~&q&a=Lu#4tglPKOwM1 zhJ6Er+U`T4TNZ5dP%7_u#p5V>OK0<^YK{qO1(SlA7^0XM7#6G!khOEIeQ-VWX3)X5 zyZ=J1ziM+i&ba&4^~%i+9<0)3QlbIUH<<*xBb*PXAI_8atQNN6|06tQc6NoWPVaR; zYuU@{{tmi@eW2tg*sGy;Ev;8;!hD6U?yCwD)z>n1JbF}mu;>nGc1v&3jtE|r!#ie3 z%m`)NwC;R3pMw9C%xq(Kt>{0D?+rs8yq5^b^DWVcJeQgoZy&~V{H2Vzb5O-M6Dbw> zsbAR?=FKwXI^?EuSIzait;>f$1%U-A@j5L}#52W|jkjJf@%OvG^t1LSK8Z(HZ;IQb zJFSRl(h!rmDc&vr({e}A9xYR;T}-p|9I$VxU{yD7fs&@Pc~mZMD? z3?jdi3QIOWni6?HM0YX2>gnt^)z{`2>YRNX>JVg>zBcAw>(i_TjSVuJG{QQr3B{bd z=lA}L!Mp<*=b4NyO9V-JEa;u|lr6j~%%OGts$0eH<$_taEMZazGTidvM8^h)uC42u zFQvK!9lZ2)dY4vdvg&7tqcJ)ff2Z$enIp%>5v94qT|;a!%N)omb@0-5k$}T#`=gU= z0u05w!*#egEo^xNzO2=poRsQ$AQQ3Z-kVYPLcnPj!3B%L93qzsgl)88S^k@`Y13i> ze?_nNoPP`)F5EhBe9EI+EU~#kCHI|IMTG3&=zGJ=5Y5EE(7jcEzsKeojax1xolsjX zZNsXl%rJ*B=%#o!==$4}&v&$nImhl_QXmKl$;Gp;@;HDNC3(H)tm&;ie{G(D&e_GG zOrATxEtzVsz!1l);>uvN#B$r80zpvt{O+Ew&Jg|4#m6?x+2OBKs@4vLlt-B}oD4F5 zDlvtW6!aPH2{Gi*vTAeL*j0D;C1(@EO7ZjQrIHgjoQP{!e*9Hp!vg;qQ{PP#lVo#r zmEw6dWwu3==V~=;2iN0YdGu2xSVZSuPqy5v@j4O|GUCGi8>=0sIL?o{TdOwaY0y{NB`9VCeD0%WL0(GlH}Q^_eEIoZ+t%~ zCGqe*g^4QtKcyGkD3972G_mPfm*S6WlfJOc3T+fUdUloVYF6eP$(hEhud@cEaEG^9 zZ@YTn?nYkA`7QhU-nvgsUDlGy)YAvLnweGl(W>w?M&_KE^|H6K7;=x7)ta?_k8{|l zufeq;3$vx=Kx(Mh8WQLk4ZwIcTW9QOj>>L zsO<0deBM3p9!hu}+xLKDlIemFT^sRrM|3}hF1wln^2tBh+gT5I1f@4!HCQOF^v%E_ z;C}Ur^*bZ|Q^gDpOf&4bk!8T5v~3pCp@-{#$o1HJ-M?b-m$$BKPLizEjy+dKJj+d6OAJQj~#wny^i{ET*5Bk<}MqZ9SZACMqD~nTx#$$ zQ|{3x7KU>ZKa}TPdTn+052)mKD9XE(^R<(Zf<5<*B6; z9Aop=7)xm};K`tIqJKbK=s!%z0vK)N~~hPB)yIRkHNUsVGVLJMXd@Hd(5zU1rvC zTDY96VTTRlh0`n%JMPNcA7VWaboli(wLNP(T6nw9Pk0sRemQYxma~oF*$IJ646&f| ze*~P&RxX?6`iUh?@RfwWL(kMHx?XCU9ILZB7z(z2IPiMIrA<>=Z>s3Go!RvDz}cpE zOJioLZwM%xa$2mO^@NXhqvaIS7eyLcD;O9UryuH@dp_j!+$fDV=58md9CtD##Wry7 zkG?(OJV&IyM!CZpu}Pwr*RHj_(DaG%NEM^_$D1eWS2wT*ZaaEm?OlF(F^+&KOvT@g zR<$f@>Pn4f4&a+Jy?T3@y}@xUhSv4Frw8_mh=wq594OVaeeyWlc(cVcjvZ#Zx3(*G zt1@u$7ViG;EF;Ff!|(k!gF}ZdF|bPAd6(+)M{d5Zj(EYv2j||gOGFqga7Y7Hl`;}- zYZokO@ZKA}TYg5eYr~^I$F834urM$W>3b;_Rt zedR|%H&-!~^=qyZ?rRnJnKWK&3C1J^e* z#c4m*RPT0TVu)j6U@*-*$Pmp|BRgf?#^p8ZCE}u7Sw-&_v3mZD+xkgHc1l?Dj*@^` z({%;>r#eB&&9M*^cd6hqQ$j4KDa!|l+X|N&HlLpRPO!rIFM=T z;KAg#TGQ*I%|^+N)f)|qMUI;a*N)%xIs+u~iHPIs}fiaI?G)HPAa`60AkAVznd z*jJ};E$QBKKc^q9W)yA8W!TTS^_(yF+N7o;1+SU<3l@FS{^Xf(?5cxwAFJReN7tv} zPbMFjA$9+haQUuww$ChAm@HO-%Jbzr4rZDPXfrN1f3NJiW4?nn8^6NuiT%8@#g+Ca zEaCPIo$?qo3L>^!O?QRvq!Y4goQll{986A{xvK3?P?_l8Vic!Ue%o9q9GwBcf8#1h)I1qIrF;4qiq2{?=GwgG!Q!-#=cv=UHy3MU4?b6 zr{42j?KU$JK2Q?C^q7euo{52B&#Z1Pt(K4v*$Wk)-|+EaTKDwPovjef8=eWhO!%%` zQgkP^V~1`?UHOVQo7UBhX6bQPJ8nBYEpLD2>L|i0;P$#&GAUyE-C7mSHP7;v8XbC5 zu) zU#+4zjDlM>R(MU6n6gEYVGbiZdsG0Ih*J=QTGajj`xrh6{7)-w{sBrWDGR>F@;-8U zZEeVKM0F83m|0zxzZYl;`VgI;&D?$2H&ae$?G%g9P0Nz_!kYDu%H$N>Y~<0Jba>AL zMg9if@PjjY}WB6>5yNQ)klwOO-+|0ZZ zQWt5%&LnzhOBlCqTZ)(SmY{-^5KyFJ-OG;*rfA&5vcLsctKWbb>oxv zV-ub&o#NB~;Dk_p48x|9&ClvLgYsB=+p#Q#ld@9639n4pk1Tzb4(fittZhG*C9v8% zW6!$ZmvRm=L_hl>E9G3am~*N4w8r&LrL3QycYX=2J^ArD=*-tsXJaxXw=^zTL4-(SB6=>65JKjoHh&1kMXZAa_meqZcvlYMca`k4{vN~*gm9vo}B{XC0jn|H8-v5Ggd1AMlO+UMD zS%l~uIcqZ(hVy@}vrg#$mBPK|iqwNm%a7THo;5%H{|%_(KJqJdwc~fyZ-+&`rq8{+ z_rr_gl<$wvp8QteCg3eMCy#L>2Y7vSBJ+&9e`c-xb9A{{PC__?v)xkOkQUkb&TS^j z-KQP*E4|;)ShMBBgq^eFSAY9{gIVo-x4(H4mt*Qyv8N1+85e0TSUagKi}j;T;c}r~ zA<%guve#bPURvN)G5b8ehUkt|d& zc718GwtQ`4*Siz88dIFx7CkBa>;PK$%D!leNA?1zhi7CB>gV!?q}XlGlk2e93_f1R z^3sWo1ePu^&W#I|*8!iG7rj}9M>_bgz{<7+tmg+WJl z-h*uAe$aLyt(Zo~)y7@kxzV$RifZ~dkuXVRbcs;ndR;7bU#QGoCi|-CvO= z6`-~E%=51Pni$K-^YhxaFo)Kz4ar=Sn3p7+n<5>o8W5V>u47T<+*z|Wk0P@NCDO;)&Nglnmr-(X{jQ~;IeT;1w4A@WrX3OapLZQ}h!ja$SF){Jca6K^hD$fIPMtOP zzoW^=R++T*%Z(G_0*QENu|;to|l)A^plxwgqP9UB0bWCw?1znk{-Rfcx6^ zjtMSS)v4D{9ksq8`um-ciENIk#JblHouG{ex|^Py ztCW~+S}A_M?-JXkK1U9fU|};@UOH!!;$aLrgGu`npY#cLZo~QdZ@3apl*ii~>YHd* ze&A23S-?cg$%=O1gQB|j9A^7;(W&jmS>C)AP1-Hpf|usXJKTED*ug3AkyUi+{g1(q zqaBWJTFa=gu0jpe%3J2a`7(=P(Zh-VenciRC^0c4gYJJzJ0bBn#8V}#KoMWgryf(?Ot9`mke6b0=goEfD#Bimilw?O~%+-!%|E(0mUBkt1N z&I{uw2DfHAwAO49D0W*HacGVpcgk$fV&1d!Rxw2-a~X^6c5YmvQ{5ImGpsYdWP#l4cjEf}H6e)%Tsy=C9%YG}ty0*$ zv_Z`A`qaQSP;=%gyd75%uwr-`jv%QkDP((L0`83Nvzyq;%e?H054NE-LD49SvpWxaES-b?P& zPu$kNK~b#Spv<8fNld3s4J6&p`_AH>V`xrj+w&?OMh2S}WRafy(r=bq~`t zO+d|(gGDK;4?Zydc0g*E?X*o>!xS}s?Q03;KCE^68pq;Wbrrp=tdWL}OZV!r>Vc}~ z2lmO~UTfA&RV+Cc#{54$$JF-w6Pt%=+HEV09=__~6+GRtLMzv4fpFfA6;@25jMCd% zb_d<+UtVVLr-wInc5KMf*asUgy9Y2{5tl!*>UrsU{yTfy{BpSBmaI~|n($3>_lCeE z5ig$3b$i~u4VlBZWR}?+#j98NB_|6sg}L7OuE);7#OS`Uux3r*w3(- zQGh)p#^mEfuj zk-1zS;IqVd|U9S=*{m3!xhz2OPrIM^M3!0p5nDUpE5W*@J7yj8&z z_k12pNCmrq<^&$kos)aGw2ovksCnG#&I~=myS{p^ZK|)L=F*d{+)DL+S~Hrt4!+sn z`b%%M=9EWYQ|>R=H20Hbmpa4Vjjtok%J(=NVUpM$X;yyVL-@v1TbvwPLna=n3V&PD zEvn0KHe2IS+jZH9#k>xcJ+60Ci;utd(D6{v+jjaHpTyaS?UEp8<}cqiLtvNF1F1Hp zyo$RU`Bp6KkdFIacB+kIlf*}dhHjNVoW@dz+jW@Pi<)1_uq#JI;TZGIkuKFOk_GaVTyH2O@QLI z=ra?ygwF>1#;O{;7W2|g)`|A*GY>knemL+~cZ&qqL(Yp#3~5XZ3}&1!A8hZCjw?@y z;c?grVK#JYTd;~UFxZH330+dy3-K4bm-tuKn3@GjRws?~c08Hk=(@uEjJqgX(5YK> z0f83{vZw0nUg_F(^0IK)a=u%CEqc}-JytVAAnh>UgBV`$>FsBD0vg4%FWqu;=BcXN zurXpmJ+sHVhJ&I#CUvh4BrI^c@w6ZyFz4LHWYI6&St|=nPHGEvFA9m6S7g8G>dg(S z_4hT{JQSSfq1j>cv@Ri_jAQBR6K}H=MdepCL_HI@-L!VvBW6)?!B)$+QP)|+RC(&}2j91A?e}d7_?fEkmVrCspxg$pWhztVoeX|< zu9B-kXOh+Y0Ee?iBHboh3q)u1$j8K!F0E+TxOMI%V^`y-dJloPr+1`6e%v~| zLS@0-1xiP!UHRF!UB|LTF(hA(_8dk>k2 z$wZ!wUwp-qUxNL)jP+B7?{6f2J2%-EFZ#Ybe%``}B@^WZ&bVstecl6!uZjdu2uIc{FK*s- zilWY^-&Q9+vJX(K*|FuqgIUw8w=R*0%DaEM{h&kZf)h(y+3veBJYtl&QnY-U2uSV4 zIk{i>Sf@VHcEnPP|ff|8XhSLFfn8>F)*w=*701@E=c^x z9H%Sn4HFfn1!b*V@JRB!Nh3p+ct^#*vacfRGS52%aXk8YIy~lq)TAD=tnCTvKeR;Md&(cvirW8DtL8YmSLlW+S@MHt)GlzGgdQtRCw&>(Y#={s4iR6 zFcXw+stq%5E9_x>tFW{4+b*jaTR@`_1qPX`8CPsyxpvvS>z`Z1$W`&sL2ku_Mp3D!tAhkCNM8-q+>ye4Uc1>J{8h5h4alPPnUK?4< zBDz-ivcM7HfL$pH+gg`3l$ooVPf`DrJbhx=Vwcrv9{iw|^R>)lt(Wg?i)<1%W~tx2 zL&n60?`>Vi7J=2d3$L?&Iz1t6iDA(VbOG1qw z-?IfyE7B*3-I^G&{^A^_Na-7QTLjMENS5$bSbECq=9x_M6Jjw9k_je_Q~zS_q7#gd$X8Ab7a_==a@Qenkz4K_Oqq^I=_iinpUnb zmI@X-TfDtZ?x_PmkCs;4jjK|ABB$3Y#ChLzx*vX@C8)_)vq#BLXUB`v2Yzrp+B!vd zPOWSnBje>9g%vv(znUI-ut16N?5o)hUZ+IPyf9NaIMM&;#E40TO@D6u6^NhtQR&2t zql@*e67=OtML8u`Eo;9kvgfjC*p>qs#^G7Q8S#v3moNTr`}$sO?kZ32txT)7_mt`? zKV}sTvT-!~VH6^qVb3<<*!rouwLb&9b>vLt3@-h6`{aJO-Lwo7sZAbwySZ4WY6{c`Q^+S?_1~qN)3>KXJLndUury?)wI6 z;tROt$v=$twwiQ~P3?%{1g%124QAoftS$+w52_T+Za-~X_UfKaYj!?pBwocPXLaMT z6S+wmc2ebL8F~#r1=jD}8QCPBywQzy#w7P0j8cpezRXLW7CtoDzGwzgkx-QLYu0Nw z*KbW4b=%rDe!HL$U|8v2Ew;jci^jA)D(r!GGQBjvTbMO|TYpRQx8tP*CWb5~1_oh| zmopbh%DVR`95D1cI7O!!w9DgJw#)r6;T4Y zXV%tu=l-IjU)WZxs7MUYw$Q#}-Z*8k=EjRN^SJbC3`N=5O>wxnt>hLlMbd=MUSU+*W6WyKEk}GZ$ZDeZPgv$mV0Uzof@w z^K~_RC+jyUe->JHr+>qSh5|2zIYp9&rDm>T{i|Ne&6;f(?yHdcj(sneoV!Pp0fVEM z>AE{s42%Y*>tqasjs(Tt%UJ#@N_@{{MZS+LIaeA??=UemEN3vXG31Lhy``z_GI0W1 zri`EQZ^bJY`1+OiPr9RaVINbL-2&qmZC}{VvKq)gGToTVe|(V?Xz5n2bAup&pfUzuTX=nSp^ z(DmGM@)>s94U_JF5K?w=bNrcJbB`rRZYTS7`BJsX`^!GY341X9ec^VEnU5ZkRKna@5q zbIUQGaSVdkeI4JZmGS}xD^W8;Jn8-DrxPV47k=(byM6VwuDF=blAxJ~LukVX7;r}x_u8gv)?@;(<} zlsocd#@0sH2S-0!=dDeqnZN+lJo~-Tewf)BvTaq$A)O@RWbKLQy z)mrOgpp(sB9jF#R^A~q*`@ER_fYR&o zKX&nJXPW%EyoSm2vnbaJevwU6y9@44jCIrLy|sAf(yr2`Yx}e!+h$x{^DrmW?Ux19 z!Hx+cOnYRW#IIubwGniRxIqig0kaQ96Xb8)d|uB2V(btWTcF%9z4;G=yvX+%tC?Q& zAG|-IF*8Yli6MuHfgyPA?|>`SS9rGFEZ5l|zR%9F^}&&~tx|{MoX_t0_h`wcrGfv? zzPfS|)JFR`^IRD71C`nBNunzxS32FD-Fh|=)Mb8ClCrwd@OJIy`TX~}XWBWoPB^r- zRciYQaVNg)gACDbVQIJbpAwB&npE1n@YZ9F11t7il~M!ULaL}dtNZz`=sZkNSl=qmPAh>|3Kt)hkaMMqoV;?IwE!U}% z-qdy}h>cm4!D-_k)mv}cf0%oB9tJs7^Wui94pJRwSNpMct%yiCF#p?QvDc3tYyg$T z6S!_?Jz&|qcb&B@xIrMkJJ(}@K!rleXUU$&pHn`@JlB@EceCx!tYr;LzKE{irx6pcUk+PMmsv@z44lkJv>y#JB5TN6~4T#$69 zE$tuIivJ}JXE`=n95r%(sZ;)=;AoME_s6c94Q_%W&Kqsm(tk5H{c^Z!GQG1X#JOED-tYbvcLsaJ%bQ?$FJM zxt;jNK!y_id8@YW=jrZu{kCXB)bH#E$=CePMX1ML1Iql4A0wUmWFF^w;!*;cIn|F#D9K6@T6ZXqAer zh`3@9FzH_?!zRWg{*E%q9}$`QUz#)Od27y8O)z{NXl0wd!6QI%n-6Q&Gwp_z`AnK` zyHme;H#6F7d~r`tBrL?>z_g3ke70R((3s(T$cQn@{$}cf7+h zxpPuh>YY0mt|oLyTlK#_o0JSvJu~0D#G|-a^2eE52lP^T^mBY2T(?7xs)}JUC^2-OUZ4l#-brlofpSgd#v!hP6DRA2o0 z1odNzr(<7bS#gCd$^Te&YZ3pFi=QrYfqDn8v+}N8Fau@n#_e0LE;zBxZ2nhg*#%A> ztn~qgkykO zcR{0)^Q7AyZEYso*}8aY|JW=tW(|0lv@h}IGd}r(>Q6_6MRMxcUPmtWQdoSnyXSoB zyM~|L&kn`(&AorAP$Xx$qFb`b!Mz8P^p2;tRG;Fx)U)v6!J3RM0ynlwH+VU|pZ+N4 z-3P|)?4FGe@;@6#oVWUSnqhgS-%iJ^3~cr7r=RHLh_Ehy1UF{ZoYvFe`yFQ$KCt4n zS=@Rc;K&&!hI}Rl2Hpq`R-pw6(-p5)u3vdsrc~MJ=<+LxHN7G2{*1L=b0ZFG8!EX~ z^~`zjXlLKz+0yQY+O}MUnll3DoISq5Q0qnx*Cb!#?K|_9fu)4GIyH5do!_5&WXol% zl{Si-3PpkMt7#6!fUTu4!X;UR{jM_qxDczd6 z+^LgJ3F`+iW}8cOYQ$ynZ&~0H%Pjt^%CYjC(C66U&41i^FDo zW;ruSh->E|hV=hOZ>D;b-phXVrkYv6zmf413q#HnuE0H4)SkD zj=$gL?Oi-4jWdHox@^x0*XNotM+H_ya^j{OZ$I}Ie)YZeM=c#{N zBt55z%c;5hFRTBGx`2nw3Gs*6e*Schi|R^#`u+zcg{xI((hFk}2fH?O*d5e^tnTWM8%8(($){zpeeN z-FNnA!`HO5jaJ>glR+m@cU|GvI@GqW;cT?0Xqo+{!klXn52W2V9Cf#Ay{WS)%yBtT z#k^Td%q`QUHI~iKc1d<$Sis)+5R;htl@~alMYmM3hH&&KG<3PHZS3hy>)ml@jh`&| zq&BCV)s8+fIY|tUURv=9aW2rzW$aYglXi|zYtPo;eNoRlHzvk^K5KMk1E?G@)!Qbu zqow<=gi3_UQU-IIM#;>3Its3!!_=Ck^|nd7hZ-2Po-A%<_*rm&jnFRJT*>aGApz$>O`D8RpY_dL zqT+sEemHz~jM=^LV!ZXHxPT&&M}bwhIevcDWO#D8cC*(DNky({-Y;j&+X}K^m8rx6 zr=zXHwsse41g__u_;S5(jrbJfR+TA6CF=EdtfIWLFWJxj8?%;cn%UBNv)_@7wO;+R zxD)oJ?qCej$kALnt?HVbJA<1x7XuS$_N?N{8d*z5{pI&R2H$2_%2=_>XvKtnv1{Tt zW5v2W8@xa0aUY#46tB+2PzXBzWx4Nl&U-JJ>nk4lS(|3hYxue5z-}Fpb!MSY%5E*# z$?z=tW+PjOMvmZ8N7>0B*Ln#yIJ9BV3 z*;<=EMKY$kSG##QhP{1nTJ4)Z&G{p!^mcUHzn0D7#dgkX2_?Up)xT(QD{lS$Z=1UY zx8hRX$jh@`Pfjs* zKRCmKyD>XJPVLgS9*f6moucbmK?nFLhHR5kxLW(|aCvK^jPjBIF@@`IL@#J*v>44= zpq8@!R%fe3Zj#d5#Z_GlUHLZa556&aqAMpm?FXNK!a~i#O{BgCw23YVMvu)e?2w(`N;e+3=t??Qgu zs$jZy@5B9vom)W$9yQ`z5pbhqabQLuxF6Xl#tG@PWzXZ^U?B2K)}HscLx7^ZEW=dB z6ABw7x_XZ-;;=NysopH}6TC|x&^On#BVNu-#c0-CL(dSl3K6T^#etK(TbZJS)`h!y zEd2H`j-7u+Ns8nS7y>#K4f;F7BnasQSUYQ%N6!u0Jz-6TWlTJMWF4u+%7hJFASD>#5U8mlD=L zS_=c@j4EE;%32T}JKMqP&8p0=pLeqcZ|QJ|h~1s^aKp)^=JVFFb);+T=DD-4PRC%5 z<*QrmJDC3(O(?55Qk2S|c2+kbl`U^@51px%l2P$u~?>}b3dBk567&ERz24s?~zt&f7;ZigGUI9uB-if$>n(^x0zVQt6s;LzhoHkuJ`Ha=R` zTapE*KFnRbgDWQQ+GI!22;I-s7sHr8nB3}LE>bvquav^-ua@aw5PO5?DjFAoy^Y|JlbPT*Y-TiJSd{8#P)H!wiw^+HSPP?vT=Oee)_=M z)!m_5EJ_{c?2gF3nBKVMv2sw3bz~7^05~OMk3+cl*#K4lO3Lc_IzHGmF@JmYJ`9rVR=k z&AlIUO($qB_PwGnrng{`kN-h$=Z_y*(i#@nY1~>lWtBq10+SAA7XNG)t9duRNuNG% zRTkg#CvRbH_2wsKpx$2^$idt4S8H+{dD?mQ$*jFhuQWHfczr!E6IR||n7Pr+z-e*A zzC*SxLEqv&`0ZEF^WPDv#d&P;gY)}rc`U-OzsLjkGjDFs&Y7ZjHzhPwYD>_rkdwQ9 zZvQVLoGo5$mt-Z|hFnTeIdasJLO|?7x|{;Nw1D9~;rsklxit&#;Cp zNIp7cQhu;NYu1VYXV!L;dZ-BDwB*EET`ptteT}sQW1_Y0DJ3wVsfLeG@tFTYV7#qy+0s=zs}e9iS2%-gw{$`&`K zd%WE@^?BG0(bHRvHZe1lFflM3$T9uFbtdfcP2~!vf@d!>w!L#ta>~53{*a#X-awH< z49geZ+$BFF!BH`tL+g#vCB@mFo=tL+e7gpujw#oMV@9l7)#4T2!Y7s;?ch0Zse>)T zoMpz_z7E|`7lz>MW0ITiUcZ&6Yf_p&&6WX_`n?#M84CoM(^fZDL~T)=9H?;YTIz!k z6L11p?3SZx@~xCL+C2Lo_jZLtzr<3#npS-~wJ2=gjJ_3uq$%Hta!Zm2!YooS}Jn!h1>1rPt`ySFpnTx=@$ zIvMhb<;o#fA5ioCTjujme$H_?`BFRzQpN?qX>&71Oe z%hizT$?9fJ#XBs%JGvhD)@Zxp6DY5R25a2r`#3e0&5u>O_1M033B{W?2!c*1k4`IC zzIRi0YJpX*>4B}6!!CDTZew{h)!5(+_q-bm7fckMy`4`$u|qO4G46Kb)WzVTE`%I z(er?D-VTEjeyyfoOV{WJJT!Rm=h~Y1%d?+uECc217e}s!G28CA#j-%mZXW;r)3?qr zi!zBOMXeCMkS@|S&47*7(D_?hp~5myrDVI~R@Q<=6|-k}>8m*G=Gh$~FHt`;mTgD9 zS45~lNA#`KGW$y*_ut$UGi!{v|KaYPq=$8z-u@^FE;zV^afJi-_A~F;yO)|(pLMwL zV`fO7sLX7KU#FLtZ8u>~4E}J)MEc;T0XF0UVIa@4^-4auflNWkqg4;_m z56{KVrY$@^!TBZgbk3;zr*?#7gN{f2n3ZelVB>tFS*%K7BKVLH5&d4q3w~Et?A)s9 zVa6H~opl9t^#8JkUoMJlOV9FfFJid5VSPiLd+8Au1#OWFi&pl{*wGfx_||9V*?mfF zXjhA5$v8XipJ&5YKtOX2+Iqg%Fo!KK5((sK{HHrFpuS`neYxq>OW@$}hANjpGI z@5tzFQZ5U>9nR@mk+xp`sJZr(hoC$&udsD3o4xRjJ?lysrp6VO&MWBuu66jziJq+j zFPN3BXDi%!bG_$FQ6;49xMQvm0-5*YC@V@n*FNf9IN=xm@)J+UcIdDzr+2s-tt^;{S^_LSQFw5E^%wE$xmIfD-oU~&YnwgY&~>StKn=Ir~$n6 zn6K^X_GJ+XqFW}kE<0tFl5Hw*Z`-rXtPX9L-=K27c*~@FmB|9^53Ai@hn$Xg;Deb1f zf>27A&0Ngg{&nYc$gbqkG+V+d<*9vhg7mp| zFEf{>%ljwsK73Gf^4bKEzGXSQCwV(BC`LPnunGN0%jQ@na3M9@V}XF-CR3L%jz2f0 znBKIq+?3k%<&n>}HUkwcn}WRTjvL(dH>DPRU*xf^ZN}akv)3xFJ)9J_t!+wbl6kcA z5+lY*%eS@tNM#c2%;EJs?ZTOo%X_kM(Tp?K1g17}=l)H8ZKP$>=5W;Q0;hS*gFlY0 z2f`+R>fxMoC!RKf%Q9Z)Fi@N;JS^NMmBEuD9Q^Qf+oRM6w=|O&^_gy#DF|wFutcm1 z*4e(0$)RfV&DGt#^EDqv*%S|3Fo(G-1phIL!o9$O{yb9-IXylq7Gkfo`yw_*%>;w zeC=+-Z~FV7${i*rwk|reEq(cvE!W(@|sbpEo@cOIbL~K zxhkF3di9vCbIE}f3B`-1%8K%CZ6zFhzYEH&oO^bN%4atS9q5jpJN3qeN0X;2 z&&$vhSgsBpe7M0b$~b%bnu;d|4j1@DxUwRTD4#yi_*3lj*9C`y*Upua$X1+CaWhE@ zltZ3Gh%Aj_I3hel@m*Tv?46*B$%FA$Rs&y#xH5~+W<~|Q6@S1(fEo+dvVAep;&y(<2TJq4rz_0+ovqjKQ|xkCz`_ldQ!ZIMf_s$*UvY=5*io?P_;s6f zNXOjdX%(nrp0k|ix!P%K)w&gox1VrE%%1sYiq53GZA=W6ObiSGlJnYj-`AON6V#3h z=K8Wt>WkiHMWdy{;zbho%sZZo-aorWHZ+<+e_h^$n@xwN1w+cOL9g*6-R_2qHk?0pq?BJl+Cv*-dH14I3s=@&0@N3!KH?`D$tl)0n2vSn^r z&1M$;G>&&ItqU)FFuC*hLWW}4ZKvsJ-bK>i3U@~S-3)5qxW(kJK3H=tNtoFoMi(rS zmgctU>VwRDc~kKNHQKGLY9iZ?zW68!4zjOCnxF|?k!KUq>~2L!aQ*F@uawI!`sv~! zt4EdfY>zArbl)WH34Z^x>!aU%o+q8wp-Bq<3iYX>8xI`WbBs|x-%5RM(v-Yr&ZUBt zN7zFcs(3gw)Q@X_$T);`GGW*)zEum;w*w zwlhAuv7|7eYm;F%lY`suA6h%24&G)EeGyS0I-l_vhxVJqh6S!c-sg9f$A65Uu@B`s2PYV{QN+yIPuFsZsjoz`Tte`S>gT}2x zQ_mktH9f#T{q%uE#bf;sj1K!8zH7O~`o!5d^M8RIOQSlLKGis}C~AW1=|Bdbtqe1! zEnc@g>iXp(k*)w;k%jA&y4_C)PFNT*tyz{^CsC_&iSZYit#BpVUKcE%Zz zHyCc_F+`RzL_W9*HTdX4lYJbQGOmPcEO;~9Q#p=D*IePU6aSJ~%Ay`t&J%J%>)1TF zd5=xhQ3>ZQt+{)gS=2Z1x=?E4?Ov(39E~xiS3YjF=MOP)jrE=)t7~Jon@eS`qK8>e z)7nH4&@e@s!O?79ubFw9CQLD2JB5j%nu&qIDD;!NNI0{*h&tP`bm=8m`)`QNDw}+P zMTF-}BZ`4HPONtSlesJ#n% zG*p%{$aH~*r<2SR=BPP)%}Uzex8y+LOc9G^6_OKW4bCc9thw-tRrSJ@gBBO{KknDR z;?5%XOL+aLO8}4QFe_?eu6I~v9Y*TdA1V&NA$OqG{CpUF5>b!A1wPZmO!|hx~ zBh3{X_Dxk4yV6 zWWT-@wV`y9^ZG|hOt}+dum9eM46DA*gGEsDQ*tg@#R}TpLP7`GQ zEAq(i=8_LCS-$-OAq*QM&N#4`Go5>w^oB*$@s*Lj+zNs2N3);ql>k*E7AKXjGHkK? z6e!%aV3FvWG{-XxjyIQNX@&75vaDh)c-{CeE&lK=o(n~t?$ZL_Ca`HOxc2!LXb41; zGcSnu&nJ&K_Z$0)T_(6p3tTC~sI_3)-K|@h7;2ap7!n$Ei+kKxH6HL^l_@ffNtNm0 zYU|8{)@Pre6LvUs=%B%*bJe@8a;S~>32OUuE@W$cAcIJ(& zPQ|Nl@~h1$-*domC!@RDv6asc{TJy=l6oE4%gZS-MTfch*spmO?c74)0fM(yK0LOD z)3THCtLYlW6(6j=hOSmz@xdTx>mM^vMZ7NR{+*aksV1(8hd~`=Hj&VYqTXxoICz>C z@On*aT)lbjRbD3t)-y@oaw{9T6qvU(I`yfW9kPsR+|ksvAStlqi13ZSU1eO3?X@hc zOb?_Sbe*@z$iZ4-kBNVC;OZk)v+k`qng^=M-L7%3WDC|;*%_&Kt`gK9d)(SmF6$Dw7>o5V z)$mtam}7lxmdfvmM{m_|2V@KJDW9FKdYKm#eGS*5gLwJkP8_f9VptVtS-Dc^o3i{3 zhiq2MoBSX1!%ECSm2Y#2@e-*Am!}=S;&Al*m7vKRS7lR}w}`=fHbcuLJu8_QP>bbVcXG03?eQzspp{D}A`(C+ zk%3C_cbdj8%KylK*HSGtdy`+i+2Je5AfA#Nj;03$tye7L_<2frwq$&y8Uv4(fa8`x ztH0cq>p@p0@Z7j@u*-EV50isg#6~yK6O7gz7d74)P(Vv$$J-#?&>6aCgViVb~ zIuu(Now%IL+OR`M0CbcCPsU#Rh>a_zsvhMFTNB9oDe#Sg%kq+>uC=^t9L=|%UVm~+ zkW|RY|9md17**Jn6b+YhD9(~$vOBsk=DzP zoE=v6n7O^__}5dgZh?uW%fc;flFt8%-CYka>snJ2b|?EnGQ+}+E7+BOPgJ+B-}3uX z(+*vev*y~OF`&4UEK&&Km9w&*w0xza-o-_rH2Um<@-#+vrK<~UJU=B$x-u*^epMH6 z!Pe>Zvt@bj8bpg3p1~cXxA@r~@SFvzV{#fY4G-;XDl!edCHBi%{^xnw2{+#|%!$9t z#8Ah?zyO)RdTq#c97HaZ#!ABZR>b#ndFGw4>a`&z+U!iA@amGCq_x zm9JXL7;Ppz0ij9#O-mVVHZ*bOvac*MY7R2k*u!vSvcQoHi=t0E zOdHt6%ok2QX|Uo>11U@aaB7a12O;R34aq_rDb~U2lWm71^ibv@Vx?Jw1|aLbFrs zXY7iUx&&H<>Ne+^hv|&_Y@QxjJ*%&s02OsgOF;uDJQ_X+vYaXUQPB92wIy})b1T4V@mM9LK9>P3F z(!oj3qHv4bx8{|zx2l4JWkM>$O16Iz4n^mic-FE%I{Rxn*vUc$4Oi^AjY3ZLNjj`z zY>{wSwQ}oBKY$IA8$*s7ZT2>xU*fgeWKcNHT~kq*>^zIvtxwz5-FRsZ65QM zwe8?q0t(`uxV00q3|5M6n*X~c%tcYfW{t;;H|}y`Oy`-?C;y$WH&O^3MQVa;Cu9}) zXsfJmIC>~~zwXU`8y!Bm$R%AeZEwyp1#JSgXlFV*t~%)AGGUL_{tFLh-kkR4xOIe) zO@hXR!wIj_zA`g3FflNAgVP&lhr(3`dnFGKp7V-aDfWHIS3meHa`@)_XZBNlaDXH! zG=(s$3p#%KBCW8_QZw%$Lv)&!l85OHSC*5(-_urtjgh<~;JB($-rswb=G^yxr!qeB zTNv@F`ly@u*VZV|xcCFfi!+yUvS=}V2VJ(#Q7FCfRYP&rHrWMtJ-#U$2FBm1=b3b; zt@f7aBSkab9T|RI&QP?#*2<9yj&l~HO*&bxciermIRX~_exL^ zm*Ud1;i}icITM$GPEcS;Tg%$II-%vj(k<(iLA^sM>8ZzCFDJEyNapt3;M8SJ_0djs znz}|%%6C;`%FU@QJyRYTPQLSS_UV|5m+}ujt5Zvu&~jzUEMxF2Imd1ry*bZJ4lvDl zVjrymf6q3tA;G~wQPHL&9kO*!6rIVM$D^eg*4HCJt|Lk}r z(X>Ce=f>Vnu2biDPTf25$vNGB72}C5b7I7MJwS$Blv{MtD{`iUD#KjHV+)*3RaH;@EGgAYPR{Z7p})P9Ny^eD~pOs@}SUb*!_0OV(eXAh3gN?*CM9R3%P7-YV?Q z$epn1G@pvDMvTMTA8PjNtlA#<6}~;jC@MN7-~{g}X02)cvCgXw&dK)hNW2oGds5b} zRA9=)*1`oPjQQI@;r;onSkAljd2!B828*9$odoqZTQvK*)%!MdcKu=waEK9ecDVJ? zw=SlX=iuB&w|Gyvur5tuQ%y~hTw@x_TM`p|U3J^drn7&0&Y5lvx}-Mk>$;U$4Zmld z>eo7<&CL=J$icEWSD~Tn#A2(2AAyF~b41;lLXHacw2Mu>lOnCj99*;bXNO-HgH7@Y zh8c|CuU#=ZqM&)ic*5DOD>@Xf?^wICb>hr>4rbREIR&q|@#C?n=pu>t+FB=X8!;?x zpZs8!S4Z)V1B{NY8OxW&ur^*;#IM2C$NQTrLp^JY+z)20B`hb~F1?KX!k7x$l(cO( z6GIad1A~i+tzNiu;qpx$0xU)jx1VP?R$Tt_Wy-vd(jiO2l=eHeeq9^0XGO}N>&A?p-peAr8+R`KC_Yt&ZCU7sn_-W4&U|SitofDc zbYgPLzD1Mj;~6Rs++X9X2CB=1`O{MVI^?h!2xuGZ+039QA5yVx?*=Drc}=aAY#w4$ zWj=bCZDw4yQc*A3Cm2+Ld3?27$>t|AHRSTwB2y6u-ET`TXXLu<=sC*98B($L8{;*e zpqu*^Dnpl^@aFvSN%C8~Rj@K>v)?|Mkct3q&5EB36+BNE=k2IUt^u9*8`hz6dc|?J z2(b>8t!}nvV%>^Lo@)d9d9x(fI|;}=$Xe~AEgte?)v1tRot{hVda9=n+|6cSnyqWg z(cD$(d*qA%9LA|n{!gvQU62&_xNEoh^#ij*Pl1C)?!Mtlwsi{qDr^frOfh0sR^(W^ z>Z3IsY~})p*rc_)KfueZ4^&bRzDF1&*x__jng5wJw<;dVzO=)2h|W3wT#b zMExkASi-zw!Xs_H0$=X`nF|&5GdsVPaHXZ`zr1v4`9sKFHHC>HGpcj6wg!JQZsIl& z_UGl9-NZ2Sk_+1h7KMdV7&zUov6U^E?Jf18sY`F^gjtuizB=>KPxGC!XAkf1SxgMg zObiV9(^hW-U9&5BkzMU-Lfiw@&PF2%SCOeYkF(Yr&pN(-$+aD~m?fsJl)Kq)E^{)i z>4mA*g2_6}p#yU?2=xucqQ);%4S6QF8^jrr#iDId z)EL~J(Xwmenusf>&fWD`_h$F$=G_xRm@{@w)L~{{?CW=hxJpFvqgTK55$3`bvRqem(hQ6w;~fm3ljrF z*$j>3y$g7J9D5w!yM21k{r%Xa5Hf6PW^d{8#a0MJ`>u-l%@HUx%|f? zQ`HCMscXci?9*IRc(?b-eQ^i5hkuSgxhr7pGiB;@Gikvk%yR2mmnSVcQ_v3f^h=l7 zy&RVon)NSf@M$?3W5m!|J&o;8-=!Tq=T{ibk`K9J6}n-|%FrY+f#PWmvL=$=v!hhg zuIftd(_O--!@ED~$DYMg^xv2qHr2Ix$9pEK;*4hLyW}iY>4N?T3;&7)1cqHc*z8c$hGe5&Yk*l-`Uc1#jhV)-E<~R*(v6~4CoMr9=7G)P9=+{Yp7*2 zXU`B27T+W}rL8md#ruh059gXhoahVMx8>86?;fTS1^rL%Rt4$q`Bn5GM}|>L=0ief zm~s4+#hRNX3!LM=&)#~55u7rM`&+KK#cti3lAGWwob<@au=$e7#y=NsP7r+C$8wPm z$}XI8ysc>o5c7f5RSlaQubMEen#*9VmR5dn zF!*RM1m&R=kW9UR>#CP#!kS0c3kmx>Z&^CGLF~n!f|!Dw8{rOr7rS}ymUdv}ie;?z zRMfXQ!yq6d{Y^BW9x@UAaVq15^(*>jaHO;{McKB#`QTzO(doeAIOC{tzxRgW{(Q|_ z%}?hn0a+E>p`@s4!!+yUtpoQyG<9~{KVH4(q4Tt}jZ36XFa@gc^9yJ!`?a;J^oe4q zKi}i5^$p7>c8Vm)tTF3rZiv4#;rib+RTJ>3ZFQ=ON;W$|=5T?`;jEj=RCB_jNFj0~ zU&u~z_DNX`YV4EvFLO<)@Y3?NEL<+k@SxM$wOME0jU~4=rRG@_JGro1K2&-h>vCku zk28%=m@*npuCV5O(ITxkS1yDlXSJr*b{j4K(F@#*j~Cq1^^Gh~BQG${34_ zpW2SG8q{URt!8b#JwwxcnNG0&1`CyGnW-BDJXbaLb*OL_@=Z_Y*K(?z`2KT?`5T^2 zsVAlOO`@sE{~BawcQXbvq=1*$Zs0bLxu3c~DPi%~i5Z*aH<@Sui2|j{jDC+GUK!<2 zXBj3lsu+GO**n{YQ9tbjljttd@V6l%k2siKrZO?KF)=V4dYEEwpiwP<! zt-+fg%#|wvEneBZ;~~>KN7n<(rXQZ8T7G~b@%Mp0u#fO55JC+-%-tL zC=$@HzbYkif)AVMTsK9XwJRLszW+LKH@jouL?+v-%8I7o!zYd#X_nsTZMl&FJ^^C2 z5tpHMdt;zaZZ~7n)z7=Gv%iaT=2^MsM!%VwV*R|tl#08rnakHJws9qk&#~L2qovl| z)n~+N%xroBYU>fH(^FK17R>}5r%}8{9C!@Xh*MdWd z3O#PxslhzS3AL9Ln5TAXZr->iOU-@F7V$L+&=isF(~x>>$v=c zg<_974`zO=yj%UU;BaX)o0ijFN6!EbH*F?{b|wafwX2?&z6YJ?5Om4`x`Uzjc1PfS zmLzUz-5G3~Od6lfi9DRelo@jUz@;_4nk+xG6_!V8Gk0E&XH-nGYY$uLtI&H}?jY-l zzY&{Da@f+CO|!)s%0(tz_SwNuxPg=9&4QD&9JEZm!rx1-ZSYml{K}-gG@I${^qtJl z){6#M@+C0(lsV>YW^LuR5I4U|`UxlYguHd*c`>(^qg$2?(PTq{E`mX(nPr8SD!|Vk~?u@3rDLxb5xz6<-^0=kuDnjOxFZ3Wt1Qa|&J2ENM2OUo7b!%b}V)hnFnB&K+E1muYgKvOHs9uVu~yr63oHmYo|< z)HJ#=xc!}($Sf-ECv!g~>eLg-CTqte&|yt`4MaXYIty~D;xk``wg-HRe?E7wS?J=s zz%u>XhG#auXD_W$ly8)_Fk6vvjluEJEr#Q4Obi`N3=FfL75_4HFl{th^n+t5ua^BY zd&h?t`+U~@>DqIcZR2c*16`Lwni>}TN|8+B5mENBWjk}ibV8l1&#^U@s?C8Z^Y)yP zHK@Pn1v(y0Al2mH-Wz5Cf^I*~ffq}!KVhAtAg}u*L6{>tUWU&+MKUR3$JJ^#?F3;D zue}F8O~?~o!SHUSgO~IQ4`C1R9eA+{y?KrgnX-;=y=dFEMSb6aPxVKW8t?Y1$GHh} zFJ=&Yptkey^S1uw3>TTFJxTXqTYO^9%%i63wm3cwe5uPUEgtuZEF0)@*4?PS%P+nJPMGiGV$an;0v$xcW_;i|NdsfhOZ0<8E;pA zdll_`j8A+nbJ#40sI`x+Qr;9?v`kpKbLrJx=MhE zxEC;<`gVAFr%&9Zvric_LmX&8f%k zH66N}lu~HZe62j6x2G6%otgP@snTO_xk46E@Ku(cyg5ZLU#a}$ zahqsqd|N3{G_z;D&j~is*_rd|XK{ruWH)lMgAF_4!45t`fdCsqxq`)0= zQ~zGJ3ro%q3`SLHuyd9@P`hu<%?DV*hPv3jb!#Q)BT`$hNq1{At%eNp%B&?&Fi zYAY%Zy;lkm;a}paJT2`fawnryx}%wIKVsxQ_KQbACV17W%DY$1tEcUspLTwg z`U1v|Z~>2sQwp4o&x`M0o4QjNn&A%RK6rJzF@kB~eZC_~IaMFSyrp=!kv}<9gL6j z86@70tOZghDLyiLw8OlSt&2x=yWsk{i@fHmr>yJau4ng}eq3r>fc1q9 z>Y)8xDtdojvxeO>xx&51STIUVV7mIfwM^Uib7UTUVi8bRX_J`LpEzB)cjML@v!YWZ zxp!4NG8>#p?Pk4ta|73}r;bdXUn}muR!&mbJY(66u;Z=!nU{9^cyX8Z6qLqm{lBVlsyXjhrq@0#VpG3VKDw)w@cY24CFg}5<`gg`dDykZ_L&^JmLz;n z>2$<}+GUJ{9eCOas{ieme8W#M4UhTilfE^vCC%WjzqWdF^6VQw zt~W2K+Vk$K;KphlwvhCVg;EU_QanQQ8nRZ1PZ4Pq(%-FI@#ro0rHvk5dlxLpJnGt8 z<*0dS>e4Dl&!7&Ml~)99KIVyTVDZ}C|Dbcp-k1X~)x`gKO%p5gn(I^()d(@#a6;so zOHZckSn<%LdB=*zN@q~`FX)uk)7s_ABAVTDE+pamdWX2xsWyV!yIdX9wKj;px)<$} zYGWuqJEo(R)sVL~pJCHgH;}}igx?45h&C-h*pb}vwP0st?H$l0VdEo(m28{^6I9q5 zZogTc5O+;2JV0?zQT{?V$9dDA-gIbXXsqVm>i5-GVcOwiItL=2lPm)DN-PdK2Jt2(_z5xJNjo23E9{{e#Nn%XPH$2> zg9O83&Lwj+T9%0LIk4~K{VlUHgGth=EB~6^6Hxc-<>5IY%pVNZD`)XC6nZ+W1N9?i z4ArkDusu^T{J7;zqgWu9-%6I_OB_9}L;bU~AY`yQ?(@G(@H97`7?sRLIGVVH2|i*o!{}%ILmnOAq;Y$IajCwfy$IgB?41sdmp}R5H}+wSJcdW#esLm_t(@+*p|?s`*@mH*5)gx^gLCs zDlo28>A%dd{pRQJ`z%3jB9nro4tRdj;sN<`OQ4}<={ldj9pWZhTq`nJy|#UDbY$J8 z)W){hNS5Wj*=)wsM`wQ2HG3qp&f}gd%e%963r+;=FyGGB#Ur>~aQUK@moJ#E%4gcx zk*H_8dgI&zmI+Tp)3^CBXI#l?StA~CeR)jPH|H}9YlTj<{rSywIA&YKx_kVR)-hGn z4z}rwi9GD=JzyClP$AC5(96WYAo%KbwVA?~+tuItie{-UC_HoGO~J*JN_>1f&uL2r zftu^9H%@g}=;8Fd;N(X=C6C;1vkC(*zA-Q4FI&WAF35%*kMetn8l0iD@pQ@*Cou}fd+%J%$?kQ@%41Il?8!>k;p zXJzi1ws+I6$l$q~B_%CH1MaU_TKUw2QPhb&K6*vr)aOq%SVK5sESI+)6P+D1+h@w+ zYLkAum^%m4>Nga2bI5*~xF+K6DT~+2E7{a*RZe#>FY{;Kpe6A@FZw>CmfgyXZ{6C@ z8@kv+;#;(YLn=bjJ8S#xHmL5~{M?9JdVAGO4fpREa%`_VpTR z#fF@!mBsgJk9cM>%a*R1A#Lt-X4M@7(BZ8T>urpdvm~yYdXCYA$)M|Oim15XnbtCE zQ(g75BI1AB-MIN@{+aXYPJs$X@!FEU|$Alw`1s_e}(z6ORRbn}mkkeA3q_bwH(Bqxp2JZqb@wvrl3+^!g-KgaJ z*er=*(~Odw2~8$1KXYnkbQyb3w&N|ke$c^TcKM-Ar7e7HOt+pid-E5}QSHIX533nt%1i zgpQR>Dl8W5rx%><=D1Pm7{{Wh%&>}4tF4^%e&h}|lLJgV8&YG!9H*t(&p1-*UiqLS z<;{i%Cxx~}S8{DKsZObRST)^+y^racvQpc7A;XGIQbOHPmBEgy4hD)o*(G5L)<5Ax zaS*S<%E?(?@&OMzdmBKv3ktngVltBv$~*D8@9cJlDU3}HI%38(jult7UoN&$s8~Kn ziuL`KDf=H}?foDcGNp5-2{+qx7SWY#%pr&OG5xy4(_UzKV|&lHQqXws=@pZ+7WmH9 zVOIa|z4=FW1FH$^6j5i>H`)uP&CJb=TH?f5o4##nCgTs$3t7A&Tyc}GWKMrK(ch!} zEAx~?8x>oQ+;dzYCT#n9iImKm$*B(-m>Bw*7#KWFL!4WgUd{B{BX#AB@bZHJOu zRyXW3J@hNAE=YYfyasrmuq}~EvUXC|2lx3Zn{#oh;B5WH=+WW96Zc5j$CwWoKSF^trdUG;=X zNG<%@3Z|PcQ@mC=h8Rz3zjL4ftYAU0Png$qt(^wPpPZ5kRgix^BZOJSQf>8N4%wE~ z1}zh&7+pPQ=5s}6vS{^Mp3IMvvlMp!IBE2Xm*Hp$Xj70P=h7objE=mRX`0?4n;Dh# ze0DE~k>t#>;>@bV6pm{A_r+44%P*C2${653~rO9&x<28Fgs+p{h z7#~K2)P{V+z$HICO($&l;rXs2HS(s~>F)V!_#PJ-+@5jxsDId-t()}Usa##~<(bOq z742>e8yPR{S?pk=TYf$dbQ5H*is6FVy2SiM5LSv{7y zJJaRhflDzwo{9(JzxoAl|HAtxbU%MY`o_Xp>mt@vm5NELU*t58xvIO5LraX6*@1N% z)AZS*fmQql2d2%8{^~Z=DlfR&Q`%+Ql_jBd$JZzVypLzl)*m zaL2E;tX~W2H@Nn41QZHh^v{f)p7vC1-5*|uC1$h3+Qb@8bgd1W#w-xIao5y^tO}cw zQnlx^Dg^N!U{cuB^Q$Xz0$=#fT|cz9CwTilZ0hRnc*Nkc?oHHA4Tg!Lr?(c_d{DW{ z;Lo6Rdd2ipTb#J(-^_K=`B-`V?5UODOXuPkl(OGUQMw!BzSL*Y3y&yG*HusC7+h8{ zx-htWGBG_;I>`~#G*w}8SRy6EtT3tks^9hgXPwql8#(-SUft8#b_yi@g+(EVH$_>` z^TnclQ~EBumI(RYDG(Gd6l9dvWoP@qVpE_cWmd?uQO@05dtDKzY00Um#~GUaS!ssJ zqO^*s3>py+B|}+OM@xzyQN8NGQs|k~u%ktLdqRV*GUKC30Yy_A{SPh?-2Yhr!>I*_ zs?Xni@8b4_LGkJX$?wXqH%BH!<=^1`q`Hf-+A%^QZDx0yz1NvHI)NgrqK^(AT;RH4 zM^)*pqlwAWtXwJ{v0ANFT2}2S|6mcnMq}3%BLkl%E`>zbMQmP92R`r2U%j}an?qr} zVFw!%!z3mK22uAV>vUZjy1v+%IW{yMK3R97`RsNDz7Cmb-J97(3pac{wK2o>f~~{e z#?T&{@40_P3k4GorQ3d3*~+DnFqQq7esXT+LFU;XB7>$zuV`S}rYN!h+l4=3Hlb=Y z*Fw);cVZRUFoFH?^jm$~A8cGJt=Qnhce z%et;|ycGCk*S>y`q=bhxN0g@Fsu|xkic(ik4HZ$lns6;Jx82aQt*-Ih`h`^eL<1 zhxi5|uU?+{PxuPwir!9II_2L5|DyIBR*C&>3Qxr6eLC>tDUag*4+jqXaOG0m|3Rwh zW4C_GpF_c{rOa|@$3Nt;Kc%b2UbE~|7p|)KjuC7 z19XAg>Lyc(`6i0(jhqtoQ}(SaJkk6SbS+zYcO~k%UTMXx&{%P<9vCT`Z zo-%9YtXGG0+H`Uo(xv5&I-WYPd6mr4v{lQV&pR1=`g%jx7PmEL=a~DRsN*m#d6tnN znfX$1+rz+L%c^&-b&m+`bKc7R7_T_5K%rn`b?|eCi3=aydtx7u;;}lu znRmgWn!9hdcC8g{&SBWZcy`fAqa&Bw*6Hi5%-F>9aSP)-?t0&dY_@sbQnOxkJ5^?9 ziboy`x+Nj)?-g<>Me=m1{_?NQA7^d2W-POaXOG&iMaFYn7tZR|(U!j|!SKMW@yEZ` z1rD3GDz!KEy9O65$k-&Wb4*FIVMWHK9({;L>+eKBvpxN;kH>{PqGWWs5l9g6F%CC)cxGF47#Om8&NY;u~s zk@3{CrB7|uIT?2s9A-Vrq^GnZK6x|vq$AVU;a}JuY2KKoAh1@vg*Eu|(n7|bc$v-3 zT&C|=-M+Ac;n@0rHyvAVU76y_lWFywYt6B=hHY{MEcbT?$LFnR6hCzE&4Q$u03G>| zEq*!oEBysd7_FL>-^`^DQ^VFM!xsEC)Y^K5z@&6`(GQoJS1fRnm?s-@NArNrL2F;_ zWjRU8A8Ov+Zn|>HwdGgSZho$ZrYrRC{azp-7hvsrZZgZmRGsjEho!H&wQn$M+3?I} zymi>)s9>7)YF35?Olcdx@-hS%n!RD(dihY$%_C~1I~TIWnWP+e=KYvSV*jlGX8kLB zR_8f`IEyYEIl#SjrRM7$zLzb-6YP(~{m^D-VwlRrz`(VynEg^>4Bt21$5qUc8?T>w z=e$J9$Hrw^BeTW+yl;OzVgufbRVcD4{@h#gzS)UmAFu9}aGBYA9G5qq+NR9!RV1O% z=lic}o#x8b?4}=-*76;C9Bj3_JHh%kKwD+e~RtMI?j4snPIW0R@Q^oF7D+= z+Z#e8b9=7r^*hG#oJ)s6I^*Rvl|Rq>y4rk2BX_cMObGR7SjT9)!AN+fH0b0Qvl|gQ zKPM6s*4)zcu)tSCfN$ z#O+MyzMOB??@fQNF7vv*R7YesW5SyMH=DXnG)tJ8v7T&`))#nO$9l5N;ciL4u;J!! z6|A50q8NAF7CW$6(W#Ng`-(5qj(*?EmxHTK8I+Fwov?3evXM*Jn!MCK5=vJcS`>x4 zz~k4+*&8hdG&5?ot&LrrzMk4ycHwc>!t;DuHASi6flTx7{@6U>)$W(+y03KJ-2HL= zX5Q|X_BXa0J&N}Z%h~#=glA%wLS>-}H+QD_ztU?-=6?^&*t&1$&e>87<;C`A4&BRL zeXi`bZ~ENUz0&`!Zs(f+y|G6%GtZ;kSv5yz+J;AuJ3|idO{>4^ms$Vuh?_~_;ns!o z#09Ucf1Af5YG+xu>pu6QkiA6K^&3zk*S+08gtjA_-y-(9;B z`CS@$yqEGxupYQuwUYPuW@oFOW|d#lI^%z(9CZqQy2Eh7nuv8%=N@nf+P&+`rrDkz zZ}0vJYfBOWRl|y@LPe?jg)6z#6vM-|Z!+ZExv8x3Q>B{XRfVG}pv6xe*BK0CjyVd| zo_08{l5%v})OG{T$c-`D{Ha1<3UuceWh(*0kreS;-u|dFj=15+PR#a`hMPT~N@!au>t*rah;xfn}6y5&{Ab zZ{6GSt%>OwGf%C-=QyXfvy3O$7Ke4-#w-`Sm~pOx^3*qmnz4*{tU{=9tI zg8kw>j5emv^`hU}27I)Ut_XB=<-P8AcK)oUm5gn6Gb+zXnz1WL_e80tS>KtR9dNN= za+GC?&KKRjOUzmhdsC$sfz(g9sQh^Hx0u5WO34fJnHi=tF)%bvmkVHgrMp3ZS1W5r zTaTRNd^eEG95*n2e`a(?YgxnhZ#S0QbFg7$7AY}i&C_o;Wz}d+cIH_5FkxHbqXxSP zSql!XoN$M+SY^p!4%sti%O==O2zAyzy@>zGDXV~||9&~FY83wEAQfY>ieG%!_ir~; zR;Y?_#WQkGWaiao>*GgxLG~n@O0I^722SjodnIqFtZoadJF{k@_UHGQ@spZ=o^|`yv~zFE z{{An|CnfYM9FWcHnESg!rSEo5i=f%!kG~Jx$z(W}Yn}sk>EdN+s19|Xy+rCr*2FuE z%`%q~TlmtXo69Dzk&2Rx)O&JjQCQ#E))3|wJ0{p{(3Id)E-|<*@nQ!kgqqK`#zbB@ zmA-RAR)c`}r3^jJYdaXNYH07qA1APD2Gi>%N&fA^%^lpyJ1i>4D!NUGK ze?IT*1zkULL3{&brfH#P?h1xOVfkwr7g;=-V5;Yk!#=xh3255w-hsLf%Q~yGcI&J6 zHi~X2oWKxJ8~1&l!a-i~Urb_53^SM*7#8l^n|^p>CKuma+q@mK#5aJ3`=lGHcbfgK zWxeuj%YAOQTQ7YK*L?Gy67R^W;b2vB;H=ZR)v1g(4m}GGC=~qI$h~u&*uKpS>ugjX zO?Vyj+?xBrDGmibP))+2%(s%QTA*FWnTsWLYF@6CLr{1c^NI`wC##;*jz1E(86;>@v1`M5yjIJm_i#kUK;4JKWzTE z*!M)&-mq&AR(Y5@tO`GAw8SB3w!?3j$y^YVGe8cQq{J85Cc<&b=Jt#sQ`Pp-C^;d-8Z*?64*CE zba$BFBkq-K79UzczS-KNG{b~fLA3i`Ca)GtoXqA1xTkD79K+s3NviBoxyr!5Z$hd^ z;}WyRZ%Z{FCzdjLF={+r_E4cF!HF&2!_;Gr{t{k>Rg7O1Syx#If$HEx?2p}Np6rU% z&MvsRL`vamXo_TzLc$rg1PgF@aeZuEb7QN~ts2Fv4nbg}9pZ9aIkhf$hb&_xY{~^2tA#T_lMuWzC%hMG zI35kmiLTi>c~35H!-ll_3rBe733!L`u6=XmywX(%@gz?t8)d7_86RFL9co*P*z2+3 zW|_k7KmoZ2zg<`4*t@Q6h~g>VdSZ7Kzt2S@fwqWEcC(c}@f6HkWLMtk{^d4@_+K5F z;5GSykzs6#R}!-r1SeDsOg6b{H7JPlJ3tMr|A6db+A(8YPy z$)~|w=j-nHiPBv)+0J476FQHbNUr|6K7Z}D3n58Cf|gTV4>B>#0&UtpHfh*C^%Yk)5M1w=PLVF{pnCr{i zk*w2W*%nL?@i5dpDQnlVp@8c{LeQtv8?N3g+%@=m@iR=!~V^)S-~kNh;>dl(!&qRRXG-js>A6c~0e9%|;XVLGYLqsUY?*XrojB!>hR@WkB!VbZhR*hr*(79Ce{Qa-htfvm$7BI_^amY={TAFi1Wagiyi7tN1{7qb~n?IapVweqD{~^?O z(Cy4SGoeF;Ki!;Mr#bv|WBPkR?Wo_!hsWH1&JdH&b#vS~Q+tK?M2VOWSM``~8!@m7 zbu_IM__NV>r}n}c<%!o`Ei4V&H}Qj63$HYLfb`5L&C&x0tK3dVhj1r+DBtly|Nf1R zA2|`TpGtEcPf&ioVWNQF_dJ!5l+@i59nw9f@|)Y8y1fN-M#U+6|HkZq5YeXfWr7kN zY#d4142*ma8e5(8n6AvbZn^hGxY)9W-gz~9AF%OUIFQJ&VrTza{X2{iTLN7s)O5-J zE-(#yQMfB3v@5y#tA5%tU6Ym#0*?=7IazHy>LHz^v#wC@*WL5n(b8Ou=ToECTgUF0 zeyeW@x6T$R$S{=<$qP+4Dhp zL)JmtMh@}6++m_2d-iG>w45<>+41839$~S+?hY;8|9tIsykKc&6V&@9&i1~cD|{iB zPvWf5g<>Ch4lKF&^iwa(yV*(MN0oOoKCM#n51enT#QJpp#`43H!>iU;{AN1twl|Pf zG`e4Uoy!E!r1E#rSp?s63iI=LMIOzSXW`KExK4Aom?(*c#QJMDr@|mCq2)SZ?L)YBT@$wj~bxIs)$V9pPh{EYq>J zYO}mu%d4|>2AL5B=higtEflE_ZD7__VBR+ULQF=SsOQYqD~XdPJny@@{@UYs7c57I zvuUK*O_ukuy0+pF?0oEpG1@bKRh?s zspq9;tu2von#aOt72~>g&*rnbs-B8UO9dFX^4J;_%#`g*`gSdDYvj{$QejuPDVjK~C-e&S3dVYpc)d{xJF&B2>ZE zxcd^@?ypUk7EHawR^VtE+~KV$Ev$KjJLG_uMyS)CUrYhP4d)V7%75%g;yott%wUpr z!jFTmdecOgCR{oYrnbfA8mrc>(=Iuhv%^pFK0Vxi(r8Jv?X~17i#1puGU^>#u_;pZ zOOHV6;X90{Xu{vQ`>>VpSC>5{&jbHRaF``}T?Uiz8wF zVt**3Cp9tFW_p)zeRTU=5-ZtQxsQ z#r=x4dO)fd6u;!}75m1ryWp^@=izF>hxeo=a%pV{*zGEs=2WLIRx!n!Cm96yZ?5zSZRW;i-bIK_^RF&;Bh)ou44NQ}4!3`E_d| zwfkelU)pYoy|-S&NzCq&;pKDn3wtto!bY%pw-?ySI-ndfJ!Jpc~w< z=GqMn+g&^7_)9BWwTF52Ye`PZoscy_diyEogAO*PZ(j*BG0bOTU^wxdb$#nRu7$3r zWf#V7Wj=X!RcMFb%YU|xGcuj?8Pv|QY&bUIFmJdHdz=fy36awaL_(H7$lBXeE}mM} z{P2yz!_9R&Ru->lVDjY)WUI?md@1u`zAOI^ovE8k`9uR2aI$MM?`N4%!uR8PHShH%&sC6tfUNO_D!Oi{4r0fjX`f{R&O zWfN*GVjR@=GbY(G8AMeoKGqEZZ9*?udMYD%$v26lmSWav|Fy-MGq?BsdCq5$7c~3t zzD4E+`iw3g^<4NK7X{RxmTBPujc3(A6j;f2IZrmSZA<=gUkUT>ov-yf&aGkO+tb0Y z;pXc2O&k^Cshk04>*5(xyNxFNxVKikRVp!a%Bu%j90eMwu0Pr(+IJjlXJS~u#K3Uo z?uVWkwR00x_LWQLtN7*z|IlI;y4)lA-74*lA@d<4jjcD;{5xchJzel`+RLMgo04XR z&70XdA?t%+`w62Zwi0OZ@#!#M&ynwWk9(J7dhcgisv_cXN^w$*z}(2CG8KZ3f1})H z<^-x$_L zbZLCOI^_wUya33)7d+_~1&{dr-jK6Rpwjdl*S{Irn|x0l$X=9h#r!0YEl&8z1<9@j zH3rTMM(&pd+unb(rEOm6{JO!?+Z@!COIPdea$7y+ZK;AovjYdv|44W8pv_vjU z-(s~!9z0eN`m9Z8+5V#~+tTb-vPorw%)7lZbt=>9!#iZI+&2=)^a#_re(G{weh}}U zERgJX(F#3GCem8?Lk%?g;69dCRQ;i!pE1aGf=&^s@ekM6> z>Y9jUQ%$pkY_fIJbIg6YqvoTbx*9dH+D#N)4yX%@+OiSu1kpxwkXp9ue+fxy*o6 zkJ5LV#!QPC{fr+nm1JxQ$P&)je`#Tx+693&Y0Uue#;nrlKT1sBpIvj9xUf*#@Wzv( zS86x=H=8qDEwAglpOSflno|caSHD->lwNf+JR{^jOHkLA zHy?$(7bSSrOt;=pShPcGO}?OE$NiL}VcM@Bny+Nz z_&8f9`Czi9sgayx#SLDDEPW1<3wdfwwm2RS?C^V;bg^j$V^fq%wF)cyR?Vl(D_WW4 zZnWfS?VtQ2iEEo==185O!#AN(aIs5(J2 za^uxglRnH2X-@v5b~@sNh}TI2aVCaEObiSy?XfbR2OaMRxV&8&a^7HRs~eke(5(gB zzAt;&=Ee#bOSF~T2)(?@b>^Cc+U^eiKWf_BqAb;#CuJ2R1#IeJ)i<9Kl&r_W|Jcyn zqdnGiZON3AT-UaD2>s5{+IvN1}OBR)ci&q*R@X)tXP)W+>S7q;D2E&j1dRS-#av z9v$@M?loCI;S$^3>{H1mT)LVsGE zT#hiiZwgwq=E$Zk46dsj{n=DkAD-d1#)hSVd0B>_Vx6mEc2ow7kcUTR^E#7eAt4W) z`kTEW&Hs43rWyWzag{-2!pHk}J@PiM?^tNxzx+gW98@56`;&xob z!m0f4-Bul3d>2$EZVTi2b@znPst;Bx1T1TwC2Z9d=D%~|aoEDR1jbjh9d!K9IJ|Cu z-sBmrV{(*f^@3I%lhAiNrB||j^zPMhzO_2z+nnF4f@c5ym&qFcr%DWT9MDfOp_Obe z?|N`JGHO`NezIw$!;7@P1@{+$F6Db_HR;ybeN)*P3|6uQGZ>s)oxXT6t%;}=_UH^;@$6Ll2hD}teZ8lOxK|XIc~vkmEM{V0*tX!%%@^l#99uUB?!Vd8 z)jMm)!%J)6%Z|64TPj~SaU~6xdvltDpXM>zuvQr8n$VU{4PB zde)k+yp~bsj`xn>Vm9UY&d42QQI7tlqVr}oor}x+a^i$~qIlkp6{|o)iO^MFkOjaU zJ9;hNon70gB7$s%IJ2#&sy3&e-|jw7`*jai=CceE)UQllKnKFC{0p zm~|-bJk0L1i!Fsg+F|k152;TsSzp-st<6HX=ePLwe;4|EctdGskC=!N+sla){TFpguY2_>*5$yp zB=L1(PYfI`oD<>Nuwq@Wjxt+{+4g^X8%hl;YQ% zJ ziM?(zn?078aI-i%IJ|V~(%|@@dGxyNlHE67>qlK=k(xR8Zi$vH*Fz0eivU*fQr{$3 z;f$2Bvdb$=G+maP_7Q>yhyz_lB4Q;m+zw|1cwfEm5QQrjZnSJd zOVI4ioO-Wj9qCfLaN^CIWxd%ePVf~%%T*ThP zlu*navHYRgcCF0V&d+QhzPD@e^JNM*f8ApUIJ>q>yTNzvUdE0G+pgTyjOBW$F{3Q| zgwYbKt?Q0dK5mscz2LxIU!g?-8_La8%J-BceLeOl4PtDty1`tw9lmp?ZdrGvlG%-M z!^+L-74IVc9(u4$9I;}3!%NX>4*}zI_ZULXam;sa+Hlf)NAdkn%#YviXjR|TuWgo> znk&%4zJqaMT1~nGQl{ULlyhVHyENXH37--gbeq5Bcyu_t zjQGf{#;fCG9x0gWpsngO^^GG-5bwE+xgpJ|W=|MT{pjtsINQQ4VDRAE2hACaOF_dP zjGmr`)7+UDmVxg7W?#g)&Yi(+&A@G{U9!D&NkWg!NuJn!Yj_Tu_k_wp5*a5#hx$uv8Vll(oOQ|cTFG`Tt#X|UiLe? zV`po}CANY_*Bcq7&5;5}Z;Nku8M<-zPS!gIjBYHsu)1^;kLH9fwF_ys+TVXE`7*Ci zKmUB++60$4=y;moc0u-neIZ&62P0J`708H`W&E7`mEizm(>k_)kS&4HPo=|yQkUe4 z9!OgqDAd<{=x)*$!yswrIiL-Koo995hQEGdU;aut>3hVRRp*i(n+QlQEc05yy_5Bw zS1V`(AFGE~YqF_50NRN>#( ztLx>~SNnrjVP=a?6c@arzn0m-b*93{z0vw|?0mX=)P5~H*2wIH7?v|JFm(C9 z%DigjXkb30@c6Un1BV|r&7OILhw*_U!zV^D<96;tIX4df+0yhTl3Rmmfq^rFmevB( zg{{2RH-5}?S<^$Vyb>|5b%K&a zy!L3!^mX+0;JU&SmM$1HAt!Suyn=s zG6$Jn$-J7dI6-id*}84#l$JUusw~wz7d1=W?a%&oO5T4Jw==qJInLed;GiCL7w`PuO^{$NGO%dP&qmp&tpyWHnC+>rU*t+;wd3|0_%jSf*sfS2*SA@$&Cx zT)cVTac`aZLB1Wz8s<*bIYyJ1I-5(+>`-RiDQ*(9ak}x&&+Z3B`h$*h`%CPRv75nl zL1R;og^Pmbgdd_Tm!}x-Ox`)AFSf!d?;Xgr&HAFoEDNO8$t1Tid{AJhG+ugIz+J!~ zD9T5lGfVN~-rbK6JUq@lk2OxXHkfUmD66l4vt&hBDR}*0Xt;1~pwovt8-KM%@9pNe zF+=s5NQ=9z86$Y-$lCCC9o-M+t_z>9zU9occYG^8>~geP^GzY9Rk7vBrGxv9y2RXd z2+P@8^qMV*H>R99l5NK=t9KG1KbU6fCSP2T6t_Y0cCO?W(G?7zrtSEXwadNt>ESF! zFD8Z+ObiU*-F?LZD~`5A-v_Ok>3%&sqgmmJb==IAanLQ|{wdAc$yr@YhBk;T8##Pw(rRfS6WPD8 zLN{1ceereDtoZn!;V7dk*CFOVvtGu2Gkm%)aw%Wa%=?Txr|=fDpNW4h1s)lHVIUlq(JN&CzHPnn?h!~s88gr@af6ZmR#Z1`5(R@G*sdLz6Q(PzgB80mgxi?%+q%-k!t8VS`?z- zeurDi>4@Uy+0&La-R%t1S}<2*mB^kJIn5VxXBYE}vj=b;ZwuIK!r!xQ&5s4kbk*Ws zPR=q2{gonlQDV_A69$p&3@xV#e2HWYptN(-rm5-P^Fx@AEb*Tv*sI8;v;;Iv zvnBPL*Zi2so2MpUQoouIXFMs@CE26-^^5kDl;q|5XCCZ|a5`&I#nZ6BWQDThcZOh( z_CN-W)@0`uakJQc!9GNb+GW|@zxXX8HQ6Njd(otN>bZS@Kb@T69b z!;9_T-^e~S@pf>&vEi|+o|XSYjW&m~P6{)Yxgc-SWH6gpAHRa1hoglr^HJODlF2cM zY7o-dTCtLwf7pE&sh*7=H%&>}yfgw=(5TnQ|>*-9KFE78^@u6JGdWEO5S9I9JMhi}ycp+*uYqv^uipd&{??Kz9OJ}4!S@Fzd-PajT zZwg+zb8Kto;V{~C$BTJw3)IZj=RkHb_x8wKol_BN9)5P3S6kB6ITwm^*3Ft4X*yjU zbcn^BSMe?e3_WS*m2$S;`kUnVeFgI^tt;GX7`;pyZ`@y}RzK~aTKK~*^%+}^KKjaZ z8d0u4VqcwW*!Ws4a^sa#uI8SmH}0yOE^Yla;oAX*8)u3+1J3SqQa+s1zV)qV#7AEJ z)r>ZbPqu$Coa~vmdA);&>*W0lnO9|GFonKZo$;yteS@qK?}EV1fzLA~*6%xa=gm^H z-?e9%7*;beFqB??!5?<})KYWpo9C}@x%|&>-VGlc-ek3f4%tf@)x*xt3%#H();z;U ztvxM%<=kuH^8OaH_e5<@KYC*pw|lmY;;gqCs=H2>O<`#bm?9Kn&- z>ob=}?D%vfjiDv<_NfHpnJphg8jhxHl8-wkq~S2*WQslC^_jD6Pkc6gTOt@f@5UAL zYE?f)#-)}DT)W)&Dasyuny^*(a`VZQqe0q>6OC4~CC%`erueo|)0mM(YnJ;18NI)= z5h-y;*{uVP^8_prOAZ^OeAXz;4r%^8!FQVA#xk!MUH=0*W`2((FV0jgFBW{*vGqbS z_zUG?@<%DZIybvuux8Er|*K= zA4WHWB3VNgTxi_zQ+FZjO%=lpF;YIi7`8DkIP|qEF(}|+j>`=O?}>_z6&n^N8)~T8 zs+9kzYFH(6W!^#eT44{*%gL^cJU6{19*T+Z-O*eX%QE|p2D3ersMaFeNNtISkAALi zXn1y}sxdc7xLe|q^S>G{&{{aI6?G4vcei>v9$oT_b%jvKl=Y#a0md54nSV@*#8wPig5XV2gxW`SCLjo|LcE2hJzK=XPwS=Z)8#PI!+wa=Z!s`X@X>(`r- zE6?5Y+xp68V-}NUBp0W~Qhtt)N9Hcd`^a*pgZY5RHfQn=(^7f3$`)cQ=EU#Z9=Wz`)ACxHMy8QSQNQ z7q@qGL|2_CU0R&`@Kp7W)-TW9PqCe4HJER5)Hh~|j4ta^cWqVosdE_iPsl2m7JtHM ziGz&v!fIYEMcH*lrICdYBPxEj#!R1OtsAqG<&&~@*!E9ndVE(MWd1cz$C-=8?C=^3 zF|!*yoA2IyS9->7G2^V8p1DkKwHL%+*ylLQNN(S|G~fPh3AbNFyPS9+UX*(IRA!yx z^|bq^3V*c5+-zIhqh#^q)T-Q64~vGFNRC^l{#!Q0M5b=rv_i%q>`l4SZp(&{=D#uy z(-c{m%nV9@-1)Ct(FgJTug}~d&u_47h?!lh{rVw8QL6N|q9z%Kb!%>gT|3Q~aWOb626vd6_ASiV+0(-tvSV71zDBY0)Ke1c-6qz@2W%{| zbZniX5NXX@zt$mA%t_pZH)M;%`7SrXfJP_x`(n2@Eb`G>T_*o<(Zh+4SU?xZJ1*xB zDOtUe$v`TuQ~eIFhMv^C-|Sk8&YX+#2y}4$KI_t+kY6(x)-g`4Py*f9zBBo&cgJCU zr8_!HjX~S`rZ9O2@m864gz%I~zP7mS@ma^z=dii0Osu5zbFuGmp9E4mSs z&(0f|h==NLurTuz*)R6fSl1)>M!3WM1Md?}`J@s*G}be9fBbqiDifyw3Gs&$26Rf0H=QKvyNOYA+SxFNDm> zFZ@>tx=gy?;g+s>XsSznsM|j9O#~14*(TU8)|~osA5+xYnKO&hnHbiA*8l6Us;t|^ z+smC`v--{_-+!l!mmi&Ao@6H~0YwSycULAK9q_5!IETLw0iWpLX+C1uutjk>N~FNA68s2 zN>;okb=X8JLF`h}VH2&i%{dW?Gu&Le0$Wp)tzdq+wy0+E{vadWe?2vhp0f{0%O*CS zo_>+##EL_QrZEYH-vu4hIIs1=)7gKfHf4THf5Lt0q{tDCgN^(#`+C&GvO{8JuYjk{ zHuqj!zYNrUIv5%p#4EQ_Gm?$3c-e&}7A}!<5=y43in|K=O;xX&eADCJF%h)rCr_YM z@L}5A8gI~$>8%x-E7{IpWLh%ok~QzgBXb|!OJxjy{e;zY;p)1L2~wh||4m$Ge`Mj} z`NhI{=W3Fxk?xJq?v8m`UZ7pq4!-MVWad3BoSkxXQJC0Kvy)w>s~qfdC$EWMUlmg` z`^l=4W-BLs&7B-$nkf=$)OTAY+*e_?mgMwYW`^~k^*^G&-+j7}J1J{H`fQac+r<>a z3T&ASs@5dMSe#X4iI^#%y+e*sV(p4^4WK%qTQVp$rO@(4`5)sCt#!R(c^NSbkHwkO zxhFI;tYmz8V`D^(0@#3A=fqzLi2HT(n}$I(fCs^tQbKM*Zk&+5V$|jcPO&d*7V;H7 zJfb|I?6mLHT%#qYPKZYsin%%RuuZaGthqJu|Ejrx!q(Ajtnu=cbOE^%Y6)cM zY^n@6<6K%S(9ZOqN2T6PSV4I$XfxNCl!L2SQoxS}|$W$}% z`kSW-UKut!EXj-^h>sMZmEgx?VZM-p1Hj$d-q55 z!h6l8Nzz_|cWnaStXZ6C`8va@G~;*aZNWK`x7Xk1F8W=1i<{A${m52MUC|tUihi4;To*=byJ30zBKPY*h(4f0{`^6=?46_;E zDljo@U}9jX{OBnj{BCxr(|L}-4F^{%*Mdg_SD%w+7S+<5^DIokZAZmFW{FwdtHdJ& z%>4gYOG662{aMQ=T>9wJrTHDQx@jYe*Z-Lzpje5@RAfi!UFZD5UOZG^gPH4~=7Enn zPtI>q07vPoLYuax6V*qhy_nXGqKPMek44nExdW}n*i zw|Al|A6$G=b?suv$-{kW*EetToLciOV^h+{uzSTOJ1fHkw=|nKPcqxs^Z4QtDTNx7 zNVXj(BHaVt-ErsXbaURabAedhN#+0g5^MCM9^|uS)h%wgCOe0xz5jAtcxrv4;UlZt z7h3Ku1}#GBj_*CuwRb;5ALH6JYiD+?iMVn~K-M>JUaQ2d#u<*5Gb5&Hwm#V<%lP2L z*NZ7fr9u_DEoa4S&pxkpy2xZ_-u`t{zneO(I@rGWq|t$Vk%0P_yH2bwV+vcD+9&TD zmc!kX(>o#S!&bqfSSE&zObiT(q1KGXhRUZeF4?bmXM?5PPgdpL`xYsuukPsNdC=I& z<#mVW)PW;LOuZAb4E6|a%5nd2^`T$J2jzNB3&nM1_sc;h7i6@oxgjR;(=gb3RpaU2 z39p;{-m;uI!jsoKLG(70a(8^Mr|E^<7MZ}%*^&w~ObuSMF3so4F4>-OaJzoOIgZYL z8|GHyWy(U2B>dm_ImJBwf7i1kr)Hh?%4N#3EDv{9`GYQVT$Q!~)_Q+zrgT?_(MPq3 zaoZU`LemX8sCnY7)wRX#w6Cc+p7FCbj-w z$to8yDR0qFx8*?#CNwbVhBy8BE~MJV8V@=Wp<6t-bAefn-%iJ^3~cke&wc6@UDczb z$NsnP{*Dt1FFG+FUB0cI@pKUHCi#UCa;)oiPqvxBdv!zoRln!*bJQ938nWCydFcSh z-%#tP%?AE!#7<9Kz!d8$+%dnF^~#^KXU+xmT+m)nbt3IT`o|U91k*Zn_;*aVS|)UG zUDOqqyK~pv$V#2;wC+t*CK=MTTeU+RQ2~#ysora zby{ts=cgAvl zU02t>iQ-WSW$m6ZjcF(Cg+T}sJPq+oDK0ZD7ik{G>m6N&))wQQ(K5f}K z`If8FG_A;Ub7LacO+8<%zO`FNE_9RKyCr24Zwj40ymPYl>8+pS-Yt=u^U!aa;xSR{ z7sm4#IgSYJm~m6GOR$PHB>qG7jP>lj2F@v!2ln>;%mjtak$`ug#S*_ia)CB}{cMW_ zh0bpl(z;_zkVsbJ12v~$nM6V!0-PXFB;i$=tnKpQ?`&}yJVkP7w74~Jqkb33oITR)~}=b0cJJKK}AFEj_;A0aK(}w#K?eh6j`syLWZ5B>YNfb}F)$u;n--d_q35GRv`* ziD5J7{&S$(kWxxH6x^9j_1y${BQ9I2&Jafy|*03x|Ir=J0k0%Ip^oKm7X5_~EoqHOl zT+u6<9dh#bPp>TTn;NU0X#ViZ66d@ba?$xL}lNk*HUcFT;bQwhZm*p44ZcgbMnbCU3F+ zX*}!gm(ZmNT@$bEU^u2xwo#=v~Dv=jnd!H z@-|FlmckDsU51oh3qj2ww=5*JYjjsdFf(jnVqjR|>l=A?!ZM%Ntk)#!iq;zHaQtN0 z&d6h^n^665S=0|P>4n01JD3djcQoWq09|5iFpo9*_qwiDv3aaf{^3WNJe;A6G;?n5 z))I@V5X+FkVTQG;NX~D+jYx0$9JiaewyxBS=E*#@B`!hGZ118A zMos#cnH-jZdMH1>?$W)J?SbI(vy!2P?x)y&cM+BN$)uG6eA^ z{Z)NA`PbEz$qN=Sb!oplAr_^YV`Ip0_rosc*GI0k90~YZdG|JBP^|wi9)a0=A0&#X ztYExwso>U+&TE#Q_yrxLD`8M=`(Hm!cos{8daTh*tY7iXBJBhC2EDS7ius9_DK$@jGln|v2e=wKI8 zDgWWn_11d2Ve}>*!>Y8iGxz2ffO-xK0!Abg@h`EX**z5~qK zm(T9b`Cyu;wQHu68&_HW-oG>XIul=;Yj7o8m{#eot0A+DwSZsD+jj<+XyU1iP=iCZ zsce7y?pwH6n?!Yp1~MF6yFK;6hMbfMn)!EISZo(1z9)FacmB%d7m}D5wt@ElvgWwF z+TMIoW`+r86k~_PUk1U=tQ!PfG(y$~9!wKfI`TX>bi+-ZwyEc(LN{nOt_)_Ce)8K; z&TP(at`(YJS9be)R(>n>Gh>kEVYs?seZ#CAhr@{i`PZEOZ%eq@#u1b5uqlWuJAtrw_c!K@U zMRU9!TtB(tQ}*3EJC|7;6c`>CrEoRc0$g+IIp$1X7c_^Cc6J_^)v+;9_>4MZVOBNTP26L969drF^#aT zpM3v$DeO5CKRYnsTfzF~c4k-B__vSFdbzJ)eI5NQ=VhyC_x2*rE!^Q@8L1ck9GcpC zSncz)XUivXpO+q)FdDoiNaAXI!{Jt(T z2FclHlOkq@Gp?N!cIpoQuBd#otqHZ=94g-WYa;ec{m=N~!6~k_I@%3<>vUwyB9$0q zV$Vzyo$*eSFDsW*Y?fj zzP7!`xPdQB=iaG*j3ouBtzpNQ9oWOg_-3!+ZQxtC=K86u_GWEv->KeA4BMF)7{uAb zRo$k}*|URho!2a_o2?D2nzJ61M6t`O-FNA^5|wp$A5+u@$uE&MyY#HL>PBo+OcHWn z*A~lvDhqPn!l}{_*Ge)m$m*;~d(!KnrF@3#>+P!-p1I|OXdhqa(|3YHQm{14_>-H; zR6#X^ueT4X1?GlmzmAwGGf~h;=@nFyPr|G1=P$W!4P2`egemhrWAUvOVPfGBnOlvM zr=Bz_5N)09%A3S}ZTp#-r&5kST5Ge|Xy+y;ZTrWco}4WP_*9=8N` zf+FY3sVA$BteB*@$_M0E%XO!gNPSu3W4G&+alkdzizRaeE-ARSKW@p=GP8W{CjND4 z;Qo#mOS%{RW)0il@nVI%dZSw2j%7cu!_H(al>WHGypgSoCo@l3=^c0x|4-A{f-^9=>|oR0!hH_0o!STDlW_1JK- z;^~MB_a9$f_|^B~a$$wp)zvvdTkeJU?mzI1`_4`S@0H?HMAq&wxX$f0%ZbBl>Qj5r zwx&m#cc=XqFtAQ_P*h>{cw@10SzN;BqpMa1pS;+`UA%WeiH6H!5t*EQ6~CFL`DwP@ zlV{2cI3|)5VDQl*QIfkYl8Ipl69dCx?koIT+>brh^Gti1(B*WnSckPCW}4Qodkid_ zL^awOJC;u{-OF{u`Rn$Pd>P?v$06Bmvy%O1GcBxTn8%B=1mZ=df3K2_aJD|856IF zWKcfC97fyijgRl$kY~#+}aoXu+4w@6*n$_1|cpJ zr{Xee9)T^dx6F8AePERZ)2W0vNj|&R=H3rv@_n(dr8-z|@u54FOc(b2Sy;3EFoR>{ z^8V=}fw#-Qi3a3qvZSoxJhc3^k{kFgo|D=C?yfp`@zdR1HyBg2rp`^{-M}RM)_Qx@ zkncHGGkq;Tfan(eQDEx2%K>UoDBA-oG3KWO?}F*|I$Z1Xy8;ercIno-YW zTKu!$Oqs&D_L{JxtNKhw&zTW!JcpKNHE6f^Gc)XDVqmB*^J&bzobtwu^`umQ*5%qA zmqIUlIfIOsyrWRFimh(S-{6k49+`=Z0(PqGqHFJPA6l-rO!|h%feGmkS8{8Gw4ALu zX_RnDOlR?hrbA~fKgPJvz7`X*cfk{1!Jb#jZR&B$Saq&NJg-#{Vwxv7H}W7)9dr>{ z$Q?JEoO35WNzP+P65~{HtZ3*qxKtu`;LfJDzzoNSp#5eyWknoXyUwsL_Io>Rw$^Dw z@Yo>Z?A&kfY8C$VEDJFcb-3~4=J_4`E*dLbL$02A%{O7WL zwadid(kZTlAaBlAF_ApU#l3>k3zsh7$yn;LVv_wG_C-=xzBlgB+wmxB!!cdq>$M7D zUURf=-gQ`Y@E==ItV4J9L8`#yXmm%;L66B>2el%2c@>3`Ny^?s3_#* zFKG``k1U1jrg1Uc*LI}(@un;-Susi8bV8QGRfl!j){8SiW&|-uYR0Zg5qL2pgjv*g zT{qkOtqHx+ZmSw^DKIQ$+!AyuZ)0lcNsUaOqj@6 z)MN2NJJkGzPQ%VrMv?1Hhh|zQ{M&T&3xCK8CWc+0{alBgB@hM|%R_a6^Z56j%*eo*+r<|7@h2RBA0 zH|}6lNLu3O-%z|mA|%EoU}IPTqv*zWSrNBc>aI9&mQDb*Sgg%hJVVd!d3R$;K~h-| zugl!II&L#fn!9=##7m768H|?gOyy`yP;={;dvt|xh{yz%p5_xj9FFafDsAGj*lxVx zo`Z34!qMx(A9|$MiHL$uH+s{<5HjWajKb?H1ZOkeV*2%jGyTktt9yGviwaOeHF){20o&NzjoyVq8(R=IL40Bdv3uZ%^o&#<Do}7dx)W zwg&Y^g2HS?_3jxaAQNYvaJeNVotp2I&F{-78k^3Rnx9muA)I;DfnPYYGKR-tWskQ) z`<5&zhQI|$SKmx!2rhD7x%K3HbsoDXi9SpI8iF>51$f+cntz*hJ9plWsK@avDSH^N zZV6_4@N`y$ZfJ{RtKNz9hh?5Ce$KoTY28*Cbe<`%ukZBPLzh73it;RKTOP`+TQK`u z;$erS*LnIBPe&d&`_xj{tzYz&&Vy$sG#7+1cg}6Qn%p{d>3biw_P(&CmTQ5>H0U6;N#x^kz58*-xfZ9>)Te* zs7UTfE3!UZUc6$@WhaIsQ`dtp2%fZ{Z^c(@-qpvsxZjvuesu8Mw^y6%q&MjrY*Mpn z2x-=@VA!eWwG4FKS&zykm$eaDPd`^MtYowL$PkoY>?vUzcIZPxp_GE2$X`&8$DxaT z0^Bs_>7W40iLcR-G21CF=dg-#Mg_x3Tkah@6GZq@7dFgRULzjCFYREV!>I6o-+_ah z8)iq}m1t-NEv8et_8i(8yRf5I;+^jT^(BnVu5Ep{J6bYD^&I??+j%t?sIJVm1MQ@r z2HjkKF>>EVLBmx!ezp>j`eSme_^?hQ|do1Qv zG;-Zwc+JK-FT%=*;bTZJ?>vFPTMT*|Yz#kNODeSa_>DCuz>L?k&;mK$v=P*t2?kir0iyB||nt|)dRXJgtw#qIy zK?lpHo?pc(s%0eK1D^3+>JFaqEy>6XI480wxWP=$;a^W$t;hCvrrSmKHqH!81rJv~ ztXkCDSC>Wf2A4?k?yY-H3V%4TGM{OqlysEo{omd^A?G-Rj(l#Z7KqAQ z9iYFV=ND*EOsjsX8n;^RMmy%HgoiV#b}_=wCjZ6bu~k=%%Y!xcszRVz%etq#oNA9S zBnLTfyczz5t>xh9)wwfg3dEl7c*%M0;i0ELl$cKNI+PY0Ht-%Wcylyuz2IZ7Sq^U! zXTMm;w@b>j(aiEe&bN8zcI}if+xukVtOraf32BCXy#gENOg+kA)@WhoR4OK|9$9d> z_2@@L0-8}JoN;cZ=^C{O$NG3+x1BBU`u*FTp`P`LNp>`d4tZNA>9HzgeS?7E{Kt1M z>)k16EvgZ0OkVsT-Qnn5FJ`-W47XRzo|4!Zo#5!MIYbZsy_U`CNqZN@p&hn(i!Dfb3ya4=P#L;-ncTwv~9<- z;&lhSa?YLDGz)aRqx5E{t2|oA9$xOWl+HP{$f8SK%z@b;pNU}~69dEbG$B^z3uoA7 z=O1+HIsjfm&ik0P;)Kfcb8M^J-)l_Rc=O!c`f0OvM$Xc5JUVxixax`<9KLr7UW)&B zbx^y;conjB2k z$-a?GVY|r*0o_dxntED$-UMH9=XOXrF!7;*-F-QSn^6r8uBkg-b1JR4U=;n*VS$sy z-5U#-;#N2;a9XhV^a7^14Gs&OJ}?P}9O#zf2;tzbVHLgo^v?F9#n)U}4DJU#PN-3g zn0;~qQ=G2hJ^{HOTv`nlj51j#nz)U`j5hfP%Ih*rWOQ#k{G+CtA@z0VN7vLH+*Z8~ ztz-s+tQywtK_P_e)!QvK0lU3sR3=GDG}Dl75lYYFI4ALi~p=prx}^|)>SgQvl_6Z9i5uYzFvo!VLuZC!%}_F zthjBMq23%Z`9~g8CxUCB<)`+WN3|VcWZfW{=5g!FyV5gTs>G5q5B9wO)2E}d+r zf8qVpt0e|^??@@LG8q^P2=1NM{kFM#*#fQg>hsRmMql-UmM8%`c;}Sx7JHU59enNa z?!!yFNlfQopD+@u*}=f+Kf$fKbJMSlKXq*%`%XH~u>WrMq2iaI-HHjWvrh>NdV3YM z=Zl%K?wxdfPl_bBoU7x)*B*=ay2y8J^x)!)bN?jyV0*Q11^8SKejXO)fC8>(aqdO! z`Qp>u9oNjCkg8K*#40>#T_(1;mSs!AmK>HqVFfkke&Ho8Y zesnNWnJd##&&ZoZrX&}g2l-rr~E>^c-A!0g(o^RKWT?3n!VO~K2#%gorIOzTxI4BfRn%`H2Y2rFf( z`_KFp3fjwg-8YVDgUL@{(3$_Hi7koO8SAgEzH491@*(`M+U37mTP1$1j@$KDN`(E# z>bm0e`rFD4`(Lg8vn2j#jPsB8@{E5%-g0j5zxYo7c+iyC{_uEXy8B^k zo!!FIbOjzjIggu@{wf^kXFlK8RvvNfYVcV&=U8~ms;gE7oA-I!6~%2}PPkUydB;*! zn(6$GhgM7rx;buS)t*y(A-5)Y0^_YBA2A=Pi(fUnH_9iyH}Er6+3xt??zmfbLnBw_ zg4_dlCTx%}SjV=hO}FHeL)1_D@hJ#ED3eKl8){?Ul3tTzL|EGNx_5_vIs8|AT|`FCJc69^l~qUV$m2&in3@t0e{#>aNZ7 z;J)y4LdyZmn9h!BLC}$s%uf6Frt?2Z)iDp47b3%v&PK2fWQMz$IK`E+joz}$*rHq-P!ba z?Hp#2ypQf|TUH87ZkCf={ZKD@cRZU`*}1bkJC4drURdUra;7TfOZiQeE@siVmHSVd zsh?eN$oWQw=(;?|iY15ibsY{~PqBC4savIeCi5%HhMU)=XE_|GVm`}zV3+3BoA0$3 zths!NC5gE}(=R}HwVJ?h#b-SMi3&UZuE-R_w|1Iz^oMpI!Nl+nm0au>Q9z2 zn%KNK#;sKPEUn*HV9}L6%N~PQv#la4mT?~W#&zMzdC=}LmTM|4Or43h41WuXnTa)T z=4aT+c+2qj!`hisy_he?9a8wjtYs$Zt6=u~4A>k;{d>0z+aCtszp_$g#X+_Dr7nsR zOSv^wo@AOabUqaOUwGw;<&$sDH@@ijF!G0dVRXFtOp=M=5a|4`ykhU=SJL7y&S>^s zP$isE*`?2P&wGZD{emRrl0&@WZPWCW5^giGDD|=}R=DZaq`Ia;vuTE6aKnYJsY)G^ zl{f4*sDK3Cr6uNX1?@_VpBlof89GUVW37N~fUw*h|Gh=CehHQI*W}+wQJ5HSAjGV> z^;`3-fX}n7gARD`EaA&4i&wgGWcN;ArTsS?RtMh(ZCy_L;VK{(`iRAJqabKY-+Lu+ zYH)ZZE_-)phf%ezDU;R)QK^KtVR4HqndB^1`Yx!Q!^~j3fK_Q<#}=_T31fw?XXjmg zHQNES(7trjIhTyiWG&HT;T1_?vc?K#H|z}d{W>6Aq%3gZ!v<-6(+v+7t(b-Hw z%#NL$SHL45pXSvGHYPrucupy&s5QUH^Lnv8y*^bn!WVG4%XdSf`%FAic+tix^i z=A?p_Qcf{Fb^g>94lTE3zqwXaUSbwuJ2dy;f_LI71<#dh4~tn(-gx_t;x+5ymQSl4 zc-4=&1w2~dyhHxMpR=-$POeKaXkvNRBeJjOl=9ubeDBX$ylDGrpP(So&~x`0-^Mu4 zm0E=tcCx$nA3dkD;jP8OAFy59rp^{5_~#U8hl|~v3D;}0?8VMx zs>L)co5OI1u{Tm-x#Xioo7F+5?kWkwOUgStzO31GgKyHRs<`qTsY|Bjd*0o+_c{CS zhh5*F$mppZ+1tVJ>Ci)dt!?)huIv%(Om#VA<`ETo{&nA5F|&zZc08Qra0h(3*6d$p z3SybH!b;A^_@>u2n954zfr`h+>Jw&F-hG{X@MqkHsSnizPA62Km(=o#`~EA!sk&4B z;YNLfJsY&QFNn6^Aa&%sN`GzR!>tiJTbZi(-oKnKHD!YP0;a>KZ~0todUtU1l?7hT zU$1`N_1)I?8*5wm--!zjsYfs|9ARQ$*p;HSeL?l+1AV~{PfgmNKJDNni6*887W`q; z<8HmX&UI+V(F6) z#}+v3etGPEuF#d{+uQlfN}X=yhIMm@JKJ1K4`!Z_x3qQj%7jZN^8HSDf}P&IR%peJ zj0tXS*Z6!tb2#Z`QJ+V@$1uIN)vFx)qgmU+XNK`;9a(?v z^_m*-2a}VhdzUkYzmvXi6u~F7gXx6GjeS=pD*MPD@oW#_I;6Z`ec=qwl|I@c499Q! zZFXQi&bXMt!cTN}qwmGjuiW;i$T<3OJy{}Sa`(+LY4M^Ug}2Y@IG!K8d&R;-)XL+E z!g}iy%F$n6zTBau#qgSOE_-?K;;R9*U-!IYnCNwB_K6O5Sx@Oe2ASnupipusRgRm) zyrgeVh<@MDG07Yc#Rd)_JZ=UiRB{BhfhgLkiF zn1;mLuD5nrGKs-U)^egCzffn*tY*32Ooz4Eo%}v{W>oj{$_`Cm|Rp~{veID zq56bpA*?f9d+*6kME!)1I_)zwB`@B{K)}kQ3cgv19Ffkkh)&B+jmLPxGv)szWNRW9R z41JS}&9_PyXzNH9XxBhYT%GjZ@*pHJ*&c7ReSNz+rDFH5&k79Rb)PpnLxxk&@9$tJ z@bl;1+wo}WXXXr+ge^h3kCZ}UEY4;&uo~PHZ4JBHbci)&i(!y;UUEw@>o?~&t&<(h z{P%#)srs_p0QA~ig~iz=>z*0I7yva zdVEd!{x4p^8^Yc&FRFO?he2-R^=C^oSq`uX`7J8h#*a3f|Cs>826Xr3-GHP@OPka}AsF-X~{t)_r`s zufg@{^n0xP8(0?@d+FNRF!F<(G@JRgk<>YTC{MeJIl8NL?bPlL6|n21mCX*cl!YB< z61$tVYR|EFfjxi2mxbvmSv5%~9({D-lSmzTt&gF>7fgThsPb zkLn4t_xg$QzGl?bSE>!okNDy_zgt3_S0LVnnPtZwg?~yxXZJ0CUd+UBoQZ+qzSy;! z`brEj99xS7SGF#l+C8Dq`oj6{fcLR2C3hOzwi{T~39dGcywa`V&&yxcp0eb7>WLo{ zB^GbtnYzL&k!!`h*{drP3mNnY@o@WyQ4fb9WVPIeJUQ(4=&NS`M1_@$=e>@@iQOFMw=EZ|77L$Oah;7#U&%^KTIg_Gs$)=|aI^Ts?BpeF zry26x0VPIkN+gxX!WM-^cLw0P~GE)w?p5X9(!eh|-Q; zkTjXkJm$Vaj7vj_giAvZ->fT}Upxry?sTfU7WO9U=K6VCvkGF)-!gi2uqHc5TU_x- zP9v9YN9&9Wt{jEY3zAZz7@s{)EM@ev%;?}{UmxY;^JYd!v!m?f)GOf(N&EI~b2!Sx zaDs_}p=oDhMq+Lw*TZ`55C%(Sk>eH`MH17S!*!W`kEa}s)9x@Gyu-|Kob0{$cvg$)}b%F}}5Wx@mQQL$>R}9BZ~V#XT3Cr2ca}&5u=hq~vDy zdqtz%9-&L@^Bn#i__0z(NiV76&uh`r&BwYVJxm>S&Kh~AhHqTk#pWyE{rV;QK@OH6 z&96+a6PefkHTv|P`#_cjb`R-xvoJUVN863|rFn2Eyk!^4|YEe^r_l_fP^MZixrA8|<4s`QN_ujp? zCPD5S?}pSZ4wD2XG8I1mS5n8o|Hj4KaB{qJ#?m<}CUwvM9nAZnxIQme%65urmxkFN z(F^gKDhos&Tw}ib_$;UQ%EfF3FXYzjk6d8$Mmpj2gOYdt9qx>iASSKx2AO1>v9x66 zr1^!0^~?+>LGyo(7mMpZow~{-;J>rUbODn>aMtg2jJ{`^@}{xnT;7*-O3m-|MvDMN zRgY_z5|2(XJ9okROojcwUs`-2KUiL$u|1r6zR~H%VK2?2u7dLlHkV)ZTbe(c>7I9l zVJ(-I7+?PK_m`e`#;CahdI)&0EQu--ylejU@}p=b z?g$Pcfm*>RkH^a^xFb03t*8)ms7hSX{@})j``_6bm^qU&kDI?0{^9V&^+d1LYDTTH z*R0oOdT_Crr~UfgT7CGp(dQaQoraTI@(T+(2$T+}zOVfT)QzwAl`8Ljo(E>*MIh&_oDcqEZz z``5htc~dQO&P+~e<51>5(#EQ4+27jwPM^KBE8#vvG+S2kvaAUQj`?&lCg=#1I=23J zX41$LdwJ3Cy#bMp`^BUaXFHT7FWbskp<5Ouyut|~aVYFjHB@5hvuT{a?l6kZ61)4p z^%U2itv6K6n716bGb1yXA+CGwwL7Z%bYM=Ko)UZ%|J5?hA9=p-^g1TJRo&#o!E$+uGpuPhp2-lN4K8wdQSa7P*hsb%rfhHoq5C zp4F!>HhDUOOWN59hL@J_7iQV~?8xTBhb(;G8m1p9N)R|ROISzkWpbhbV|m6-F1KG= z4^HPCy#L{DsewVy?~QB+@C&X!^Sq5&-l$Ss_JPr%epgPW zJB}-zrrQ5E68#)%+jY;uXos`Sf7Z50iEHaLXF2HH@z*tDoFvA=)X6NAThzYZ>u%ho zhGzY;E9Q+6a+flgHgf$snzVuG-<0j^_i-NSx@z7yg{3u%OQz9YwS~nzCPbnFl&HE- z*)Uq}XVhX-?o+%L{Dn>Eu2f)#7qcOcqc$@!|Q5y)E(De;kjxDIDY#7h;QZS&{!fl4;@ndz(FKH>c0-e3JE@ zyOQZet98!v&W#J5E=qSS-|6#=bEjZZ@d=K%tUJZGgseE)#x2`mFWY8wBgfkA$fo1o zIr~`I+BoM$7?=zAE6$S*$(i1Fb$tTQo{k3IEX{6{1n}N3-m=H8D|Qqt+8z?ku>07m z6))Epte$&5;_8wFyZIZ%f(+(gPTu(7Jb05~lxaCw?X2L$miW7Cl+iM; zkG;9Y=+XU>a9+8E@254cW@u{-5D>22E`M{$?IkDY^eq*={_69to8r zV);Y$7HKYsU0l0)dPXUH_hf@xaN@hh*Mbd93}=`a7%pb*kk&`qFq|H>s;9;=a%Pd_ zRo!_HPG>N^_DyMV$eYn^a41c8NrI{V*8N`(eC0TxQ6{dXH>bjcTh~1FX);*T&Y9ZX zf#;(6eWW6;h$h|C3JqJdvyXAz982ekS09(AcU)vKD_W4?wsr?+m(06w3HOaWyG)_uAb}@5^yOkz)Njf>Al2I-Vb{ZXGvPTke{)vCeIAlcs7Tq2Q`Z|Y?8jdz7B%a`(q)>~P#7f$z7mOC6%wM}8; z^-~`mBvxlNJeLjI$-Hd+?Cz_PIdfWycNkQ>QEIx<#-)%`&9H!R(GR}ND{rRH{N}nv zr<&8@pQ}qk%+=|ZPvTu#%r=C|3tpXV``V{uLf4*$rR)1=ROd8oxS962vOUzvqFsB6 zr=HT5;9$N7oC)Y4d*izIZ3%bv2;Z4P>2P)fj znAzV1t`S%~?i!I+z>`(D?w$JDk_)Y&A-nFSR=0A)D%92t?!wg?dlm;?%kW8I)_god|Fhb2s`*%xaG_zre0ke^M|1*_3ft= zPCkXJ4v&~m7!|zzGT+nTs2k{pqjgz}zyo;J0>9qcMr%!z7k)5N)ke?pY3c6nc*s8CwbE6tZ|iOLuRU41ecx15C*c#N<_p5~N*GqMvAXydvHS2| zvN}_<*==i6ZS<;3Hp1e9suNUpnl(oKe8IRxO2)e3NhZVTQ%5iNIxM`-^uA?k`>fiJ zcl%j;eSe7;^URG42xQ=rY<6(Jd-2?=Rbn9`4Q6*g^DbG$x#g8WrQl2LK3`^z8#F2SfH-602=`RGA;f)HP zKz;pI%Ow;0%UXP=1SzqqGHhm4_bTOK%sjsJV&#ctcdv2lTyf%xvr~B58NRh3|B1|v zBix)}@`_)(Ly2sOIgdEGibBPz!UG2Je z;L-(;_Y-*3ei?=OTzzM-aG_A>PtRDLc|l!wD?uhPiXHZt7h=3RY2uWk$w~o_s#p?C zqNW{h6?Q+(l@OH8(0n6&N9wJ@x5r%SL8~Q|M1%r zvQvei2Cld0qK)g#q?sAcGchn|7dvm2$~NZmYS3J*`BaT{Ud7h#?`$i~17=Ns$K0T9 z@c0d{g8;)W#tZ#FoKA*JS6Q%BTyfd@)n<(ihNjV7rs}7~8~K`EsqKBjZL^`9^Wm{| z&pvd&C<_jl-aa+q-|8(I`j8QeUk?wuF31m%J;2P(snQ}HE&V9QC0xo)*yHDOO@+t) zsxw$V|6CsDz$tFqSiEC~z;oDi@x5%SlgYQ-$Q76Q3I!8Y zXS_CwKKgI!N1cOfq@pUrIG0Ji(LMO&Agj!gJePDa(a7TbaI~hOQ*K{ z9}lFAs!}YP?kr%uR`oRFzo*kj<4h5jyUIMB^)~ zH%Vz0&|M-|_4dcLbaAWeB?PaH+M3t#{Z{M7j`M7GtOlGhS2T`4T`ap-tHCjXO>D)U zLwhgj^<2zgp3gLcMeon)!k-!Lrn(K)JHAanr5)qDb>UYxRVlEUg3~_jDBwCQAfKBu z+d9bLdSAAAk@Hs2iTIobJZJ-k_b2P48p=!p43bY?oBk(=r-pe$%YIAS zRnBvmqL`j0yWDzM>!<%`dPv~L`23Uai>n^){~;p!o3}%;Rcp&Pk%K?pG{ybUKfNev zf8o@=y|241Qe2#kvVvITU;eOR*vI%e^%R|C{aeJ>B#8y$LJ&wp{wS^WUb2zq}cF-s$hy z_=Jh!A`=5cyxsnjA*U9;)^B^usMFujC+!U~$}s(jmuSRsHm>|PFL*LdKA4tSJem{t z~Vf^Epb2OrF4(X znaK60W2aWg?A45J!OJh1vl`x7uu@^!%FV&G!OJHZyBhzB?_IE)QBmi-#=dt6=hfPH z9^ceDInS5p=&_{*?m~+|`%ixsK{pM6PM)(fs&^B`lmf z4jA2-GqHJ5Q`dHVha|;l{SDh}A98PBvEb2L?z>vvjN&)qen-7&0Lv#ZudzM;hbb>% zq1dM*4aO=gi>G}0=gZ-`vN5rK!vCrF1$KXJnza1SdYz+rdl!gkwk$K@fBcL;BxAYf z1a_^0bZO6(;!~K`Ms&pJYY1{FYJPR7Sn!BdD}i;&B2m$h136QSS}V3>Evee`?rjMB zCx@fEZZqAusx?z9M)IC?tS!b70sqp0o^*sZrrgE-W@1rgLh})Y^3?fHk4* z;GxR9)l7Oz^!(Sxx~yJd{+m(Tcfs7R7jL=hSn)bsdBc8-?^){bda>{gTp@dE8E3~ZO<>nbFw<#&YhAA} zm6g4It+P#9z${O7HP^aXwy%vH zbjucfY3eFG5w>dc+`GT5y5F*00j;t0{P0NlivJoag)DEq8#t#;Gnh zowe`ZGW^tDV7mP1n`NQZdy<}ljrSEaxv-{0R`t1fmdRetlDcLt;3l43i} zm^X1u440W07bVoTEZ<XFoJ6C_Or1go`Hc$Wa=+gA_b9T;gcz#JFpZswJ|L-PHyyFFt>Hl)b1OMfwjUNzP0JB8Bdk=th^uD8MTw6f5YdZLyk&@phiv7 zj;*GBv;I!F&41;K&TWR9jMp!na$PgaAx9K$Y~wqf$|En7Y?joei)K7kvgv&*c2v}} ztl+R}|BqPc;hM7B1v{%jx1$O?GE4HzT`^;h&%$s%t%fg7CCyw5#N{}QRxk)%3;oC} zY9KB4Zn>C;mEg(O_x#cw*hJSwObXK9z~B*6a*caU``U0nk(7XsOrlGYy}kAx*i_Nd z{jaLAHL7ENr|8XQP%+?puv_570w%Lc%c6_<4c6b+=Ii~^{&D@LrYe_e+mls->#J)U zqy;jIK40~9u6;L;#b*BRZB`Obl$w6IGFFNQUNc%Hp6mQ~sXCvr!ns=3DNGDkK<7Wc zN=j*X+k2BejA^pl8Og@IhQF=YBi4E`9$fQrBEQ;w)g+08tJW#k=Dau%zL4w0{wRT- zjD}L@1BVot0z?IQLX)1{JN70%QR1}G8OeP4G2#~wNKfNfT2=!(3L>}k{7j&R(rJm#M- zD!wq&`>WK3n_bN_x<5>5_0@M&D9Zizm8mNjFLH)-!)`T6g0xArv7;ofkJ|CjFLBdR3I`Q%T z^C!FJZ7vrR`Jv+Sa~aQPMz#}b(ut4n@31SlQT4QB-HELrGunB#%u@9K@Rr-wR@rLv z1<5CfJ8e%C{_dCrj`|C`cM0yFoN4OP*cDpbEvis>u{S;;dijo{Y=NM<=SB_pulJ2y zI~t$$zs`dSA?8+N)>tI?w1f=ond=acNk$ za&4OxJxlaLIhVkhwXgNR-#FP{^*6QU#=}LwMJf_9qt@+Lcw9Jr$vfkDPA*)033qgq z*=DdcJjxV5AsDh|Rm;EP# zaRTqPBp#*%dsB5hzVXOfaxBvfG?H+ArfulE(@_4#*_ao4ojDg4u4CdnVr%fVh<)|C zdx`w(0vvQ3SDW~DPCBSz6yKS7s`uxCduk=qUCdtmvw7NJBo?e+z9Gor>x4!v-{3_l z23#k$G9D4%ymx{1h6G`)Woyh{7zC>%zgQOWu0nG`>w|d-GR0kgjdbk9ve!HoIemP? zgW$>cMVS7$noZc17tdJh&mDAr}Lyn@*8xEYr38$>q#A8ww^UX=(%RFv4*?w>7zdtuQEJq|1y6TLz5uy zNhXGCp!xs%B~B{2mNNnzmhytmx3Ns|=$AY2=|%Y;S&R1Xr*@Y6@FwZqiP3`z2BtXZRz}xE>H-J9&kLZ&hBvTz$|+&BqPN%%U^TuT9Hk zY1*0L!S?vaoSCd~e!YdN=d4YlDo&_u&+|03Xr6OLI_3^@*-K8&yd4Ypz9=z$ z2OU|w@UfXvVSXO3h@{gUH=Q%$-vY%qHXZS-F`l4N=62!4iN{CN&i^YjE!|{cwl}TQ zjkj7e)Zy$RH{ZG4;tyP}NG0?}+s)v1vVXN9eJSfF*B>m;s~3K|S+-&+*P%BPF7lsp zWB1wH@qXT21~c2&bIS!+@6Ord-o(XUSCfA5lis1%ThDJ#;O`Z0Io@=K+sScLXmtAV zPxVjN*05T>VSRifLPyA;(&5H}X?txmH>?cq4Al6zh@XQikHz;+fuZMn*Op&p3S|mk zZa3awTDbG-8+PGy)^QIO+-Xo&etf0)VLg|-Vei*9$J$&DePTI%V8OgRVn{FHJD zG~s5&-o+!jotfb}69a=_fA!@5*@r;8rcAaA3VvVquTjZ)((Mkm3qMw0&HdQj@u~RA z)92@uEE4pb*bZBJcQNZ9s_wsY>CpiPUcFDV3`A2+J?0#lxiKq9MM9?c)v9)vjq5)M zJl?h5{Avc1BexktWN>fm(th!a1xK$jWu{czeXY!PL(FWRgj?J7y>>|sX~NDDOEs>| z^Ic%2e7*Lr$u^#pvunNnXumqUws3-QmJu`OSH`4!cbM2VMKT%-Yz+P+;&ge{ zuUD0K9n+XsEZQ0Bxp>(t#lSb(Hb-{6d+lpF%OSu_lPTlc5|0A;vuhhSZCQMhXNldc zXy(-Ii#zAtT)g(#wHI@h^s;t5e7lCTc2CE9uz-}5+?l)z>(jxnTx;@8x4XUnvg1Sf z;oFf?LHbO2dA+k{&bzv>U!2i=d)xiFu1!B(YYwkn`>;G+*L!bA{*JAtf8ObMrF~a= zpf*8h;nJJh%u(3^T_uxqm#ApEED$w4@p|2&o5oJfD_NZ9y$a5X+S~nNxt!3^eTSTT zUe9ZuCBpe`@lMk}?=lvpf4g``s;=B*X5$s%BEImQt9Nw-69oOZF! z7EImLD*lFNB`5%{npaQTko$MdXYHSgTNyPb>pn=c|MO1Addf+$g3a=E~=vU9wNs{-QZ)hgerQ3B3~y?6x>7AU^kZgZqXz6T;6N z3K87eaha#^V&uZl9Mfb!{gq&DNquhO98>ZQq~Lux)9j6JA`}vOdAC@q>RH|W5TTIZ zKEtdrt#M9TNB6mT4o%W}$Flc#EZBF`T;#6#8&+`GKp~nD?AH*Ch7Gwc_wJ z)wyX+1&2?((Q)6p;LvX7E=#jz_YZ03Y!Uhzc)_-aFNZC|o2ivEkHw;0`^znTr7N=? znD0hK)2+IHVrt95ohsQt8MJ2L{-n%;6L5Im`-m7oi(_UWJU*vP9%z!yB-Dke|#;6tPu`P!cX8(04H`x6l zdUM*`8CTYaeAv;!rJ;AV`9}VS)JK^{3>A;0!e_k8 z5w+HC1@nIuX1ELciu~T?e(PdNb5i_2--?`byE>R^%5R<%IJ!IIS9ja_W4wO&t z=aIRS5yU!{O`yNmJq_XG*DTD;%Xs@zrnaPBWzUo(vxhupfq zO?F_l3EHy4;B)5Vodf*%!2NS3m0ODZMk)2iYrg1 z)pM>j$I=?i6!HxB6)y*EHac_eSJH>>5BC=HzwtZIB>Gr@JzmZ5&MWp)Wo6gYn&Xdv ztUZ-vy?RF6jt<_U9S@aUCw6n(Xqnm>-E+TSwYIA{;?zcL!Z2LQU4_L;y zXcP%L)^5(%*p)A_A**Vd!I5}7hSQ9T-mSQIfG>I)=SGvBGv|WZIaYk&lh*B6(Bz%W z9I)`{4JLCYtA}mfT&{YcOGK;pEV!TCn#|k8p(XQbNm}rB@xVkrhLBs{pA9<03O6Wx z+u$oAF#pM>iySMOe3!e~z3R4{#+$5n=<sr)^#cFnVoRrDdUUV-3hVty|#2U zvu-@Y_~Q1)hhJ^ul8hasBU%?QG2CKeV5r{H^-kJPoA1{*rEkTvzwj>qaACW+VZ@CI z?9$uoG(N-x7+jRo-*~g^+S;XwDP`x@r91I`pPYa2f@^_tdEsH#9wl+XE9Sp#<1W14 z7^bp$W%P`#WrDmBwf)m?IQ>u;KJ0n?1#GzIFO1I^=i>F*G%6eVz9}*4O&2c{6;d|4y z>}>6~s;6#5CQ9t#;BV*!FORLRJ<@PyS(E3*?Ngd}cdtlZ^CH?VYBz`e_Zueb-hUL5 zzB1{#LzDDD<3+~Zp1z>TH8q|c9Y%AVUNUcQ=z72JCjXDQ`x*8ya_2<{C^9olo%MIZ z#?5c8Fo?$Hdu8a{%DnQR$@aCr`s2 zUFDWd5!KXZ%KOHA_u+-qofhB4KY|JXr?TZ9ng!91Az9e9=+Ioy3E3+Y7(fMY|Czo| zqIa`aG4!-$_|CJ?3~YZmW&c_i*}1>7LNx;0ljM(TOs0M<=@&g`;<2Y96!3_CQIafRo)z| zqJHP6VXEP)rFxP7!#2xz-sEdl-J30J2?z`|COI<5te zl&mb656pL${oW*Z{NZblx`aPdme&a$GHZ@?Su5CMQpa^TL0s{{75ztkXSKQKO<8gH z!d1sTf>IS_Q&ud#&E-~Adw9jgW2(l&L4bL5Oe4Cx+$3cP03s;OKz zUc`#Hf7+HB(P=ehiRKo=9;VCmubRc0#vON$Z85fqm=(j)U^;8xhn5W0 zR{^h<6&y1TP%xjGHT%>}k?R#gtVIdS8^l~|gZA$e{H~<6U`LB($KPcQV(wQ%L>#`i z_M~6Kew~_}nVRL5)MLi=WSP*SgsEMc zTMY}0PBwd7{O~}uRxmIvU2@fq4!sufQW79m~?dF*TZY;3^@6tE{Z=i@OV%r z5)yM{vJzv-eozt$cu$xz-Gnvz-s$V|E{qAc)o0vNj!yP6DhCD4ruCSX- zZ=co)uyiYT``LYeX1DPEg+=rIFMfC;2DVUhUUcn6-4D+Xt_58|b7w)oyMpzOTvdfB ze?L?}oOJe4*whyRPn{w^P0{M!%kJ0z=)|vwVfK7)MRqy{UJShWVavRFkkeCJo+|AU zs@u1DR^e)|5``V*Rm#^DqA%ByN zJ7m5@tGsoPZFl45&vnxIxFzTn>(lukD>sK5O?Y`%pWztehc^pXKDjUMkhVPi;l_iy zn|`+ZN?Wh7iSy+@uC z+cPu2F~?3h^U2lb;RV)T(XCvnuNvN)T%Y~-!|q^}Q%|mgYTzmBD}q$`|2fBNg=hq_ zC$NUxPP6a3sVS8D>Gj#V1=g;g9-I^TQ?uMd?oMQrxYt%+RkrUO6}ud}9{AgfwrzZ5 z9@C;9rur)2jrM}7A~jJ^Zco~FSn)wxZF|uAhjSS;^iqO0-e09#wfbiNk(}iowUV3O zU0_*yYuTihY8x5Lu9Lp1J)fp9-kJTtr!%Q2So7l)sXNIJA9N%Y1^@hNvy|_e?nyY4#p}bhP$Blf9duJ zPMbIp0pmkHUYatBj7j@Hfde~2+2)tVGWLK2DfSyusAVag$k-+9Bebb}X#3}w;I75alSYZ9aZ;3ZqL(A26xLi$uA5B8F8_4Gj>Nk}@veE6!+F2KZaX8Bu>t#vg=Sma zH(qdL6ZKxsc+cdDozCn9N=@=Sna;tI9yU&fmOKJmEVwj9PrqreV%#dim=y2g8E~|r zFDYpD(y(I>oK`v3i%fof>6-hSZo5^U)(>7OX#QWb?Tos}k#s$h+eW3Kwm6&iU%6n=9$sBLWmz{~*{PtZ z`K)Zpz7@p>e|*wdqaQWFv2CisxnQT4{YM%44rHiRi!GGkUK4S~X5N9G!x1e>k)h8x z&oD5i2p&GQ{;_5y>$D{T78z>hQ{xW?`*G<6DYj*+nNQ{LKdH5Wsa0dqOq(pdhM&_; zEbI=rVRH1*)$GpKf(;kF#8?AC%a{z>O+L@8KE?A(*8c0=0>Mug50#zjlBr~Rpm{B< ze4fP3&@T-AREz;POf&L5 z4NC;Mr0=g^+XtS16E%1Qno?X23WAHr4h6g@|1+g?VfTc7v2DSNUY+Tlc+}MVn9}d1 z+O6thA`)Tqe6&B#OH|XlA;?{AA|99TpvK6_j^1q$hdA#WN*8@LQ_>V60-Ov{M@cWxB&bh(0o5Qc!hTU2J zyJ%AXsX|kRnL?!@yVo~}r8s$Q^<7%K@l2e@3eBA>ZDxjjON~gJdE@F7a9oP9ec#E^ zx>hS%K>%{y!<>$4K`p&Ghh#3DahK+HUU>gwum{f`j-MHc)~PRE2^VaZf6@0zbe^%- zv}D$|Oj{&bpL%g=FMoK%Iepfj-%hnlY)x($i}n<56+T{+<2m>9kAqpVaS!iQI!STe z-~DrYo%BN46^qYVE>_W@*mF2PN-oer`D0@N?hXS8>uS8X%?EhdHb7JYi2oixYE4|&C0^^$ul^uy{n>=rKlc3p zvcBCqWB2{PyVjHiMqkgy{mhqItrP9BV^V)q{!E`vt0HgB1v!^|m)=??#I-4c=Yde) zRn`7k+@M1pzKbv1(0DrR^3Ib*woC?5t}>;tfJlF*Y5b!6kH{QPJtw=U8-Ax_Bj-s( z#yqx@=zM=yR{gS1ORq+B@>LE!tAndQr9>TGch7yg?u9It_az&o9gh0zN3%(+?pxTc zv3cr>#rMMl40DPi~o{dzkA~OP`ddT{Q1v_5?+)Yk$vZ@ji=Q z@~c3Q$!>B?%jUqO+8rDXVcQZcCaAv?nac0aFlW9_1H z&4+mmqL*%Lx}yF~d%x=?zAKHXQ*?{&ByDLFo8me1SK4}+(;J>`3S|b($fPdaDEa@o zoK%5e-IhfP|Ghu|id8ba^ge8}{MrA06Mq?{+*K9IQ!l;w>1Z5l+J=2|)m}@7cqr>! zeI)UF>V2h5_E!gtPK$+ai0v`E&{V__a{tX#2M3+#&3@)he||H4Ied)Gi+zXG&JRcC zE_)#zvS!xaNtQbpH#2Mu+teNKeKP;#%QqaBxyYve=E`tXTM}|RB+pbPn_Z;hqdF); zm>3=~F)-}gdUFp)t8eOq(>2N0z^4~aa#$$7@X?`8_p`Sq3V$g2C2RlmN;@Q@on`W8 zP&lDua<8xl@Iq#1os<&8pX(o2W>?HLo7Hyx&Dnn)OkEhHx?N`ev3lLp_DSnnOD`P{|Wnu#=;emodiM>doUSmV_-`mcKzOQXd6wE_=eVXHMO5|H(UI zT57gznCrF5X`aB^klP`@8X_zfG$hQw6LLty|0P3GVFS~AE}=(E>zeLXK04BO^n2qI z_Qa{z3bNyOm07VBI<}hJYb_Upr5{t~b#=1eF0w@h^sV2_*zjuh-c4*rx)`sQtA2XV z9q?^4tCN?+L(N?MX`C8Ds};y zg3UH2uT|){B;8)}apM2!HbFZ$?B^XYwTn1?^%0wa{}GwYuM^*vvK?V!c*w-Sz`ZG~ z;mq@%E2W{r@h-C@U+)wW^;K;b>{`0bb>n9LZ^|O8_Xr8Rnf#Yy_88ROS5Wl=)~7YCM`Jln zM3;PX;6C+)%X`02e8a?B%(@znwRL`GeY}|6`96$s^*$j^X64_EY}1NVOPG{TCwR<0 z>Bp?fBJ{j*VyeLs-nGn8WyMi@g1we8eYwc6gAsJp*jnQaMOO=InJ4mJj*&dp)Oe$N zM#w@J+1~G>7v^?A!(Z5q=O4>W~NPL`+Rm^!>6Z8b9n!oBbuQbp;(E51zLw=2K1lPckL4Ixrpd6I#TmYp~=|#qxOyjH0X4 z)|)hJkXf*l)x&O{j`0M|z~f=APkBLgL+Vil@r4`CI%qGDI0QP6X6=~^phd}-@2r|B z`02_PP@YSce4_MZaqHU<{yU;742Bm@?ft6hqJ7nDs-Qp^@0Pfw;UD}0%^Z)ex~Y9w zBB&uuP~qo_;F%|OO@UOBFCv_Ms|Cfg%kT=9qF8&?Zy-%HnB8H%KI zZtSX@$!Jr!e8wRzp@wS~AR{M6PTa5CF({~K=c_AQ=Cp0Et0)rubkT`9 z;GWKf<{dT<0EpjWMS4aVT#bzchNp)-l}LXb(z}3v+l_%m6enJKlWO8szEDK zDduG8%0SiQ$EJobzbH^W-ND>8ldX$Ha0q7Sx$E&%_wSs`ZQH=Tsz3jR9L zYzr1RL3OTvptMjIyPa!Au zEP6dnKOD7Gc`vcb!AsobekvnqS=PqF${34_v!{wA+kKxR$;9xOiGjgn4=d*(*AwpC z{NL90h^OznHJJ)e|1up z6!XmmkJ1+&Vo342a&hPShJC>XYeH^^{IfS_>2g$9H|Sk^^ zX8A^G3CqbgP*c=m%VL%;HlM$JLK;>|Z3hfb>~Q^bGiySSzQ)o!RjMurwO;D%zR90> z?RFrOtIA^umrsT+snsD2iy4`2>4FNy$zd~AfLgemB6BB1?>E|BD0o-IIf4`x5*8MSwh2rMT6C+no0DbR2`|k+)#m-K>%1muN%rd&g|da5{OHgeGgT_o zNU6g$%xj*OWu=~{DZ|AJCyX9#D3VIMTcWMOyQ0iI#wE34b;@Dao;O-vO__bVc}hYh z{E=(6s&l_%ICx{R+wLao5<$^`6zT94)knH)N(4VXTrZaWembAZyasokEqaj+oA$=> z$GX(a5Xf4t)!xW;AZ(8)pU19iC$~3qHJplaVd_2U?#nx6Q~cYyb{mJPi*;(u3{RLC z7`|y=tw{8K@499?SHfo2suxOEYCH{Ztcf|Rw&c6gy)5pC^8GV*a`(OYc0R#SMQcH( zPf=u=y!h7%OW2>iPMrC1RhX?xoptX%xoMIHkzw~w9hRQlug8{<7GBRVm9cFLW7pk% zOi}zccy8Z{OI%`*fejE_kHG7EY0 z*NU14Yqj~;xU4$(z$-0$?@V4qG z^Znwx!Z5{x`%c#>;TeKmQ_~uK!{-<9FKk<+bKpU40ON+AdiHgUq9^1f?B`B?)&1fD z&#PL4OFyh1@U+C~i5D*S@?kZ1QomEsDgGY1xHaRBn@_E^Ks9I*FXFDBrFjF_3blZ} z2kJT`7p&dQ2%2!Y&HcZDLF)nAwo)$fU)mE7PnfF^DY|@P{6(J~3|FNirZq7z9rRLB zJYX3UadbCqK7%L1)Rx=fuj`drmgU#B9PIwk)H{uDWBT>)Yzr=(He-0mn6B@2u(yDT z;VBaX17En;NAQp{uj_YS<}ly$T)UV=w;rnkO?=4T{oG=n6DjgXYe(X4*U%|V(v0UG zHYH{1DP7r~Z+d0>>y*QLIZXmmI(GD0d_6l)w{2(6Mh=FlJ1&GDJ9nscM)wDkZNjz< z9&xO54{r_I16nKZ!29)Wbk3`o7v1l44j2VIJo)Qf)4?B673#ed1&kDL*(pX2?} z=T5zk8CD!=-DgxLW_Bc|<@nXvw%Q5Ct2#gj2)us0lYOT5dbf)p9WTxudj6q%MWODl z=T7lI<{mxrP<&zX{b2Q7CpU(*KGuA<;rF|*SD8;fTjBXtLTpFe#H#CDhm)>}uKcc~ z5L?f?8rGiOJ=UBSJ0aJ>uK_ zJ}%yNLXML1+E<1;TTF#L_GY&xHimqkP^Hgw>FafeUH=ZSZ~v~Vy{k(L2KkMY{@;@GwEtuBG=qY=b{oJ-QLEH1+=5u!*Zcr$cxNz{TgRYWqb#X-f z-^RclkB%kQ7IQ~PZhy^x=gzA4s`Dl+p6$dk!KTu@uW|OJavD%`YL%i(II z)5ScgO5d)nwXb2xJn6<_%N_oOh-SKsRPui3YE|G!zytR6CKEH8h(+RCBw_f_TH>X$Fn zjz@|1fn2)#dN{wz?5K)~uMBlcrh#LZNl*D}9Lti|>l;h{HuC4ak9K(w=$0j}P$(gQ zh?DpFS4^GmxNE)H*>Z2i%yS}G1 zF40OUpI#U`wmahyu-eoW5vFc_kYbR z_2~Ujad-7f^E37a%qcA2j$Mr6+n&YYcJb}rS1bu0VXf9*wcaUj-gSLf;`!z+mnLX0 zQM=%{>Vg93CYZlsrM&{*RV`20n%!TxUBY}+>)zKN?Q9A0?)s`H<@+PstI@JPP{Hq)Z>tr&G|TcVLf-wwjW6~x-8Z&`L4w7 z^8IZKao4#M*&LQ`hr=hz9{&;b;{Gd62GYQ-Ex`;13)(so3~lB*JJhWH&9$iYYM|Qs znjglDq?v@I+98^Oi;-oAf?mh%)F&!NbJ{dn7#J8F^aVF_r|J33H7Jj`%Ia}wLt3ZZ zB#9aP9(IhA3Y?wJZB&@NW=oioutU)<_0yt}+RB#9j(toMf2XSG2)yKXNlSSeWB4;o zIdT1ozw@>*D=lB|aeRwMxnyMUggjPGcCV8>tTWduxQnVhm&`ot^?%+UQI$Duipv{M z1i3|3ZxWO?+$>}n{-CMDljDUmXPgrA3Dz^MU(a4W&y}qkrmL+k#Gc)Dm3Q*Smc<5t z6JNbDW_{-5sKzBEmZo+_s*r10a+;mb4n@VaT$lO+<~LMSIM!+8wL*@GVTS@Na2J&G z3EoW<%!cqCdgUaA#5S@)cq<$k45n=8Fop0OdRew=mWjwgcnwmrOIuynfTQ%*35F5| z7KRlUlN}>uTiGEB7CdvAbv3X8!eOWq)CqmBVFTeca5gP{C9C?88NxMPevJDqOpZZU zhw&ZL8yHvN{$z%7#A3nLxM`nC@@Qy*8;YEHiD?`|s z1K0T;2u|6Z@kg)HJ81@sEQ2t^i}Sx{SZg~^S!%oRw4*Bnk60Kp$nJxJ3@`jYEaO#R zPI@{?#p$iwp@kMhFC^Q*ygsZACyx?EGEbH9d&u4Q`sljy&q4)|s)PItf`aZMyN?KJm3y)}FugEh zU}TVI;A6Ph@qP7tneLLa?>#KVLKzwEGYEsl?C*N0ne10qogY-7uXJ6HfuA98k$&4| z}AF*p=&EwG2b;Q5)W5o-~sDt24X|M25U+3j0*}=m}ZH{F}wop|63$-p}f$P0TdRz z429h-_xW2ok8*P8tyE%QWTi>wWMlOQs3px97`%ZA<) zDEQ5#|GBX0&pxgu_J*%sRt~4W&Br@@r^sw-@F>Ehf@NQN|QUL=iL!yAo zwdo9U426%a*izWRVWamj)voVsK+38at`f}YTv`DMHqs17LI!@l)%Km1rm?)J9*vs&;@P~Tj9aKi5v~J zTny|CiB@cDo0BhqT=3`a#&!k)hQz9M$9$h|I=rA%+sX3CUrkV z;A40wT*1Kjz5fVb^R?Z-MMOb-gNu8%2Ar9&jL)MgPM*p0e6|9E1jEB*hcbyRd9E7m zJL*Lj$1dIDvuMcvnm3*#Ywtb>8b7cZDh6gU|;nfO~)zxmo@z@W(RF#a;zbeYScj8iu}P-1w^ z#K2J7b68c+n|+065X-vH`??DM>}_17z`)AD2@YXahKI^622()(Z4t0-XOIMi2iUX? z`FCpmJ#2OOz`&uk?GU4%5`#EHqOY{j`(+b%TL>z)tV_P*#Inr(Q1uQ5kZu8&Yu_1I z7z&*vE`d@N6GMig2*Zo>lglm!bnAO%ybx;I5U}L)zC(OW3>gO*8S)uq8798xOH4A? z$~p35@*}-U895#`gFB$ixI=tmHZy}FgP_B+>r?N3@rvC5POqLTJ{ZYgzp!(~QSqg% z{~xw~S7(p`xz>hj@k5D?{%c^FJ8s%uZmySiYr6!&sYfLz={SRGVDJ8?qH$&nYz&E; z-#oaH%*l|bvZVR&lY(+Hkn8{4HGILK3Q_;s!&1!h2*@&b_Qt^6hN>SD)3fr=AM0>r z&HCtCZpR=D3WrHE1P-0NXko?CvdG8aZ=f5<6mW<#GZa2nVvqvc^T9f(&vj|<<;UMc z7is>N5N}QGiMXN10k%7N+T31NQ2I5@fP|Y7DBJ`X1RYLoGM;X<%fFjyd4@Mk3=AAE zdk&r6qyRDHLkU3REqZX`j9Rn3Y+{erog0Vw1%ppm>1hG?$sS?%&V7 zv7EJtk0FuAUy^!1W?n?T~rJ?n*dxBgf(V*|L>0Hr%F20@1^Q1R$k z5y=a3VPx5}sftUCx%9OexS=lOaMeoXVt}~};*NcwyusrEQr+4&C3&JkBfCJse~&4t z@81P0FerdRKw%2gFGC@f$ZzkCboS{j;A>p+{Ojk<65EuN3g;_{FeLJv_|qh@S;E#y zbAjha?dp_=sf_}lQsEf;Bh@zhwzVA|>ppA}XLu-IU+z)lyZ1*u#HJ(f%IV>P@X^LdVoQcL6P^umV--YtXn>_YTxOeL~W&}$v&X60aPX& z0qHujqmOZBe7IZdbX9OUx8S_u&gcUXi$od}Afa*&n(nVdVhNo0IT-?NGAvc&&vPh) zYgI0WK%0h!-|k8b-!wt>2|q*S&Od!}%8k}(H+L_Xa88Xu8XS5L{!Kh#Rn^1t)lT-Y zO=fziA}iC@ABz|nK(Qtb4!vEQE?i7j;Sd)&bh;+S`S~KT_$gfMJM2MaYxb=PM_L4& zt_ME8!KcOM6{t4jAIJMfZZ1%1tPqpBKD{LnJw8F^s(?~J_rJKA>vi^eiN!s8e8X=$ z!z@nS;tmhxPc@MrjIKQDK4&BXG6hdG7?CI30aAgGKyk z#z!{2_?bernho2bP88oDDv8u z=YNx*;o<*?qooWQreczOU&^b&b<=+qxeAdu_ZdM+VXu5#Q!G+syDdbG6}TB5{%4Wn z2*3II+mu`eNrs32WsKHXM;v82GQ;YsEcaaRKJ93Sc#BD@3@i+sM|N-sFmx85*zm3) zfa^tfoPhWGA_Z0k&K7~TcMO~ioID;{hff_ktprM=P*Wun6&U0g9{!(YwnIeNNh0>R z#oLw5=YNGf2v6`y7oB$Qw^o^fD8s}53J<)Be8Oj~KhDkOQm4hf`FTbf14x`j&c`HQ zSHyTpr%`p^ySX=uO;Q;I86N(Zm@wsLaY^jWDh+)OrPs5eHg1_SX?=Q2B`DPXv&cCd z_^Ujz^os=Nt6DA@u%4f#sS6h$_Ylz2XqoM@|9*I9TU1TpE2Xc7Q=30_uHpiA$f~F9^v_N^pnDE4gDOKnSI9G{D$Rvg1)`tViXNHTuv3nOpW(Du@&g~u zgehAT8Dtm&oL;;O+`$;?lqVJZ`DeR0(?Mp1V=*gkaIt61R%Hm_dI^`kwVd6dXJ^31 z(tF`ITKI0w(^u9gf4lX2hBAW`L%<=3DT`{W7>)$3xB-{+1Lvd3oyw;##r@u7H}%^s z@#J5JE>*@K?UPfN?%-hn`J9=dP)PyYt_6h-2+Koy9ehqJ!`*|V8$j`$75Pn1V@bKX zUr7n06iD@c241B8MBsE#J69gw>PED~vGp&|TgOrif(~w=rkN2a<5fQX@}pLC_st6j zI#zJogIdM%pt7!{heg&im*LvQWR(j&pjNS$N$e84Wkm*df%@R`4qPs6Pig!lzPR=@ zH6XfAD9>zCRJF(K+5U~3_=WrkDH>w?U6TZ%tt=2G&`iu#E|h&8C0h_s=lpg z`e0=6YR6>3-B(n#^qU_rPT26~$a-1-2`_FxHfB&^c%iQo#*v{VXu-nY5TT_b@^a7m z4Vr77Nv?gDaHUXPxooBP6-8Bs7w5gE9ue8&!?;*MXZKabbcx8LI!sz}(ygJ-Y+Qp6 zXc*XZKT==-*?H-GMa$H()z0S(HcjGTlw9l^#3V8AYGu5t6bnCt_Nf^ipj_gp#_*!w ztf6e<+*X!}66}ntcfTlMk|@1%vLp7D(9{iouDq2y#NjXUR6&d3h5oE_zqu}|YPF>Y zrj&|L+smKWa(9tZe@f=e=pXW{)_I3GFux7%EC^KqwImoB@);CC{8@kEswQfKpl+=5W!JF#Zv znmw~lB{a$_$evXMscA7_ftE5X46+O#LHqw0@)?vsX>OL;0$6cpbu71nSy+^Xzu~}& z$9`^af~K!f28D(?xIKC^kViN+VDbF~rtDrvvGkgg$#c}-GC6OGmMv74s9NfG4#KX(mp7OJ1r43HbWkDg<()x4dCuPlLUYp+ZB+E=;nY5@$FGxOk z=O=rx{puh!W+D$5WVd-8+>vmHC*4434%dSF)7NsFoV!u3&zzp16jeK;D1kwcVdb&F zZhbE=28q%;nl95dCL1s?GOTCd2c^EqvS&eJRzZEPO&>OaYNlj|O`!Iru~kcn+rv~v zDTash?@uh!@oEQ?3KREC;B!ctCi~|up8_bxkGU2x@G@}Lxu4poA-nkvgUUBp3r>UK z6B7f&76v&`JNnr6V~(Cl(*M4lNf2#rQ@Zk~J1F8<2cxMev$7b&%43l}&uce&Pnw*q zSiumHxRAq0K+YN*KVG2t0oN??pt3arrECSsfv_~Bj6Jv5K&nsh_mn=@IbGqN{N;`b z1?BTWqYT)~S00Qp3~c2qH+X!)*uY7wTn99Y5zipWP$@C#!394S^@M{jBaXPg*xA6k zJX!F3XgsJauV(x+Rk z0|!GQ3lH1zCG9sMy*34~>XnBlG@Rdkto(t5(1)E9_QV}m>J#Vb_!BZ&E=?IcS^@3p zOzCrtIj*#UffLd;HPYIn!ypaH*J=p|Po0b9RoQ!e;{{FgHkKMU=0}X6b`KW==VUoH za732P^IftG z^(XeawmCDnm`Ru9Iy1QRH!5&KM)sz^Fce?_jqC9;RI;lXc*kM4Cr^ip7aY@F#KJV?VGYQYT;Q=snTv@IQx!p@oI+q-#x1fNnH3ve7r0C+aa91R z<7N1#-my=j>_-ykm(S_#}zfDW?Wn5pl$R(p?*00XB$fo<=yWc&K#Z0iCT6cmIR9)kOUH;(i%dM&!e zqui~%N0#9$69a<|gCLsf1u0sfJ|>d-u05yEOkZ$KG|o%{O|8O(`x_gzMHqM`MNw?% zve}lHQrJ3OltB_r$AXlM)Gf9R{=x7wE zzjEe4`B}p`cehFEb2eXQ5M=mwN5o#TF;tkbdqy1_{u3tPNLr3#;Ga9};2}20PxD?@)dkp#rY0TaemkpwXujMa=Sy z*DrI3#hEcEGd!GqeHTlFRZFKV^Awk@v9E;^emO5U6Sij4=+w%0T(S7@TX2{*3%s&= zDF7LF7jTMQZo|j$5F~a*Q0x+;;+0Y@A%=&ulh`F0zJbR7N;tpe4D5;4sJT%_h zrL>Wm1!{}w2d$OLDh&VrTi)n&Nn+I}@>ovyzW86fp1H$x&=ronUjY*2g^I!RQ4@(-xBt;X=efBXDjGfvf}T{so= z)Ws;vr+_PQuPRH`!i7Z~4_4gi%5>03yP>GT@S;EI)+^f*4IafqLcSiq&NK!@n5M4W z5a5z(nOInseYj5Eit}~WB6SUh7wfyP91mId=iw3-j_#_heG(V1Y;tS-CU<|YkI4t^ z6&z}7Ksl~rnkvH!e@+3z=}%I!M193q_OFcjsjj1apgjMa1lMX|ro9&eELjRd)-&iZ zyf`1E{p96Bjh3R7A8uyYyo;GVb8|F{%)yfhQ$2qb*lJ<3dV@=_r%$CC!;AN+ ziweuS85gSN^-p1CXv415e5J>)Yy_RCEE(%AN8{{&EN0V+Shqi7ug%NwtmpPO6; z?jb&{2bUjmh%vR7D++hTHiUt_rE17(z%_N@b45;ujR_JA-$CntE;Fj#%{#{+3mQ)s zKfn2&;LmGF zN(&9K7APvH6H{hT0Oc}hiNsdCV*jDjHFuWqKaiB#)spbAzT)9uMJ@(T;b#W22{p^@ zk4uBcGdYBJ2PP^Xo4@6t%q!mVB~OC6-nl-xrNAJ|@Nhn#fXgkV>;I(ge|1@R{HZB; z4q%3tyr7_TC<8wOC(jA6t9t(JHs;bl&A`RbIoqK9CBx)A^XJ?QotNERj<~&C@cx_{ zg8*m*s*mwzZ%0RO%~v~zibxsEJRZhilhOKskwJ2gGI&f(0X#OC$q6$_0yGzbnxo}W zO0ipAZjH7jS;iZa8z!yz6f{M9j}C)8sO*9kyx7Q^-4aHM{HLJBR*%IP_Z| zRC;_YZ#UQ|EozqZ$20n(#s)rq1@SD;pK+o_hl!`9yPegI<;G(K=0g9mqlU9Rz3-$44vv94lLf#Y9B7dptR_4 zg808jDvk>nSQt75A1lc-{9s~W5C*A9*ktKba_}8PQR3S}@sGXLK<+{4WdA1>zlgiO zaFT)oD?_KClf)thK88+C@SttWWEPKQHC%F#u;rY6!_dJqq*C*gXxy{MJv)C*x&#`7 zzh}?K&}pb(>&58X6@OEiTVGp_AyMkXm&OB%N=|P5`a5>Act7~{qshEGv5~#`rsG6S z9&iaexml#?!ADhPZidd|4R6?zlG8#eA{nF@Izh8oNxQTJtTa{}clf}tL1fyjoqr;? zK2VWh_;=@u-2^7LMxJ+0?KvOxjN2ZU_U>Bru+}hAWZ(kLnM{@ZbJVlR0i=f`kpmP0>K_=G z-pLF42`S9{qzMUAaA-D6vkDYp(_}d~ZG)T9(_jTqnmpccM!zHQVX7uR*Mnw|MN$-4 zdzd8ewDR42Fqc6H6b@%3#6FxdxhwofLhOT=uOig-q7aw7V1UHQD`;)^ih&W7D?s_; z52TkMjY#F}tOuD7tUA0IG(Yx2j^QU01A`E&^3xz8nX`K;PV}VC(JGfve|G|0a zSnUyTpX8Y95e8m{hx6@}l*}M~&s7XUAX~w?QDE^UaK^i#4C;fn7=T){?-_&{9xe`L zWYB6ifaH!<3=CV#=w6*yVs-6gJ36A6i*%ijhutEk@__>2a5>)3iGQ0JazDXZXE5y^mBdWAOK?wQUYdOPg8%;5wz z$vKdmut2{Io0n{VWaIom!_)V2@0lzKDmL;olvI+d<-#oYg zO50yS<8hoXA)J@*g;Y0fJW-%9L1LZGgd55tpb(iPere{JKfAXJq)eQ^$M@^q8(Byy zIZ^gq?3J6#5jWR`HJZgjHzQIkN?0Q+A{jUt9?EmRe6ZmCIWY!NhKKictSw&bW}e_N z<-{?i!wa=f{Mv2Hzz;GxXxiMJRq_iW%L?8c1gD{6uG2v22c!cWw5s5dKwPeaF6K^mw$tGNS`%D2e)-gMk-Tl-i<_R|xCwQ29r6f;$=%8R26REI~8MH1U+2PbC z!^FS zOcK8o9b)*-r{lW@c;G@`*&i_AlC!YuD2kB&G=u|%DssNtZsxRl!0`WoR z89488u!6^nY@s!i4JfRXTV7ZyfM>Ps9-nK8=-Y7Mb4isj{TGxuxVodG#M?K5hc#oB0Qr`wuB}A3?;p*n#sF zIt}xgQEYQ`0wqD1ZM>jV3tDO968Y_&ohrn3q>>N5f?{?mI8n$j{AFTbFk1zhzfhC~ zmzo-XV;8xYiAnOY2pyivDpai?0&%g`O3b*CYiNOU{2C@;}DD61|Io5q*k{0kXw(vrdFclJCBpg zMecN;*t+t=Ca|Bew)4AMO16RXFsLk3Ypqn=`}+O46X39FF?a$U6@3C)i@@V?%1=ee z+M(&gCN_qL!j^mMRir>`M*0{d^ByRJR&?mQb(?<>EU@iOc$lil!|?EO@y4Tur|+@0 zmTVIT&z*yE;j#Srea8$RPs;#x&R!^h)=bSm(7cSd_LqWv;pq9wj-+Ebl>A;^Z(2RVzS7m80uYLn|CJo$!NaK zzQZL*nvsERQ7>OH7;)haforFBG|8&y--u*4fc72wJ)E?@q{`Dd5Ec;hHbYHutO4E>Qe?(N2|%L5bl% z69XuJL*@gjk=Bp+fXm}AmMZ1k65dmo1VE`tz~!1bI6hkpKqG6QwO1z4aUC{>#4mRb z8ft)Ngbsm5bVL{g9k%T@Ry=k^ljG%?tGk2CKyy{#bv%&OgX;@vu3Y3sZWVNO;8&5}5R z#-w;*tKr&jfV%CVwxX|ejNTF5MIrH`9nVZ3{FL31_2Cbn;q?R7pjLiJX+e{vNbljh z&>1sn@Tx($`heY1Hv65=n10ZkeE9B7$gED32t(ygDf6kPS#&BC^8}avicysB=~Loo zNX#iLIM5{iNGx#GdC^ZXpqb*_M`D3qhTNr#7yI5(^3qJR^kxI4xi2#4W@MIpI`~2Z z#fi&4mkVbRIl$tg7e$IQ~bVtc+mJ$OWvU~hbeimX#1iNOVoGh3&hfbdY&-TI+ z>jKaSH9y0{&(=YoG+B2$_s#t&bVUe~(>?eQ;(2WoTcK<1K0)S-p(fm&puI;2RP(@0 zaFgpkbs4mNb_R5$R+fR0nStRGBo>-D83Y{`MSqcqsE7p3HPpF#*)2^dKk-z|Hf@r& zKbWTm@}Gp49D`+Uv$tWazj3J|2m8dcY_Yd5eEq@_307kjsQ^mvCGR;wk-p@o>eZFc ztwlg9*lvUDw($E7Rd~w>G>TqQbVtc6bC>!Kf$bfWmMvl6VGwlq^v2=D!JoztQw2Fe zsb|s*0VOvzXi38X6Hx`bWfG{Y5oOpZ?d!g&?-EC3kK96$3rj4HWV{GbU=RiM+!(Kc zCcj#A-1-B!GJ<51`XTFpWEcb;rb$<96z)92Cy-@0%iKw9@loj?&<+47CLpbs$EVyT zi^rLP>d4uknm@h|T=T~pNFDFlYPs9>Kwws31?Qn4PoGMV8c=KRy1)Dr^)oWF!8J`d zq}pNm-s7RNRj`6V2~@t5Z{-ftw+*N^e;)xM@=cTJJVn zaD6AJ;)7_a2e)d3Wf_>585k-U81cAR0W=eo>>%WJB58}zA69<*Bhy_UnKZRdmz7}P zoXqM~;3KB7-*4;X#xxhs#a@@Tx)n}UR06f7kXlTF5WB-A#SWa8cqcj0BTHEUvT7Z* zjr%TjqD60%=_-|2(+S}Iv(f%_JzdjWADPVJ`}OX@`)?_b@^%ZToCB{$2d4omP#Tb8 z2(%FZuXEdX%+%o0+N_z*whE{0y`(sj)j{)ril`ExA)|>?udO_WXy#=OuC7lAT zMcvQ9#vll8K5;W_OyHY&giqi_LX|Ru0K>oI4Lar@1f62rtqwIQ?9t(4__v?4_=HMX zg9CeX!x1?#hJWrouO%itW!pCsJOnCzX5l|BeQkb(I>@v>11rNncaFpp3_=Wo4nbu~ z6TyQz=X9%hboS`*f>w-xcOEER$y}faDs6c@G|L(SO1p}?<(R!6IG)!0xy#lSB+1K= zcqnwyy_E`2K||f_kX*co7g~n>&`ITZ*`ok15l$2_>w_&4YMHKzluD%-n3)+EaHUny zdcnjaJ2-ejsqqka_O}^SCh;aQ~Kqqvz9r<)=1SHhqOn(+s44pI$H=8x5`{EwKO%l4B7fQ;4+7FQavUpN|15&qg zHz+~BQh}J12x{3igGx<#X7tpjzzb@xgZijHZVJ2&o&{|SJpuKz;InILck}qbvy63S zCW{vzI<3ZlGET_N1Dg4m;Q5B3kYsI1ipWH z{9rNAE)aQ!hmYU)o$Q-j#AuTA?8ckWOOF3f1npg;7W+_Zcksbd@J^2wfwmLi{@4jf zB0O|ji62zzDSUE}EmGO)_*JWIC8$RSZr@GS2}p9j&ZWN^G-mB99n+T z$jX;vuAueLoKTsQ2@0P;tsGFRw*|5m%7~3+s!o6sSK>~vJy4YwTKBN=xZFDlb~(rl zJ_eY~(-Z@NN_AFHFUFt+)Ye~oec@aVKbP{YHZNKD_q;q1|6#&y{t{kE1{F}s-&HC0 zgHdRUP=uv|Sy-)UyFUeEj7$6}2gP zeqP-52c3BumpoT3K67ZxW|Q?o>t)@TwnQoNL))73WH~G?>ecq>fLf9A%##ciR-`lv z1s1hVuY3$y4Ctb}@5MQF0ftWHG6j|iMJI9vjkiqKU;99o;i0_YI#@6&HF4>GK33T} zVcHq_tv?o7+cWUPbu1OQH0h@e6Ubd)9iRn?DjCWQtjr7ysvC+Na@PFHDl)8UfzPfh zBJ`dpx%l*vH@Gh=Z>Yz_APzHCfcpECuS& zcu@iQ8Fxq-gIW?HU->31^VpZeKcP=8qX80cEDYctC$zc3!@!wlwxhM)>c9`bdOki- zE>*Mk>+%dZBQu+UTNqRuF~1iJWdGOHzM^32igGOp70_w|CVsf8_DK+P5&aqtP-_p= z-&GU^t-*tiEd1D=yos528MhNFsB|oJf~>KYW2jVCN?Kf!@ld~l<6oY6)}1zUgTR-d z_1cpwc05r8)lb+;dohs7$fbK@!PLEZ{x>;6wE(!6WB|@bh;a?%lI0Vq+=0%%%;f!4 zUabJ~!!cJ-OBFgR!(Lnd0V1%%mNrpsdpTjImX2ou`6t*%U{^<%j z3eOZ7WI?_v>6UBOamxoUK?uEP@>Ij^bWQ=cz0MvT(45g@w@XDQo{GJkmf6JvDzzVj zHhMKq@0oJOXz9cfmhzL2OL}EL8s2kM0L>T)S3J0@^y)zT2LVw?E%X3V|F_+Nwh6_c zZNft*10Q=>TueJy9w^$%DhXMi2yP)l){KEx-DofbD1n!>$C_T3xagz*$nNOQO9 z5D>b2ahv_SDeI$taLa(#(;wn}k*W6Zk??zEe*u?k>zNoOn_VvI{9y&PKU5j!?6P

q zq?GCIU}={;9Hzq1&BDOo@}vS(zI?fRFtKQd^=(Ma4qkD{2P)l=8W5l|4%AbGmT||J zRKK3;Nd(zvR?u3<oihrc+!;fsao6C=<%A|6mn`PPNr#FrtO^OZpNi(e4q)feOzX+6ov z$^jZ}1>I2n@{(R(g#st&PRmPreH`FbL-7pk3^yfY@5-9Lpsu2z%w zfmX)-XMpS$%vRq7UWX&az~P+fe;eE$NAJ&oTwce+Z6gsQu-GU$!o!n&M#*kV0cc45 z0N&#UZUFY4aBIf7WuRS4Obi)} z+zc<4AME}u^1Ls0jShn}!waq8G8Nt*%@u0Wr`<#5eib`4YsDO89{-4+<6^PapL8+dv&C9}+S?b- zGOpd=J+14QV451Jji`uyW+)JJ%bxO`zTl;&)RFgKT?L0aY#pQ9WMhWE@t_v(e9(1;fm((Dlf}JZiCkpB34gkqFhg=gmlv%c%I{#Dnl=5|F?N^}QDF##gvJ8TT%UA9@LWUdb;Xh% z;i~=C-79z2`it&Zqz=Ac=tM)r$$Q0`ZJz=iOqF!XHb7F&eNd`Foi6~@)_jnaK%mh{ z$5%N##-O!z0?@TUpz+D(D>o&;chn}rXDVSMlvk3Cw;6-awZpk`5kC3|pAp0yeH4a_ zCf@Z>Guf}KIzOmDU+KCYXuaDa{kF} z#k+g<3LJf*APd?x77r=8LPJU}%fpsXu!k@*M2UiTy?}21=7SB%z{eA}F~vp7F!Zr7 zFo;k5uFem-QE7@ByMnL$;jjbRrVGG6U}MJ|ldWqVwr}}hzh{FI19%)zx2UyQLNxA~Y2Vug zN>AroUC`3`!>_*vyz+2C>?$YoRlTxRSL0TcEpwiAK>gDn2GHn`)&fG+WV z5n8?Q)=a)kCU2-W89@GIsr5VUeF4-?kt#`+ZV`%j*dQhX>if-N2kk(OQ9KUa>F5Ev zon+mmrLi)BCqN@l!WCd!PgwM`p*`geD!x_vt7F>x)v2gU`o6bTI%nuZ#Kz*{9E>6WufsYqF zxuRQ?c6H$z@MdXCK`Dj+rRg(UrI&;_IqYFsaXc;O`K6cOgJ*)&K|SarDNYV75_(Fl z9E}rACZ;IvPuwg5p;gHgbC=DJjiMxEwvevvZj5KR#Of> z{Ndy}VPiz8h5`7b;|GBf!Co&Tj;x%~d#v)(xmC_L(`z@t&oPG`M*Gtu4Rlhay3MKO zx$07&8FN^la>hdEo9T1&^ZNc=Ir-q{QqWD&SL{-_y!=)>Ck9oBgU@p^kcF(#Ik93! zLK^72l)kqO^92uq?2?s;=h6n9eC{hfDbeZWqa{0%7f#knOTH8H^5N&m<6f_)OmtiF zho6C)Va_fK-T!9}@oJn+1f5U{@*((y^5a@&;PEHOP2-6z0=CCND^)?~vo%EAoB$ca zxOJ@4)KCa?nuN0w!vq!v27|wX_n4IxKyBlIjT4=FPBn}7own4-ef(lU%{8$e{nqw` zU&?#f)tDIylP-YgR5%%a1|&=Xokb)GE@42c=1|9~E;#co7 zr6H>Xg&jFnTA84cSrDJ93V$N!? z8TUbEa6{Tg6OOb9_$e`nGXxyU>_5aCq_wcQsVb*2|9R4xr8!5ofqH&{a91F7gX$m9 zE!O1>RUX0 z;^7Zwd2QVA<`+Mx{k0HQd*2D!VW`vp&gh#dXue+tw$8|S!DiYAyh%<55K+( z<6;}oEF<=I8+c#f9mI+rSpAJy8&AynsL(S+S~`z1hB7p;fm1v$gP;SXHNCnVG;549 z?hYEA*tW}=jX5-2p{LP!X+z+p2eO#+dK?UvpC2$x&NEl%V5oedmps4EQ61E(0nJ1% zo4CcWMMfYx_zP&?vH&PA7BQDY$KgXOA~`@~BA|ADu_CC(pU(rDO@u5TGq{2lWq`_@n$zUN_tou)L8C)Q^UZHbuR<6QS}~G|o&EJnAAEHurE^!JZvV z*F(BmQ?J)6fW{0!r#VCCt}2VI%*8zGTc@jn&YyHJYkn*{LvreY=9L>>$uKRrnQaC- zZzcK28Lqp?bew>?Lo29v_en`+-W7V!wrPQGWasLBoFP|6G20(HdxZVe^fdjQ( z8XA!I8-ULKFMFYv{9YjW)fBF~sc%?8vlrm`jkJP2%tuzR$Z<$}G32ow_qO%>`eMG= zVJ3dIU{K#Rk>>>dvehBO@vdMLNN>WhDOVk3LACTKR8$3ty*UbDp1 z1I&reoCkc$=6<)hy0|_H)K&9Q1nURMS2VE5`KU^qNx5FxA8h+;`Oysrnh%PAVn-lE z`jS?5v)-B=XH+14b@07ADhz@Sm(pKdnRjyC?R9H%;(GQS{Kyv`W~T4f-;k|!v?MhZ zbnygu-@C$tU#`>rrhd{?VwlXr0Gc6#)QtNT+&+Tl9+Dk|G=lW1WEysCQoQyg$)sQD z>7wJ{+p+Y(=k&=lZ<3UG&tRz4$bP6zsA2ZOk3s#x(O?hk1kKz)-jN%j$=P=&$Ngbg7(j<3{h zW0m7s#sQX{baLHo1vk|X4mSdr3?|1uxAn^f#|$e%R!*UjJ(!ct_-5(7$5$W`%OVC^ zp?0-x%PH_xfQs%VolDFP7^*U}GJw{cwlMI5QZ#hO$P|A?$oPvbJ0yI;XI-M-*#oXC z;z9KUWXsUTi&s2-vpw$5%QTa9vwE6GGd9R!cz7SM%m?X!e#Zu+xQ{rgNQB zhx3Ob-&}9VfjX_A8wBTpTevBjYpj-6&5@cG`+QaLs^cs79{e~7{NdNAU3ld<+jir(WL)(%fZG%A>`{@NhBI=fN#2lLNqIgl#*h zowE-bGKCj5N|MbZcPY_lrBj;nhG1&n*bWuW8#OHIrWn!H*|M^5m7l%2z0Lv!uG8hteR|!0$e0f; z(hX>Q5mcGLih%-Si?|?Aj)0T|s&IK|L15neSQVUeAZ39HXiW*Y(sAtZdeFFGAxi=z z-(*3{XoS3t0~7x;A)aZF)VK{?#4CYM-8H&dDh;bd(l))00p%uW5r>e6R3Qm!yU&F_ z4}q1Cpc#C51|f!@0l5V`{T{P2E7^;J;;32)e<}opG$PE!Az@x~ap`f*SqDEp;))5@ z6q^Y4WfkP^HrS1A9H2E?pnF7=K`UM%sSy;;pc7_2m;}J>h9#g95K^;6L0TW6 zQ+2^>Uh<@Zw;cSa=6%)M``LPj4j)kiFR4A?9S}(CCBSu(LdTgKwtkEZ2aQ0!ZxLwg zVBiDy%TtUk?lC@MJak$K+%967D7pK%W?ob3DUdqwDk^cXI+e+>+Z}r%d*m3wmF}6O z63`y>e|I*hFbK*pOlM(WKuzCmeyR+h^%Vv@9pI7-Tzo@n;I$t%ae!8qf@VkhkW9Dv zko1LP$Fd+Ffn>48$_$|UtwFjsghU{+g-O>%&^?3y?ig&4w&2GwS~SiKG;;n2at;Po zv-$T($TCPWKwOUI=0nP}xWIBCdqHI&va27aawC}yPCHDXb~ig{J}wv(GoY~^4{)mu z)c$l3n7Off&LL1E#r33uIH*OZwmUC5Erf|563R2){7QFjgSJYQz_ki&Rom*~jM(Af)v!!LG=DOIrLV7cJS9T2!Z#3$gMY?nbefF;u{sU3x~e3AOM(@&&ha*=Hwn2h20W+V zfmnwKThlX-fghaPpNLgjEv{Y(+KvS}y9%*>1M7NFMTVIy3=HV2LP4=8%n)evLF0`q z_v?@+LHsv9ZC=}5;S1WM7&Bky{H86}_pR|?y7$}B8T&T$G%`O7KAszgzaYIo zF?t?o&MNv#kmoF&t41*`ai^|Yo_1lHA%9Yt0dyNj)q!dAbN6jpx=>Agv3rBA{q366 z*9-T2*dz|mNj_qW56s{ey)9uOAb0!0Tu{0OmuTQr2rl+B%)QmKp`kd_Ph)OJvx@vTG}@vLXlyQyPWNB~o&0iSgD)e)e+J~X ztTfyoCw!B;_)h(bT>@FX2kx6g*Th&)bQJ=}SPGNaAH$sQIqaaTFq9x|%_&S#i>|De zK5RID5y)SVHTh2uav$F+d=nf7;8lE}nb>L4J9-j14{AiHcmIovjOK}cS(w$GsJ%zb z*Lk@TXv{6<|4hRiRyiKMj=+bh@u2hlp?l9jyIrLjX0b3ZgnV;NbUeCj(;RSI3i~oH zUIJdlh`DZ%i(%(tjwj&dDM~z`xnZlR)@LNPU0Nvsni=M2_^H8aqUj@eUKTuOt;)a+ z5qSw3^l%4{6oTe{>mUnm4gL8#bek^6^oU6ad`Z6H)gQe0375V$KSScP&esQQ5B4W& zFJ3ZxO#^7;mgfYE&JW0p`C{d3GCh5#Yzk$cb#kkGQ;>#@M(??=lBn=e_EU_8FE=;% zidNh2;5q?x^8J!eXTV49=cG<4ncTLpr6%bZ188mRmSt`qgioeK@bv3d`t4gG391QB z{AmJ>`S)Iaob{=PCHaBROdZhD*-G%eQs6`v=H_WGDZBAmLJ24rbAeX+HBSrv^tH!; z2gGLP*io;-lrUdO6x34x(^S!LMq=CZ53rR2%nY2M-BT^A-+b*cfR5KL0iWT2>%pf# z%d+>Lz7B2{UbX8^%*IVVu z$AY$~D}vThf>g~iTk?7Ky03ci;E)K}ohMX2M=pGFy2^P5_?*H=4Tjk)3=DNf;67B_ z5=aXTT*`xQ-uCirmpts`1&T+@B+v}9#Qm4&L1&l++Q4UlF;@3w-r;$Zb?(bSy;fCK zZV`d#MS@Zbw`LT3n>Z=QICKaSu<^r7rLTrlwf{c`@7@B*Y+t_Cl+UY)`JuD!K8>mWe}dKtfX*&> zt69~<;sN6sEA>xg@FZ@&niHCm4Z2F;YZ=`pP6+~)-1ZFY43!d`F-|97{h6JMJwS_V z62VPY9)6JC2L}_%XMl5A8t4|qKpXgcKa&GXpaOUm1xQVTh~|d`17=WO5k{W(2Nj_k zdGA5&1D#r1$0L5ks7<$Jx+*tlMF+PgI0wPbb`W4l1m`a+@U2bDI@-Z~Y6)wb^Y_QSbC%n3!ZV>*6~{exz4_Gg+l_i>jOTgYFzMtLs#0v z`U*uZ2~}lKeSVOg;RWHrOl&0YFHJWyfHJ^Kt%Uq;Xx5*daUUTJJ@uwomJ9K4B1ospX3$P;)*dGBy_2|-ANV-3N~t<*XNX#HL#yJ4GJ_h!i&GpAFTWM-@t<<~ zAA_C?Xg)EC+mvgI;)|)b3X6F5hi6S%B%=U2gAwZbu<}GkLw`_65IR``X>^*HwhFBE zf@tBuRv+AZoM8N=UKO^l26Bdr7ib46^z;dt?vk_bJuJmSL9H6dT(o>s;08Tjrgfjo zOSHHdHioM*%w=I5IlA@z30NxpR!8>!yi;hIfBiQ0*kW? zu9rT%X6f0E>%EDVhLb@&CVqBM$cTaE?PVJeew@~0W)U|@gLTP%D`sVo9O|8xAQ5cm z5#k;-69StZe>W>cQNkl;mM0@~r#1BUi5G^N2?~Yrpd5F8Ku_ZoP@x z{3^EVK{q&ndbyxgD#m_O&-El~i+mISnWP9E-z#omJ;!}Hes1G&3wg%duhuzeB#1=# zFfLxeRL>v}T7!_#x8XqL!q?Ia^H>-deqWurXV>GdLJ{W6ul_2t9Ody&nFN}V1KkQz zDLg6m!+NpD3attiH3zknL2W|;kO>SAgm{9~PlYW`u~Sw8i7GH$?C4i?hfQScxo=gH zHQ(*hF@Yk79M)r>E`V-V_;<%;CRFGs$H9fczfC5YwM}47dd>d&!paMv{X=kh#g;T# ztF8XZnaLcM3fq=#v?wWPcvfQP{@eCmt6Dx{-3eU)#g4%f{OiG|NoS;|%wen9v zvf7_hD?sNx^8ft*f(cE%nN;5O8HJtqF z%D?0r)7TYe+`QneD85)3)SA5$Vrbl!Tgi~5DeaY&2JL~%GbC=gGDTT_YjWhrDJ!2IuX9-fT+{gKcsg`pqXuS(~-3REzse4nbR$g{^E&W__ z;-&^Bx1XRLUd;{KoQA#PJRN^zbvUneJnv-LpyIHjpZ{V|dh(5~4jE9pE7<|ExV}>! zv~B=A9(U&bbhmAbmM&|^PhXrQmdG-a(>VDCm#Yn^DU~b&8qa26 zye@tC(#lzrS^hdMoFMFK1=@9fMBjXR!UQYTg5KFjH{9qfdKV0GAxJMc*NS|c0NIHH znup-zIe~6dWY4>J@Uf2a44v7xKr^bWO`>*oTdtg*v?<4wOK93v#pHTBjtFKyaQ{HW zUb178U?XV7K)N%}y-e`^vmD|Koy-NCY%7DAuJ4HC>7J|cdco3jL8?NaQFYE1fi}>r zDJO&8L50#qIi_4i7lP7P3UxwH-GPm@YxMFt%(83K1+^F-3Rf^d`D+`(vlPI+d=7YO z%R9ayV0q&;^K-^Zsf?h$0Hj|}wQX$0{FXi!qWG@v4q zkKy6`O3-D#AChlyRV-!W1*Jq#nH{H<`Y?4VgE&Ly$bDa+ zn(4^tn?79X2?u>&6rmmc)sW^Xzt6>zV za8_sF1>FP%O4${uvz7v51y_O4-VnC}{ z@v!)or`<_=-l$Q!f3_kc&A(4rpkE@$hmyQU=A8 zBxvpVvco-z+O~ctlD0fQ4mu-mzUR~ocBcz7R3fd|eEA{qxr+BLC_+JT35ykoD_Fqk zmJ2k_54y3;x=j*1rUCAE@-YZH?E1`|Y#nEB}X<)4ZP$l_4!G|4JC`% zib%-Xynax}fjcSHQH*8c*Pj-5^R}K@8E9)G1}e!xcX=4Mt+ko(#pXofu??ahyp9Mm zBsK&|n1VLX`hwQJSIt?#APN(MDV)kaY2I~3&^iVt%ssu)3gBHTHK*72aOrb%fqL3a zktf6)Dya!kwI1{UHuK}fOtvmQRW7vvm)mGR~#RvUIxWKbBFn<#_A?{aIT6} zRDi}iXczLvqqjLbx0@-L9ht={kUxc4;hu)VMs*p6hp_#C9BbQdsFeNKykP-TFV8!t z_M8vrKsn_ID6hGBnrBLQO{mD;2wD{eT8R;v_u#K?%XDARtUiVbJ&iI9i&+>Lj9aJ8 zYT^Vr5JL7I!A{J1Qk?&`~}n=9yWutD8Q*#KpnL60kZF6BRgm{0?6ezm+*mZ z66XS!QyD>*0{`kOfad6tYTx6z70kj@{kMm+_AssH$`ahoC*BdMwv`>TAz`dF&^rh z2&+)_E|s5CKqVq5*H?khBHJ}zi>3HQ__R3*e6h<_LLa<4qwURCp5BvGq5vvCT+~82 zo?QT4Ls|69Sc!pfi%;gI+5f==5>JhJ0K*y9aN za#IWomWddgQf5#Fmph<>u~`O^p+K2u;bXJw&n~|WUG87_4zvdVd=omnG+87X_w4bF za}pN8ToSC)R#{$lk9aS^zzNa*#ln|edWTcFW{(u8Xo(Vmlolq?)a2EFxrD(h@ruN@ zOOL0lEu5YG`Q^7&5r!vLC4tTsc_>@~N)dU-4Sp9&-#g&)^zz$K#>EF#HANlCTYxL> z7l|-D%r@i;;%GW9Zu7#x(nFC$F8+gqC_;42Cceqw&}3cB1DYE*PL6O#p7Y{#QhLG_zF^CSir@Y)&ADNK-=Y0yNFIH+CZAT6WsIfd!h zqRnasQ1d2&>PGmyev5$$w3QBBAp|a4L8qU9h6X0hflGp>W zBMG!yUadPYpmFFBNc}a!ClEW|-4@ebH)(yYsp9SA){|0cOX>X5ps54e!8p@YCZP zrut1?1}IO|?&UWtM($AIwmC4hje{g`+v!%){w^3zToUl|T;nLe@pkCsCg$Gp}ZU?Cm!gPD2QE-`<>)5t;JP# z&vM8NBdDIdA_&?}Z{_!$1+t@EmqC)Dv!hTJoRVgoT=!XS`8J7dO#Ez@FRTRZoc?!5 zhG7{C1A~Zx0%VyQRF+Ghn}Ls^6SDISGO@l*48(^nu`8ampgMKai}zE%+Np|w#6ip8 zAPd!^c|bc4HHBfKpv7^Z`G^k*2CWRj44sAwpShDlV5i{;dFEbW-~y{%x9Pf}l`tzq zCx;@>S_W2z&L6vzFMw!;jy3P0VY-k(64LiTBsi0W5wAMQtc*D$NM zgg%+XHn-^20Y>ialG30uTm&?B06po$(7#VRnq@h+J~uemHBSrvRBGKO3CeY#k`bjH z3TjpEV-*4SnZWzpHsos5foE9)kD<47Vi~xg&EG}S5esfS8;oAET_e7&x z@=CW)0Ns*p4B7<`nK(Ki%buRFDCmI33g)#Doi<<-z&#MiV%u=HR?rwYXBrP^4E(Y6 zUrSJ0P(J3W!N3iQ6ObrqK`mGmRO*3Tzz=E#fc+W2w>kwhzYkGcvDEsEL|PSS)FpoQ zjyHT8q<0(u?WMf*_)1f%0;twG=K2QIZvo31yeumQol6R`8?190`=oi(eb{tC&VGw2L zlxO|~agEUH6t*MR7N&uG%gLab)P2~d@b6tYPzfM!xGvdYmwnsQ#wE{HH~OWmxu>h= za}8Vq$TF;8VPN=oM`Wg<4!?@6erKss^F`jJrtXGT44}R?lKA6O)3&8OOa+~8qL~Cf z8@>G$(hL@k(^||S6Ao&E%YY;PY$i4gLeox!FfMLkY*2K0yY1JR0=D-W41x@u%EwB< zU7yL11b$Czo!&}@c~_FTYpj!b?`eWsaQ`_Jc}yX#W>DWBl!H~k@h=WagP`7lzFRqX z40B!1QI3P4ndoxix)77A3d;T7k4+$yPtfZ5I-{0Q0Ku^$UgfAQ)k6xnQ=nX zHY8mk_d56(IANXvCv$#=&d=6CeXcJJEDy@4O}GI%=eE;WGeKcu(F{oZdLC$kq=T>O zpX66aE66ge1l|7x3T-bFr4zvi93K5TIZJ!b8qmoAuyA(!cznj3L$7Lf?RB!<7N*Lf zzv969CS&kff*~r*FIB`@c5Aq#aDfBGQ3M*soo+0ZToN8J`;W&yOm#%Wn!qiFTdkqN z4{q;_;1d10#r4nw$W1XJD$If6EFT4q?h9+|PD+q!4ym&{9h^;6Fn zl8m3#KsmTWmokhde0Oupeg*ZHIuy*1+u$ojqc{t{3j2p=ML(m zbc-+EJrT65KYUwKi-P!K*;`KzD1r(!23b&x0X+7Uv`K<>y>Q8^2ew>Of)#oMxuqrd zG=u6rK_`hIP>y#zQ2MXW&*}hZ`!~c_9=r^lFj3GYqR`y*51dYpx&8z7{R9f;?q58a z4^oCf%B3yfbcs~9_VjT{Gpu4^V9?hVWAJ3~WN5lBUDU+wcKpgpK`%z%E(OrY3@3O2 zDpPSE{__XT8mdSn+Ti!Ck&t#6ys2pvH1 znJWZZfDlnNM@m&(is9d#DV2t^*j)@F%H}&|J%p_brfv(8ny zN?WI^3NUmwH@wa?k^TMC+N_|JiGdMPMt#y`-R;~r_ovVmA<+HSp#DB|&&ce=ltR#Y zH$ilrs?DG_>1S)u#>d^xd2JJ0!8;8=bsKc|>yy~DeJoq~=HBvoBe7tK7UXVDth)3{hou?;L=|N5=+Nl&Qo~p zadNqc4>!o}W3E;VBA`|R*tATM`ks@TRvJb-xK;T;EuG1Y3Ka|yt;|~vT7%BoW#OFx z-m-1s_njru-OFxiLX-l?6i|MH)a!_Q&OtSVEU1P6w@lh^1c&xq6WesO`{EV_Uc=2wOSHVi&Ip!Ip6Sp^l)-65bB%n5MG_4?F|qZuFB z?3mUq7u+Nv3pz*IMJhxd6#47lOl+N=E6(t+pOG_7F?x^0-QFd=icfZI5>;ja?JtvM zcsSoqz`{kIVJ+zVj}tFGvYJm%;Ea)v|Bz+~+UI1gVWh~w4LWmBR%VF+OTWG(XxvAh zd6RTU?$^G^o@p}g&ZU%uRO~d7I9?Xe&)6<2$lS!OM0n=O$&>?SYK74F!&`y+8X1kKCP{A+* zw2Mucp>y%lj*i|-pkqlGIQJ_*jR;X@U}xyOoNg!Edk~5|1_DXJsPXGBoOI{ey|Ci^_0Bx1N0MGq^&+v;_yJ*9S2S530p1q#O z$MRKzLykd>?LBB8*uOhh4nBOxpz^10N^;;!3-)cLZ2OtI9c|gR{#f+lH4CU`J&_aM zzAyom(j1CBz0lgYhk=FRBxhm=r0xZc#youdzRwmk_6{!X(iEdvKy3vn*uFkir7cpR zLm@Mv%W8PK{WG5M&5!_hDc2UXBIPaaS!T4_Zl_$U#MotZwM z@g4Ar7SJ((lHgND!LzL3k#-}{d_8C#uRg;%76yjMct(c*pt)2f$Qmb*EHdVWoVt+b z%*c14Hxax>cOf72)P*~3Ofm}~C&ebhcWr_O;v&I=vM=qXY*--2e2|#|v_Bu`%3jzi z7sMJ}_}Ul=*y-$`6`zn!;p*}b0hep$;PWuVL8ru6s>W|mj#zQo;dOQl_jw=Io+jws z0HD(rkym-XOy2Q67<{LV0z;t9j2u4U*bSbF9RHXz77Fd$v_ydAdF$4~2~Gkw`%=KF zI2bG~?#Rk~xqB0|W=k5rYXN+sO4S_1(K{NTebDj@iVT7d)4;vTNvvKXYd;ia8uXnN z(7O75k+-seLInfEV@1$?Bj6K}pr;;z*^jy9o; z*Ak1su1c8t^oiIm6DH>bjw#@n)B?p5H)t*E0?1K09N=>sxELV26+nw#LF+<5aUF?e zubMi;deHiRX#AF~^h}f}w(LsF!S&;?4RSSL17HE|gwsq#96}@T+ z2QyV<_wpT*>FHY;EW6=>$)vux|DF#aYfWX5*A}mmmy0;n^?p_|_!QkqZ0|!rqrPY> zrIi@K=XNYUM3^)T6;M{QgAodFv~`7VG;cP^y4N67A^ z?a*B{PmUKj>LlNAs)!VZgfypO&`iUebnv)ywGsoU%>Wu_mGh{IGXf2XZv%BcXDLBe zo5S_YnId_(405`uI!-;{94rLN!Jx7Y(z3kzpzyTz9v#qr6()X`m3Lcjg4(gTN6ta( zf=>Kts?dLZfHP5a=Mu-|bF2yu9Lha*VP);k#_!8P`)a_wTJ%NN&kXv`2FNgMWMN=n zT%5o&=cNd^6$?7O8hW}IXe{5WVHQtW;DHKI8xz(#oP1Pc!xS!4$v2>3yUY)M;2yy- z*J+?OGO`*GEi=(9qZ_V}?eJh#pjH)RZ3DO;>eaeu&(&VH0?|0oe4so_4F5rm2+iZ5 zGkZCGrLDl@?bUK%oyS~RK=UsC4;mL7I0#zrUJe@Xcll|U13O@Fs^8L=OVbwK4)#`u zjQ5+pct5q2bseZ%o_)uxgv0Hi6u4EY3_2Zy8`O^bwhcTSuK->j^nuf6Mr@X94rp{Y z1UvwfvotufYGve$Z&!*GAhoXz184^HL_hWw_n>$a0hx;$)~(ZX`58D-*0gIdfLDg2 ztZ4@?N&)p2p{r6rBLmZZmCSb9BcyfV!~+#j$~#ibA-n0|?la&yRnNl#PIiWe!6O}@ zF#%)H>ZAxhS#XwZn+(Gy(E1-f zP(KZnw`VBLvj#0Ho}$IW(1{og?&AW@I)Ucd<_R9-0kIhvzxTT^yaC-R(g{1=?j_8W zON^j1*bQ85R3uQwIgot=>SrH0uUK+|#j6Q)U_wKhp!dlKdL<{=-YbCSGLD?@0WbeI z;Zc1e9BFEF5}b>UoPRGV7#7oad`gM`gs(ju+Ip9jAbp~DpwWA1+Za6e%r@!qsbjZU z%O0jGqKEzj(5NlX346nXpix&v20!M1&@g`#e970VG2np4hABMnJl8xv@?@E_S%o_I zjusZ)K1i@9pHNS0fY{o{pbQ#=+wQ8q=%nH?9kx1n2EV5szhm4wgb34 zQeg0FhBnSR{5{PzkHvtt^(5}_;E!UB*k#OnFHjIPAJoI>7`siX)v=gY12oz$$Ixk- zTcEjYHPc7Umug36fR5N!i=j-R%?N#Gmy}L+%UMx;mZ#lVb12j<8ym% zsCu7#5P7#mA@eq_G z%~#`|0v$!2bI=+b1|U6P|H1WeXzkHK==j3Ku>>;iimU_G7GAI|(r{Zcii0PfzR1^d zAQTjqVbhH()Zuoa>TG%n>h&XRQ>&6AXqyFS;|pjs99pM-naMp-t00iaXZ2}t+Z_~V z=;1KoG^lJBhr3WFdT9bArm?urE_9JBhhy@j6!1g?fZO z@}zBgz32E!xxbf_ZgAO1fCd#oDY~E0lR*h|90vF#0O*`zZ&HZ@Xe{qYq616w(nHWq zpKA{^AKY^2bP{NGFZ_8EGw4Rw0=S={DSPu2{oVgO*?3)bLiKfLo|oLC4C=AheIb4erl*urfS!@994=6www{AFSuG3f;REfVKGJyiK&1mq^GxW0 z1i9eNAL!EkF++DhXcmtLluD*aTP#19`Y=^d3N(&Ea_mbXO3&2m2ZJtN@%Da}Un-fQ z++408&G4{a;<}*%Cwj60?^4DegVJzw8ym8Se_E$?T>W=*`LBkH?%OUl2n>5XPa744wBhcf;u2?`@nPBL$PycBxGjP{2F zgS8(vA@a)|9>^IX!H|i0&3LrFfix{b8Z&NE!Z;yIpN{R4Ip*R2dzP} zkaVYf%oTL*4@#}EStQro;@&|-2@cwE20jBfxkL@pl8QlEJ&wJ%3hIF+a~40WE^%VMzQerEbf7hf(cro*ySe;+838;A#tUgG_fv@1>2>rhSsx+6f{H z7J752$mvzGGbCY;o_ys zz$=Ir2!nDjw9CijQN`A<7u2eeV|Xb4cEOXrRg%YfSWZvVOb{vgCGtG4>F5{T314^| z6d*04C(sqZF!O4b+pB}mFGQ@DzpHH>s1o=k=!2aqc#a0NCh}qGN<`j=>^hKR*a2Gq zLASjJhptUz&mtFA$pWPt=SvQQb{-$%$^rr8c5P!3PR%^|^Zt+s`0be5I zW+4!Vp-e#-6tY{O=a^M$o(@|abXyoy3MM<4X*OqQG6eXwx^2oXFRo21+|aBtKR}2rmhr4tR!9& z78nsQk;zRk=>s2V#%KNk=7-RGO}Id7UqGpm@lgUR11EUI2NXu2UN{#6CpZ;?QUyp1 zG*<_4w+LvD&8@~ZhjxRFkV}ZA8FsQTFeI}}T>>9m&@G$6QMi7FA_F*wrY}&ulJsRM zpVtG%1twMunZG2&tS?M(K**J_gVw^lad18%n9bJ_2%hJEXq+7J#=&`kv)h`LZwz(H z7AS7HxhJU%e7-q1!^6vQg|fG_*X>{Z3mTT7yO|0fTd^(K0}A+C4+()!g$;->OS_!x)`Lopf*__A*S%5hJsDY%iyf-_-^Zy*{SXad5e~b! zCYaa8Tbbd7Kc|4<^d~7PKeX!d+ou~CGXJcH(3K=GgRpAUe3@^?HX+L?n zP@|=2<%gRYHt%9)&)gi%B6IL$!c@;+4$i;gEw)N>Y~E3?gnKI zCWefMpu2D%Jo@p)v2M~5ev>8tTO)a*1t;<_@G)%kkk9bgFEjZ|W80Vg6BrrxGw?D5 z+FW2f(<_$!h)vxCw7)Z+frH_u&5C0itl3mq859_Hu`qydK-kE@$}lniydh`>t6}y7 z=*j^>S5|#R?uF$K3mY5D#%>Sr(3l@*7tyR*@U|( zii2}>)GL?38S4r!87rL3{;s&|13$kcXcrQXN99|)KcE#}S0x!9{%4VMIPmq@hLTm! zR2=IAI+Z&2l*vD`Qw7Z$L2}30?C**e4l0Y@PJBQY1BLl*>5yS z&DG%*=r&wVP_Bl~RPr-Cl-G52$T|huS5RRv1G4Vtn5zS*yunyM2rj>bPbl!gbUAv@ zUFxNB2$C~FcN`}k*#WvsS-1jPLRbZ=oCMv_4O-2|z`zNrN5JP1n1M>aWC!qoENC~5 zq;1n><|NQ@KA`pJE_TdKppmP>tcx0M-R1@Eiu(Dbiv?pqGmX-q(gJ#~2!_fUYFRVF3CfZy*L9WXg*Ez;vPXBlO;D79Qz>w9+9;I-za`0 z9}%QE4`(KS#Hor9qhbXUl&PFwVOUho+Ti(L90#TNfxAaz*Mi+yQ9VVI$n zI=H2!uML_(WnYX> z7GMx`uwv%ryu@e1Vs!wthzE4z0VuZ$JP2g#G%aivR?%XRM$F>GKbDes8MgJzLOFq_ z@~XTo8zFmuL3e)sD|B+Qaj1wCgN#?dT;<>+wm4y`La58r2ZGxUT62L;5P;MbB9O7} z>5%r%B}N80hCM6{4D}44R?s%~s}kTtLO{D_q2mx6qFfUlUAZJ&J5bDt0M!8})KUc+ zybV0&3hg*{HYwtbOC-CltHUc>h#lo{JL*BLWkpR$iJVY#C{K;@ldNOskW zfM;*S7~LB`a!wbWR=TRu5PV}Zcs5B9wM0v}Vv)Ay>`h&!zM$^I-U8FSl1_m_VLyWu zL%<^~IffG-Ci&m;O4+3-(JTB*odZ-N%YbL`K%q2E`o~hxh7xsXC{@jRDX>98mB+1c zl^?s9c6HkWMg|d{ov%tdYO5H2Xjwq^U#6^Cb(t~o)25b#pl*fGs&|}RF{XE9p|z0~ znptfH0ylFmY~|g%CvVT@GT8-IvQo7TSHcfYSna2&2wE}E&zP(9lRqJqpFd)U#6=$g zKBd{byS6=)TXP`v@Lfqrh=K1Z1)YxuNq|$OGFj2zDp)%RowJ z@A8^ypX5W5ca(T#E>KkLy7}NzfilGCXcT;w6~?dUi!UGODbso;325i0ktMi*c8g% zT4G@G0$I&EBSD6T(${2VKwFfxL3{Y^C#pl*eNAhUK!?bPGCZ6QIvybUT;j0}pj~Lw z8=kPgVq@S3tsPn3(0D}myV#p0$hh=KRXLiXRJL3SdZypv$00I3&2r@w*9TF^T3 zhsh3hpnXHrH!b11GdHjz5?tQG>uzpI1}TPpp!Gi>bxIdkmwSrtu-+`8yOOCq-3WZ9 z5@=P*^(_aN&Ja*?o7NK%d^7n5$YSrd8l}~4YM>r;h^&aggdM4FqD__}y;=q3W}tNt z%Ew$qKqDdl;d*_ZoRT{n2A(tn59cd_*5ij9Tmtf#@hX8c3o}9*cW#JAnkb44O7Juy5eZHt;O(0yC-|pa z^;isYfv}?vs6Ga@o}uH`oQg>)GYxaVOQxOe4838>plPB7+Inq)oK5s>!4$=BldggS zYTfdgRr{c>U9T(%+O-dEM{lw5JE6@l5H}6f?^!G#l6*t_?)|rgA?W~;-IGD( zgbPR}T|;)tp`(#U&&+W#6O-iIyGAFMxxC@y+<)MGkc3p4Iv}6T;;x z40qLo&iWI}e_$l71>RYVXpw;Snx;yD(i8Y%tG5d(l~ow_gX;ebkIjy~A0gf?1+^xQ zoCY6s1xkn4O?2Ci@|m=l%?>{UKE;rWp%ZNTzRU9`L&BU7-WKCwczD^YpnaR8p4;gh z4t|D*AeF|_yCih)9hfQw+DZ2ibO-&8Gi_ea3TO3!>WUVDHYsq)hd2`!R5OCwWPG4m zT9%3_j!C|E9vXu2;h2k(u@giC08tj{I*1Xhz)T~ zbUelfcEKdj>@8$<1!%lV9y(q%FYQ%CU7FKMKik0loJ+0F`q(cFSw3&YBt-^8h5#is z_lIm>OoIKBWYyKo9W6R?%wF7Tiz`)H&2(r+j7KR*+eOZ>xoM_N!JE=eg&1TQF1X!U zT) zfmU_E*X)E?uq;lvtH{Kl!*Bp}{zIY^Y}CqlLooaMms7bUSXmDp`v1Xc!)?%dkb|5I zFV1`0Elm*fRRi^2Uilbsg=tM-Nw`q^qEYNNV{yL?$0x-PGwn)0$oY#gn{AVc>L}TC zY-RIzIZ%%UbQ&SK=O4qz!q7*@2&}FU2cNux?UrazcnLyA$dn~mU+=2l&SVZd`v%*Z z4CvW^yPwXVX&QQ9+I(G(3*c4-WIRl^T*uK-@|-$oJPc_T|3`EjXdMD4Lt-C0JLuG` zi_kU$2UrAj6B9W7fX{3K-N^TR`mD+ z&UiQjI!O=IBYz?$-1BZ}kXW1<`1DHH9T!;75d^JJOazZYfL#SXp%1k73VdD{%1yVR zJBYBX@_?MX*K-%NTFp*?VQ1nV!eJJ0}5&6wI29S+f!ly`6Xp% z<7tU$0zFNoplxegk8YR>-U@dp`yy!Oi5=38(`*Fa(e!3DlcIUAX24DHR#ws3r-}|W z@vyD(lijm?gA4R-Vn}Srf=U&vy($UiFG8RjNI>^@ZSds)mturhau8H^o}=-*t^#Oh zCJ$)E$B~1Lm;0|Q3;wIyUIAu*5sxzi)w(kcb>^OuP2)M;&k)hW2;K|%33T&mOPmsP zt;|^ghKG)zqxxhS4zVyWAP(%~fr^8B$nIPW4uTKzJa}dkX>c1)U_k zK&?zp%!4mAKzA-YX*jB}K}2gCXhn>`#kXG7Z@Ud^6CJM{Jf6qR*rn$?P3!kW8)=Y> zY!gnOH;cb{DPVHKmqz>1rod3^gu z_P#p)#9+bfKLU;5u~PS*?jFzy7zmk~dwLu0fkqV`x^pCUfbKR{|8U^qdnJa$EDQ{a zpfxWKx4!r%VC`me@#t?6ko@t6CFeEvoRNNh;F#9#6UUsn1tnUoBtWMWLPNAe*}B3% zQ8PgVyt-h*!2{f&yOG%$G7Z~ylqJQ2Le!ljF#|*kI!RiqG1m^_MDrK)*IwhLBj3Mn~ z6X=Q$5Dgk_F#+`wnE1ir22BK@PzUel2aocp& z1_s$Z?mVE?#+*$2u$z0^K<#1BYAr}EoC1zD8R#kXLT1q6yJ&06X$nXPt)QAx2AU)Y3+Ff zN)N*8pf`1KFmyidQNM2JNfo5;I7MZ&?C5gEEOZQRfP+PzAd;V5YT z7ieXjJhM>Wj}6J7z9=t4XL2~-yNDM%9gegcDS+15gM4#mV}QjY@00*@kozCX8|n#x z*5ZRzYB9il3_5`ayzhgH;h{V@+IpfD1wea1jPjgyz*nGyj@*_;oM z3qdN6jxP`}d+f%)F?mVFd?hik`8wtw z{)IsD7t~xfhKJytpP-xIB_=#&yEh+H+epE8od`zpZd7b;Tougzex<{NgRvTlpp`Ts zZ=KC5#CIQC(ghm-?gWj5sC5Y)lK(jcl&?W!9|#i)Q`p~gO7iRxU~Ph&^1{an+Kur@ zYO+>Z0Vr)MgGMGG{Vx&F$gn)~q!*mak_DNP&LnM_v#N6WnHJD&RA+O8cIJ$ACeUMG z?`*un#n1^EPk)%&ufuSRg#nau=NC-Xd;6%vsf~l7Q@&j1<%CWhP^o1Z`q^(MxV!_! zd8cxV0q9gZP}=>w-?| zIJWh}8PK6Z|CvE+yRr@MfzI|Y0o_vnvasm@Xl)IAGl;xrDcz$L|?xiZL_#M_2vRzT|= z@n_|WsbBxKN`glu7xF-NJj_wpy4wJCuHWhX_aMtd4^j`vA2FV44>~^;rN<<~@Z!~s zuDF*DO?*2}oSssDNa^MGRSKXJPXDzgDmWha>@E@AwN8+=Ny&M^_tvLpXP%M=?Ur!F z)o+5%yBj!7vlQJc1UfYqG&>Kz`^t46H~ZgsMQE=HsgEQGnXC7ksx?kFa+8twERBwdVxt#&BIcThZr}&<{eEJ4w&6xwBwz>+##QMbM(|jfq zC9PY0SIDJxJ}X&uYuTdkYd2(OLo}@{WdQY0K>eU+@iRC#215=y0A1N6$dLF)pQkU9 zoiAd?*()pmiKnH5M++pt3yMWGXe-sgyU%sE( z#dO`-fa{uR9(ZvvuM((N%nyrK*urAacr{`j2U&3|$?zhJ^H=p!W=^XIO8U(En>Kj- zy1TOZd&mMF2GIGq%phlkad`-Q_#=31+M?_hQKnfLrfxj19@q-WGrV}Ug;y4IqlQCM z!}ETFZ6dMCYXmO1XfuBlDg7YF2|C?Yt1jpGuC|LDcVFr0D9A-BF3?o&7CAHxf+ zI@X>hro;6QJ_HZ7wJwu^2d=gi@iZt z&vvsdPT&<&LY6;jz`N9w)$;kn8;xy?#8(~r;uUK$WtjrV2K;GKgu${;*vpdbwuPR-w7U7qwq={N20B4^-NxJccFjr{I&%LE}T95rQ@)t4jfy3{s$p zPgTfCV`|nVB6$ZCb1nsJb&EbB7MLxo06Mw!1dEOY=tSoC8;j2trk+VE$&zCDcSnVh zn{D$1-AB#`w(@lZI)dFYwTMSc8q(9%SftE5m2Cl|VVYqT3wS|&GiWT08#HzRnU8B` zgXAD9Mg}E@li>Lu(2Y6J#qa`0PPKh7lE41R)KUFqxj86J?p24(>1=0E0Nb&I9lWSs z5j5p**Y|dTQu2`neD@w}p89f09o!p-tlV$TopVGubCK3GCs&>$!Jy>G05L}#Vn2A4 zKmj?t-MV;B=4Q-LoppI-*6gmh zNO#aGf6%E`|L!0{oE046l!i8FwH_?ACthLOzsVHkanUO=ypV9*l1nx z#2;dRx=t+UIJ5|KV$f*`!z(Epy1BOgSTqB?MvY)Cq{(m!wEh=l&qF*TbkJG_l&i7T zJ-Bi@a_zCp&-RSaSgeJwP{X^qnM7d4OvV(7FhQ2@lP+ za%wydck{GQeSPI{-!cUTDbN}SzG_eIMapS?zEWi-XXWBjES9v3OZtJw@gVz-suMpi zhgL~%GG^KCIZ?m_-bsh6hT(_A)w!O;mm#`WKe3d9SK46Yd&Yi{0i_XL}P#wmFj3WKCqW;&aAcCTI!W^&$k$uaNP1NO*wCG9HlIIGeJ-j#C7sU(h@&#AOwc z;CnY<&I6rC1UmD{$p?I|fv9e&S(~d1A7mU&h#?V4ZmQ&AB_($7C?fb)Lxg?&$o7>k z@&L_*)-xd63BKF#jKsD{7v-1SQxrup7i{O+juVQ|aads#*{PC;!(5(#R#O)`Nub#a zjss4nb;xl*Fsu=00f%h4auXbukXb}QhKERUX*}H>GN4kiMWBrXDU`(-1RcO3=>ne6 z@p{0hTblMIpT`(F`}

vS(KS93~LAl`is_m5<^^2^?;`tpG}mh-?9Gyl4EE5H9h5Vq(0ttNr1*3a3kyHn_gZkP6~FIP5iS<$6!UcWkWj$x z&D8Syhcrsoh58REEU>ADWMiB@RAD&F!oV=O{1kz7CXMbRFA>ijDvSr457y3y+>nId zPbvsM;fOI%)`a8`C46e38I}ChD2whBCq?xxm6%Bl4-P)q=MU;j)e|U5iHM&ZR~J5F z;|G-Ou*46sxeG03c7>NM@;Ic*$+2e>Xk-+W!|=t73d1=T1_o)+-7?@(37Vt!Y+?hY zxEt+|fv#y*(%|9|Yy6<9J=K$_tpwXGiCm%)>mM1^_}LX6hU_6i{*h)tik(RdbU_tv zHux0wS_ydW!5%xz1v5<4`N zp_Ou|YEShf3Qh#wEeKlAgB&N~3`Pv+LFa!FRo8%e*`P54NG}`O{>f|Bo4aah)Vv3J zINLw4o}t|7;Kl#7L2XDr2FO^&wZLPmC4cQ#f{1}{vp{Jj!A^xhoE!k%nXsbB_|aF_ z`t>d#_rx>6YUucqmm!+a@`x8yuf%`(?p2<1;l8#Y*mdYR0o3v+P`#eHC&A&#@>>hM zRkj8yf?6JsmJav^q@6F`-B_?c9Mr#vZ2A}XvQP5kuSFm}s1=7<$AMgM7Id9hr?-$m zMe1HieN2p7q(S{NRq%bfV&EiF0UEj9>NwpaYq1hi%Yc^w)g8PHI~RNGeDRLKOGuzX z6;u}QN2-Zn?E|p8x=tI;2d|Jugo6sh1r`Pd$c?@d2p3%Ze^L&dUCdq_>N?E>?u-6u ziV(Z^e2-DXG}hqF>4#3g0-ct7>p{`nGja@tZqsiu3moTWbE)HE0FB+Y@b231Xj8!? zhHCKYE*}Mke|J8dU%q7amyfDU)0R6es8~MTuTamw)q#_9$=-5$cYfWuCv#g*GJr<-9>3??{K4+|)GMzTV!RljIdT(HxFF&J+)iAX=?wBS zZ;-=J&`DMG3>*xVJ7<85bP!-j41OrLoFn)+=xS-XyIjJ;42k>RSiLXoGAR84*?V}G zOBmE<-2%SYx@BdvnMK^I!d33u52+y12RPM1?SZ8_M94zIR0z}yj9GUXIWiF@AlwYe zTg(jQ4CM?03=C^Q=d?30sQAo1!*^&ZXgo?0w6Ey>r0Hi?r@Y*^7ilFXj`yM@nd z)EQo!m+sR@5e;j)&g>iVT6!=0)=&i((A`*pj2%i34p!HM7r$GxNs&R2;YEK#hr6$~ z*bkpv=OZ&dJm6zcV7SP_z#z`>BEOiGA?(b7>wFIcr|i!7qgUyjG=oK!L73si`QJ0F zwVkIdwOx4H(UpNmEQ}fCo`Zr6FZ@3&<5gfzdOAtP>8;$MU8)RvAk{Zw+TX{yRew6z zSvmb+mt;mk$du^^RpVwgy^8Zy*)rASxcH*E2Nar&IKoxc7+&zNUY2!kZs>$Hie_CN zb7DK(UoRadOqg5ve3a{>96LLtr`q3`0J8)Jh^%3e*uSqK)<5e)mF=Z>#tI` zoSY=C{4JYH?QrJwBWr6;DswQr@UISHQmD~mV#siW-oov-^T z!XRnS9jD@!2Pq0NY<#?yxncXiJoBtOZF#xv#rohfhZ|I%dG0u+_RX&ebe=YjRa#ugikizRVtME?mud z4rRC+s0-b%sxz1~Tmqf{z_6bIu5$bG904@H9G3&N$w6x{6uxw zc}cI2(pcFC=AyQZ-^+mJiZn2FJ!<2~Gi!nb`Wv=%EbGXP{6%-(lm% z1iI@S8XidgfS3i1jqS@{7z%-Aa8cD^_k|GL7rVVAJZi!dR2Zy5z9Z5%>z+>86Rf)1 zf)U~Z#Qwg(>7ceGxx4#dH6P+UBy4piX3a`y)f4D0`FwYmN>OY3?91*fa#{?RSr{1j z!1rVcGW=6ly0?Dc62E(zkyApwr(%{y3xcI%nuUAHWlHg%Jrpcq4( zA}9>NX?Nw*DK&dFzv?l-)7-n~khB~79h^SEsSTuRu9qrY4KzMca?Z-9Q|8>T=2SwM z1XYESb3i8D?MqZcsKS<4K&oUH8^i6xmRCS(Y?TrD32GZCub}wu?z~Nk4A}DtD|kN* zDE8+wuru5Yct4?tM++Rnpd2)V>$M2On?I_cG$suinR@PW3Rm11s`&>Q2 z^KViN52O5cf-d2uLHL>m{^ig(;|yEW+?mV!}_>jXHbISEeraWq!Ij`e7>QZ0PGnr>2$_x@2rx=`dSj zn%~rOrT!m4$3-s#oyGj`&WG#4n=cqUC2%r#zOT^iT3g`Y92d2tQ7quJCW8v7mBG&F z;UWE!Yga;;%8I943X1nzSF&tLaZzb#DbX>S^Q+WL8KmmEm)3)fD)#68o9YgD1)K(r z9Mtna-?E1#)=Nli*3%LOuqyT`Di5+h2`%t4a(XIT*gA>fqWEExY6Gro<(i%w7F{a= z&6|VHS2xCTnJ%Qd9vGJYQwb2iG?c+re=V~As-%ZSYo8Z zC%SA>P3qMS4+hSc5h)g5SL^Hnt*Ekps1}hxU!^O8i$8*WV64co#GSpYcjIsLxRmbVdP3 zq6cVJ80xxdt=}!ze{nOv?4_l%M@N<6;qg4iKXdqs57tC9W3A=P`2j-3Y0A1Ag5*t&yGHu}|Zz`3Bo0@MB zp{dx5ACx*~wlYh7x^#$lOGA`0Xk7q2r7kt+J&>e^9D=Ke47<{5Ef&hd4jf`upb!Jy zIu9xt_JIyaz)~K7_HaVW0*$#jS{D{4m%I$w+R}KWoTKNdiZ;lXG6yxp8LqJ~Fhty6 zs&cR^Y8{qbzxILq@vAfUY+j}Uz7zgKlqai<@B0UTJg@ObaAsA4gO(Gt59~w3B$k?5 zz7^m+vLypF-V6^lME;gzc(`>=(b8C%K&zV}3*3*txU@105mOe5x*&If`@KNP|w_2^W8-)iH^g;Bvu;2ZBg%xqa>WCBzf7wNZUc7pDkFwHI4>6gaeV6oWyEhERR1>D+t z-0GYgrh^XuJE8(P5$flZlF4@aTn>B+;ShQM<&x&Prz-_C6dSjE=Ue8d3huE~PG9b{ zz(Z00y(L$}#h*7pL1iGR09w({84hY3X-riVWO%qSn!$eg;W?`cS2CY_|62@n_rgPz zoVkoK0<>HMv>F0UZ3HNPaoPw}F5vsQX!#7Tlb{_s7q3_^k!k(~$$?8jDoDzKh*TuX zaGiyL0hX5DodV4iV&*!ew6tOdC@tMK)S0_#n!$u0e2p9DfODP9K@BXa$WjqcssZZ* zrI-zp+0WV&NYK0y~ng{{@}53_cn8 zCg=u(Y|E!!yDb(aZCdHjpLcvi$*L$&mHA|6z$`H_Kd{T6bGRM+rKidn22Pn~mqber zuJH&sJrlg1@B=#|q}I$$ico22>A3`{PtwKsG8`YWMLFm$o{Uj<&QI_HpI`q0RO`Gh z_D}U}c+vf^&noznfZj=tsh2N-R%L?caEz)MT!aq?RWm#S)w%N>j)B*`l^oeHmjiO- zTr^}`&|I*sDLqHQ*Jrtj9S#GX*tDSULZ`x`n^_`kN8}_JZh+SR<}6{h0^6O^v%mVf z1^7CgMGrh#Kv&jCthpf*&&MFZurh1TGFc|URjqox2LcXg_=C>$fUI{@R90npn7o~# z&ad4v^l=dTocrH(k6E}2Wyu<9$i7?P+uA-FJDuGG?60Ob6{? z#ulft@V2g>ndpm)E2osBWKsqlP+fvOUSVz8T+p`FCv*P1nFVRl&JYJ(-Z?kqz{M|o z=jNyUZJ4@XnlQNj0GCs++HDS~O#r^hCbDAwXRmyzhNC_ek%(3mk!^w$ebrz^c$*-L zmEobFlf)!M`K}}iT1zhdmCw27-NjHQ{tvC*dye)_2kkcpwWN-NN53S%tpViy5FFq! zr>>V-dGZYZ?i3gaEW9dkd$#e^`ZZUIyzZ^cYC3$2PtxX@9zz_cwSS9+0kj5%=S0nE zMK{$C4R<1DztPNN{L}MY_W<;^JJ6K{tzzKW;UJ%I)rUn0Y3xLIbSTHeAbG3-ip>y*FMm_qyjo)tsx zaf45^We~ll$#CPRHr{!7=%@l;{Ej2hTe^i6K)p0SRAx{HjpaC0 ztHx;kQu=Bb+S}j8&JZA9-V?Wqd2j!2*~3e%E?6sq%knFB??SSIWna|ZnH|&~!v3p^ zfeUoTjrA?<%P&)2$Uw|lI_+z~WR6}>7C{z&r3W)y1RPleXC3JPl};)Qf(}9r55Bg| zdGP2|+@=pk^2f{m+?$|iy8ZpfD{Hf6{=OpWQ~yOA6lqVQCHs@k*#Rd@5hUhFt%4KA;*9MgVyWslL#qnvXs?h5C`aV~#0^`xF( z1~=%066hZ8Jre5oSOWbVZ!h5wp2YTE2b{;iXWz&%XfWJnVF0b*1CQ%SxK{7GbnK$z z!jdJyTFw77|3|z!YpDPl#Q}}8L&p6tFEtFrCop8LiC60l_zQ~slO-l+koU5r64Om*6o^q-&kqx zsjpquzXUgb>zVS(A>L3LA*b43u614e-3#|Kw^a2PT3rZN0jGFqiuIeC=e8%0#~3s# z$*yLg9CzMJw&!IzKX|4es)p=Tt;TQ%wEmy$w2eMC#0MIa1dXBW)hrEK-pB?YYe5_T zfvcPAWeG|^aCOk}7T6dNWGo*t1~dnJ7csg@*f3^U-N5}0Otr=2&*j~`y9jtmywZDATuZKbReHPvhKCKAa^M)#K ztTcC3-Ht2f!7n5gXQ+eDl|19G(0!Nbho$VZkX~=ug1Ytj*i!;uL zD}rlz9OF5lbId`b6U_Q<{h+;odnEQw7hIpd)bHw4R_)SNC0gLS+*4flAG%WZ%UG^=5eLM`AVRjsXQnCfDTEx35p@%3Wq!?PM-d6HKyRU zhX)VC!`UFS`>boUOYOM9Jn6&l43cLQGJww|eGnM2NaVt_4Q@tHgB94odyyO?!LDy} zU=RndXnk_b+rj2T(v}KldC<|t9H4$M7ek`)qpxeO6tZ`G#@7CXkF{bMi4p?km9JNH zU?Wii5~p{9M<>B!8`^lrpFk&SfJQW6<4@pu*xheTF026UQf3ho0>uY(+?4XsC|QR4 zp!PrB@jSvQ0NkPgw?kng3FMDT74#*Dta%?aDZy1YoPje_Io479Ocx7iBnUj58unrF z<5xcSB7;FY5B}XLIK$26@~_ViWiWTsWrxKopmLMM=Wf^#!HU}|Y z?xrqUV6wOQvwEa`g6fK=K2ji+zL24ob)b#Qkl}c69tE8r^TF)Jt0|sLv&2)oUu38@ z=s7^vcGx2KZegVg?y&$V*toLb9MJe=u;zQjST}e~1>shdF=fbo4xst2Pq8z+9A-<1 zSqoaK+wWdx0?JDt3_*)vtgTiyEPg3F$NuCmMr}vk(|*joMxfFKJj(?iQ?{h(m;f)s zL-3fd$yYwj`t9nV9dd>Wh>-zAA6p4ruc3q<=+>HN;zu@tme0&Jyk zT)j^jl>VXp&)hw0gqK%0odtJBbN8$7n3#~e{Gpman5d?E~zZ^1PW#^?c_)dze` zArZ?N5}xbh9w(?|S9>s*DY@}v!#_zw@QQmu21DP*jR#T=JOqm~Ot_)U0NPu!C^$jK zKvHe-;wI2OVbH2)WzelcZ!9!hB|d8g%-H?p;!ZzDo@1b^C#}+FdPJO^X$QI+9W?g~ zaU-b21<#mgYOM)o*zg&2r%^ovntctRSvAm!aWMP%1z0A2y$iBW64^dp4&zQWb=LBe zi;L$rfm-#McX-}po%?c7uT@o*TSOpwk)YJVtr^AMCQiyR4jsY|Z)RyRJO-Wr!3^3X z25}Lnw~tt}0qX68F!Tnfb3KVCU+@RL2hZVS8)bp6NI>ezb1~fXnA@9JKEv>gf&hfw z$liQ6@z{m~%?EjeAtIFuFDoY;?nwmEotEI+J4EbrgLcfDDF!+)3ncuvv!}d_-~8JA&8mUi$PcysBweZbGguo+}7a=jLgy$qw4ekvgShGU%KJ@LgG3u0-;cr?-nTSVHCz zJ}hXSW_22T>3tJBC?25V8%|ketlSK_TrMJ2fdgb>)tqI?7f{#IgJT5hk6Z;%jBqhn zCf%6V3|atd266}Jl7KgSQLl2qr_X_I@wQC50ht5>d3M{=m-7-PTS*@lgWUfI_67Ke z$X!AplfV-~Am4%~N!WN9ELSjZ+xG8ME%nP(LPs$W2P3p7@S7)b;92Ref32b*EXRWf0Y zfMMn~xCqkN8fabZ-1!2St*l=q zShFT7$Mp#3_iQa>dk=E0Jp=l>6)A?Dg{N>V(!jRL1bM^(RBM3hTg3Vj_QeUc;XMp9 z?s0!1H2cN6SFyW!#73-J>rH8&P zh}Kbjmf^4?W!ArUJs=;)Gr)aVfVm6>-G^~qN!l_OCQKL0TflmyNQubN6!1D3xL=W0 z&>XhZ)prCfLwj8VUW0;vH07xZgBqx>Sy;GyH)sXJt+#pQ+m%GtGs{C)>!{yhTj2F? zMaem3Q2B;DPawsRs4KznjD>+=c}%9bJB#{kt}UI3FGF6&d}pz5TN<3nML(Z{Lj%80 zO~G|N6DY@k>fUG3b*Uk8dkSI>UrYtXsyqX@?gicGH$nA?%=yMPZ`Gowo*kC+v>4~j ziQ{rC*mCs8Bt-@_P>l&wwfdb($=(p9@OdpW7Bjx$SXWe~$#PKapH9t51yP2LZ^2g$ zi9Qta2$!vMI&-n1;A8`XDzbjd1@D?31$D+$3MKV5ZGPeu;dir^Yh^3wwoJHw?L(^U z%hw$C@33@wagLDzv=0Jwknk+C9V+vWfmTdw?N4`!D4eMXO0nz=f?8%?ps__R$l0E! z|1?Rcihx&UXZz0Y>OBJ9k#P!?lo2NbPXnELeECrP2LTzMqi&ok-$3VXUT$3S+>y^- z@mWRQ2T;$+c&}H%4^Bh(zDU)>pp`+NtKC#4sW3ceVPLq$AQ0ot74YJNa8loekZC;P z3=hGww-}!65}u|U**;&O*rrQUQUSEPLb$@9e)7M=nR zgu$~-lWHKl75~f=>|A1|1seTH)-v;A58fE~Yd7@lKriqN5@f}`7(-0y&R5`NR0lQT z<;FDyPS_gHlc4($;u-iDI9?Zt@+&yBmU1za{ZnFO;73|Bk6B7X=R3e9bZNEL4)A@5 zi2EN-FqfWq{Vk+G9kiZU7Pg+aDcmNmU3BY@MIryfA_DpY7l?)b3s7KCV|ek3=NE&U zY`Ia=bS7t^X?j8O!8<>-Pu|4XGfPoSV}9TvC*6G+3MvdQvR>97+7$6IaRXP+9FDC& z7HwgAkT`XMLeE2X%_WlC7c}>q?%-p1aVp|XZ^$#9O6ew-9ZF0@+{1{NLE&MLVR!*L z|NGdChbeauw@u)xMU2;7c&vWp40yFKaxFrr{=iq7!bZvvs}hUKR6!*gw(;oNLq=ag z!$Vzy4417z{ndYW5UUV%(Cdq}1rFR?kY$ZvTh971_i7bRZuG0v+2)#Czgx1DK&M#xiO^UDzwYm;E%<5&xEG2MD8hJ%rg=QCM zm&U(&kXp)8g5f0#14C2b2Hb1n{4RjoO`tJJ$SSLBE>Ot9!UfwxP3qJe;Mxyo4LN;M zOKY0tT%u+iK<)*#xfMD3#9lg;p9nm6bmt6@5Cwiv`#@!VqG^i7;M*;oz>UxhrROI^jjq8bSU_S`1*z@FkP8AtBHr5;pU1H zs!NkEFbIOumiUnsEOI8f4(>_}-*iE33wh9PrS6i2)=xB^KZ@~D(PDs=`T7jVWj<(s zasltBS$3k*og5EYKqJpcMEG^wH?YOjH><2fZG8KzAK_yfGfGz7N= zJy%533t^ygzquh>=HS$4yZ^MzkOZx&%Dy!rFMQVfPr^xk&$+Z1Ua>GR?21cU^q3KJ zJ43PI+zTNtZHE&;HHth-%wvvqCikC$@;oo-4BfVp-Ir>n&lfO03_Ja27kGsI!WKr^ z&V@^ZdWbJwbc&xuX^R_Z~Jnk`mJl5m6RFep*H|&xCWQ|+6J0_b-7&?wrt*)E5f<2 zJ^gJnLA|1Q21IF(+zv0T)&iZKvJieY477{~?;=T*$0*~ks4^}5BP@0$S!Bi0srDkE z+24bz3@`f48p=9t0^0ZF`Lk*YbsvAdK`TwLZSn8cRErDFKYKo%JzL1fpv>@sE5cND zW5pi6)k$KBFqw%P-gK>=EHSUrRb+*$9>_#SP%j-@ubaG{fdKgYm)GF)UyRr7nm=El z_P0R@{a#t`tR?tzz+Pa1ziMp8r;zXQwN z8*L?;pf%+sM+&w}h*cQui00v5?^@ms9ubfQwGKh6*m@@A8Eul77Px^~afNb;Qb)x$ zsaD2~?84G78}vYVTnf~Ow3=#tMq(Q1!X{=PP(v1c`6Y)c=tPz+Y5fl^KzFt-V`Y$L zxalzwd^;xW{?HOFUwu>VyYs}7IT_?(Wh%VXzYHx?F61R> zynYsJTLE~#-KLZB?V{P=x$9;~|IT#w}b-(=c=k87L2@(nq{!NtFU(3b7$B_6XcWIyXi`!nZ z-^;5NxET^RZwWds`z3ejx$g|Zpq1i@hBj-i%9=t23}`8~ z0(9D>==H|xCLP7JQw+SITRq&4vK(0vakTUeXtmEn;R*x6<~Z}kk3{`CcK*KYB`XOX zj|SZ=lE}n==J1WLyKd%bm!>EPGbA!heCWUqa=1g%w6Iq@K;v{=42k=uTD_aGbgI>R zun%ULEl@VB`z^x2%D|}Tavn6I$j`vRz_?av`jkFLMQ(=11I^2LUwE(_uu}!MWhEAY z`Z(}1PzcTvfP`A04e01qP;O&mi0n~ZH}?ieoS$LNu9%~sBPhT2aDWyzfX_rhEjvN# z5alPR z%bz)~-*Z%4>|pM+WdMy=g36&{t*X>n?>T0Q{tOb7@O}l}FC+l%1I~vn99NZKNQ9hz z8RBCmnqe%ucN5AgY#eKnHNhQU~|a71cJg zJNRf$TRo@hQm}uBudVj33&NqnkM&-zOiw*jIDN|=Kkz-up!40S;FMSKRwA)#6jJi2C{^0?spxVg@NJZ8%6h>nO$PEWx(SKGte2UDLoL!$$)lt8(Z2) zyy2UCxcT6__urtqgxVyarKKRKefC(10UqXBs9~;5Fw9-!)M*&rh%hZ<-~{a_hyV>? z2Y_a{lO62Z*_*kOLehA=!DkX{e@Tw0nj@vE43aelZE3^WPyx3r5G|FZAajK)6g=MQ zoe=|vY{~;r{R{8pK^i1q>{R7Iwb`@lQ@?NGnjLkA?MB7heB8JbAjASXh+`q7OOhQd)+2GCioOF;W6MGAM%XS!+J| z%-|yHY>}o1_6=fM6Scj$91G$iq`_|YRs*fdfS&R?p$Fvd76TOqWrmO7_1}=vfZF8% zcpShyr5?2~66|RPO<6rnz{veBkhWGEBKL#p8;Mh(_7JS6xMBimM?AErm_Ny2!jE;X zHX9%PpXvexbKRzIgF6$Rdk(mRf@bw-1R8%lh^vnXZ80IOx(4+cB^f@kFff2d{}3y!MZhbQ zK{H0jF0MK0J<*SqDf}+@zE{Xi7{(da4O#vF8DDY5{AX5ximl@dc>8hBhII$N?hyd@ z@60RBUDp~bQuu3oC;2O}L#jnZhb}GojTTwGgd-UdNeLT?ZcIISybiMn5 zZZ{c^H#@=erJ#1yevqEbeab0ePrO|dbRxx3L-0=4r_`64=+|Lf!Bzj z>>F`m5M!9gG+ns>G~Kcswl|rpK~fQP0uE>o>@Hh|?E*Vam9Gsw`r^|o9-Tcp@}PYI zF$)amaP4+Pow-xN=vmYc`8bZlu7CP2u9p7C z_C5l1R|Iqyz=9{nHUA~_lqT*!e?~&gdgG}FvJ4UoiVUAw7#I@&++|ca{Jt^n=3FgP z%}Xn@c7Os=YJ&ji_M+~8aWfUSF)dKLsJ~|oFX$FAgPV*p$uSR_xGq3XAA;`wXk+YzH(GYcij~2-9<;v@+OC}f-pd0@0^kjI zab1s8K>K)btayuoZnAFM@d>mnFmA=QDWFzjLE6IxF%i&ooDu5Uoqo{%9@}_Dq?U?)Mv-C~)x=jiUY{$>;bouF(?z>M z6Jqn2z0?F59`Xmg{b=7{{ikKdV?)*a={%raupqHL7eLc)8_#JeE?@wQF|GU0c;}(| z5gFb&sshU)>X_C&Z+!=vxO%;Al5;o@XpX3#@g>MB@jFkw0G&JJ!o<&zQo-_-Ph8?w z%Uj3o5l&|&GQV1;Df+Ik%UO{JbhkW6y`lU06C$9}9IN_=lQOF`FFh7%S3?D$&0qfLE|Xk7`ls!@cS6p2`l%0UU!v~BKBN(( zSEYYdPCh=#il9B<)oyLC7(^KgA2&sto=Y+068OsV(CIp>c97tEMFwStMBP8DjW17> zYhd&Ud8)N~d#rYEwy*H2XTNW;Rd&7q_kWFq6(~o+Q?e(6GQ&fK2VRr>)A$=^TynX} z@=&Kv;OKs<$>rA=%RQm#S_!-}?1MqqlE3>pmIK=Xg^`y4@Y=<^Zd@knFy8dE`X@mN|&=xrL1nIe$UBR-~g z@||nE<=WdVw9JG+=L^HnUXo$CV}A%Fk|+mj*Ql-iAi~?@KSf($Q6#7e%lhbg((9tK zJj08uh00$Ir)vM#U_3T$QMZ=VYOXB7-60At4-#q?tx^JwDkZWryy&+UbDgCFn$0}5 z4P>W)$EVPbuAIEFPLpPRVYFGpBYv||L6+ggssm+g4iESrt@TRcTBFr4f%gF$Z>-Y? zqbo|MKx-;rtZHb}Q>>8mD)}B1*%?(6s8w%qa2lH`2g8f?sfy7enMP6!FT7UV&|vnA zn9E;n_H9XrVbX#-uFHR5r#Q=6cvIMA2!LU%|f(F;-M@1>IpDb*S1a6$T z!yk0k3G|j0(CLQzK=mQ$b}R`|$X!^;4%>DchreI(!AQP6G&qbSh-stme^Lm1R^G!xyqgfVIHWO3-wE;x0nGQ9AA@%P=KO;$&eRBQrI zJWWklP`*$5zmClJ2(GX9nL~snO++@ zmrZ;s1F~IF3g)iHi+f9E9?g&w*mG}!aEwC_m%g?*1E;SN!w=B;pD~AabtX2lH~%&b zQ-5y+UJBR-+I1ygU(LrL`R~f40?zDm-_*Vz66=B|dY?}{&~#Q2d_sl`B%QAN!Ds3( zH9cx`>(7`&u1@eg&|m=)Atw)jOL%a58#V_$qpSDQ!H}FO|MK|3r4c(r zq>=l|$E(yCezGtyfX|gt7o1((VaqfWBWjJ$f20F8##ffkA>t?Y&Nt89;> zly#h-eQkWYe^~k1ajmLS;0KkW3ZEQgi&VBce${GQ$zaUzi-iHyq6HlW*W}DyfAH`} z@UA-0nAl@bvw)M~Ay|(22=v^6HaXAUb)22aMJ^{666QtorUradM=Pv-5`;dPUSDyCvaaj zRAmOwzhE(EL#sV^d=hw{E@;IzXozozGsI?yx#zg=f=u-}K7|Kt2IzKy8AxsctsCK% zk56I%o59DhahJd1)(`d#)?b)Uv~mbS`Fk$N{$hM`sKn}rK><9$cKF6Lq=%W%Zl*i5x*(2VUy&N*f zDFWV^pUG^cl%U1$5&;cCWrjcC_Fp{%RQKdObI`pC_Zj#Y0-_jIUQasy@L@ZsF$FpU z*u#R~WXb{NiR`Z?L>5LG`6Xy^gGPw@gB&I+ap-e{&rP~D!N!ZRR$M)fxBO=n=yv~|oqkjl)b>FMGY`;_*q|_w zH`Fs?5C-4JzR3?fOE~quvC_mVZmJBBFx>=FrQBk$1sYOYz@t$T;8qA|%`^B4PJOrU z`fl!^Q)WzrB;?-y)B>%r zw)j7(cq5P>LAT|6&`@Fc$HKsn^YHvsmIICZk4=AZD1MF#2Po8WyBXwmaY((x$MmlC zENIcg_YEFN{Q5?77(l%ac$qB2a))~}xJ(v-_4ETK-3T`6GpLXhh1_vR@P?vQ3hE3m zUim~UVG){am#E#`rqq@m_~fvLLxRrnqbfS02M-9cg^6BKDl-J1(TwjFBc!r<%_HTcsHOvoJ8Y zu3~3MOj1=|nj8Shwcu0Yxfv>V${Z}1RKogqp&bJ|L*w-1K&x*h4D1Y!r-NK#jxS&k zgRXxlSuE3C^EK|FYn$*QiM#WaK()e&B4%-eXB$3j0-f0T_wCjpK_Lg!){aX4~$mc$?^6zP1!PyC4o~wH`RSQGZY0 zrNT22hcoydC950Mq$Pk#RN;yTFUn11;wxmQw24ddy-b{z;b&j4u;q)~W$n_78$6s8 zLA8=_g#*X;*6WU$51s>4do5wQNMx69m z#OEOm)dBa>+$9}-COSg4>=)9M7(jdFLedX)UzaN@xgN!?BLi|jgTi6u73Dh)yatUx zXGEx+3N!*8h-=CLF5yA?#M%#=7=#%f z&NgU&vra~4LxNOUNqv8G{q}ay*{;ehyR}i=)ObV=bQVCe!=(+2mHP|I<=?dIj%Ga~ zR(uw;+nkqyQ~240yHlG5-mPmmG7r?}<@1cF$}4Q}+&=rTECVNa9hNDdqAt2JLV1M8nPO#TN^MR;Wy2MAe)0H80TQb%=s8 z!@oNsGKuc)oW&>J+5Jf1yLnej;_ij`;-?c@mOd9_m$?7(ydr}lcC%kksbJRkjHo&% z688;sZ|;4N)lX-DLK5VAHikwv8O0VwaGhz}&cMyU$>X5~ax5sU_!&AOVGa&4&}u>+ zhE8yJE8dA^?6j4{VyA#~5;&ZN89E_$J!oLPykYV0>N~%7+k)cdzdJ{HI3GBf?6LI{$-1o8}wtPBh#&^jDMgW5$Ukd={5kzE~}pgaCRGwz-Ypd0BvPi^hHxHLEu zv}ThJw8~);+hNa3rp`7F6_Fg^)GIf=(IYX1f$foIVyBO& zL6=c$xdJN#==NaHNJnS(tp^|-p!h)Ocv0Gv*CU}6%-XZa=b0!r!0+dX2~!C?%F^HcZVDuPmavI8gtJm>CqRa*V5=Uv}AP#l5p z(2nVPSv70r^W9Nmn_BtKOjA-?%_hdcsmpzH5}*5xi-Ct^HtpswJ9Kxg-c@m422NdX z!9v+LVx6zwui6KS5zyF|hk>`C;mYFe9w}F4lFCa!qm|rHpMgxa2JaNP(%YJ|ka_dc zjuWd2En%4;LH*8ME)Ir=@!&#O4%F^D=IR0(t&2bHv@HN+u89>q`QG3x-@Yp(UIBD_ zHP{^>;;-y(*GJ$TRH_V2tPG&lF9x8v2aTYXFi0^Z#`U?r{7|IhRev0{Y*vJ!u*9pFszAgU);2GI8Ak?ljk? zC_m8ZBZFtG%u4m{sApHS2r&G+W3WJlF@8StD)1TR;1g01bNDun&@+jnSP%3l49pxp z#vHv4DRcBX49u(y4A2p!HsqOlPKKWhJbWAtk@;2N^((N@1+SFo_glILvQ*+@kcc`1 zXoem~=&oZB`hi{nvd$UyCAY^fWXs{8K1dpX$qD14xk7tOD! zRd+=**gvl20|cZuV^D73?B{(?mC~ zIQ&)4O2mS^c68O!;Hx)aSMsjhdW{jhLLStIL%uasbk#DsG85UyEcSw0lN!ntg0IqMR27pIY`e79LsA1 z{9cBb-dgl0q?Er~<=Y3P!%yTf58m&85?81h#Fux2Q>F zL99xIV$NbvZ!eL!)FFe?ztWz|#bV&(x5f46N(TmINFNy#613=7Ve3<2rUhPxmB$=C zlQz5x2>TbfE3k4lN*VX_0XN98CG zIp4hR?(uWNmQ8^h_NnjAGRn{hYP1(-SeX@5q|ES0&R|i;t3$7xrU-MMf%LmcTdHxTO;9dnV=ye#@j5Q20@*~g=_xstAgfAWd8QGJ?38D47v(@gNMk|2oZ-v8$B|<8F-the~FJ!F$C>h`gbQ~ zaooyoNY}U_b0fZX8KSj?zid=tm&)&c<|s)M@xdp8e!0By0~h(f5&?b51-s|JNRILxhptbK~^IeuiGWh*0O?0 z=>w#;kYW&Y@G{$c|Kc8vq{b%s!=IEH#F7(41)N%^tMV}td^{ai3__5w{Rh&*aBX%_`tnN(d?;!T1Vd)5u&D%vA>{5~LC}sy5eo}@ zA^SGS_CW>k>X(8qzxx>?&hUZmFp6hjWBAAJm{P0A!tl?%BLS3CU>Lf#_uR$z_Dl(e z)^|WNBl|()0vKTcvI$~p4`T%AHVhNcY*e5PTnuzJ-c&XQ6m_7ctqBXbzQGkg(Ag3{ zP~3RDabwUq#sQvXK`*P-7&ur#Gf|-1qXR*+Kn70J?3fY^-N5$~VUHouzL{y#I}WFP zvz{gHsuQq5nsI{!^XdixEe@sE+Mp3#Veq(P+Wy6r2lH4CB=M|aQYrx5tvvC4pREuy zmoN#`rOF93eoiW>=aPYpTAitL|GcP!wd+#@E9f+2mdVU}LmfC2K=A@;lY!<>g&IC+ ze{SHA0rka{8UER`r7(&4FerVnb>i;`OmtwWXBa=Ym;^|TgLF@GrnfSk0 z3L0+BGf8xp1nr>WxqVddXi9M7HfE&{pGy2EFt|K;p$a(*ZcD%QWkp}u^+Moz*HeNF ziHAbfc3Ui(p~9oGPuoDKVJ>KFpNSuI64~91LwXF5eIUDxwD#nHdSZ}XEvr+WRB%ba zm4nq>-r_6!S9*buO#`2NTEgz~;OWbG3XB~G0o)E5Zc=PiWqy%bv12X*=N5fHx zmj@a+Y@l-va&X@|)wIY7EI!oW!Oq4q_Z_EDgFw|vK`kzZM3|lxpfH1sz2izDpd2j1 zAj`nX$^dCmKvOH*3*4y%6t~cJA5y;ye!n?V%8_EI1ZBb{&ftBxDhUVgf_(Es@E7|l zHfii~hS&cz?gE|V`|o&z&w(ar&O6Y5ff=-g2AsLSK<4=9hh zy;$nDLIGwntbjOB;{PEzq7J-Le+2^;Ex>fgKwEr0Ty8Tl^kxW#?BEpIB(tD!YdC2BRTC(HK@(`kl1w^uvtcRrgr$5@rS- zaO>4rlYTg;1sToA{QA#P`--xS7{iP84S_AoTTe8#_uu7e z;SX*yJf0%W3R+nMT9YEc@bkdekFJ47yxC<13TkT(GK0>wf{27(V`RL3Tzm~^jp2WA zj}f%v`uGd*k>%hTf{7tRQH9|}KcB(8&3b_cxH=R!3V}9|tQRg>#l2dZft!_q;WQVw zMb6ExsG7hjDpH^`?U(iJ%zF08-SF_DoI|S`0u^>j-@NxYoK+pFlBvo4HRO~V0f{_*w3=b7$7+&Nb)tR^wX3QVa02Ldq9;;H`Tw#*@41qQc4X?#xtwJ|HDmt?~gaNX0LoWWq0_MdYlJOrL7(gc#Dssrh zZ#ZRT&@}~gydLOuJy3rDwljbW)YfQO{id|%oB}IDqJYb_?F{^ov!suMjy7ZkpP(xb zQl&Qgu#0$35J%I0hNu-T>vS|(4pt_}S0vaz@2GzZn>f+PI7N_!X+epNm>EY7;ih4m%AH-ym**U?Y zn46FOUORM}3pA4Z*|qxaA$!?`n&tM-LH9x&+0n-snfG9Jr!2D;0}m?$!xR_M?r+l+ z7VbZET8Wq8A(HxbXpM9S;v(>DF6cB?qle6F{^!OFtdo;^snonyUvm8cDO-CB(wYM|5z$+@ij zRtgV({aB>&Xel)3vaVjk%(Sjwze_1@6(r|^&Po97>Nm84>|}$~O`uu|G;RthQ$Q|) zVdz*-AF9(qB?hd7mB}sGQ*trV8dSn6LQ7bWk_!T%?E96BVp6m^%`EP1*`>(9%gVq| zEqNtbp@P8yJW_BFf7yyCNx2yy>zDDZXy%2ean)0+dGO*t7XxUF6mly@>}jWMEUZ^A zv5FRZ{wtI5Et?Y{)u1K;DQ8~@`tC?G=<4>}yeyEXdFI#o21;TOnH5FBLh4;py6=UG zXo~;cD>M^S77H=#+&Dq^<%ff3tcrz;HfHX)Vd5go@bAu+^XwAMQ8j@az}8ZL!hnSi*0W$7CI_`N(tDgffS-; z+a$F+BywKFf)#S=CAZ7wTmZLgC5%8Z%E7QP^i|=kK1W3{(1}EU9=G^0Pq-ez3*AFw z<0l};An0Jk#`5>^6^=y`clRr}J=Okd;oGiXlg8pDp=_WGYMFu0zk6e$>1*;q(D?YX zg^LS!-OZY5e9f$TqKm4QJiU`b4gW$lFc z)fz#1zp9tAF$ghO<~oDI`5hl<;Pmv%=9(p-vn(Z`t#@(PMVr-_Tu-^yuU`{-M)jv8 zw-9J2wr${&n3D1Y5l!(}KlvxhJPe7D*m}n|^MsNlblhW-!^EPC_q9JymGzvX5u{fo zx>%V(1T?=YzhfSVAA9q!S;-=goi9XWL92ol9{hUQ{HJAR@@3}h!mg)Wmq#|f?u6_} z0qrFZnWo|=qA5Oi5~QTEWe43Oz~cdN+nMk(l|qnFAr+AflAv;jf$_Tju98*HR2;vb za#`T96Plyt8UFp}w8^-2VLAUN;k3T9_aH7XDZG6F*{*VMq6=b%lq(+Kl}vrB^dY-Y zRxyZ!%ECWQ5}PH?g6?F0KlSISORN7JeE~Z4^xvHihZ{K9%$pxCm0P|IbjHn$u!@^J zps|WWA{G{kXEgTc@PKylGCMXl3pWLBcqhs5@6MFQe&iDwt5!z7_;%%zCOEvV$U?&Z zyLFzl70coT-XKUx2--!<`RDFNcjye43+Vj%WQS+L4^tJvA*yEG#VMbuk!k0!P>X?| zm4QJwh1>SJt)l_=O{FhJ<^Bv}pq4VkbRSSp3T)366Y%LZQ+kVYj2;>tt=AYKwihvofMTtMSCs+TuS#;DwMbXlroT1;A9Roi2}y4ElFlV&2Mkr2 zLAqNESRk?3#saQyzQ};;>KX7ft#$yimJL!mf=Wiz)ij{I1j0P<9?irnZmOVC5k3OG z_`Wh|1udvlRDzX?EJwUuv=+!M?!Iz7gzuR8sYuOP&_nq^D+~#ghxkfA{44t)y=&RN z7Y0+rn>KWRhU86R+MZktf)3#IRF0sUFtH&>LIza1yUT*opUEV%wh7Eh-QT0R1Gt)< zXWTG!@C=FcN<6Iy>7~YU8FT4#gXTB0Z#__A5MX6sxU^X0LV4k%sekn1`$2m)M8Kuv zl{i1e319Zer8LSfV2fPBoqdu?wM(IiBS{gwM$JPMd`2UtUeNxgEz^TJRBYF?M?PR* z;VAaQ1_n8Nf+&u@=jur0*hA#c(Rb6j2cAUY}_{sr9{ z7-z;H0Lp2{*dM93*|)9j@L2a@lQhFa`TBC7vOAuexSduC%C>zvbZZ3@=&0Z65}^6g zhp@f)G8Ypy^nIQ?Fbgq&#Xvjq!Lhb1*^7;v;h}tOdBKd3#@(A=g68v?_@TQ)UV!u8 zF;@`=VWgSe-Df1WDJfZ;Q~}Gj7_>mj5)M94>9pXy;?C#;5sO3`6huMpT{dxx;RG3h z=$yR=^cvZZ%v-Mn%^wpO1VAlIkWIa-_ZB>~{u?O>X@w$>T7u55o@n1-ec*>*J!ow1 zJ_G8SP<{q=20>N^(8|!xX;yoZWLxX{LFa6O@(^6_lG|rNDf2!94?{rIQSfO6pfe6Y z^)9HUdv<*)JBPkDg9vEfYSV*^M)?D>M$taE_XJ*04OA3@icZukX_t8#GpD=LMO7Fg zX5V0)vTeq;%Eh)*)3a1S{@EhZ^kB~g*`g`Mg?eg2Q`s02zuY}&xPk+E@)MgXCqv?9 z(6M_~Y@nS&iCem2f~?qB!DAg!AUE?s*4HmRA@88PM@N()@t4B`0YSyZ{~1<-4`aCU zkkJG*l9$MHB2U2#w6b9(C?8yAXKL@@ken;NOs!SHLVwLwZd2GfByFIRrNFAw++4j8 zVF|V~3uGrKFPdq7V!yzluPqFU6E*91DmPgdUg_X-u1s9ZtN_|^`HS&Rqp}sx)7FWPr=O1-PIekaPp;7xj=V` zq7c~K&@i}pM^@&`-GlevD)KOF+zL6CtMB)2TLFffcfwxnXx_K>N?|>_fFz$Xs2>H| zm9k5fd&+)^x6ynZwWmS-2mx5!rhV63GVN=5^(kJ62={;H9nSU)pBP~L^WYHq1g;?@ zgh1gYzz}G2BcOrVWZkzzt?$32gT|NRL49_cj9U$TN6NmxvjdN3g63C2A}$PXfh_H4E6OoM}6Dzbf1Z{K<3;?eQKZsa)F3#}c)HMABaSx+R z;gd|xNl=X~iVP5$2VWd6@z`*4@N`bq$X-;$nkA^lzz*4!$P~dK#qi>l`t(KJulQ}n zg8fvuc{-PN9SLrn+9lg%1(V}Cay%()J}XPxks#McD-U=b<#Ux4WYA|2W@Uit&iW9^ zlk;lZS|(>d(D((8F&5ak$9(;Sr&{V~#0#2M&w1#uMhnz$fvo;#nDEg5I+wv??i&gF z8j88tKPiLC3Q*oGW8Sz*W_5W8xYklqO8N3bNJhbr50)BNpE`JE1^8qDs9b%<8AvQA zfnu3ZtuKLyui0N5|2wRC#}H-Q%6`ELG$#s=uS;sR7wiQfJslND9M*fNt^II?mCMiY zQv|2w;S-A@GRzG^OQ)Cy?mQqc8KnCl=v-a&v2#$HTNpYD^p_z@Kiu*#a|Z7Y=m-#K z#)x6U!$x_wlJ>&WhnO>J^+YagVO0R_2Z4zj?$NYqxaOlLazSJsWJR$SgQ54Y1@#IA zDdiG}4=;IVkazI)oXr#FU;O(|PgY}rri~A?#)3@lcjtGdD1zGKgu(7Fw$5s29;vQ~RUS5?5i4&j z)BugTAf;gmh8M479bQAy@Gh6oUB7Ow%#!zhr>Cq6mdUo6V8VQ!X_t#?^6{VzD{pV( z>h?(qp2ArdY&?CxUf>o5c#59EAP-HGTC?;53c4m9_lo_s6dWzC!WZIpxy)2yP-1xD z^~Pnfyu<6`kOX~E#9D-PdB#2Gb|dern_dVUIc&_&@Z!{hm@OM;FAeaIQtD`T0;Ovl z?K#LkTVn&KX>|;1^=%ri*>Ho>({A2fPg+-=S_AI6f@WdB>#a9fH(V26=pDBLR5Qji zfYx!`c=vFry~Cy#lf<(?DaKHn;RU}#8++Xhm8q7uH_gxs-1unsvmX;c2e$0`kaI-) zQ;ED+#1sy`i%%bED}Z-@GKqYyjgU)J)NC`;G59OUBh}?0x==u?r1O+m+$qt{gryl> zvRzG&Kz>*VatSOI-Q36#`^kwHJlY4EAt__OFl&{z^hEJEGsuh>c>L)N-vZO%7QM=a zZ2X{FYFl;1Oa2Ku1`MLC3=F%Tv`XngXBohSNwi#(V?F5(BB`XVT3R8`}6 zZ2F2t9?anQ69S(;vUu^K(|Zc5WJR_2W%p@wF(leS2L6f?xIt|2ke^DZ8pPk5KsgBA zKHI5UcN>a9jg+ljO1!x31DzlD?D{KN(YR;5mtU`l_!wIpqsV|{V*@T5aph~&I_Vs@ zaN)vh%i~s<8i7&;N-qBFqyiE{%f$&DqSLM_vhlj=gsRNrS`#9}AjZnT@FqY+1XRKy z>LXc(7q99TUelkDa!G9xYuklJ#(<(lZ0jt`m9sb*Qb27QuzZC=Cfht#mbN*ty2t{2 zzIj^Ji+~8#!iCq~eu-IOx@papUph8UiBm28#hUf6{Ms0@@nwje62ptEi6XumodXN1 z_+`0PM~TTc{aCQj`-SQaSLrL0r*S-57y|00fyU9$OI~8hZ19TPuBTaBL~QNs1XU1(!%#-v1O zuHb@-gX{vgdme$(g(}0vjtLhl7h12fU+kR{;Kat~TB4$NrRt}QgSvXx3y%dHHa}z> zxWT7F9NGVWo$)Rgn3A2-Y<5l-b}dl}V3CXQo_FUHXw~tN`~Q3Nj5HLP+m)<@#IyG9 zndVRgGpIth@rfA3r2qfYOC~lt3(9tKZ;gAVVfn<*Pvqi62f+#h_mhg-pMcIVIr9G> z!a0(QmUz5-;vy)^DbmR9JVoTBE(7Rh=p+BXvr93EvobJ1t>am{M4`NBQAZz3*Ma7R zQ$?PLfmi;4%9KNbiiEc2DW#Oez37`e0p<$3Sq*PsHpu%rY*SzWtuHz9 z|L?(t9eqbyqx9p87c7MNx8`hPn;2*}w}%DDoEf0Q(89PF9twjjaVmc!Daeor8l&cP zZ|OP5{TY;h%s`{NPF=_PtBF69nbg?l5D$oFx%omkGGaR5>d%Y4P z@4v8Jv37%p=)y&Z(ieZ+QJkB0E>Eyv3X?5^BEt)Pma2sdi>}Ogz@oj3v2v!KAcvrZ zcdwwcVRyj4un3Jl&_4Y4wj~-oiid=JJ${{O42UpIU72?^vO^<0LSxaUIU778!uc5l z8D8km`qW>fo1&u`uA42Q;cN)Xnc!KOjJ3j&)j=&&7ZsLuH!Kc$(6y`~WPNC3)Dw+0 zewGt;7W_2;wNWa%{JFUQC~>i@RC3W4RbhOqbTCZ3Xi93wp;uFcPxdU2FjQiA;h)5B z66pH*?AeLaJKcmX=n3VND!NCu1)Hos&!qCrLAX|#;f20bYVaqH)~kVLs{YfWOuleQ zFi5a6FvOaiTK42+>Y|l$4uZ#mk9gaIeLriX`q5<@tmMC)sp#4eWRmRPHQ@%cZ^%Ur z(AJ60c?{|dFZfMOH-l7p>}Z`{)TkJk_{LLknvp=i;=GART^<~pClc7`y;KPlPW)4j zWPiH(qVvtNoOvM*w#RNvR^n>O2naSd7VxhumfYCw2`V}GS6}664h}i`LC5sTH*Z%# z)uuq>BZqEGR$3#{yE&Rg#!)29NJWj|h5x1Z>l`}Rjx|j0Ja$u;sqcZv*>+pwc}haJ z-F9zSuq@5&+macQpgl)Hlj@Eu9|E1d@Fq<&KxjSVX;3+bD|HA%#*O;AA75twnW?Dv z{lkGG(C%p1%80sz&TI~FtH7*q=0wn#tlp8QyNp2V9zGun<#am`ctyos=lPm!iL;J2 zVcZNGyLs5H7?O5aZpP^+by}6vj!AXkU4m77J#~{hdz@Xm-ZucZ~Dns3@z`&U))4?DO zS_e~@Bjj>i*GNW4Ziax_aW%K~SDrGeq+A8vb0g?L*hj()H%}-nWoDW%p{=@`r(JZ_ zlj^CA44~eCS)|H-aM*EU_@YTYU+tP>_2Q|vxbz{DWT@RLF4QbGR2 zhZ~%x)~w&e7bUiG5~RIxAJN``h65kdI`nV=`5o?Sf5?6A;800G4gm$!5NJBPvGbyK zX(a<^r0HSi(~3mKDfSQm#~Y?w{f=z(6p-D1qTqzoBI{d=6lWY z0jrU#XmPz3URQR~ij5Z|20*D1grO^<{pJe`2ETR_E(49p!q1VmQ&(Dctyk?0s8mdp z1ob-1tm{2?)jCZ}c4k~DAuxFs&!T^vYLGq~w)Oz1CkC6vmpdK2_`f!2o=F5ei$7o5 zH{w>viPO~$Pu~hxwJSpXxqjt@>FS}!KyKq@0NwZ(d(UoR`GSAY8~-4B`wvJj@4C;% zm_J9Wa`8kh=-7p!ZvOlW))yW^bbxm0fO=x!`}t1aR{z2`^&&e*(}`b7AXkCb1B1q| zpFHJE>+@|`xi#d(Y5wCD{Sb0PYz}F>Dn1^y$fhWUVJpPbzj@e8gMBvZrv> zlU_H_8od1sN}$zLZ!9#SW@w6j`ZSO4n8jT?#nT%XF&+~%mDH&PwL!tDARdwWL4E^a z=-qvN7nI?l48PYvgF%{=fk9@WyU$u_-y7f%PLzPf0LzgxML8M@qRdG_lO3+IFKXV3Cx!@hf`e{bQKC{ z72FHA&F9i9&3VDI0q~T!;K0F)y=im#!6{D#=5MF>--CS16tWbfCkZ8NaxS{OW5XK0 zjWaZQooy3T1sGnOx^YtB)%=9kr?w>;+|1md8UtYM5so!@06Gdvb z_5OoLqZD9gPv%edW!-g*&qX(-`yOa(b^UaM2|xO#FX9n`?m>8w3qI%cfCoca7s$V` z+X-A=rhsl{buPLr0KQdq`(&s_@a>e(u1_^AUA6ydxLfP=QqWl=JSRXma$enX@Trxe zOCeZ9ok50`f#JlTCW+9?Y}1pRUIrB~urVY)Syp&l4!%3fHBgxXpXX69O8#!)2#!~HdN$s$rc2a$AyXpgFbFOQRb^1jq4asYRM#?}WVq`0 zux#_4u#{|C+9S*CpyK!obh)LhD$W&-UoaE$SRcyA)4>T1l@g{BHWGY}?#F z;h@7+(2;j5PbRJMYvEyAm8W&*F^eK-Btz?1*{b;*k~|@E^>?4Eo-@nDR?tXdh1D(4 ziEo_X{=6doId{Yy6Ku{MF$)hZ_mEBz69bof_Ogu!KThj0vxu9d!MbF>6*IW>g7v3A zTP(aBKR5HB5`!!&1A`HR2*XDW_rs4gru%k%u{f&u)?(phUPndH`U4Jzjp5dqiBkwFG?C6L`%ekg5Ob`*_yTJAybRWDt%fzp#!VC{V`|?h(==?~&@$M#{+wm(a6~N~Y zw)~OU_LPw$&Fo9iiK7{khqu`8ksazXZuH*>FH|#)^p0fbJWL405at3`gN5JNT3kPjIf{^6|XY zpelQ_ut^aVo1l^mzP2pt{tmHuGarNp`~%-830dbt%nCKoo}UKD+AE|LHL{Nvs2JMt zB-AW|oJ6GnAE#OB`1r*F&^j}gr9WOMxuvXX(zAL0CQMBhG=>Ep*9uv8Yw4}WkG}0EM z1|g) zc~&_dv91aZQ2K!8deFvya0qvSLKsr#fy!S{dk!>Lg*XKTBoAHTkf)WC6Lv5jx#qhQ za^uFDrv2cW57Yy$0kx%#H>}zAL1~M3#tWfIpdEqmF>qZ51y%+IL9KF6d?!^BQ|qAD zER@zMgv%~OsYTDS33S%RGjY(2DQezUKwHN--6Ko6xTsgw-;s@3p9NIR2$G!7KzGdu ztlMNg^>nBjI7QsYogzS~0=73W;K73ikwuVps)p8EcfKEg8Kv0Y!T2p)sFS0m)RWD_qWOn^kTA>2`jI2#^3@`kf&6jTs zdDy6;u~Q^AP#ty z7pGh{2`L#@DR{15{K*Jme^o%$Ir)z9~_XLtA|r|$Y^vGAah zA_GE}E4Rz<)T0#=`+mwVIQGRWRs&?q3Qh1X9)*_Qhh8tx>$1_Tjjxbp0*_6LFjRtq zSEhNblsWV6jZ0qyO?0kS&;YM6?Cb5aS=kw2*b9d8QeFOKxNl_lre|E>7cNcXMn7K0*z~w>nPoF z+6FrHFCMhA?YZjwpbg9>`Y$b7;?9(uc#$Rb_pbAT=p-n3EOu!L;CK>bDE#m?;?hAzZolJ7 zc243RZ$Rfn2s(T^us!+X(w?q{{Nt1O?g;xF2m4x{L4{%C4bY}0A(_dt9-uH;c<$1k zC9h|!k~b)iJMNUue!tJvW3B+hzdI?9WoE-|UIg;3G6QTM+@GTvxr)($PK7PdUwADm z^2D@~EjlUOvNJT(Kw&En8FRtX?+3+Igb`(ty4K9 zje^^{q{a=XZr&!bAyi;7X!VIWsJ*zu;#=$WK&w7U(D-f58 zrA5r;;N%1`Vk&5(F+U^(zV zJ_u+7OC)IhsBnct-WuO;BHJ12j{O!>0Iw*07R~puqnUa6^*FIOGtjOS%h1O`$7QRT zz$aQusme}1ur%||zDpr8>JQyH(AKdf66@Ex#zhc=*W(?@(>!>oQ zfye(LH8LM~>hsx2Ev#yXcQLZ49R{6(cb@?=-kX1M zr=R2XsF^=MFLr-!)vCqFa36Ftg1XYZ^>HCWbE485Jez{=iZz1b>^}o5!_Ftu`an4p zv>UoGNV@Za@-ngPBoXjQko635V0o>l&yK!0m?3j}qD|ior(UKW|0^z`r*vhTl|bt$ z^iH2ulv8LpkaB=gU0u>k9 zDEkTJc$#MxcsA+2RJ(iEBU@HM3Z_QA)e@{zXu8UcNqLv<_6k5_`UWVSf={P6X#$;v zkO*00TzfJ6mI5cJ?%5N4BthyF$iJX94SrsV$7;Albd2lkzPyN8uD}LbS(V7d-(ef? z3vqXs063%%UNdA+XJufp(6D?f?Gkh;qn5|9PCDJA2u0=#*+>EZ##o*$L2~< zY=AJ#wGlJsYrXykzC#N><1uH0fqm$;w<`s}Js#MY|B18)h0wK3jBHiUceg&4(+=#` z_j)R?>hQca^=2VTj~TVE3?F@6nXqEE5~%io^_3B0ws1A@9jBt;)hTl=L8nS;9JV~j zX_y{x^eZS2LRYO?s>Yx10F8EnM*BhiD(GF(oNKq7Ihe2T;GbZ)LXRN#YOf?NG11C5 z6#;3wGJCs1v={^!UYviwCY}3pa6yQjHPe!b;4yAczlaaIbBDj7*;}^2PFD%k8&#EI z&|qa?Ksrme+(eICo%2J*!G;t5&@*#Er8H#!y(EL61LTr}kcye+eSBRl>RdY){Htzw z1u8uo4=_K}s<}f$qCK**7_;!*D*+)dqvf z8AU+_(`~G-YjP;aGGyN2d6RYS%R#+XRaI^gf#^koQVX|c6nmREDa(S&kbDM32FKHy z;kS+o-cJi|G&9thtK|#2<#}mvX4T4>{737vUaElBo|HA`gRW+NvNK?om>A?jE{o+) zRbPM(a+)j6@UN^H>#c+bEtfKAfn?9?$Xu8(T`X?_>y=Mk)_3|TQGp^#9=*Cv@g|VANq;|C=^h3{%0i8az4pf|gPQaXHwnOA{ zXd}nkwj1~6Xo44(Je|+f>ZkxZ4J+kLqX*AV2ns9zw3DZsliq$RamEI(xG1 zQQe05AMK8UY7dDCKc_i^3>9N|czw&kr8CxXwNxHdIQYfgBIU!3-9L<37#?;MPUK;D zsQw{gQ|F?V5AOR|Ss5O3DDrFs>1UDS2*3GSG7+@DfJM$nnL(44fuU^96sMk_A{u96 zKS9e2R)&WP9c%I#SQr=;TNW}h@H5CVG#+3UJibi8%)Sl%#_T97(EU&U?i@MallU?u z6TB;buGeMnvo#w3f=}NBx8Wo}@jfm1Q)zYAipvhKrLP|{7T)?}Q3z-RxgT^NGUyuR zKG2*4KZ6A94(RCBg-zzU?z;OlR&7`yxA+e~H>k8zfZPe)1u7MNj=H`4u=dJN(5kws zb%}<5L?=Ep;A42WIA6Q;j^lmErOX0ox0Q4&fzMEmc`R3}WhMkZ$9 zAN2ML5m0Dn-C{Nb=tms+F}MN1}#?55ul9q z>kaH~q1j*`bZSZ{h;$&|ebM{H89eZUUKUveyN29?x&kW;7*(pN5cA z0RtHb*w3KMf@J@Bj)O}Wc;LSJB*7`b3UdD&O)}gec~W+=d@#%%3LtZEg+uGTb;mSe zq427t!EPA?D+43T#IL=Ox)HqdR|+~edt~*=WlXtA5muq_`&N}e>+3#zy>h0VNkVZ$ zOXHF96U7TnbairCnWa8mI>fuBA<7SY+xiDb2BAxCyPEW7h;nA_Wb!yso~XsBD=EmS zpeWnTv%GGu5vY&#Ve2F=i&^&${+x_-kMUtkU46&!1QmwYHK28Y9~f0Rf6Us$vSLzC zK&5-kLhxCHpyOk|#(D{@S@BebK@D`8YhmH?-QvrHF5G&XSH4|IWIeMy)GqZqYzw^p zIrM)9pSuIywG#+BOI(UUo0S1{;v?i%={>V@v@WQD@;7*!>@>fnn)LN8I7IOK)|8Xs zp~QrrrKuqmH$f#Uv=ns7Fg^0^nUCTHZr-Wd|3x%-lyH`;s{EkRvEfd{>^GWujDLE* zYl8CX@rEs z0qqRMQr0#IHi2%J|IfhAaC5~8RnTe93JjLH&8LGeS0L*1&GOf8e4GN_;OLd4#Gu2< zz;H?#v;spKvR5a0L+|YmY-(DuOYD{vfo@L_YoC5XnSq0$a_5Y5=kL$$MJ|Iu=L>-E zyI%k*Z|{T8O-;ml`;9Po_Hy1V$UMw`=xO(m9v0}_9MJ7u525GgC~c8SG8XXX^yc{D zG~ZhOgoFK3we&;Ze@g01qXF!hx1sF^;gr8SKg zCicS&wCEye(uNCbI6-YePSA?Hb(=sJQ!#+Xdq6X?=Q(~C>e?7f>NR!gh@IF5UQ?t9 zNde49+#a*!-&zrNch$p`)`n$5jhiQ>Xu*z7SQ;$Ehybc znNK}k!zB&c3(u%ZUP z^E}7F5b&Na&^ZdmO8pZV6v=Y|xGqtKxIh7quQy+~ebqt{xh8P~w{$?O8E3q)&}^0X ztQjz4_Y+VTnFqX20$-m+47z3y)Mv4ul(gzfqRI=8EM?G&<%I&!Q**$5mpT>bt-!L- z^-3oes7w$Mh1^9_A2KVV>D=!maaGW{=P$bY&rWz!$dXe9l5S}5TiU4_u<-M~8*?uz zN7%_Syy%i)&|_s_@c(3SDCtew%5zuUJ2>WW&Ha8qbkzw_|JIr+Zds{(<7hUIPct169S}V9~!k3vMWjjEXL3Jbfj| z*$~DB=1M{iPF7-)eiOjAOt1wWaR!H=2)O5DoMHWoah6gX@1_I%7eqb^z(s!?TGkQX ztaGW=SCC&2lwX7xHogU2+SRP_Xy@VgAl70f(8zN}SH-&v{0%#}7T<2H z3;_jN!tu|iQ{5M(Vb|i;D6ypaTNsg;r$JArOBDAhS& znPsICD^pfhnt@&5Ij^VnVG^*`wcp-daZlSNHcRYvz8duJuH-}T7#OIv&QWx0`4b_~ z?QDOVD%k55OxP9|yIx49Me$J%b#)%`M#<-4Rk<&6b|9s0n;+W7bF4i|X8<(+6gmEl?I@_$>lD z*IdBmnmMS3R&FscVUTBd$lSrhZsm|R@nORSi!=v^;7Cxk= z7vLKJ1(oYWOnw1V>; zESjlT;=*Ykgic`kc#Oc2O-ho!JaDvvy{F`{f^ldPB z1qSF~<*?a*92EEHFvv4>3Rhg%vd~}tiTW9t*)~DaB}GCmSJf3ZDFlrKPnP5W;bL(b?A0j1&=0b6$laRyGQD;C?DyGrC& zFI)*)7Ila*K*8miGJ`0?N-6fo!loBr33OMMCWvSqUgZ#QsfIxabhi78&TP|nsf#MZ z7<>G8{BZ#HKHEA#Yn*Zv84N-D|2G`H|5g!F6-uF^?-KD-4YS7OMdq* zHKFEEY9!CA{p>63K&#bwJeJ4BuK#3grM2e`crLk^w>zjgmJ2wH;$PDPBeoql_*l=*&(Fz_*Sg3Bam zPB{<0Goj50o{Av;umI&8P|v?7aQ(TC=Ka;#kH7q=6_t1~_x-VXBJ)MqlMkGp@*i~L z*hAq82FCCGE)y=>E#+r;c-c@$Ww(Wr3Ap70Dk&0M1Z>$Eq`{{SELtdW>8{C1a0MIgl7PqVFafgf9<-wke16LQP3~fGW{`37D8G}}4R-}BZ@gx{t~FilhbSo3 zfM<50D+A}Kyoj5r^Q$^_um5oi4No3^W{LSL)FmOi*C$);eo)doc^)IDc#mFk#2c4L z@aoV+r1^(wvyzT&*es&8?Q3sQS7U-SXm#j6dk&@7uaR#`6bJR#ybWVTJ5CBMirib@ zqLCnS;=#Q4pc6^{-7zq3W8Gsk_w~F7$2T;DXK{g63V>EiLVdG*mBd+QC5bycebcMv z+ybvujCz;~I)wx3j*RBVzSE*&&pnU@r{pMA24nF2e?0?e9z>`iA!x^OO*_!a+hu`0 ze4sO0Ht3ia$O+ioEWP(wL>{!J?s8Z~Bxv^})I@~`v%E4PMly(j!$O6TW8NF9_k~^k zpetoFMHVXygGMI~BO5LnR|Z;R2sNYTX6c42uZq~-$KWynbRy9Q=G~2-Q4KMJ^eVev zu5w759<{{8d#zsjhd$`&8EoxrsMS;k@K`_{^K(W)o;)_t#pt=pNj_^kRXC zcAFE|X^=wM{J z!3x?N!U>t%v~UIAuRWiEpTTlRk&YMp-von)(=Y$ME61SBVA&UJ6W-_A#AjB}`meC- z`KgT_9{&>xysRuHHqX~St|Z$FIvKlzT)`OG&0m_Eoa|HjW23>ra4-Dj=CV1hLN z2Xj%YBWR8fn~PMCT(luq1Ba79qY2o;22_rTK-QE0%qjcV$|%V5@9~v?2NSqJGdlRf z2)B#m8Fn%&-H^3oZo=Uh@SGr#!n&JgrABarzzboA$Dhw(mAA;sxu=xr$ zPu+IHAqF;2EyAFn}tQDxiB?!E1=XzAY1q5Gi~LlDfCT(+;|l2rM&A z)dFOgxR}~c24r_{;{ZEhec;R|%E-1PbcoI33g@%*n)IaA>l5fi6@)Db992uLL8hrk zp9GzIhLG7K_7<$gw88fuvR`*G1TQWDc~$>(!Y4)K5Z~o+HoE{M)Fy_Z0#MvTD>bpHGAt19*k@<=hG(RGP=;r^Bxtz5yK zpzslTzuMD|0Xa2JoB(#>dbOWO=JHzb{5bx6!eW(^5-*fd{KO$5500IW?w?*FyPe~T z!Q&4PK+)`GdQu%Zoq}Wz`1ybW$S7oT4N^>Vh;&T^YXK!1q;TdC;kpg-RHyK)8st#m z5D8NO1&`4s*U88!okQfCm*o=;PopK>YW7H}mSYOvuQd;DG`2Z_EI;;Q(Mffr6u==O zePv2Q5GZk22%@A7jwuaW(nX$3Sga!XQpooovWr7{azIIg=cSOZ9kRHHh7c%eB$srm z*^4o3yzuh($)?x;=Nve6iNk}bd z-3vlTU=PdjdB}F%StP;P_sSkk)s1&I9;2$-aChNLbyQUwl@4xvj-o2bwdwJ5bXDP} z&{eIU;_M7c#AtYQcG~KG_V85}xmhDE`yDxnLQ~AKY+8QPre$aN~B+I<}3Wb!v0etd=#eF=F6kD0EV@sl>vRELa&B zK>IaT9=qr$e~PV)Y4xE`GaJt`Xo7kpuyv0&A1qUCVPcq|^kB(hM&~UTLUv5#Xb@pk zmt|t@l2JfiBMDWu(e=s&=0xjbA35URY%vi5jYKi=L)J*nQc8G-aX-m6@U9P8&=|4d zO~Ykg2WPn)NVHIoP!XJ+EbJ?2@V)iAq6nl_W(2CWL8IT;Rs-`hp!$TJ0dy`ZY;EJN zqZ?f7*I!Zj;t(;X`(IpSa@A73?tgJBH5pWq)^G1RYS6e-#Xi}IzvZas8P%V=XT+`S zJ`gi${ze4`1%^Ny$Vy>7P#O6i!z0H)6 zwA?<=@cuOWIRn$9-WMDjKzVOv)*SV>0l~(b<2G?O{kU>x-}fF+&-Twv8NBtgIa^C43?}64EWDM1BEuU54i5>ls}8sZvpQUhW7zuPHX;jjn4$N zjS@kpd4qPGoQSGO3%NL@evQe^h2d{?o7))P9C?mNTu z1*MxL#H<6|K;Z+~O(1hIF{9=nXrDM}ePW;uXm)0Kkl$Q3DNtC)Gf0C@_f?sHU{Ztq z;{D;*Kzn`dud@B!yGbu*5vU#ip8>Se6}-E|D1Xj{-*;P6OFNF1bZ)v55vEn9@d|XR zN+J_KY~Nd!OZ&o)s{MuYws0T*k}dH{s8oTQA+btt+2_p?V%8sTgHFkWo^5Em?*a7A zvwO#UOcx!#@MDsq9K*w8DF!Q61_lSv(SgQVd(Irsl%Es&;lo0S8Ecj}C3x_p#M+23 za56wHSbLD`BWnTD+Qcp)3Kvb7d+ZA6xSU@7h*Z!>AL#x_5y&0_TXt|-l&}JY5U7_5 z+L7FS(MF+SucG>nh8xI(CAq&h6D1*D#$_-=Ol~{EPQfzk+8uw>s9ZU&B3p z1;lRf+H&L>Zw1i(A2FHY?lz6!UDtcF^h0((QQbAg(Obf!ru{&KAIKdjbN4s7*iD`+ zZI#Yo+-d{fw59+$MLp(05z9%vzKSL;1;zWVD_KmuEk&0J@j_-an-C#>mHiFiR7I1ZcwCV>x~2@|Vux3htb?oks{h-^e1wCUjp^g7W|$cs=L| zDe#zdk=MSyi>+3?TlN*s+w$4kP5-K+)_-LskR0-<#-RSo>)I^8bD&WWp|lgLk~H8m zmdPc{6hNcv@Q9FOux4dofJBG4SlqM6@Ys+AokiSy@|nR!)~Tz@R(|{OV-o1xg4V=e zraYycRtySA^191%?`8NumE3N=-9YvDOsVh(zkW^acQur2jkOV1y<0=rNI&gPOy8y8?Hd3((~tazx<=qcGRy1RCE7l zh-p#!6g$#_&*H(d9h+WO&Hv;SmN&(C%aC{`V)4 zd2-Yg^b3@Fc^Ec6-pzMMc*~3TQ>7FX7$Teg#mzL^*YII2pJR#5(XC#~XDL}leffTB z%SYCh{AdMv%$&Zz)$GOlsihBvd~*8q-5D^<2n;pcrMU={?0ux;9e!+61*cl@BBYz3 z`(WVtS`oDVfVlu%#_j1{nH&HbJ%{qwT%KXY2HAazmiw@~SeC(tm4N}_ZqQoRyfgBP z`32&(sW5=@+Nmvuwbm^!rL9;leiXT`H8-p4MaISZ+Lw=gc`L9ie~SWSrL-(WZHV{0 zHO>OE{)KBVtz6d8C-!%*(bY-n+hJ$wE8qzgo}lF{d6*%K5h?^+=pK6X1=QwTpZk1? zzudU7yD%iQClBJ4VBN|hZb)hI2@&RzXkpIB@Q}HH6I^%f00lZfg1-VB=vc};4(M$C z$`DYS0Mx=@nD9{WignC`{=|*K6N{DRn~Fk;0vD6VGaxmMB=}Z&Z0e3Y`yq6(Ct2^{ zk!L?9X{td^3c@f=q15YvTgEZN=?N38R137hv!=WZkxlz9{ZTD=%JA6wuO+y}2pJJk zW3Xjq0PQ?hLOn^F4>B8_2fDvSyml$d&Oz|qE&9K_q(NgGiLg_&Pe5;PF?h;zkXa%5 zh=4?rD2G9j5^E3Yj#Je2vzTMPw5;txtJ6uX*+FO3PLtk|{blMi{l;ic(7`U?u|E#b zS-i|XyY9-cF<9EkH6{0hM!h5;v$Cg)n8SIGg!N35=l>rx4Scnz0{DDgh62uM2flt} z&Hwgs!sAo$X3UH^66U^ntayB?>Ejs)t}@iMHaK0&#ZbwdcuF?m(%WYW$gY)w zyEdG+W#y`*Eq^M0OyAU#xKTJ&K?xM9Gm1d=ddwBtaqO&}Tv1G~PN zRs`Kbz;gl=AuXDb6_KD>TJ}RztQlgO9A8a2VEQUWp5Joa8p-2Gd`YNVr{Hv}1h{4W zW1n<~@A44lg++6Ncw01gHYse{2Wn%3Zf-?y`+@cimofirovtc^t<|C^1+9lfS+258 zN2`cHF)9JBhajdbbgGEtVMt`Cx!zdaB=&c25VHcL`~}xOr5uYMYpx5mx+-!Jv;%lq zuf9UfZ6&O>3d%9qvoe6z(LzsF{|34x0kr3RQjL_pguu_0NOcydHJ5l~#|a7Wx$oE% zK08xx(N|Db_g8i5tshK>w(Ej@1YT(gDsju06TLw5Fr@kkoMU=_ zCVyc(bh?Z|h2i1t1^dI7^}f8V=yM;`}5!>i+eYyvR;KdLCP@gC+?-oMTOF9e=;Q1fyJwOr248_eif3i1O`jj|6IwbYXTMe|! z0o$lHWcFY_xE}yg!wp%hW8fsVPXMyF0n{HAvUPmqQe>FN)g#2FGNpG{okUEotD za@a*&MemB!S&u6Q@kXE;>9GEInhzf%Pqtzc!>NA92v#r%~G3 zq_M5JiYM!%YaqC%WTBwK@WTIQM?}bz&S!_`v9`5D)dYr!+SF*UEi+7N&x$O$p_=v4 zm05}5#d@*!=?RKLjn2Mjd!lLrrIgvcU4#8poNd{*{#axj)bvZ4;e~(h+=J^?j+TL^ z)mB@pGH5kHEStA#uWfVSipNTzTGtWR%mRFk6@0G=W(~^=?hp4LxLd-@B*);$%E0h0 z3=}{286dlN=F4=KoPFwU!l4oq)a+1mQtHsgyxsAp;4f7qRDuPr% z=49FLE}sw;A)VXN#@@W!+=ZQ4U5^1-=Jp%A)+>jq=R8_}?f__4=Y0lwu*slX)-w70 zoF86dxGJ~Y(t=lU5^L8YOAFpa1!%7xp+b#Yq;<8e-M)mWoeU6nA>BDQ5p6$5an`mh`8N_4aX9xL06zrP#Rkn8f z8uA*l`VqG?-De=?P7cuiW!QBMuY-cc;>^TABWMZ_b{&^KyoS}3&r8Ueaq)pwNg6`n zS<;l9jq9`eFU!nnV|kdmScoAJW~bE)hLGx-nuE;32(eY0_#Cz#2jBB12{ILQ?}Kh* zHiL|59w>#@yxJ!sQ3M)AO62jlaiovYYtbzerenQ{P1<{MK;yu|6$YkE$9f+|{P3&) zc5}G~v{x1ED9PZ&%D^BHc^_I51u@`qHKY}-40aR9)eh`4N_Nk5ew=2(8u0exu?@{1 zJB#izWvFfOu>j2jJ4xJMbzxWFT^fx|WoRD<%0_fDOL{OdoobljmUdw~7hQHcgBqY3%klid{%k=J< z0RKS-&<#%?n6=$LH*m0>ei!VayXW{yUGT)WXxul@x*6dLgQ*Dxla<8&L2m0=B+dXn zmDZC%NkT{TU11j3=FAr%3JjtQ|L&BqyBN$kx$ZOUa-TN8r{J4DLARSdIQSr`b`Iq~8nt12{m9N7X{i7P9!1aik5s4soYRR*-S4WSx593jKt%*wzZ zAO9iE5Oi*lwT6)*nqFbh%AGugZC9<+469h~fHq(5(P5APt!bJjZNcA>U@$rMxvd|> zE4*{LKx+o3{N$a(?qU$3b>}hU9G=S;R?Y#3#uc}&FBYy-AD=qa_F)rfeCq#leilCP zLEQ&q-+uh)8hB)NZ?j0#gO94pkkwBt4ALOG>Ud6Tyi|jpF!U^GOO}FJ8fe2MgA{}2 z&vzHVhx%uSSJ%`8ihRs^tk9}ZQFC$%AA=@iN}cZ0gIeD595M=i5EDT+uW+^qw1H^Q zXq5^mT#_B^+IJgE%5Ij}`<^W+dT;WpEBBboi#yokdiWR=82;UHv14wkLlq$RXh@v!hWh-kN+gRVe? zj*PWIMzSHTbZj{SbPF;l85nBqiGeKnI_o7+;Jef$<$|&_s04tod_&J2;8STfwoEMo z-4~e54;l~LX7TMLsK9Gv|6s`=4IM9ntXGp_aA9R&m@R*}sOVBsgx{&82p1L5YO;sP z4nm;Ys^B>+vvs;JgA4;F^hTBA;&-4UFSCzsIM96X&4Lpu;FZwOG&hq$8lG;n_MDM^ zeqxhL=z|T)Ne&+vK73VYkYVV=9GTPsWxq6bS2aG+ZD3%NnnhtGCO9iMffrVZFU1!$Y)mq$YOGcK(&8);)sjXG7_dvq~ z#s{xK``J3>nKwyy^j?GvF)}GyFbhxRuQqezX;chQU=U%@WP)|pz!AE++3ET;@SW?W z1rxxROEw~@d7T2yKqa}nAlF0HBuv$0U}fl(S8M_89_dtWF;HRPf%<0cy}*a5isB5N zuoL9ggat-`%dmt zP-Z!3liZdb1|fz_WmlJ+DSVR;-(~dpA**?OkrW%l%d<6BY*YCdUOvsb6QVa;L~!Fo zV=FEJhR%yYE=Sy6E?C;p(HoR+ZOYBi`O3$G_A zfUjzCb@R-7e;|F|yO$0Dpn5MM=>s3=%=Ie=AHHKy`O`NgIq;4C;1=c! zZb&`w095;*2Q~1PCQCB7u`)0OfJ$Qi1CS||J&`=zHWFv}xMbD9VaP3~Aj|L&CJUNW z0q6G%iACUCkT4aLvO(o2Xq_tPT=o#~zTc+k-sXmEt)+_1PKtaerBJ&vIP?)~W{E6) z1i)o1QaWH_2bD23T6@-jX2k1xJWevXUX+>B7SMfBkpZ+~?1(&@ive1dDZ}va|Ch!C zib_sy{rVb_3p8The*6e4F4R~UIt3pq;V+#~%Q+EHZU$Y=C^1cLd0Wi7FO3HnA1Q$A ztTN_}YwsC?COn!B`jpN6Zm|_yR*HaEqaER21753#)RbtQew2p+QYz(wmW@h_GIZLr zJvk04V2{37!6L`7%J!Z_ngXcL`M;m>q*YL#Yh7w;@!VaYL3J(mBd4BOiGu215%5Ym z4mNKwja9H#%~9~3Zb#6{8f^x5RtAO#j0uq|8v+%Y6+rheitz5_mfdu4_Zf-4=b){; zKHQ)Z%usI=gA_w2Y-e1=T3B}36vVjLflU#s&Tf!S#g>H(>;>fjD{wxz%gxX!&th^Ne0atmkd5=_ ztu74S`NiQfJBasRVZly5gO_E+Y@ky0KZ~5h0n@2WpFpyr44O#}RSRA^Gw~}dD2_UA z_(hpPEE#lTu;wT0pgz}^GX&RPpID@`ih&JO%DbF*WM$}d=SVyO@*nsHT2_WmK_`hr zkTu+GAR3fcjzHSmw#OMnK(#qWxy%j{?XZns3hA{Yoe2m!4-j>%7SyVSj@R-rt*hQ+ zc;=QOuJv^2{X=;M4^{?-`3#u7M11`vKG3YG0jRb9^vIWag3xyT#g6Z*A-zgie-hG1 z8~S}m(CNkx!1tw2f>eoVhB``fAgCP*Iy2bTk9C97+-|)r4)QfK}7uKFvuE=8d19xQ}F^a~SF)?IZ z)L?j#?<^jxw{OL>IVlDnetJm@y_F3_47j>Po7aRK(9rnbvXt9NeBJ_eRfZS&ib6BF zEZ2Z9msq43#v{st{V31?!%#G0!dHiB1yCW8BPpw={UaU9sg2U->Fl3-rY z$mnR_w)FVQz@paaOBsY1IMaB%`!APlXw?3a98on#N_8?XXm*sDV-@dRiD`bV5ui3a z_^e`3)C%%U(+LRa4~_;Enm&sqWEnu`$-#Roi=S}mM}uc#x40hmKEmXhSmeO318UDH zw-~rEXfSwz_y2?HZ5K$tdzRUkm*D$$(R&u)kq3nbRiM3}#gi7;YlvI|ukikD*9tDB zAiWvrnU&YyN~A&Oo{;khCxa9N`1W<^J-hvhmX?`@I_jz53fPoweDhQJG~{MLU2w;i+w=U?O;2^yOK z-#{zH`1n|X&ZW0$^J_tOSc7&&{)6s2XYtx~+F|vE6A$!C6j*yEvAtK|VfYtQpT=|i z<-7;S4Rje9{-dnUW@ad7C}$90U|7q*z{tSBaHL4}9N(d-piw{~+>T%2|HX#_HMC_Ok>T@zmX zZp|h|23dv|{S6)NzS?3xd@?7iuHS!mJFnp6==bXDb~)VUf5#xq@Z$XM8P?j)QZ|e7b7N+NZE-GPk!|(+NM&I`aDrYG9T7eFJqC8m`qWm=oT)=hVwtOzEAaJj-p4 z{nS#kXguVhaX}e;GF$o_zicj<=b>3Ejp`k`>%;uc&C8M zPF@D^YTZorSAlxvZ$PI<+B1M|WCGPfwKFeBu*8(dseZEBDg0Gq`W(?6`;J(3rTM;d zu|1`#%%B5yQU8J3nHOg8NhB7jy$aN`Tzpj1?;J=zopqi2+$4yg=*B=*@amrQIebj( ztk(<4azkCh&k_?4TD7wuYU}*q(D@f4F1M8-Y~7LjLiJjpNp=y)jgkzIF-DlWKC7co ze6B2xF=Bw4zb@0+dcDwGnEC#f+u|VR3xQp$zjC+E3n|^wMF|PhbV5L5mXLj~vTvtq zOn9MiXkGXn)$=FaU6DjT{QVrcF8rSFlQrOb1Nfk)w_ByY5%5^2rOeBq#Nflq0Q1jW zBe!Q0G@&tG*xhoUe}@0VmI*V9vs6KOqaLNxVW=`Fz_7j|MK)WOk zRazZd*)6w~VTI=xcJR7G@F~~Jf*i^vt5<=R?0`avgnA6M*9o?sQo;Gik-=>3Z+f0=4Ix2l0k32ug)OL}CP zPL^Ky_*t1j5XuWpm7Vos>aM6$5!~QY0KwuD`K?||+2~#@cffbOivn0&h~cKkTn&jC zs@yLZEcFvf-Q-ZH018jg816J_3ucC;2_5?v3%5*HRfViaY|Il0ZZIs)Ve+{yV$pOW zJg4t$vc=OQ&u%<<@I-6*HSjL;$&!7b{ zt57{V(XPc*R)z6O;zE)Of)dQB75!*(e-bwhE&mCE%ljZ6HpWgF1V@&d24C=tUI(NIhE2uH@zi-&lH2GXioyq+<{kBfmU=)liqPS z?VI&1@sK-$GweO)YA`Gi@wusgVS2!8E`4n^sC!XE&yR0*@@EM@%Z-+1mKHlttt?dn zm6*`bYp_d0cP}LL-3Sp{pw`-qbLZ!-aNlVs z1PXhGlpnoZ?sq>O__`w4Cs7Q1cQ91!Rj#x9+$65epc%eGCrG_2${^^li=iRN;K==p zoI(`_HydyBSUduyXHcH{DG-Tv+9h=NPo5TQ$@GoO!IQ+`oQ*njC&%E&$^bgIhe4hJ zwkzdYcAUwt{h*Quw2E=!u^A6jT;()xIsOj^*@h59J||fPJl8k3FE3ri+Blo*;#&r{ z$pLFMo$A-KF!oH?%q}d=+WJA653K5LN@jR9<4omq*C9E1BFEJ9IeCWz!=d}2KxbS) zR`#l*t;#KE&to?@+~arZk_$OIk^g*z=2TdrExP zU%9&Qw&cQAG*t$?YGy)4R+`6G%=u_mkK)P`E+3EjJTDji>9n| z!g+=>=mg;zZ*HtOF?klpQspn-Pf5*AzU(?teJN;#um|WKXoznEZDw?_7GF$AQf6cT z?dhD+<c zc4i49hO?LUEO{(YWe7U6+N#95L2+w}9D_eA14EPo$n}s_%>{=|^iPS$wHq9(yySOt zip}1hxd)E(>;d;)RKU0KIGFo!O1jc2An9VAS3YTG5ZXOAmIsBK2EbnhXJ~ zp!1)=d639<7dHdAZLnq80Zt)M`>>vYA0jft|Dnf&Su3;N+Jo0n^MFPP7MQa7UCEp$ z2;N;R$sp)pwd_FWF5aXNCVpsPSLD+u{8b*jrV7-CC{tB-OyT3VKeB4lM1>-?JvyM% zpTW(`;tCGFwVDMi6RRO}k%A0~sN!>Z!2J*j@ZFqppwnkg@}=yk5i>r%ESYQ0ivOKw zH@=*~EI0xz!%h=!t zIzNv*yJ6E7?6($llaiprH0g?Ztw#1E^ZK6!JAmB|iD6J{AJlgNm6WJAHb7(AFPm$Q zf+NA0hLy!`4F9=a{0G&5*v4omZvo3O1hO(PP^%qGn|3}wXcY>$SHSY2e9MjppplgM z48pJ#`hA)O(<0hSd>a|+B*5hiwEdgQQKia}uJ&20p;DD2;47#c1>M+awakIRUMNZR zhq%nd-K=N2FM5Ha{?o!kr-TP3&=@mhHPuDm zmWwN4zUqp!?eXJ=*y+w72=P?`-K$YpO zJzNQKk;zp{*MZu+XC5kwYk*f#EV*sS%JgHRfcC-t4=O|s^1e-01b7$KHG%V z(>7glu{{+U+EcdI;^;|`(9<28UW4=qFg(1i(`TD-cVnbX^?_acZ#zRmlbt~hbYsJA zi*F5UqfU8&I;}d5?7w6t?Pl${1+s((yDKL`$~${)-TViCxSUOuLE+)C|< zO7V-qW~wp-gV%pyuWu+XU#L~Ga6xJqg$Gp=z_(6duW=wZX28mPc2FmNQ+G0d#LmvM z8##q7Pk+>u;fyg3UHf+mXx7evW5>HaUQeR8SbS@kx|!*EbIS~Hi^;(E*^MnAZI;>v zwVkEiV#nn+6eShs$hmHQawUo#e1;+POzWjeESda0gx47#_R)G&sP6HtFV zK?yvbaDHd>0da;9RtAO{2?~Xop!wDX#)17sCp)(p*g#kc2$f(p(j^N!rqAiDn&R!( z{qXxK$nXWE)CZXcRWLp{a77K$=U|J~c+|)cI{D~_YE_OoTI!#*x|HNN0!%BNO<`1?Gd~+UjHRFm$uXZG_1h?tLAZZfb>QUD(^@62O0fxv;7T+35+tsR; z>S;O3O;-e&59-5Bliu+=H{*Gz()~rC92f&Sg%jNC{$i<8&MmPOl<;OUh=5DCCt{Ya zds4(f>CeDQYmbf;=oFdYBi?0&Zy2>-Gjz;RiUX(bNQI5+;2C+{qOJ-^Y11Gf8n+ER z@?6Cr0~f3ah)I2zs>sjqP@bj1Sy2C`5<@8H{L&>r2t6D-*O>TcnQc)h zy21P)0P6bZR$_)xGSvtCev62M{hCrNypuy|vpT2%oZ1YUq&H-cg!kUhCq29I2HYzK zdwAze@S3X+nMTLckoC>Z1n1xnhVu_iJYX7p^_Kq*q_Cb7_iD<4uL_E4pz||9dY8q@ zR3A9idAltx=`J`n=B#7@tvvzBJqtAP_FG$eKms(D^GC~V_kHldo-WAIrwUU;Dk25J z=e957eG4x{DxrQ}23kc2T7L!_0dfG3RtJLp1wLa*q6jql1t~!=%W7!J!N;_Y{E`D) z>Jl~nDa#PX%D_OKQBYZMo|I2ouBkk==jR%531IooUr^r?RGEQ#HTN0td!t2KxaCBSEI1jE**FbLW zea`^uzrps~l&(7PRrMMql2=aHqW*FfXk~0X1E}Y6Xwo;8*w3$OA6RYmyfwMxY>!<8 zC^Lcf0)kf7OcoJy;WIa%*sWkx4N0UaGNAP9=sow1*_I%g&JR`2el`WRuS6z;-7!;^ z;oqGr?4Tj#pJKXwwh2$a1gY=ll~p;CQTT?@8g$I4c7~12lC)`c>f3sg9`( zcO1Jr`V((}N+}+28%W{7E`_2U%smD-L1J^ju2MscaN$bPpwte+LXZ|n-!!Y6xi1tP zSF%*bs6oc@5&M8)J>9|6@_@`J(5^1Vmm{#JbI^{Yst3D1Yfa1tM*-+&Row9dxhd&8 zq?HK1DG4;Ab>aDhJGu#1^t2fwSQ!}lY!gyJJyz_y06=jE!ie}&EwJ?nfYxe*r&WVJ zv_R)tecQHhZg^)6q$SrnT~&x7@r!eT3Ak#wt_d#DRlw^oK(&-neA3o-2~dVyUdsjE z=~1J_q4YW$5`y6SFOfr#xUiFir2Tc7&fH4vx1C+0Pr$1`ETgiZG6yssOZ)jPRfb4b z1_nLL!7$4OU9)fC6n5Ha8+ga0D5OT1;r|d)`uktmvas1j6+F76h_wIlo4`if7h*G7 za|DI9^X@&e3tSlPgrsOuhQc7}m7s9{tQuC`0m?CDx0ZwC>KP=F$B5GMrLACP^H~)J zP>TlC6L`a*>;rCZnG1v00UJCEws>RK5V-Z5aGvz7%Bd%|gNkcy^*m`Sj}A@Hm?TIS zr2kNO`-1lxNdH23cJgLhaQ6W`MgiJC_AK1+)?c$N@O<2-z4*{+B>_;Kad8VG!9wN` zz&RIE!s70AfO4raB&D5u@9`v$aq(G!FQ>p)2cBKc@N8;ngprWTvkwzM=?ju?PaW|kT8J9q8}jl6Jz?$r|kwVokE zHV^l2S_PV~%_wr3Jd}aoW4kT@AZwv(hQt`?mBwUby;jB^zdujoG;rJF7`8ov{N)0 zKqEj`GLdvFpKjIZR;qHy(WwX2yEkHx1+66g(-d)Y!U5)}S1M9hCvvcJcFjz_3?8}> z0{4ts3|bh#Ju2wnFY?$7c&A?n=mduf2FB~G6Av3qTn{R0!qmW{J8cY*+5^1%P5`n3 z=9uxrzAN8r-(YSc%!bR*(Xfm5$zX7d0~Oy*FXwF>SXKrG+N_Ep zK8B$u-WCZTzju5 z%cvZ1VTEMXGA{-^W!w!=8HYM|4yr}v>Atp!x@kp}A&!-S;kF}Utr4LVL;bV@IA( z%kBv>gG)c;lTLJtW>mRc7qRfx;VeF3@b%V_ZwsPxU&%6ct^=(wiD%$v5Og@SaiZ}q z(1eL9=$23ghD3owj!Zh>wOogm7dRPkU3;)xd2dko4-qC&fk^?NvnQHPyuJWhVJIWl z2PqGbTN>>Vp+-V3=US$#%7R)NeJA^@Be_2-u6e1zxqy!`nRVj&UpthuyJjguMm9k^ z=pVnwp^EE8GIR(13GlipX;6!%MyrusZYhIAeD`A6gf$AEOj&yNb_;(8t)0sU&BXDX zsL|S^176SU64%Zrq1_Q9!tk(J0KFlm2wL^V37-*C2c2PXx!5#MYdWaS6TNlHRJB)u z>sBRgd3{vV4z`g*F9u+aaS7b;4o&RR_w5sq8WAxD%ka?#)Ittiai)c1Z zXkp@Icqr@=*B%G%Q54ufLehhq;i2%xKr5G=DgW~LLAz*g>-ZIdN5dl9`6Q~v!xaS? z9$sdIcBx)p07XVLSlt3{=ur2jKHgu|s!AdZ4~_SBE$W#522>whORN$-ut!Ky2sC4Q zQRL$!@DQ3+hVupOiTn%?jguoDFoG+NYmAQ^K>N3t5rgB$7YHys{G4avEvOF}Je~DO$pXNjA3?6EY3OPa!zP=@?}t^(Nf~u_;`<(%UWa5 zio2Aa`Bm)>MZ7|mK6}l!USkB+72*tn4&e5%^P6SiuejzP;ykDk(Hz*r#{gOrpR(Z2 zf#1{pI?W4IgCAI|7y5aDOP?EbZU%vr&&`miWaic0(JSQfW+!M))heL{Jm8-y+YH(h zm^d4jP+m)zKzyPFDpOfNH@Ks%5Ce&;GbFNt?tk96&Q;g{++q=i$JvDTC=z`mLui+~a3>;nlgv!RdwL z;q4bLs6J6-U}t!-K2%WvUKuI^%S^`xq$>-Y@5>G^3OpX}&$(5H1D#x33!pnjSP zI8F5RdL8sRs^t)HLuR(Y#LZW3$jsJ*X;K8IfcYq^zCmFP!_tse2q?5ScZaLZIB{LT zKy1$@zV0Kh?NmW)uu($%nQtfP9BQPqDfo~>{OltIVnSO09NJCcR*=wk+-xDj@Zyzd zr!qqlD+2?!3PaeVXD3dVfa37%BanS0#Q|hppRs|{G(HLLxK8l8f8yf>)E|Py3;6DF zEp>)}cTy6%AMzQ9?FpI;imA^HH;-l?`QjBTo1jy%RLyX2PG%uL=4n~k^wX-$CEP~He=VBX@Qxj_Gy*KF`~sw61iaxq-Ip&_ee=B2Pv zorj^aK@ieWEalPS1QIKj820;fiq`4gM%!)Sdo+uA!1xd!r&(A@_>ZSq= ziCbo$a21$o3m$=3lNBu0dSSXuzeSx_3(3-@PJa%LLP<}=IdQ`{qwZuh@S(c z7eft(7wLAh=h`o6Ti3k(K}|F;mb{&P_87f5v?dVd9S z(tS;&Z_-rv-p`>v1xy+YDWLPeZ7;-xH7cqLf=-g1YULZ;0oo`Zut02Q2WY+PBKmt8GS2+m$shz;+1H>y?Lx*E=>olTM_m?)DuVnb0O{wmu=4etxXV;l_e~EX z8fe2X;i0*fOzG-yPximc;PDP_hMn;`8(lmnu5q3X+PkrzL6BkM`EQ#ROQ`KqDBSoY zc<&lD5pW651scKSWD2p+p98i<8LaN{k{E{G8J1?%Q%f$`Zwk?0?HL~M-~nj->v{Tm zW(5XLhLu@&c-}BMt28q(GOWj08be$NuK)bt2D~R_e1({KPx|+&Kt2GSl?ZBEgVqj! zPJ&nmYBY)+o)21&VGC+?B^xlLg3o`2WrxS7W*mK?0Gc0HsksIo`)b&+(;nI~D{7q% zKFNCi0p?o1lXsciz%8z2kW~UDkU2(McSx%PeC8`?C3gdZ=sE6m&}by?*(Fg}jrhS; z{BFjPMf=0AHT0T+dL)ohYV`4GZs2 z5XWkB$1_TjjxaejheWYd_xTKQ)9G1#ozIzEA;E)9O{-CQVbtkGfdIl)Dyin|_ z;0@IWm64D$m-RbsI8EHVpLjl4&i^S}f1-Nh;lrSjk^2nX3>(dPAM!OwhFLCP z+XSJzUB7+Me+segFnp2xcYI`#0O6sQD-pNg`%^NO2?evtGH?&hpe zn4G}t;E>Z{8o69=qWVFpD<&;!3i}jI0(34%xNG3a&b=q)FOAO~cc(Py4Z8_t{>@VNF zdOvJZV0b9cyvg&4=Z2P3lf0M8gqt0i1v*x?gk5){`avNrZ#K|*v@8?9K856-FQC(G zp{4~y7OkA}_*7fO<`0|r891fC2)HW1w6%dpqK~<{Fz_-wyw7IqB6tG2o)Th?3nUk| zxqx#aWakJs__W%WeY{m2O0wWMMWiAnhICd22F%rhptJ;S^PF1@PD_e2Zg>=`gW?S{ z70EL|T7a_PRFWPtuaZ#u;0M(p4xo5k&i`qvjq)<^oSpS_S-X@=RzF?N6q|g!la;GOfwS_J`&-A-1?5U= z4F6*OTQ&u5*yrupB)T=Hl{qS4N26H4=@(0w`j(X!{8M?&zJ_J%94U}GU&ztV>kgc? zwu&f|$}j;R^UMV5$FVV3a+!M^UjW(*3d+OJu7l2`Rs@}oue%&{j&z8Rndpm(P8&`h zD>TP++Hjg(ZM>(+Kn=IBGbE-xWP5p|7#y<_OrRLzVz}w?#Ph)i0hwkc^jrkmZv;MT zzDeS#1o*^B#bvLJu6~9blI?1JWcBnDlNB@=GEmNcyau`@0hHDYDmeI}l>C|6+aJ9D z20ESPVX{NrLpIQrx;hMe44hkB=CN3Svg|cORc6q+&dxFHZw16X-n=qYWPseG2TuMh z?yBPMMKP7iR&t9ZYTIWdl=PjOqzF1cYIfpz+Y<{jznA+6%FcF~$Kt(0XJ^PMRtbhq zko};%_F@4z)2Z4o-|$?nnURm7bFu6rtBm#?4oPjc->twW-Pp1-@Pg)Uo(Tx|oVysg z>BA-lVTR7z8ta-h7bSyoJm*x^>0UcQXQQE+%k*%PA_G4|=jCFZeu z*65T6<1XPC4 z$8s(Ny?Q2ucioPT6Qi$R6@aY3YYN<;$IGn`iNPyQ*K<^y-=`_ux(a>{K z2~WGQWysF`tA8;-Zb>mV5Z<(ev&VB1=ckKmYbLtv1J`>pkapvG&tDGC8Q`V8>bDN9 z+0h1Gs;D3bs*?;nkiaTSPv?l;u%yJ1RcPuGL4VS)0%rr<*nzg zw2s>FmsjMbZBc(YYv#dv5ZYy|^o zjJpn!n+;3vjZA|m2N?p*{Gi?t6Ti&g zf65GEn-9+gkCaG(>;&C~0*zf}eK&4S!{aL?yhJxQ+?Wt_7PPiR6x6DpCQ$rD!xJPb z#XZI3n$Dgz3=*K(4+e$9$}7ru9C+QrbGtcjW6O-kmJMRyIJ>ZAA?w7$uUXWO+yU)@ zd9x*-5i)Cns!xS!8~fcPPQ&BH47xbG4uKk$sP4!2Q>7B zp>FKyS{P!;-LZCc+QZbHpu2Hr>%7gn3_g&Gi;Ll5vgq}LT6z<1e1^D$o8ciuUhQrk zAGAfE#lXjqn8tIv_y?z#>$(f*gFL*YJGMIMOJxsOBD_(nGhVjDGydECV-nEC@9mS#B z0#ao`cekWSF+5cNz~Ip49`L@P@wz8V4*#yBLP>p3R5uiHOJkQiK83+84|2}jF;@rB zo;!pI3w>K5XXICGmJq8jm?0}N6O;!-%-(^^v59+F!typMFg#>`Amjs|0b)i!>`p-u zrs67eMhJGbh!yNSJlO3vpuSb&ksTc1d<#!!u=L{oNho5cD&&MaSQ>=M9Z&XRP~HwQ z2QlIe7^+7%ru7KHbVHs#^iwyE% zt-_!a73~?OCnQZ)ii56uj3KBCw6+lvK2i*MtPBiJXFmS%YM6iL5@dZ-p5DPDYOZ@q zAnRovdbsqp<-sQqF-Xce?mf)fW+n=`wc^3qq=*Lx6UqWoKxcLTyA#6l0DQX%JSLVx zN|YziH2efq0@OL3dG|p$sjqp3iTrfiHdhzW`KpP~9U>LMnRWjDJoP-?9Zy<>liq>W zP?g=<4!YNf=foc^x9{5p;>tkts>u#s)5=UEDk6nJrCQpN>@%t}Zpg%60F7Be?;$$o zdW1m;d`}U=H=Ft#6%k?~kSg)DgbBo*M?m+q87KePYXq*K)*S9hR1-#-T}(U%I*gA8 z>YoRwIsc6+xBlm2mKWGLcTh7yv~T6A$olSXwAMPgEVsKaV9Xb zVy5}IMmvWO3@6fSL1+CXGJrNdfosv%NPB+jx2J!H{u%8<{>z~KC5V(awE$1*RNS@;_c{BW@al_tx=Is16w)qJrG zXx{s~mi>`1hAS$+QmdvuFxU&9o>fzVmneMVGm@{jK-v%!7eARW`-WV}YUWAvu8Sxm zsrhkhgY643P)SpuYq{f;FQ^RIe1Ly}Cg{#H(AIG9ZcDf-t`={-mZxgl*zZ1yT*7Ut z${>qmR>fSXSx%Sdvc}Gy#OienbfW>NtejzZh6iz$D4&4307xH7DG9pA!h;{wKIS?4 zVh3o|SjmwMAEHWPZ<_w9PStbkHZO2j)Xy(nEEv-|T~&eM;b-Bbvi6>;%QKSLei

!dn)G;pp6I74*2>W&Hbni~)zmYkg3ADcP^MlsMw>sAd zLr+zkrW5clY0K`S7)jAMGtfDl$qumd4m~Xc&N@)}lJTld=`=TOf9pjXryfFz5 z7y1)l7G_O}d6;U)H@zUua5Ae`zyS??P+xd5t5<=Km`1(ft=EO1x^Vsh=Kez$nd}`N zMLu9(q1%=!^2UL~L;;fGB^e4>85mkXB}THtE>-R+`z7A4lLw?|RJny&F~eul8PJi*y7vxfs=FVOFE>h>Zr8s3>Y1m98Dts$-8o{M906Lr zaS}A5D|Yx2=rrg<*%!AQI&B9EiT`TcQyxf|NH9G7&mvbL(kJ$VQRqCAy+f{{&f)}i zrv-|Fpg#A5u-@W?#lKcepLS-xE9l@cN?z+e7_BcX7Bt>6ef?a032<4~e<%TTRDH6s%i-pOccm9K zHx}!OGCTyGk7?6gl32@YJGJ~`TSkS!j7A1=gm{z2%sp-MPVLTcE-@&01o8#=Myd&7 zQVgBR4xe-`wQ62F$5^#h&P25E7) zK=#xzK=vdf(*Nwxpc$&>i5Ks2DT3+~wOhB3W_)COr}5KkqzK(U;^l{Q5}1x1VgtMsr`v+T%f!P zx|QAdkOX*lhQfn?6FC}ctw1*=zPRl*S6voVCjDuW5Uq_~`MB?(S>M|Qa*O{wbh#h) z%EFsh3zYMj_(3MT)!Z$}kf?iSiP@!#n_xW&BhdbJhKUay*d3n03Qhx1D+{T-l_=o? z?{WXEt#mjM)Y=gSt?z}Lojp5Yhi7h!%VV{zjo}aMPFx3#F+I$__284-pWLN<_RoC^ z8-FXvJ3_+M_Bg0a;_*G z1*t2^B@=(mICb!ci!E3VbXUM#iM05~pbMJ1LR%wNHUtLzQwP@_Ez%4{tPBjR-+b-a zu)Z*&lTo=ORs1H$Vb>|Xe;H&zcFqFr+pOq**q^>7F0(L*1G?A#6R5t1 zte28wV4rUFpe9N|479g3=42_8H6o6hbwvFPIC68{Mf6N@fpE@a>YjV=CZlGrRUmjT@0@@8^9 z<=Ve>Np%xT*OYEQX@UFTwR52R<&Q95*8IqJj#)|K&JqvUfsEdub4HGU&ejAuMW&(Q zhEmDHRBlOz&d2%Z85tiu2x6b(e|*PI#w&YVnz>8_IY6hGakdB?+n#ktnfcxlfr|?c%3;7uy&M%m%_x4eT))b~+dVUHFG7QD63=A9$oN{{#Vyq|jLQ2mNP(37E zVIbNmr~9jVX_^V2*RI_gY>Xb975(!ntx$m*)F!$y&zW!fuWeI6^N7aDH%@81RC_u> zc}tMf#G;Fm;2slr|AdR?0_npSnXmt}wyKz~1nTQJK!(sYML}*o(Yy8JyhmaO&R66y z{^^;nXac%h@u57kk)#rM;nbwk2Mt&63O6X4EDQ#(=|1w9XQE=+W$n_FRs{!Mz4P>Y zQS>4ty@SV4YmW{GL+52fp&c=)Wsp(X9pG~Fm@A0p{BzfE1?UvsoWeIN8APFD)JFRi zj_J5e;Sli=`V zIjF1vo5(WzL;(lSv%LT74oNhE?wtai4h(HC+a70-Lv9C@SBMw(r#U zwI>I(q7GE@eeXXKuyNuJe?@RVl|vP|r+q;U)QE$2b{n;r!oP>3-we(ygb#Zb!1!0_X3@EksdhmV=QJMOdoGf%K{iJ6uh z>O6+8!JQ>$PKydB-#VaOApayAGLK>F4yx7Qafq#s6=z5UpWy&L#$Xd)gG8FGvXEyk zivsAhS)`h_K;g#`?w1TIX*VUmf_5*-GW@e|WEUv-`^B;D(3y>#ZL_bqd6?t{NmoEd zLWNNKQxDa)2D&SN(lEHjLOyAL>kj+RQfL}L$xmkrL4B=t8y{=NF0oryWMCIKA8&p# zATD;0+byuPYYbX~0jjM&SG%c9y5-S6U!Yh;Us3_QW9Y&bMp;3Fsq9J%laveRD}mGL z34Vr$pR3(kM5o_QwvFxTTo&_0Hw@`7K<}OjQ4;>dXQ42up~nn z=>De{hC&$%SXF^i=GjhR+1Lg)A%;Y&319Y1(qOXu(=y|+q3X({Hcn7W?soAE!!s73 z))r{3K4?4&OFs)KR64+WH$bhq6IN9{EMM(FwC2J-#uF~&I!g(A|FH-> z&T}?!<3vc@Bc%oKj*34`J67H}QR>C2V!K|Y>p*NIh#?qf1{&*w<@`cvq&$X{^OFs_ z-V?}O$RjVX+yy>o48uQx1=C{Y6oJ|=r4E-q&r(8G1@CFcZJySUHWf6qb-Ho>lGV!; zu#RoTefDzr`~)&;^??1t6zpSLa*M4Q7iWVk{HSxOb=D+M{_E3UEBn(>XOCE{z;3tt z^;cT_EV(KxS4;OkXaI$l$9L$RATy4>uuXOdV6U6BZfnMikOvH)5u%jS4GZ}GsKjPZ zxuXFZ#zCAf@4Q?IJT91WVA1~YXWHKDKS?uGg4X{pJ}O;No9X-_qzyc7lXBqg0sl*; z;){<;@31b4k=zU__+EQU!}hemN@69X_&_W33?+_!SEyicP{UUu3t=hqu=n)AITzGA zeXCh5%#gT6q?If$j3r#(>?RC*(Bp&_w1kGn_C z2WqdXxo$X7u%f4rOJ7=$;o;)YCzCEYu0Elf2SXxgbq;v^ ze1Wnc!|y2!ilBT7>h=FsKGb!3qM^bHW_!=;yA;*WK+^@wOh_s?-LOE4p$atr15Pb- z6uAE|n4VCIT>)AblgQ(7466PjXm5%bXih4ishKxs;Urcs5!v3^(ca1*X4`{XD;{v! z9O*8I^k2X4;@ zqO@0(D^Ierg4#*YabfzkS8$YC1q|=CPpIH+6VSHB0?NJO4Ara*3^+!#EgHUu3fM3x z2;9ry5Spz1h-s3B@d!s z47!^VJQC>znTN39Y8Giq;I2>jwjf$Z@!5&Mq7%M5l%GbZfNN!JZk=oJz~R!w(j_w8 zE#LzPF59W1^h|7Cq&!T$XQ5$P>DFXeunaW5jk8yIxlfn}6eiGgO=!LY?jP_dn><4e zD+5CtXnYYo{?#tCaB3Ks)eX9HvbjNfr(c5Sf$fVu zcD|^Ej%a{JuS?t~7G11f`R&IKA?pj~Xxy^OOUWrqc5w3z3Fz2Alpo4~y#$gP~V&>JTq_c?P2gUWJ+ z91X@Do)cj=a4JDYUfXh@_BKg?+U&dx4?*`e7fo#qToUtT9=Ie7`3Ac0btBXD@}Uktc70eQNN<<*Nx`VdwgutKUd~G}X4xAQ4C+N^-+BNu2;_V0=0N#uxwZMhVz@t>)5);~TfwxIOJvCp> zVhvFHipL{O>F`3QH8~vmyFp{k$qrtZ*rl8{gC-m;6~Omq%7I4T7~~jgSsB0wF-yxE zDSFR3FhgaghNpZ6$63%s>Qg1icwh>2rW-*wrh{(d z@mM)w`u1HHIrK`rtYb?c(}kcO|NH~Y@msdDaC+@uZQz#R1qo5aU3uX3F5opbVhjOF z;U682Y_v=OtvPyjaId2H-3(_1&{}HHc|k}kZ3>v?fR@@QbLeY}fJ!m&f;!Ne8sP`v zsT5K0ek3ewY7i^GA#1+n80x_1zd}}+LU#}3IWzKI5L()>?}c{mHBdT8Rlv3G8}r^U zm3xrUu&K z3{{aZ7kb@mD<8x3gszH}exS7;VUY6#4}sQyfmWA+mZCiS(PR$Jgf|@p1(L-UD}zg$ z0tUT43@n3KzXIyM$bw2|m^gIR$8pFyeoh8I=4JdXReS>O z43KqPPo4?+Fk%J7hI~){Zh!rSBjLZy$ zkCi~D1c3BOKzC`c0{IvcnhQT&wFcFY3Ji%*Kf=7fkof@QY+LZ!y)ZRJxC(eESTV#j zb^0QL6THq`0vw*w;J5;rzRYhW=#JyXLKWH!4Xg|d8x}IKzv$j~i4E-}dlAsiyG*w| z$6}gP3uehgh-ppKUdo*fN~R|jz^hJWP*M>*`u!kEKtAOG zyJe%HG3aPL@CltF3>%9PDdn1>a$LWDg@Pzl^pyx`5I$Ab_|exNP2fFW`=LAfAnSw+ zgQOwu1O@+F(1`({Jz(_=GN8K|K<*6KnRUA3`eSc7({q!{5@*!$I>#>J1C^{|ARE-o z;44o{&vaaW%q^!N4i~oqA14=iyr;r;ALzDIP+15mM?rRDU!xB_wF$JNaE-Uz^6+s^QiW02Z0Zjbhb)_Je&kL7`%2~_{ zIq4Sf*#pp%ZqF@_Fc1e_#i9V-^UBTeB0sJ>YTg|8jR`Cu5u}~(pgrsBTn^k^*=$pz zA8b5*|E$~JJrp<~X9|d9Zjxkp@yf?wV<4YOF^jPD(&wj}rmviNI{xh2Y88-4IQO(m zgV$vn8#qlkO`XiLrQ1agoT6d(F|?gI`2j)HHQ5vo$q@#9c46EfTz1okTzcojBmH{m7bg`itvBp%yjF3<6r7kA9>K{6Zo zo-0*QET8P_?YhLgkxO98HPAT&T~Os7YfBZ>pL<%b?gFib#(mxZD8GR)^p4PTi#41I zCk5~*f%dPfGc>U>Fz~>`Jh0`F9_slHYS7aL)-o))cKXVhr|X}6vvt~#rB%{-D(Owc zN{7-*9arw`b60}Lf{{4Gi&ITXrW0~5v3uw~)_jzj_3Tr4@oza!P#oad@eba5;z~>i zgYFQ7hp^uT=EOpdu56$6S5y~D=qNA*!gpyx1B%AsDh=9GYW?}tCUB1CWBAD+6!hzzK>G`m zG%FTcD8Hh^xkRd&&(R)K{>U*{$~3uJ9T5-KYYAalBJ-wXf#k*6mPgL(=EY6Xbz%m! z1o#*>CMZlS@+nhzHRWM>hZyJ_axV!Fo~%R049%qf!zLt^)y@0k=O+u;3DD9#KtY9?H9LF45N7QNm_{gR-2t(zGN3RXVu zvxW5DJh&JhLPZ=ExfmWkesl@E<{C14iE=6*q(ldm=8%>#_|_3ftbS*?ypaPm$`-gt zzs=adNvvE)6m&x5&I11irXvMbVu}+@tyLHpnT=$*RjZg5RZn^hzHZ}PU#pNU<3-z( zg-?55aBOH&*t8GS+W#VhZWlCX=56X+)bhdIP8C$cVB2L0J)LRYuKCk8xCw#cBp$SL z7qq+HKWCAK;-884w|Yk?uLO;TTIM!;8^&ht^Y)HV?%V=O1?aYd;!l&I1={|Hx?!Df zvX7Z$kr@*KHyAjHHSkzUn}SP6Vep69UNibL6^9d)mo^)!P(+f5go8LhG17YaN3g;FZNG#gBMG;gAE#!ljc!>rs z)tSnmGEa%&#rYaD>w1rQTh`d!ja$gXJIi$n!+A|+lRyx=HT29QT~3A})U7<^A7;{p-4gpNEjmwN)T`BI=(&VB|>a7fF7 zWH^L#bmz$F3=dICvH+ ziZg6fHfXVC;NW@auqZ1_W(o`YA@{xqAyXJYvG^`XqEYdZWkbV_OBbUnB0(#{8bCsK z7&Tf2C6umCO5|loWMFA4U}tDll<{~2I*Y5&39{Qn66C&ziWY3qy~)R<+=>O{O-eWq zo?gK8Rha>FhtDCkGM)gT(0c*}zq#~3AA9*R|1+QHime~)_k8##30)f|WVTUS)GXTaM0?ZgKA>x3OiI5E-sw6r916meT8B`<1abvK&QzI zFgz3%oPXdTBX=H1(Z7F?QHDc;@@1fz0B9#(zPp%8s>PH0-`u-m%8d zPJmw^&Wr&xDhJ)w8}gSy0%RxL?G3@kE{C1xSvc|;DvL2Z1dV^3_+em`X84P5;?bQ+$HG|~aBsoUZl!yesmL=KOsd<+lgPX}d$JC4$e9zF~J zt)Z`?{VUDZkHA{sQRzc7TULjk@DWE(P z#t2$a2HGDCu`Q=9qvD68Ea?1;&i^f|eaZ@5Cdf|#nX4ec(D^^Z*~Es0J-4H+ok8WB z0`x9;LtchX`P_~^^Iq!%Km6+XKzoTn_iC83F+BXwp~z#Z#PINcl;6%vdVL(9nlB0P z@?Wf0eQ^@mz0);7ZTBOSEwi*#MKr~2{l2qsifD?@{T9?2)5)L;TGRM>(wbrikK|qI z9U#VuRnt!eHeL35>R==(c6hP(yx^=kkd=$YEQ=FrulLx!EZM$AlrO{aAzPG#t|CJ_ zD+5D1c-HTTaDjBJ(212(*&e@T%AQ)nDy#4M5j@SV2wvaj09m)UQktO?v`RW@mzF@$ zpBMV$$;|Qr{Cq*1Vr}QGM>aY1T29^;9l`m1+;F|g(+{bH8N!)Kf6^Bs_XSH^YKbL|Z$|k8+?i z0b1GF#>>#TnD^qxWrge#_g|g|?RDyGR@k%;R0^Q1YiDJ6$e~!(#{eExwrz*DkN6o9 z!KLf2n+j0U;9{L!oQPMX0Y%Yb?pwIk9k z)Pf8z{68$?RbWnfI!VRpt=yqqstkIdo2zfcw7-vYtNwJbvvT^uF3F67kSWs-s>aP~ zdKKrZvSq5taq&fS4=6MlafGX?F}&bky)5h8+|UVY6wSIk=EQcmzi3kAv2lv<^nA>9 zWub$^(qGLfTQwM7@Yf~pcyja5{{jvJfqq4`tF4v+*I%V>IXOvO`CB%Z+TqOUN7mMy zROVoK;a?rZq)-FuBRTRw&RX$1?r|Z3Lj}~Ef}aM~H*vv10S-_LAyFCDs;K(2Z_}y! zQBU)^O}YC1Z8Bn6qLIflM^iL1(G%SB#o3mCji?${l?H=a&4^w3h%r{k2!cMzZ3|h3 zPF4m6!YvFwhB_&Yi{gj-iUXJ$SLcDpfIv6Bf6(A*%h1mSk5LOT_%So47`q&w-FB*3 zyzlhR$X%+84E_wD-iDd8iOnB@*Xqk6TZn_8Ky_J zeXtL?yZp9x$btz6t+^NyL2HuFDfWEu2d8E5tvO=It;cQIu}nVi1w5+am_hvud4|fJ zdt|yLco=_uZp)~sn2~7!THE)2<`Dx<0kMz;b)fM{P|X9H+d9DcG~!4ChwpKVhN(L& zKN+oXXih5xtC-U~$@&SCa-&$mTJHwIkF!pRc~r$2-4%Y*u;jUEDrmjEuXM~JkUfHW zEz7mfUSA-6`+-jEQA-U)(8;9*s)2p3JZ&7}hb~WjmVKc&w_uuHL&tHb3SNdpo)b?N zOi?roITTfKlR=RIv|}L1C!BRrZ52bxU%vOT8(m*mz1Maz>~7#PG1~Fmnt>P6GK9LA z7t*r<&8TGGdH~Ytbl|hQ!HfClelHSjVs|*y1kr}Bix+0otoM&(rU*dFk2XDqE>;GH zAn+(5>@dGE{~_KWEk*NQP20NoHVhA|27IZ|* z%9cAO%gjnlV|b*-g}CWS?edqH?$;(teNauzkZEw+tTAJb=z96FUoA4J{5dt zA!zpetwh@W9b)rla!Ig0tzQ8?gBH5drz$zZDztdgg6h;?67PPCfcA-icf+pCuw@gA zGXtFin;cO!XBlYai9BczS=pQf1@Nq*hbU+t0z@uHx(hA|P1{vqTfj463M25j~Or)CN8j&?|D2Bk>I7y~FJ z!mt>mHUX!|40fjrGgKt+s+?p2o#VGq7}{F}r^btXEei}iH)(;=X`%#Dn&gsTHF&jS zvf%D7mU{{niA#@K3_alfKcY@S)H0-|O7s*c3k@kq`HqqTJ9*xNZVD}YY{m9O&GXsn z@{o#~sOhas^2a($wjQf@DM$2bi;Ghp)>kA-?@=a@-fGE9Z~P32YW-yjEWMtSmNGj` zS_A5@=R?jVz?pJjsb-afkJw@cH(Ai$$6YS0l017h@ZM8|q!l@M2tZRxR!Duv28HIv zRoV$tOe)mD^;#4t1>j2=AbBoG>hL=q?22i&aDz+?3vlBVM(WuI!vhVRyjctb*c`Gx) zeGhd8(8(NM7*&?^maxVeXbW8_Vx2JI{h<)1C?lxz{Qg?0g75h*nH+N9;upSi^Hcsd zOkFVTI5(TiKe=<6m7Kenlo=zQgKzyy2@(2WTFDupD!K4e-wr3wh8Nw5vuq_;U+L3= z$A(8n%Aga@Yy>J7@XZvRzBKNr!BtS*!pX4Hz5Z!L%iWFY;B(I*u?VWI_&_0e^5Xkx z%Wp}he};q~E5pS6^M;_i&_TJaa;KE})YCPm72QB}Wj*MA;JWi2ES}p700)II$dQgKrlystn7vJ!hW%b)ZVV#c%ua_UdrYUq)a3Ers3wov&$Jt5X zn>Vq>%vY@$`HY~H&CPJrLy_Yj^A2Zw1|2Z}bpX;sLKmOEDLa z1|8BO!I1b15{I7;U0EW);@(}7$h*lyJWD|g)Jn`#FmrQv^;YEQ6MN}YF3??~C9=!pb<9ccI{}sj@r|peSiWCiJO0m1f8}@`>wfU+Sl^xQ@jun?*Cw)eFCiv0;%9W z5BA$91{MZ2hJIEChC(L^A&{y33>&uw9hU{IFlFX!fSla4pMeXUH@@6Gc>k>;7lUE* z{s)Q{FLrNM1dS<+G6dRu(8zgsek#j>#{I{pzc>^>M}-5lyA3T5xdeg7itUkRZISYb zkbud3@QHSyv!HJTG%%a2`*x`H{g-r5X&2AH4L$o2ky|ixg&=6hvl1w!oZ&mQ{?2?Z zeQgFw@NR*~bl(Keh64HD4AWR@U>}C@-whoOAh;P>H5zM8-7*8StKR2FW`9 zFQ?vxyaY9AX1(LA5GseXfM1=(KBbp9)TN45mupasi4gljGYWXxlH+(>od@Z z+o8~1Te_8lpO&vDq>I?%a>JT0DQ zvsElian@*%6Gqv4!`+y@gmOI1U%qoo@N~%RSa}z864reNLGZkT_*9nV(erV2{Af($#8^(@jJZ&e7Gqq5*g%p`V@ z-u;j};ciyws<&Et7Oc9hBs5*+#-zMUcY9qx<@9_8b?GGIT!kKAw&V)zF-b1g1J z=*{ZwXBe)&o};n?R68NUM}%P_D+2?zQ2M4oRwxNT{H=g9l&-XIy~cmM#}s^yKAvz) zzbvs?MnMOsIX+i^Je;v{O_JU|%}%rXDhF3iV^+XzCQn52+WxGGzmh!58o+bvSZ(Hs zc-)?RY*U@V)XB0644OFY<_Sn%o20j|bfxJ6h{X)xnty*aH~kaM-c@*zXlvyLQe1%?g3^%#u9Z^0&~N-Gf03j}G}h$ym)f=$iEESe*cOU#XO;!Q7nQk+rvPFwO9_46c*1;Jc%iU&3*~=JD z3q5mGT)D-zjZ;Q}0aqL^XFF_qP3zgCn>$xGE-7bVz?Hs0>gp`gbXL#kPJh0RZBm}Y zb`@&{+@^MCtqDDIw4EWkE`pDNK^Ld*yR-fjoQViC6qjepNo6a!%nJ%q23+ZOdE0cb zxtj|(_cG_;j7_%eY>@58f9tX{;0`6W>};6b@AbJ~EGuVVP-Wm_m<($Fz3;=4c9$PJ z2o5V}j?%fCn7J7AaQW)kK~rd0@he{0D0jivJVIqJ?%cSXEgS5s<9eaq>{oE7lx%od z?GB05pDl8|hyiCRJ+5Y(7rlB$H$UU{HA^)3G;rlzkhi^B| zHHSbYy1pBSH%J|>k{_fFRu;)`Fy&Lg8K2XCS!@Eul(+=v0jmWXIKmU83K~=WHVG;W zuW_d4#ghygLAmLduX2KC83TCDh%&=J_7!o@RUEC-9&ddSy1sZ)gWTMtN0V5lw9UA6 z_r(rneZTjR+f74$_sXg>OkrhUsJa@rqAX4P?`@6-@ClQU)-q<@Ed=R>=9R7FROj?F z#ko!ZdJ7dp%8$gvdrsRr8g!HHIc*Dp&S-;HP=MABYz2=m5~|y9)nQWLx_`b)mZAQ{ zUe`8f1{X8wl3Zs7m;OfZTsEwZJEoh*0&4?6)_KVWOiJMNV(9uLqE+gsq~RAUp^?!L zydCTsHin%WmpD7ygKA>%%~ar-=Bq{BU&1RQ8I%|jA-&y_St`)(>`I60Hx`D!ZGESD zaOGO73)YI94FB#-`Ow5TasDLGIu;(teup)n6P94(wRuw4cdU##t(kl##qViB%st&h zsUP@Q86Kjv^4J&>b-k_HK7(3V65!MH!FQ0Wl`THx)?=UfI!M@0XbSH%mWnf=mM&$sU~IE8Ox zx|{muD`-?xh2h`-^_k7y2Hh1)ogALT7EPb5E&6idKL!zj^+9Y$P3{WwXf&y^G5q^4 z=p^CA2OjelI-?YqxzGFEDnZDc89M{yPHb@oeg;2g^L5D%?_QPq39*3AL}Fz~d?eeP z1XA(m?#6WJXn#}Wk=L2a=DnX3TrumhLCLw@ZLuP)T&xU<3mu=He1uFA`<{l@# z;Pm1+_+rI}O$>4jptDOrzFjFGP&xh1(@xNSOd1C1^1@JEU5I0puiH4e=Cxl;A zNQsMe+Da{I=v11hF2nHezsZ9iyO|x@rq^5wQ@YIC_BM!Mci|72+vAiq7ZQj%ntdab6J7 zyYZnYLn5RfXyyBG&bPf&qnF%HQem)$&hmlo^e$| zcuI}e!Mzg{)0M$}V<-8j~7E#^8ahC!a;#VHrNr3vgpPW&0-oM9ZdJGOkVC@W6A zx^NBOmLyeu1~G;gT7F6VCex>K&7Zl~=P7HH!|}^gCKV_!yg238Hm6s{gTr<~tV)Dp zj^QTV^Pxy6MNqaAD-D8pgqt7lNv4w1n-t!m>8d_44ng7w<~@&NaIS- zc%(d7XFQAAV{c|Jp@a=8H_G>V3niF5elUqeBISLODXa$eyUVZP$K{RJuq@7YWOr4k;pT~n&y+nrVR!0z4L0v4-Ir>2?`}$W0ht3z8AYBDp*HZ2JY~==zJ}84S??Zb zFw;_*l70j%&8z3RLG|vE-O`zB19vGgNFu3vroy;XaoG`7P7Pket-D1bInM}WI_T!f z85#FHY!9}ALPe1ANif$t3+d#KeXSd3^cF@q%CN2GV+F06i)R3-W!Rvw=Y01USHHC; z=B#f*A_VSb^s(fbN*(XnTFaK@{Pb8yD0rndNS$EmsSnE<=5k3EnH^eD`1xo1s^2_U z+D3J7cNDx}*0?=OhVy=@sYTZQ7}Fa6^^6M)$>6(11=TIg?ZZ zE{8%kn)Pn1IPS!*ur9}AWtx-_=p4y?mnQaYeie|mm$k&k_ocK9!^6d~lN4mPcndAr zf4etJ#&`l(i~WU_n!8FY~^BjxHxs!%wXKer0hFXr3=)-4O6 z{@%^&+3e&Xyf%!%rdsmKl`{^lj%atB!w3lq71WG85k~u!m-55?ARk&?qoyh#|?)r?+`t-&0Yqi zvT5&4uu`z1o}+t?F}5x*ynkoTDITQIbi52+nZ>$2YtBhIhKmc9rLkGfdj?8F2)n=r zlr*J)g4CBsfk6(c9~NU^XFDE&MVo>MlI;t?5y7eQ%|RBb3ndO6Pb(R!b6&dt7PM{( zG-`^dy?MYn1eE`G^f@Z3fJza@1jmZ}kQrAcCi^m4XEwA}a^FD!cxB@w z@ObT!hDj_B3<}?=9=vB`a&QtuNadqD-c5TWpQd#&=rH`d1Cl?W;6JC@bAvf=k+2Tu z0WAn8d?)8LmImi}7T+f&&JJMiod_*BBR`wYe2M@V#Yy15^{FI%mk%#bNl zU(U0y^}nn3$$JU{3pc$AVEd;qPgCcpSoYkkgjG8~@PT#`<};{)#>@4@7-q9FFnBV| z@)l}oxFL|e33MgthH^v4ikbb%)+=r#gj`SU@K6?&1*Lt%xt}E2r>i8$mE2S1RLF{% zvNHOr5qo;VqCN&;NL)!S>pK|sIG~@=YTmLhv9OdW!2`|V;37v0+zM|4jT7dBPDBBp z>wI68lMU3`&%O~p>%G9@L#LlUd9h$kzR^71i|gz`eJ5rwp*LrrO=598p0K*mt|_Lx zKyN+YiwddlydC?Mc%kNR@fK2vcfC}RJU<5JPvuXEO|q(@E?~IV1F~3ir@PlIiEp>fwM|)+2_xCo(vZ) z@^|Ds+z}nNC?dn$ps{bcW~~B4=Vw3HJgYsy6TR6bmn((u5ShxNaHg|ZpYvPVjJ+XB z+~N$K%o59$%w@qg><5RV!PoNYBG6fgE%FR=SQ!`uY}pwk8948)JmK43u2u9>;c>_l zuIaa4_#E4;m^4R+fu8~5KIViuU3b2eTZsG}4KHjQyx{5^D`xPII)fQ`QF*m4rfoN*B$|%lEIMRSg|-Z^_IwnPZ=>&JP+-fb>1O&#WEGp{a(!q zo9xyf(_~EGS+U3A^eXq=Gj>4of*sg?MB4z=N(SW*#6BBYMEg7&G^BE&MCXy$VMQB* zg-QmJZs4{uBQInv$p24KGqz9AH3h8?If!U0D>J-!l~(m4!0eslT&9DooFfgp84?`j z80NAvFhEMfhZ=Y7Ha?2~1)8^iaVjBxfvU^dH&dN1rLW@=*W4EII)pj+Y-{v=c36xu2 zbY@?*2+4_#Ew1s{86fDgWMY;mw9E(BDGFJ0j%Y9Nc*rmplB3%|W3ZsrMN6!g{*3Dh z(+BmeEj%ymjnnGZP8M7Iei94wV$fD{O@@DWSQ-wb%;;GMs@f#FE@lM_H9VWdk_fKt zLFI|bx||Nvof5L(bto*pU%X;pMzriO(%J*^t<#k=D&HK0ML`YYw1?^piVQ0YrSBbZ zIhqu(QPQq{aYtxVh@h&&lw+DYD~>bB`Un3~1D(&rCH6p7}GfuNIKwlQ1H zJGRoZFXG%m$r&1J7!(*DDu2_P#%J)d%((qnru>{h7D;cGi>sSEOq8~+30zR4A#hhWE}Y>Rj4IlD*|_JK}P6@E6s(sM%J-Hba+{BNvE`_Fhd>*0>sD$>xp z&`6ehszLi1&!!GhhWViTAI~TjPf`Fisue-|NM?iON_=KGKT~o1wc8dFrnbjH>t`K2 znKrPh9bVCFEvA*oH*+$JVEUCEp7$ZX`^=!tkjTWZHp@K7e}cDAgRX((F&1yIh8YP^ z4_hDG$yZ|2`}^6m5C&QBdWa`Z$vR#spuXU<-el{iE}PC<=?gDPbJz@O9aQNp3$_FG zU(Yn319eh*rJ30exqCv}7$KnZlBF3QLTa^Ao^8h@mj}IlJ2SNXkbqp!;;P(!1`$v= z*%q#q5}zsceSu%ZsdU$aIfp=HEo4+x3Ut$N>q0sEm2MR?uUl9hXyD-Xd3M(7>H%we zd2nk{;jp(|ruM{_Z3!ml*a{Rkf%*yyKivj&chMr3en+vzSIv(ta!GT0uCi(4iGmkR zpfi5m9a#4G$TAq%Nr79h;QpNyyXx}T!x?;!Hv5?xc-q8#f}Y0*8DkGn{giy?4ntO) z-D?fTEWJJJ9UOem=FH7{pa2@R{&Uw*dVMPY4n3tq-d7Bl9#Q4owq$lmx$*`TlCXSmcrN7*=gFsKev90Nkc>nFHzv zL2K<}NoL0qSqmlBSczDG+n6W7HR@7CJGFKCPm7Ied4=COcCeTlujXr=C$0ob?fWjz zx9mx_J`thR5hv@iM9}b=mJEXzLs#bQ)#3~*kCi&E`SJK;K*y|^q3xSm|36H1eXxj~ zL5yMLF;9iRKVCOQd_1l!FwyNu(A;I3Zx(>gw*ps%FD2gW@VviSBU8p`+VqJIzdnXn zHcr#)5dFVOK?HOT=!39c<%cfP-Hp)Z#B@o}C@vp^WZWmu=uRJVmc@lEHqU&;k97T4 z2Cdj$d{eizX$rG~!OXHbnKE;ErVH#jbEt6pp(NIy)%>ztIt=Oz50jA!S(dKJEO%co z-L%6cJ#`br}{eY7dkhpD==`zff^&Kb72!M0XKs* zEPMraFAXrL&@9(s5{0%uCl)O7-MT&f{X*x+j#&?l7(^H}85V->e?-%Np+tuX(mE3X z-F=XKS)yC$W#8QlaL;_dRfC63%p_1x3$!Mzi$R#7@NrW#BnTakvLzoleT7j5v@+0S z_tJm~MGP!zm-~!+rN4c9V_TxZ9ccV}4L>Li@pzPb!Rx2ONeim?hKPl`xo!qkWb9}2 zG)0y)xLj2SIeJV*e`(EcJT~K;PF%N9$mG%>3g=W zRdU*`60T;l`T@WHcNUP^^IV`c7&1ue7~0$(3$9lQ-^T87+4kT&hFMA=75LmQ2pL~J zS0nS+!{@-GjvF2dpqAl6d4?CScz!7}EMjF~XkfnP$upTD@#F3%u`9Wgj@~bw_-jVY zwbK^!bQx3`USwq&bO}6ikQe;gv~gwhlQ*d$8lN0EYuXvqSXiBohWN7WUZKpO#PH(O z1ICUd;f3s?+B$X9_q6EbZ7gCH(cGk}_+s8<#)aS189{53bs1iq3d`(sDQW0dnmcj5 ziF?tH4Er3o{*~WfVBCSoxv({xMrRg> zz_S2*@QFDoaXs%EjtXv^=xpOq5y{1nD6_#r$;`|B>UK_s#9tj9H#B6MuR&5{7bwMn z)={e^6uRU*f$YN+W>9QokCB;gcfw!(a8Xj4VUDW{s3oY+z|Ej&-1bz(;*7*JVPOVF z27LxmhJ}^AljkwM6M#%ymVr14>L8VDOZFV|JkQYkVH2n?!fCT$sh>!zGQ(of{$D9| zTV^4K9<7Nh6gU_jp3VNQXz{IukKrLF=wP7ue6P8nBjH&X6q907;G)};BUW5?U}j-Z zbmDLZ+0DtI_{-6>Epke700S$7;=gwiQy8Qf6m7#FFDsfEFR*y=G0uBi=1O%()dYqd z)p7bM54s0UV!|hoKO>wVDXS!{yJj?u6()-TM1OyyRwyyZhJmD2X#X zv~OhJa;0;TLG0rt=?;^wzjHQO<+2FW{_T{Q@ab0VkM%uV`l}@w9{%UFX=r%eoA@&1 ztY_1|1wyVum2d5i)N(QKF?1ep0PP!{b^V=lL4yS=LnntK&sxwpg*(T^Vg){ihsPVH zTz_|%-%#t{yBo?Z3=caBCklY?Bx71<-nKNjbdkp-f6$&r4n-bD(0KzA6MnLScZ$k_ z%4s7umcJ6)Ei|_&k;e$2Uy%Tl#Wo+QQqx z-s%jX^+ZR^Uc8@L%DS#SL1fMAv}SO>_L%Dn&`Lsq0$Y~F2}@wGimE#$PX+|Fq0Z z{+t})=NH9u+B1?TT5uu{XoWwI2ROe-JxooO2G14;`EV$PoH9zjaf;dVy!Wz>V86v& zcjoFsc3qtihN~%=DtWlfO>{@KxgrB-oTKE(hN*A6#rO)v-C_i)TnCEtx5qv|S z5Q8F{N>0*o2Gzjcxj%)j>^gK>Nr2&@d~8-pLSQj5V9Rt7~5rPtOB zkn`_Tn8e(VxbbbAuCqsnmw}OaleD0q^v@u-*6C9jI2aTsYZa6i@ccrADd;=?WpnNRoBq0S&GtA(e#lxV;_9U3~-MJRfv>80@8|)I|Vt7~xs@gSVn}t{z z9y$s{-e-X12NniK#TG?I27U%E21e#f%-1h-h{c&nFgyfZxb=>MTa#fKX#c0%M?;+t z2?h7x7r39==%Ikn#m~@qfVmb_TwUnx=;&opVBmv=rRCzqpc73%W`o1mcEvFR?IYlo z2wV&gXMwi_D#pHKVPG`W+r-82&;nGYP3dz~gqRNQfhmFNJ4ovVG_Ebl5TNv3v&xS_kRiZn#TjIA zBL-!L0IruHwO*JQ$Fxw^tsSvi0%HH##hL0{A#FOW z?IhH;5F-OAT278N^I>Uad6uS*B#KLoCE{8t@?cS zBevzoH5bo3&I#UqBMKdRyA|>F<44xjbA+BvI4-^h)ZVFw&R);0W7sLcvf@5y9wVMX z0IHs0`U21)c-Dbx;4_KR=kOg+Z94cm#Zaeg5f1}D>{jL3-W{#pET>Dr>)fOnEI&Vh zw3I^cMZDc;QIci6F}Y#VievYS6u|Xs$TMhx7ZSP3RxBB;OMzjd$fr-slC>b$s!8|G z2A|D-*2GL{o=%U_(?!Ohb|EK&pu;rj3fsjWHi1sp{c~5*=Z#xyuS9)N%9rn68^QvY zfbM4!f{r=+gHEF@DbKlZUt18IGr+r@L1&#zlism-!u0s~o_m+mUrovW^8Hjzs+{X7 z*X5#dX3`8udpx`NynNZbMa6#f9x>p&^#D8)Cg5@nd0mPE{4~6qNw=Q$G9A*AXIR0? zz;J#Cu)$Ro@H>T7`3w$$--^94*&*rUTB z1{xuO`RtNH8)uGT4(pyEX3*WSpq{^f>ah)?AH2$E80tKj+5wuEzA~kmS?mu;)uy^_ z%@++zv;KoPM!eut9j90tOIK+=N!rqrsQqASCPR{@v{x1zH^V=Bwv?TX@vjzq*aW#v z=t7a#zP#fb0+u(jfqQ!=_&|G?K%)1iSgpM5zzi;B88mwN9A??It!)U;Qh?OM8las+ zpf*7jXp;tb->G_63FzF&5H_&FWiRJFI1X~OZ!ze;szlgc(V3i}xB{PEyawDWhVH)3 zlL}Vr4s7UJThL%up$;m!n<3{mfO^OKAnkf^FH?qLW0%`b=NX{-GbH+=#s+A;Cv=sq zc!fOZw9Z4Y)qUDhtk(+Mz3i4gh;v!z+d5sA8)SD8^ZqN24^uNiW1^4W_nmxZaFI0< ztV%DDud?Q(0{C_v2b=>uSc3b!B&2 zEO{R0_nzHYse$C5H8S9}Wzf?CAiG1QcC{ox_l2@DaDx2<8MT-KX{{mekq7yt!O~~N zjcvQ0Nwjr~7zEQ$F+$?Iz=6Upmki5(6(PVD=1t_ z0#qi{{ZXu7aA126ZefE>;s%W;^)cRD!Ut;e^D;b~ZP2dx=kmkyB{JPw5Lb2ZgGFuj zJ#cIn`zICufdRC(ZMH$X&Ax=Gr5O*`e`H5=de3l{i#LL<5aVP>6nA3E z1C^yV7Z?>7Rldp_QL))!bE`Aibt~EES z>jn56n8L^09QU^=a5Ho!JLH{_U(7EMw~ax7p;I1Y(c@!Z-U=+se{oAe8gyH7ebbAI zuI#CPrmiI*qrdDhthH`=DXq)E%FwBN%(aO@9;z={w{jDoV~NettzOG#DOrJU-CLvT zpQp&c#?Z(nqu8<#L@TryEWz}z9L&F{hom0@-Q1@i1HTaz?C%zXBcL<%Z=VT#W%1mO z6Vw(2EuDjubn*=MOCQWrXjFQ-C|H4;fitHtL%qp-nW5J+21VE%c6L2|k)ZA-6LV7= z)SW%0MzbfJ2Hms?zL(A+i66YW(H1mX$_WbL6%u#t&g?OeVOR}X|9AAox1FC3bYE1I z0HdC2K5F2D$2Zg!<;d9yt+r zBR*&h@z}nZB-gf17i3n5fXnd!7kBWbi3{6fFCEShS{Mx5;qE`K1@{?5z{ibWf*k?SbZlZx&?er0OuRfNrqm;DV?(0G+c2 zj)yir(9MiIC(gI&xq&M+N$@#VJ48T>DaEZO@CTn0uwgKA<1w-T&29g?Gv&v+a9w|^ zgUtDPdXBH3EX_N>zg<3K;mZl&vmE~2xgra?mh!T#BPgVopFO0SF?Y`u-XDn*KqCPl zAN;%-z^U)eAPZVEYjCqr{iGg;sGNhI9K#w`28K1<(-)X`Cu)C4FtFAzQUIOy{vXtU z$8gOKZrM!-tr@_zWjXSBRAz^nPqcFIf_w`Ot*?&KkeMdks0a`bov`cHk*{x0d)!$ZDH*c8qD5XH$Dy6v`RObG> z6Y`Z$K^%HgKMSOe;gChtRSq_R>l`9}$j5Q~5M7X@Edx5X15}cO!$*N(Eh_^97pPtV z-HX+8P62Xq0eUDvPSJP(3WcekG=*XFh~V2ZPeaRpUQi2+f$_Tju98(#{7-_~NXZV* z#E;B4ngMFC_A?8FZ{s+7^aZqK4NgCN4ly?cvc=-U7{nMj|Gc$yaXIngBWpS6hSnFo zpnx=z0^Pt`#C#vp3e~wP*S%Qc?){=Px7O*Zpqrz?=`^(Q!m+IUwePrCB=5BH-Fz@t z2(&`|Zs3xbFBW$pHAs|%96WW-?v!Po;xg4dtXiipsigjN`1=`0UnqdeE0NBQ2^Sx8 zdx2`xB+xY$lae(TA3FU`9K8D6r|gdBCT^!z_6gjtgWi7psLHkgv^EKn#=n{bgK{o< z6yeA#Cm`j32&g5c++qNt6I(#*aFF8y+!JWxWeBtpco4|eXW3!EL;IX3qAJotK#j-10~#AHEncCZbBc{ajv)ZtGd;-8 z@B+NXT8BZ3;f2?u-b8+t7P$+0LTd!JO}fE+HZ}BshQnqHWsuxgEq>z(0#y#XJvKPq z@B*#17MI9FF8U5WM?(xOzkj;cB~2I6O?me;T|~>e z3#}9&D_@LP6oEuG!!8hmmRGj_06~i!T-gWVb*H<4=`ouoT z?~Q^m*kpv7$*gq@EDWL$Q$H-b5|Luz81pLh5z~Y(d-TAobReS}(-S5}uxof;H_!=E z1-S#d+f8u2?KLyyxavQROP+rrg%h85GluA8kD@?@<+}uN+ssC+;cOrI0zQ z_#G_zifK;ShWlD(fYwNXeFk-d?y>0t#>${l0dgXoztO&y8Jug6{t!xgC9QPG0GRm3Qu*=9wyS>xIPY6<${U1)ZG&^3Be}N=uo2 zcHKR*@YqF1&Ol>hfqun#6N~oxSl1hwM{vqrI9eDAJlJx zsC{hxcc$~>H3Anx-aLS~oeSi4X$H%r2&<{qXC%P$Ld-tjS?t@Mx-;k;3pixs)AJ;!~x^U!m=%YvcDz@wIF9)C813IN6!%{W=Jjd^2 zTR)t+;`%CCEBqg5c3PfcBP#;~
.e - * - * This routine was necessary because letting BULLETIN find the "From:"e - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating:* - * - * From: MX%"Hunter Goatley, WKU "* - * - * but MX needsl - * - * From: MX%"" - * - * Inputs:R - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects:P - * - * The message file is rewound so that subsequent GETs start at thes - * beginning of the message. - * - */i -unsigned long intm -scan_for_from_line(struct RAB *filerab, char *final_from)v -{d - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */e - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */n - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */l - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */) - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines._ - In such cases, the remaining lines are indented by 6 spaces.c - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is( - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */u - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */i - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */R - }r - - /* Now have the whole "From:" line in whole_from_line. Sincef - the real address is enclosed in "<>", look for it bya - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */S - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */t - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */e - i = &whole_from_line + 6; /* in string length */h - }m - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */N - }A - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - }t - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -}S - - U -/* - * - * Function: forward_to_postmaster - * - * Functional description:N - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs:n - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the foldere - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects:i - * - * The message file is rewound so that subsequent calls to this routinef - * can be made (in case the message is to be written to several folders).c - * - */; -unsigned long inte -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{= - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len;M - char status_msg_buf[256]; int status_msg_len;f - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = {r - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255;i - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster....");c - subject.dsc$w_length = 255;g - subject.dsc$a_pointer = &subject_buf;r - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */i - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */n - attribute_itmlst[0].buffer_address = &postmaster; /* To: */n - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */d - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist));s - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist));r - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x];i - vms_errchk(mail$send_add_bodypart(&send_context,f - &bodypart_itmlst, &nulllist)); - if (x == 1){n - status_msg.dsc$w_length = 256;f - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status);b - elses - status_msg_buf[status_msg.dsc$w_length] = '\0';r - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf);e - bodypart_itmlst[0].buffer_address = &status_msg_buf;i - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - }f - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */i - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz;( - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - }/ - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist));e - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -}i - - d -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs:T - * - * folder - Address of a string descriptor for the name of the foldern - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS statusB - * - */ -unsigned long int* -log_accounting(void *folder, void *from, int bull_status)u -{t - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf};i - - int status;r - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log....");n - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */n - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */l - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */) - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */y - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */b - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */h - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file");t - traceerr(status);& - SYS$CLOSE (&accfab); /* Close the file */' - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status);R - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - s -/* - * f - * Main routine - * - */ -main(int argc, char *argv[]) -{r - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */Y - }I - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1)u - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file....");I - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){g - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf);s - } - else { - tracemsg("Opening sender address file....");n - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab);l - } /* End of "if (argc == 2)"... */t - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) {r - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%");n - } - else{a - - /* Now add the MX% prefix and the double quotes */s - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */e - - /* Make the string repliable through MX by adding MX%"" to it */i - strcpy(from_line,"MX%\042");s - strcat(from_line,frombuf);E - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */O - }a - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder....");t - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */r - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace)T - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n",l - folder_name); - tracemsg("Adding message to BULLETIN folder....");$ - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user);. - if (!(bull_status & 1)){ - traceerr(bull_status);f - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user,c - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - }d - rms_get(&rcptrab); /* Read next recipient */& - }i - - - /* Close the RMS files */x - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab);n - - tracemsg("BULLETIN message processed");a - exit(SS$_NORMAL); /* Always return success */ - -}y -$eod e -$copy/log sys$input MX_BULL.TXT -$decks - MX_BULLg - An MX SITE transport_ - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution:e - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN?p ------------------r -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a messagee -need be sent to a site.t - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the* -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands:d - - SEND ALL Sends all bulletin files.i - SEND filename Sends the specified file.t - BUGS Sends a list of the latest bug fixes.L - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM.C - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. Thec -build procedure for MX_BULL expects the logical BULL_SOURCE to point to the_ -BULLETIN library. You must define this logical (or edit the .COM file), -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct):l - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>"n - -3. If you don't have a SITE transport already defined, simply copyf - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL= - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN./ - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail toR -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETINr -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL_ - MAIL> SENDh - To: MX%"GENERAL@BULLETIN" - Subj: This is a test....o - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path.a - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN"""b - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded tot -BULLETIN via MX_BULL.r - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST ...." - -(Alternatively, you could create a dummy account named MX-LIST (or whateverh -the list name is) that exists only long enough to send the request via MAIL.)/ - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder.s - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwardinga -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the messagec -to the Local agent, which discovers that the mail is forwarded to. -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, whiche -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. Ther -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file:/ - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logicaln -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the* -callable VMS Mail interface) to GOATHUNTER.g - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address/ -for BULLETIN messages will look something like the following:t - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM:b - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayedl -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet; - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1.r -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"?t -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it upn -$ close tmp !...L -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:"D -$ endifM -$ exit 1 !Always return successo -$eod - diff --git a/decus/vax92b/bulletin/news.com b/decus/vax92b/bulletin/news.com deleted file mode 100644 index 91e8992..0000000 --- a/decus/vax92b/bulletin/news.com +++ /dev/null @@ -1,679 +0,0 @@ -$set nover -$copy/log sys$input NEWS.ALT -$deck - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, itb - is worth the effort to try to get it into a mainstream - hierarchy. - a - 2) See what the alt.net.opinion of the new group is. Wait a1 - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3.b - n - (these first two steps are often ignored, which usually- - leads to unpleasantness in step 4 below) - f - 3) Post a "newgroup" control message. If you don't knowo - how to do this, check with your news administrator. If youn - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE thatw - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group.r - It may take a couple of days for the control message too - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post thee - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into thei - newsgroups file. - u - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators,o - and reduce the overall acceptance (and distribution) of thed - "alt" hierarchy. This is the reason that steps 1 and 2) - above are important. - o - o -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - i -Don't take this all too seriously, though. The "alt" net is the lastn -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstreamh -newsgroup guidelines.e - t -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - F -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - c --- o - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES4 - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Walesh -$eod g -$copy/log sys$input NEWS.CREATE -$deck -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29c -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATIONa - a -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to aa -successful result should be honored, and any request which fails tou -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. Thee -reason these are called guidelines and not absolute rules is that it isl -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or nota -to create a newsgroup on a given machine rests with the administrator of thatr -machine. These guidelines are intended merely as an aid in making thoses -decisions. - t - j -The Discussion - e -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, andg - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroupsa - to announce-newgroups@uunet.uu.net. - a - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note thate - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handlep - that for you. - s -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should beo - determined during the discussion period. If there is no general agreement onw - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead ofe - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made,g - going back to step 1) above. p - s -3) Group advocates seeking help in choosing a name to suit the proposedl - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group isu - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups andr - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to castn - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitlyp - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, ore - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article hown - to cast a vote. If two addresses are used for a vote, the replye - address must process and accept both yes and no votes OR reject - them both.t - t -2) The voting period should last for at least 21 days and no more than 31l - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - r -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific newa - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - n -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - o -5) Votes may not be transferred to other, similar proposals. A vote shalls - count only for the EXACT proposal that it is a response to. In particular,r - a vote for or against a newsgroup under one name shall NOT be counted asa - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a differentg - moderator or set of moderators. - t -6) Votes MUST be explicit; they should be of the form "I vote for thek - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and nota - counted as votes. - a -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - o -The Result - , -1) At the completion of the voting period, the vote taker must post theg - vote tally and the E-mail addresses and (if available) names of the voterse - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can bed - verified. - r -2) AFTER the vote result is posted, there will be a 5 day waiting period,c - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - d -3) AFTER the waiting period, and if there were no serious objections that mightt - invalidate the vote, and if 100 more valid YES/create votes are receivedt - than NO/don't create AND at least 2/3 of the total number of valid votese - received are in favor of creation, a newgroup control message may be sent t - out. If the 100 vote margin or 2/3 percentage is not met, the group should e - not be created. - k -4) The newgroup message will be sent by the news.announce.newgroups moderatore - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address.a - r -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from thep - close of the vote. This limitation does not apply to proposals which never - went to vote. - U -$eod e -$copy/log sys$input NEWS.MODERATORSd -$deck -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net, -comp.binaries.atari.st atari-binaries@hyperion.comt -comp.binaries.ibm.pc cbip@cs.ulowell.eduA -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edue -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edun -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edut -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.come -comp.laser-printers laser-lovers@brillig.umd.eduo -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edus -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edui -comp.research.japan japan@cs.arizona.eduF -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edun -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edul -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nza -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edun -comp.sources.atari.st atari-sources@hyperion.comy -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.cao -comp.sources.sun sun-sources@topaz.rutgers.edue -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.comd -comp.std.unix std-unix@uunet.uu.nete -comp.sys.acorn.announce announce@acorn.co.ukn -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edub -comp.sys.concurrent concurrent@bdcsys.suvl.ca.use -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.eduo -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.comh -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edur -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.comc -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.orgs -news.announce.conferences nac@tekbspa.tss.comd -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edut -news.lists news-lists-request@cs.purdue.edut -news.lists.ps-maps reid@decwrl.dec.comg -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.cat -rec.arts.movies.reviews movies@mtgzy.att.coma -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edut -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edue -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edun -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edud -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.eduh -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.eduO -sci.military military@att.att.come -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.govn -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edui -soc.politics poli-sci@rutgers.eduy -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.comh -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edue -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uka -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/nulln -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.orgr -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.orgi -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.comn -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.nett -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.neth -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.netr -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDUu -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edue -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDUn -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com) -biz.sco.announce scoannmod@xenitec.on.cae -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.orge -ddn.mgt-bulletin nic@nic.ddn.milt -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.deb -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.orgk -de.comp.sources.os9 fkk@stasys.sta.sub.orge -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de( -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jpU -fj.binaries fj-binaries@junet.ad.jpR -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jpo -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edut -gnu.bash.bug bug-bash@prep.ai.mit.edud -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.eduu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edue -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edul -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.eduh -gnu.gdb.bug bug-gdb@prep.ai.mit.edu. -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edui -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.educ -houston.weather weather-monitor@tmc.edug -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org@ -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.educ -info.firearms firearms@cs.cmu.edup -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.educ -info.ietf.hosts ietf-hosts@nnsc.nsf.net. -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.eduy -info.ietf.smtp ietf-smtp@dimacs.rutgers.educ -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edur -info.labmgr labmgr@ukcc.uky.edu@ -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.govc -info.nsfnet.cert nsfnet-cert@merit.eduu -info.nysersnmp nysersnmp@nisc.nyser.netn -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edut -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.netc -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edup -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.milt -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.nets -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.netm -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.netr -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.netu -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fix -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FIo -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.neto -sura.noc.status sura-noc-status@darwin.sura.nett -sura.security sura-security@darwin.sura.neto -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edui -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edus -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.neto -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net. -uunet.tech postman@uunet.uu.net. -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com -$eod d diff --git a/decus/vax92b/bulletin/pmdf.com b/decus/vax92b/bulletin/pmdf.com deleted file mode 100644 index b463c55..0000000 --- a/decus/vax92b/bulletin/pmdf.com +++ /dev/null @@ -1,1031 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized;R - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return');R -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *)N - - PROCEDURE dosubmit;* - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGINi - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGINP - WHILE rp_isgood (qu_rtxt (line)) DO BEGINz - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD;P - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' +V - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - ENDm - ELSE warn_master ('Can''t open queue file ' +C - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *)D - - BEGIN (* bulletin_master *)S - init;N - dosubmit;' - mm_end (true); - qu_end;C - END. (* bulletin_master *) -$eod * -$copy/log sys$input BULLETIN_MASTER.PAS_V32 -$deckd -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound);r - -(*******************************************************************)t -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *)I -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *)p -(* *)r -(*******************************************************************) - - CONST; - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - t - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC'l - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC'( - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC'r - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC'l - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char;N - - VARa -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *)h -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - m - outbound : text;a - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC'c - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC'z - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC's - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC'H - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC'a - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - a - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char;u - var ier : boolean); extern;t - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern;* - m - procedure FINISH_MESSAGE_ADD; extern;e - - PROCEDURE warn_master (message : varying [len1] of char);n - n - BEGIN (* warn_master *)i - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - h - (* initialize outbound, mm_ and qu_ *) - e - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true);i - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL',' - rslbuf := protocol_name.body, - rsllen := protocol_name.length);P - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0;i - IF NOT os_open_file (outbound, fnam, exclusive_read) THENl - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL( - 100; - - VARo - line, errorsto : vstring;x - bigline : bigvstring; result : rp_bufstruct; - header : he_header;m - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string);' - - BEGIN (* try_something *)_ - IF rp_isbad (rp_error) THEN BEGIN' - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *)e - end; (* try_something *) - - BEGIN (* return_bad_messages *)d - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit');, - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt');i - try_something (he_read_header (header, qu_rtxt), 'he_read_header');- - errorsto.length := 0;n - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DOm - IF ltext.length <= ALFA_SIZE THEN BEGIN_ - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i];( - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto),d - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - ENDn - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr);T - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *); - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGINI - initstring (line,o - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return');N - END; (* if *)E - try_something (mm_waend, 'mm_waend');) - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf));_ - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf));u - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6);e - os_catdatetime (line); - catchar (line, chr (chr_lf));1 - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf));n - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf));h - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf));. - catchar (line, chr (chr_lf));L - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend');N - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring;* - retval : rp_replyval;* - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - O - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGINL - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN] - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox,] - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length),A - protocol_name, ' ', ier);* - IF ier THEN BEGINP - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN* - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true;; - ENDt - ELSE BEGIN - warn_master ('Error opening folder ' +I - substr (tombox.body, 1, tombox.length));F - return_bad_messages (tombox); - done := true;O - END; - ENDR - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - ENDr - ELSE warn_master ('Can''t open queue file ' +a - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *)l - p - BEGIN (* bulletin_master *)o - init; - dosubmit;l - mm_end (true); - qu_end;r - END. (* bulletin_master *) -$eod c -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file.I -$ !w -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ !t -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. -g - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properlye -$ !a -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue]i -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE")o -$ !_ -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto oute -$ ! -$ ! Create listing of messages queued on this channel. -$ !t -$ if p3 .eqs. "" then p3 = "1-JAN-1970"c -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp"o -$ define/process outbound 'dirlst_file'l -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ !n -$ ! Determine whether or not connection should really be madee -$ !) -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel: -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channelh -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channelN -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ !a -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read.d -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then -u -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then -' - goto list_loop -$ ! Found at least one to try., -$ cnt = cnt + 1i -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TTc -$ !l -$ ! Define other logical names -$ !n -$ define/user script pmdf_root:[table.'channel_name']'name'_script.l -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. -t - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ !d -$ run pmdf_root:[exe]masterc -$ exit_stat = $status_ -$ !h -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then -) - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT1 -$ deassign TT: -$ deassign PMDF_DEVICE -$ !e -$ ! If master does not exit normally, then try a different connection.- -$ !- -$ if exit_stat .ne. 1 then goto list_loopn -$ eof_list:f -$ close pmdf_datal -$ !c -$ ! If we found at least one connection type for this channel, then skipe -$ ! the attempt to use the conventional mechanism.e -$ !e -$ if cnt .gt. 0 then goto out_phonenet -$ !h -$ regular_master:r -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT( -$ !n -$ ! Define logical names -$ !i -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]mastere -$ exit_stat = $statusI -$ !d -$ ! Activate optional cleanup script to reset terminal/modeme -$ !r -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TTo -$ deassign TTa -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1i -$ !( -$ ! Directory channelh -$ !m -$ dir_channel: -$ !s -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ !T -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ !( -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1r -$ !e -$ ! This is a BITNET channel; use BN_MASTERs -$ ! -$ BITNET_channel:m -$ !e -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ !' -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gatewayi -$ goto out1) -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel:w -$ !a -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ !N -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_masterE -$ goto out1i -$ !t -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ !e -$ CTCP_channel: -$ !t -$ run pmdf_root:[exe]ctcp_master -$ goto out1R -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTERq -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ !f -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ !o -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ !j -$ MTCP_channel: -$ !e -$ run pmdf_root:[exe]mtcp_master -$ goto out1o -$ !s -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ !A -$ ETCP_channel:f -$ !t -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ !f -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ !' -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1p -$ !l -$ CN_channel:e -$ !c -$ ! Define other logical names -$ !e -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277q -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_mastera -$ goto out1 -$ !g -$ KER_channel: -$ !n -$ ! kermit protocol is slave only. If we get here there has been a mistake.o -$ ! however we will just exit and no harm done. -$ goto out1" -$ !D -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ !o -$ PX25_channel:c -$ != -$ ! Define other logical names -$ !- -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ !c -$ run pmdf_root:[exe]PX25_master -$ goto out1n -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTERN -$ !a -$ UUCP_channel:a -$ !4 -$ ! Define other logical names -$ !t -$ uucp_to_host = channel_name - "uucp_"n -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmpc -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfilen -$ !. -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll". -$ uupoll 'uucp_to_host'_ -$ goto out1f -$ !t -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ !f -$ XSMTP_channel: -$ !m -$ run pmdf_root:[exe]xsmtp_mastera -$ goto out1e -$ !t -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ !a -$ DSMTP_channel: -$ !q -$ run pmdf_root:[exe]dsmtp_master -$ goto out1t -$ !c -$ ! Handle delivery on the local channel, MAIL_ channels, anda -$ ! the DECnet compatibility channel -$ !t -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel:g -$ open/read queue_file 'dirlst_file' -$ local_loop:q -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list)) -$ goto local_loopn -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1n -$ !t -$ ! This is a SMTP test channel, use TEST_SMTP_MASTERo -$ !i -$ TEST_channel:s -$ !e -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1l -$ ! -$ out1: -$ delete 'dirlst_file';* -$ !t -$ ! Common exit point - clean up things first -$ !f -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_datan -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT. -$ deassign TTt -$ deassign PMDF_DEVICE -$ restore: -$ !_ -$ ! Restore saved stufft -$ !a -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ !s -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel] -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87e -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988e -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminatel -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988l -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988_ -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DATe -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT tot -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters:a -$ !c -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed./ -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTERT -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod : -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You mustl -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, butn -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are ' -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETINe -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I usei -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it ase -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable.r - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT) - -For V3.2:h - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check yourt -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. l - -You then need a channel definition like the following in your configurations -file PMDF.CNF: - - bull_local single loggingo - BULLETIN-DAEMONi - -And a rewrite rule of the form:M - - BULLETIN $U%BULLETIN@BULLETIN-DAEMONr - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following:e - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletinn - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletino - jnet-l: jnet-l@bulletint - policy-l: policy-l@bulletin - future-l: future-l@bulletine - mon-l: mon-l@bulletin - ug-l: ug-l@bulletinc - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vax92b/bulletin/setuser.mar b/decus/vax92b/bulletin/setuser.mar deleted file mode 100644 index 2a552fc..0000000 --- a/decus/vax92b/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vlt95b/bulletin/aaareadme.txt b/decus/vlt95b/bulletin/aaareadme.txt deleted file mode 100644 index fb97c8c..0000000 --- a/decus/vlt95b/bulletin/aaareadme.txt +++ /dev/null @@ -1,201 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vlt95b/bulletin/allmacs.mar b/decus/vlt95b/bulletin/allmacs.mar deleted file mode 100644 index b7498eb..0000000 --- a/decus/vlt95b/bulletin/allmacs.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vlt95b/bulletin/allmacs_axp.mar b/decus/vlt95b/bulletin/allmacs_axp.mar deleted file mode 100644 index efb71ec..0000000 --- a/decus/vlt95b/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vlt95b/bulletin/board_digest.com b/decus/vlt95b/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vlt95b/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vlt95b/bulletin/board_special.com b/decus/vlt95b/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vlt95b/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vlt95b/bulletin/bull_news.c b/decus/vlt95b/bulletin/bull_news.c deleted file mode 100644 index 4f09cd3..0000000 --- a/decus/vlt95b/bulletin/bull_news.c +++ /dev/null @@ -1,705 +0,0 @@ -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} diff --git a/decus/vlt95b/bulletin/bull_newsdummy.for b/decus/vlt95b/bulletin/bull_newsdummy.for deleted file mode 100644 index a17d3ec..0000000 --- a/decus/vlt95b/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,99 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END diff --git a/decus/vlt95b/bulletin/bullcom.cld b/decus/vlt95b/bulletin/bullcom.cld deleted file mode 100644 index f3ec7e6..0000000 --- a/decus/vlt95b/bulletin/bullcom.cld +++ /dev/null @@ -1,742 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 5/30/95 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vlt95b/bulletin/bullcoms1.hlp b/decus/vlt95b/bulletin/bullcoms1.hlp deleted file mode 100644 index d5542b9..0000000 --- a/decus/vlt95b/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1236 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with -> at the beginning of each line. This can be -suppressed or the indentation character changed with /[NO]INDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message will -be deleted after the node on which the message was submitted from is -rebooted. If you wish the message to be deleted after a different node -reboots, you have the option of specifying that node name. The message -deletion is keyed by BULLETIN running on the node that reboots. It -writes into the database info that the node has rebooted, and when -BULLCP wakes up and sees this info, it will delete any shutdown messages -for that node. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers so -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file can -be specified which contains the text. If the editor is used for changing -the text, the old message text will be extracted. This can be suppressed -by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST - -If a mailer protocol is needs to be added to the network address in -order for it to be sent by VMS MAIL, i.e. protocol%"address", the -appropriate protocol can be specified by either hardcoding it into the -file BULLNEWS.INC before compiling BULLETIN, or by defining the system -logical name BULL_NEWS_MAILER (it is the same protocol used by the NEWS -feature in order to respond to NEWS messages). The default protocol is -IN%. If desired, you can specify the protocol with the address, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. The -identifier can not be any longer than 12 characters. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, the -folder will then be modified to point to that folder. For example if -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be shared -between more than one node. This capability is only present if the BULLCP -process is running on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message.R -It can be a substring of the subject. This is in case you have forgottene -the exact subject that was specified. Case is not critical either.s -You will be notified if the deletion was successful. -See also /NEGATED. -2 /USERNAME. -Specifies username to be used at remote DECNET nodes when deleting messagesc -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name,r -date, and subject of each message is displayed.I - - Format:i - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message.t -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /CONTINUEh -Used with /GROUP. Allows you to continue a search after you have broken -the search by entering a command, i.e. READ, SEARCH, etc. Note: If you -enter a SEARCH command which specifies a string, and then continue the -directory search using /CONTINUE, the new search pattern will be used -when continuing the search. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description ofo -folder. -2 /EXPIRATIONb -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the DIRECTORY -command are to be written into the specified file. All qualifiers which -are valid for the EXTRACT command are valid in conjunction with /EXTRACT -except for /NEW which conflicts with the DIRECTORY /NEW qualifier. The -listof messages to be printed will be displayed on the terminal (in -nopaging format). - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /FEEDBACKl -Used only in conjunction with /GROUP. Specifies to show when new news -groups are selected. l -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS.c -2 /FROMa - /FROM=[string]n - -Specifies that only messages whose username contains the specified string, -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.p -See also /NEGATED. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Used with the search -qualifiers /SEARCH, /SUBJECT, or /FROM. Wildcards are permitted in the -specified string. Use /FEEDBACK to see when groups are selected. At -any time during the search you may enter other commands, i.e. you may -read a message, see a full directory listing, etc. You may then restart -the search listing by typing DIR/CONTINUE. For more info, see help on -the /CONTINUOUS qualifier. r -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don't -match the specified search command are displayed. -2 /MARKEDb -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see alli -messages, use either /ALL, or reselect the folder. I -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicatedo -by an asterisk). Using /UNMARKED is equivalent to selecting the folderi -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEENi -Lists messages that have been seen (indicated by a greater than sign). s -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. To see allr -messages, use either /ALL, or reselect the folder. -2 /UNSEENl -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folderE -with /UNSEEN, i.e. only unseen messages will be shown and be able to bea -read. To see all messages, use either /ALL, or reselect the folder. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWSt -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED.o -2 /SEARCHo - /SEARCH=[string] - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.a -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.p -2 /START - /START=message_number - -Indicates the first message number you want to display. For example,l -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDEy -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings. - - Format:y - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. A - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE.s -2 /FROMA -Specifies to exclude the message based on the message owner. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. When /FULL is specified, the EXCLUDE command will -not add an exclude, so it can't be used with any other qualifier except -for /DISABLE.e -2 /LIMIT - /LIMIT=days - -Specifies that the exclude will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. k -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROMz -and /SUBJECT cannot be specified at the same time. -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):stringl - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:killn - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program.t -1 EXTRACT -Synonym for FILE command.s -1 FILE -Copies the current message to the named file. If the file exists, the -message is appended to the file, unless the /NEW qualifier is specified. - - Format:e - FILE [filename] [message_number][-message_number1],[...] - -If the filename is omitted, a file will be created based on the name of -the folder. - -A range of messages to be copied can optionally be specified, i.e. FILE -2-5. The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. e - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /ALL -Copies all the messages in the current folder. -2 /FFh -Specifies that a form feed is placed between messages in the file. -2 /HEADERl - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file.s -1 FIRSTa -Specifies that the first message in the folder is to be read. -1 Folders -All messages are divided into separate folders. New folders can beb -created by any user. As an example, the following creates a folder forc -GAMES related messages: - r -BULLETIN> CREATE GAMES -Enter a one line description of folder.e -GAMESe - -To see the list of available folders, use DIRECTORY/FOLDERS. To selecta -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, thatp -user will be alerted of topics of new messages at login time, and will m -then be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option,n -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command.T - -A folder can be restricted to only certain users, if desired. This is t -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATEl -rather than /PRIVATE is specified, all users can read the messages in thet -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SETr -NODE. A remote folder is one which points to a folder on a remote DECNET -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)c -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/, -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, andb -giving access to that UIC group. Only users in that UIC group will seeD -the messages in that folder when they log in.e -1 FORWARDf -Synonym for MAIL command.a -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INCLUDEw -Specifies to include reading messages based on the message owner or the -subject. If it is determined that a message is to be included, then the -message is read when a user tries to read a message by typing NEXT or -BACK, or by hitting the return key. Otherwise, it is skipped. Specify -the qualifier /FULL to make all EXCLUDEs and INCLUDEs for the specified -folder apply to all other BULLETIN commands, including directory -listings. - - Format:a - INCLUDE [string] - -If a string is specified, then the message is included if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one INCLUDE may be -specified per folder. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all INCLUDEs. -2 /DISABLE -Specifies to permanently disable the INCLUDE.r -2 /FROMh -Specifies to include the message based on the message owner. This iso -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. When /FULL is specified, the INCLUDE command will -not add an include, so it can't be used with any other qualifier except -for /DISABLE. -2 /SUBJECT -Specifies to include the message based on the message subject. /FROM -and /SUBJECT cannot be specified at the same time. p -2 Storing_INCLUDEs -INCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):stringv - -In order for /FULL to be the default for a folder, the following linee -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 INDEX -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for E -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after ones -has read a message. /RESTART must be specified to start from the first -folder if a scan is in progress. All other qualifiers are ignored while c -a scan is in progress. - - Format:h - INDEX - -When a directory is displayed, you can read the first message in the -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for oldert -versions of BULLETIN. -2 /MARKEDe -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED,e -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKEDi -Lists messages that have not been marked (marked messages are indicatedN -by an asterisk). Using /UNMARKED is equivalent to selecting the folderf -with /UNMARKED, i.e. only unmarked messages will be shown and be ableE -to be read.S -2 /SEENX -Lists messages that have been seen (indicated by a greater than sign). r -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read.e -2 /UNSEENE -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the foldert -with /UNSEEN, i.e. only unseen messages will be shown and be able to bew -read.i -2 /NEW - /[NO]NEWc - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message.r -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified.. -2 /RESTART -If specified, causes the listing to be reinitialized and start from they -first folder.t -2 /SET - /[NO]SET - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format: - LASTl -2 /EDIT -Specifies that the editor is to be used to read the message. This isC -useful for scanning a long message.c -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command* -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEa -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format:, - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying anu -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" mustt -be specified as xxx%"""address""". -2 /EDITo -Specifies that the editor is to be used to edit the message before -mailing it. -2 /HEADERn - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the N -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of morei -than one word, enclose the text in quotation marks (").i - -If you omit this qualifier, the description of the message will be useda -as the subject.l -1 MARK -Sets the current or message-id message as marked. Marked messages aree -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of importantU -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers]e - UNMARK [message-number or numbers]o - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to byl -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGINe -will be used. -1 MODIFY -Modifies the database information for the current folder. Only the -owner of the folder or a user with privileges can use this command. - - Format:N - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted forh -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing listi -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTd -commands, the address of the mailing list should be included in thei -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST o -2 /IDr -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presentlyR -assigned to it. Any process which has that identifier assigned to its -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID.d -1 MOVE -Moves a message to another folder and deletes it from the current -folder.s - - Format:r - - MOVE folder-name [message_number][-message_number1]e - -The folder-name is the name of the folder to which the message is to bee -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,3 -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPSs - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADERL - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER.t -2 /MERGE -Specifies that the original date and time of the moved messages aret -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.d -2 /ORIGINALE -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned byo -the person moving the message. -1 NEWS -Displays the list of available news groups.a - -Format:t - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed.h - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL wille -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /DEFAULT -If specified, will show news groups that have be defined as default -groups using the SET SUBSCRIBE command.e -2 /NEWGROUPu -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /PERMANENT -If specified, will show news groups that have be defined as permanentL -groups using the SET SUBSCRIBE command.n -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B.o -2 /STOREDi -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 New_features -Here is a list of new features which may be of interest to the general o -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - --------------------------------------------------------------------------u -V 2.23 -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95e - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95t - -V 2.22 - -SHOW EXCLUDE and INCLUDE commands added. 5/16/95 - -V 2.21 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -Added /FOLLOWUP to POST command when used with news groups. It specifiesn -which news group you want replies to your message to be sent to. 10/28/94 - -V 2.20 - -Logical names can be specified in POST/GROUPS=. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/11/94 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93s - -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93l - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group byN -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92W - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92d - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over.c -2 /EDITa -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message.E -2 /HEADER. - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commandl -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEs -Specifies to decode the message using ROT-13 coding. diff --git a/decus/vlt95b/bulletin/bullcoms2.hlp b/decus/vlt95b/bulletin/bullcoms2.hlp deleted file mode 100644 index ca634f2..0000000 --- a/decus/vlt95b/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1399 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with -> at the -beginning of each line. This can be suppressed or the indentation -character changed with /[NO]INDENT. -2 /FOLLOWUP - /FOLLOWUP=string - -Specifies that any replies generated by people reading the message -should be sent to the specified newsgroup. This is useful if you want -to post to more than one group, but don't want reply messages posted on -all the groups. To specify more than one newsgroup, surround the list -with quotes, i.e. FOLLOWUP="newsgroup1,newsgroup2". If replies should -only be sent to the message owner and not a newsgroup, the string -"poster" should be specified. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message -to the specified NEWS group(s) in addition to the selected NEWS group. -Logical names are allowed. -2 /HEADER -Allows customized headers line to be added to the message header. When -specified, header lines can be added by inserting them at the top of the -message, with the header lines and the text of the message separated by -a blank line. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. -In order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply -surround the exclusive text starting with the line "START " -and ending with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The file created by the PRINT command is not -released to the print queue until you exit, unless you add the qualifier -/NOW or change one of the print job's qualifiers. Multiple messages are -concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /CANCEL -Cancels any messages waiting to be printed. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL level -to find out the name of the mounted form and the default form for a -particular queue. If you specify a form whose stock is different from -the stock of the form mounted on the queue, your job is placed in a -pending state until the stock of the mounted form of the queue is set -equal to the stock of the form associated with the job. (In order to -have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the file -or files have been printed. If /NONOTIFY is specified, there is no -notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 QUIT -Exits the BULLETIN program. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. If you -specify a number greater than the number of messages in the folder, the -last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -/HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /INDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read -them. (Note: Reading the last message does the same thing, but RESET -does it without having to read it.) -2 /CURRENT -Resets the new message counter to the current message. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using the -qualifer /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected or /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text strings. - - Format: - - SEARCH [search-string[,...]] - -The search starts from the first message in the current folder. You can -specify the message to start at using the qualifier /START. If you use -this qualifier without a parameter, it starts with the current message. -The search includes both the text of the message, and the description -header. If a "search-string" is not specified, a search is made using -the previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FEEDBACK -Used only in conjunction with /FOLDER and /GROUP. Specifies to show -when new folders or news groups are selected. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for a -match. If, during a search, no more matches or messages are found, the -next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. Use /FEEDBACK to see when folders are -selected. News groups can be specified here. However, to search news -group with wild cards, use /GROUP. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Wildcards are permitted in -the specified string. If the string does not contain an * and does not -specify a news group, * is automatically placed at the beginning and end -of the string. I.e. if the string is "comp", then all news groups -containing the word "comp" will be searched. Use /FEEDBACK to see when -groups are selected. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /MATCH - /MATCH[=option] - -Interprets and matches multiple search strings in one of the following -ways: - - AND A match occurs only if all of the strings are found. - - OR A match occurs if any of the strings are found. - - XOR A match occurs if only one of the strings is found. - -If you specify none of these options, the default is /MATCH=OR. If you -specify the /NEGATED qualifier, you will get the negated operation. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If no -starting message is specified, the search is started from the last -message. /REVERSE must be specified with a search string. -2 /START - /START=message_number - -Specifies the message number to start the search at. If you omit the -message number, it starts with the current message. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUSm -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name.h - - Format:E - - SET [NO]ANONYMOUSS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read.r - - Format:i - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If -ADD_ONLY is set and a mailing address is present (see /DESCRIPTION), -when a message is added to the folder, it will also be mailed to the -address (in addition to being stored in the folder). This also applies -to a message which is added via the BBOARD feature . If ADD_ONLY is set -and a user uses the POST command, the ADD command will be used instead. -One use for this is to mail messages in a folder to users who do not -have access to BULLETIN. U - - Format:, - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2.o - - Format:i - - SET BBOARD [username]h - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages.h - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30", -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The formi -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY.i -The time will always be 00:00, even if the time is specified on the line.w -3 /EXPIRATIONT - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature.f -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be:W - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account.e - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV.s -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION.l -2 BRIEFl -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa).e - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERS - /FOLDER=foldernamep - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENTa - -Specifies that BRIEF is a permanent flag and cannot be changed by the -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier.h -2 COMPRESS -Specifies that messages added to the folder will be in compressed format. -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires s -very little cpu overhead.t - - Format:l - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. / -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed every -time when logging in, until the new messages are read. Normally, the -BRIEF setting causes notification only at the first time that new messages -are detected.m - - Format:] - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for theg -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges.l - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used.c - - Format:p - - SET DEFAULT_EXPIRE daysi - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages. - - Format:t - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format:o - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it. -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format:, - - SET [NO]EXPIRE_LIMIT [days]s - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) h -2 EXCLUDEe -Specifies to ignore any EXCLUDEs or INCLUDEs that are present. - - Format:h - - SET [NO]EXCLUDEs - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or INCLUDEs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 EXLIMITh -Specifies the default limit for the EXCLUDE command. - - Format:e - - SET EXLIMIT days - -If no match is found for an exclude after the specified number of days, -the exclude will automatically be deleted. The default is no limit, -which is specified by specifying 0 days. This default can be overriden -by the /LIMIT switch on the EXCLUDE command. -2 FILE_DIRECTORY -Select the directory where messages are written to when using the -EXTRACT or file COMMAND. By default, the message is written into the -current directory. g - - Format:e - - SET FILE_DIRECTORY [directory] - -If directory is omitted, the setting is removed. Note: This information -is stored in the customization file (SYS$LOGIN:BULL.CUSTOM). -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format:c - - SET FOLDER [node-name::][folder-name]e -3 /MARKEDc -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will haveu -to be reselected. -2 GENERICv -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for thee -same user. -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new messages will be displayed for upon -logging in. -2 KEYPAD h -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format:h - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to by. -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI.w -2 LIBRARYt -Specifies a library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command to see if there are other libraries. -2 LOGINm -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command.e - - Format:s - - SET [NO]LOGIN username -2 NAME -Copies all stored settings from one user to another. Used when a user's -account name is changed. - - Format:a - - SET NAME old-username new-username -2 NEWS -Changes attributes of the specified news group or class of news groups. -This command requires privileges.n - - Format:e - - SET NEWS [news-group]n - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALL. - /NOALLt - -If specified with /CLASS or /DEFAULT, all groups that are presently -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of anyE -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the defaulte -attributes (using /DEFAULT) with /NOALL, the attributes for misc.testn -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. e -3 /CLASS - /CLASS=classnamem - -Specifies to modify attributes for a class of news groups rather than ae -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes ofK -existing groups which are in the class are modified, and any groups -created in the future will automatically have those attributes. -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETE. -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLE -Specifies that the news group is enabled and can be accessed. This isl -the default. -3 /EXPIRATIONd - /EXPIRATION=daysy - -Specifies the default expiration time for messages if none is specified. -The default is 7.e -3 /FULLl -Control whether all information of the news groups is displayed, i.e. -the access list if the news group is private. This information is only -those who have access to that folder. -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified isb --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default.e -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is postede -every month with an expiration date of one month in the future.a -3 /PRIVATE - /PRIVATEe - /NOPRIVATEn - -Specifies that the news group or class can have it's access modified by -the SET ACCESS command. To accomplish this, a file is created ine -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access M -to news groups in that class is to set /NOPRIVATE, as then time won't be d -wasted checking a file for ACLs. -3 /STOREDa - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessedi -via the network from the server node. This results in faster access, -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED.h -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node.r - - Format:s - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder.s - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node,s -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated. -3 /FOLDERD - /FOLDER=foldernamet - -Specifies the folder for which the node information is to modified.e -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format:m - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are loggede -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specifiedh -folder. This is a privileged qualifier. It will only affect brand newc -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernamet - -Specifies the folder for which the option is to modified. If nott -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENTt - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN.o - - Format:l - - SET [NO]PAGE -2 POST_ONLYp -Specifies that the selected folder has the POST_ONLY attribute. This -causes the ADD command to mail the message to the mailing address if it -is present (see /DESCRIPTION), rather than add to the folder. L - - Format:e - - SET [NO]POST_ONLYh -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format:n - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers.y -3 /IDt - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.e -2 PROMPT_EXPIREr -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format:S - - SET [NO]PROMPT_EXPIRE -2 READNEWe -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command.e - - Format:i - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersp -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newp -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER0 - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If nots -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENTo - -Specifies that READNEW is a permanent flag and cannot be changed by the -individual. This is a privileged qualifier. -2 SHOWNEWA -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN.s - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format: - - SET [NO]SHOWNEWO -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new userse -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all -users. t -3 /FOLDERh - /FOLDER=foldernames - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENTs - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged -qualifier. t -2 STRIPi -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If STRIP -is set, the header of the mail message will be stripped off before it is -stored as a BULLETIN message. - - Format:T - - SET [NO]STRIPl - -The command SHOW FOLDER/FULL will show if STRIP has been set.s -2 SUBSCRIBEo -Can be used to force users to be subscribed to the selected news group. -This is a privileged command. - - Format:b - - SET SUBSCRIBEp - -Note: If you execute the commands SET SHOWNEW, READNEW, BRIEF, or -NOTIFY, and add /DEFAULT or /PERMAMENT, it is equivalent to doing a SET -SUBSCRIBE command with the addition that the specified feature will be -the default and/or permanent setting. -3 /ALL -Specifies that all present and future users will be subscribed to the -news group. -3 /DEFAULT - /[NO]DEFAULTP - -Specifies that new users will automatically be subscribed to the news -group. -3 /PERMANENT - /[NO]PERMANENTl - -Specifies that new users will automatically be subscribed to the news -group and that users cannot unsubscribe the news group. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 EXCLUDEl -Displays the list of excludes which are present for the current folder. -The right hand side of the display shows the date of the last time a -match for the exclude was found, and also the number of days from the -time of the last match after which the excludes expires. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. u -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected -via the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name]f -3 /FULLB -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 INCLUDEe -Displays the list of includes which are present for the current folder.i -2 KEYPAD -Displays the keypad command definitions. - - Format: - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either SET KEYPAD, or if /KEYPAD is -specified on the command line, the keypad keys will be defined as -commands. The default settings for the keypad are shown via SHOW KEYPAD -or HELP KEYPAD. Settings can be changed by using an initialization file -with DEFINE/KEY commands. BULLETIN looks first for the file pointed to -by the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -3 /STATE - /STATE=(state,state,...) - -Specifies the name of a state for which the specified key definitions -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when a -key name has been specified. -2 LIBRARY -Shows the library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the /ALL -qualifier to see if there are other libraries. o -3 /ALL -Specifies to show all available libraries. -2 NEWo -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format:a - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this.T -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command.e -3 /LOGIN - /[NO]LOGINe - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDERf - /FOLDER=[foldername]h - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups.m -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSIONi -Shows the version of BULLETIN and the date that the executable was -linked.n -1 SPAWNi -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format:e - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBEL -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of thex -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. n -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format:l - UNDELETE [message-number]t -1 UNSUBSCRIBEs -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See the -SUBSCRIBE command for further info. -1 Usenet_newss -BULLETIN can also read USENET NEWS if your system has network access tos -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of b -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group in -order to keep track of which messages you have read in that group. Most -of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read news groups with new messages, use INDEX/SUBSCRIBE. diff --git a/decus/vlt95b/bulletin/bulldir.inc b/decus/vlt95b/bulletin/bulldir.inc deleted file mode 100644 index f66cc78..0000000 --- a/decus/vlt95b/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vlt95b/bulletin/bullet1.com b/decus/vlt95b/bulletin/bullet1.com deleted file mode 100644 index 44e1788..0000000 --- a/decus/vlt95b/bulletin/bullet1.com +++ /dev/null @@ -1,2474 +0,0 @@ -$set nover -$copy/log sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. -$eod -$copy/log sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) -$eod -$copy/log sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. -$eod -$copy/log sys$input BULLETIN.LNK -$deck -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.23" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.23" -$eod -$copy/log sys$input BULLFILES.INC -$deck -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ -$eod -$copy/log sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) -$eod -$copy/log sys$input BULLNEWS.INC -$deck - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ -$eod -$copy/log sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy/log sys$input BULL_NEWS.C -$deck -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} -$eod -$copy/log sys$input CHANGES.TXT -$deck -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. -$eod -$copy/log sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy/log sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy/log sys$input NEWS.TXT -$deck -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when a -user accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. It is also possible to -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) When the POST and -ADD commands are used with this folder, the messages will be posted to the news -group, rather than actually being added to the folder. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. -$eod -$copy/log sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod -$copy/log sys$input WRITEMSG.TXT -$deck -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/vlt95b/bulletin/bullet2.com b/decus/vlt95b/bulletin/bullet2.com deleted file mode 100644 index b77fd75..0000000 --- a/decus/vlt95b/bulletin/bullet2.com +++ /dev/null @@ -1,1678 +0,0 @@ -$set nover -$copy/log sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy/log sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy/log sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 5/30/95 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE -$eod -$copy/log sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP -$eod -$copy/log sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP -$eod -$copy/log sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy/log sys$input BULL_NEWSDUMMY.FOR -$deck - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END -$eod -$copy/log sys$input CREATE.COM -$deck -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK -$eod -$copy/log sys$input INSTALL.COM -$deck -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy/log sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy/log sys$input LOGIN.COM -$deck -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! If you want to have more than one BULLETIN database, replace BULL_DIR -$! with the actual directory to allow redefining BULL_DIR. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! -$eod -$copy/log sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.23" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* -$eod -$copy/log sys$input OPTIMIZE_RMS.COM -$deck -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS -$eod -$copy/log sys$input RESTART.COMI -$deckR -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL_ -DO DEASSIGN BULL_DISABLE/SYSTEME -$ BULL/START -$eod E -$copy/log sys$input SETUSER.MARL -$deckE - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -;R - .LIBRARY /SYS$LIBRARY:LIB.MLB/t - $PCBDEF ;define PCB offsetsX - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program -$eod -$copy/log sys$input UPGRADE.COM -$deck -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE -$eod diff --git a/decus/vlt95b/bulletin/bulletin.cld b/decus/vlt95b/bulletin/bulletin.cld deleted file mode 100644 index deb3c36..0000000 --- a/decus/vlt95b/bulletin/bulletin.cld +++ /dev/null @@ -1,44 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vlt95b/bulletin/bulletin.com b/decus/vlt95b/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vlt95b/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vlt95b/bulletin/bulletin.for b/decus/vlt95b/bulletin/bulletin.for deleted file mode 100644 index e42418d..0000000 --- a/decus/vlt95b/bulletin/bulletin.for +++ /dev/null @@ -1,2031 +0,0 @@ -C -C BULLETIN.FOR, Version 8/4/95 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - CALL INIT_BULLETIN(.TRUE.) - -C -C The MAIN loop for processing bulletin commands. -C - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - CALL DO_COMMAND(INCMD) - -100 CONTINUE - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) - - END - - - - - SUBROUTINE DO_COMMAND(INCMD) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - CHARACTER*(*) INCMD - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (HLEN.EQ.0) THEN - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - END IF - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (NEWS_FEED().OR.REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - WRITE (6,'('' ERROR: /FOLDER not valid when posting'', - & '' a message to a news group.'')') - ELSE - INCMD = 'POST '//INCMD(4:) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - END IF - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,'('' ERROR: There are no more preceding messages.'')') - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.,.FALSE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR - ELSE IF (INCMD(:4).EQ.'INCL') THEN ! INCLUDE? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'FI') THEN ! SET FILE_DIRECTORY? - CALL SET_CUSTOM('file_directory') - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SH') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SU') THEN ! SET SUBSCRIBE? - IF (REMOTE_SET.GE.3) THEN - D1 = 0 - D2 = 0 - D3 = 0 - CALL SET_FOLDER_DEFAULT(D1,D2,D3) - ELSE - WRITE (6,'('' ERROR: Command invalid for folder.'')') - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LIB') THEN ! SET LIBRARY? - CALL SET_LIBRARY - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS? - CALL SET_NEWS - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE? - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE? - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:3).EQ.'EXL') THEN ! SET EXLIMIT? - CALL SET_CUSTOM('exclude_limit') - ELSE IF (BULL_PARAMETER(:4).EQ.'NAME') THEN ! SET NAME? - CALL SET_NEWNAME - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'EX') THEN ! SHOW EXCLUDE? - CALL SHOW_EXCLUDE(0) - ELSE IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:2).EQ.'IN') THEN ! SHOW INCLUDE? - CALL SHOW_EXCLUDE(1) - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SHOW LIBRARY - CALL SHOW_LIBRARY - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATION - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1) - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN? - CALL TAG(.FALSE.,2) - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - - RETURN - END - - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - CHARACTER INEXDATE*12,INEXTIME*12,INDENT*4 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT') - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - LENI = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',INDENT,LENI) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LENI.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') INDENT(:LENI)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2100' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2100' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60) - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60) - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - IF (CLI$PRESENT('EXTRACT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35 - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - BLENGTH = BLENGTH + ILEN - 1 + 2 - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE. - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting.'', - & '' A truncated message will be broadcast.'')') - CALL GET_INPUT_PROMPT(INPUT,ILEN, - & 'Type C to continue, A to only ADD message, or Q to Quit: ') - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN - BRDCST = .TRUE. - END IF - END IF - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! Username - END IF - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THEN - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '// - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK) - END IF - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletin - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IF - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF (FOLDER_NUMBER.GE.0) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF -C -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP, -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same cluster -C as that of the BULLCP node. -C - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET) - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - ELSE IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR. - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LENDES),STATUS) - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IF - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (CLI$PRESENT('EXTRACT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*4 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP)) - - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG) - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC' - - DATA READ_UAI/.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE. - RETURN - END IF - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE. - END IF - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURN - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')') - RETURN - END IF - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN) - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN() - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - RETURN - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - SUBROUTINE INIT_BULLETIN(NOX) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - DATA PAGE_LENGTH/24/,PAGE_WIDTH/80/ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (NOX) CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER(:LEN_P) - CALL CHECK_DIR(BULL_PARAMETER,.FALSE.) - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - END IF - CALL LIB$REVERT - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE IF (COMMAND_PROMPT(I:I).EQ.'/') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL(.FALSE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS1') THEN - CALL NEWS2BULL(.TRUE.) - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - IF (NOX) CALL CRELNM('SYS$INPUT','TT') ! Input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - IF (NOX) CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - - CALL OPEN_OLD_TAG - - IF (.NOT.NOX) THEN - CALL NEW_MESSAGE_NOTIFICATION - RETURN - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IF - END IF - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - - RETURN - END diff --git a/decus/vlt95b/bulletin/bulletin.hlp b/decus/vlt95b/bulletin/bulletin.hlp deleted file mode 100644 index cf279b3..0000000 --- a/decus/vlt95b/bulletin/bulletin.hlp +++ /dev/null @@ -1,151 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vlt95b/bulletin/bulletin.lnk b/decus/vlt95b/bulletin/bulletin.lnk deleted file mode 100644 index 7d7af23..0000000 --- a/decus/vlt95b/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.23" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.23" diff --git a/decus/vlt95b/bulletin/bulletin0.for b/decus/vlt95b/bulletin/bulletin0.for deleted file mode 100644 index d7c7c08..0000000 --- a/decus/vlt95b/bulletin/bulletin0.for +++ /dev/null @@ -1,2361 +0,0 @@ -C -C BULLETIN0.FOR, Version 7/17/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IER1 = SBULL + 1 - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER1) - IER2 = 0 - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.TEST_NEWS_OWNER().AND.SETPRV_PRIV()) THEN - WRITE (6,1055) - READ (5,'(A)',IOSTAT=IER2) DESCRIP - END IF - END IF - IF (IER2.EQ.0.AND.IER1.EQ.SBULL+1) CALL - & REMOTE_DELETE(SBULL,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.NE.USERNAME - END IF - IF (ASK) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,1055) - READ (5,'(A)',IOSTAT=IER) DESCRIP - IF (IER.NE.0) RETURN - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.(TEST_NEWS_OWNER().OR. - & SETPRV_PRIV())) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) -1055 FORMAT(' State reason for deleting message not owned by you.') - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2),EX(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:9).EQ.'19') EXDATE(8:9) = '18' - IF (EXDATE(8:9).EQ.'20') EXDATE(8:9) = '19' - IF (EXDATE(8:9).EQ.'18'.AND.EXDATE(10:10).LT.'6') - & EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX,EX) - IER = SYS$ASCTIM(,INPUT,EX,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /CTRLC_FLAG/ FLAG - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - CHARACTER GROUP*80,STAT*4 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - FOUND = 0 - - CONT = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - CONT = CLI$PRESENT('CONTINUE') - ELSE IF (INCMD(:3).EQ.' '.AND.NFOLDER.LT.0) THEN - CONT = .TRUE. - END IF - IF (CONT) THEN - SUBJECT = SUBJECT1 - REPLY = REPLY1 - SEARCH = SEARCH1 - FROM_SEARCH = FROM_SEARCH1 - SINCE = SINCE1 - NEW = NEW1 - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - IF (.NOT.ANY_SEARCH) THEN - WRITE (6,'('' ERROR: No previous search to continue.'')') - RETURN - END IF - INCMD = ' ' - LEN_P = 0 - DIR_COUNT = DIR_COUNT1 - NFOLDER = NFOLDER1 - I = DIR_COUNT - IF (DIR_COUNT.EQ.-1) THEN - I = SBULL - 1 - END IF - GO TO 200 - END IF - NFOLDER = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - EXTRACTING = CLI$PRESENT('EXTRACT') - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - NEGATED = CLI$PRESENT('NEGATED') - IF (SEARCH) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (SUBJECT) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (FROM_SEARCH) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (REPLY) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3 - NEGATED = .TRUE. - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - ELSE - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - IF (INCMD(:3).EQ.'IND') THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - REPLY_FIRST = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - ELSE - NEW = .FALSE. - END IF - END IF - OUTPUT = EXTRACTING.OR.PRINTING - - START = .FALSE. - SINCE = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - NFOLDER1 = -1000 - SUBJECT1 = SUBJECT - REPLY1 = REPLY - SEARCH1 = SEARCH - FROM_SEARCH1 = FROM_SEARCH - I = SBULL - 1 - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - SINCE1 = SINCE - NEW1 = NEW - GOTO 200 - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - IF (NEW.AND.IER.EQ.0) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - IF (READ_TAG) CALL DECREMENT_MSG_KEY - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) NUM = NUM + 1 - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - END IF - I = I - 1 - END DO - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - END IF - IF (NUM.GT.0) I = I - 1 - END DO - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) NUM = NUM + 1 - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) J = J + 1 - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I1 = SBULL - I = SBULL - DO WHILE (I.LE.EBULL) - CALL READDIR(I1,IER) ! Into the queue - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1 - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - I = I + 1 - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1 - END IF - I1 = I1 + 1 - END DO - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - EBULL = EBULL - SBULL + DIR_COUNT - SBULL = DIR_COUNT - I = SBULL - END IF - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY, - & TAG_TYPE) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVE - END IF - END IF - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - END IF - ELSE - NBULL = 0 - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN - DIR_TYPE = 'seen' - END IF - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - IF (INCMD(:3).EQ.'DIR'.AND.ANY_SEARCH) THEN - IF (.NOT.CLI$PRESENT('START').AND. - & .NOT.CLI$PRESENT('CONT')) THEN - WRITE (6,'('' No matches found starting search'', - & '' from message number '',I)') SBULL - DIR_COUNT = -1 - GO TO 9999 - END IF - END IF - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - IF (NFOLDER.EQ.0) - & CALL DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION) - - TAG = (BULL_TAG.AND.(REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1)).OR. - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THEN - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN - START_SEARCH = BULL_POINT - END IF -200 CLOSED = .FALSE. - IF (ANY_SEARCH.OR.OUTPUT) THEN - NUM = 0 - IF (NFOLDER.NE.-1000) THEN - CLOSED = .TRUE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - CLOSED_FILES = .FALSE. - SEARCH_NUM = 1 - REVERSE = .FALSE. - END IF - DO WHILE (I.LE.EBULL.AND.FOUND.GT.-3) - IF (.NOT.ANY_SEARCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (NFOLDER.NE.-1000.AND.I.GE.SBULL) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SLEN,0, - & START_SEARCH,REVERSE,SUBJECT,REPLY_FIRST,.FALSE., - & .TRUE.,FROM_SEARCH,NEGATED,.FALSE.) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - IF (NFOLDER.LT.0.AND.(I.EQ.F_START.OR.I.EQ.DIR_COUNT)) THEN - IF (FEEDBACK) CALL LIB$ERASE_PAGE(1,1) - CALL - & DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION) - DIR_COUNT = 0 - BULL_POINT = MSG_NUM - 1 - PRINT_HEADER = .TRUE. - END IF - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - TAG_TYPE = DUMMY - END IF - IF (NFOLDER.LT.0.AND..NOT.OUTPUT) THEN - NUM = NUM + 1 - IF (NUM.EQ.PAGE_LENGTH-6) I = EBULL + 1 - END IF - ELSE IF (NFOLDER.LT.0.AND.(OUTPUT.OR.I.LE.SBULL)) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSED = .FALSE. - END IF - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - CALL CLOSE_BULLFOLDER - IF (GFOUND) THEN - START_BULL = 0 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - IF (F1_START.GT.0.AND.F1_START.LE.F1_NBULL) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - START_SEARCH = F_START - 1 - IF (IER.AND.(NEW.OR.SINCE)) THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER1,DATETIME) - CALL CLOSE_BULLDIR - IF (IER1.NE.0) THEN - START_SEARCH = IER1 - 1 - ELSE - IER = 0 - END IF - END IF - END IF - IF (.NOT.IER.OR.F1_START.EQ.0.OR. - & F1_START.GT.F1_NBULL) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER, - & IER) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - GFOUND = .FALSE. - IF (FLAG.EQ.1) CALL CLOSE_BULLFOLDER - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - SBULL = F_START - I = SBULL - 1 - EBULL = F_NBULL - END IF - ELSE - NFOLDER = 0 - END IF - END DO - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - ELSE IF (NFOLDER.EQ.0) THEN - WRITE (6,'('' No messages found.'')') - END IF - IF (NFOLDER.EQ.0) I = EBULL + 1 - IF (NFOLDER.LT.-1000) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED = .TRUE. - END IF - NFOLDER1 = NFOLDER - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - I = EBULL + 1 - END IF - CALL CANCEL_CTRLC_AST - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.GE.SBULL.AND.I.LE.EBULL.AND.NFOLDER.NE.-1000) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN - OUTLINE = '>' - ELSE - OUTLINE = ' ' - END IF - IF (BTEST(SYSTEM,29)) THEN - OUTLINE(2:) = '*' - ELSE - OUTLINE(2:) = ' ' - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3) - IF (EXDATE(8:12).LT.'1994'.AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin? - EXPIRES = 'Permanent' - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11) - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9) - ELSE - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11) - END IF - NOTHING = .FALSE. - WRITE(6,'(1X,A)') OUTLINE - IF (OUTPUT) THEN - FOUND_MSG = .TRUE. - CALL SYS$SETAST(%VAL(0)) - NEXT = .FALSE. - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES) - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES,PRINT_HEADER) - PRINT_HEADER = .FALSE. - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0 - ELSE - MSG_NUM = -MSG_NUM - END IF - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1)) - END IF - END IF - I = I + 1 - IF (ANY_SEARCH) IER = SYS$CANTIM(,) - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.OUTPUT) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IF - END IF - - IF (DIR_COUNT.GT.NBULL - & .OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THEN - ! Outputted all entries? - IF (PRINTING) THEN - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THEN - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IF - ELSE IF (EXTRACTING.AND.FOUND_MSG) THEN - CALL FILE(0,CLOSED_FILES,.FALSE.) - END IF - IF (NFOLDER.LT.0) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE - DIR_COUNT = -1 ! Yes. Set counter to -1. - END IF - ELSE IF (NFOLDER.NE.0.OR.(-NFOLDER1.EQ.FOLDER_NUMBER.AND. - & INCMD(:1).EQ.' ')) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE IF (FLAG.NE.1) THEN - WRITE(6,1010) ! Else say there are more - END IF - -9999 POSTTIME = .FALSE. - NEXT = .FALSE. - IF (NFOLDER.NE.0.OR.-NFOLDER1.EQ.FOLDER_NUMBER) THEN - DIR_COUNT1 = DIR_COUNT - IF (DIR_COUNT1.GT.NBULL) DIR_COUNT1 = -1 - END IF - RETURN - -1010 FORMAT(1X,/,' Press RETURN for more...',/) -1020 FORMAT(1X,/,' Press RETURN for more, type SEARCH to read ', - & 'these messages.',/) - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER) - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT,PRINT_HEADER) -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER*128 FILENAME - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THEN - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IF - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THEN - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IF - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = FILE_NUM - EBULL = SBULL - END IF - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F) - - IF (.NOT.IER) THEN - FILENAME = FOLDER - DO I=1,LEN(FILENAME) - IF (FILENAME(I:I).EQ.'.') FILENAME(I:I) = '_' - END DO - FILENAME = FILENAME(:TRIM(FILENAME))//'.TXT' - LEN_F = TRIM(FILENAME) - END IF - - IF (TRIM(FILE_DIRECTORY).GT.0.AND.INDEX(FILENAME,':').EQ.0 - & .AND.INDEX(FILENAME,'[').EQ.0) THEN - FILENAME = FILE_DIRECTORY(:TRIM(FILE_DIRECTORY))//FILENAME - LEN_F = TRIM(FILENAME) - END IF - - CALL STR$UPCASE(FILENAME,FILENAME) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE. - FIRST = .TRUE. - END IF - - IF (PRINT_HEADER) THEN - WRITE (3,'(/,''Newsgroup: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1 - IF (FBULL1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - OPENED = .FALSE. - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(FBULL,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DO - -100 IF (FILE_NUM.GT.0) THEN - FILE_NUM = -FILE_NUM - RETURN - END IF - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created. - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - END IF - - GO TO 10 - -900 WRITE(6,1000) FILENAME(:LEN_F) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message ',A,' written to ',A) -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A) -1050 FORMAT('Subj: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN) - - CALL LIB$MOVC3(8,IN,OUT) - - RETURN - END - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - FOLDER_NAME = FOLDER - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSE - RETURN ! Don't notify - END IF - END IF - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSE - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM) - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time - ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSER - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LOGIN_BTIM_NEW) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF - - CALL GET_NODE_NUMBER(NODE_NUMBER1,NODE_AREA1) - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100 - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IGNORE = BTEST(SYSTEM,2).AND.(NODE_AREA.EQ.NODE_AREA1).AND. - & (NODE_NUMBER.AND.NODE_NUMBER1) - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF ((USERNAME.NE.FROM.OR.SYSTEM).AND..NOT.IGNORE) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - ELSE - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - END IF - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - INREAD = '+' - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' ' - END IF - IF (LEFT) THEN - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN) - LEFT = .FALSE. - ILEN = 0 - INREAD = '+' - ELSE IF (ILEN.LE.WIDTH) THEN - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN) - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSE - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ') - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH) - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0) - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DO - IF (INPUT(ILEN:ILEN).EQ.' ') THEN - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEN - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE. - ELSE - WIDTH = PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE (6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....')e - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1S - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')')P - ELSEE - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IFR - ! Bulletin number is stored in SYSTEM - ELSED - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEMC - END IFE - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0)R - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THENU - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated.L - END IF -C -C Instruct users how to read displayed messages if READNEW not selected.P -CE - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.) - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030). - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - PAGE = PAGE + 1T - ELSEC - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILENU - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)//I - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN) - & //' '//FOLDER_NAME(:FLEN)//L - & ' to read these messages.' - END IF - PAGE = PAGE + 1' - END IF - -9999 IF (LOGIN_SWITCH) THENo - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF - RETURNR - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'))L -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.')e -1080 FORMAT(' ',/) - - END - - - B - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlistE - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)),N - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0D - END IF - - RETURNt - END - - - - SUBROUTINE DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION) - - IMPLICIT INTEGER (A - Z)R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGI - - CHARACTER*(*) OUTLINE - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULLN - ELSEE - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IFE - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ')T - OUTLINE(I+1:) = OUTLINE(I+2:)R - END DOH - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ')E - OUTLINE(I+1:) = OUTLINE(I+2:) - END DOT - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ') - OUTLINE(I:) = OUTLINE(I+1:)O - END DO( - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINE - BULL_PARAMETER = ' 'M - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1)) THENL - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THEN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IFL - IF (PRINTING) THENf - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - END IFE - - WRITE (6,'(''+'',A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE))$ - IF (EXPIRATION) THEN, - WRITE(6,1005) - ELSEL - WRITE(6,1000)o - END IFr - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/) - - RETURNN - END - - - - SUBROUTINE GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - - IMPLICIT INTEGER (A - Z)_ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'( - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER TODAY(2) - - CHARACTER DATETIME*24 - - IF (SINCE) THEN ! Was /SINCE specified? - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY)C - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER)E - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),a - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - IER = 0 - RETURN - ELSE$ - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IFR - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - END IF - END IFf - - RETURN - END diff --git a/decus/vlt95b/bulletin/bulletin1.for b/decus/vlt95b/bulletin/bulletin1.for deleted file mode 100644 index cbb4ae0..0000000 --- a/decus/vlt95b/bulletin/bulletin1.for +++ /dev/null @@ -1,2263 +0,0 @@ -C -C BULLETIN1.FOR, Version 9/14/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - CHARACTER*256 SENDTO - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_S = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',SENDTO(LEN_S+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_S = LEN_S + I + 1 - SENDTO(LEN_S:LEN_S) = ',' - END DO - LEN_S = LEN_S - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_S) - IF (SENDTO(I:I).EQ.'"') THEN - SENDTO = SENDTO(:I)//'""'//SENDTO(I+1:) - I = I + 2 - LEN_S = LEN_S + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',SENDTO(:LEN_S) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//SENDTO(:LEN_S) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*32 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256,TODAY*24 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - IF (IER1.EQ.0) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THEN - I = IER - ELSE - NUM_COPY = NUM_COPY + 1 - END IF - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (.NOT.ORIGINAL.AND.REMOTE_SET.EQ.4).OR.REMOTE_SET.EQ.3 - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0.AND.NEWS_FEED()) THEN - IF (.NOT.ORIGINAL) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - IER1 = .FALSE. - ELSE - REMOTE_SET = 3 - END IF - END IF - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - ELSE - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF (TO_NEWS.AND.ORIGINAL) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2100' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (REMOTE_SET.GE.3.AND..NOT.ORIGINAL) THEN - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT) - ELSE - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - IF (.NOT.ORIGINAL) SYSTEM = IBSET(SYSTEM,3) - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (POST_NEWS) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADER - IF (ORIGINAL.AND.(NEWS_FEED().OR.REMOTE_SET.EQ.4)) RETURN - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IF - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./ - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND. - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0 - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN) - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0) - IF (CHANGED) THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IF - - IF (INCMD(:4).EQ.'PRIN') THEN - IF (CLI$PRESENT('CANCEL')) THEN - WRITE (6,'('' Cancelling all previously queued messages.'')') - CLOSE (UNIT=24,DISPOSE='DELETE') - FIRST = .TRUE. - RETURN - END IF - END IF - -50 IF (PRINT_NUM.EQ.0) THEN - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = PRINT_NUM - EBULL = SBULL - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name - IF (QLEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - END IF - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100 - CLOSE (UNIT=24,DISPOSE='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - END IF - -1040 FORMAT(' Message ',A,' sent to printer.') -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE. - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) - END IF - - CALL DISABLE_PRIVS - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A, - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE. - GO TO 50 - END IF - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ_MSG -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /POST/ POSTTIME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH) - CHARACTER HEADLINE*132 - - LOGICAL SINCE,PAGE - - EXTERNAL CLI$_NEGATED - - FIRST = BULL_READ.LT.F_START - KILL = BTEST(BULL_USER_CUSTOM,3) - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3) - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE. - END IF - ROTC = CLI$PRESENT('ROTATE') - END IF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSE - BULL_READ = 1 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - NEW = .TRUE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READDIR_KEYGE(IER) - IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_BTIM) - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - CALL CLOSE_BULLDIR - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - END IF - END DO - CALL CLOSE_BULLDIR - ELSE - IER = 0 - DO WHILE (IER.EQ.0) - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - MSG_NUM = IER - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - END IF - END DO - END IF - BULL_READ = IER - IER = IER + 1 - END IF - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999 - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IF - - NEXT = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - IF (.NOT.SINCE.AND..NOT.NEW - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THEN - IER = 0 - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR. - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN - MSG_NUM = F_NBULL+1 - ELSE - MSG_NUM = BULL_NOW - END IF - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE - CALL GET_THIS_OR_NEXT_TAG - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0 - END IF - END IF - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END IF - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END DO - CALL CLOSE_BULLDIR - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READ - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSE - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0 - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IF - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE. - CALL READDIR(BULL_READ,IER) - END IF - END IF - IF (REMOTE_SET.LT.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - IF (IER.NE.BULL_READ+1) THEN - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0 - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) ! If not, then error out - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - - SAVE_BULL_POINT = BULL_POINT - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(FIRST.OR.NEW.OR.NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEN - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - - IF (.NOT.OK) THEN - BULL_POINT = SAVE_BULL_POINT - BULL_NOW = MSG_NUM - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN - BULL_READ = MSG_NUM - 1 - ELSE - BULL_READ = MSG_NUM + 1 - IF (INCMD(:4).EQ.'FIRS'.OR.FIRST) NEXT = .TRUE. - END IF - IF (REMOTE_SET) CALL CLOSE_BULLFIL - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - IF (BULL_READ.GT.F_NBULL.OR.BULL_READ.LT.F_START) THEN - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - GO TO 50 - END IF - BLOCK = BLOCK_SAVE - END IF - - NEXT = .FALSE. - IF (REMOTE_SET.LT.3) THEN - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.BULL_READ) CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - END IF - - EDIT = .FALSE. - - PAGE_WIDTH = REAL_PAGE_WIDTH - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN - IF (CLI$PRESENT('EDIT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 9999 - END IF - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTH - PAGE = .FALSE. - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSE - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL - END IF - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:) - END DO - I = TRIM(HEADLINE) - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)) - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - ELSE - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ' - & .AND..NOT.BTEST(SYSTEM,3)) THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROM - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - IF (EDIT) WRITE(3,'(1X)') - ELSE - END = END + 1 - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IF - END IF - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) THEN - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter - GO TO 9999 - END IF - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - -9999 POSTTIME = .FALSE. - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - RETURN - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO - - RETURN - END - - - - - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1 - EQUIVALENCE (INREAD4,INREAD) - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - BULL_POINT_READ = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - - GO TO 12 - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - - BULL_POINT = BULL_POINT_SAVE - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN - ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL FILE(0,.TRUE.,.FALSE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THEN - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THEN - WRITE (6,'(''+B'',$)') - INCMD = 'RESPOND/LIST' - ELSE - GO TO 11 - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')') - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLY - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message', - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),', - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) -1040 FORMAT(' Type P to post reply, U to reply to user,', - & ' B to do both, or other to quit: ',$) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END - - - - - LOGICAL FUNCTION NEWS_FEED() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - I = SLIST + 1 - FLEN = TRIM(FOLDER_DESCRIP) - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN - I = FLEN + 1 - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND. - & FOLDER_DESCRIP(I:I).NE.'@'.AND. - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE - I = FLEN + 2 - END IF - END DO - IF (I.EQ.FLEN+1) NEWS_FEED = .TRUE. - END IF - - RETURN - END diff --git a/decus/vlt95b/bulletin/bulletin10.for b/decus/vlt95b/bulletin/bulletin10.for deleted file mode 100644 index 1afad2d..0000000 --- a/decus/vlt95b/bulletin/bulletin10.for +++ /dev/null @@ -1,3628 +0,0 @@ -C -C BULLETIN10.FOR, Version 9/29/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - COMMON /HEADER_SEEN/ HEADER_SEEN - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - LAST_LF_SEEN = LF_SEEN - LAST_REAL_LF_SEEN = REAL_LF_SEEN - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - CR_SEEN = INDEX(BUFFER(START_READ:END_READ),CR) - IF ((END_LINE.EQ.0.AND.CR_SEEN+START_READ-1.LT.END_READ) - & .OR.CR_SEEN.LT.END_LINE-1) THEN - END_LINE = CR_SEEN - CR_SEEN = 1 - ELSE - CR_SEEN = 0 - END IF - LF_SEEN = END_LINE.GT.0 - IF (END_LINE.GT.257-CR_SEEN.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - IF (.NOT.HEADER_SEEN) END_LINE = 254 - END IF - REAL_LF_SEEN = INDEX(BUFFER(START_READ:END_READ),LF).LE.END_LINE - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - IF (BUFFER(EB:EB).EQ.LF) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - IF (EB.GT.0.OR.LAST_LF_SEEN) RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE(:MIN(LEN(WRITE),256)) - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - NEWS_WRITE = NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - - LOGICAL FUNCTION NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - NEWS_RECONNECT = .FALSE. - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - NEWS_RECONNECT = .TRUE. - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /HEADER/ HEADER - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER().OR.SETPRV_PRIV()) THEN - IF (REMOTE_SET.EQ.4) THEN - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (INPUT(:11).EQ.'Message-ID:') THEN - MESSAGE_ID = INPUT(14:ILEN-1) - ILEN = 0 - END IF - END DO - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - CALL NEWS_POST('cancel',0,IER,SUBJ) - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - DO WHILE (BUFFER(SB:EB).NE.'.'.AND. - & .NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX( - & BUFFER(SB:EB),' ')+SB-2),J,,%VAL(1))) - IF (.NOT.NEWS_READ()) RETURN - END DO - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - STAT = .TRUE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(FROM,TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - HEADER_SEEN = .FALSE. - LF_SEEN = .FALSE. - LAST_LF_SEEN = .FALSE. - REAL_LF_SEEN = .FALSE. - LAST_REAL_LF_SEEN = .FALSE. - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8 - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONE - CHARACTER*4 ZONE - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/ - - CHARACTER*8 TIMES(1) - DATA TIMES /'-5:30'/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - IF (INDEX(ZONES,ZONE)/4.LT.4) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) - END IF - ELSE - HOUR = '00:00' - END IF - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_TI_L(TIME(:2),DATE,,%VAL(1)) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - NEWSGROUPS = ' ' - FOLLOWUP = ' ' - LREF = 0 - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.'.OR..NOT.LAST_REAL_LF_SEEN) - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126) - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(FROM,BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+11).EQ.'Followup-To:'.AND. - & EB.GT.SB+12) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+13:EB))+SB+12 - FOLLOWUP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - CALL GET_FROM(FROM,FROM_LINE(7:),TRIM(FROM_LINE)) - LAST_FROM = .TRUE. - ELSE - LAST_FROM = .FALSE. - END IF - END IF - END DO - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'1FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - START = -1 - CALL NEWNEWS(IN_BTIM,IER) - IF (IER.NE.0) START = IER -C -C The following code makes use of the NNTP command NEWNEWS, but is -C known to be slow and buggy in many servers. -C -C IER = SYS$ASCTIM(,TIME,IN_BTIM,) -C CALL DATE_TIME(TIME) -C SKIP = 0 -C DO WHILE (SKIP.GE.0) -C IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( -C & FOLDER_NAME))//' '//TIME)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C IF (BUFFER(:2).EQ.'23') THEN -C IF (.NOT.NEWS_READ()) CALL EXIT -C DO I=1,SKIP -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (FIRST.EQ.'.') RETURN -C DO WHILE (BUFFER(SB:EB).NE.'.') -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) -C & CALL EXIT -C IF (.NOT.NEWS_READ()) CALL EXIT -C IF (BUFFER(:2).EQ.'22') THEN -C IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN -C I = F_NBULL + 1 -C DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. -C & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) -C & .OR.I.GT.F_NBULL)) -C I = I - 1 -C IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN -C IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C END DO -C IF (I.GE.F_START) START = I -C ELSE -C IER = OTS$CVT_TI_L(BUFFER(SB+4: -C & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) -C END IF -C RETURN -C END IF -C END IF -C SKIP = SKIP + 1 -C END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2 - IER = IER1 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - CHARACTER*256 TEMP - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IF - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0 - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE - IER = NEWS_READ() - IF (IER.AND.(BUFFER(SB:EB).NE.'.' - & .OR..NOT.LAST_REAL_LF_SEEN)) THEN - IER = 0 - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THEN - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF ((INDEX(TEMP,': ').EQ.0.AND. - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255).OR. - & (LTEMP.EQ.254.AND..NOT.LAST_LF_SEEN)) THEN - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IF - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IF - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF - ELSE - HEADER_SEEN = .TRUE. - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128 - ELSE - ILEN = 128 - END IF - END IF - ELSE - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ABS(ILEN).EQ.128) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - HEADER_SEEN = .TRUE. - - RETURN - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /READIT/ READIT - - COMMON /NEWS_INIT/ END_READ - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - - DIMENSION DUMMY(4) - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - END_READ = 0 - IF (.NOT.NEWS_LOGIN()) THEN - IER = 2 - RETURN - END IF - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY) - IF (SYSLOG) THEN - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3)) - END IF - END IF - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUP - - CHARACTER*8 NUMBER - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURN - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1 - RETURN - ELSE IF (ICOUNT.EQ.-1) THEN - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THEN - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURN - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - START = ICOUNT - BULLETIN_NUM = START - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0 - CALL NEWS_HEADER(IER) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - BLOCK = START - MSG_NUM = START - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN - END - - - - SUBROUTINE NEWS_GROUP(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN - IER = 1 - RETURN - END IF - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)) - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT') - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURN - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME - - CHARACTER*28 TIME - - DIMENSION DIFF(2) - - I = 1 - LTIME = TRIM(INTIME) - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:)) - - DO J = 1,2 - I = 1 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-' - END DO - - IF (I.EQ.LEN(TIME)) RETURN - - IF (TIME(I+3:I+3).EQ.' ') THEN - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IF - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DO - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - IF (INDEX(TIME(:I-2),'.').GT.0) THEN - CALL SYS_BINTIM(TIME(:INDEX(TIME(:I-2),'.'))//'00',BTIM) - ELSE IF (TIME(I-4:I-4).EQ.':'.AND.TIME(I-7:I-7).EQ.':') THEN - CALL SYS_BINTIM(TIME(:I-2)//'.00',BTIM) - ELSE - CALL SYS_BINTIM(TIME(:I-2)//':00.00',BTIM) - END IF - - IF (TIME(I:I).EQ.'+'.OR.TIME(I:I).EQ.'-') THEN - IER = SYS_BINTIM('0 '//TIME(I+1:I+2)//':'//TIME(I+3:I+4),DIFF) - IF (IER) THEN - IF (TIME(I:I).EQ.'-') THEN - IER = LIB$SUBX(BTIM,DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,DIFF,BTIM) - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE NEWS_LIST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - COMMON /NEWSLIST/ NEWSLIST - - CHARACTER TODAY*24 - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR. - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER)) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - NEWS_FOLDER1_BBOARD = '::' - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14 - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNT - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1 - IF (IER.EQ.0.AND.IER1.EQ.0) - & NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) ! Old bug caused this. - IF (IER.NE.0.OR.IER1.NE.0) THEN - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLEN - NEWS_F1_COUNT = NEWS_F_COUNT - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN - NEWS_FOLDER = NEWS_FOLDER(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - NEWS_F_COUNT = NEWS_F1_COUNT - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)// - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - END IF - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - IF (IER2.EQ.0) THEN - NEWS_F1_FLAG = NEWS_F_FLAG - NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN - NEWS_F1_EXPIRE = NEWS_F_EXPIRE - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1) - IF (BTEST(NEWS_F1_FLAG,8)) THEN - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_LAST = 0 - END IF - IF (FLEN.LE.44.OR.FLEN-44+EB-SP+1.LT. - & LEN(NEWS_FOLDER1_DESCRIP)) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - END IF - ELSE IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE. - IF (FLEN.GT.44) THEN - IF (NEWS_FOLDER1_DESCRIP.NE. - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - IF (SPECIAL) THEN - IF (UPDATE) THEN - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF - ELSE IF (.NOT.UPDATE) THEN - UPDATE = F1_START.LT.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.F1_START.AND. - & NEWS_F1_FIRST.GT.F1_NBULL) THEN - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE), - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (((F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND..NOT.BTEST(NEWS_F1_FLAG,8)) THEN - DELETE (UNIT=7) - IER = 0 - ELSE IF (IER.EQ.1) THEN - IF (NEWS_F1_NBULL.GE.NEWS_F1_START - & .AND.NEWS_F1_START.NE.0) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(NEWS_F1_START,IER1) - CALL CLOSE_BULLDIR - IER1 = NEWS_F1_START+1.EQ.IER1 - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - IF (.NOT.IER1) DELETE (UNIT=7) - END IF - END IF - END IF - END DO - END IF - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - NEWSLIST = .FALSE. - - IF (SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED')) CALL RECOUNT - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DO - - RETURN - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4 - - COMMON /LOCALPOST/ LOCAL_POST - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /TEMP_INPUT/ GROUP_TEMP - CHARACTER GROUP_TEMP*256 - - COMMON /HEADER/ HEADER - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER RESPONSE*4 - - CHARACTER TODAY*24,UNAME*132 - DATA UNAME /'()'/ - - COMMON /POINT/ BULL_POINT - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1) - IF (IER1.NE.0) RETURN - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900 - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3) - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSE - I = INDEX(NEWS_MSGID,'.') - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & NEWS_MSGID(:I-1)// - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256) - IF (IER.NE.0) RETURN - LOCAL_POST = .TRUE. - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1 - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP - ELSE IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - IF (TRIM(FOLLOWUP).EQ.0) THEN - INPUT = 'Newsgroups: '//NEWSGROUPS - ELSE - INPUT = 'Newsgroups: '//FOLLOWUP - END IF - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE.AND. - & .NOT.NEWS_FEED()) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER) - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0 - DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP)) - IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP) - DO WHILE (TRIM(GROUP_TEMP).GT.0) - COMMA = INDEX(GROUP_TEMP,',') - IF (COMMA.GT.0) THEN - FOLDER1_NAME = GROUP_TEMP(1:COMMA-1) - GROUP_TEMP = GROUP_TEMP(COMMA+1:) - ELSE - FOLDER1_NAME = GROUP_TEMP - GROUP_TEMP = ' ' - END IF - CALL LOWERCASE(FOLDER1_NAME) - FLEN = TRIM(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1) - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9) - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND. - & INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND. - & INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST), - & GROUP_LIST,FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - ELSE - WRITE (6,'(1X,A,'' is not a valid news group.'')') - & FOLDER1_NAME(:FLEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to specify it? (default = Y) ') - IF (RESPONSE(:1).NE.'n'.AND. - & RESPONSE(:1).NE.'N') THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - END IF - END IF - END DO - END DO - CALL CLOSE_BULLNEWS - END IF - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900 - END IF - ATSIGN = INDEX(PATHNAME,'@') - PCSIGN = INDEX(PATHNAME,'%') - CALL LOWERCASE(USERNAME) - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - END IF - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME) - - IF (FILENAME.NE.'cancel') THEN - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - CALL STR$UPCASE(FROM_LINE,FROM_LINE) - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME) - ELSE - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (INPUT(:5).EQ.'From:') THEN - IF (.NOT.NEWS_WRITE(INPUT(:ILEN))) THEN - CALL CLOSE_BULLFIL - GO TO 900 - END IF - ILEN = 0 - END IF - END DO - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - - IF (FILENAME.EQ.'cancel'.AND.TEST_NEWS_OWNER()) THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'// - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE IF (TRIM(SUBJECT).EQ.0) THEN - IF (.NOT.NEWS_WRITE('Subject: (none)')) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECT - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) - & GO TO 900 - END IF - - IF (NGROUPS.GT.0) THEN - FROM = USERNAME - DESCRIP = SUBJECT - END IF - - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//'>')) GO TO 900 - - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION) - END IF - LORGAN = TRIM(ORGANIZATION) - END IF - - IF (LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN))) - & GO TO 900 - END IF - - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & ZONE(:LZONE))) GO TO 900 - - INPUT_HEADER = .FALSE. - - IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel').AND..NOT.NEWS_FEED()) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE( - & FIRST_ALPHA(EXDATE):2) - & //' '//EXDATE(4:6)//' '//EXDATE(10:TRIM(EXDATE)) - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900 - ELSE IF (REMOTE_SET.EQ.4) THEN - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT) - END IF - EXTIME = '00:00:00.00' - END IF - IF (CLI$GET_VALUE('FOLLOWUP',GROUP_TEMP)) THEN - CALL LOWERCASE(GROUP_TEMP) - IF (.NOT.NEWS_WRITE('Followup-To: ' - & //GROUP_TEMP(:TRIM(GROUP_TEMP)))) GO TO 900 - END IF - INPUT_HEADER = CLI$PRESENT('HEADER') - END IF - - IF (CREATE) THEN - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURN - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).EQ.'240') IER = 0 - ELSE - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - LOCAL_POST = .FALSE. - RETURN - END IF - - IF (.NOT.INPUT_HEADER) THEN - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2 - END IF - IF (IER1.EQ.0) THEN - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DO - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') THEN - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:MIN(79+SB,EB)) - IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN - WRITE (6,'('' Use /INDENT to change indentation'',$)') - WRITE (6,'(''+ character. See Manager for permanent'',$)') - WRITE (6,'(''+ change.'')') - END IF - END IF - ELSE - LENGTH = (LENGTH+127)/128 - GROUP_LIST = GROUP_LIST1 - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - SAVE_BULL_POINT = BULL_POINT - DO I=NGROUPS,1,-1 - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1) - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL ADD_LOCAL_NEWS(8) - END IF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - BULL_POINT = SAVE_BULL_POINT - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - CALL STR$UPCASE(USERNAME,USERNAME) - - LOCAL_POST = .FALSE. - - RETURN - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURN - END IF - END IF - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME) - LPATH = TRIM(PATHNAME) - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NAME - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME) - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE. - END DO - - TEST_NEWS = MAYBE_NEWS - - RETURN - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) RETURN - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULL - FIRST = F1_START - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - REMOTE_SET = 3 - CALL OPEN_BULLDIR_SHARED - I = F_LAST + 1 - IER = I - 1 - DO WHILE (I.NE.IER.AND.I.LE.LAST) - CALL READDIR(I,IER) - I = I + 1 - END DO - CALL CLOSE_BULLDIR - CALL OTS$CVT_L_TI(I-1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNT - NEW_NEWS_F_END = NEWS_F_END - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - F_LAST = LAST - NEWS_F_FIRST = FIRST - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE NEWS2BULL(RECLAIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBER - - DIMENSION NOW(2) - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV - - CALL DELETE_EXPIRED_NEWS(RECLAIM) - - IF (RECLAIM) CALL EXIT - - CALL SEND_POST - - CALL NEWS_LIST - - CALL UPDATE_LOCAL_NEWS - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - ELIST = INDEX(FOLDER_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN - IF ((FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR. - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))).AND. - & INDEX(FOLDER_DESCRIP(SLIST+2:),'@').EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARD - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (IER) THEN - SAVE_LAST = F_LAST - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER) - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN - SAVE_LAST = F_NBULL - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LAST - FOLDER_BBOARD = 'NONEFEED' - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - REMOTE_SET = 3 - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM(9 - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.)R - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1) - END IFN - CALL CLOSE_BULLFOLDER - END IFE - END IF - END DO - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTHF - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/W - - CHARACTER*(*) TIMER - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+_ - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)//S - & TIME(16:17)//TIME(19:20)I - - RETURN( - END - - - - SUBROUTINE ALLPRIVS - - IMPLICIT INTEGER (A-Z)A - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1E - PROCPRIV(2) = -1. - NEEDPRIV(1) = -1I - NEEDPRIV(2) = -1E - - RETURNR - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COMN - - NEWS_FOLDER1 = FOLDER1E - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DOI - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM. - NEWS_F1_COUNT = NEWS_F_COUNTD - REWRITE (7) NEWS_FOLDER1_COMA - - RETURNN - END - - - - SUBROUTINE SUBSCRIBEA - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC'B - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)A - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX)E - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')')W - RETURN - END IFN - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1E - END DOR - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')')R - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')')= - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSEE - WRITE (6,'('' You are now subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IFR - - CALL UPDATE_USERINFO. - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(T - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THENN - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1))L - LAST_NEWS_READ(2,J) = F_START - 1 - ELSED - LAST_NEWS_READ2(2,J) = 0O - LAST_NEWS_READ(2,J) = F_NBULL - END IFR - CALL CLOSE_BULLNEWS - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ)N - CALL UPDATE_USERINFO_NEWS_ALWAYSR - RETURN( - END IF - END DO - - END - - - - - - SUBROUTINE UNSUBSCRIBE) - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLUSER.INC'R - - INCLUDE 'BULLFOLDER.INC'. - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_EXPIREDI - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)E - COMMON /USERINFO/ LAST(2,FOLDER_MAX)I - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IF - - CALL OPEN_BULLINF_SHAREDR - DO WHILE (REC_LOCK(IER))I - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_RECI - END DO) - IF (IER.NE.0) THENM - DO I=1,FOLDER_MAXE - INF_REC(1,I) = 0( - INF_REC(2,I) = 0T - END DO - END IF - CALL CLOSE_BULLINF( - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DOA - - IF (I.LE.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Folder is permanent and cannot not be'',H - & '' unsubscribed.'')')_ - RETURN - END IFU - - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - CALL UPDATE_USERINFOD - - I = NEWS_FIND_SUBSCRIBE() - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1))) - END DOE - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0E - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0' - - CALL FREE_TAGS(I) - - IF (NINCLUDE.GT.0) WRITE (6,'('' Note: Excludes and/or '', - & ''includes exist for this group.'')') - - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ)T - - CALL UPDATE_USERINFO_NEWS_ALWAYS - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'H - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (IER.EQ.0) IER = 1 ! None read yet. - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0E - RETURN - END IFM - - RETURNE - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER)R - - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'T - - I = NEWS_FIND_SUBSCRIBE1()D - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0E - RETURN - END IFI - - RETURN - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC'D - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR.(LAST_NEWS_READ(2,I) - & .GT.NEWS_F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER)M - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X)D - END IF - - RETURNT - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG)R - - IMPLICIT INTEGER (A-Z)p - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0T - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THEN - COUNT = COUNT + 1 - END IFD - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT)T - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSEF - SUBNUM = 0 - END IFU - - RETURNR - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES)( -CT -C SUBROUTINE NEWS_NEW_NOTIFICATIONN -C - - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLFOLDER.INC'W - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT) - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)I - - MESSAGES = .FALSE.R - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1I - - FOLDER_DESCRIP = ' ' - REORDER = 0 - DO WHILE (SUBNUM.GT.0)U - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - FOLDER1_DESCRIP = FOLDER_DESCRIPH - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUMI - UNLOCK 7L - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1T - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THENC - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - ELSE IF (IER.NE.0) THEN - SUBNUM = -1D - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR.E - & F_START.GT.F_NBULL) THEN_ - IER = 1 - END IFA - END IFL - IF (IER.EQ.0.AND.SUBNUM.GT.0) THENF - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND.O - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THENS - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR.U - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)M - IF (DIFF.GT.0) IER = 1R - END IF - END IFE - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THENT - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1): - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A,''.'')') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1). - ELSEM - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1)Q - IF (IER1) THEN1 - CALL LOGIN_FOLDERE - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBERL - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINTO - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO' - END IFU - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IFF - END IF - END DO - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE) - - CALL CLOSE_BULLNEWS - - RETURNL - END - - - SUBROUTINE REORDER_SUBSCRIBEM - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLFOLDER.INC'( - - INCLUDE 'BULLUSER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0) - I = I + 1I - END DO( - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1, - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER)H - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1)F - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2E - TEMP = LAST_NEWS_READ(L,J) - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K) - LAST_NEWS_READ(L,K) = TEMP - END DOT - END IF= - END DO - END DOT - - RETURNT - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)A - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENS - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14)R - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER)U - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC'( - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN( - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15). - - RETURNI - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLUSER.INC'B - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN= - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IF. - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE.) - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURNS - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE()R - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC'L - - INCLUDE 'BULLFOLDER.INC'( - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1A - END DOJ - - NEWS_FIND_SUBSCRIBE = I - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'S - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DOD - - NEWS_FIND_SUBSCRIBE1 = I( - - RETURNR - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'U - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF. - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER))R - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DOT - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0$ - INF_REC(2,I) = 0R - END DO - END IFI - CALL CLOSE_BULLINFT - - IP = 1R - DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER - & .AND.IP.LE.FOLDER_MAX-1) - IP = IP + 1 - END DOG - - IER = .TRUE.L - - IF (IP.EQ.FOLDER_MAX) THEN - PERM = .FALSE. - IP = 1 - ELSEC - PERM = .TRUE._ - END IF - - IF (NOTIFY.EQ.0) THEN - IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THENF - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')')D - RETURNO - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) - END IF - ELSE IF (NOTIFY.EQ.1) THENA - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.PERM.AND.R - & (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15))) THENe - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).AND. - & .NOT.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE.) - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.PERM.AND.S - & (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE.. - END IFT - - IF (IER) THEN - IF (READNEW.EQ.1)W - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14)G - IF (READNEW.EQ.0)N - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1)) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15)N - IF (BRIEF.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15)N - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')')N - - IF (BTEST(INF_REC2(2,IP),14)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - END IF - - IF (BTEST(INF_REC2(2,IP),15)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - END IF - END IF4 - - CALL UPDATE_USERINFOE - - RETURNU - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT) - - IMPLICIT INTEGER (A-Z)' - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - REWIND UNIT - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM)T - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '//. - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK). - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THENI - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6,, - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) - END IF - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THEN) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF: - LENGTH = OCOUNT - (NBLOCK + 1) + 1R - NBLOCK = NBLOCK + LENGTH + 1, - SYSTEM = 0 - CALL ADD_ENTRY - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIRZ - - RETURNZ - END - - - - SUBROUTINE UPDATE_NEWS_FOLDER -CR -C SUBROUTINE UPDATE_NEWS_FOLDER -CA -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'D - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THENd - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_END( - F_COUNT = NEW_F_COUNTA - END IFT - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1_ - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM))T - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_EX_BTIM_KEY - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLNEWS - - RETURND - END - - - - SUBROUTINE SEND_POST - - IMPLICIT INTEGER (A-Z)1 - - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER FILE*132_ - - C = 0 - - IF (.NOT.NEWS_LOGIN()) RETURN - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST',FILE,C)) - IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'340') RETURNE - - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD'). - DO WHILE (IER.EQ.0)B - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (INPUT(:5).EQ.'From:') - & BULL_PARAMETER = INPUT(7:INDEX(INPUT,'@')-1)O - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IF - END DO - IF (INPUT.NE.'.') THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - IF (BUFFER(:3).NE.'240') THEN - CLOSE (UNIT=3)E - CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER))S - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER)= - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - END IF - CLOSE (UNIT=3,STATUS='DELETE') - END DOR - -100 CLOSE (UNIT=3) - - RETURN( - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVSE - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100( - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME,I - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST)E - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)): - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVSR - - IF (UNAME.EQ.'()') THEN - UNAME = ' ' - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IFU - - RETURNB - END - - - - SUBROUTINE RECOUNT. -C -C SUBROUTINE RECOUNT: -C4 -C FUNCTION: -CE -C Fixes the message count of stored news groups. This may become wrong -C if old copies of some of the database files are used with newer versions. -CL - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC'M - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXTS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFILS - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - FOLDER_NUMBER = 1000R - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER))) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THENS - CALL CLOSE_BULLNEWSA - RETURN - END IF( - - REMOTE_SET = 4. - - DO WHILE (IER.EQ.0) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - END DO - - IF (BTEST(NEWS_F_FLAG,8).AND.IER.EQ.0) THEN - CALL NEWS_TO_FOLDER - - CALL OPEN_BULLDIR_SHARED - - NUM = F_START - F_COUNT = 0 - - IF (F_START.GT.0) THEN: - CALL READDIR(NUM,IER) - NEXT = .TRUE. - F_START = NUM - DO WHILE (NUM+1.EQ.IER) - F_COUNT = F_COUNT + 1F - NUM = NUM + 1M - IF (NUM.LE.F_NBULL) CALL READDIR(NUM,IER)S - END DO' - NEXT = .FALSE.E - - F_NBULL = NUM - 1 - END IF - - CALL CLOSE_BULLDIRH - - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DOR - - CALL DELLNM('BULL_NEWS_RECOUNT') - - CALL CLOSE_BULLNEWS - - RETURNS - END - - - - SUBROUTINE DELLNM(LOG)D - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$SYSTEM',LOG,PSL$C_SUPER) - - RETURNA - END - - - SUBROUTINE NEWNEWS(SINCE_BTIM,FOUND) - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC') - - COMMON /BUFFER/ BUFFER,SB,EBE - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDRU - LOGICAL XHDR /.FALSE./C - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1E - - DIMENSION SINCE_BTIM(2) - - START = F_START - END = F_NBULL - - FOUND = 0 - - IF (REMOTE_SET.EQ.3.AND.XHDR) THENT - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - IF (.NOT.NEWS_READ()) RETURNS - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (FOUND.EQ.0) THEND - L = INDEX(BUFFER(SB:EB),' ') - CALL OTS$CVT_TI_L(BUFFER(SB:SB+L-2),IER,,%VAL(1))E - CALL NEWS_TIME(BUFFER(SB+L:EB),MSG_BTIM) - CALL CONVERT_FROM_GMT(MSG_BTIM)N - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) - & FOUND = IER - END IF. - IF (.NOT.NEWS_READ()) RETURNT - END DOI - IF (FOUND.NE.0) THEN - IF (.NOT.OTS$CVT_L_TI(FOUND,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IFS - END IF - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500'I - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22')I - START = START + 1I - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THENH - IER = 0T - END = START - 1 - RETURN - END IF - END IFR - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURNS - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0( - I = START) - DO WHILE (IER.EQ.0.AND.I.LE.END.AND.FOUND.EQ.0) - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)). - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURNE - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) FOUND = MSG_NUM - I = I + 1 - IF (REMOTE_SET.EQ.3.AND.I.LE.END.AND.FOUND.EQ.0) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURNT - IF (BUFFER(:3).NE.'223') THEN - END = I - 1I - IER = 0 - RETURN - END IFR - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURNN - IER = 0 - END IF - END DO - IF (FOUND.EQ.0) THEN I - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURND - IF (.NOT.NEWS_READ()) RETURNM - END IF - END IF - - RETURNM - END diff --git a/decus/vlt95b/bulletin/bulletin11.for b/decus/vlt95b/bulletin/bulletin11.for deleted file mode 100644 index c42a8a7..0000000 --- a/decus/vlt95b/bulletin/bulletin11.for +++ /dev/null @@ -1,3275 +0,0 @@ -C -C BULLETIN11.FOR, Version 8/4/95 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('CURRENT')) THEN - MESSAGE_NUMBER = BULL_POINT - ELSE IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*12 BULL_MARK_DIR - CHARACTER*12 TAG_KEY,INPUT_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,) - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1) - ELSE - UNLOCK 13 - END IF - END IF - - NTRIES = 0 - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),) - IF (IER1.NE.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128,DISPOSE='DELETE', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1) - NEWS_MARK2(1) = NEWS_MARK2(2) - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - CALL ERRSNS(IDUMMY,IER2) - IF (IER2.NE.RMS$_RNF) SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURN - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1), - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IF - - RETURN - END - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - - CHARACTER*12 BULL_MARK_DIR - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSE - MARKUNIT = 23 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1 - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEY - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IF - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY) - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURN - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - TAG_TYPE = 0 - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR. - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN - IF (IER.EQ.0) UNLOCK 13 - IER = 0 - MESSAGE = MSG_NUM - ELSE - IER = 36 - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - IER = 36 - - HEADER = .FALSE. - - TAG_TYPE = 0 - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) THEN - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:) - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THEN - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I) - IER = 0 - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - MSG_KEY = NEXT_MSG_KEY - RETURN - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DO - - RETURN - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - DO MESSAGE = MSG_NUM+1,F_NBULL - CALL READDIR(MESSAGE,IER) - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE) - IF (IER.EQ.0) THEN - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END DO - - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2) - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURN - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER) - & INPUT_KEY - END DO - - CLOSE_IT = .FALSE. - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - CALL DECREMENT_MSG_KEY - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR_SHARED - CLOSE_IT = .TRUE. - END IF - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - DELETE (UNIT=13) - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER)) - READ (13,IOSTAT=IER) INPUT_KEY - END DO - END IF - END IF - - END DO - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE. - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1 - DO M=1,2 - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1 - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1 - LIMIT = 256/(NEWS_FORMAT+1) - NEWS_NUMBER = LAST_NEWS_READ2(1,I) - K = 5-NEWS_FORMAT*2 - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1 - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IF - SET_LIST = .FALSE. - END IF - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0) - END DO - K = LIMIT + 1 - END IF - IF (K.GT.LIMIT) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2 - NEWS_REC = NEWS_REC + 1 - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - IF (IER.EQ.0) THEN - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IF - END DO - END IF - END DO - END DO - CLOSE (UNIT=23) - END IF - - RETURN - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = J - ELSE - NEWS_MARK(I) = J - END IF - - RETURN - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG) - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUM - NEWS_TAG(I) = 0 - END DO - - RETURN - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - DO I=1,2 - IF (NEWS_TAG(3,I,ISUB).GT.0) THEN - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB)) - NEWS_TAG(3,I,ISUB) = 0 - NEWS_NUMBER = NEWS_FOLDER_NUMBER - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER) - END IF - END DO - IF (IER.EQ.0) UNLOCK 23 - END IF - - DO J=I,FOLDER_MAX-2 - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J)) - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0 - END DO - END DO - - RETURN - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY - - IER = 36 - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE) - IF (IER.EQ.0) THEN - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THEN - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM) - END IF - IER = 36 - END IF - END IF - END DO - BULL_READ = MSG_NUM - IF (CLOSE_IT) CALL CLOSE_BULLDIR - ELSE - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0 - MSG_KEY = BULLDIR_HEADER - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THEN - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36 - END IF - END IF - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*24 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1)) - - CALL DISABLE_PRIVS - - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))// - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:) - END DO - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR) - - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO)) - I = INDEX(SENDTO(J:),',') - 1 - IF (I.EQ.-1) I = TRIM(SENDTO(J:)) - CALL INIT_ITMLST - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - J = J + I - IF (SENDTO(J:J).EQ.',') J = J + 1 - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) -C IF (SETPRV_PRIV()) THEN -C CALL ENABLE_PRIVS -C CALL ADD_2_ITMLST -C & (TRIM(USERNAME),MAIL$_SEND_FROM_LINE,%LOC(USERNAME)) -C CALL DISABLE_PRIVS -C END IF - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO)) - CALL END_ITMLST(ATTRIBUTE_ITMLST) - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - CALL LIB$REVERT - - RETURN - END - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,) - - RETURN - END - - - - - SUBROUTINE SET_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEXT/ NEXT - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DIMENSION EXPIRED(2) - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IF - - ENTRY SHOW_NEWS - - LIMIT = -2 - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1)) - IF (.NOT.IER.OR.LIMIT.LT.-1) THEN - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')') - RETURN - END IF - END IF - - EXPIRE = -1 - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1)) - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN - END IF - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR. - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')') - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - IF (CLI$PRESENT('DEFAULT')) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1 - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - RETURN - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE) - FOLDER1_NUMBER = NEWS_F1_COUNT - FOLDER1 = BULL_PARAMETER - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10) - CALL WRITE_FOLDER_FILE_TEMP(IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMP - REWRITE (7) NEWS_FOLDER1_COM - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER) - END IF - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - END IF - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS') - DEFAULT = CLI$PRESENT('DEFAULT') - ALL = CLI$PRESENT('ALL') - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE') - ENABLE = CLI$PRESENT('ENABLE') - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - - STORED = 0 - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN - WRITE (6,'('' Stored setting was not removed.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'[.BULLNEWS*]*.*;*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_SAVE = FOLDER - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - FOLDER = FOLDER_SAVE - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0 - F1_NBULL = 0 - F1_COUNT = 0 - F1_LAST = 0 - END IF - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3) - IF (IER.NE.0) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - END IF - CALL RESET_PROTECTION - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IF - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THEN - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')') - ELSE - WRITE (6,'('' Default is not stored.'')') - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS) THEN - WRITE (6,'('' Expiration is DEFAULT value.'')') - ELSE - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Default expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no default expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')') - ELSE - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - NOTIFY_FLAG_NEWS = .FALSE. - SET_FLAG_NEWS = .FALSE. - BRIEF_FLAG_NEWS = .FALSE. - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a default news group.'')') - ELSE - IER1 = 2 - END IF - END IF - NOTIFY_PERM_FLAG_NEWS = .FALSE. - SET_PERM_FLAG_NEWS = .FALSE. - BRIEF_PERM_FLAG_NEWS = .FALSE. - DO WHILE (REC_LOCK(IER2)) - READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC - END DO - IF (IER2.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a permanent news group.'')') - END IF - END IF - PERM = .FALSE. - IF (SET_FLAG_NEWS) THEN - IF (BRIEF_FLAG_NEWS) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE IF (BRIEF_FLAG_NEWS) THEN - IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - IF (.NOT.PERM) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (BRIEF_PERM_FLAG_NEWS.AND..NOT.SET_PERM_FLAG_NEWS) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (NOTIFY_FLAG_NEWS) THEN - IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' NOTIFY is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLINF - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IF - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER) - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) - END IF - FOUND = .FALSE. - MODALL = INDEX(GROUP,'.').NE.LG - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR. - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.')) - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER) - END DO - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER) - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - RETURN - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - END DO - END IF - - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC', - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFERT - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMU - - CHARACTER TODAY*24I - - DIMENSION BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - ALL = CLI$PRESENT('ALL')A - FULL = CLI$PRESENT('FULL')M - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN fileR - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)T - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENS - IF (CLI$PRESENT('SUBJECT')) THENA - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)I - ELSES - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IF0 - ELSE - INPUT = FROM - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:) - ELSE( - INPUT = DESCRIP - END IFa - END IF - LEN_P = TRIM(INPUT)w - CALL CLOSE_BULLFIL - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - INPUT = 'SUBJECT:'//INPUTI - LEN_P = LEN_P + 8 - ELSEU - INPUT = 'FROM:'//INPUT - LEN_P = LEN_P + 5C - END IFG - - IF (EXCLUDE) THEN - INPUT = ':EXCLUDE:'//INPUT - LEN_P = LEN_P + 9. - ELSEN - INPUT = ':INCLUDE:'//INPUT - LEN_P = LEN_P + 9M - END IFP - - FLEN = TRIM(FOLDER_NAME)A - INPUT = FOLDER_NAME(:FLEN)//INPUT - ILEN = FLEN + LEN_P - - DISABLE = CLI$PRESENT('DISABLE')/ - - EXC = -1A - IER = CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P) - IF (IER) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) EXC - IF (EXC.LT.0.OR.EXC.GT.999.OR.IER.NE.0) THEN T - WRITE(6,'('' ERROR: Valid limit is 0-999.'')')U - RETURN - END IF - END IF - - CHECK_ONLY = .FALSE.U - - GO TO 100 - - ENTRY CHECK_EXCLUDES - - CHECK_ONLY = .TRUE. - DISABLE = .TRUE.s - LEN_P = 0 - INPUT = ' ' - ILEN = 1 - -100 IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER)' - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'R - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH)= - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)I - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN( - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) THEN - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - CLOSE (UNIT=4,DISPOSE='SAVE') - RETURN - END IFt - - IER = 0 - CONVERT = .FALSE. - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERD - IF (IER.EQ.0) THEN E - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THENV - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5)f - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill'B - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF ((STREQ(OLD_BUFFER(:ILEN),INPUT(:ILEN)).AND.T - & OLD_BUFFER(ILEN+1:ILEN+1).EQ.':').OR.E - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:OLEN),INPUT(:OLEN)))) THEN - CONTINUE - ELSE IF (.NOT.(ALL.AND.INPUT(:FLEN+8).EQ.T - & OLD_BUFFER(:MIN(FLEN+8,OLEN)))) THEN - IER2 = OLD_BUFFER(:1).EQ.':'.OR.1 - & INDEX(OLD_BUFFER,':defaults:').GT.0 - IF (.NOT.IER2) THEN - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC1,BLIMIT,BDATE,IER1) - IF (IER1) IER2 = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1) - & ,' ').GT.-EXC1 - CONVERT = .NOT.IER1 - END IF - IF (.NOT.IER1.OR.EXC1.EQ.0.OR.IER2) - & WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN)T - END IFD - END IF - END DO - - IF (.NOT.DISABLE) THENR - IF (CLI$PRESENT('FULL')) THENh - WRITE (4,'(A)',IOSTAT=IER) FOLDER_NAME(:FLEN)//':defaults:kill' - ELSE - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IFI - - IF (CONVERT) THEN - WRITE (6,'('' NOTE: See help on the new SET EXLIMIT command.'')')_ - END IFC - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOMB - - RETURNB - END - - - - SUBROUTINE UPDATE_EXCLUDE - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'U - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMN - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - DATA SCRATCH_B1/0/,NINCLUDE/0/,EXC_CHANGED/.FALSE./ - - CHARACTER TODAY*24G - - DIMENSION BTIM(2) - - IF (.NOT.EXC_CHANGED) RETURNR - EXC_CHANGED = .FALSE. - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'F - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH)R - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)D - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THENE - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (.NOT.(IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ.E - & INPUT(:MIN(TRIM(FOLDER_NAME)+1,ILEN)).AND.INPUT(:1).NE.':' - & .AND.INDEX(INPUT,':defaults:').EQ.0)) THEN - IF (IER.EQ.0) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DOD - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOMU - - RETURNI - END - - - - - SUBROUTINE SET_CUSTOM(PARAM) -C_ -C SUBROUTINE SET_CUSTOM -CL - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMITT - DATA EXCLUDE_LIMIT /0/B - - CHARACTER*(*) PARAM - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'( - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)D - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN( - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IFS - - LENP = LEN(PARAM) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0.AND.PARAM(:LENP).NE.INPUT(2:LENP+1)) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)E - END IF - END DO - - IF (CLI$GET_VALUE('SET_PARAM2',INPUT,ILEN)) THENF - WRITE (4,'(A)',IOSTAT=IER) ':'//PARAM(:LENP)//':'//INPUT(:ILEN)J - END IF - - IF (PARAM.EQ.'exclude_limit') - & DECODE(ILEN,'(I)',INPUT(:ILEN)) EXCLUDE_LIMITT - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - CALL CHECK_CUSTOM - - RETURN - ENDN - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'( - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./M - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGEDE - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORYT - CHARACTER*64 FILE_DIRECTORY - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT. - DATA EXCLUDE_LIMIT /0/S - - DIMENSION BTIM(2) - - FILE_DIRECTORY = ' 'S - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THEN - BULL_USER_CUSTOM = .FALSE. - ELSEN - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IFT - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - OPEN(UNIT=17,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURNM - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?M - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head/ - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER)I - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IFN - - NINCLUDE = 0 - OLD_FORMAT = .FALSE.T - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ. - & OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+1,OLEN))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL LOWERCASE(OLD_BUFFER)T - IF (INDEX(OLD_BUFFER(TRIM(FOLDER_NAME)+2:),'defaults') - & .EQ.1) THENE - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - OLD_FORMAT = OLD_FORMAT.OR.(.NOT.IER1)E - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXCE - & .OR.EXC.EQ.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1 - ELSE - EXC_CHANGED = .TRUE. - END IF - END IFL - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - IF (INDEX(OLD_BUFFER,':file_directory').GT.0) - & FILE_DIRECTORY = OLD_BUFFER(17:) - IF (INDEX(OLD_BUFFER,':exclude_limit').GT.0) THEN U - DECODE(OLEN-15,'(I)',OLD_BUFFER(16:),IOSTAT=IER1) - & EXCLUDE_LIMIT - EXCLUDE_LIMIT = MIN(999,EXCLUDE_LIMIT) - END IF_ - END IF - END DOR - - CLOSE (UNIT=17) - F - IF (OLD_FORMAT) CALL CHECK_EXCLUDES - - RETURN - END - - - - B - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1)U - - IMPLICIT INTEGER (A-Z)P - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMT - DATA BULL_USER_CUSTOM/.FALSE./N - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - CHARACTER*(*) STRING,STRING1N - - CHARACTER*12 EXFROM - - INCLUDE_MSG = .TRUE. - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURNS - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME)B - - INC = .FALSE. - - DO I=1,NINCLUDE - OLD_SCRATCH_B = SCRATCH_B_ - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)) - OLEN = TRIM(OLD_BUFFER)E - IF (STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THENT - IF (.NOT.INC) INCLUDE_MSG = .FALSE. - INC = .TRUE. - END IF_ - - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - T - MATCH = .FALSE. - IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:')) THEN, - CALL GET_FROM(EXFROM,OLD_BUFFER(FLEN+15:), - & TRIM(OLD_BUFFER(FLEN+15:)))A - LS = TRIM(STRING) - IF ((TRIM(OLD_BUFFER)-FLEN-14.EQ.LS.AND.( - & STRING.EQ.OLD_BUFFER(FLEN+15:)).OR.STREQ(FROM,EXFROM)) - & MATCH = .TRUE. - ELSE IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND. - & STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER - & (FLEN+18:BLIMIT))) THENT - MATCH = .TRUE.- - END IF= - IF (MATCH.AND..NOT.INC) THENI - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXC.OR.E - & EXC.EQ.0) THENP - IF (OLD_BUFFER(BLIMIT+1:BLIMIT+1).EQ.':') EXC = -1 - CALL ADD_EXCL(OLD_BUFFER,BLIMIT,EXC) - CALL WRITE_QUEUE(%VAL(OLD_SCRATCH_B),OLD_SCRATCH_B, - & OLD_BUFFER)I - EXC_CHANGED = .TRUE. - INCLUDE_MSG = .FALSE.U - END IFD - RETURN - END IF_ - END IF - END DOM - - RETURN - END - - - - FUNCTION STRFIND(STRING,STRING1)T - - IMPLICIT INTEGER (A-Z)M - - CHARACTER*(*) STRING,STRING1L - - L = LEN(STRING1)E - DO I=0,LEN(STRING)-LE - J = 1I - DO WHILE (J.LE.L)C - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J)))T - IF (DIFF.NE.0.AND.DIFF.NE.32) THENI - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = .TRUE. - RETURN - ELSE - J = J + 1, - END IF - END DO - END DO - - STRFIND = .FALSE. - - RETURN - END - - - - - SUBROUTINE SHOW_EXCLUDE(TYPE) - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMT - DATA BULL_USER_CUSTOM/.FALSE./N - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGEDT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) THENT - IF (TYPE.EQ.0) WRITE (6,'('' There are no excludes.'')') - IF (TYPE.EQ.1) WRITE (6,'('' There are no includes.'')') - RETURN - END IFI - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME)T - - FOUND = .FALSE. - - L = 1 - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)L - OLEN = TRIM(OLD_BUFFER)M - IF (STREQ(FOLDER_NAME(:FLEN)//':',OLD_BUFFER(:MIN(FLEN+1,OLEN))) - & .AND.((TYPE.EQ.1.AND.STREQ(OLD_BUFFER(FLEN+2:FLEN+8), - & 'INCLUDE')).OR.(TYPE.EQ.0.AND.STREQ( - & OLD_BUFFER(FLEN+2:FLEN+8),'EXCLUDE')))) THEN - IF (.NOT.FOUND) THENT - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'Excludes for '_ - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'Includes for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - FOUND = .TRUE. - END IF - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1)N - IF (BLIMIT+5-FLEN.GT.PAGE_WIDTH.AND.L+2.GT.PAGE_LENGTH-1) THENA - L = L + 2' - ELSEA - IF (L.EQ.0) THEN - WRITE (6,'(''+'',A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - ELSE1 - WRITE (6,'(1X,A,$)') OLD_BUFFER(FLEN+10:I - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - END IF - IF (OLD_BUFFER(BDATE+1:BDATE+1).EQ.'-') - & OLD_BUFFER(BDATE:) = ' '//OLD_BUFFER(BDATE:) - OUTLEN = MIN(BLIMIT,PAGE_WIDTH+FLEN+9)-FLEN-9 - IF (OUTLEN.GT.PAGE_WIDTH-16) THEN - WRITE (6,'(1X,X,A,1X,I3)')O - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXCE - L = L + 2F - ELSE. - WRITE (6,'(''+'',X,A,1X,I3)')P - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC0 - L = L + 1 - END IF - END IF - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1) THENN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & INPUT(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF( - END IF - END DOI - - IF (.NOT.FOUND) THENE - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'No excludes found for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'No includes found for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - END IF - - RETURNI - END - - - - SUBROUTINE SET_NEWNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)( - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX)_ - - CHARACTER*12 NEW,OLDA - - IF (.NOT.SETPRV_PRIV()) THEN1 - WRITE (6,'('' ERROR: No privs to set a new name.'')') - RETURN - END IF1 - - CALL CLI$GET_VALUE('OLDNAME',OLD,LENO)R - CALL CLI$GET_VALUE('NEWNAME',NEW,LENN)= - - CALL OPEN_BULLUSER_SHARED - - TEMP_USER = USERNAMED - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY - END DO - - IF (IER.EQ.0) THENE - USERNAME = NEW - DO WHILE (REC_LOCK(IER))' - READ (4,IOSTAT=IER,KEYEQ=NEW) - END DO ) - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) USER_ENTRY - ELSE - REWRITE (4,IOSTAT=IER) USER_ENTRY - END IF I - END IF - - USERNAME = TEMP_USERT - DO WHILE (REC_LOCK(IER1))( - READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY - END DO - - CALL CLOSE_BULLUSER - - IF (IER.NE.0) THENE - WRITE (6,'('' ERROR: Old name not found.'')') - RETURN - END IF' - - CALL OPEN_BULLINF_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THENN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSEF - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN/ - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSEK - DO WHILE (REC_LOCK(IER))I - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO)))S - NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN))) - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - IF (LENO.GT.1) THEN - OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1)))I - ELSE' - OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2)))N - END IF - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - IF (LENN.GT.1) THEN - NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1))) - ELSEE - NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))) - END IFR - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEND - DO WHILE (REC_LOCK(IER))E - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE( - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO = - IF (IER.EQ.0) DELETE (9) - END IFD - - CALL CLOSE_BULLINFN - - RETURN - END. - - - SUBROUTINE CHECK_EXCL(BUFFER,L,EXC,BLIMIT,BDATE,IER)( - - IMPLICIT INTEGER (A-Z) - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - - CHARACTER*(*) BUFFER - - DIMENSION BTIM(2) - - BLIMIT = L - BDATE = L+3 - - IER = BUFFER(L:L).EQ.':'V - IF (IER) THEN - I = LAST_INDEX(BUFFER(:L-1),':') - IF (I.GT.0) THEN - J = LAST_INDEX(BUFFER(:I-1),':') - IF (J.GT.0) THEN( - IF (J.LT.I-1) THENS - DECODE(I-J-1,'(I)',BUFFER(J+1:I-1),IOSTAT=IER) EXCE - IER = IER.EQ.0 - ELSEA - EXC = EXCLUDE_LIMITL - END IFU - IF (IER) BLIMIT = J - 1 - CALL STR$UPCASE(BUFFER(I+1:L-1),BUFFER(I+1:L-1))A - IF (IER) IER = SYS_BINTIM(BUFFER(I+1:L-1),BTIM) - BDATE = I + 1 - END IFO - ELSE - IER = .FALSE. - END IF - END IF3 - - IF (.NOT.IER.AND.STRFIND(BUFFER,':exclude:')) - & CALL ADD_EXCL(BUFFER,L,-1)= - - RETURN - END - - - - SUBROUTINE ADD_EXCL(BUFFER,L,EXC) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2) - - CHARACTER*(*) BUFFER - - CHARACTER TODAY*24G - - IF (EXC.EQ.-1) THEN - BUFFER = BUFFER(:L)//':' - ELSEL - BUFFER = BUFFER(:L)//':' - WRITE (BUFFER(L+2:),'(I3)') EXCR - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - END IFI - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - BUFFER = BUFFER(:TRIM(BUFFER))//':'//TODAY(:INDEX(TODAY,' ')-1)//':' - - L = TRIM(BUFFER)A - - RETURN' - END E diff --git a/decus/vlt95b/bulletin/bulletin2.for b/decus/vlt95b/bulletin/bulletin2.for deleted file mode 100644 index 75bcdbc..0000000 --- a/decus/vlt95b/bulletin/bulletin2.for +++ /dev/null @@ -1,2559 +0,0 @@ -C -C BULLETIN2.FOR, Version 7/20/95 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::'.OR.NEWS_FEED()) THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'('' WARNING: Account used by other folder.'', - & '' If you specify the same account,'')') - WRITE (6,'('' you must specify the address'', - & '' of the mailing list in the folder description.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to make this change? ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) THEN - CALL CLOSE_BULLUSER - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Specified file cannot be opened.'')') - RETURN - END IF - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.EQ.0) THEN - INFROM = INPUT(:ILEN)//',' - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (MSG_OWN) THEN - ILEN = TRIM(INPUT) - 6 - INFROM = INFROM(:LENFRO)//INPUT(7:) - CALL ADD_PROTOCOL(INFROM(LENFRO+1:),ILEN) - LENFRO = LENFRO + ILEN - END IF - IF (EDIT.AND.TEXT) THEN - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:TRIM(INPUT)-1) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:TRIM(INPUT))//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_P = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LEN_P.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') BULL_PARAMETER(:LEN_P)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THEN - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - IER = 0 - END IF - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')') - END IF - END IF - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IF - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (.NOT.FILESPEC) THEN - WRITE (6,'('' Enter message: End with ctrl-z,'', - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - ELSE - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IF - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IF - END IF - END IF - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No message added.'')') - IF (.NOT.STATUS) THEN - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ') - IF (STREQ(INPUT(:1),'Y')) THEN - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV') - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IF - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C -C SUBROUTINE ADD_SIGNATURE -C -C FUNCTION: Adds signature to message being mailed/posted. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATURE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/ - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURN - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) RETURN - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IF - - ICOUNT = 0 - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME))) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THEN - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END DO - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IF - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE. - ELSE - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' ' - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - END DO - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,INPUT1 - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.DIFF.NE.32) RETURN - END DO - - STREQ = .TRUE. - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -C -C SUBROUTINE RESPOND_MAIL -C -C FUNCTION: Sends mail to address. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,INDESCRIP*(LINE_LENGTH) - - PRIVS = FILE.NE.'SYS$LOGIN:BULL.SCR' - - INDESCRIP = SUBJECT - LENDES = TRIM(INDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES) - IF (INDESCRIP(I:I).EQ.'"') THEN - IF (LENDES.EQ.LINE_LENGTH) THEN - INDESCRIP(I:I) = '`' - ELSE - INDESCRIP = INDESCRIP(:I)//'"' - & //INDESCRIP(I+1:) - I = I + 1 - LENDES = LENDES + 1 - END IF - END IF - I = I + 1 - END DO - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0 - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD) - IF (PRIVS) CALL DISABLE_PRIVS - - IF (LISTSERV) THEN - IF (SYS_TRNLNM('MX_NODE_NAME',MAILER)) THEN - REPLY_TO = .NOT.SYS_TRNLNM('MX_REPLY_TO',MAILER) - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - REPLY_TO = .NOT.SYS_TRNLNM('PMDF_REPLY_TO',MAILER) - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - END IF - END IF - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO) - & //'""" """'//INDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IF - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//INDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE - I = INDEX(SENDTO,'%""') + 3 - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THEN - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THEN - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THEN - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & INDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) -C -C Use the following if you do not have VMS V5.3 or greater. -C -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//INDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IF - - IF (PRIVS) CALL ENABLE_PRIVS - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV) THEN - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('PMDF_REPLY_TO') - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('MX_REPLY_TO') - END IF - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: CHANGE command subroutine. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWER - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IF - -C -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')') - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')') - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - LENFROM = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description header - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT, - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2100' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2100' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10) - - CHARACTER GROUP*80,STAT*4 - - EXTERNAL CLI$_ABSENT - - IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SEARCH_LEN(1) = 3 - SEARCH_NUM = 1 - NFOLDER = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - SEARCH_NUM = 1 - NFOLDER = 1 - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1 - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM) - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1 - NFOLDER = 1 - ELSE - IF (NFOLDER.EQ.0) NFOLDER = 1 - SEARCH_STRING = ' ' - END IF - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - END IF - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME - NFOLDER = NFOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DO - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - SCRATCH_F = SCRATCH_F1 - NFOLDER = NFOLDER + 1 - END IF - - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - OLD_BUFFER = ' ' - END IF - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - END IF - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IF (NFOLDER.NE.0) FOUND = 0 - - CHANGE = .FALSE. - IF (CLI$PRESENT('REPLY').OR. - & TRIM(SEARCH_STRING).GT.0) THEN - REVERSE = CLI$PRESENT('REVERSE') - ELSE - REVERSE = .FALSE. - END IF - - DO WHILE (NFOLDER.NE.0.AND.FOUND.LE.0.AND.FOUND.GT.-3) - IF ((NFOLDER.GT.0.AND.(.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1)).OR. - & (NFOLDER.LT.0.AND.OLD_BUFFER.NE.' ')) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL, - & REVERSE,CLI$PRESENT('SUBJECT') - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'), - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),CHANGE) - IF (FOUND.LE.0.AND.FOUND.GE.-2) THEN - NFOLDER = NFOLDER - 1 - IF (NFOLDER.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F, - & FOLDER1_NAME) - END IF - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - END IF - END DO - ELSE IF (NFOLDER.LT.0) THEN - NFOLDER = NFOLDER + 1 - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - IF (GFOUND) THEN - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - GFOUND = .FALSE. - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - END IF - ELSE - NFOLDER = 0 - END IF - END DO - CALL CLOSE_BULLFOLDER - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - END IF - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - NFOLDER = 0 - END IF - CALL CANCEL_CTRLC_AST - END IF - END IF - END DO - - IF (FOUND.EQ.-3) FOUND = 0 - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - IF (CHANGE) THEN - WRITE (6,'('' No matches found in current folder: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' No matches found.'')') - END IF - ELSE IF (FOUND.EQ.-2) THEN - IF (CHANGE) THEN - WRITE (6,'('' ERROR: No more messages in current folder: '' - & ,A)') FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' ERROR: No more messages.'')') - END IF - END IF - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN, - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE,CHANGE) -C -C SUBROUTINE GET_SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEXT/ NEXT - LOGICAL NEXT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*4 SAVECMD - - CHARACTER*128 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - OLD_REVERSE = REVERSE - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THEN - OLD_REVERSE = REVERSE - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(BULL_POINT,IER) - IF (BULL_POINT+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (STREQ(DESCRIP(:4),'RE: ').AND.TRIM(DESCRIP).EQ. - & LEN(DESCRIP)) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - SEARCH_STRING = INPUT(11:) - SEARCH_STRING = SEARCH_STRING(:LEN(DESCRIP)) - ELSE - SEARCH_STRING = DESCRIP(5:) - END IF - ELSE IF (STREQ(DESCRIP(:4),'RE: ')) THEN - SEARCH_STRING = DESCRIP(5:) - END IF - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - ELSE - SEARCH_NUM = OLD_SEARCH_NUM - IF (SEARCH_LEN(1).EQ.0) SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (OLD_REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - OLD_SEARCH_NUM = SEARCH_NUM - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.CHANGE.OR. - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last - END IF - IF (REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - SEARCH_STRING = ' ' - RETURN - END IF - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0 - BULL_SEARCH = START_BULL+1 - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR. - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY) - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - ELSE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - IF (IER.EQ.0) THEN - IER = BULL_SEARCH + 1 - ELSE - GO TO 800 - END IF - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - IF (SEARCH_MODE.EQ.4) THEN - CALL STR$UPCASE(DESCRIP1,FROM) - ELSEo - IF (LEN(DESCRIP).EQ.TRIM(DESCRIP)) THEN - IF (REMOTE_SET) THENt - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTES - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER)I - IF (IER.GT.0) GO TO 900O - END IF - END IFC - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)T - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENI - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENI - DESCRIP1 = INPUT(7:)M - END IF - CALL STR$UPCASE(DESCRIP1,DESCRIP1) - ELSEl - CALL STR$UPCASE(DESCRIP1,DESCRIP) - END IF - END IFB - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (TRIM(SEARCH_STRING).EQ.LEN(DESCRIP).AND.' - & DESCRIP1(:LEN(DESCRIP)).EQ.SEARCH_STRING).OR. - & (INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1.AND. - & STREQ(DESCRIP1(:4),'RE: '))))) THEN - IF (.NOT.NEGATED) THEN1 - FOUND = BULL_SEARCH_ - GO TO 900D - END IF - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')')' - FOUND = -3I - GO TO 900 - ELSE IF (NEGATED) THEN E - FOUND = BULL_SEARCH - GO TO 900 - END IFt - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THENE - IF (REMOTE_SET) THENE - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTEM - GO TO 900B - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900B - END IF - END IF& - ILEN = LINE_LENGTH + 1R - MATCHES = 0 - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE. - END DOy - DO WHILE (ILEN.GT.0)' - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)' - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THEN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I)o - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR.I - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THENA - FOUND = BULL_SEARCHi - IF (.NOT.NEGATED) GO TO 900e - ELSE IF (FLAG.EQ.1) THENN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900e - END IFl - END DOr - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSEd - FOUND = -1 - END IF - END IF - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULL - END DO - -800 FOUND = 0C - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - NEXT = .FALSE. - CALL READDIR(BULL_POINT,IER) - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTEA - ELSE - CALL GET_REMOTE_MESSAGE(IER)_ - END IF - END IFC - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file readR - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLc - - IF (.NOT.IER1) SEARCH_STRING = ' ' - NEXT = .FALSE.S - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMDH - - RETURN - END - - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE) - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRINGB - D - OLD_MATCH = .FALSE.= - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURN, - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE. - RETURN - END IF_ - J = J + SEARCH_LEN(I)T - END DO_ - - RETURNN - END - - - - SUBROUTINE UNDELETE -C6 -C SUBROUTINE UNDELETE -Cn -C FUNCTION: Undeletes deleted message.B -CI - IMPLICIT INTEGER (A - Z)B - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'I - - INCLUDE 'BULLFOLDER.INC'P - - EXTERNAL CLI$_ABSENTN - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')')F - RETURN - END IFF -CE -C Get the bulletin number to be undeleted. -CT - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I)B - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IFU - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the userS -C is permitted to delete the bulletin._ -CL - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,E - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner?S - WRITE(6,1040) ! Then error out.z - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?C - WRITE(6,1030) ! If not, then error outO - GOTO 100 - END IFM - END IF - END IFS - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:11).LT.'1900') EXDATE(8:9) = '19' - IF (EXDATE(8:11).LT.'1995') EXDATE(8:9) = '20' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'21'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'21'//EXDATE(10:)* - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration dateO - WRITE (6,'('' Message was undeleted.'')')1 - ELSE8 - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)G - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSEA - WRITE (6,'('' Message was undeleted.'')')M - END IF* - ELSE - CALL DISCONNECT_REMOTE( - END IF - END IFO - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010)U - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.')O -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.')E - - END - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z)A - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL) - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - I = INDEX(INPUT,'<')R - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - INPUT = INPUT(INDEX(INPUT,'<')+1:) ! personal-name D - END IF - - IF (LMAIL.EQ.0) THENa - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN( - MAIL_PROTOCOL = MAILERC - END IF - LMAIL = TRIM(MAIL_PROTOCOL)I - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%' - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1 - RETURN - END IF - END IF_ - - I = INDEX(INPUT,'@')O - IF (I.GT.0) INPUT = INPUT(:INDEX(INPUT(I:),' ')+I-2)S - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"'L - - IF (ILEN.NE.0) ILEN = TRIM(INPUT) - - RETURN - END diff --git a/decus/vlt95b/bulletin/bulletin3.for b/decus/vlt95b/bulletin/bulletin3.for deleted file mode 100644 index e1813d6..0000000 --- a/decus/vlt95b/bulletin/bulletin3.for +++ /dev/null @@ -1,2476 +0,0 @@ -C -C BULLETIN3.FOR, Version 6/6/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2100' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2100' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2100 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2100 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_EDT' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THEN - CALL EDT$EDIT('NL:',OUT) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT) - ELSE - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IF - END IF - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT - ELSE - WRITE(6,'('' Could not activate editor.'')') - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE) - - RETURN - END - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - NOW = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - IF (.NOT.NOW) NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - CALL SYS$SETAST(%VAL(0)) - CALL REGISTER_BULLCP - IER1 = 1 - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - - BBOARD_LOOP = BBOARD_LOOP + 1 - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & (NEWS_LOOP.EQ.0.OR.NOW)) THEN - IF (NOW) THEN - CALL CREATE_PROCESS('BULLCP NEWS1') - ELSE - CALL CREATE_PROCESS('BULLCP NEWS') - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - - NOW = .FALSE. - - NEWS_LOOP = NEWS_LOOP + 1 - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIME - CALL HIBER('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - DIMENSION NEW_SYSTEM_FLAG(FLONG) - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2)) - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER) - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - CALL SETUSER(USERNAME) - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAG - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - END DO - FOLDER_FLAG = FOLDER1_FLAG - FOLDER_NUMBER = 0 - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - CALL CLOSE_BULLUSER - ELSE - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DO - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IF - CLOSE (UNIT=REMOTE_UNIT) - END DO - END IF - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE HIBER(MIN) -C -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -C -C SUBROUTINE DELETE_EXPIRED_NEWS -C -C FUNCTION: -C -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - CHARACTER*4 GET_VMS_VERSION - - INTEGER TODAY(2),NEXT_EX_BTIM(2),NO_EXPIRE(2) - - CHARACTER*8 TODAY_KEY,TEMP - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - IF (.NOT.NOW) THEN - IER = SYS$SETPRN('BULL NEWS1') - IF (.NOT.IER) CALL EXIT - IER = SYS$SETPRN('BULL NEWS') - IF (.NOT.IER) CALL EXIT - END IF - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - CALL SYS_BINTIM('-',TODAY) - - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - REMOTE_SET = 4 - - INPUT = GET_VMS_VERSION() - IF (INPUT(:2).EQ.'V5'.OR.INPUT(:2).EQ.'V4') VMSOLD = .TRUE..AND.NOW - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER).OR.(VMSOLD.AND.IER.EQ.0.AND. - & (.NOT.BTEST(NEWS_F_FLAG,8).OR. - & COMPARE_BTIM(TODAY,NEWEST_EXBTIM).LT.0))) - IF (VMSOLD) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - ELSE - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END IF - END DO - CALL NEWS_TO_FOLDER - - UNLOCK 7 - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - GO TO 1000 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,8)) GO TO 900 - - CALL OPEN_BULLDIR_SHARED - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0 - NDEL = -1 - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM) - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. - IF (NDEL.GT.NEWS_F_END) THEN - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1 - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (EXDATE(8:11).LT.'1995') THEN ! Deleted manually? - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) - EXTIME = ASCTIME(13:23) - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0 - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0 - UNLOCK 2 - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER) - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_START - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - IF (I.LE.F_NBULL) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0 - END DO - F_START = I - NEXT = .FALSE. - END IF - CALL READDIR(F_NBULL,IER) - IF (F_START.LT.F_NBULL.AND.(DN.OR.F_NBULL.EQ.IER)) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I) - I = I - 1 - IF (I.GE.F_START) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = I - END DO - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLDIR - END DO - -900 CALL CLOSE_BULLNEWS - -1000 IF (NOW.OR.IER.EQ.0) THEN - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.*]'//'*.' - INPUT = GET_VMS_VERSION() - CALL LIB$DAY_OF_WEEK(TODAY,DAY) - IF (DAY.NE.7) THEN - IER = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - IF (IER) THEN - DAY = 7 - CALL DELLNM('BULL_NEWS_CLEANUP') - END IF - END IF - IF (INPUT(:2).NE.'V5'.AND.INPUT(:2).NE.'V4') THEN - CONTEXT = 0 - DO WHILE (LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT)) - IER = CONV$RECLAIM(INPUT(:TRIM(INPUT))) - END DO - ELSE IF (DAY.EQ.7) THEN - REMOTE_SET = 4 - DIRLIST = .TRUE. - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(1000,IER) - CALL READ_FOLDER_FILE(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NO_EXPIRE) - DO WHILE (IER.EQ.0) - UNLOCK 7 - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - C = 0 - IF (LIB$FIND_FILE(BULLNEWSDIR_FILE - & (:TRIM(BULLNEWSDIR_FILE))//';1',INPUT,C)) THEN - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';2') - ELSE - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - END IF - CALL OPEN_BULLDIR_SHARED - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE,SHARED, - & BUFFERCOUNT=127, - & INITIALSIZE=(NEWSDIR_RECORD_LENGTH*F_COUNT)/512, - & STATUS='NEW',FORM='UNFORMATTED',DISPOSE='DELETE', - & RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,IOSTAT=IER, - & ORGANIZATION='INDEXED',RECORDTYPE='FIXED', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - END IF - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (2,IOSTAT=IER) NEWSDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - WRITE (9,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - ELSE - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY), - & %DESCR(EX_BTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & CALL COPY2(NEWEST_EXBTIM,EX_BTIM) - END IF - END IF - END DO - CLOSE (UNIT=9,DISPOSE='KEEP') - CALL CLOSE_BULLDIR_DELETE - CALL GET_MSGKEY(NEWEST_EXBTIM,TEMP) - IF (TEMP.NE.NEWS_F_EXPIRED_DATE) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - NEWS_F_EXPIRED_DATE = TEMP - CALL REWRITE_FOLDER_FILE(IER) - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - END IF - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - ELSE - IF (NO_EXPIRE(1).NE.NEWEST_EXBTIM(1).OR. - & NO_EXPIRE(2).NE.NEWEST_EXBTIM(2)) THEN - CALL GET_MSGKEY(NO_EXPIRE,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - ELSE - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - END IF - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';') - END DO - END IF - CALL READ_FOLDER_FILE(IER) - END DO - CALL CLOSE_BULLNEWS - END IF - DIRLIST = .FALSE. - NEWSLIST = .TRUE. - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - IER = .TRUE. - DO WHILE (IER) - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;') - IER = INDEX(FOLDER_FILE,']1JAN').EQ.0 - END DO - J = INDEX(FOLDER_FILE,']') - DECODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) THEN - DO I=1,10 - YEAR = YEAR - 1 - IF (YEAR.EQ.-1) YEAR = 99 - ENCODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) IER = LIB$DELETE_FILE(FOLDER_FILE(:J) - & //'*.*;*') - END DO - END IF - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IF - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/,HEADER_Q1/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(HEADER_Q1,INPUT) - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'READ/NEW' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - - NHEAD = 0 - HEADER_Q = HEADER_Q1 - IER = 0 - CALL STRIP_HEADER(' ',0,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.EQ.0) THEN - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP) - IF (STRIP.AND.INPUT(:5).EQ.'From:') INFROM = ' ' - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - NHEAD = NHEAD + 1 - END IF - END DO - -C -C If more than one folder has same BBOARD account, don't use the -C To: line to determine which folder to put the mail message in. -C - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - DUP = .FALSE. - DO WHILE (.NOT.DUP.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - DUP = FOLDER.NE.FOLDER1.AND.FOLDER_BBOARD.EQ.FOLDER1_BBOARD - END DO - IF (DUP.OR..NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - FOUND = .FALSE. - J = 0 - IF (DUP) J = 1 - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THEN - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - FOUND = INTO.EQ.F_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - END IF - FLEN = TRIM(F_BBOARD) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DO - END IF - END IF - END DO - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COM - END IF - - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - ELSE - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - ELSE - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL SYS$SETAST(%VAL(1)) - IF (.NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) - & CALL NEWS2BULL(.FALSE.) - END IF - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE. - - LEN_BBOARD = LEN(BBOARD) - 1 - - DO I=1,TRIM(INPUT)-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND. - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND. - & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR. - & (INDEX('@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0 - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND. - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALPHA(IN) - - CHARACTER*(*) IN - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURN - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN - - BBOARD_NAME = FOLDER_DESCRIP(I+1:) - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!') - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DO - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - IF (INDEX(IMAGENAME,';').GT.0) ILEN = INDEX(IMAGENAME,';') - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0) - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - IF (.NOT.IER.AND..NOT.DEL) THEN - CALL DELPRC('BULLCP NEWS',DEL) - IER = .NOT.DEL - ELSE - IER = .TRUE. - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI) -C -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL ADD_2_ITMLST(4,JPI$_ENQLM,%LOC(ENQLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF - END IF - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_ENQLM - CALL LIB$MOVC3(4,ENQLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2)) - - RETURN - END - - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - CHARACTER*4 FUNCTION GET_VMS_VERSION -C -C FUNCTION GET_VMS_VERSION -C -C FUNCTION: Gets VMS version -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER VERSION*4 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,SYI$_NODE_SWVERS,%LOC(VERSION)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - GET_VMS_VERSION = VERSION - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DO - - CALL CLOSE_BULLDIR - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'F - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER))A - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DOB - - IF (IER.NE.0) THENF - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0r - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTEd - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAMM - - DATA OBIO/0/,OCPU/0/,ODIO/0/D - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAM - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list, - P - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU))n - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IFM - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1t - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM)6 - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.1 - END DO - END IFo - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND. - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIOO - ODIO = DIOw - OCPU = CPUe - IER = 0 - RETURNO - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IF - RETURN - END diff --git a/decus/vlt95b/bulletin/bulletin4.for b/decus/vlt95b/bulletin/bulletin4.for deleted file mode 100644 index a4a1582..0000000 --- a/decus/vlt95b/bulletin/bulletin4.for +++ /dev/null @@ -1,2199 +0,0 @@ -C -C BULLETIN4.FOR, Version 4/19/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(BUFFER,0,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' ') THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - ELSE - IF (.NOT.HEADER) THEN - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - STRIP = .FALSE. - END IF - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - IER = 0 - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - CALL STR$UPCASE(FOLDER,FOLDER) - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '', - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAX - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - LENDES = 0 - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACL - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_NAME = FOLDER - FOLDER_OWNER = FOLDER1_OWNER - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -C -C Description: -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -C -C SUBROUTINE CREATE_NEWS_FOLDER -C -C FUNCTION: Creates a new newsgroup. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME) - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF -C -C If file specified in command, read file. -C Else, read from the terminal. -C - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file -2010 FORMAT(A) - ICOUNT = ICOUNT + ILEN - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER, - & 'Adding newsgroup.') - CLOSE (UNIT=3) - - RETURN - -920 WRITE(6,1020) -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURN - -910 WRITE(6,1010) -1010 FORMAT (' No news group was added.') - CLOSE (UNIT=3) - RETURN - - END - - - - - SUBROUTINE INIT_COMPRESS - - IMPLICIT INTEGER (A-Z) - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127 - DO J=0,127 - A(J,I) = ' ' - END DO - END DO - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DO - - J = 1 - DO I=1,8 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=10,31 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=127,254 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - - RETURN - - ENTRY COMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.126) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.126) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:))) - IF (T(O:O).NE.' ') THEN - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND. - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1)) - C = C + 1 - K = K + 1 - END DO - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1) - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0) - O = O + 1 - ELSE - T(O:O) = IN(K:K) - IF (ICHAR(T(O:O)).LT.9.OR.(ICHAR(T(O:O)).GT.9.AND. - & ICHAR(T(O:O)).LT.32)) T(O:O) = ' ' - K = K + 1 - O = O + 1 - END IF - END DO - IF (K.EQ.L) THEN - T(O:O) = IN(K:K) - ELSE - O = O - 1 - END IF - - OUT = T - - RETURN - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1 - T(O:O) = IN(I+2:I+2) - END DO - I = I + 3 - ELSE - B = UNMAP(J) - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1 - T(O:O) = IN(I:I) - ELSE - O = O + 2 - T(O-1:O) = B - END IF - I = I + 1 - END IF - END DO - - OUT = T(:O) - - RETURN - END diff --git a/decus/vlt95b/bulletin/bulletin5.for b/decus/vlt95b/bulletin/bulletin5.for deleted file mode 100644 index e762265..0000000 --- a/decus/vlt95b/bulletin/bulletin5.for +++ /dev/null @@ -1,2503 +0,0 @@ -C -C BULLETIN5.FOR, Version 9/13/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3) THEN - CALL SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - RETURN - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - NODEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (NODEFAULT) THEN - IF (NOTIFY.NE.-1) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) THEN - CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - END IF - REWRITE(4) USER_HEADER - ELSE IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & (FOLDER1_NUMBER.EQ.0.AND.FOLDER1_BBOARD(:2).NE.'::')) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - IF (FOLDER1_NUMBER.NE.0.OR.FOLDER1_BBOARD(:2).NE.'::') THEN - ! Test is due to bug which changes folder number to zero - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG - IF (BTEST(FOLDER1_FLAG,2)) THEN - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAG - FOLDER_NUMBER = TEMP_NUMBER - END IF - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - CALL UPDATE_EXCLUDE - - CALL UPDATE_USERINFO - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET').OR.(INCMD(:3).EQ.'SEA') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & (F1_START.GT.0.OR.F_START.LE.F_NBULL)) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_COUNT = F1_COUNT - IF (F1_START.GT.0) THEN - IF (F1_NBULL.LT.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER-1.GE.F1_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - ELSE - F_NBULL = F1_NBULL - END IF - F_START = F1_START - ELSE - F_START = F_NBULL + 1 - END IF - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - REMOTE_SET_NEW = 1 - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - IF (COMMAND.AND.INCMD(:3).NE.'REP'.AND. - & INCMD(:3).NE.'DEL') HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER1) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.IER1.EQ.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11).AND.WRITE_ACCESS) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s news group.'')') - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP( - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE IF (REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - ELSE IF (REMOTE_SET.EQ.3.OR.REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN - WRITE (6,'('' Folder only accessible for reading.'')') - END IF - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THEN - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - BULL_PARAMETER = 'MARKED' - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - BULL_PARAMETER = 'SEEN' - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED' - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN' - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - WRITE(6,'('' WARNING: No '',A, - & '' messages found.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IF - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE. - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - LAST_FOLDER_NUMBER = FOLDER_NUMBER - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IF - - IF (TEST_NEWS(FOLDER1)) THEN - INCMD = 'SET NEWS ' - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL ' - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Access is limited.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0) - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,10)) THEN - WRITE (6,'('' POST_ONLY has been set.'')') - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THEN - WRITE (6,'('' COMPRESS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - SLIST = INDEX(FOLDER1_DESCRIP,'<') - ELIST = INDEX(FOLDER1_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN - IF ((FOLDER1_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR. - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))).AND. - & INDEX(FOLDER_DESCRIP(SLIST+2:),'@').EQ.0) THEN - WRITE (6,'('' Last message fed by news group was: '',I)') - & F_LAST - END IF - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/, - & ' Description: ',A) -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/, - & ' Description: ',A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/ - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' ' - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. - STORED = .FALSE. - CLASS = .FALSE. - NEW = .FALSE. - PERM = .FALSE. - DEFA = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counter - NLINE = 1 - START = .FALSE. - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE. - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - CALL NEWS_LIST - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - END IF - COUNT = CLI$PRESENT('COUNT') - IF (COUNT) TOTAL_COUNT = 0 - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - NEW = CLI$PRESENT('NEWGROUPS') - CLASS = CLI$PRESENT('CLASS') - PERM = CLI$PRESENT('PERMANENT') - DEFA = CLI$PRESENT('DEFAULT') - IF (CLASS) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - ELSE IF (PERM) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE IF (DEFA) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER) - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER - FOLDER_COUNT = -1 - RETURN - ELSE - START = .TRUE. - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN) - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0 - FOLDER_COUNT = -1 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN - SUBNUM = -2 - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DECLARE_CTRLC_AST - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE. - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (PERM.OR.DEFA) THEN - IER = 1 - DO WHILE (INUM.LE.FOLDER_MAX.AND.IER.NE.0) - IF (INF_REC2(1,INUM).NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (ZEXT(INF_REC2(1,INUM)),IER) - END IF - INUM = INUM + 1 - END DO - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2 - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THEN - NEW_NEWS = FOLDER1_NUMBER - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP) - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)), - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - END IF - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - FSTATUS1 = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (.NOT.NEWS_TEST) THEN - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN - IER1 = 1 - MORE = .TRUE. - END IF - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DO - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1 - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THEN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))') - ELSE IF (CLASS) THEN - WRITE (6,'(1X,''Class'',/,1X,(''-''))') - ELSE IF (SUBSCRIBE) THEN - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,''Status'',7X, - & ''First Last'',/,1X,(''-''))') - END IF - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1 - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1.AND. - & FLAG.NE.100) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - ELSE - FSTATUS1 = ' ' - END IF - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNT - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0 - END IF - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - END IF - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IF - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER - IF (NEWS_TEST.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - CALL GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & FSTATUS1,IER,ACTIVE) - MORE = MORE.AND.FOUND - IF (MORE) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND.AND.FLAG.NE.1) FLAG = 100 - END IF - END DO - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - END IF - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNT - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSE - WRITE(6,1100) ! Else say there are more - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10) -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS.OR.CLI$PRESENT('CLASS')) THEN - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.' - END IF - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER ! Open folder file - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - CALL RESET_PROTECTION - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')') - RETURN - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0) - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER) - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE - CALL SET_FOLDER_FILE(0) - END IF - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ELSE - ID = INPUT - INPUT = ' ' - END IF - ILEN = TRIM(ID) - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IF - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*256 ACLENT - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURN - - ENTRY WRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER_COM - END IF - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DOF - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNB - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)P - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEND - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COMN - END IF - END DOU - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1C - - RETURNA - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DOC - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENH - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COML - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1$ - - RETURND - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COMF - END IF - END DO- - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1A - - RETURNI - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))A - IF (NEWS_OPEN) THENO - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COMR - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1. - - RETURNE - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER)F - - DO WHILE (REC_LOCK(IER))I - IF (NEWS_OPEN) THEN_ - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COMG - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO( - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNR - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)'T - - CHARACTER*(*) KEY_NAME) - - INCLUDE 'BULLUSER.INC'F - - CHARACTER*12 SAVE_USERNAME0 - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME' - - DO WHILE (REC_LOCK(IER))E - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAMEC - USERNAME = SAVE_USERNAME_ - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER)L - - SAVE_USERNAME = USERNAMEE - - DO WHILE (REC_LOCK(IER))G - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRYC - END DO_ - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAMES - - RETURNL - - ENTRY READ_USER_FILE_HEADER(IER)( - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DOD - - RETURNI - - ENTRY WRITE_USER_FILE_NEW(IER)T - - DO I=1,FLONGN - SET_FLAG(I) = SET_FLAG_DEF(I)C - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)S - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I)) - END DOE - - ENTRY WRITE_USER_FILE(IER)E - - DO WHILE (REC_LOCK(IER))A - WRITE (4,IOSTAT=IER) USER_ENTRYE - END DO - - RETURN. - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - B - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - t - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)T - - NEW_NEWS_ACCESS = - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS'A - - RETURNR - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - ) - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_'F - END DOE - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)Y - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C))D - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' ' - ELSE - FILE = FILE(:L) - END IF - END DO - - RETURNN - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z)P - - CHARACTER*(*) INPUT,FIND - - F = LEN(FIND)I - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURN, - END DOR - - RETURN, - END - - - - - SUBROUTINE GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & STAT,IER,ACTIVE) - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'' - - INCLUDE '($SSDEF)'t - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG' - - CHARACTER*(*) STAT,FOLDER_MATCH - - CHARACTER NEWS_ACCESS*132 - - FOUND = .FALSE. - STAR = INDEX(FOLDER_MATCH,'*')N - ONE = STAR.EQ.0.AND.TRIM(FOLDER_MATCH).GT.0 - START = .FALSE. - IF (STAR.GT.1)R - & START = FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1)W - STARTNOW = STARTN - - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - IF (ONE) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP, - & (FOLDER_MATCH(:TRIM(FOLDER_MATCH)),IER)R - FOLDER_MATCH = ' 'L - ELSE IF (STARTNOW) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMPF - & (FOLDER_MATCH(:STAR-1),IER) - STARTNOW = .FALSE.e - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - END IF - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - STAT(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - STAT = ' 'A - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(STAT(:1).NE.'x'.AND. - & .NOT.BTEST(FOLDER1_FLAG,9))).AND.S - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND.T - & (ONE.OR..NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THENB - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP)N - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2)R - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFERB - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1)T - ELSEf - FOUND1 = .TRUE. - END IF - END IFb - FOUND = FOUND1a - ELSE. - FOUND = .TRUE.E - END IFA - ELSE IF (IER.EQ.0.AND.START) THEN - IF (FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1)) RETURN - END IF - IF (ONE) RETURNA - END DON - - RETURNN - END diff --git a/decus/vlt95b/bulletin/bulletin6.for b/decus/vlt95b/bulletin/bulletin6.for deleted file mode 100644 index 92a33ac..0000000 --- a/decus/vlt95b/bulletin/bulletin6.for +++ /dev/null @@ -1,2800 +0,0 @@ -C -C BULLETIN6.FOR, Version 9/15/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - TRY = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.TRY.EQ.0) THEN - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - TRY = 1 - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL_NAME - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & BUFFERCOUNT=127, - & ORGANIZATION='INDEXED',IOSTAT=IER) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open file: '',A)') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - IF (UNIT.EQ.14) THEN - WRITE (6,'('' Database conversion in progress. Try later.'')') - ELSE - WRITE (6,'('' Please try again later.'')') - END IF - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - COMMON /NEWSLIST/ NEWSLIST - DATA NEWSLIST/0/ - - COMMON /DIRLIST/ DIRLIST - DATA DIRLIST/0/ - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - LUN = 2 - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL_NAME - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & BUFFERCOUNT=127, - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - END IF - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) WRITE(6,'(1X,A)') - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1))) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULL - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LAST - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMIT - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLNEWSDIR - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($FORIOSDEF)' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*180 TEMP - - CHARACTER BUFFER*12,DATETIME*24 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - CALL OPEN_BULLNEWS - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=180/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & BUFFERCOUNT=127,KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR]') - IF (.NOT.IER1) GO TO 900 - - NEW_FOLDER_NUMBER = 0 - - DO WHILE (IER.EQ.0) - READ (2,IOSTAT=IER) TEMP - IF (GET_INTEGER(%REF(TEMP)).NE.NEW_FOLDER_NUMBER) THEN - IF (NEW_FOLDER_NUMBER.NE.0) CLOSE (UNIT=9,DISPOSE='KEEP') - NEW_FOLDER_NUMBER = GET_INTEGER(%REF(TEMP)) - CALL SET_BULLNEWSDIR_FILE(NEW_FOLDER_NUMBER) - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE, - & STATUS='UNKNOWN',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) GO TO 900 - END IF - NEWS_MSG_NUM = GET_INTEGER(%REF(TEMP(5:))) - NEWS_MSG_BTIM_KEY = TEMP(13:) - NEWS_EX_BTIM_KEY = TEMP(89:) - NEWS_MSGID = TEMP(21:) - CALL COPY2(MSG_BTIM,%REF(TEMP(97:))) - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL LIB$MOVC3(76,%REF(TEMP(105:)),NEWS_BLOCK) - - WRITE (9,IOSTAT=IER1) NEWSDIR_ENTRY - END DO - - CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - - CALL RESET_PROTECTION - - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - - IER = LIB$RENAME_FILE(BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - & ,'BULLNEWSDIR.OLD') - - WRITE (6,'('' BULLNEWSDIR.DAT has been renamed to '', - & '' BULLNEWSDIR.OLD and may now be deleted.'')') - - RETURN - -900 CALL RESET_PROTECTION - - CALL CLOSE_BULLNEWS - - WRITE(6,'('' ERROR: Cannot convert BULLNEWSDIR.DAT'')') - IF (IER.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - - END - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(81:84) = BUFFER(85:) - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL RESET_PROTECTION - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - IF (ASK_SIZE.EQ.184) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST) - ELSE - F_LAST = 0 - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LAST - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER)) - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0 - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -C -C SUBROUTINE CONVERT_BULLNEWS -C -C FUNCTION: Converts bulletin NEWS file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. '' - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0 - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE) - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0 - NEWS_F_END = 0 - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108) - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:) - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1 - IF (LMOVE.LE.0) THEN - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP - ELSE - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE)) - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) - END IF - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SET_PROTECTION - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL RESET_PROTECTION - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXT - - COMMON /KEEPLOCK/ KEEPLOCK - DATA KEEPLOCK/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - CHARACTER*4 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSE - DIR_NUM = 0 - END IF - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURN - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEYGE=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0.AND.ICOUNT.EQ.F_START) THEN - READ(2,KEYGT=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.EQ.0) ICOUNT = NEWS_MSG_NUM - END IF - END IF - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND. - & MSG_NUM.GT.F_START) THEN - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER,IER2) - F_START = MSG_NUM - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IF - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THEN - ICOUNT = MSG_NUM - BULLETIN_NUM = ICOUNT - END IF - END IF - ELSE - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 - END IF - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END IF - END DO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IF - - IF (IER.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1 - END IF - END IF - END IF - - RETURN - - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM) - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z) - - INTEGER TEMP - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I) - END DO - - RETURN - END - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/1/ - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.2.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.2.AND.MSG_NUM.NE.0) THEN - IF (MSG_NUM.GT.NEWS_F_END) THEN - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36 - UNLOCK 2 - END IF - END IF - END IF - ELSE - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - IER = 0 - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10 - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY),%DESCR(EX_BTIM)) - IF (POSTTIME) THEN - CALL GET_MSGKEY(%REF(NEWS_POST_KEY),%DESCR(MSG_BTIM)) - CALL CONVERT_FROM_GMT(MSG_BTIM) ! Assume stored is GMT - END IF - DESCRIP = NEWS_DESCRIP - FROM = NEWS_FROM - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IF - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11) - EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME(:11) - TIME = DATETIME(13:23) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - ELSE - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IF (BULLETIN_NUM.NE.NEWS_F_END+1) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END DO - END IF - ELSE - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IF - IF (REMOTE_SET.EQ.4.AND. - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN - CALL SPECIAL_NEWSDIR_ENTRY(IER) - ELSE IF (IER.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEN - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*140 TEMP - - DIMENSION BTIM(2) - - READ (2,KEYID=3,KEY=NEWS_POST_KEY,IOSTAT=IER) TEMP - DO WHILE (IER.EQ.0.AND.NEWS_POST_KEY.EQ.TEMP(57:64)) - IF (NEWS_MSGID.EQ.TEMP(21:56)) THEN - IER = 2 - RETURN - END IF - READ (2,IOSTAT=IER) TEMP - END DO - -10 IER1 = 0 - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=0,KEYGT=NEWS_F_END, - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - DO WHILE (IER1.EQ.0) - CALL LIB$MOVC3(4,%REF(INPUT),FNUM) - CALL GET_MSGKEY(%REF(INPUT(13:)),%DESCR(BTIM)) - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IF - F_COUNT = F_COUNT + 1 - CALL LIB$MOVC3(4,%REF(INPUT),NEWS_F_END) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - END DO - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IF - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSE - F_COUNT = F_COUNT + 1 - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,MSG_BTIM) - ELSE - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - END IF - - IF (LOCAL_POST) THEN - CALL SYS_BINTIM(DATE//' '//TIME - & (:TRIM(TIME)-2)//'00',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP - NEWS_FROM = FROM - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH - NEWS_MSG_NUM = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,NEWS_MSG_BTIM_KEY) - CALL GET_MSGKEY(EX_BTIM,NEWS_EX_BTIM_KEY) - ELSE - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - - RETURN - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KEYID/ NEWS_KEYID - - COMMON /KEEPLOCK/ KEEPLOCK - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 2 - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - CALL READDIR_KEYGE(NDEL) - KEEPLOCK = .FALSE. - NEWS_KEYID = 1 - - RETURN - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII))/ - IF (ACLSTR(START_ID:START_ID).NE.','.AND.B - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE.E - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DOC - IF (ASCII) THEN - START_ID = START_ID + 1T - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1N - END_ID = INDEX(ACLSTR,'ACCESS') - 2C - END IF - END IFL - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THENY - IF (ACC_TYPE.EQ.1) THENU - WRITE (6,'(C - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(U - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IFN - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THENU - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)( - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2. - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)C - OUTLEN = 1 - ELSEU - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IFU - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DOM - - RETURNE - END - - - - - SUBROUTINE CONVERT_INFFILEL - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))5 - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THENY - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')= - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFh - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))I - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)N - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DOU - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9)1 - - RETURNT - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -CC -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another fileK -C( - IMPLICIT INTEGER (A-Z)R - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))_ - ! Get length needed to store acl outputR - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of stringO - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURNG - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C: -C SUBROUTINE COPY_ACL11 -C0 -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routinesF -C since must convert location of string into a character string. -CN - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - ! Read input file aclT - - IF (.NOT.IER) THEN: - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENTE - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,S - & %LOC(ACLENT))I - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlistF - IER = SYS$CHANGE_ACL' - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST)D - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IFR - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output fileU - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT,D - & %LOC(ACLENT(POINT:)))O - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DOv - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURNO - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./S - - IF (CHECKED) RETURN - - CHECKED = .TRUE.) - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C)' - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORYR - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE - CALL ADD_DIRECTORY(BULLNEWS_FILE)I - END IF - - CALL CHECK_DIR(FOLDER_DIRECTORY,.FALSE.) - CALL CHECK_DIR(NEWS_DIRECTORY,.FALSE.)K - - CALL ADD_DIRECTORIES - - RETURN - END - - - - SUBROUTINE ADD_DIRECTORIES - - INCLUDE 'BULLFILES.INC'E - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE)D - - RETURNE - END - - - - LOGICAL FUNCTION CHECK_DIR(DIRECTORY,LIBRARY) - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLFILES.INC'_ - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - CHECK_DIR = PRESENT(BULLUSER_FILE,DIRECTORY,TEST).AND.E - & PRESENT(BULLFOLDER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLINF_FILE,DIRECTORY,TEST) - - IF (CHECK_DIR) THEN - IF (SYS_TRNLNM(DIRECTORY,TEST)) DIRECTORY = TEST - RETURN - END IF - - TEST = ' 'M - - IF (INDEX(DIRECTORY,']').EQ.0) THEN - CALL SYS_TRNLNM(DIRECTORY,TEST1) - ELSE - TEST1 = DIRECTORY - END IF( - - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER)E - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST), - END DOU - - IF (.NOT.LIBRARY.AND.TEST.EQ.' ') THEN' - IER = SYS_TRNLNM_SYSTEM(DIRECTORY,TEST)4 - IF (.NOT.IER.AND.TEST1.EQ.DIRECTORY) RETURN, - END IF - - IF (TEST.NE.TEST1) THEN - IF (LIBRARY) THEN_ - WRITE (6,'('' ERROR: Not a valid library. '')') - RETURN' - END IF - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER)U - CLOSE(UNIT=3,STATUS='DELETE')M - CALL ENABLE_PRIVS_ - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)') - & TEST1(:TRIM(TEST1))M - CALL EXIT - END IF - DIRECTORY = TEST1S - ELSEL - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - CHECK_DIR = .TRUE. - END IFE - - RETURNW - END - - - - - LOGICAL FUNCTION PRESENT(FILE,DIR,TEST) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILE,DIR,TEST - - FILE = FILE(INDEX(FILE,':')+1:) - FILE = FILE(INDEX(FILE,']')+1:) - IF (INDEX(DIR,':').EQ.0.AND.INDEX(DIR,'[').EQ.0.AND. - & INDEX(DIR,'<').EQ.0) DIR = DIR(:TRIM(DIR))//':' - C = 0 - PRESENT = LIB$FIND_FILE(DIR(:TRIM(DIR))//FILE,TEST,C) - - RETURN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z)0 - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:)E - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:) - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':'A - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURNS - END - - - - SUBROUTINE SET_LIBRARYF - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - R - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CALL CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P) - - IF (CHECK_DIR(BULL_PARAMETER,.TRUE.)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - CALL UPDATE_USERINFO - CALL OPEN_USERINFO - INCMD = 'SHOW' - CALL UPDATE_READ(0)D - END IFI - - RETURN4 - END - - - - SUBROUTINE SHOW_LIBRARY - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (CLI$PRESENT('ALL')) THEN - IER = 1S - N = 1O - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',BULL_PARAMETER) - IF (IER) THEN - IF (N.EQ.1) THEN - WRITE (6,'('' The following are valid libraries:'')') - N = 0 - END IF - WRITE (6,'(1X,A)') BULL_PARAMETERT - END IFO - END DO - IF (N.EQ.1) WRITE (6,'('' No libraries are present.'')') - ELSEO - WRITE (6,'('' Present library is: '',A)'), - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - END IF - - RETURNR - END - - - - SUBROUTINE SET_BULLNEWSDIR_FILE(FN) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILEE - - BULLNEWSDIR_FILE = ' 'N - - ENCODE(6,'(I6)',BULLNEWSDIR_FILE) FN - BULLNEWSDIR_FILE = BULLNEWSDIR_FILE(FIRST_ALPHA(BULLNEWSDIR_FILE):) - L = TRIM(BULLNEWSDIR_FILE)E - - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.'// - & BULLNEWSDIR_FILE(:L-3)//']'// - & BULLNEWSDIR_FILE(L-2:TRIM(BULLNEWSDIR_FILE))//'.' - - RETURNE - END diff --git a/decus/vlt95b/bulletin/bulletin7.for b/decus/vlt95b/bulletin/bulletin7.for deleted file mode 100644 index 1c8d068..0000000 --- a/decus/vlt95b/bulletin/bulletin7.for +++ /dev/null @@ -1,2341 +0,0 @@ -C -C BULLETIN7.FOR, Version 9/29/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER1_NAME.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCALPOST/ LOCAL_POST - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - IF (.NOT.LOCAL_POST) THEN - DATE = NEWEST_DATE - TIME = NEWEST_TIME - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIR - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /OUTPUT/ REASSIGNED - LOGICAL REASSIGNED - DATA REASSIGNED /.FALSE./ - - CALL DISABLE_PRIVS ! Disable SYSPRV - - IF (.NOT.REASSIGNED) THEN - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - END IF - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - IF (INDEX(INPUT,']').GT.0) THEN - SYS_TRNLNM = .FALSE. - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX)) - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1 - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IF - - RETURN - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - IER1 = 0 - ELSE - IF (IER.GT.0) THEN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0 - CALL SET_FOLDER_FILE(0) - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0) - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*12 DATE_SAVE,EXDATE_SAVE - CHARACTER*12 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - END IF - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER PSCAN$_BEGIN = '00000000'X - PARAMETER PSCAN$_ACCOUNT = '00000001'X - PARAMETER PSCAN$_AUTHPRI = '00000002'X - PARAMETER PSCAN$_CURPRIV = '00000003'X - PARAMETER PSCAN$_GRP = '00000004'X - PARAMETER PSCAN$_HW_MODEL = '00000005'X - PARAMETER PSCAN$_HW_NAME = '00000006'X - PARAMETER PSCAN$_JOBPRCCNT = '00000007'X - PARAMETER PSCAN$_JOBTYPE = '00000008'X - PARAMETER PSCAN$_MASTER_PID = '00000009'X - PARAMETER PSCAN$_MEM = '0000000A'X - PARAMETER PSCAN$_MODE = '0000000B'X - PARAMETER PSCAN$_NODE_CSID = '0000000C'X - PARAMETER PSCAN$_NODENAME = '0000000D'X - PARAMETER PSCAN$_OWNER = '0000000E'X - PARAMETER PSCAN$_PRCCNT = '0000000F'X - PARAMETER PSCAN$_PRCNAM = '00000010'X - PARAMETER PSCAN$_PRI = '00000011'X - PARAMETER PSCAN$_PRIB = '00000012'X - PARAMETER PSCAN$_STATE = '00000013'X - PARAMETER PSCAN$_STS = '00000014'X - PARAMETER PSCAN$_TERMINAL = '00000015'X - PARAMETER PSCAN$_UIC = '00000016'X - PARAMETER PSCAN$_USERNAME = '00000017'X - PARAMETER PSCAN$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER PSCAN$_END = '00000019'X - PARAMETER PSCAN$k_type = '00000081'X - PARAMETER PSCAN$M_OR = '00000001'X - PARAMETER PSCAN$M_BIT_ALL = '00000002'X - PARAMETER PSCAN$M_BIT_ANY = '00000004'X - PARAMETER PSCAN$M_GEQ = '00000008'X - PARAMETER PSCAN$M_GTR = '00000010'X - PARAMETER PSCAN$M_LEQ = '00000020'X - PARAMETER PSCAN$M_LSS = '00000040'X - PARAMETER PSCAN$M_PREFIX_MATCH = '00000080'X - PARAMETER PSCAN$M_WILDCARD = '00000100'X - PARAMETER PSCAN$M_CASE_BLIND = '00000200'X - PARAMETER PSCAN$M_EQL = '00000400'X - PARAMETER PSCAN$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER PSCAN$S_OR = 1 - PARAMETER PSCAN$V_OR = 0 - PARAMETER PSCAN$S_BIT_ALL = 1 - PARAMETER PSCAN$V_BIT_ALL = 1 - PARAMETER PSCAN$S_BIT_ANY = 1 - PARAMETER PSCAN$V_BIT_ANY = 2 - PARAMETER PSCAN$S_GEQ = 1 - PARAMETER PSCAN$V_GEQ = 3 - PARAMETER PSCAN$S_GTR = 1 - PARAMETER PSCAN$V_GTR = 4 - PARAMETER PSCAN$S_LEQ = 1 - PARAMETER PSCAN$V_LEQ = 5 - PARAMETER PSCAN$S_LSS = 1 - PARAMETER PSCAN$V_LSS = 6 - PARAMETER PSCAN$S_PREFIX_MATCH = 1 - PARAMETER PSCAN$V_PREFIX_MATCH = 7 - PARAMETER PSCAN$S_WILDCARD = 1 - PARAMETER PSCAN$V_WILDCARD = 8 - PARAMETER PSCAN$S_CASE_BLIND = 1 - PARAMETER PSCAN$V_CASE_BLIND = 9 - PARAMETER PSCAN$S_EQL = 1 - PARAMETER PSCAN$V_EQL = 10 - PARAMETER PSCAN$S_NEQ = 1 - PARAMETER PSCAN$V_NEQ = 11 - BYTE %FILL (2) - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -C -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -C -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE)) -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1 -C UJPIMODE = -1 -C TERMINAL(1:1) = CHAR(0) -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./ - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IF - END DO - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - DO I=1,FOLDER_MAX - DO J=1,2 - LAST(J,I) = LAST_READ_BTIM(J,I) - END DO - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.EQ.0) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - WRITE (9,IOSTAT=IER) USERNAME,INF_REC - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIM - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0 - LAST_SYS_BTIM(2,I) = 0 - END DO - END IF - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -C -C SUBROUTINE READ_NEWS_USERINFO -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) NAME - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2))) - END IF - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READ - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - EQUIVALENCE (OLD_LAST_NEWS_READ2(1,1),OLD_LAST_NEWS_READ(1,1)) - INTEGER*2 OLD_LAST_NEWS_READ2(4,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF = (LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF1 = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF1 = (LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF2 = .FALSE. - GO TO 10 - - ENTRY UPDATE_USERINFO_NEWS_ALWAYS - DIFF2 = .TRUE. - -10 IF (.NOT.DIFF2) THEN - DO I=1,FOLDER_MAX - DIFF2 = (LAST_NEWS_READ(1,I).NE. - & OLD_LAST_NEWS_READ(1,I)).OR. - & (LAST_NEWS_READ(2,I).NE. - & OLD_LAST_NEWS_READ(2,I)).OR.DIFF2 - END DO - END IF - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHARED - - IF (DIFF) THEN - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & LAST(J,I) = LAST_READ_BTIM(J,I) - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - END IF - - IF (DIFF1) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & OLD_LAST_SYS_BTIM(J,I) = LAST_SYS_BTIM(J,I) - LAST_SYS_BTIM(J,I) = OLD_LAST_SYS_BTIM(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF - - IF (DIFF2) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=2,1,-1 - IF (I.EQ.NEWS_FIND_SUBSCRIBE().OR. - & OLD_LAST_NEWS_READ2(1,I).NE.LAST_NEWS_READ2(1,I)) - & OLD_LAST_NEWS_READ(J,I) = LAST_NEWS_READ(J,I) - LAST_NEWS_READ(J,I) = OLD_LAST_NEWS_READ(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - CHARACTER*24 TIME1 - - TIME1 = TIME(FIRST_ALPHA(TIME):) - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:) - END DO - - IF (TIME1.EQ.'-') TIME1 = '-- :' - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder info - ELSE IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND. - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - IF (INCMD(:4).EQ.'SHOW') THEN - SAVE_FOLDER_Q1 = 0 - RETURN - END IF - IF (NEW_MESS.OR.NEWS_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1 - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0 - END IF - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE(IER) - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER) - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - - RETURN - END diff --git a/decus/vlt95b/bulletin/bulletin8.for b/decus/vlt95b/bulletin/bulletin8.for deleted file mode 100644 index 5b7ad54..0000000 --- a/decus/vlt95b/bulletin/bulletin8.for +++ /dev/null @@ -1,2145 +0,0 @@ -C -C BULLETIN8.FOR, Version 10/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND. - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0, - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - END IF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE. - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THEN - ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX)) - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV) - END IF - END IF - END IF - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND. - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24 - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM) - P = 4 + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (BTEST(FOLDER_FLAG,14)) FROM = 'ANONYMOUS' - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT) - P = 4 + P - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER) - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - CALL CLOSE_BULLFOLDER - END IF - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = -1 - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV) - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - INIT = INIT + 2 - IF (INIT.GT.60) THEN - WRITE (6,'('' Bulletin aborting due to record lock'', - & '' problem. Alert system administrator.'')') - CALL EXIT - END IF - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /WINDOW/ WINDOW - - CHARACTER*80 MESSAGE - - WINDOW = 1 - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - - COMMON /TEMP_INPUT/ NODE_TEMP - CHARACTER NODE_TEMP*256 - - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,PASSWORD*32,TEMP_USER*12 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - RETURN - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C -C SUBROUTINE SET_FOLDER_FILE -C -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE, -C if = 1, set FOLDER1_FILE -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NUM.EQ.0) THEN - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE) - END IF - - RETURN - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C -C SUBROUTINE SET_FILE -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILE - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - ELSE - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)// - & '.]' - END IF - - RETURN - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12 - - DATA UPDATE/.FALSE./, JUST_NAME/.FALSE./ - - UPDATE = .TRUE. - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_UPDATE - - UPDATE = .NOT.UPDATE - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_NAME - - JUST_NAME = .NOT.JUST_NAME - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATE - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):) - - M = INDEX(FILDATE,'-') - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3) - - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN - FOLDER_FILE = FOLDER1_FILE - IF (JUST_NAME) THEN - JUST_NAME = .FALSE. - RETURN - END IF - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THEN - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHARED - END IF - END IF - - JUST_NAME = .FALSE. - - IF (UPDATE) THEN - READ (1'1) NBLOCK - REWRITE (1) NBLOCK + LENGTH - UPDATE = .FALSE. - END IF - - RETURN - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THEN - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE - MINGT0 = MIN(I,J) - END IF - - RETURN - END diff --git a/decus/vlt95b/bulletin/bulletin9.for b/decus/vlt95b/bulletin/bulletin9.for deleted file mode 100644 index cf419a8..0000000 --- a/decus/vlt95b/bulletin/bulletin9.for +++ /dev/null @@ -1,2436 +0,0 @@ -C -C BULLETIN9.FOR, Version 6/7/95 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - - IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN - WRITE (6,'(A)') ' A new BULLETIN executable has been '// - & 'installed since your last use.' - WRITE (6,'(A)') - & ' Type HELP NEW_FEATURES for help on any new features.' - END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - EXTERNAL BULLETIN_SUBCOMMANDS - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IF - END IF - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE - WRITE (6,1000) - END IF - IF (.NOT.SUBSCRIBE) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - DO I = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IF - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1 - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THEN - NUM_FOLDER = 0 - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1), - & 'HIT any key for next page....') - END IF - END DO - IF (NUM_FOLDERS.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE IF (INEW) THEN - NEW = INEW - IF (REMOTE_SET.GE.3) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSE - CALL FIND_NEWEST_BULL - END IF - END IF - - IF (INCMD(:4).NE.'INDE') THEN - IER = CLI$DCL_PARSE('INDEX',BULLETIN_SUBCOMMANDS) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1010 FORMAT (' The following folders with new messages are present'/) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - FOLDER_PRESENT = CLI$PRESENT('FOLDER') - - IF (FOLDER_PRESENT) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z') - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME) - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURN - END IF - END IF - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid date specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURN - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN - END IF - ELSE IF (SINCE) THEN - IF (BULL_POINT.EQ.0) THEN - WRITE (6,'('' ERROR: No current message.'')') - RETURN - ELSE IF (NEWS) THEN - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THEN - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSE - STARTMSG = 1 - END IF - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - ELSE - IF (NEWS) THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1 - END DO - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND. - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0 - NEWSMSG = 1 - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THEN - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0 - ELSE - FOUND = .FALSE. - END IF - IF (FOUND.AND.NEWS) THEN - WRITE (6,'(1X,A,'' latest message read '', - & I,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'', - & '' to specified folder.'')') - END IF - END IF - IF (.NOT.ALL) THEN - IF (IER.NE.0) THEN - WRITE (6,'('' User info does not exist.'')') - END IF - IER = 2 - END IF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - CALL CLOSE_BULLUSER - ELSE - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - CALL CLOSE_BULLUSER - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPE - DATA SCRTYPE/-1/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESS - - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - IER1 = 1 - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER2) THEN - CALL ADD_DIRECTORIES - ELSE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IF - END IF - END DO - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - LDESCR = 0 - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - IF (.NOT.NEWS_FEED()) THEN - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - ELSE - CALL STRIP_HEADER(' ',0,IER) - END IF - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - IF (NEWS_FEED().OR.LEN_FROM.EQ.0.OR. - & (BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0) - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0 - IF (IER1.NE.0) THEN - OPEN (UNIT=3,DISPOSE='DELETE',FILE='BULL_DIR:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW') - SCRTYPE = 1 - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - CHARACTER*256 BUFFER - - REWIND (UNIT=3) - - IF (.NOT.NEWS_FEED()) THEN - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,'>')-1) - CALL SYS$SETAST(%VAL(1)) - CALL NEWS_POST('ignore',.TRUE.,IER,INDESCRIP) - IF (TEST_BULLCP().EQ.2) CALL SYS$SETAST(%VAL(0)) - END IF - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3) - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - CHARACTER*24 TODAY - - DATA STORED /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THEN - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER - RETURN - ELSE IF (BUFFER(:5).EQ.'From:') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE. - OLD_BUFFER_FROM = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - END IF - STORED = .TRUE. - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STORED - STORED = .FALSE. - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3) - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - IF (LEN_BUFFER.GT.0) THEN - IF (.NOT.TEXT) THEN - IF (.NOT.NEWS_FEED()) THEN - TEXT = .TRUE. - ELSE - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - END IF - IF (TEXT) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - ELSE - IF (TEXT) WRITE (3,'(A)') ' ' - END IF - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF ((TEXT.AND.NEWS_FEED()).OR. - & (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') ' ' - END IF - IF (.NOT.NEWS_FEED()) CALL STORE_BULL(1,' ',NBLOCK) - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2 - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-') - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO - INEXDATE = .TRUE. - END IF - END IF - IF (.NOT.NEWS_FEED()) THEN - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - TEXT = .TRUE. - ELSE - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - IF ((TEXT.AND.NEWS_FEED()).OR. - & (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /SCRTYPE/ SCRTYPE - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAY - - CHARACTER USER_SAVE*12 - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1 - FIRST_BREAK = .FALSE. - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - IF (NEWS_FEED()) THEN - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - CALL STRIP_HEADER(' ',0,IER) - TEXT = .FALSE. - RETURN - END IF - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - RETURN - END IF - - TEXT = .TRUE. - - EXTIME = '00:00:00.00' - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2100' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.GE.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME) - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARD - END IF - IF (SCRTYPE.EQ.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - CALL RESPOND_MAIL('BULL.SCR',INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('BULL.SCR;*') - END IF - CALL SETUSER(USER_SAVE) - USERNAME = USER_SAVE - ELSE - CLOSE (UNIT=3) - END IF - SCRTYPE = -1 - END IF - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - - IF (.NOT.NEWS_FEED()) THEN - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - END IF - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(FROM,INFROM,LEN_INFROM) - - RETURN - END - - - SUBROUTINE GET_FROM(FROM,INFROM1,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INFROM1,FROM - - CHARACTER*256 INFROM - - INFROM = INFROM1 - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - I = INDEX(INFROM,'<') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<')+1:) ! personal-name - END IF - - I = INDEX(INFROM,'(') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'(')+1:) ! personal-name (net-name) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR.INFROM(I:I).LE.' '.OR. - & INFROM(I:I).GE.CHAR(127).OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) - I = I + 1 - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1 - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND.INFROM(I:I).GT.' '.AND. - & INFROM(I:I).LT.CHAR(127).AND. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.126) - & INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP).AND..NOT.NEWS_FEED()) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - END IF - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) THEN ! of previous header line - IF (LAST_NEWSGROUPS) THEN - NEWSGROUPS = NEWSGROUPS(:TRIM(NEWSGROUPS))//BUFFER(2:) - END IF - RETURN - END IF - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - LAST_NEWSGROUPS = .FALSE. - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.' - END IF - ELSE IF (BUFFER(:11).EQ.'Newsgroups:') THEN - NEWSGROUPS = BUFFER(13:) - LAST_NEWSGROUPS = .TRUE. - END IF - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - - RETURN - END - - - - - SUBROUTINE SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_NEWS_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified news group -C Note: If NOTIFY READNEW and BRIEF = 0, it is either news -C group removal or SET SUBSCRIBE command. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - ALL = .FALSE. - DEFAULT = 1 - NODEFAULT = 0 - SUB = ABS(BRIEF)+ABS(NOTIFY)+ABS(READNEW).EQ.0 - - IF (NOTIFY.EQ.1.AND.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: /NOTIFY is invalid with non-stored'', - & '' news group.'')') - RETURN - END IF - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - IF (CLI$PRESENT('NOPERMANENT').OR.CLI$PRESENT('PERMANENT').OR. - & (SUB.AND.(NODEFAULT.OR.CLI$PRESENT('NOPERMANENT')))) THEN - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (SUB) DEFAULT = 1 - ELSE IF (CLI$PRESENT('NOPERMANENT').OR.NODEFAULT) THEN - IF (NOTIFY.GE.0) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - IF (SUB) - & CALL SET_NEWS_FLAG(IER,-1,-1,-1) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*PERM ',INF_REC - END IF - END IF - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - IF (NODEFAULT.AND.SUB) THEN - NOTIFY = -1 - READNEW = -1 - BRIEF = -1 - END IF - IF (DEFAULT.OR.NODEFAULT) THEN - IF (NODEFAULT.AND..NOT.SUB) THEN - IF (NOTIFY.NE.-1) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - ELSE - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*DEFAULT ',INF_REC - END IF - END IF - IF ((ALL.OR.(SUB.AND.INCMD(:3).NE.'SET')).AND.IER.EQ.0) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY=TEMP_USER,IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - END IF - END IFt - CALL READ_USER_FILE(IER)t - END DO - CALL CLOSE_BULLUSER - END IFn - - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF: - - RETURNn - END - - - - - SUBROUTINE READ_INF_REC - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC's - - INCLUDE 'BULLUSER.INC't - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL OPEN_BULLINF_SHAREDE - DO WHILE (REC_LOCK(IER1))O - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_RECN - END DOA - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DOT - END IF - CALL CLOSE_BULLINF_ - - RETURN - - ENTRY SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER.AND.' - & INF_REC2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1m - END DOd - - IF (I.GT.FOLDER_MAX-1.AND.TEMP_USER(:1).EQ.'*') THENa - WRITE (6,'('' ERROR: You have '',S - & '' reached the news folder limit of '',I,''.'')')L - & FOLDER_MAX-1 - IER = 09 - RETURN - END IF - - IF (INF_REC2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14)9 - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15)O - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15)_ - IF (NOTIFY+READNEW+BRIEF.EQ.-3) THEN - DO J=I,FOLDER_MAX-2 - CALL COPY2(INF_REC(1,J),INF_REC(1,J+1))F - END DO - END IF - IER = 1E - RETURN - END IF - - IF (NOTIFY+READNEW+BRIEF.EQ.-3) RETURNr - - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(' - & ZEXT(INF_REC2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(INF_REC(1,J),INF_REC(1,J-1)). - END IF4 - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THENl - INF_REC2(1,J) = NEWS_FOLDER_NUMBER. - IF (F_START.LE.F_NBULL) THEN - INF_REC2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - INF_REC(2,J) = F_START - 1R - ELSEA - INF_REC2(2,J) = 0 - INF_REC(2,J) = F_NBULL - END IF4 - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13)E - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13)O - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IER = 1 - RETURNe - END IF - END DOG - - RETURN - END diff --git a/decus/vlt95b/bulletin/bullfiles.inc b/decus/vlt95b/bulletin/bullfiles.inc deleted file mode 100644 index af8ee2e..0000000 --- a/decus/vlt95b/bulletin/bullfiles.inc +++ /dev/null @@ -1,39 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vlt95b/bulletin/bullfolder.inc b/decus/vlt95b/bulletin/bullfolder.inc deleted file mode 100644 index 117f8fc..0000000 --- a/decus/vlt95b/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vlt95b/bulletin/bullmain.cld b/decus/vlt95b/bulletin/bullmain.cld deleted file mode 100644 index 32c0642..0000000 --- a/decus/vlt95b/bulletin/bullmain.cld +++ /dev/null @@ -1,34 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vlt95b/bulletin/bullnews.inc b/decus/vlt95b/bulletin/bullnews.inc deleted file mode 100644 index 251895d..0000000 --- a/decus/vlt95b/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vlt95b/bulletin/bullstart.com b/decus/vlt95b/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vlt95b/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vlt95b/bulletin/bulluser.inc b/decus/vlt95b/bulletin/bulluser.inc deleted file mode 100644 index 215a667..0000000 --- a/decus/vlt95b/bulletin/bulluser.inc +++ /dev/null @@ -1,53 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vlt95b/bulletin/changes.txt b/decus/vlt95b/bulletin/changes.txt deleted file mode 100644 index b70d66a..0000000 --- a/decus/vlt95b/bulletin/changes.txt +++ /dev/null @@ -1,634 +0,0 @@ -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executingu -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect iss -that users will not be allowed to change the setting. The main intent heren -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder.t - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF wasw -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show thatu -there are unread new messages every time BULLETIN/LOGIN is executed, ratherc -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages.. - -A major bug was fixed which was introduced in previous mods to speed upa -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vlt95b/bulletin/cmds.mai b/decus/vlt95b/bulletin/cmds.mai deleted file mode 100644 index 1340739..0000000 --- a/decus/vlt95b/bulletin/cmds.mai +++ /dev/null @@ -1,22 +0,0 @@ -The address for getting BULLETIN is BULLETIN@PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file - (only one file per command). - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - -BULLETIN is also available via ANONYMOUS FTP from PFC.MIT.EDU, but the account -is set at low priority, so I suggest using it during non-prime hours. - - Mark diff --git a/decus/vlt95b/bulletin/copyright.txt b/decus/vlt95b/bulletin/copyright.txt deleted file mode 100644 index ee33a7e..0000000 --- a/decus/vlt95b/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vlt95b/bulletin/create.com b/decus/vlt95b/bulletin/create.com deleted file mode 100644 index 5e90fde..0000000 --- a/decus/vlt95b/bulletin/create.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vlt95b/bulletin/handout.txt b/decus/vlt95b/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vlt95b/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vlt95b/bulletin/install.com b/decus/vlt95b/bulletin/install.com deleted file mode 100644 index 758acd4..0000000 --- a/decus/vlt95b/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vlt95b/bulletin/instruct.com b/decus/vlt95b/bulletin/instruct.com deleted file mode 100644 index a9cf299..0000000 --- a/decus/vlt95b/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vlt95b/bulletin/instruct.txt b/decus/vlt95b/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vlt95b/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vlt95b/bulletin/login.com b/decus/vlt95b/bulletin/login.com deleted file mode 100644 index 5c0c2d5..0000000 --- a/decus/vlt95b/bulletin/login.com +++ /dev/null @@ -1,31 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! If you want to have more than one BULLETIN database, replace BULL_DIR -$! with the actual directory to allow redefining BULL_DIR. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vlt95b/bulletin/makefile b/decus/vlt95b/bulletin/makefile deleted file mode 100644 index 830c3fb..0000000 --- a/decus/vlt95b/bulletin/makefile +++ /dev/null @@ -1,82 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.23" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vlt95b/bulletin/master.com b/decus/vlt95b/bulletin/master.com deleted file mode 100644 index f1c5834..0000000 --- a/decus/vlt95b/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel:C -$ !I -$ run pmdf_root:[exe]ftcp_master -$ goto out1l -$ ! -$ CN_channel:i -$ !s -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277M -$ !L -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master( -$ goto out1_ -$ !+ -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vlt95b/bulletin/mx.com b/decus/vlt95b/bulletin/mx.com deleted file mode 100644 index 7d87c28..0000000 --- a/decus/vlt95b/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */L - - } - } - } - rms_get(&rcptrab); /* Read next recipient */e - }u - - - /* Close the RMS files */r - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab);f - - tracemsg("BULLETIN message processed");y - exit(SS$_NORMAL); /* Always return success */ - -}L -$eod t -$copy/log sys$input MX_BULL.TXTm -$deckM - MX_BULL_ - An MX SITE transport. - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution:- - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN?h ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site.t - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including theS -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands:n - - SEND ALL Sends all bulletin files.. - SEND filename Sends the specified file.e - BUGS Sends a list of the latest bug fixes.D - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. Thei -build procedure for MX_BULL expects the logical BULL_SOURCE to point to theo -BULLETIN library. You must define this logical (or edit the .COM file)m -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct):L - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>"* - -3. If you don't have a SITE transport already defined, simply copyu - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULLe - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin deliveringc -messages to BULLETIN.t - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail tod -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETINm -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL) - MAIL> SENDU - To: MX%"GENERAL@BULLETIN" - Subj: This is a test....a - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITEu -agent, since the @BULLETIN path was defined as a SITE path.f - -To facilitate the automatic delivery of messages to BULLETIN folders, youi -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN"""/ - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN"""t - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to/ -BULLETIN via MX_BULL.d - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST ..../ - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.)u - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder.M - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwardingm -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When maild -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the messagee -to the Local agent, which discovers that the mail is forwarded tos -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUEf - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The; -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logicalf -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return addressr -for BULLETIN messages will look something like the following:t - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM:s - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayedW -to death, leaving a bad address on the "From:" line. This frequently happensa -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by:b - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnety - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226s - Western Kentucky University - Bowling Green, KY 42101 -$eod t -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$decka -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headersb -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1.u -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3i -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"?( -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file/ -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it upn -$ close tmp !...t -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr;s -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:"b -$ endifb -$ exit 1 !Always return success -$eod N diff --git a/decus/vlt95b/bulletin/mx.mai b/decus/vlt95b/bulletin/mx.mai deleted file mode 100644 index ec864aa..0000000 --- a/decus/vlt95b/bulletin/mx.mai +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_LIBRARY") .eqs. "" -$ then say "BULL_LIBRARY logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_library/LIB,SYS$SYSTEM:SYS.STB/SEL,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_LIBRARY to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P4 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P4 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P4 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p4 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p2' 'p3' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p2' 'p3' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vlt95b/bulletin/news.alt b/decus/vlt95b/bulletin/news.alt deleted file mode 100644 index e33d065..0000000 --- a/decus/vlt95b/bulletin/news.alt +++ /dev/null @@ -1,254 +0,0 @@ - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales diff --git a/decus/vlt95b/bulletin/news.com b/decus/vlt95b/bulletin/news.com deleted file mode 100644 index fb7775e..0000000 --- a/decus/vlt95b/bulletin/news.com +++ /dev/null @@ -1,679 +0,0 @@ -$set nover -$copy/log sys$input NEWS.ALT -$deck - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales -$eod -$copy/log sys$input NEWS.CREATE -$deck -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - -$eod -$copy/log sys$input NEWS.MODERATORS -$deck -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com -$eod diff --git a/decus/vlt95b/bulletin/news.create b/decus/vlt95b/bulletin/news.create deleted file mode 100644 index dc1c840..0000000 --- a/decus/vlt95b/bulletin/news.create +++ /dev/null @@ -1,155 +0,0 @@ -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - diff --git a/decus/vlt95b/bulletin/news.moderators b/decus/vlt95b/bulletin/news.moderators deleted file mode 100644 index b53780f..0000000 --- a/decus/vlt95b/bulletin/news.moderators +++ /dev/null @@ -1,260 +0,0 @@ -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com diff --git a/decus/vlt95b/bulletin/news.txt b/decus/vlt95b/bulletin/news.txt deleted file mode 100644 index f52d95e..0000000 --- a/decus/vlt95b/bulletin/news.txt +++ /dev/null @@ -1,150 +0,0 @@ -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when a -user accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. It is also possible to -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) When the POST and -ADD commands are used with this folder, the messages will be posted to the news -group, rather than actually being added to the folder. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. diff --git a/decus/vlt95b/bulletin/nonsystem.txt b/decus/vlt95b/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vlt95b/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vlt95b/bulletin/optimize_rms.com b/decus/vlt95b/bulletin/optimize_rms.com deleted file mode 100644 index 4f42e3e..0000000 --- a/decus/vlt95b/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vlt95b/bulletin/pmdf.com b/decus/vlt95b/bulletin/pmdf.com deleted file mode 100644 index 85c77b1..0000000 --- a/decus/vlt95b/bulletin/pmdf.com +++ /dev/null @@ -1,1031 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input BULLETIN_MASTER.PAS_V32i -$deck' -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound);; - -(*******************************************************************)a -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *) -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - - outbound : text; - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL - 100; - - VAR - line, errorsto : vstring; - bigline : bigvstring; result : rp_bufstruct; - header : he_header; - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string); - - BEGIN (* try_something *) - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *) - end; (* try_something *) - - BEGIN (* return_bad_messages *) - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt'); - try_something (he_read_header (header, qu_rtxt), 'he_read_header'); - errorsto.length := 0; - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i]; - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto), - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr); - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *) - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages (tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable. - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT - -For V3.2: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check your -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vlt95b/bulletin/restart.com b/decus/vlt95b/bulletin/restart.com deleted file mode 100644 index 502bfa8..0000000 --- a/decus/vlt95b/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vlt95b/bulletin/setuser.mar b/decus/vlt95b/bulletin/setuser.mar deleted file mode 100644 index 153cb7b..0000000 --- a/decus/vlt95b/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vlt95b/bulletin/update.fil b/decus/vlt95b/bulletin/update.fil deleted file mode 100644 index 97fb572..0000000 --- a/decus/vlt95b/bulletin/update.fil +++ /dev/null @@ -1,11 +0,0 @@ -$ if p1 .nes. "" then FS 'P1' -$ COPY 'FM' [.SEND]/LOG -$ COPY 'FM' CMODA::IR:[BULLETIN] -$ TAB2SP 'FM' -$ RENAME 'FM' [-.NET] -$ PUR [.SEND]'FM' -$ PUR [-.NET]'FM' -$ IF FM .EQS. "CHMAIL.MAI" THEN P3 = "AAAREADME." -$ IF P2 .EQS. "" THEN COPY 'FM' [ANONYMOUS.BULLETIN]'P3' -$ IF P3 .EQS. "" THEN PUR [ANONYMOUS.BULLETIN]'FM' -$ IF P3 .NES. "" THEN PUR [ANONYMOUS.BULLETIN]'p3' diff --git a/decus/vlt95b/bulletin/upgrade.com b/decus/vlt95b/bulletin/upgrade.com deleted file mode 100644 index a2d77c4..0000000 --- a/decus/vlt95b/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vlt95b/bulletin/writemsg.txt b/decus/vlt95b/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vlt95b/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vlt97a/bulletin/aaareadme.1st b/decus/vlt97a/bulletin/aaareadme.1st deleted file mode 100644 index cfef11f..0000000 --- a/decus/vlt97a/bulletin/aaareadme.1st +++ /dev/null @@ -1,2688 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/decus/vlt97a/bulletin/aaareadme.txt b/decus/vlt97a/bulletin/aaareadme.txt deleted file mode 100644 index fb97c8c..0000000 --- a/decus/vlt97a/bulletin/aaareadme.txt +++ /dev/null @@ -1,201 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vlt97a/bulletin/allmacs.mar b/decus/vlt97a/bulletin/allmacs.mar deleted file mode 100644 index b7498eb..0000000 --- a/decus/vlt97a/bulletin/allmacs.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vlt97a/bulletin/allmacs_axp.mar b/decus/vlt97a/bulletin/allmacs_axp.mar deleted file mode 100644 index efb71ec..0000000 --- a/decus/vlt97a/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vlt97a/bulletin/bad.for b/decus/vlt97a/bulletin/bad.for deleted file mode 100644 index c32e9b7..0000000 --- a/decus/vlt97a/bulletin/bad.for +++ /dev/null @@ -1,22 +0,0 @@ - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=5,FILE='BULLNEWS.DAT',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - BULLNEWS_FILE = 'BULL_DIR:BULLNEWS.DAT' - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) WRITE (5,IOSTAT=IER) NEWS_FOLDER1_COM - END DO - - TYPE *,FOLDER1 - END diff --git a/decus/vlt97a/bulletin/board_digest.com b/decus/vlt97a/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vlt97a/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vlt97a/bulletin/board_special.com b/decus/vlt97a/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vlt97a/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vlt97a/bulletin/bull_news.c b/decus/vlt97a/bulletin/bull_news.c deleted file mode 100644 index 4f09cd3..0000000 --- a/decus/vlt97a/bulletin/bull_news.c +++ /dev/null @@ -1,705 +0,0 @@ -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} diff --git a/decus/vlt97a/bulletin/bull_newsdummy.for b/decus/vlt97a/bulletin/bull_newsdummy.for deleted file mode 100644 index a17d3ec..0000000 --- a/decus/vlt97a/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,99 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END diff --git a/decus/vlt97a/bulletin/bullcom.cld b/decus/vlt97a/bulletin/bullcom.cld deleted file mode 100644 index bb514da..0000000 --- a/decus/vlt97a/bulletin/bullcom.cld +++ /dev/null @@ -1,763 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 11/3/95 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER COPY, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FORCE - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER OUTPUT,VALUE(REQUIRED,TYPE=$FILE) - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB THREAD - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE, NONNEGATABLE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER FORCE - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER THREADS - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD THREAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vlt97a/bulletin/bullcoms1.hlp b/decus/vlt97a/bulletin/bullcoms1.hlp deleted file mode 100644 index 73996de..0000000 --- a/decus/vlt97a/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1260 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is -specified. A node which does not have BULLCP running cannot have a -message broadcasted to it, (even though it is able to create a remote -folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with -> at the beginning of each line. This can be -suppressed or the indentation character changed with /[NO]INDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message will -be deleted after the node on which the message was submitted from is -rebooted. If you wish the message to be deleted after a different node -reboots, you have the option of specifying that node name. The message -deletion is keyed by BULLETIN running on the node that reboots. It -writes into the database info that the node has rebooted, and when -BULLCP wakes up and sees this info, it will delete any shutdown messages -for that node. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current process -to another process in your job. - -The ATTACH command allows you to move quickly between processes that you -have created with the SPAWN command. For example, while you are editing -a file, you can SPAWN a subprocess to read a new message. Enter the -ATTACH command to get back to back to the editing session. If you want -to read another new message, you can use the ATTACH command to get back -to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers -so that either the message text, expiration date, or the header are to -be changed. If no qualifier is added, the default is that all these -parameters are to be changed. If the text of the message is to be -changed, a file can be specified which contains the text. If the editor -is used for changing the text, the old message text will be extracted. -This can be suppressed by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /OWNER - /OWNER=string - -Specifies a new owner name. Can only be changed if you own the folder -or have privileges. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. A -range of messages can be specified, i.e. /NUMBER=1-5. Only the -expiration date and message headers can be changed if a range is -specified. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be copied -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list via -the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to be mailed to the email address. This is common if you have -users that don't have access to BULLETIN. Note: When you specify an -email address, the folder automatically will have the ADD_ONLY flag set, -which causes both ADD and POST to both add a message and send mail the -message. Note that a message added to the folder via the BBOARD feature -will also be mailed to the specified email address. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. If you create a remote folder pointing to a folder -associated with an email address, you must specify the email address in -the description of the remote folder also. - -It is also possible to use the description to specify a news group from -which messages are fed into the folder. See the file FOLDER_TO_NEWS.TXT -for more info. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. The -identifier can not be any longer than 12 characters. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The specified node is checked to see if -a folder of the same name is located on that node. If so, the folder -will then be modified to point to that folder. For example if there was -a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be -shared between more than one node. This capability is only present if -the BULLCP process is running on the remote node via the BULL/STARTUP -command. If the remote folder name is different from the local folder -name, the remote folder name is specified using the /REMOTENAME -qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data -Base. If the RDB does not exist on your system, a privileged user will -have to create it. If a user is not in the RDB, this program will -automatically enter the user into it (unless this feature was disabled -during the compilation of this program). NOTE: See HELP SET ACCESS for -more info. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW -for more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -either /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The -BULLETIN utility must be installed properly on the other nodes. You can -specify a different username to use at the other nodes by either using -the USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. The -specified subject need not be the exact subject of the message. It can -be a substring of the subject. This is in case you have forgotten the -exact subject that was specified. Case is not critical either. You -will be notified if the deletion was successful. See also /NEGATED. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting -messages on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message. -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /CONTINUE -Used with /GROUP. Allows you to continue a search after you have broken -the search by entering a command, i.e. READ, SEARCH, etc. Note: If you -enter a SEARCH command which specifies a string, and then continue the -directory search using /CONTINUE, the new search pattern will be used -when continuing the search. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of -folder. -2 /EXPIRATION -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the DIRECTORY -command are to be written into the specified file. All qualifiers which -are valid for the EXTRACT command are valid in conjunction with /EXTRACT -except for /NEW which conflicts with the DIRECTORY /NEW qualifier. The -listof messages to be printed will be displayed on the terminal (in -nopaging format). - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /FEEDBACK -Used only in conjunction with /GROUP. Specifies to show when new news -groups are selected. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS. -2 /FROM - /FROM=[string] - -Specifies that only messages whose username contains the specified string -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Used with the search -qualifiers /SEARCH, /SUBJECT, or /FROM. Wildcards are permitted in the -specified string. Use /FEEDBACK to see when groups are selected. At -any time during the search you may enter other commands, i.e. you may -read a message, see a full directory listing, etc. You may then restart -the search listing by typing DIR/CONTINUE. For more info, see help on -the /CONTINUOUS qualifier. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don't -match the specified search command are displayed. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWS -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /OUTPUT - /OUTPUT=filename - -Specifies to write the directory output to a file rather than the -terminal. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED. -2 /SEARCH - /SEARCH=[string] - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDE -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings. - - Format: - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. /FROM is the default. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE. -2 /FROM -Specifies to exclude the message based on the message owner. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. When /FULL is specified, the EXCLUDE command will -not add an exclude, so it can't be used with any other qualifier except -for /DISABLE. -2 /LIMIT - /LIMIT=days - -Specifies that the exclude will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROM -and /SUBJECT cannot be specified at the same time. -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. If the file exists, the -message is appended to the file, unless the /NEW qualifier is specified. - - Format: - FILE [filename] [message_number][-message_number1],[...] - -If the filename is omitted, a file will be created based on the name of -the folder. - -A range of messages to be copied can optionally be specified, i.e. FILE -2-5. The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /ALL -Copies all the messages in the current folder. -2 /FF -Specifies that a form feed is placed between messages in the file. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 FIRST -Specifies that the first message in the folder is to be read. -1 Folders -All messages are divided into separate folders. New folders can be -created by any user. As an example, the following creates a folder for -GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that user -will be alerted of topics of new messages at login time, and will then -be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If instead you -specify /SEMIPRIVATE, all users can read the messages in the folder, but -only those given access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote -DECNET node. Messages added to a remote node are actually stored on the -folder on the remote node. The BULLCP process (created by -BULLETIN/STARTUP) must be running on the remote node for this option to -be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another use -is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, -and giving access to that UIC group. Only users in that UIC group will -see the messages in that folder when they log in. -1 FORWARD -Synonym for MAIL command. -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INCLUDE -This command is a synonym for the THREAD command. -1 INDEX -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after one -has read a message. /RESTART must be specified to start from the first -folder if a scan is in progress. All other qualifiers are ignored while -a scan is in progress. - - Format: - INDEX - -When a directory is displayed, you can read the first message in the -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for older -versions of BULLETIN. -2 /MARKED -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED, -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. -2 /NEW - /[NO]NEW - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message. -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -2 /SET - /[NO]SET - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -2 Suggestions -Here are keypads settings that the author personally uses. Note that -the IND/SUBS commands are useful only for reading NEWS. - -DEFINE/KEY PERIOD "IND/SUBS"/TERM -DEFINE/KEY PERIOD "IND/SUBS/NONEW"/IF_STATE=GOLD/TERM -DEFINE/KEY MINUS "READ/THREAD"/IF_STATE=GOLD/TERM -DEFINE/KEY PF1 ""/IF_STATE=GOLD/SET=NOEDIT -DEFINE/KEY PF1 ""/IF_STATE=NOEDIT/SET=NOH -DEFINE/KEY PF3 "EXT"/TERM -DEFINE/KEY KP9 "MAIL/EDIT/NOHEAD"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP8 "REPLY/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP7 "SEND/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/H"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/NOH"/IF_STATE=NOH/TERM -DEFINE/KEY KP5 "RESPOND/NOEDIT "/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP5 "RESPOND/EXTRACT/LIST/EDIT "/TERM -DEFINE/KEY KP2 "SEARCH/REP "/TERM -DEFINE/KEY KP2 "SEARCH/REV/REP "/TERM/IF_STATE=GOLD -DEFINE/KEY KP2 "SEARCH/REV "/IF_STATE=NOEDIT -DEFINE/KEY COMMA "SPAWN"/TERM -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying an -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" must -be specified as xxx%"""address""". -2 /EDIT -Specifies that the editor is to be used to edit the message before -mailing it. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers] - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 MODIFY -Modifies the database information for the current folder. Only the -owner of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to automatically mailed to the email address. This is common if -you have users that don't have access to BULLETIN. In order to do this, -you should use the SET ADD_ONLY command. This causes all messages added -to the folder to also be sent to the email address. This also applies -to messages which are added via the BBOARD feature. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can -be specified following the folder name, i.e. COPY NEWFOLDER 2-5. -However, if the old folder is remote, they will be copied but not -deleted, as only one message can be delted from a remote folder at a -time. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be moved -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEWS -Displays the list of available news groups. - -Format: - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed. - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL will -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /DEFAULT -If specified, will show news groups that have be defined as default -groups using the SET SUBSCRIBE command. -2 /NEWGROUP -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /PERMANENT -If specified, will show news groups that have be defined as permanent -groups using the SET SUBSCRIBE command. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B. -2 /STORED -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 New_features -Here is a list of new features which may be of interest to the general -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - -------------------------------------------------------------------------- -V 2.24 -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -SHOW EXCLUDE and INCLUDE commands added. 5/16/95 - -V 2.21 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -Added /FOLLOWUP to POST command when used with news groups. It specifies -which news group you want replies to your message to be sent to. 10/28/94 - -V 2.20 - -Logical names can be specified in POST/GROUPS=. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/11/94 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group by -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92 - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. diff --git a/decus/vlt97a/bulletin/bullcoms2.hlp b/decus/vlt97a/bulletin/bullcoms2.hlp deleted file mode 100644 index 91b3738..0000000 --- a/decus/vlt97a/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1457 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with -> at the -beginning of each line. This can be suppressed or the indentation -character changed with /[NO]INDENT. -2 /FOLLOWUP - /FOLLOWUP=string - -Specifies that any replies generated by people reading the message -should be sent to the specified newsgroup. This is useful if you want -to post to more than one group, but don't want reply messages posted on -all the groups. To specify more than one newsgroup, surround the list -with quotes, i.e. FOLLOWUP="newsgroup1,newsgroup2". If replies should -only be sent to the message owner and not a newsgroup, the string -"poster" should be specified. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message -to the specified NEWS group(s) in addition to the selected NEWS group. -Logical names are allowed. -2 /HEADER -Allows customized headers line to be added to the message header. When -specified, header lines can be added by inserting them at the top of the -message, with the header lines and the text of the message separated by -a blank line. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. -In order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply -surround the exclusive text starting with the line "START " -and ending with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The file created by the PRINT command is not -released to the print queue until you exit, unless you add the qualifier -/NOW or change one of the print job's qualifiers. Multiple messages are -concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /CANCEL -Cancels any messages waiting to be printed. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL level -to find out the name of the mounted form and the default form for a -particular queue. If you specify a form whose stock is different from -the stock of the form mounted on the queue, your job is placed in a -pending state until the stock of the mounted form of the queue is set -equal to the stock of the form associated with the job. (In order to -have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the file -or files have been printed. If /NONOTIFY is specified, there is no -notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 QUIT -Exits the BULLETIN program. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. If you -specify a number greater than the number of messages in the folder, the -last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -/HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /THREADS -Reads all messages that have been included by the THREAD command. If -neither message number nor /SINCE is specified, the search starts with -the first new message. After the first READ/THREADS command, typing -READ/THREADS will continue the search from where it left off (as long as -you do not select a different folder or news group). Also, after a -message has been fully read, if the return key is hit without entering a -command, it is equivalent to typing the READ/THREADS command. Messages -which are parts of threads and under read will be displayed in the -directory listing by a preceeding #. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /INDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read -them. (Note: Reading the last message does the same thing, but RESET -does it without having to read it.) -2 /CURRENT -Resets the new message counter to the current message. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using the -qualifer /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected or /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text strings. - - Format: - - SEARCH [search-string[,...]] - -The search starts from the first message in the current folder. You can -specify the message to start at using the qualifier /START. If you use -this qualifier without a parameter, it starts with the current message. -The search includes both the text of the message, and the description -header. If a "search-string" is not specified, a search is made using -the previously specified string, starting with the message following the -one you are currently reading (or have just read). After fully reading -the message found by the search, if you hit the return key without -entering a command, it is equivlanent to typing SEARCH without a search -string and will search for the next message. Once started, a search can -be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FEEDBACK -Used only in conjunction with /FOLDER and /GROUP. Specifies to show -when new folders or news groups are selected. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for a -match. If, during a search, no more matches or messages are found, the -next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. Use /FEEDBACK to see when folders are -selected. News groups can be specified here. However, to search news -group with wild cards, use /GROUP. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Wildcards are permitted in -the specified string. If the string does not contain an * and does not -specify a news group, * is automatically placed at the beginning and end -of the string. I.e. if the string is "comp", then all news groups -containing the word "comp" will be searched. Use /FEEDBACK to see when -groups are selected. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /MATCH - /MATCH[=option] - -Interprets and matches multiple search strings in one of the following -ways: - - AND A match occurs only if all of the strings are found. - - OR A match occurs if any of the strings are found. - - XOR A match occurs if only one of the strings is found. - -If you specify none of these options, the default is /MATCH=OR. If you -specify the /NEGATED qualifier, you will get the negated operation. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If no -starting message is specified, the search is started from the last -message. /REVERSE must be specified with a search string. -2 /START - /START=message_number - -Specifies the message number to start the search at. If you omit the -message number, it starts with the current message. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. UICs can contain -wildcards, i.e. [130,*]. Note that by default, a process is given the -process rights id SYS$NODE_nodename, where nodename is the decnet -nodename. Thus, by specifing this id, a folder can be restricted to a -specific node, which is useful when the folder is shared among nodes in -a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUS -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name. - - Format: - - SET [NO]ANONYMOUS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. - - Format: - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If -ADD_ONLY is set and a mailing address is present (see /DESCRIPTION), -when a message is added to the folder, it will also be mailed to the -address (in addition to being stored in the folder). This also applies -to a message which is added via the BBOARD feature . If ADD_ONLY is set -and a user uses the POST command, the ADD command will be used instead. -One use for this is to mail messages in a folder to users who do not -have access to BULLETIN. - - Format: - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages. - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30" -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The form -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY. -The time will always be 00:00, even if the time is specified on the line. -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be: - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account. - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV. -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION. -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by the -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier. -2 COMPRESS -Specifies that messages added to the folder will be in compressed format. -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires -very little cpu overhead. - - Format: - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed every -time when logging in, until the new messages are read. Normally, the -BRIEF setting causes notification only at the first time that new messages -are detected. - - Format: - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - - Format: - - SET DEFAULT_EXPIRE days - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages. - - Format: - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it. -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format: - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) -2 EXCLUDE -Specifies to ignore any EXCLUDEs or THREADs that are present. - - Format: - - SET [NO]EXCLUDE - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or THREADs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 EXLIMIT -Specifies the default limit for the EXCLUDE command. - - Format: - - SET EXLIMIT days - -If no match is found for an exclude after the specified number of days, -the exclude will automatically be deleted. The default is no limit, -which is specified by specifying 0 days. This default can be overriden -by the /LIMIT switch on the EXCLUDE command. -2 FILE_DIRECTORY -Select the directory where messages are written to when using the -EXTRACT or file COMMAND. By default, the message is written into the -current directory. - - Format: - - SET FILE_DIRECTORY [directory] - -If directory is omitted, the setting is removed. Note: This information -is stored in the customization file (SYS$LOGIN:BULL.CUSTOM). -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new messages will be displayed for upon -logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to by -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. -2 LIBRARY -Specifies a library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command to see if there are other libraries. -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NAME -Copies all stored settings from one user to another. Used when a user's -account name is changed. - - Format: - - SET NAME old-username new-username -2 NEWS -Changes attributes of the specified news group or class of news groups. -This command requires privileges. - - Format: - - SET NEWS [news-group] - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALL - /NOALL - -If specified with /CLASS or /DEFAULT, all groups that are presently -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of any -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the default -attributes (using /DEFAULT) with /NOALL, the attributes for misc.test -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. -3 /CLASS - /CLASS=classname - -Specifies to modify attributes for a class of news groups rather than a -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes of -existing groups which are in the class are modified, and any groups -created in the future will automatically have those attributes. -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETE -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLE -Specifies that the news group is enabled and can be accessed. This is -the default. -3 /EXPIRATION - /EXPIRATION=days - -Specifies the default expiration time for messages if none is specified. -The default is 7. -3 /FULL -Control whether all information of the news groups is displayed, i.e. -the access list if the news group is private. This information is only -those who have access to that folder. -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified is --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default. -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is posted -every month with an expiration date of one month in the future. -3 /PRIVATE - /PRIVATE - /NOPRIVATE - -Specifies that the news group or class can have it's access modified by -the SET ACCESS command. To accomplish this, a file is created in -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access -to news groups in that class is to set /NOPRIVATE, as then time won't be -wasted checking a file for ACLs. -3 /STORED - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessed -via the network from the server node. This results in faster access, -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED. -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder. - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node, -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are logged -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 POST_ONLY -Specifies that the selected folder has the POST_ONLY attribute. This -causes the ADD command to mail the message to the mailing address if it -is present (see /DESCRIPTION), rather than add to the folder. - - Format: - - SET [NO]POST_ONLY -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format: - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers. -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed. -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that READNEW is a permanent flag and cannot be changed by the -individual. This is a privileged qualifier. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all -users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged -qualifier. -2 STRIP -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If STRIP -is set, the header of the mail message will be stripped off before it is -stored as a BULLETIN message. - - Format: - - SET [NO]STRIP - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SUBSCRIBE -Can be used to force users to be subscribed to the selected news group. -This is a privileged command. - - Format: - - SET SUBSCRIBE - -Note: If you execute the commands SET SHOWNEW, READNEW, BRIEF, or -NOTIFY, and add /DEFAULT or /PERMAMENT, it is equivalent to doing a SET -SUBSCRIBE command with the addition that the specified feature will be -the default and/or permanent setting. -3 /ALL -Specifies that all present and future users will be subscribed to the -news group. -3 /DEFAULT - /[NO]DEFAULT - -Specifies that new users will automatically be subscribed to the news -group. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that new users will automatically be subscribed to the news -group and that users cannot unsubscribe the news group. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 EXCLUDE -Displays the list of excludes which are present for the current folder. -The right hand side of the display shows the date of the last time a -match for the exclude was found, and also the number of days from the -time of the last match after which the excludes expires. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected -via the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 THREAD -Displays the list of includes which are present for the current folder. -2 KEYPAD -Displays the keypad command definitions. - - Format: - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either SET KEYPAD, or if /KEYPAD is -specified on the command line, the keypad keys will be defined as -commands. The default settings for the keypad are shown via SHOW KEYPAD -or HELP KEYPAD. Settings can be changed by using an initialization file -with DEFINE/KEY commands. BULLETIN looks first for the file pointed to -by the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -3 /STATE - /STATE=(state,state,...) - -Specifies the name of a state for which the specified key definitions -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when a -key name has been specified. -2 LIBRARY -Shows the library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the /ALL -qualifier to see if there are other libraries. -3 /ALL -Specifies to show all available libraries. -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGIN - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDER - /FOLDER=[foldername] - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups. -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSION -Shows the version of BULLETIN and the date that the executable was -linked. -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of the -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. -1 THREAD -Specifies that the current message is defined as a thread based on -either the subject or the message owner. Since threads are much more -commonly based on the subject, this is the default. Threads are read by -using the command READ/THREADS. - - Format: - THREAD [string] - -If a string is specified, then the message is a thread if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one THREAD may be -specified per folder. - -Note: EXCLUDEs take precedence over THREADs. -2 /ALL -Used with /DISABLE to specify to disable all THREADs. -2 /DISABLE -Specifies to permanently disable the THREAD. -2 /FROM -Specifies to include the message based on the message owner. /FROM -and /SUBJECT cannot be specified at the same time. -2 /LIMIT - /LIMIT=days - -Specifies that the thread will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to include the message based on the message subject. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 Storing_Threads -THREADs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] -1 UNSUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See the -SUBSCRIBE command for further info. -1 Usenet_news -BULLETIN can also read USENET NEWS if your system has network access to -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group -in order to keep track of which messages you have read in that group. -Most of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read all your subscribed news groups that have new -messages, use INDEX/SUBSCRIBE. diff --git a/decus/vlt97a/bulletin/bulldir.inc b/decus/vlt97a/bulletin/bulldir.inc deleted file mode 100644 index f66cc78..0000000 --- a/decus/vlt97a/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vlt97a/bulletin/bullet1.com b/decus/vlt97a/bulletin/bullet1.com deleted file mode 100644 index 280b69f..0000000 --- a/decus/vlt97a/bulletin/bullet1.com +++ /dev/null @@ -1,2760 +0,0 @@ -$set nover -$copy/log sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. -$eod -$copy/log sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) -$eod -$copy/log sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. -$eod -$copy/log sys$input BULLETIN.LNK -$deck -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.3" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.3" -$eod -$copy/log sys$input BULLFILES.INC -$deck -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ -$eod -$copy/log sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) -$eod -$copy/log sys$input BULLNEWS.INC -$deck - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ -$eod -$copy/log sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy/log sys$input BULL_NEWS.C -$deck -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s,s1; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} - - -smtp_assign() -{ - int n; - -#if MULTINET || TWG - /* - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()). - */ - - if (!hp1) { - int h[4],i; - if (sscanf(node1,"%d.%d.%d.%d",&h[0],&h[1],&h[2],&h[3]) == 4) { - for (i=0;i<4;i++) if (h[i] < 0 || h[i] > 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp1->h_addrtype; - memcpy(&sin.sin_addr, hp1->h_addr, hp1->h_length); - } -#if TWG - sin.sin_port = htons(25); -#else - sin.sin_port = htons1(25); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s1,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s1,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node1),DSC$K_CLASS_S,DSC$K_DTYPE_T,node1}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s1,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s1,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - - -smtp_create() -{ -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s1,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(25); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s1,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#else - if (!(sys$qiow(0,s1,IO$_CREATE,&iosb,0,0,node1,25,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#endif - - return(1); -} - -smtp_disconnect() -{ -#if UCX - sys$cancel(s1); - sys$qiow(0,s1,IO$_DEACCESS,0,0,0,0,0,0,0,0,0); -#endif - sys$dassgn(s1); -} - - -smtp_connect() -{ - if (!smtp_gethost()) return(0); - if (!smtp_assign()) return(0); - if (!smtp_socket()) return(0); - return(smtp_create()); -} - -char node2[132]; - -smtp_gethost() -{ - /* - * Get the IP address of the SMTP host. - * As of MULTINET 3.0, cannot be done at AST level - * so can't do in SMTP_ASSIGN(), as BULLCP calls it at - * AST level if the decnet gateway feature is used. - */ -#if TWG - struct hostent *gethostbyname(); -#else -#if MULTINET -#endif -#endif - - node1 = getenv("BULL_SMTP_SERVER"); - if (!node1) { -#if TWG - gethostname(node2,132); -#else -#if MULTINET - gethostname1(node2,132); -#endif -#endif - node1 = node2; - } - -#if TWG - hp1 = gethostbyname(node1); -#else -#if MULTINET - hp1 = gethostbyname1(node1); -#endif -#endif - return(1); -} - - - -smtp_write_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - - -smtp_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s1,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - - -smtp_socket() -{ - -#if MULTINET || TWG - if (!(sys$qiow(0,s1,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s1,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#endif - - return(1); -} -$eod -$copy/log sys$input CHANGES.TXT -$deck -V2.3 - -Added the ability to create a folder that can post and read to a news group, -and can send and read messages via email. See NEWS_TO_FOLDER.TXT for more -info. 4/18/97 - -Added the ability for BULLETIN to see news groups from secondary news groups -(see NEWS.TXT). 4/18/97 - -V 2.25 - -Changes to make it easier to click on news group name to select them: You can -enter a news group name at the prompt and it will select it (without typing -SELECT). News groups displayed without period at end when BULLETIN lists the -ones that have new messages. NEWS/SUBS has space between * and news group -when denoting which ones have new messages. 3/21/96 - -V 2.24 - -When replying to a message in a news group that has been crossposted, give the -user the option of just posting the reply to the news group in which the -message is being read rather than all the news groups in the crosspost. -11/20/95 - -Messages added to folders and stored news groups are now marked as being read -so that the person does not see them when doing a READ/NEW. 11/20/95 - -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. -$eod -$copy/log sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy/log sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy/log sys$input NEWS.TXT -$deck -BULLETIN has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was -to run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added -the ability in BULLETIN (actually BULLCP) so that it acts as as a gateway -between decnet and tcp for NEWS. This method does not require spawning any -processes, since the detached process BULLCP is always present, so the access -is very fast. Also, since BULLETIN uses a shared database to store info on -the NEWS groups and periodically updates it, there is no need for that to be -done when a user accesses the NEWS groups. Several other NEWS readers do this -when you run them, which is why they take a long time to start up. It is also -possible to feed NEWS groups into a "real" BULLETIN folder, so that the -messages are saved on disk (see the file NEWS_TO_FOLDER.TXT). - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER to -be a system logical name pointing to either your internet or decnet NEWS node. -If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -It is also possible for BULLETIN to access news groups that are located on -other news servers than the one specified by BULL_NEWS_SERVER. This is done -by creating the file BULL_DIR:BULL_ALT_NEWS.LIS and adding a line which -containsthe name of the news group and the news server where it's located. -The format is news-group-name:news-server-name. - -In order to post messages, BULLETIN needs to know the internet nodename of the -local host. This is done automatically for nodes running MULTINET. For other -nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This can -be hardcoded into the source by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, -it will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will -cause subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -If you have any problems or questions, please let me know. - MRL -$eod -$copy/log sys$input NEWS_TO_FOLDER.TXT -$deck -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description -surrounded by <>, i.e. . It must be in lower case. (Other text is -allowed in the description, i.e. "THIS IS A TEST FOLDER ".) When -messages are added the folder, they are also sent to the news group, and new -messages from the group are posted to the folder (via the BULLCP process which -wakes up on a periodic basis). Whenever you modify the folder description and -specify the news group name, you will be prompted as to whether you want to -initializee the news group counter to either load all the messages present in -the news group, or to load only news messages that appear there. - -Messages posted to the news group from such a folder have a special line in -their header indicating they were sent from that node using bulletin. When -bulletin feeds new postings back to the folder, it will see that header line -and also see that it was posted from that node, and thus will avoid adding it -to the folder (and thus creating a duplicate message). Note that messages are -added to the news group via the BULLCP process, so they will not appear -immediately after being added to the folder. - -If you are modifying an existing folder to make it associated with a news -group, and if you want to copy any existing messages in the folder to the news -group, you can do that by using the command COPY/ORIGINAL/LOCAL and specifying -the news group as the destination. /ORIGINAL will cause the original owner -names and dates to be preserved (note, however, that dates older than 14 days -in the past are not usually accepted by the news server, so dates older than -that will be changed to the present date). /LOCAL will create the special -header line in the messages to prevent BULLCP from adding those messages back -to the folder from the news group. /ALL can be specified to copy all the -messages in the folder. - -If you create a remote folder that points to a folder that has a news group -associated with it, you do not have to specify the news group in the -description of the remote node. - -When a news group is specified for a folder, it is still possible to associate -an email address for the messages to be sent to in the folder description. -You do this by using [] to enclose the address rather than the usual <>, i.e. -[mrl@pfc.mit.edu] See help in BULLETIN on the command CREATE/DESCRIPTION for -more info about associated email addresses. Note that these features allow -you to create a full gateway between a news group and a mailing list. -$eod -$copy/log sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod -$copy/log sys$input WRITEMSG.TXT -$deck -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/vlt97a/bulletin/bullet2.com b/decus/vlt97a/bulletin/bullet2.com deleted file mode 100644 index b0d2276..0000000 --- a/decus/vlt97a/bulletin/bullet2.com +++ /dev/null @@ -1,1703 +0,0 @@ -$set nover -$copy/log sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy/log sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy/log sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 4/10/97 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER COPY, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FORCE - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER OUTPUT,VALUE(REQUIRED,TYPE=$FILE) - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB THREAD - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE, NONNEGATABLE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER FORCE - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER THREADS - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD THREAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE -$eod -$copy/log sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP -$eod -$copy/log sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP -$eod -$copy/log sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy/log sys$input BULL_NEWSDUMMY.FOR -$deck - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END - - - - SUBROUTINE SMTP_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION SMTP_CONNECT - - SMTP_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION SMTP_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION SMTP_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_READ_PACKET = 0 - - RETURN - END -$eod -$copy/log sys$input CREATE.COM -$deck -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK -$eod -$copy/log sys$input INSTALL.COM -$deck -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy/log sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy/log sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.3" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* -$eod -$copy/log sys$input OPTIMIZE_RMS.COM -$deck -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS -$eod -$copy/log sys$input RESTART.COM -$deck -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START -$eod -$copy/log sys$input SETUSER.MAR -$deck - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program -$eod -$copy/log sys$input UPGRADE.COM -$deck -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE -$eod diff --git a/decus/vlt97a/bulletin/bulletin.ann b/decus/vlt97a/bulletin/bulletin.ann deleted file mode 100644 index c374df5..0000000 --- a/decus/vlt97a/bulletin/bulletin.ann +++ /dev/null @@ -1,26 +0,0 @@ -Article 168253 of comp.os.vms: -BULLETIN is a bulletin board utility which I wrote for VMS. However, because -many of our VAX users moved to PCs and MACs, they have wanted access to read -and post to the BULLETIN folders. In the past I accomplished this via EMAIL -and used the feature which allowed mail to be sent to and from a folder. -However, some people have asked for Web access. In order to easily provide -this feature without a lot of work, we decided to do the following: Since -news server software is now easily and cheapily available, and most news -readers (i.e. Netscape) have the ability to read usenet news groups from more -than one news server, I set up a local news server to serve private news -groups. I then modified BULLETIN to allow a folder with email access to also -have the ability to post and receive to a specified news group. I also had to -modify BULLETIN to allow it to access more than one news server. Thus, a user -can now post and read the same folder either via either BULLETIN, EMAIL, or -WEB access via a newsgroup. - -The new version of BULLETIN (v2.3) which has this feature is available via -anonymous ftp to PSFC.MIT.EDU in the BULLETIN sub-directory. - -Note: The newsgroup-folder feature had existed in the past but would not work -with email. It also was crude in that if you added a message, it would first -post the message to the newsgroup and then later be added to the folder. It -now is added immediately to the folder. Sharp users will note that this gives -BULLETIN the ability to be used as a newsgroup to mailing list gateway. - - diff --git a/decus/vlt97a/bulletin/bulletin.cld b/decus/vlt97a/bulletin/bulletin.cld deleted file mode 100644 index deb3c36..0000000 --- a/decus/vlt97a/bulletin/bulletin.cld +++ /dev/null @@ -1,44 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vlt97a/bulletin/bulletin.com b/decus/vlt97a/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vlt97a/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vlt97a/bulletin/bulletin.for b/decus/vlt97a/bulletin/bulletin.for deleted file mode 100644 index ad9859a..0000000 --- a/decus/vlt97a/bulletin/bulletin.for +++ /dev/null @@ -1,2095 +0,0 @@ -C -C BULLETIN.FOR, Version 2/27/97 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - DATA NEXT_COMMAND/' '/ - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - CALL INIT_BULLETIN(.TRUE.) - -C -C The MAIN loop for processing bulletin commands. -C - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IF (IER.GT.0) THEN - IF (INDEX(INCMD(:IER),' ').EQ.0.AND. - & INDEX(INCMD,'/').EQ.0.AND. - & INDEX(INCMD,'.').GT.0) INCMD = 'SELECT '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE IF (READ_COUNT.NE.0) THEN - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - ELSE IF (NEXT_COMMAND.NE.' ') THEN - INCMD = NEXT_COMMAND - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL DO_COMMAND(INCMD) - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - CALL DO_COMMAND(INCMD) - -100 CONTINUE - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) - - END - - - - - SUBROUTINE DO_COMMAND(INCMD) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - CHARACTER*(*) INCMD - - NEXT_COMMAND = ' ' - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (HLEN.EQ.0) THEN - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - END IF - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL'.OR. - & INCMD(:4).EQ.'POST'.OR. - & INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - WRITE (6,'('' ERROR: /FOLDER not valid when posting'', - & '' a message to a news group.'')') - ELSE - INCMD = 'POST '//INCMD(4:) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - END IF - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,'('' ERROR: There are no more preceding messages.'')') - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').AND.CLI$PRESENT('NEWS')) THEN - WRITE (6,'('' ERROR: /NEWS and /FOLDER cannot be '' - & ''specified at the same time.'')') - ELSE IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.,.FALSE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR - ELSE IF (INCMD(:4).EQ.'INCL'.OR. ! INCLUDE? - & INCMD(:4).EQ.'THRE') THEN ! THREAD? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IF (CLI$PRESENT('THREADS')) NEXT_COMMAND = 'READ/THREADS' - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - NEXT_COMMAND = 'SEARCH' - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'FI') THEN ! SET FILE_DIRECTORY? - CALL SET_CUSTOM('file_directory') - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SH') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SU') THEN ! SET SUBSCRIBE? - IF (REMOTE_SET.GE.3) THEN - D1 = 0 - D2 = 0 - D3 = 0 - CALL SET_FOLDER_DEFAULT(D1,D2,D3) - ELSE - WRITE (6,'('' ERROR: Command invalid for folder.'')') - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LIB') THEN ! SET LIBRARY? - CALL SET_LIBRARY - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS? - CALL SET_NEWS - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE? - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE? - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:3).EQ.'EXL') THEN ! SET EXLIMIT? - CALL SET_CUSTOM('exclude_limit') - ELSE IF (BULL_PARAMETER(:4).EQ.'NAME') THEN ! SET NAME? - CALL SET_NEWNAME - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'EX') THEN ! SHOW EXCLUDE? - CALL SHOW_EXCLUDE(0) - ELSE IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:2).EQ.'IN'.OR. - & BULL_PARAMETER(:2).EQ.'TH') THEN ! SHOW INCLUDE? - CALL SHOW_EXCLUDE(1) - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SHOW LIBRARY - CALL SHOW_LIBRARY - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATION - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1) - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN? - CALL TAG(.FALSE.,2) - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - - RETURN - END - - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER INEXDATE*12,INEXTIME*12,INDENT*4 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,BULLETIN_SUBCOMMANDS - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT') - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - LENI = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',INDENT,LENI) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LENI.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') INDENT(:LENI)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2100' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2100' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60) - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60) - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - IF (CLI$PRESENT('EXTRACT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35 - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - BLENGTH = BLENGTH + ILEN - 1 + 2 - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE. - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting.'', - & '' A truncated message will be broadcast.'')') - CALL GET_INPUT_PROMPT(INPUT,ILEN, - & 'Type C to continue, A to only ADD message, or Q to Quit: ') - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN - BRDCST = .TRUE. - END IF - END IF - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! Username - END IF - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THEN - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '// - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK) - END IF - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletin - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IF - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF (FOLDER_NUMBER.GE.0) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL ADD_TAG(IER1,2) - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF -C -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP, -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same cluster -C as that of the BULLCP node. -C - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET) - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - ELSE IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR. - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & INDESCRIP(:LENDES),STATUS) - ELSE - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LENDES),STATUS) - END IF - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & ERR=910,FORM='FORMATTED') - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IF - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:INDEX(FOLDER_DESCRIP,'>')-1) - CALL NEWS_POST(BULL_PARAMETER(:LEN_P),.FALSE.,IER, - & INDESCRIP) - END IF - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*4 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP)) - - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG) - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC' - - DATA READ_UAI/.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE. - RETURN - END IF - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE. - END IF - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURN - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')') - RETURN - END IF - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN) - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN() - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - RETURN - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - SUBROUTINE INIT_BULLETIN(NOX) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - DATA PAGE_LENGTH/24/,PAGE_WIDTH/80/ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (NOX) CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER(:LEN_P) - CALL CHECK_DIR(BULL_PARAMETER,.FALSE.) - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - END IF - CALL LIB$REVERT - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE IF (COMMAND_PROMPT(I:I).EQ.'/') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL(.FALSE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS1') THEN - CALL NEWS2BULL(.TRUE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'SMTP') THEN - CALL SEND_MAIL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - IF (NOX) CALL CRELNM('SYS$INPUT','TT') ! Input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - IF (NOX) CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - - CALL OPEN_OLD_TAG - - IF (.NOT.NOX) THEN - CALL NEW_MESSAGE_NOTIFICATION - RETURN - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IF - END IF - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - - RETURN - END diff --git a/decus/vlt97a/bulletin/bulletin.hlp b/decus/vlt97a/bulletin/bulletin.hlp deleted file mode 100644 index cf279b3..0000000 --- a/decus/vlt97a/bulletin/bulletin.hlp +++ /dev/null @@ -1,151 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vlt97a/bulletin/bulletin.lnk b/decus/vlt97a/bulletin/bulletin.lnk deleted file mode 100644 index 8d8a7d2..0000000 --- a/decus/vlt97a/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.24" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.24" diff --git a/decus/vlt97a/bulletin/bulletin0.for b/decus/vlt97a/bulletin/bulletin0.for deleted file mode 100644 index 3d5d39a..0000000 --- a/decus/vlt97a/bulletin/bulletin0.for +++ /dev/null @@ -1,2439 +0,0 @@ -C -C BULLETIN0.FOR, Version 9/20/96 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET.EQ.1) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IER1 = SBULL + 1 - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER1) - SUBJECT = DESCRIP - IER2 = 0 - IF (IER2.EQ.0.AND.IER1.EQ.SBULL+1) CALL - & REMOTE_DELETE(SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - ELSE IF (REMOTE_SET.EQ.3) THEN - BULL_DELETE = SBULL - 1 - IER = 0 - IF (CLI$PRESENT('REASON')) THEN - CALL CLI$GET_VALUE('REASON',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) RETURN - IF (EBULL.EQ.SBULL) THEN - WRITE(6,1030) - RETURN - END IF - END IF - END DO - SUBJECT = DESCRIP - IF (.NOT.TEST_NEWS_OWNER().AND.SETPRV_PRIV().AND. - & .NOT.CLI$PRESENT('FORCE')) THEN - SUBJECT = 'CanceL' - IF (CLI$PRESENT('REASON')) THEN - SUBJECT = SUBJECT(:6)//BULL_PARAMETER(:LEN_P) - END IF - END IF - CALL REMOTE_DELETE - & (SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - RETURN - END IF - END DO - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - SUBJECT = DESCRIP - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.NE.USERNAME - END IF - IF (ASK.AND..NOT.CLI$PRESENT('FORCE')) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - IF (REMOTE_SET.EQ.4) THEN - SUBJECT = 'CanceL' - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.(TEST_NEWS_OWNER().OR. - & SETPRV_PRIV())) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2),EX(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:9).EQ.'19') EXDATE(8:9) = '18' - IF (EXDATE(8:9).EQ.'20') EXDATE(8:9) = '19' - IF (EXDATE(8:9).EQ.'18'.AND.EXDATE(10:10).LT.'6') - & EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX,EX) - IER = SYS$ASCTIM(,INPUT,EX,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DIRMODE/ DIRMODE - DATA DIRMODE/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - CHARACTER GROUP*80,STAT*4 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - DIRMODE = .TRUE. - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - FOUND = 0 - OUT = 6 - - CONT = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - CONT = CLI$PRESENT('CONTINUE') - ELSE IF (INCMD(:3).EQ.' '.AND.NFOLDER.LT.0) THEN - CONT = .TRUE. - END IF - IF (CONT) THEN - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - SUBJECT = SUBJECT1 - REPLY = REPLY1 - SEARCH = SEARCH1 - FROM_SEARCH = FROM_SEARCH1 - SINCE = SINCE1 - NEW = NEW1 - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - IF (.NOT.ANY_SEARCH) THEN - WRITE (6,'('' ERROR: No previous search to continue.'')') - RETURN - END IF - INCMD = ' ' - LEN_P = 0 - DIR_COUNT = DIR_COUNT1 - NFOLDER = NFOLDER1 - I = DIR_COUNT - IF (DIR_COUNT.EQ.-1) THEN - I = SBULL - 1 - END IF - GO TO 200 - END IF - NFOLDER = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('OUTPUT',BULL_PARAMETER,LEN_P)) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & DEFAULTFILE='.LIS', - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - WRITE(6,1000) BULL_PARAMETER(:LEN_P) - RETURN - END IF - OUT = 3 - INQUIRE (UNIT=3,NAME=BULL_PARAMETER) - WRITE (6,1040) BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - END IF - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - EXTRACTING = CLI$PRESENT('EXTRACT') - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - NEGATED = CLI$PRESENT('NEGATED') - IF (SEARCH) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (SUBJECT) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (FROM_SEARCH) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (REPLY) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3 - NEGATED = .TRUE. - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - IF (INCMD(:3).EQ.'IND') THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - REPLY_FIRST = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - ELSE - NEW = .FALSE. - END IF - END IF - OUTPUT = EXTRACTING.OR.PRINTING - - START = .FALSE. - SINCE = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - NFOLDER1 = -1000 - SUBJECT1 = SUBJECT - REPLY1 = REPLY - SEARCH1 = SEARCH - FROM_SEARCH1 = FROM_SEARCH - I = SBULL - 1 - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - SINCE1 = SINCE - NEW1 = NEW - GOTO 200 - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - IF (NEW.AND.IER.EQ.0) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - IF (READ_TAG) CALL DECREMENT_MSG_KEY - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) NUM = NUM + 1 - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - END IF - I = I - 1 - END DO - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - END IF - IF (NUM.GT.0) I = I - 1 - END DO - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) NUM = NUM + 1 - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) J = J + 1 - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT.OR.OUT.EQ.3) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I1 = SBULL - I = SBULL - DO WHILE (I.LE.EBULL) - CALL READDIR(I1,IER) ! Into the queue - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1 - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - I = I + 1 - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1 - END IF - I1 = I1 + 1 - END DO - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - EBULL = EBULL - SBULL + DIR_COUNT - SBULL = DIR_COUNT - I = SBULL - END IF - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY, - & TAG_TYPE) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVE - END IF - END IF - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - END IF - ELSE - NBULL = 0 - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN - DIR_TYPE = 'seen' - END IF - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - IF (INCMD(:3).EQ.'DIR'.AND.ANY_SEARCH) THEN - IF (.NOT.CLI$PRESENT('START').AND. - & .NOT.CLI$PRESENT('CONT')) THEN - WRITE (6,'('' No matches found starting search'', - & '' from message number '',I)') SBULL - DIR_COUNT = -1 - GO TO 9999 - END IF - END IF - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - IF (NFOLDER.EQ.0) CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT) - - TAG = (BULL_TAG.AND.(REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1)).OR. - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THEN - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN - START_SEARCH = BULL_POINT - END IF -200 CLOSED = .FALSE. - IF (ANY_SEARCH.OR.OUTPUT) THEN - NUM = 0 - IF (NFOLDER.NE.-1000) THEN - CLOSED = .TRUE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - CLOSED_FILES = .FALSE. - SEARCH_NUM = 1 - REVERSE = .FALSE. - END IF - DO WHILE (I.LE.EBULL.AND.FOUND.GT.-3) - IF (.NOT.ANY_SEARCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (NFOLDER.NE.-1000.AND.I.GE.SBULL) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SLEN,0, - & START_SEARCH,REVERSE,SUBJECT,REPLY_FIRST,.FALSE., - & .TRUE.,FROM_SEARCH,NEGATED,.FALSE.) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - IF (NFOLDER.LT.0.AND.(I.EQ.F_START.OR.I.EQ.DIR_COUNT)) THEN - IF (FEEDBACK) CALL LIB$ERASE_PAGE(1,1) - CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT) - DIR_COUNT = 0 - BULL_POINT = MSG_NUM - 1 - PRINT_HEADER = .TRUE. - END IF - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - TAG_TYPE = DUMMY - END IF - IF (NFOLDER.LT.0.AND..NOT.OUTPUT) THEN - NUM = NUM + 1 - IF (NUM.EQ.PAGE_LENGTH-6) I = EBULL + 1 - END IF - ELSE IF (NFOLDER.LT.0.AND.(OUTPUT.OR.I.LE.SBULL)) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSED = .FALSE. - END IF - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - CALL CLOSE_BULLFOLDER - IF (GFOUND) THEN - START_BULL = 0 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - IF (F1_START.GT.0.AND.F1_START.LE.F1_NBULL) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - START_SEARCH = F_START - 1 - IF (IER.AND.(NEW.OR.SINCE)) THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER1,DATETIME) - CALL CLOSE_BULLDIR - IF (IER1.NE.0) THEN - START_SEARCH = IER1 - 1 - ELSE - IER = 0 - END IF - END IF - END IF - IF (.NOT.IER.OR.F1_START.EQ.0.OR. - & F1_START.GT.F1_NBULL) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER, - & IER) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - GFOUND = .FALSE. - IF (FLAG.EQ.1) CALL CLOSE_BULLFOLDER - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - SBULL = F_START - I = SBULL - 1 - EBULL = F_NBULL - END IF - ELSE - NFOLDER = 0 - END IF - END DO - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - ELSE IF (NFOLDER.EQ.0) THEN - WRITE (6,'('' No messages found.'')') - END IF - IF (NFOLDER.EQ.0) I = EBULL + 1 - IF (NFOLDER.LT.-1000) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED = .TRUE. - END IF - NFOLDER1 = NFOLDER - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - I = EBULL + 1 - END IF - CALL CANCEL_CTRLC_AST - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.GE.SBULL.AND.I.LE.EBULL.AND.NFOLDER.NE.-1000) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN - OUTLINE = '>' - ELSE IF (BTEST(SYSTEM,8)) THEN - OUTLINE = '#' - ELSE - OUTLINE = ' ' - END IF - IF (BTEST(SYSTEM,29)) THEN - OUTLINE(2:) = '*' - ELSE - OUTLINE(2:) = ' ' - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3) - IF (EXDATE(8:12).LT.'1994'.AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin? - EXPIRES = 'Permanent' - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11) - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9) - ELSE - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11) - END IF - NOTHING = .FALSE. - IF (OUT.EQ.6) THEN - WRITE(OUT,'(1X,A)') OUTLINE - ELSE - WRITE(OUT,'(A)') OUTLINE - END IF - IF (OUTPUT) THEN - FOUND_MSG = .TRUE. - CALL SYS$SETAST(%VAL(0)) - NEXT = .FALSE. - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES) - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES,PRINT_HEADER) - PRINT_HEADER = .FALSE. - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0 - ELSE - MSG_NUM = -MSG_NUM - END IF - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1)) - END IF - END IF - I = I + 1 - IF (ANY_SEARCH) IER = SYS$CANTIM(,) - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.OUTPUT) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IF - END IF - - IF (DIR_COUNT.GT.NBULL - & .OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THEN - ! Outputted all entries? - IF (PRINTING) THEN - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THEN - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IF - ELSE IF (EXTRACTING.AND.FOUND_MSG) THEN - CALL FILE(0,CLOSED_FILES,.FALSE.) - END IF - IF (NFOLDER.LT.0) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE - DIR_COUNT = -1 ! Yes. Set counter to -1. - END IF - ELSE IF (NFOLDER.NE.0.OR.(-NFOLDER1.EQ.FOLDER_NUMBER.AND. - & INCMD(:1).EQ.' ')) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE IF (FLAG.NE.1) THEN - WRITE(6,1010) ! Else say there are more - END IF - -9999 POSTTIME = .FALSE. - NEXT = .FALSE. - DIRMODE = .FALSE. - IF (NFOLDER.NE.0.OR.-NFOLDER1.EQ.FOLDER_NUMBER) THEN - DIR_COUNT1 = DIR_COUNT - IF (DIR_COUNT1.GT.NBULL) DIR_COUNT1 = -1 - END IF - IF (OUT.EQ.3) CLOSE (UNIT=3) - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(1X,/,' Press RETURN for more...',/) -1020 FORMAT(1X,/,' Press RETURN for more, type SEARCH to read ', - & 'these messages.',/) -1040 FORMAT(' Output being written to ',A,'.') - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER) - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT,PRINT_HEADER) -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER*128 FILENAME - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THEN - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IF - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THEN - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IF - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - END IF - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = FILE_NUM - EBULL = SBULL - END IF - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F) - - IF (.NOT.IER) THEN - FILENAME = FOLDER - DO I=1,LEN(FILENAME) - IF (FILENAME(I:I).EQ.'.') FILENAME(I:I) = '_' - END DO - FILENAME = FILENAME(:TRIM(FILENAME))//'.TXT' - LEN_F = TRIM(FILENAME) - END IF - - IF (TRIM(FILE_DIRECTORY).GT.0.AND.INDEX(FILENAME,':').EQ.0 - & .AND.INDEX(FILENAME,'[').EQ.0) THEN - FILENAME = FILE_DIRECTORY(:TRIM(FILE_DIRECTORY))//FILENAME - LEN_F = TRIM(FILENAME) - END IF - - CALL STR$UPCASE(FILENAME,FILENAME) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE. - FIRST = .TRUE. - END IF - - IF (PRINT_HEADER) THEN - WRITE (3,'(/,''Newsgroup: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1 - IF (FBULL1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - OPENED = .FALSE. - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(FBULL,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DO - -100 IF (FILE_NUM.GT.0) THEN - FILE_NUM = -FILE_NUM - RETURN - END IF - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created. - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - END IF - - GO TO 10 - -900 WRITE(6,1000) FILENAME(:LEN_F) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message ',A,' written to ',A) -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A) -1050 FORMAT('Subj: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN) - - CALL LIB$MOVC3(8,IN,OUT) - - RETURN - END - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - FOLDER_NAME = FOLDER - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSE - RETURN ! Don't notify - END IF - END IF - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSE - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM) - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time - ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSER - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LOGIN_BTIM_NEW) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF - - CALL GET_NODE_NUMBER(NODE_NUMBER1,NODE_AREA1) - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100 - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IGNORE = BTEST(SYSTEM,2).AND.(NODE_AREA.EQ.NODE_AREA1).AND. - & (NODE_NUMBER.AND.NODE_NUMBER1) - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF ((USERNAME.NE.FROM.OR.SYSTEM).AND..NOT.IGNORE) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - ELSE - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - END IF - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - INREAD = '+' - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' ' - END IF - IF (LEFT) THEN - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN) - LEFT = .FALSE. - ILEN = 0 - INREAD = '+' - ELSE IF (ILEN.LE.WIDTH) THEN - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN) - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSE - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ') - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH) - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0) - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DO - IF (INPUT(ILEN:ILEN).EQ.' ') THEN - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEN - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE. - ELSE - WIDTH = PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE (6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - PAGE = PAGE + 1 - ELSE - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)// - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN) - & //' '//FOLDER_NAME(:FLEN)// - & ' to read these messages.' - END IF - PAGE = PAGE + 1 - END IF - -9999 IF (LOGIN_SWITCH) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION, - & OUT) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - CHARACTER*(*) OUTLINE - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULL - ELSE - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IF - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ') - OUTLINE(I:) = OUTLINE(I+1:) - END DO - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINE - BULL_PARAMETER = ' ' - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1)) THEN - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THEN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IF - IF (PRINTING) THEN - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - END IF - - IF (OUT.EQ.6) THEN - WRITE (OUT,'(''+'',A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - ELSE - WRITE (OUT,'(A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - END IF - -1000 FORMAT(A,1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(A,1X,'Description',43X,'From',8X,'Expires',/) - - RETURN - END - - - - SUBROUTINE GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER TODAY(2) - - CHARACTER DATETIME*24 - - IF (SINCE) THEN ! Was /SINCE specified? - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - IER = 0 - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - END IF - END IF - - RETURN - END diff --git a/decus/vlt97a/bulletin/bulletin1.for b/decus/vlt97a/bulletin/bulletin1.for deleted file mode 100644 index d04fc6f..0000000 --- a/decus/vlt97a/bulletin/bulletin1.for +++ /dev/null @@ -1,2495 +0,0 @@ -C -C BULLETIN1.FOR, Version 2/27/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_S = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',SENDTO(LEN_S+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_S = LEN_S + I + 1 - SENDTO(LEN_S:LEN_S) = ',' - END DO - LEN_S = LEN_S - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_S) - IF (SENDTO(I:I).EQ.'"') THEN - SENDTO = SENDTO(:I)//'""'//SENDTO(I+1:) - I = I + 2 - LEN_S = LEN_S + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',SENDTO(:LEN_S) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//SENDTO(:LEN_S) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*32 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - INIT_NEWSFEED = .FALSE. - - NEWSGROUP = .FALSE. - MAILTO = 0 - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - RETURN - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - I = INDEX(FOLDER1_DESCRIP,'<') - J = INDEX(FOLDER1_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'@').LT.1 - & .OR.INDEX(FOLDER1_DESCRIP(I:),'@').GT.J-I+1).AND. - & (INDEX(FOLDER1_DESCRIP(I:),'.') - & .LE.J-I+1.AND.INDEX(FOLDER1_DESCRIP(I:),'.').GT.0)) THEN - NEWSGROUP = .TRUE. - WRITE (6,'('' Init news feed counter to feed '', - & ''all messages in news group (Y),'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'or set to feed only new messages (N,default) ? ') - INIT_NEWSFEED = RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y' - I = INDEX(FOLDER1_DESCRIP,'[') - J = INDEX(FOLDER1_DESCRIP,']') - END IF - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER1_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER1_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'.') - & .GT.J-I+1.OR.INDEX(FOLDER1_DESCRIP(I:),'.').EQ.0) - & .AND.MAILTO.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(RESPONSE) - IF (TRIM(RESPONSE).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//RESPONSE(:TRIM(RESPONSE))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - IF (NEWSGROUP) FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - IF (MAILTO.EQ.2) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (MAILTO.EQ.3) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (INIT_NEWSFEED) THEN - F_LAST = 0 - ELSE IF (NEWSGROUP) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - I = INDEX(FOLDER_DESCRIP,'<') + 1 - J = INDEX(FOLDER_DESCRIP,'>') - 1 - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER_DESCRIP(I:J),IER) - CALL CLOSE_BULLNEWS - CALL OPEN_BULLFOLDER - F_LAST = F1_NBULL - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /FEED/ FEED - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256,TODAY*24 - CHARACTER SCRFILE*18 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - IF (.NOT.BULLCP_NEWS.AND.FOLDER.EQ.FOLDER1) THEN - WRITE (6,'('' ERROR: Destination cannot be same as'', - & '' current location.'')') - RETURN - END IF - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER1 = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - NEWS2BULL = NEWS2BULL.AND..NOT.TO_NEWS.AND.ORIGINAL - IF (IER1.EQ.0.AND..NOT.NEWS2BULL) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THEN - I = IER - ELSE IF (.NOT.NEWS2BULL) THEN - NUM_COPY = NUM_COPY + 1 - END IF - NEWS2BULL = .FALSE. - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - FROM_BULL_POINT = BULL_POINT - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (REMOTE_SET.EQ.4.AND..NOT.BULLCP_NEWS).OR.REMOTE_SET.EQ.3 - - POST_FEED = .FALSE. - SLIST = 0 - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST:INDEX(FOLDER_DESCRIP,'>')-1) - POST_FEED = .TRUE. - END IF - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') + 1 - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - END IF - IF (SLIST.GT.1) THEN - IF (NEWS_FEED()) THEN - ELIST = INDEX(FOLDER_DESCRIP,']') - 1 - ELSE - ELIST = INDEX(FOLDER_DESCRIP,'>') - 1 - END IF - END IF - IF (CLI$PRESENT('LOCAL').AND..NOT.BULLCP_NEWS) SLIST = 0 - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS.OR.(POST_FEED.AND.SLIST.LE.1)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - END IF - IF (.NOT.POST_NEWS) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=FROM_BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF ((FROM_REMOTE.OR.FROM_REMOTE.EQ.4).AND. - & (TO_NEWS.AND.ORIGINAL)) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2100' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (SLIST.GT.1.OR.POST_NEWS.OR.POST_FEED) THEN - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - IF (SLIST.GT.1) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE='BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'BULL.SCR' - END IF - ENDIF - ILEN = LINE_LENGTH + 1 - - INFROM = FROM - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - IF (POST_NEWS.OR.POST_FEED) THEN - USE_INFROM = ORIGINAL - IF (CLI$PRESENT('LOCAL')) NEWS2BULL = .TRUE. - CALL NEWS_POST - & (SCRFILE(:TRIM(SCRFILE)),.TRUE.,IER,POST_SUBJECT) - NEWS2BULL = .FALSE. - END IF - IF (SLIST.GT.1) THEN - CLOSE (UNIT=3) - USE_INFROM = ORIGINAL - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - ELSE - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - END IF - CALL LIB$DELETE_FILE(SCRFILE(:TRIM(SCRFILE))//';') - ELSE IF (POST_FEED.OR.POST_NEWS) THEN - REWIND (UNIT=3) - END IF - BLOCK = BLOCK_SAVE - LENGTH = LENGTH_SAVE - END IF - IF (.NOT.POST_NEWS) THEN - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - IF (.NOT.ORIGINAL) SYSTEM = IBSET(SYSTEM,3) - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (SLIST.LT.1.AND.POST_NEWS.OR.POST_FEED) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - IF (TEST_BULLCP().NE.2) - & WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADER - IF (BULLCP_NEWS) RETURN - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IF - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./ - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND. - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0 - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN) - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0) - IF (CHANGED) THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IF - - IF (INCMD(:4).EQ.'PRIN') THEN - IF (CLI$PRESENT('CANCEL')) THEN - WRITE (6,'('' Cancelling all previously queued messages.'')') - CLOSE (UNIT=24,DISPOSE='DELETE') - FIRST = .TRUE. - RETURN - END IF - END IF - -50 IF (PRINT_NUM.EQ.0) THEN - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = PRINT_NUM - EBULL = SBULL - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name - IF (QLEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - END IF - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100 - CLOSE (UNIT=24,DISPOSE='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - END IF - -1040 FORMAT(' Message ',A,' sent to printer.') -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE. - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) - END IF - - CALL DISABLE_PRIVS - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A, - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE. - GO TO 50 - END IF - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ_MSG -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /POST/ POSTTIME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /THREAD/ THREAD - DATA THREAD /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/,LAST_THREAD/.FALSE./ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH) - CHARACTER HEADLINE*132 - - LOGICAL SINCE,PAGE - - EXTERNAL CLI$_NEGATED - - FIRST = BULL_READ.LT.F_START - KILL = BTEST(BULL_USER_CUSTOM,3) - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3) - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE. - END IF - ROTC = CLI$PRESENT('ROTATE') - END IF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - THREAD = .FALSE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - THREAD = CLI$PRESENT('THREADS') - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSE - BULL_READ = 1 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE').AND. - & .NOT.THREAD) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW').OR.(THREAD.AND..NOT. - & CLI$PRESENT('SINCE').AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND.(.NOT.LAST_THREAD - & .OR.LAST_THREAD_NUMBER.NE.FOLDER_NUMBER) - & .AND.CLI$PRESENT('NEW').NE.%LOC(CLI$_NEGATED))) THEN - NEW = .TRUE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READDIR_KEYGE(IER) - IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_BTIM) - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - CALL CLOSE_BULLDIR - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - IER = 0 - END IF - END DO - CALL CLOSE_BULLDIR - ELSE - IER = 0 - SKIPPED_THREAD = .FALSE. - IF (THREAD) CALL OPEN_BULLDIR_SHARED - DO WHILE (IER.EQ.0) - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - BULL_READ = IER - END IF - IF ((SKIPPED_THREAD.OR.(THREAD.AND.IER.NE.0)).AND. - & BULL_READ.LE.F_NBULL) THEN - CALL READDIR(BULL_READ,IER) - IER = IER - 1 - IF (IER.NE.BULL_READ) IER = 0 - END IF - IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - MSG_NUM = IER - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,DUMMY,DUMMY) - IF (IER1.EQ.0) THEN - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(IER) - ELSE - BULL_READ = BULL_READ + 1 - END IF - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - WRITE (6,'('' No more messages are present.'')') - IF (SKIPPED_THREAD) CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - SKIPPED_THREAD = .TRUE. - BULL_READ = IER + 1 - IER = 0 - END IF - END DO - END IF - IF (THREAD) CALL CLOSE_BULLDIR - BULL_READ = IER - IER = IER + 1 - ELSE IF (THREAD) THEN - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999 - ELSE - BULL_READ = IER - 1 - IER = IER + 1 - END IF - SINCE = .TRUE. - ELSE IF (CLI$PRESENT('BULLETIN_NUMBER')) THEN - BULL_READ = BULL_READ - 1 - ELSE IF (LAST_THREAD_NUMBER.EQ.FOLDER_NUMBER) THEN - BULL_READ = LAST_THREAD_READ - ELSE - BULL_READ = BULL_POINT - 1 - END IF - CALL OPEN_BULLDIR_SHARED - IER = BULL_READ + 1 - IER1 = .FALSE. - DO WHILE (.NOT.IER1.AND.IER.EQ.BULL_READ+1.AND. - & BULL_READ.LT.F_NBULL) - BULL_READ = BULL_READ + 1 - CALL READDIR(BULL_READ,IER) - IER1 = BTEST(SYSTEM,8) - IF (IER1.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER2,DUMMY,DUMMY) - IER1 = IER2.NE.0 - END IF - END DO - IF (.NOT.IER1) THEN - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - END IF - END IF - - NEXT = .FALSE. - LAST_THREAD = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - LAST_THREAD = THREAD - IF (THREAD) THEN - LAST_THREAD_READ = BULL_READ - LAST_THREAD_NUMBER = FOLDER_NUMBER - END IF - IF (.NOT.SINCE.AND..NOT.NEW - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THEN - IER = 0 - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR. - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN - MSG_NUM = F_NBULL+1 - ELSE - MSG_NUM = BULL_NOW - END IF - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE - CALL GET_THIS_OR_NEXT_TAG - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0 - END IF - END IF - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END IF - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END DO - CALL CLOSE_BULLDIR - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READ - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSE - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0 - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IF - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE. - CALL READDIR(BULL_READ,IER) - END IF - END IF - IF (REMOTE_SET.LT.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - IF (IER.NE.BULL_READ+1) THEN - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0 - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) ! If not, then error out - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - - SAVE_BULL_POINT = BULL_POINT - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(FIRST.OR.NEW.OR.NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEN - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - OK = OK.AND.(.NOT.THREAD.OR.BTEST(SYSTEM,8)) - - IF (.NOT.OK) THEN - BULL_POINT = SAVE_BULL_POINT - BULL_NOW = MSG_NUM - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN - BULL_READ = MSG_NUM - 1 - ELSE - BULL_READ = MSG_NUM + 1 - IF (INCMD(:4).EQ.'FIRS'.OR.FIRST) NEXT = .TRUE. - END IF - IF (REMOTE_SET) CALL CLOSE_BULLFIL - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - ELSE IF (.NOT.THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_NOW) - END IF - IF (BULL_READ.GT.F_NBULL.OR.BULL_READ.LT.F_START) THEN - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - GO TO 50 - END IF - BLOCK = BLOCK_SAVE - END IF - - NEXT = .FALSE. - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (.NOT.THREAD.OR.INCMD(:4).NE.'READ') THEN - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.BULL_READ) - & CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - END IF - END IF - - EDIT = .FALSE. - - PAGE_WIDTH = REAL_PAGE_WIDTH - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN - IF (CLI$PRESENT('EDIT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 9999 - END IF - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTH - PAGE = .FALSE. - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSE - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL - END IF - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:) - END DO - I = TRIM(HEADLINE) - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)) - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - ELSE - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ' - & .AND..NOT.BTEST(SYSTEM,3)) THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROM - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - IF (EDIT) WRITE(3,'(1X)') - ELSE - END = END + 1 - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IF - END IF - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) THEN - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter - GO TO 9999 - END IF - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - -9999 POSTTIME = .FALSE. - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - RETURN - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO - - RETURN - END - - - - - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1 - EQUIVALENCE (INREAD4,INREAD) - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - BULL_POINT_READ = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - - GO TO 12 - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - - BULL_POINT = BULL_POINT_SAVE - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN - ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL FILE(0,.TRUE.,.FALSE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THEN - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THEN - WRITE (6,'(''+B'',$)') - INCMD = 'RESPOND/LIST' - ELSE - GO TO 11 - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')') - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLY - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message', - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),', - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) -1040 FORMAT(' Type P to post reply, U to reply to user,', - & ' B to do both, or other to quit: ',$) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END - - - - - LOGICAL FUNCTION NEWS_FEED() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - I = SLIST + 1 - FLEN = TRIM(FOLDER_DESCRIP) - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN - IF (INDEX(FOLDER_DESCRIP(SLIST:I),'.').GT.0) - & NEWS_FEED = .TRUE. - RETURN - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND. - & FOLDER_DESCRIP(I:I).NE.'@'.AND. - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE - I = FLEN + 2 - END IF - END DO - END IF - - RETURN - END - - - - - LOGICAL FUNCTION MAIL_POST() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NEWS_FEED()) THEN - MAIL_POST = INDEX(FOLDER_DESCRIP,'[').GT.0 - ELSE - MAIL_POST = INDEX(FOLDER_DESCRIP,'<').GT.0 - END IF - - RETURN - END diff --git a/decus/vlt97a/bulletin/bulletin10.for b/decus/vlt97a/bulletin/bulletin10.for deleted file mode 100644 index 8c50f12..0000000 --- a/decus/vlt97a/bulletin/bulletin10.for +++ /dev/null @@ -1,4059 +0,0 @@ -C -C BULLETIN10.FOR, Version 2/27/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - COMMON /HEADER_SEEN/ HEADER_SEEN - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - LAST_LF_SEEN = LF_SEEN - LAST_REAL_LF_SEEN = REAL_LF_SEEN - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - CR_SEEN = INDEX(BUFFER(START_READ:END_READ),CR) - IF (CR_SEEN.GT.0) THEN - IF (END_LINE.GT.0) THEN - IF (CR_SEEN.EQ.END_LINE-2.AND.BUFFER(START_READ+CR_SEEN: - & START_READ+CR_SEEN).EQ.CR) CR_SEEN = CR_SEEN + 1 - ELSE - IF (START_READ+CR_SEEN.EQ.END_READ.AND. - & BUFFER(END_READ:END_READ).EQ.CR) CR_SEEN = 0 - END IF - END IF - IF ((END_LINE.EQ.0.AND.CR_SEEN+START_READ-1.LT.END_READ.AND. - & CR_SEEN.GT.0).OR.CR_SEEN.LT.END_LINE-1) THEN - END_LINE = CR_SEEN - CR_SEEN = 1 - ELSE - CR_SEEN = 0 - END IF - LF_SEEN = END_LINE.GT.0 - IF (END_LINE.GT.257-CR_SEEN.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - IF (.NOT.HEADER_SEEN) END_LINE = 254 - END IF - REAL_LF_SEEN = INDEX(BUFFER(START_READ:END_READ),LF).LE.END_LINE - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - IF (BUFFER(EB:EB).EQ.LF) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - IF (EB.GT.0.OR.LAST_LF_SEEN) RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE(:MIN(LEN(WRITE),256)) - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - NEWS_WRITE = NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - - LOGICAL FUNCTION NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - NEWS_RECONNECT = .FALSE. - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - NEWS_RECONNECT = .TRUE. - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /HEADER/ HEADER - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER().OR.SETPRV_PRIV()) THEN - IF (REMOTE_SET.EQ.4) THEN - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (INPUT(:11).EQ.'Message-ID:') THEN - MESSAGE_ID = INPUT(14:ILEN-1) - ILEN = 0 - END IF - END DO - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - CALL NEWS_POST('cancel',0,IER,SUBJ) - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - DO WHILE (BUFFER(SB:EB).NE.'.'.AND. - & .NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX( - & BUFFER(SB:EB),' ')+SB-2),J,,%VAL(1))) - IF (.NOT.NEWS_READ()) RETURN - END DO - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - STAT = .TRUE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(FROM,TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - HEADER_SEEN = .FALSE. - LF_SEEN = .FALSE. - LAST_LF_SEEN = .FALSE. - REAL_LF_SEEN = .FALSE. - LAST_REAL_LF_SEEN = .FALSE. - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8 - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONE - CHARACTER*4 ZONE - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/ - - CHARACTER*8 TIMES(1) - DATA TIMES /'-5:30'/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - IF (INDEX(ZONES,ZONE)/4.LT.4) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) - END IF - ELSE - HOUR = '00:00' - END IF - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_TI_L(TIME(:2),DATE,,%VAL(1)) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - SENDER_LINE = ' ' - NEWSGROUPS = ' ' - FOLLOWUP = ' ' - LREF = 0 - NEWS2BULL = .FALSE. - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.'.OR..NOT.LAST_REAL_LF_SEEN) - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126) - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(FROM,BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+6).EQ.'Sender:'.AND.EB.GE.SB+8) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+8:EB))+SB+7 - SENDER_LINE = ': '//BUFFER(SB1:EB) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+11).EQ.'Followup-To:'.AND. - & EB.GT.SB+12) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+13:EB))+SB+12 - FOLLOWUP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (INDEX(BUFFER(SB:), - & 'NNTP-Posting-Host:').EQ.1) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - CALL LOWERCASE(BUFFER(SB+19:EB)) - SAMEHOST = STREQ(PATHNAME(2:LPATH),BUFFER(SB+19:EB)) - ELSE IF (INDEX(BUFFER(SB:), - & 'X-Newsreader: News2bull').EQ.1) THEN - NEWS2BULL = .TRUE. - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN - IF (SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = SENDER_LINE(:TRIM(SENDER_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - ELSE - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - CALL GET_FROM(FROM,FROM_LINE(7:),TRIM(FROM_LINE)) - END IF - LAST_FROM = .TRUE. - ELSE - LAST_FROM = .FALSE. - END IF - IF (.NOT.LAST_FROM.AND.SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = 'From'//SENDER_LINE - END IF - END IF - END DO - - NEWS2BULL = NEWS2BULL.AND.SAMEHOST - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'1FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - START = -1 - CALL NEWNEWS(IN_BTIM,IER) - IF (IER.NE.0) START = IER -C -C The following code makes use of the NNTP command NEWNEWS, but is -C known to be slow and buggy in many servers. -C -C IER = SYS$ASCTIM(,TIME,IN_BTIM,) -C CALL DATE_TIME(TIME) -C SKIP = 0 -C DO WHILE (SKIP.GE.0) -C IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( -C & FOLDER_NAME))//' '//TIME)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C IF (BUFFER(:2).EQ.'23') THEN -C IF (.NOT.NEWS_READ()) CALL EXIT -C DO I=1,SKIP -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (FIRST.EQ.'.') RETURN -C DO WHILE (BUFFER(SB:EB).NE.'.') -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) -C & CALL EXIT -C IF (.NOT.NEWS_READ()) CALL EXIT -C IF (BUFFER(:2).EQ.'22') THEN -C IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN -C I = F_NBULL + 1 -C DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. -C & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) -C & .OR.I.GT.F_NBULL)) -C I = I - 1 -C IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN -C IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C END DO -C IF (I.GE.F_START) START = I -C ELSE -C IER = OTS$CVT_TI_L(BUFFER(SB+4: -C & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) -C END IF -C RETURN -C END IF -C END IF -C SKIP = SKIP + 1 -C END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2 - IER = IER1 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - CHARACTER*256 TEMP - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IF - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0 - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE - IER = NEWS_READ() - IF (IER.AND.(BUFFER(SB:EB).NE.'.' - & .OR..NOT.LAST_REAL_LF_SEEN)) THEN - IER = 0 - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THEN - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF ((INDEX(TEMP,': ').EQ.0.AND. - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255).OR. - & (LTEMP.EQ.254.AND..NOT.LAST_LF_SEEN)) THEN - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IF - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IF - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF - ELSE - HEADER_SEEN = .TRUE. - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128 - ELSE - ILEN = 128 - END IF - END IF - ELSE - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ABS(ILEN).EQ.128) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - HEADER_SEEN = .TRUE. - - RETURN - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /READIT/ READIT - - COMMON /NEWS_INIT/ END_READ - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - CHARACTER*64 ALT_SAVE - - DIMENSION DUMMY(4) - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - ALT_SET_SAVE = ALT_SET() - IF (ALT_SET_SAVE) CALL UNSET_ALT - END_READ = 0 - IER = 0 - IF (.NOT.NEWS_LOGIN()) THEN - IER = 2 - IF (.NOT.TEST_ALT(FOLDER1)) RETURN - IER = 1 - END IF - IF (IER.NE.1) CALL NEWS_GROUP(IER) - IF (IER.EQ.1) THEN - IF (TEST_ALT(FOLDER1)) THEN - IER1 = SET_ALT(ALT_FOUND) - IF (IER1) CALL NEWS_GROUP(IER) - IF (.NOT.IER1.OR.IER.NE.0) THEN - CALL UNSET_ALT - IF (ALT_SET_SAVE) IER = SET_ALT(ALT_SAVE) - RETURN - END IF - ALT_SAVE = FOLDER1(INDEX(':',FOLDER1)+1:) - IER = 0 - ELSE IF (ALT_SET_SAVE) THEN - IER = SET_ALT(ALT_SAVE) - END IF - RETURN - END IF - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY) - IF (SYSLOG) THEN - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3)) - END IF - END IF - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUP - - CHARACTER*8 NUMBER - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURN - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1 - RETURN - ELSE IF (ICOUNT.EQ.-1) THEN - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THEN - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURN - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - START = ICOUNT - BULLETIN_NUM = START - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0 - CALL NEWS_HEADER(IER) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - BLOCK = START - MSG_NUM = START - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN - END - - - - SUBROUTINE NEWS_GROUP(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN - IER = 1 - RETURN - END IF - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)) - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT') - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURN - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME - - CHARACTER*28 TIME - - DIMENSION DIFF(2) - - I = 1 - LTIME = TRIM(INTIME) - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:)) - - DO J = 1,2 - I = 1 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-' - END DO - - IF (I.EQ.LEN(TIME)) RETURN - - IF (TIME(I+3:I+3).EQ.' ') THEN - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IF - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DO - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - IF (INDEX(TIME(:I-2),'.').GT.0) THEN - CALL SYS_BINTIM(TIME(:INDEX(TIME(:I-2),'.'))//'00',BTIM) - ELSE IF (TIME(I-4:I-4).EQ.':'.AND.TIME(I-7:I-7).EQ.':') THEN - CALL SYS_BINTIM(TIME(:I-2)//'.00',BTIM) - ELSE - CALL SYS_BINTIM(TIME(:I-2)//':00.00',BTIM) - END IF - - IF (TIME(I:I).EQ.'+'.OR.TIME(I:I).EQ.'-') THEN - IER = SYS_BINTIM('0 '//TIME(I+1:I+2)//':'//TIME(I+3:I+4),DIFF) - IF (IER) THEN - IF (TIME(I:I).EQ.'-') THEN - IER = LIB$SUBX(BTIM,DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,DIFF,BTIM) - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE NEWS_LIST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - COMMON /NEWSLIST/ NEWSLIST - - CHARACTER TODAY*24 - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR. - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER)) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - NEWS_FOLDER1_BBOARD = '::' - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14 - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNT - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1 - IF (IER.EQ.0.AND.IER1.EQ.0) - & NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) ! Old bug caused this. - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)// - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - END IF - IF (FLEN.LE.44.OR.FLEN-44+EB-SP+1.LT. - & LEN(NEWS_FOLDER1_DESCRIP)) THEN - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - END IF - ELSE - CALL UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - OPEN (UNIT=33,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',SHARED) - - DO WHILE (IER.EQ.0) - READ (33,'(A)',IOSTAT=IER) INPUT - IF (IER.EQ.0) THEN - FLEN = INDEX(INPUT,':')-1 - NEWS_FOLDER1 = INPUT(:FLEN) - IF (SET_ALT(INPUT(FLEN+2:))) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER1) - IF (IER1.NE.0) THEN - FOLDER1_DESCRIP = NEWS_FOLDER1 - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = INPUT(45:FLEN) - ELSE - NEWS_FOLDER1_DESCRIP = ' ' - END IF - END IF - CALL NEWS_GROUP(IER) - IF (IER.EQ.0) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - IF (IER1.NE.0) THEN - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - ELSE - CALL UPDATE_NEWS_ENTRY(.FALSE.,LOCAL_UPDATE,FLEN,0) - END IF - END IF - END IF - END IF - IF (IER.NE.0) CLOSE (UNIT=33) - IF (ALT_SET()) THEN - CALL UNSET_ALT - IF (.NOT.NEWS_LOGIN()) RETURN - END IF - END DO - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.1.AND.TEST_ALT(NEWS_FOLDER1// - & NEWS_FOLDER1_DESCRIP)) THEN - IER = 0 - ELSE IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.F1_START.AND. - & NEWS_F1_FIRST.GT.F1_NBULL) THEN - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE), - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (((F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND..NOT.BTEST(NEWS_F1_FLAG,8)) THEN - DELETE (UNIT=7) - IER = 0 - ELSE IF (IER.EQ.1) THEN - IF (NEWS_F1_NBULL.LT.NEWS_F1_START - & .OR.NEWS_F1_START.EQ.0) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(NEWS_F1_START,IER1) - CALL CLOSE_BULLDIR - IER1 = NEWS_F1_START+1.EQ.IER1 - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - IF (.NOT.IER1) DELETE (UNIT=7) - END IF - IER = 0 - END IF - END IF - END DO - END IF - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - NEWSLIST = .FALSE. - - IF (SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED')) CALL RECOUNT - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DO - - RETURN - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4 - - COMMON /LOCALPOST/ LOCAL_POST - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /TEMP_INPUT/ GROUP_TEMP - CHARACTER GROUP_TEMP*256 - - COMMON /HEADER/ HEADER - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER RESPONSE*4 - - CHARACTER TODAY*24,UNAME*132 - DATA UNAME /'()'/ - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /NEWS2BULL/ NEWS2BULL - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1) - IF (IER1.NE.0) RETURN - ELSE - REWIND (UNIT=3) - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900 - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3) - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSE - I = INDEX(NEWS_MSGID,'.') - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & NEWS_MSGID(:I-1)// - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256) - IF (IER.NE.0) RETURN - LOCAL_POST = .TRUE. - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1 - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP - ELSE IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - IF (TRIM(FOLLOWUP).EQ.0) THEN - INPUT = 'Newsgroups: '//NEWSGROUPS - IF (INDEX(NEWSGROUPS,',').GT.0) THEN - WRITE (6,'('' Warning: Original message was cross'', - & ''posted to the following news groups:'')') - DO I=1,TRIM(NEWSGROUPS),PAGE_WIDTH - WRITE (6,'(1X,A)') NEWSGROUPS(I: - & I-1+MIN(PAGE_WIDTH,TRIM(NEWSGROUPS(I:)))) - END DO - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Type Y if you want your reply crossposted also, '// - & 'N for no: (default = Y) ') - IF (RESPONSE(:1).EQ.'n'.OR.RESPONSE(:1).EQ.'N') THEN - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - END IF - ELSE - INPUT = 'Newsgroups: '//FOLLOWUP - END IF - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE.AND. - & .NOT.NEWS_FEED()) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER) - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0 - DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP)) - IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP) - DO WHILE (TRIM(GROUP_TEMP).GT.0) - COMMA = INDEX(GROUP_TEMP,',') - IF (COMMA.GT.0) THEN - FOLDER1_NAME = GROUP_TEMP(1:COMMA-1) - GROUP_TEMP = GROUP_TEMP(COMMA+1:) - ELSE - FOLDER1_NAME = GROUP_TEMP - GROUP_TEMP = ' ' - END IF - CALL LOWERCASE(FOLDER1_NAME) - FLEN = TRIM(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1) - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9) - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND. - & INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND. - & INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST), - & GROUP_LIST,FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - ELSE - WRITE (6,'(1X,A,'' is not a valid news group.'')') - & FOLDER1_NAME(:FLEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to specify it? (default = Y) ') - IF (RESPONSE(:1).NE.'n'.AND. - & RESPONSE(:1).NE.'N') THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - END IF - END IF - END DO - END DO - CALL CLOSE_BULLNEWS - END IF - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900 - END IF - ATSIGN = INDEX(PATHNAME,'@') - PCSIGN = INDEX(PATHNAME,'%') - CALL LOWERCASE(USERNAME) - IF (FILENAME.EQ.'cancel'.AND.SUBJECT(:6).EQ.'CanceL') THEN - IF (.NOT.NEWS_WRITE('Path: cyberspam!usenet')) GO TO 900 - ELSE - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - END IF - END IF - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME) - - IF (FILENAME.NE.'cancel') THEN - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - END IF - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED').AND. - & SYS_TRNLNM('MX_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED').AND. - & SYS_TRNLNM('PMDF_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MULTINET_ROOT','DEFINED').AND. - & SYS_TRNLNM('MULTINET_SMTP_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - CALL STR$UPCASE(FROM_LINE,FROM_LINE) - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME) - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (SENDER_LINE.NE.' ') THEN - IF (.NOT.NEWS_WRITE(SENDER_LINE(:TRIM(SENDER_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE(FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - ELSE - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ILEN = TRIM(INPUT) - IF (INPUT(:5).EQ.'From:') THEN - GROUP_TEMP = INPUT - ELSE IF (INPUT(:7).EQ.'Sender:') THEN - GROUP_TEMP = 'From:'//INPUT(8:) - ILEN = 0 - END IF - END DO - ILEN = TRIM(GROUP_TEMP) - IF (ILEN.NE.0) THEN - IF (.NOT.NEWS_WRITE(GROUP_TEMP(:ILEN))) RETURN - END IF - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - - IF (FILENAME.EQ.'cancel'.AND.SUBJECT(:6).EQ.'CanceL') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel ')) GO TO 900 - ELSE IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'// - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE IF (TRIM(SUBJECT).EQ.0) THEN - IF (.NOT.NEWS_WRITE('Subject: (none)')) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECT - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) - & GO TO 900 - END IF - - IF (NGROUPS.GT.0) THEN - FROM = USERNAME - DESCRIP = SUBJECT - END IF - - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//PATHNAME(:LPATH)//'>')) GO TO 900 - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION) - END IF - LORGAN = TRIM(ORGANIZATION) - END IF - - IF (FILENAME.NE.'cancel'.AND.LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN))) - & GO TO 900 - END IF - - IF (.NOT.USE_INFROM.OR.COMPARE_DATE(TODAY(:11),DATE).GT.13) THEN - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & ZONE(:LZONE))) GO TO 900 - ELSE - TODAY = DATE(:2)//' '//DATE(4:6)//' '//DATE(10:) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & TIME(:8)//' '//ZONE(:LZONE))) GO TO 900 - END IF - - INPUT_HEADER = .FALSE. - - IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel')) THEN - EXPR = NEWS_FEED().OR.USE_INFROM - IF (.NOT.EXPR) EXPR = CLI$PRESENT('EXPIRATION') - IF (EXPR) THEN - I = INDEX(EXDATE,'-') - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE( - & FIRST_ALPHA(EXDATE):2) - & //' '//EXDATE(I+1:I+3)//' '//EXDATE(I+7:TRIM(EXDATE)) - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900 - ELSE IF (REMOTE_SET.EQ.4) THEN - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT) - END IF - EXTIME = '00:00:00.00' - END IF - IF (.NOT.NEWS_FEED()) THEN - IF (CLI$GET_VALUE('FOLLOWUP',GROUP_TEMP)) THEN - CALL LOWERCASE(GROUP_TEMP) - IF (.NOT.NEWS_WRITE('Followup-To: ' - & //GROUP_TEMP(:TRIM(GROUP_TEMP)))) GO TO 900 - END IF - END IF - END IF - - IF (CREATE) THEN - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURN - END IF - - IF (NEWS_FEED().OR.NEWS2BULL) THEN - IF (.NOT.NEWS_WRITE('X-Newsreader: News2bull')) GO TO 900 - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (SUBJECT(:6).EQ.'CanceL') THEN - IF (.NOT.NEWS_WRITE('Control: cancel ')) RETURN - ELSE IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - END IF - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (SUBJECT(:6).EQ.'CanceL') THEN - IF (SUBJECT.EQ.'CanceL') THEN - WRITE (6,1055) - ILEN = LINE_LENGTH + 1 ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - IF (.NOT.NEWS_WRITE(INPUT(:ILEN))) RETURN - END IF - END DO - ELSE - IF (.NOT.NEWS_WRITE(SUBJECT(7:TRIM(SUBJECT)-6))) RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).EQ.'240') IER = 0 - ELSE - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - CALL STR$UPCASE(USERNAME,USERNAME) - LOCAL_POST = .FALSE. - RETURN - END IF - - IF (.NOT.INPUT_HEADER) THEN - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2 - END IF - IF (IER1.EQ.0) THEN - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DO - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') THEN - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:MIN(79+SB,EB)) - IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN - WRITE (6,'('' Use /INDENT to change indentation'',$)') - WRITE (6,'(''+ character. See Manager for permanent'',$)') - WRITE (6,'(''+ change.'')') - END IF - END IF - ELSE - LENGTH = (LENGTH+127)/128 - GROUP_LIST = GROUP_LIST1 - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - SAVE_BULL_POINT = BULL_POINT - OLD_NBULL = NBULL - DO I=NGROUPS,1,-1 - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1) - FOLDER_NUMBER = -1 - OLD_NBULL = NBULL - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL ADD_LOCAL_NEWS(8) - CALL ADD_TAG(IER,2) - IF (NEWS_FIND_SUBSCRIBE().LT.FOLDER_MAX) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER1) - IF (IER1.EQ.0.OR.IER1.EQ.OLD_NBULL+1) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(OLD_NBULL+1) - END IF - END IF - END IF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - BULL_POINT = SAVE_BULL_POINT - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - CALL STR$UPCASE(USERNAME,USERNAME) - - LOCAL_POST = .FALSE. - -1055 FORMAT(' State reason for deleting message not owned by you:') - - RETURN - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURN - END IF - END IF - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME) - LPATH = TRIM(PATHNAME) - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NAME - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME) - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE. - END DO - - TEST_NEWS = MAYBE_NEWS - - RETURN - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) RETURN - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULL - FIRST = F1_START - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - REMOTE_SET = 3 - CALL OPEN_BULLDIR_SHARED - I = F_LAST + 1 - IER = I - 1 - DO WHILE (I.NE.IER.AND.I.LE.LAST) - CALL READDIR(I,IER) - I = I + 1 - END DO - CALL CLOSE_BULLDIR - CALL OTS$CVT_L_TI(I-1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNT - NEW_NEWS_F_END = NEWS_F_END - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - F_LAST = LAST - NEWS_F_FIRST = FIRST - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE NEWS2BULL(RECLAIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - DATA BULLCP_NEWS /.FALSE./ - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBER - - DIMENSION NOW(2) - - BULLCP_NEWS = .TRUE. - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV - - CALL DELETE_EXPIRED_NEWS(RECLAIM) - - IF (RECLAIM) CALL EXIT - - CALL SEND_POST - IF (ALT_SET()) CALL UNSET_ALT - - CALL NEWS_LIST - - CALL UPDATE_LOCAL_NEWS - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - IF (NEWS_FEED()) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARD - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (IER) THEN - SAVE_LAST = F_LAST - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER) - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN - SAVE_LAST = F_NBULL - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LAST - FOLDER_BBOARD = 'NONEFEED' - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - IF (FOLDER_BBOARD.EQ.'NONEFEED') THEN - CALL SETUSER('SYSTEM') - ELSE - CALL SETUSER(FOLDER_BBOARD) - END IF - REMOTE_SET = 3 - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/LOCAL/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1) - END IF - CALL CLOSE_BULLFOLDER - CALL SETUSER(USERNAME) - END IF - END IF - END DO - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - CHARACTER*(*) TIME - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+ - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)// - & TIME(16:17)//TIME(19:20) - - RETURN - END - - - - SUBROUTINE ALLPRIV - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1 - PROCPRIV(2) = -1 - NEEDPRIV(1) = -1 - NEEDPRIV(2) = -1 - - RETURN - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COM - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - RETURN - END - - - - SUBROUTINE SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')') - RETURN - END IF - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE - WRITE (6,'('' You are now subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - CALL UPDATE_USERINFO - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - LAST_NEWS_READ(2,J) = F_START - 1 - ELSE - LAST_NEWS_READ2(2,J) = 0 - LAST_NEWS_READ(2,J) = F_NBULL - END IF - CALL CLOSE_BULLNEWS - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - CALL UPDATE_USERINFO_NEWS_ALWAYS - RETURN - END IF - END DO - - END - - - - - - SUBROUTINE UNSUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_EXPIRED - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.LE.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Folder is permanent and cannot not be'', - & '' unsubscribed.'')') - RETURN - END IF - - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - CALL UPDATE_USERINFO - - I = NEWS_FIND_SUBSCRIBE() - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - - CALL FREE_TAGS(I) - - IF (NINCLUDE.GT.0) WRITE (6,'('' Note: Excludes and/or '', - & ''threads exist for this group.'')') - - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - CALL UPDATE_USERINFO_NEWS_ALWAYS - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (IER.EQ.0) IER = 1 ! None read yet. - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE1() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR.(LAST_NEWS_READ(2,I) - & .GT.NEWS_F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0 - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THEN - COUNT = COUNT + 1 - END IF - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT) - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE - SUBNUM = 0 - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES) -C -C SUBROUTINE NEWS_NEW_NOTIFICATION -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - MESSAGES = .FALSE. - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1 - - FOLDER_DESCRIP = ' ' - REORDER = 0 - DO WHILE (SUBNUM.GT.0) - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUM - UNLOCK 7 - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1 - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - ELSE IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR. - & F_START.GT.F_NBULL) THEN - IER = 1 - END IF - END IF - IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (DIFF.GT.0) IER = 1 - END IF - END IF - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - ELSE - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IF - END IF - END DO - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE - - CALL CLOSE_BULLNEWS - - RETURN - END - - - SUBROUTINE REORDER_SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0) - I = I + 1 - END DO - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1 - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1) - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2 - TEMP = LAST_NEWS_READ(L,J) - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K) - LAST_NEWS_READ(L,K) = TEMP - END DO - END IF - END DO - END DO - - RETURN - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE = I - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE1 = I - - RETURN - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - IP = 1 - DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER - & .AND.IP.LE.FOLDER_MAX-1) - IP = IP + 1 - END DO - - IER = .TRUE. - - IF (IP.EQ.FOLDER_MAX) THEN - PERM = .FALSE. - IP = 1 - ELSE - PERM = .TRUE. - END IF - - IF (NOTIFY.EQ.0) THEN - IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).AND. - & .NOT.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (BTEST(INF_REC2(2,IP),14)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - END IF - - IF (BTEST(INF_REC2(2,IP),15)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - END IF - END IF - - CALL UPDATE_USERINFO - - RETURN - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - REWIND UNIT - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '// - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK) - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6, - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) - END IF - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1 - SYSTEM = 0 - CALL ADD_ENTRY - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE UPDATE_NEWS_FOLDER -C -C SUBROUTINE UPDATE_NEWS_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1 - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_EX_BTIM_KEY - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE SEND_POST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - CHARACTER FILE*132 - - C = 0 - - IF (.NOT.NEWS_LOGIN()) RETURN - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST',FILE,C)) -50 IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'340') RETURN - - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (INPUT(:5).EQ.'From:') BULL_PARAMETER = INPUT(7:) - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IF - END DO - IF (INPUT.NE.'.') THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - IF (BUFFER(:3).EQ.'441'.AND..NOT.ALT_SET()) THEN - REWIND (UNIT=3) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0.AND.INPUT(:12).EQ.'Newsgroups: ') THEN - CLOSE (UNIT=3) - IF (TEST_ALT(INPUT(13:))) THEN - CALL SET_ALT(ALT_FOUND) - GOTO 50 - END IF - IER = 2 - END IF - END DO - CLOSE (UNIT=3) - END IF - IF (BUFFER(:3).NE.'240') THEN - CLOSE (UNIT=3) - CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER) - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - END IF - CLOSE (UNIT=3,STATUS='DELETE') - IF (ALT_SET()) CALL UNSET_ALT - END DO - -100 CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVS - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST) - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - - IF (UNAME.EQ.'()') THEN - UNAME = ' ' - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IF - - RETURN - END - - - - SUBROUTINE RECOUNT -C -C SUBROUTINE RECOUNT -C -C FUNCTION: -C -C Fixes the message count of stored news groups. This may become wrong -C if old copies of some of the database files are used with newer versions. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - REMOTE_SET = 4 - - DO WHILE (IER.EQ.0) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - END DO - - IF (BTEST(NEWS_F_FLAG,8).AND.IER.EQ.0) THEN - CALL NEWS_TO_FOLDER - - CALL OPEN_BULLDIR_SHARED - - NUM = F_START - F_COUNT = 0 - - IF (F_START.GT.0) THEN - CALL READDIR(NUM,IER) - NEXT = .TRUE. - F_START = NUM - DO WHILE (NUM+1.EQ.IER) - F_COUNT = F_COUNT + 1 - NUM = NUM + 1 - IF (NUM.LE.F_NBULL) CALL READDIR(NUM,IER) - END DO - NEXT = .FALSE. - - F_NBULL = NUM - 1 - END IF - - CALL CLOSE_BULLDIR - - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - - CALL DELLNM('BULL_NEWS_RECOUNT') - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE DELLNM(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$SYSTEM',LOG,PSL$C_SUPER) - - RETURN - END - - - SUBROUTINE DELLNM_USER(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$PROCESS',LOG,PSL$C_USER) - - RETURN - END - - - SUBROUTINE NEWNEWS(SINCE_BTIM,FOUND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - DIMENSION SINCE_BTIM(2) - - START = F_START - END = F_NBULL - - FOUND = 0 - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - IF (.NOT.NEWS_READ()) RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (FOUND.EQ.0) THEN - L = INDEX(BUFFER(SB:EB),' ') - CALL OTS$CVT_TI_L(BUFFER(SB:SB+L-2),IER,,%VAL(1)) - CALL NEWS_TIME(BUFFER(SB+L:EB),MSG_BTIM) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) - & FOUND = IER - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (FOUND.NE.0) THEN - IF (.NOT.OTS$CVT_L_TI(FOUND,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END.AND.FOUND.EQ.0) - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) FOUND = MSG_NUM - I = I + 1 - IF (REMOTE_SET.EQ.3.AND.I.LE.END.AND.FOUND.EQ.0) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - IF (FOUND.EQ.0) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - - RETURN - END - - - - LOGICAL FUNCTION TEST_ALT(FOLDER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - CHARACTER*(*) FOLDER1 - - TEST_ALT = .FALSE. - - OPEN (UNIT=3,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',SHARED) - - IF (IER.NE.0) RETURN - - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) ALT_FOUND - IF (STREQ(ALT_FOUND(:INDEX(ALT_FOUND,':')-1), - & FOLDER1(:TRIM(FOLDER1)))) THEN - ALT_FOUND = ALT_FOUND(INDEX(ALT_FOUND,':')+1:) - CLOSE (UNIT=3) - TEST_ALT = .TRUE. - RETURN - END IF - END DO - - CLOSE (UNIT=3) - - RETURN - END - - - - LOGICAL FUNCTION SET_ALT(NEWALT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NEWALT - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - DATA SETALT/.FALSE./ - - SET_ALT = .FALSE. - - IF (SETALT) THEN - IF (NEWALT.EQ.ALT) THEN - SET_ALT = .TRUE. - RETURN - ELSE - CALL UNSET_ALT - END IF - END IF - - CALL NEWS_LOGOUT - - CALL CRELNM('BULL_NEWS_SERVER',NEWALT(:TRIM(NEWALT))) - - IF (NEWS_LOGIN()) THEN - SET_ALT = .TRUE. - SETALT = .TRUE. - ALT = NEWALT - ELSE - CALL DELLNM_USER('BULL_NEWS_SERVER') - SETALT = .FALSE. - END IF - - RETURN - END - - - - SUBROUTINE UNSET_ALT - - IMPLICIT INTEGER (A-Z) - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - CALL DELLNM_USER('BULL_NEWS_SERVER') - - CALL NEWS_LOGOUT - - SETALT = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALT_SET() - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - ALT_SET = SETALT - - RETURN - END - - - - SUBROUTINE ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION EXPIRED(2) - - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLEN - NEWS_F1_COUNT = NEWS_F_COUNT - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN - NEWS_FOLDER = NEWS_FOLDER(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - NEWS_F_COUNT = NEWS_F1_COUNT - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - IF (IER2.EQ.0) THEN - NEWS_F1_FLAG = NEWS_F_FLAG - NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN - NEWS_F1_EXPIRE = NEWS_F_EXPIRE - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1) - IF (BTEST(NEWS_F1_FLAG,8)) THEN - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_LAST = 0 - END IF - - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE. - IF (SP.GT.0) THEN - IF (FLEN.GT.44) THEN - IF (NEWS_FOLDER1_DESCRIP.NE. - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE - UPDATE = .TRUE. - END IF - IF (SPECIAL) THEN - IF (UPDATE) THEN - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF - ELSE IF (.NOT.UPDATE) THEN - UPDATE = F1_START.LT.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - - RETURN - END diff --git a/decus/vlt97a/bulletin/bulletin11.for b/decus/vlt97a/bulletin/bulletin11.for deleted file mode 100644 index bcaae91..0000000 --- a/decus/vlt97a/bulletin/bulletin11.for +++ /dev/null @@ -1,3536 +0,0 @@ -C -C BULLETIN11.FOR, Version 4/5/97 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('CURRENT')) THEN - MESSAGE_NUMBER = BULL_POINT - ELSE IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - IF (.NOT.BULL_NEWS_TAG) RETURN - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*12 BULL_MARK_DIR - CHARACTER*12 TAG_KEY,INPUT_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,) - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1) - ELSE - UNLOCK 13 - END IF - END IF - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - ELSE - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - BULL_NEWS_TAG = .FALSE. - RETURN - END IF - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),) - IF (IER1.NE.0) THEN - CLOSE (UNIT=23) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=128,DISPOSE='DELETE', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1) - NEWS_MARK2(1) = NEWS_MARK2(2) - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE') - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - CALL ERRSNS(IDUMMY,IER2) - IF (IER2.NE.RMS$_RNF) SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURN - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1), - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IF - - RETURN - END - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - - CHARACTER*12 BULL_MARK_DIR - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSE - MARKUNIT = 23 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1 - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEY - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IF - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY) - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURN - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - TAG_TYPE = 0 - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR. - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN - IF (IER.EQ.0) UNLOCK 13 - IER = 0 - MESSAGE = MSG_NUM - ELSE - IER = 36 - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - IER = 36 - - HEADER = .FALSE. - - TAG_TYPE = 0 - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) THEN - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:) - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THEN - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I) - IER = 0 - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - MSG_KEY = NEXT_MSG_KEY - RETURN - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DO - - RETURN - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - DO MESSAGE = MSG_NUM+1,F_NBULL - CALL READDIR(MESSAGE,IER) - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE) - IF (IER.EQ.0) THEN - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END DO - - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2) - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURN - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER) - & INPUT_KEY - END DO - - CLOSE_IT = .FALSE. - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - CALL DECREMENT_MSG_KEY - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR_SHARED - CLOSE_IT = .TRUE. - END IF - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - DELETE (UNIT=13) - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER)) - READ (13,IOSTAT=IER) INPUT_KEY - END DO - END IF - END IF - - END DO - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE. - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1 - DO M=1,2 - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1 - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1 - LIMIT = 256/(NEWS_FORMAT+1) - NEWS_NUMBER = LAST_NEWS_READ2(1,I) - K = 5-NEWS_FORMAT*2 - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1 - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IF - SET_LIST = .FALSE. - END IF - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0) - END DO - K = LIMIT + 1 - END IF - IF (K.GT.LIMIT) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2 - NEWS_REC = NEWS_REC + 1 - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - IF (IER.EQ.0) THEN - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IF - END DO - END IF - END DO - END DO - CLOSE (UNIT=23) - END IF - - RETURN - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = J - ELSE - NEWS_MARK(I) = J - END IF - - RETURN - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG) - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUM - NEWS_TAG(I) = 0 - END DO - - RETURN - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - DO I=1,2 - IF (NEWS_TAG(3,I,ISUB).GT.0) THEN - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB)) - NEWS_TAG(3,I,ISUB) = 0 - NEWS_NUMBER = NEWS_FOLDER_NUMBER - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER) - END IF - END DO - IF (IER.EQ.0) UNLOCK 23 - END IF - - DO J=I,FOLDER_MAX-2 - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J)) - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0 - END DO - END DO - - RETURN - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY - - IER = 36 - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE) - IF (IER.EQ.0) THEN - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THEN - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM) - END IF - IER = 36 - END IF - END IF - END DO - BULL_READ = MSG_NUM - IF (CLOSE_IT) CALL CLOSE_BULLDIR - ELSE - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0 - MSG_KEY = BULLDIR_HEADER - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THEN - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36 - END IF - END IF - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*24 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - SUBROUTINE SENDMAIL(FILE,TO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE '($MAILDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - CHARACTER*(*) FILE,TO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1)) - - CALL DISABLE_PRIVS - - SENDTO = TO - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))// - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:) - END DO - - IF (USE_INFROM.AND.(SYS_TRNLNM('TWF$TCP','DEFINED').OR. - & SYS_TRNLNM('MULTINET_SOCKET_LIBRARY','DEFINED').OR. - & SYS_TRNLNM('UCX$DEVICE','DEFINED')) - & .AND..NOT.SYS_TRNLNM('BULL_DISABLE_SMTP','DEFINED')) THEN - IER = SYS$ASCTIM(,INPUT,,) - INPUT = INPUT(:2)//INPUT(4:6)//INPUT(10:11)// - & INPUT(13:14)//INPUT(16:17)//INPUT(19:20)// - & INPUT(22:23) - IF (INPUT(:1).EQ.' ') INPUT = INPUT(2:) - OPEN (UNIT=8,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & INPUT(:TRIM(INPUT))//'.SMTP',IOSTAT=IER1, - & STATUS='NEW',RECL=256) - IF (IER1.EQ.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - WRITE (8,'(A)',IOSTAT=IER) 'helo '//PATHNAME(:LPATH) - INPUT = INFROM - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - END IF - WRITE (8,'(A)',IOSTAT=IER) 'MAIL FROM:<'// - & INPUT(:TRIM(INPUT))//'>' - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - WRITE (8,'(A)',IOSTAT=IER) 'RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>' - WRITE (8,'(A)',IOSTAT=IER) 'DATA' - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - WRITE (8,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER) - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.EQ.0) THEN - WRITE (8,'(A)',IOSTAT=IER) INPUT(:L) - END IF - END DO - CLOSE (UNIT=3) - REWIND (UNIT=8,IOSTAT=IER) - IF (IER.NE.0) THEN - CLOSE (UNIT=8,STATUS='DELETE') - IER1 = 2 - END IF - END IF - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('helo '//PATHNAME(2:LPATH)//CRLF)) - & GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - INPUT = INFROM - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - END IF - IF (.NOT.SMTP_WRITE_PACKET('MAIL FROM:<'//INPUT(:TRIM(INPUT)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - IF (.NOT.SMTP_WRITE_PACKET('RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('DATA'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:TRIM(INPUT))//CRLF)) - & GOTO 10 - END DO - IF (NHEAD.GT.0.AND..NOT.SMTP_WRITE_PACKET(CRLF)) GOTO 10 - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER2) - DO WHILE (IER2.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER2) L,INPUT - IF (IER2.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) IER2 = 2 - END IF - END DO - CLOSE (UNIT=3) - IF (IER2.EQ.2) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IER2 = 1 - GOTO 20 -10 IER2 = 2 -20 CALL SMTP_DISCONNECT() - IF (IER1.EQ.0) THEN - IF (IER2) THEN - CLOSE (UNIT=8,STATUS='DELETE') - ELSE - CLOSE (UNIT=8) - END IF - END IF - CALL ENABLE_PRIVS - STATUS = 1 - RETURN - END IF - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR) - - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO)) - I = INDEX(SENDTO(J:),',') - 1 - IF (I.EQ.-1) I = TRIM(SENDTO(J:)) - CALL INIT_ITMLST - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - J = J + I - IF (SENDTO(J:J).EQ.',') J = J + 1 - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO)) - CALL END_ITMLST(ATTRIBUTE_ITMLST) - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - CALL LIB$REVERT - - RETURN - END - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,) - - RETURN - END - - - - - SUBROUTINE SET_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEXT/ NEXT - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DIMENSION EXPIRED(2) - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IF - - ENTRY SHOW_NEWS - - LIMIT = -2 - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1)) - IF (.NOT.IER.OR.LIMIT.LT.-1) THEN - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')') - RETURN - END IF - END IF - - EXPIRE = -1 - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1)) - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN - END IF - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR. - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')') - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - IF (CLI$PRESENT('DEFAULT')) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1 - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - RETURN - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE) - FOLDER1_NUMBER = NEWS_F1_COUNT - FOLDER1 = BULL_PARAMETER - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10) - CALL WRITE_FOLDER_FILE_TEMP(IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMP - REWRITE (7) NEWS_FOLDER1_COM - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER) - END IF - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - END IF - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS') - DEFAULT = CLI$PRESENT('DEFAULT') - ALL = CLI$PRESENT('ALL') - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE') - ENABLE = CLI$PRESENT('ENABLE') - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - - STORED = 0 - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN - WRITE (6,'('' Stored setting was not removed.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'[.BULLNEWS*]*.*;*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_SAVE = FOLDER - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - FOLDER = FOLDER_SAVE - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0 - F1_NBULL = 0 - F1_COUNT = 0 - F1_LAST = 0 - END IF - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3) - IF (IER.NE.0) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - END IF - CALL RESET_PROTECTION - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IF - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THEN - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')') - ELSE - WRITE (6,'('' Default is not stored.'')') - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS) THEN - WRITE (6,'('' Expiration is DEFAULT value.'')') - ELSE - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Default expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no default expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')') - ELSE - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - NOTIFY_FLAG_NEWS = .FALSE. - SET_FLAG_NEWS = .FALSE. - BRIEF_FLAG_NEWS = .FALSE. - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a default news group.'')') - ELSE - IER1 = 2 - END IF - END IF - NOTIFY_PERM_FLAG_NEWS = .FALSE. - SET_PERM_FLAG_NEWS = .FALSE. - BRIEF_PERM_FLAG_NEWS = .FALSE. - DO WHILE (REC_LOCK(IER2)) - READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC - END DO - IF (IER2.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a permanent news group.'')') - END IF - END IF - PERM = .FALSE. - IF (SET_FLAG_NEWS) THEN - IF (BRIEF_FLAG_NEWS) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE IF (BRIEF_FLAG_NEWS) THEN - IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - IF (.NOT.PERM) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (BRIEF_PERM_FLAG_NEWS.AND..NOT.SET_PERM_FLAG_NEWS) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (NOTIFY_FLAG_NEWS) THEN - IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' NOTIFY is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLINF - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IF - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER) - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) - END IF - FOUND = .FALSE. - MODALL = INDEX(GROUP,'.').NE.LG - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR. - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.')) - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER) - END DO - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER) - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - RETURN - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - END DO - END IF - - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - ALL = CLI$PRESENT('ALL') - FULL = CLI$PRESENT('FULL') - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (CLI$PRESENT('SUBJECT')) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IF - ELSE - INPUT = FROM - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:) - ELSE - INPUT = DESCRIP - END IF - END IF - LEN_P = TRIM(INPUT) - CALL CLOSE_BULLFIL - END IF - - SUB = CLI$PRESENT('SUBJECT') - DISABLE = CLI$PRESENT('DISABLE') - EXC = 0 - - GO TO 5 - - ENTRY INCLUDE_SUBJECT(EXCLUDE) - - IF (REMOTE_SET.GE.3.AND.NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) RETURN - - LEN_P = TRIM(INPUT) - ALL = .FALSE. - DISABLE = .FALSE. - SUB = .TRUE. - EXC = -1 - -5 IF (SUB) THEN - IF (DISABLE) THEN - IF (STREQ(INPUT(:3),'RE:')) INPUT = INPUT(5:) - INPUT = INPUT(:MIN(LEN_P,LEN(DESCRIP))) - LEN_P = TRIM(INPUT) - END IF - INPUT = 'SUBJECT:'//INPUT - LEN_P = LEN_P + 8 - ELSE - INPUT = 'FROM:'//INPUT - LEN_P = LEN_P + 5 - END IF - - IF (EXCLUDE) THEN - INPUT = ':exclude:'//INPUT - LEN_P = LEN_P + 9 - ELSE - INPUT = ':include:'//INPUT - LEN_P = LEN_P + 9 - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - FLEN = TRIM(FOLDER_NAME) - INPUT = FOLDER_NAME(:FLEN)//INPUT - ILEN = FLEN + LEN_P - - IF (EXC.EQ.0) THEN - EXC = -1 - IER = CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P) - IF (IER) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) EXC - IF (EXC.LT.0.OR.EXC.GT.999.OR.IER.NE.0) THEN - WRITE(6,'('' ERROR: Valid limit is 0-999.'')') - RETURN - END IF - END IF - END IF - - CHECK_ONLY = .FALSE. - - GO TO 100 - - ENTRY CHECK_EXCLUDES - - CHECK_ONLY = .TRUE. - DISABLE = .TRUE. - LEN_P = 0 - INPUT = ' ' - ILEN = 1 - -100 IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) THEN - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - CLOSE (UNIT=4,DISPOSE='SAVE') - RETURN - END IF - - IER = 0 - CONVERT = .FALSE. - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - I = STRFIND(OLD_BUFFER,':RE: ') - IF (IER.EQ.0) THEN - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THEN - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5) - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill' - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF ((STREQ(OLD_BUFFER(:ILEN),INPUT(:ILEN)).AND. - & OLD_BUFFER(ILEN+1:ILEN+1).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:OLEN),INPUT(:OLEN))).OR. - & (DISABLE.AND.I.GT.0.AND. - & ((STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:MAX(I+5,ILEN+4)), - & INPUT(:ILEN)).AND.OLD_BUFFER(ILEN+5:ILEN+5).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:OLEN), - & INPUT(:OLEN)))))) THEN - CONTINUE - ELSE IF (.NOT.(ALL.AND.STREQ(INPUT(:FLEN+8), - & OLD_BUFFER(:MIN(FLEN+8,OLEN))))) THEN - IER2 = OLD_BUFFER(:1).EQ.':'.OR. - & INDEX(OLD_BUFFER,':defaults:').GT.0 - IF (.NOT.IER2) THEN - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC1,BLIMIT,BDATE,IER1) - IF (IER1) IER2 = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1) - & ,' ').GT.-EXC1 - CONVERT = .NOT.IER1 - END IF - IF (.NOT.IER1.OR.EXC1.EQ.0.OR.IER2) - & WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN) - END IF - END IF - END DO - - IF (.NOT.DISABLE) THEN - IF (FULL) THEN - WRITE (4,'(A)',IOSTAT=IER) FOLDER_NAME(:FLEN)//':defaults:kill' - ELSE - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - - IF (CONVERT) THEN - WRITE (6,'('' NOTE: See help on the new SET EXLIMIT command.'')') - END IF - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - SUBROUTINE UPDATE_EXCLUDE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - DATA SCRATCH_B1/0/,NINCLUDE/0/,EXC_CHANGED/.FALSE./ - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - IF (.NOT.EXC_CHANGED) RETURN - EXC_CHANGED = .FALSE. - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (.NOT.(IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ. - & INPUT(:MIN(TRIM(FOLDER_NAME)+1,ILEN)).AND.INPUT(:1).NE.':' - & .AND.INDEX(INPUT,':defaults:').EQ.0)) THEN - IF (IER.EQ.0) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE SET_CUSTOM(PARAM) -C -C SUBROUTINE SET_CUSTOM -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - CHARACTER*(*) PARAM - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IF - - LENP = LEN(PARAM) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0.AND.PARAM(:LENP).NE.INPUT(2:LENP+1)) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - IF (CLI$GET_VALUE('SET_PARAM2',INPUT,ILEN)) THEN - WRITE (4,'(A)',IOSTAT=IER) ':'//PARAM(:LENP)//':'//INPUT(:ILEN) - END IF - - IF (PARAM.EQ.'exclude_limit') - & DECODE(ILEN,'(I)',INPUT(:ILEN)) EXCLUDE_LIMIT - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - DIMENSION BTIM(2) - - FILE_DIRECTORY = ' ' - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THEN - BULL_USER_CUSTOM = .FALSE. - ELSE - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IF - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - OPEN(UNIT=17,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURN - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - NINCLUDE = 0 - OLD_FORMAT = .FALSE. - FLEN = TRIM(FOLDER_NAME) - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL LOWERCASE(OLD_BUFFER) - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults') - & .EQ.1) THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - OLD_FORMAT = OLD_FORMAT.OR.(.NOT.IER1) - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXC - & .OR.EXC.EQ.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1 - ELSE - EXC_CHANGED = .TRUE. - END IF - END IF - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - IF (INDEX(OLD_BUFFER,':file_directory').GT.0) - & FILE_DIRECTORY = OLD_BUFFER(17:) - IF (INDEX(OLD_BUFFER,':exclude_limit').GT.0) THEN - DECODE(OLEN-15,'(I)',OLD_BUFFER(16:),IOSTAT=IER1) - & EXCLUDE_LIMIT - EXCLUDE_LIMIT = MIN(999,EXCLUDE_LIMIT) - END IF - END IF - END DO - - CLOSE (UNIT=17) - - IF (OLD_FORMAT) CALL CHECK_EXCLUDES - - RETURN - END - - - - - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /DIRMODE/ DIRMODE - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - CHARACTER*(*) STRING,STRING1 - CHARACTER*132 ADDRESS - - CHARACTER*12 EXFROM - - INCLUDE_MSG = .TRUE. - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURN - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - DO I=1,NINCLUDE - OLD_SCRATCH_B = SCRATCH_B - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - IF (STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (DIRMODE) BLIMIT = MIN(BLIMIT,FLEN+17+LEN(DESCRIP)) - - MATCH = .FALSE. - IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:')) THEN - CALL GET_FROM(EXFROM,OLD_BUFFER(FLEN+15:), - & TRIM(OLD_BUFFER(FLEN+15:))) - IF (STREQ(ADDRESS(STRING),ADDRESS(OLD_BUFFER(FLEN+15: - & TRIM(OLD_BUFFER(FLEN+15:BLIMIT))+FLEN+14))).OR. - & (DIRMODE.AND.STREQ(FROM,EXFROM))) MATCH = .TRUE. - ELSE IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND. - & STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER - & (FLEN+18:TRIM(OLD_BUFFER(FLEN+18:BLIMIT))+FLEN+17)).GT.0) - & THEN - MATCH = .TRUE. - END IF - IF (MATCH) THEN - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXC.OR. - & EXC.EQ.0) THEN - IF (OLD_BUFFER(BLIMIT+1:BLIMIT+1).EQ.':') EXC = -1 - CALL ADD_EXCL(OLD_BUFFER,BLIMIT,EXC) - CALL WRITE_QUEUE(%VAL(OLD_SCRATCH_B),OLD_SCRATCH_B, - & OLD_BUFFER) - EXC_CHANGED = .TRUE. - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THEN - SYSTEM = IBSET(SYSTEM,8) - ELSE - INCLUDE_MSG = .FALSE. - SYSTEM = IBCLR(SYSTEM,8) - END IF - END IF - END IF - END IF - END DO - - RETURN - END - - - - FUNCTION STRFIND(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) STRING,STRING1 - - L = LEN(STRING1) - DO I=0,LEN(STRING)-L - J = 1 - DO WHILE (J.LE.L) - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(STRING1(J:J)) - & .OR..NOT.ALPHA(STRING(I+J:I+J)))) THEN - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = I + 1 - RETURN - ELSE - J = J + 1 - END IF - END DO - END DO - - STRFIND = 0 - - RETURN - END - - - - - SUBROUTINE SHOW_EXCLUDE(TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (TYPE.EQ.0) WRITE (6,'('' There are no excludes.'')') - IF (TYPE.EQ.1) WRITE (6,'('' There are no threads.'')') - RETURN - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - FOUND = .FALSE. - - L = 1 - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - IF (STREQ(FOLDER_NAME(:FLEN)//':',OLD_BUFFER(:MIN(FLEN+1,OLEN))) - & .AND.((TYPE.EQ.1.AND.STREQ(OLD_BUFFER(FLEN+2:FLEN+8), - & 'INCLUDE')).OR.(TYPE.EQ.0.AND.STREQ( - & OLD_BUFFER(FLEN+2:FLEN+8),'EXCLUDE')))) THEN - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'Excludes for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'Threads for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - FOUND = .TRUE. - END IF - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (BLIMIT+5-FLEN.GT.PAGE_WIDTH.AND.L+2.GT.PAGE_LENGTH-1) THEN - L = L + 2 - ELSE - IF (L.EQ.0) THEN - WRITE (6,'(''+'',A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - ELSE - WRITE (6,'(1X,A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - END IF - IF (OLD_BUFFER(BDATE+1:BDATE+1).EQ.'-') - & OLD_BUFFER(BDATE:) = ' '//OLD_BUFFER(BDATE:) - OUTLEN = MIN(BLIMIT,PAGE_WIDTH+FLEN+9)-FLEN-9 - IF (OUTLEN.GT.PAGE_WIDTH-16) THEN - WRITE (6,'(1X,X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 2 - ELSE - WRITE (6,'(''+'',X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 1 - END IF - END IF - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & INPUT(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'No excludes found for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'No threads found for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - CHARACTER*12 NEW,OLD - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to set a new name.'')') - RETURN - END IF - - CALL CLI$GET_VALUE('OLDNAME',OLD,LENO) - CALL CLI$GET_VALUE('NEWNAME',NEW,LENN) - - CALL OPEN_BULLUSER_SHARED - - TEMP_USER = USERNAME - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY - END DO - - IF (IER.EQ.0) THEN - USERNAME = NEW - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=NEW) - END DO - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) USER_ENTRY - ELSE - REWRITE (4,IOSTAT=IER) USER_ENTRY - END IF - END IF - - USERNAME = TEMP_USER - DO WHILE (REC_LOCK(IER1)) - READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY - END DO - - CALL CLOSE_BULLUSER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Old name not found.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN))) - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - IF (LENO.GT.1) THEN - OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1))) - ELSE - OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2))) - END IF - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - IF (LENN.GT.1) THEN - NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1))) - ELSE - NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))) - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - SUBROUTINE CHECK_EXCL(BUFFER,L,EXC,BLIMIT,BDATE,IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - - CHARACTER*(*) BUFFER - - DIMENSION BTIM(2) - - BLIMIT = L - BDATE = L+3 - - IER = BUFFER(L:L).EQ.':' - IF (IER) THEN - I = LAST_INDEX(BUFFER(:L-1),':') - IF (I.GT.0) THEN - J = LAST_INDEX(BUFFER(:I-1),':') - IF (J.GT.0) THEN - IF (J.LT.I-1) THEN - DECODE(I-J-1,'(I)',BUFFER(J+1:I-1),IOSTAT=IER) EXC - IER = IER.EQ.0 - ELSE - EXC = EXCLUDE_LIMIT - END IF - IF (IER) BLIMIT = J - 1 - CALL STR$UPCASE(BUFFER(I+1:L-1),BUFFER(I+1:L-1)) - IF (IER) IER = SYS_BINTIM(BUFFER(I+1:L-1),BTIM) - BDATE = I + 1 - END IF - ELSE - IER = .FALSE. - END IF - END IF - - IF (.NOT.IER) CALL ADD_EXCL(BUFFER,L,-1) - - RETURN - END - - - - SUBROUTINE ADD_EXCL(BUFFER,L,EXC) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2) - - CHARACTER*(*) BUFFER - - CHARACTER TODAY*24 - - IF (EXC.EQ.-1) THEN - BUFFER = BUFFER(:L)//':' - ELSE - BUFFER = BUFFER(:L)//':' - WRITE (BUFFER(L+2:),'(I3)') EXC - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - BUFFER = BUFFER(:TRIM(BUFFER))//':'//TODAY(:INDEX(TODAY,' ')-1)//':' - - L = TRIM(BUFFER) - - RETURN - END - - - - - CHARACTER*(*) FUNCTION ADDRESS(INPUT) - - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) INPUT - - ADDRESS = INPUT - - IF (INDEX(INPUT,'@').EQ.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - ADDRESS = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - ELSE - I = INDEX(INPUT,'@') - IF (I.GT.0) THEN - ADDRESS = INPUT(:INDEX(INPUT(I:),' ')+I-2) - IF (INDEX(ADDRESS(I:),'(').GT.0) - & ADDRESS = ADDRESS(:INDEX(ADDRESS(I:),'(')+I-2) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SEND_MAIL - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - C = 0 - DO WHILE (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) - OPEN (UNIT=8,FILE=INPUT(:TRIM(INPUT)),IOSTAT=IER,RECL=256) - IF (IER.NE.0) GOTO 30 - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - DO I=1,3 - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - END DO - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - DO WHILE (IER.EQ.0) - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - END IF - END DO - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - CLOSE (UNIT=8,STATUS='DELETE') - GOTO 20 -10 CLOSE (UNIT=8) -20 CALL SMTP_DISCONNECT() -30 CONTINUE - END DO - - CALL EXIT - END diff --git a/decus/vlt97a/bulletin/bulletin2.for b/decus/vlt97a/bulletin/bulletin2.for deleted file mode 100644 index bd900df..0000000 --- a/decus/vlt97a/bulletin/bulletin2.for +++ /dev/null @@ -1,2670 +0,0 @@ -C -C BULLETIN2.FOR, Version 3/10/97 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'('' WARNING: Account used by other folder.'', - & '' If you specify the same account,'')') - WRITE (6,'('' you must specify the address'', - & '' of the mailing list in the folder description.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to make this change? ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) THEN - CALL CLOSE_BULLUSER - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Specified file cannot be opened.'')') - RETURN - END IF - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.EQ.0) THEN - INFROM = INPUT(:ILEN)//',' - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (MSG_OWN) THEN - ILEN = TRIM(INPUT) - 6 - INFROM = INFROM(:LENFRO)//INPUT(7:) - IF (INDEX(INFROM,' "').GT.INDEX(INFROM,'@')) THEN - I = INDEX(INFROM,' "') - INFROM = INFROM(:I-1)// - & INFROM(INDEX(INFROM(I+2:),'"')+I+2:) - DO WHILE (INDEX(INFROM,'""').GT.0) - INFROM = INFROM(:INDEX(INFROM,'""'))// - & INFROM(INDEX(INFROM,'""')+2:) - END DO - END IF - CALL ADD_PROTOCOL(INFROM(LENFRO+1:),ILEN) - LENFRO = LENFRO + ILEN - END IF - IF (EDIT.AND.TEXT) THEN - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:TRIM(INPUT)-1) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:TRIM(INPUT))//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_P = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LEN_P.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') BULL_PARAMETER(:LEN_P)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THEN - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - IER = 0 - END IF - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')') - END IF - END IF - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (.NOT.FILESPEC) THEN - WRITE (6,'('' Enter message: End with ctrl-z,'', - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - ELSE - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IF - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - END IF - END IF - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No message added.'')') - IF (.NOT.STATUS) THEN - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ') - IF (STREQ(INPUT(:1),'Y')) THEN - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV') - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IF - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C -C SUBROUTINE ADD_SIGNATURE -C -C FUNCTION: Adds signature to message being mailed/posted. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATURE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/ - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURN - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) RETURN - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IF - - ICOUNT = 0 - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME))) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THEN - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END DO - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IF - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE. - ELSE - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' ' - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - END DO - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,INPUT1 - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(INPUT(I:I)) - & .OR..NOT.ALPHA(INPUT1(I:I)))) RETURN - END DO - - STREQ = .TRUE. - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -C -C SUBROUTINE RESPOND_MAIL -C -C FUNCTION: Sends mail to address. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,MLDESCRIP*(LINE_LENGTH) - - PRIVS = FILE.NE.'SYS$LOGIN:BULL.SCR' - - MLDESCRIP = SUBJECT - LENDES = TRIM(MLDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES) - IF (MLDESCRIP(I:I).EQ.'"') THEN - IF (LENDES.EQ.LINE_LENGTH) THEN - MLDESCRIP(I:I) = '`' - ELSE - MLDESCRIP = MLDESCRIP(:I)//'"' - & //MLDESCRIP(I+1:) - I = I + 1 - LENDES = LENDES + 1 - END IF - END IF - I = I + 1 - END DO - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0 - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD) - IF (PRIVS) CALL DISABLE_PRIVS - - IF (LISTSERV) THEN - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('MX_REPLY_TO','DEFINED')) - & CALL CRELNM('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('PMDF_REPLY_TO','DEFINED')) - & CALL CRELNM('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - IF (.NOT.SYS_TRNLNM('MULTINET_SMTP_REPLY_TO','DEFINED')) - & CALL CRELNM('MULTINET_SMTP_REPLY_TO', - & USERNAME(:TRIM(USERNAME))) - END IF - END IF - - IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (LPATH.GT.0) THEN - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - END IF - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - CALL CRELNM('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - CALL CRELNM('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE - CALL CRELNM('MULTINET_SMTP_REPLY_TO',INFROM(:TRIM(INFROM))) - END IF - END IF - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO) - & //'""" """'//MLDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IF - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//MLDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE - I = INDEX(SENDTO,'%""') + 3 - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THEN - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THEN - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THEN - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & MLDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) -C -C Use the following if you do not have VMS V5.3 or greater. -C -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//MLDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IF - - IF (PRIVS) CALL ENABLE_PRIVS - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV.OR.USE_INFROM) THEN - USE_INFROM = .FALSE. - CALL DELLNM_USER('MULTINET_SMTP_REPLY_TO') - CALL DELLNM_USER('PMDF_REPLY_TO') - CALL DELLNM_USER('MX_REPLY_TO') - END IF - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: CHANGE command subroutine. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWER - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IF - -C -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - LENFROM = 0 - IF (CLI$PRESENT('OWNER')) THEN - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - IER = CLI$GET_VALUE('OWNER',INFROM,LENFROM) - INFROM = 'From: '//INFROM - LENFROM = LENFROM + 6 - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('OWNER')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')') - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')') - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL.OR.LENFROM.GT.0) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (LENFROM.EQ.0) THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description header - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT, - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - IF (LENFROM.GT.0) CALL GET_FROM(FROM,INFROM(7:),LENFROM-6) - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2100' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2100' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10) - - CHARACTER GROUP*80,STAT*4 - - EXTERNAL CLI$_ABSENT - - IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SEARCH_LEN(1) = 3 - SEARCH_NUM = 1 - NFOLDER = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - SEARCH_NUM = 1 - NFOLDER = 1 - INPUT = DESCRIP - CALL INCLUDE_SUBJECT(0) - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1 - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM) - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1 - NFOLDER = 1 - ELSE - IF (NFOLDER.EQ.0) NFOLDER = 1 - SEARCH_STRING = ' ' - END IF - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - END IF - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME - NFOLDER = NFOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DO - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - SCRATCH_F = SCRATCH_F1 - NFOLDER = NFOLDER + 1 - END IF - - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - OLD_BUFFER = ' ' - END IF - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - END IF - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IF (NFOLDER.NE.0) FOUND = 0 - - CHANGE = .FALSE. - IF (CLI$PRESENT('REPLY').OR. - & TRIM(SEARCH_STRING).GT.0) THEN - REVERSE = CLI$PRESENT('REVERSE') - ELSE - REVERSE = .FALSE. - END IF - - DO WHILE (NFOLDER.NE.0.AND.FOUND.LE.0.AND.FOUND.GT.-3) - IF ((NFOLDER.GT.0.AND.(.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1)).OR. - & (NFOLDER.LT.0.AND.OLD_BUFFER.NE.' ')) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL, - & REVERSE,CLI$PRESENT('SUBJECT') - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'), - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),CHANGE) - IF (FOUND.LE.0.AND.FOUND.GE.-2) THEN - NFOLDER = NFOLDER - 1 - IF (NFOLDER.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F, - & FOLDER1_NAME) - END IF - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - END IF - END DO - ELSE IF (NFOLDER.LT.0) THEN - NFOLDER = NFOLDER + 1 - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - IF (GFOUND) THEN - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - GFOUND = .FALSE. - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - END IF - ELSE - NFOLDER = 0 - END IF - END DO - CALL CLOSE_BULLFOLDER - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - END IF - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - NFOLDER = 0 - END IF - CALL CANCEL_CTRLC_AST - END IF - END IF - END DO - - IF (FOUND.EQ.-3) FOUND = 0 - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - IF (CHANGE) THEN - WRITE (6,'('' No matches found in current folder: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' No matches found.'')') - END IF - ELSE IF (FOUND.EQ.-2) THEN - IF (CHANGE) THEN - WRITE (6,'('' ERROR: No more messages in current folder: '' - & ,A)') FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' ERROR: No more messages.'')') - END IF - END IF - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN, - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE,CHANGE) -C -C SUBROUTINE GET_SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEXT/ NEXT - LOGICAL NEXT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*4 SAVECMD - - CHARACTER*128 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - OLD_REVERSE = REVERSE - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THEN - OLD_REVERSE = REVERSE - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(BULL_POINT,IER) - IF (BULL_POINT+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (STREQ(DESCRIP(:4),'RE: ').AND.TRIM(DESCRIP).GE. - & LEN(DESCRIP)-1) THEN - IF (FILES) CALL OPEN_BULLFIL_SHARED - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - SEARCH_STRING = INPUT(11:) - SEARCH_STRING = SEARCH_STRING(:LEN(DESCRIP)) - ELSE - SEARCH_STRING = DESCRIP(5:) - END IF - IF (FILES) CALL CLOSE_BULLFIL - ELSE IF (STREQ(DESCRIP(:4),'RE: ')) THEN - SEARCH_STRING = DESCRIP(5:) - END IF - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - ELSE - SEARCH_NUM = OLD_SEARCH_NUM - IF (SEARCH_LEN(1).EQ.0) SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (OLD_REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - OLD_SEARCH_NUM = SEARCH_NUM - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.CHANGE.OR. - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last - END IF - IF (REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - SEARCH_STRING = ' ' - RETURN - END IF - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0 - BULL_SEARCH = START_BULL+1 - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR. - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY) - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - ELSE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - IF (IER.EQ.0) THEN - IER = BULL_SEARCH + 1 - ELSE - GO TO 800 - END IF - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - IF (SEARCH_MODE.EQ.4) THEN - CALL STR$UPCASE(DESCRIP1,FROM) - ELSE - IF (LEN(DESCRIP).EQ.TRIM(DESCRIP)) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - DESCRIP1 = INPUT(7:) - END IF - CALL STR$UPCASE(DESCRIP1,DESCRIP1) - ELSE - CALL STR$UPCASE(DESCRIP1,DESCRIP) - END IF - END IF - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (TRIM(SEARCH_STRING).EQ.LEN(DESCRIP).AND. - & DESCRIP1(:LEN(DESCRIP)).EQ.SEARCH_STRING).OR. - & (STREQ(DESCRIP1(:4),'RE: ').AND.DESCRIP1(5:).EQ. - & SEARCH_STRING(:MIN(TRIM(SEARCH_STRING),LEN(DESCRIP1)-4)) - & )))) THEN - IF (.NOT.NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - ELSE IF (NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - MATCHES = 0 - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE. - END DO - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THEN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I) - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR. - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - END IF - END DO - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE - FOUND = -1 - END IF - END IF - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULL - END DO - -800 FOUND = 0 - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - NEXT = .FALSE. - CALL READDIR(BULL_POINT,IER) - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - END IF - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - IF (.NOT.IER1) SEARCH_STRING = ' ' - NEXT = .FALSE. - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMD - - RETURN - END - - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE) - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRING - - OLD_MATCH = .FALSE. - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURN - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE. - RETURN - END IF - J = J + SEARCH_LEN(I) - END DO - - RETURN - END - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')') - RETURN - END IF -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:11).LT.'1900') EXDATE(8:9) = '19' - IF (EXDATE(8:11).LT.'1995') EXDATE(8:9) = '20' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'21'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'21'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')') - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END - - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - CHARACTER*256 INPUT_OUT - CHARACTER*128 TEMP - - INPUT_OUT = ' ' - - I = 0 - - DO WHILE (I.LT.TRIM(INPUT)) - INPUT = INPUT(I+1:) - IF (I.GT.0) INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//',' - I = MINGT0(INDEX(INPUT,','),TRIM(INPUT)+1) - TEMP = INPUT(:I-1) - CALL ADD_PROTOCOL_SUB(TEMP) - INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//TEMP(:TRIM(TEMP)) - END DO - - INPUT = INPUT_OUT - - IF (ILEN.NE.0) ILEN = TRIM(INPUT) - - RETURN - END - - - - SUBROUTINE ADD_PROTOCOL_SUB(INPUT) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - END IF - - IF (LMAIL.EQ.0) THEN - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN - MAIL_PROTOCOL = MAILER - END IF - LMAIL = TRIM(MAIL_PROTOCOL) - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%' - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1 - RETURN - END IF - END IF - - I = INDEX(INPUT,'@') - IF (I.GT.0) THEN - INPUT = INPUT(:INDEX(INPUT(I:),' ')+I-2) - IF (INDEX(INPUT(I:),'(').GT.0) - & INPUT = INPUT(:INDEX(INPUT(I:),'(')+I-2) - END IF - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"' - - RETURN - END diff --git a/decus/vlt97a/bulletin/bulletin3.for b/decus/vlt97a/bulletin/bulletin3.for deleted file mode 100644 index 5a2c134..0000000 --- a/decus/vlt97a/bulletin/bulletin3.for +++ /dev/null @@ -1,2505 +0,0 @@ -C -C BULLETIN3.FOR, Version 12/12/96 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2100' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2100' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2100 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2100 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_EDT' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THEN - CALL EDT$EDIT('NL:',OUT) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT) - ELSE - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IF - END IF - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT - ELSE - WRITE(6,'('' Could not activate editor.'')') - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE) - - RETURN - END - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - NOW = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - IF (.NOT.NOW) NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - CALL SYS$SETAST(%VAL(0)) - CALL REGISTER_BULLCP - IER1 = 1 - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - - BBOARD_LOOP = BBOARD_LOOP + 1 - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & (NEWS_LOOP.EQ.0.OR.NOW)) THEN - IF (NOW) THEN - CALL CREATE_PROCESS('BULLCP NEWS1') - ELSE - CALL CREATE_PROCESS('BULLCP NEWS') - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - - C = 0 - IF (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) THEN - CALL CREATE_PROCESS('BULLCP SMTP') - END IF - - NOW = .FALSE. - - NEWS_LOOP = NEWS_LOOP + 1 - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIME - CALL HIBER('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - DIMENSION NEW_SYSTEM_FLAG(FLONG) - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2)) - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER) - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - CALL SETUSER(USERNAME) - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAG - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - END DO - FOLDER_FLAG = FOLDER1_FLAG - FOLDER_NUMBER = 0 - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - CALL CLOSE_BULLUSER - ELSE - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DO - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IF - CLOSE (UNIT=REMOTE_UNIT) - END DO - END IF - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE HIBER(MIN) -C -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -C -C SUBROUTINE DELETE_EXPIRED_NEWS -C -C FUNCTION: -C -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - CHARACTER*4 GET_VMS_VERSION - - INTEGER TODAY(2),NEXT_EX_BTIM(2),NO_EXPIRE(2) - - CHARACTER*8 TODAY_KEY,TEMP - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - IF (NOW) THEN - IER = SYS$SETPRN('BULL NEWS1') - IF (.NOT.IER) CALL EXIT - IER = SYS$SETPRN('BULL NEWS') - IF (.NOT.IER) CALL EXIT - END IF - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - CALL SYS_BINTIM('-',TODAY) - - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - REMOTE_SET = 4 - -C -C A bug keeps messing up the last expired date key so that stored -C news groups do not get found. Someday when this is fixed, we can -C add code like this: -C -C INPUT = GET_VMS_VERSION() -C IF (INPUT(:2).EQ.'V5'.OR.INPUT(:2).EQ.'V4') VMSOLD = .TRUE..AND.NOW - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER).OR.(NOW.AND.IER.EQ.0.AND. - & (.NOT.BTEST(NEWS_F_FLAG,8).OR. - & COMPARE_BTIM(TODAY,NEWEST_EXBTIM).LT.0))) - IF (NOW) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - ELSE - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END IF - END DO - CALL NEWS_TO_FOLDER - - UNLOCK 7 - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - GO TO 1000 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,8)) GO TO 900 - - CALL OPEN_BULLDIR_SHARED - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0 - NDEL = -1 - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM) - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. - IF (NDEL.GT.NEWS_F_END) THEN - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1 - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (EXDATE(8:11).LT.'1995') THEN ! Deleted manually? - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) - EXTIME = ASCTIME(13:23) - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0 - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0 - UNLOCK 2 - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER) - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_START - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - IF (I.LE.F_NBULL) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0 - END DO - F_START = I - NEXT = .FALSE. - END IF - CALL READDIR(F_NBULL,IER) - IF (F_START.LT.F_NBULL.AND.(DN.OR.F_NBULL.EQ.IER)) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I) - I = I - 1 - IF (I.GE.F_START) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = I - END DO - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLDIR - END DO - -900 CALL CLOSE_BULLNEWS - -1000 IF (NOW.OR.IER.EQ.0) THEN - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.*]'//'*.' - INPUT = GET_VMS_VERSION() - CALL LIB$DAY_OF_WEEK(TODAY,DAY) - IF (DAY.NE.7) THEN - IER = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - IF (IER) THEN - DAY = 7 - CALL DELLNM('BULL_NEWS_CLEANUP') - END IF - END IF - IF (INPUT(:2).NE.'V5'.AND.INPUT(:2).NE.'V4') THEN - CONTEXT = 0 - DO WHILE (LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT)) - IER = CONV$RECLAIM(INPUT(:TRIM(INPUT))) - END DO - ELSE IF (DAY.EQ.7) THEN - REMOTE_SET = 4 - DIRLIST = .TRUE. - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(1000,IER) - CALL READ_FOLDER_FILE(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NO_EXPIRE) - DO WHILE (IER.EQ.0) - UNLOCK 7 - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - C = 0 - IF (LIB$FIND_FILE(BULLNEWSDIR_FILE - & (:TRIM(BULLNEWSDIR_FILE))//';1',INPUT,C)) THEN - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';2') - ELSE - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - END IF - CALL OPEN_BULLDIR_SHARED - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE,SHARED, - & BUFFERCOUNT=127, - & INITIALSIZE=(NEWSDIR_RECORD_LENGTH*F_COUNT)/512, - & STATUS='NEW',FORM='UNFORMATTED',DISPOSE='DELETE', - & RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,IOSTAT=IER, - & ORGANIZATION='INDEXED',RECORDTYPE='FIXED', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - END IF - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (2,IOSTAT=IER) NEWSDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - WRITE (9,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - ELSE - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY), - & %DESCR(EX_BTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & CALL COPY2(NEWEST_EXBTIM,EX_BTIM) - END IF - END IF - END DO - CLOSE (UNIT=9,DISPOSE='KEEP') - CALL CLOSE_BULLDIR_DELETE - CALL GET_MSGKEY(NEWEST_EXBTIM,TEMP) - IF (TEMP.NE.NEWS_F_EXPIRED_DATE) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - NEWS_F_EXPIRED_DATE = TEMP - CALL REWRITE_FOLDER_FILE(IER) - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - END IF - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - ELSE - IF (NO_EXPIRE(1).NE.NEWEST_EXBTIM(1).OR. - & NO_EXPIRE(2).NE.NEWEST_EXBTIM(2)) THEN - CALL GET_MSGKEY(NO_EXPIRE,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - ELSE - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - END IF - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';') - END DO - END IF - CALL READ_FOLDER_FILE(IER) - END DO - CALL CLOSE_BULLNEWS - END IF - DIRLIST = .FALSE. - NEWSLIST = .TRUE. - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - IER = .TRUE. - DO WHILE (IER) - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;') - IER = INDEX(FOLDER_FILE,']1JAN').EQ.0 - END DO - J = INDEX(FOLDER_FILE,']') - DECODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) THEN - DO I=1,10 - YEAR = YEAR - 1 - IF (YEAR.EQ.-1) YEAR = 99 - ENCODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) IER = LIB$DELETE_FILE(FOLDER_FILE(:J) - & //'*.*;*') - END DO - END IF - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IF - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'READ/NEW' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - - IER = 0 - CALL STRIP_HEADER(' ',-1,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.EQ.0) THEN - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP) - IF (STRIP.AND.INPUT(:5).EQ.'From:') INFROM = ' ' - END IF - END DO - -C -C If more than one folder has same BBOARD account, don't use the -C To: line to determine which folder to put the mail message in. -C - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - DUP = .FALSE. - DO WHILE (.NOT.DUP.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - DUP = FOLDER.NE.FOLDER1.AND.FOLDER_BBOARD.EQ.FOLDER1_BBOARD - END DO - IF (DUP.OR..NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - FOUND = .FALSE. - J = 0 - IF (DUP) J = 1 - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THEN - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - FOUND = INTO.EQ.F_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - END IF - FLEN = TRIM(F_BBOARD) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DO - END IF - END IF - END DO - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COM - END IF - - IF (NHEAD.GT.0) NUMHEAD = NHEAD + 1 - - IF (NUMHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - ELSE - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - SAVE_Q = HEADER_Q - HEADER_Q1 = 0 - ! INIT_MESSAGE_ADD_BBOARD reinits header so save it - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NUMHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - ELSE IF (NUMHEAD.EQ.1) THEN - INPUT = ' ' - LEN_INPUT = 1 - NUMHEAD = NUMHEAD - 1 - ELSE - CALL READ_QUEUE(%VAL(SAVE_Q),SAVE_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - USE_INFROM = .TRUE. - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL SYS$SETAST(%VAL(1)) - IF (.NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) - & CALL NEWS2BULL(.FALSE.) - END IF - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE. - - LEN_BBOARD = LEN(BBOARD) - 1 - - DO I=1,TRIM(INPUT)-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND. - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND. - & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR. - & (INDEX('@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0 - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND. - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALPHA(IN) - - CHARACTER*(*) IN - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURN - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN - - BBOARD_NAME = FOLDER_DESCRIP(I+1:) - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!') - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DO - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - IER = 0 - DO WHILE (IER.EQ.0) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - END DO - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - IF (INDEX(IMAGENAME,';').GT.0) ILEN = INDEX(IMAGENAME,';') - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0) - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - IF (.NOT.IER.AND..NOT.DEL) THEN - CALL DELPRC('BULLCP NEWS',DEL) - IER = .NOT.DEL - ELSE - IER = .TRUE. - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI) -C -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL ADD_2_ITMLST(4,JPI$_ENQLM,%LOC(ENQLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF - END IF - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_ENQLM - CALL LIB$MOVC3(4,ENQLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2)) - - RETURN - END - - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - CHARACTER*4 FUNCTION GET_VMS_VERSION -C -C FUNCTION GET_VMS_VERSION -C -C FUNCTION: Gets VMS version -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER VERSION*4 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,SYI$_NODE_SWVERS,%LOC(VERSION)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - GET_VMS_VERSION = VERSION - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DO - - CALL CLOSE_BULLDIR - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAM - - DATA OBIO/0/,OCPU/0/,ODIO/0/ - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAM - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU)) - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IF - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1 - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - END IF - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND. - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIO - ODIO = DIO - OCPU = CPU - IER = 0 - RETURN - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IF - RETURN - END diff --git a/decus/vlt97a/bulletin/bulletin4.for b/decus/vlt97a/bulletin/bulletin4.for deleted file mode 100644 index eaf39b7..0000000 --- a/decus/vlt97a/bulletin/bulletin4.for +++ /dev/null @@ -1,2300 +0,0 @@ -C -C BULLETIN4.FOR, Version 4/19/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(' ',-1,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' '.AND..NOT.MAIL_POST()) THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - ELSE - IF (.NOT.HEADER) THEN - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - STRIP = .FALSE. - END IF - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - IER = 0 - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - CHARACTER RESPONSE*4 - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - CALL STR$UPCASE(FOLDER,FOLDER) - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '', - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAX - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - RETURN - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACL - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_NAME = FOLDER - FOLDER_OWNER = FOLDER1_OWNER - - MAILTO = 0 - I = INDEX(FOLDER_DESCRIP,'<') - J = INDEX(FOLDER_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER_DESCRIP(I:),'@').LT.1.OR. - & INDEX(FOLDER_DESCRIP(I:),'@').GT.J-I+1).AND.NEWS_FEED()) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - I = INDEX(FOLDER_DESCRIP,'[') - J = INDEX(FOLDER_DESCRIP,']') - END IF - - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - IF (I.GT.0.AND.J.GT.I.AND..NOT.NEWS_FEED().AND.MAILTO.EQ.0 - & .AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - IF (CLI$GET_VALUE('COPY',FOLDER1,FLEN).NE.%LOC(CLI$_ABSENT)) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Unable to copy folder settings.'')') - ELSE - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - 1 - IF (.NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) THEN - LAST(1,FOLDER1_NUMBER+1) = LAST(1,FOLDER_NUMBER+1) - LAST(2,FOLDER1_NUMBER+1) = LAST(2,FOLDER_NUMBER+1) - REWRITE (9,IOSTAT=IER) TEMP_USER,LAST - END IF - END IF - END DO - CALL CLOSE_BULLINF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(SET_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SET_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(NOTIFY_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - END IF - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - END IF - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -C -C Description: -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -C -C SUBROUTINE CREATE_NEWS_FOLDER -C -C FUNCTION: Creates a new newsgroup. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME) - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF -C -C If file specified in command, read file. -C Else, read from the terminal. -C - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file -2010 FORMAT(A) - ICOUNT = ICOUNT + ILEN - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER, - & 'Adding newsgroup.') - CLOSE (UNIT=3) - - RETURN - -920 WRITE(6,1020) -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURN - -910 WRITE(6,1010) -1010 FORMAT (' No news group was added.') - CLOSE (UNIT=3) - RETURN - - END - - - - - SUBROUTINE INIT_COMPRESS - - IMPLICIT INTEGER (A-Z) - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127 - DO J=0,127 - A(J,I) = ' ' - END DO - END DO - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DO - - J = 1 - DO I=1,8 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=10,31 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=127,254 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - - RETURN - - ENTRY COMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.126) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.126) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:))) - IF (T(O:O).NE.' ') THEN - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND. - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1)) - C = C + 1 - K = K + 1 - END DO - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1) - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0) - O = O + 1 - ELSE - T(O:O) = IN(K:K) - IF (ICHAR(T(O:O)).LT.9.OR.(ICHAR(T(O:O)).GT.9.AND. - & ICHAR(T(O:O)).LT.32)) T(O:O) = ' ' - K = K + 1 - O = O + 1 - END IF - END DO - IF (K.EQ.L) THEN - T(O:O) = IN(K:K) - ELSE - O = O - 1 - END IF - - OUT = T - - RETURN - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1 - T(O:O) = IN(I+2:I+2) - END DO - I = I + 3 - ELSE - B = UNMAP(J) - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1 - T(O:O) = IN(I:I) - ELSE - O = O + 2 - T(O-1:O) = B - END IF - I = I + 1 - END IF - END DO - - OUT = T(:O) - - RETURN - END diff --git a/decus/vlt97a/bulletin/bulletin5.for b/decus/vlt97a/bulletin/bulletin5.for deleted file mode 100644 index 25e1c5e..0000000 --- a/decus/vlt97a/bulletin/bulletin5.for +++ /dev/null @@ -1,2513 +0,0 @@ -C -C BULLETIN5.FOR, Version 3/5/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3) THEN - CALL SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - RETURN - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - NODEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (NODEFAULT) THEN - IF (NOTIFY.NE.-1) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) THEN - CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - END IF - REWRITE(4) USER_HEADER - ELSE IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & (FOLDER1_NUMBER.EQ.0.AND.FOLDER1_BBOARD(:2).NE.'::')) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - IF (FOLDER1_NUMBER.NE.0.OR.FOLDER1_BBOARD(:2).NE.'::') THEN - ! Test is due to bug which changes folder number to zero - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG - IF (BTEST(FOLDER1_FLAG,2)) THEN - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAG - FOLDER_NUMBER = TEMP_NUMBER - END IF - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - CALL UPDATE_EXCLUDE - - CALL UPDATE_USERINFO - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET').OR.(INCMD(:3).EQ.'SEA') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & (F1_START.GT.0.OR.F_START.LE.F_NBULL)) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_COUNT = F1_COUNT - IF (F1_START.GT.0) THEN - IF (F1_NBULL.LT.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER-1.GE.F1_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - ELSE - F_NBULL = F1_NBULL - END IF - F_START = F1_START - ELSE - F_START = F_NBULL + 1 - END IF - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - REMOTE_SET_NEW = 1 - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - IF (COMMAND.AND.INCMD(:3).NE.'REP'.AND. - & INCMD(:3).NE.'DEL') HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER1) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.IER1.EQ.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11).AND.WRITE_ACCESS) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s news group.'')') - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP( - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE IF (REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - ELSE IF (REMOTE_SET.EQ.3.OR.REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN - WRITE (6,'('' Folder only accessible for reading.'')') - END IF - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THEN - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - BULL_PARAMETER = 'MARKED' - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - BULL_PARAMETER = 'SEEN' - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED' - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN' - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - WRITE(6,'('' WARNING: No '',A, - & '' messages found.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IF - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE. - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - LAST_FOLDER_NUMBER = FOLDER_NUMBER - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IF - - IF (TEST_NEWS(FOLDER1)) THEN - INCMD = 'SET NEWS ' - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL ' - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Access is limited.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0) - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,10)) THEN - WRITE (6,'('' POST_ONLY has been set.'')') - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THEN - WRITE (6,'('' COMPRESS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - IF (NEWS_FEED()) THEN - WRITE (6,'('' Last message fed by news group was: '',I)') F_LAST - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/, - & ' Description: ',A) -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/, - & ' Description: ',A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/ - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' ' - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. - STORED = .FALSE. - CLASS = .FALSE. - NEW = .FALSE. - PERM = .FALSE. - DEFA = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counter - NLINE = 1 - START = .FALSE. - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE. - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - CALL NEWS_LIST - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - END IF - COUNT = CLI$PRESENT('COUNT') - IF (COUNT) TOTAL_COUNT = 0 - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - NEW = CLI$PRESENT('NEWGROUPS') - CLASS = CLI$PRESENT('CLASS') - PERM = CLI$PRESENT('PERMANENT') - DEFA = CLI$PRESENT('DEFAULT') - IF (CLASS) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - ELSE IF (PERM) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE IF (DEFA) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER) - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER - FOLDER_COUNT = -1 - RETURN - ELSE - START = .TRUE. - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN) - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0 - FOLDER_COUNT = -1 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN - SUBNUM = -2 - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DECLARE_CTRLC_AST - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE. - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (PERM.OR.DEFA) THEN - IER = 1 - DO WHILE (INUM.LE.FOLDER_MAX.AND.IER.NE.0) - IF (INF_REC2(1,INUM).NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (ZEXT(INF_REC2(1,INUM)),IER) - END IF - INUM = INUM + 1 - END DO - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2 - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THEN - NEW_NEWS = FOLDER1_NUMBER - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP) - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)), - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - END IF - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - FSTATUS1 = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (.NOT.NEWS_TEST) THEN - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN - IER1 = 1 - MORE = .TRUE. - END IF - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DO - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1 - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THEN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))') - ELSE IF (CLASS) THEN - WRITE (6,'(1X,''Class'',/,1X,(''-''))') - ELSE IF (SUBSCRIBE) THEN - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,''Status'',7X, - & ''First Last'',/,1X,(''-''))') - END IF - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1 - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1.AND. - & FLAG.NE.100) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - ELSE - FSTATUS1 = ' ' - END IF - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNT - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0 - END IF - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '* '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - END IF - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IF - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER - IF (NEWS_TEST.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - CALL GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & FSTATUS1,IER,ACTIVE) - MORE = MORE.AND.FOUND - IF (MORE) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND.AND.FLAG.NE.1) FLAG = 100 - END IF - END DO - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - END IF - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNT - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSE - WRITE(6,1100) ! Else say there are more - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10) -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS.OR.CLI$PRESENT('CLASS')) THEN - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.' - END IF - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER ! Open folder file - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - CALL RESET_PROTECTION - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')') - RETURN - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0) - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER) - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE - CALL SET_FOLDER_FILE(0) - END IF - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INDEX(INPUT,'[').EQ.0.AND.INDEX(INPUT,']').GT.0.AND. - & ID(:1).EQ.'[') INPUT = ID(:TRIM(ID))//','//INPUT - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').GT.0) - & COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"'.AND.INDEX(INPUT(2:),'"').GT.0) - & COMMA = INDEX(INPUT(2:),'"') + 2 - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').EQ.0) COMMA = 0 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ILEN = TRIM(ID) - ELSE - ID = INPUT - INPUT = ' ' - ILEN = TRIM(ID) - END IF - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE IF (ID(:1).NE.'['.OR.INDEX(ID,']').NE.0) THEN - IF (ILEN.EQ.0) THEN - IER = SS$_IVIDENT - ELSE IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IF - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*256 ACLENT - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURN - - ENTRY WRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER_COM - END IF - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - DO I=1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - NEW_NEWS_ACCESS = - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS' - - RETURN - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C)) - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' ' - ELSE - FILE = FILE(:L) - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - F = LEN(FIND) - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & STAT,IER,ACTIVE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*(*) STAT,FOLDER_MATCH - - CHARACTER NEWS_ACCESS*132 - - FOUND = .FALSE. - STAR = INDEX(FOLDER_MATCH,'*') - ONE = STAR.EQ.0.AND.TRIM(FOLDER_MATCH).GT.0 - START = .FALSE. - IF (STAR.GT.1) - & START = FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1) - STARTNOW = START - - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - IF (ONE) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER_MATCH(:TRIM(FOLDER_MATCH)),IER) - FOLDER_MATCH = ' ' - ELSE IF (STARTNOW) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP - & (FOLDER_MATCH(:STAR-1),IER) - STARTNOW = .FALSE. - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - END IF - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - STAT(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - STAT = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(STAT(:1).NE.'x'.AND. - & .NOT.BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (ONE.OR..NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1) - ELSE - FOUND1 = .TRUE. - END IF - END IF - FOUND = FOUND1 - ELSE - FOUND = .TRUE. - END IF - ELSE IF (IER.EQ.0.AND.START) THEN - IF (FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1)) RETURN - END IF - IF (ONE) RETURN - END DO - - RETURN - END diff --git a/decus/vlt97a/bulletin/bulletin6.for b/decus/vlt97a/bulletin/bulletin6.for deleted file mode 100644 index 3bab532..0000000 --- a/decus/vlt97a/bulletin/bulletin6.for +++ /dev/null @@ -1,2810 +0,0 @@ -C -C BULLETIN6.FOR, Version 9/15/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - TRY = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.TRY.EQ.0) THEN - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - TRY = 1 - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL_NAME - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & BUFFERCOUNT=127, - & ORGANIZATION='INDEXED',IOSTAT=IER) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open file: '',A)') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - IF (UNIT.EQ.14) THEN - WRITE (6,'('' Database conversion in progress. Try later.'')') - ELSE - WRITE (6,'('' Please try again later.'')') - END IF - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - COMMON /NEWSLIST/ NEWSLIST - DATA NEWSLIST/0/ - - COMMON /DIRLIST/ DIRLIST - DATA DIRLIST/0/ - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - LUN = 2 - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL_NAME - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & BUFFERCOUNT=127, - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - END IF - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) WRITE(6,'(1X,A)') - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1))) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULL - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LAST - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMIT - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLNEWSDIR - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($FORIOSDEF)' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*180 TEMP - - CHARACTER BUFFER*12,DATETIME*24 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - CALL OPEN_BULLNEWS - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=180/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & BUFFERCOUNT=127,KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR]') - IF (.NOT.IER1) GO TO 900 - - NEW_FOLDER_NUMBER = 0 - - DO WHILE (IER.EQ.0) - READ (2,IOSTAT=IER) TEMP - IF (GET_INTEGER(%REF(TEMP)).NE.NEW_FOLDER_NUMBER) THEN - IF (NEW_FOLDER_NUMBER.NE.0) CLOSE (UNIT=9,DISPOSE='KEEP') - NEW_FOLDER_NUMBER = GET_INTEGER(%REF(TEMP)) - CALL SET_BULLNEWSDIR_FILE(NEW_FOLDER_NUMBER) - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE, - & STATUS='UNKNOWN',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) GO TO 900 - END IF - NEWS_MSG_NUM = GET_INTEGER(%REF(TEMP(5:))) - NEWS_MSG_BTIM_KEY = TEMP(13:) - NEWS_EX_BTIM_KEY = TEMP(89:) - NEWS_MSGID = TEMP(21:) - CALL COPY2(MSG_BTIM,%REF(TEMP(97:))) - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL LIB$MOVC3(76,%REF(TEMP(105:)),NEWS_BLOCK) - - WRITE (9,IOSTAT=IER1) NEWSDIR_ENTRY - END DO - - CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - - CALL RESET_PROTECTION - - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - - IER = LIB$RENAME_FILE(BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - & ,'BULLNEWSDIR.OLD') - - WRITE (6,'('' BULLNEWSDIR.DAT has been renamed to '', - & '' BULLNEWSDIR.OLD and may now be deleted.'')') - - RETURN - -900 CALL RESET_PROTECTION - - CALL CLOSE_BULLNEWS - - WRITE(6,'('' ERROR: Cannot convert BULLNEWSDIR.DAT'')') - IF (IER.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - - END - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(81:84) = BUFFER(85:) - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL RESET_PROTECTION - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - IF (ASK_SIZE.EQ.184) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST) - ELSE - F_LAST = 0 - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LAST - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER)) - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0 - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -C -C SUBROUTINE CONVERT_BULLNEWS -C -C FUNCTION: Converts bulletin NEWS file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. '' - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0 - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE) - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0 - NEWS_F_END = 0 - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108) - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:) - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1 - IF (LMOVE.LE.0) THEN - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP - ELSE - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE)) - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) - END IF - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SET_PROTECTION - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL RESET_PROTECTION - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXT - - COMMON /KEEPLOCK/ KEEPLOCK - DATA KEEPLOCK/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /THREAD/ THREAD - - CHARACTER*4 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSE - DIR_NUM = 0 - END IF - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURN - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEYGE=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0.AND.ICOUNT.EQ.F_START) THEN - READ(2,KEYGT=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.EQ.0) ICOUNT = NEWS_MSG_NUM - END IF - END IF - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND. - & MSG_NUM.GT.F_START) THEN - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER,IER2) - F_START = MSG_NUM - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IF - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THEN - ICOUNT = MSG_NUM - BULLETIN_NUM = ICOUNT - END IF - END IF - ELSE - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 - END IF - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END IF - END DO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IF - - IF (IER.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1 - ELSE IF (THREAD) THEN - DUMMY = INCLUDE_MSG(FROM,DESCRIP) - END IF - END IF - END IF - - RETURN - - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM) - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z) - - INTEGER TEMP - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I) - END DO - - RETURN - END - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/1/ - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.2.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.2.AND.MSG_NUM.NE.0) THEN - IF (MSG_NUM.GT.NEWS_F_END) THEN - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36 - UNLOCK 2 - END IF - END IF - END IF - ELSE - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - IER = 0 - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10 - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY),%DESCR(EX_BTIM)) - IF (POSTTIME) THEN - CALL GET_MSGKEY(%REF(NEWS_POST_KEY),%DESCR(MSG_BTIM)) - CALL CONVERT_FROM_GMT(MSG_BTIM) ! Assume stored is GMT - END IF - DESCRIP = NEWS_DESCRIP - FROM = NEWS_FROM - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IF - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11) - EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME(:11) - TIME = DATETIME(13:23) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - ELSE - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IF (BULLETIN_NUM.NE.NEWS_F_END+1) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END DO - END IF - ELSE - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IF - IF (REMOTE_SET.EQ.4.AND. - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN - CALL SPECIAL_NEWSDIR_ENTRY(IER) - ELSE IF (IER.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEN - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*140 TEMP - - DIMENSION BTIM(2) - - READ (2,KEYID=3,KEY=NEWS_POST_KEY,IOSTAT=IER) TEMP - DO WHILE (IER.EQ.0.AND.NEWS_POST_KEY.EQ.TEMP(57:64)) - IF (NEWS_MSGID.EQ.TEMP(21:56)) THEN - IER = 2 - RETURN - END IF - READ (2,IOSTAT=IER) TEMP - END DO - -10 IER1 = 0 - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=0,KEYGT=NEWS_F_END, - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - DO WHILE (IER1.EQ.0) - CALL LIB$MOVC3(4,%REF(INPUT),FNUM) - CALL GET_MSGKEY(%REF(INPUT(13:)),%DESCR(BTIM)) - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IF - F_COUNT = F_COUNT + 1 - CALL LIB$MOVC3(4,%REF(INPUT),NEWS_F_END) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - END DO - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IF - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSE - F_COUNT = F_COUNT + 1 - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,MSG_BTIM) - ELSE - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - END IF - - IF (LOCAL_POST) THEN - CALL SYS_BINTIM(DATE//' '//TIME - & (:TRIM(TIME)-2)//'00',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP - NEWS_FROM = FROM - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH - NEWS_MSG_NUM = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,NEWS_MSG_BTIM_KEY) - CALL GET_MSGKEY(EX_BTIM,NEWS_EX_BTIM_KEY) - ELSE - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - - RETURN - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KEYID/ NEWS_KEYID - - COMMON /KEEPLOCK/ KEEPLOCK - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 2 - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - CALL READDIR_KEYGE(NDEL) - KEEPLOCK = .FALSE. - NEWS_KEYID = 1 - - RETURN - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII)) - IF (ACLSTR(START_ID:START_ID).NE.','.AND. - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DO - IF (ASCII) THEN - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl output - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C -C SUBROUTINE COPY_ACL1 -C -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - ! Read input file acl - - IF (.NOT.IER) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./ - - IF (CHECKED) RETURN - - CHECKED = .TRUE. - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C) - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORY - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - END IF - - CALL CHECK_DIR(FOLDER_DIRECTORY,.FALSE.) - CALL CHECK_DIR(NEWS_DIRECTORY,.FALSE.) - - CALL ADD_DIRECTORIES - - RETURN - END - - - - SUBROUTINE ADD_DIRECTORIES - - INCLUDE 'BULLFILES.INC' - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE) - - RETURN - END - - - - LOGICAL FUNCTION CHECK_DIR(DIRECTORY,LIBRARY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - CHECK_DIR = PRESENT(BULLUSER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLFOLDER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLINF_FILE,DIRECTORY,TEST) - - IF (CHECK_DIR) THEN - IF (SYS_TRNLNM(DIRECTORY,TEST)) DIRECTORY = TEST - RETURN - END IF - - TEST = ' ' - - IF (INDEX(DIRECTORY,']').EQ.0) THEN - CALL SYS_TRNLNM(DIRECTORY,TEST1) - ELSE - TEST1 = DIRECTORY - END IF - - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - - IF (.NOT.LIBRARY.AND.TEST.EQ.' ') THEN - IER = SYS_TRNLNM_SYSTEM(DIRECTORY,TEST) - IF (.NOT.IER.AND.TEST1.EQ.DIRECTORY) RETURN - END IF - - IF (TEST.NE.TEST1) THEN - IF (LIBRARY) THEN - WRITE (6,'('' ERROR: Not a valid library. '')') - RETURN - END IF - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER) - CLOSE(UNIT=3,STATUS='DELETE') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)') - & TEST1(:TRIM(TEST1)) - CALL EXIT - END IF - DIRECTORY = TEST1 - ELSE - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - CHECK_DIR = .TRUE. - END IF - - RETURN - END - - - - - LOGICAL FUNCTION PRESENT(FILE,DIR,TEST) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILE,DIR,TEST - - FILE = FILE(INDEX(FILE,':')+1:) - FILE = FILE(INDEX(FILE,']')+1:) - IF (INDEX(DIR,':').EQ.0.AND.INDEX(DIR,'[').EQ.0.AND. - & INDEX(DIR,'<').EQ.0) DIR = DIR(:TRIM(DIR))//':' - C = 0 - PRESENT = LIB$FIND_FILE(DIR(:TRIM(DIR))//FILE,TEST,C) - - RETURN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:) - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:) - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':' - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURN - END - - - - SUBROUTINE SET_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CALL CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P) - - IF (CHECK_DIR(BULL_PARAMETER,.TRUE.)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - CALL UPDATE_USERINFO - CALL OPEN_USERINFO - INCMD = 'SHOW' - CALL UPDATE_READ(0) - END IF - - RETURN - END - - - - SUBROUTINE SHOW_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (CLI$PRESENT('ALL')) THEN - IER = 1 - N = 1 - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',BULL_PARAMETER) - IF (IER) THEN - IF (N.EQ.1) THEN - WRITE (6,'('' The following are valid libraries:'')') - N = 0 - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER - END IF - END DO - IF (N.EQ.1) WRITE (6,'('' No libraries are present.'')') - ELSE - WRITE (6,'('' Present library is: '',A)') - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - END IF - - RETURN - END - - - - SUBROUTINE SET_BULLNEWSDIR_FILE(FN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - BULLNEWSDIR_FILE = ' ' - - ENCODE(6,'(I6)',BULLNEWSDIR_FILE) FN - BULLNEWSDIR_FILE = BULLNEWSDIR_FILE(FIRST_ALPHA(BULLNEWSDIR_FILE):) - L = TRIM(BULLNEWSDIR_FILE) - - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.'// - & BULLNEWSDIR_FILE(:L-3)//']'// - & BULLNEWSDIR_FILE(L-2:TRIM(BULLNEWSDIR_FILE))//'.' - - RETURN - END diff --git a/decus/vlt97a/bulletin/bulletin7.for b/decus/vlt97a/bulletin/bulletin7.for deleted file mode 100644 index dc23c6c..0000000 --- a/decus/vlt97a/bulletin/bulletin7.for +++ /dev/null @@ -1,2347 +0,0 @@ -C -C BULLETIN7.FOR, Version 3/20/96 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER1_NAME.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCALPOST/ LOCAL_POST - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - IF (.NOT.LOCAL_POST) THEN - DATE = NEWEST_DATE - TIME = NEWEST_TIME - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIR - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /OUTPUT/ REASSIGNED - LOGICAL REASSIGNED - DATA REASSIGNED /.FALSE./ - - CALL DISABLE_PRIVS ! Disable SYSPRV - - IF (.NOT.REASSIGNED) THEN - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - END IF - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - IF (INDEX(INPUT,']').GT.0) THEN - SYS_TRNLNM = .FALSE. - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX)) - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1 - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IF - - RETURN - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - IER1 = 0 - ELSE - IF (IER.GT.0) THEN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0 - CALL SET_FOLDER_FILE(0) - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0) - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*12 DATE_SAVE,EXDATE_SAVE - CHARACTER*12 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - END IF - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER PSCAN$_BEGIN = '00000000'X - PARAMETER PSCAN$_ACCOUNT = '00000001'X - PARAMETER PSCAN$_AUTHPRI = '00000002'X - PARAMETER PSCAN$_CURPRIV = '00000003'X - PARAMETER PSCAN$_GRP = '00000004'X - PARAMETER PSCAN$_HW_MODEL = '00000005'X - PARAMETER PSCAN$_HW_NAME = '00000006'X - PARAMETER PSCAN$_JOBPRCCNT = '00000007'X - PARAMETER PSCAN$_JOBTYPE = '00000008'X - PARAMETER PSCAN$_MASTER_PID = '00000009'X - PARAMETER PSCAN$_MEM = '0000000A'X - PARAMETER PSCAN$_MODE = '0000000B'X - PARAMETER PSCAN$_NODE_CSID = '0000000C'X - PARAMETER PSCAN$_NODENAME = '0000000D'X - PARAMETER PSCAN$_OWNER = '0000000E'X - PARAMETER PSCAN$_PRCCNT = '0000000F'X - PARAMETER PSCAN$_PRCNAM = '00000010'X - PARAMETER PSCAN$_PRI = '00000011'X - PARAMETER PSCAN$_PRIB = '00000012'X - PARAMETER PSCAN$_STATE = '00000013'X - PARAMETER PSCAN$_STS = '00000014'X - PARAMETER PSCAN$_TERMINAL = '00000015'X - PARAMETER PSCAN$_UIC = '00000016'X - PARAMETER PSCAN$_USERNAME = '00000017'X - PARAMETER PSCAN$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER PSCAN$_END = '00000019'X - PARAMETER PSCAN$k_type = '00000081'X - PARAMETER PSCAN$M_OR = '00000001'X - PARAMETER PSCAN$M_BIT_ALL = '00000002'X - PARAMETER PSCAN$M_BIT_ANY = '00000004'X - PARAMETER PSCAN$M_GEQ = '00000008'X - PARAMETER PSCAN$M_GTR = '00000010'X - PARAMETER PSCAN$M_LEQ = '00000020'X - PARAMETER PSCAN$M_LSS = '00000040'X - PARAMETER PSCAN$M_PREFIX_MATCH = '00000080'X - PARAMETER PSCAN$M_WILDCARD = '00000100'X - PARAMETER PSCAN$M_CASE_BLIND = '00000200'X - PARAMETER PSCAN$M_EQL = '00000400'X - PARAMETER PSCAN$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER PSCAN$S_OR = 1 - PARAMETER PSCAN$V_OR = 0 - PARAMETER PSCAN$S_BIT_ALL = 1 - PARAMETER PSCAN$V_BIT_ALL = 1 - PARAMETER PSCAN$S_BIT_ANY = 1 - PARAMETER PSCAN$V_BIT_ANY = 2 - PARAMETER PSCAN$S_GEQ = 1 - PARAMETER PSCAN$V_GEQ = 3 - PARAMETER PSCAN$S_GTR = 1 - PARAMETER PSCAN$V_GTR = 4 - PARAMETER PSCAN$S_LEQ = 1 - PARAMETER PSCAN$V_LEQ = 5 - PARAMETER PSCAN$S_LSS = 1 - PARAMETER PSCAN$V_LSS = 6 - PARAMETER PSCAN$S_PREFIX_MATCH = 1 - PARAMETER PSCAN$V_PREFIX_MATCH = 7 - PARAMETER PSCAN$S_WILDCARD = 1 - PARAMETER PSCAN$V_WILDCARD = 8 - PARAMETER PSCAN$S_CASE_BLIND = 1 - PARAMETER PSCAN$V_CASE_BLIND = 9 - PARAMETER PSCAN$S_EQL = 1 - PARAMETER PSCAN$V_EQL = 10 - PARAMETER PSCAN$S_NEQ = 1 - PARAMETER PSCAN$V_NEQ = 11 - BYTE %FILL (2) - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -C -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -C -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE)) -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1 -C UJPIMODE = -1 -C TERMINAL(1:1) = CHAR(0) -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./ - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IF - END DO - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - DO I=1,FOLDER_MAX - DO J=1,2 - LAST(J,I) = LAST_READ_BTIM(J,I) - END DO - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.EQ.0) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - WRITE (9,IOSTAT=IER) USERNAME,INF_REC - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIM - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0 - LAST_SYS_BTIM(2,I) = 0 - END DO - END IF - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -C -C SUBROUTINE READ_NEWS_USERINFO -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) NAME - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2))) - END IF - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READ - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - EQUIVALENCE (OLD_LAST_NEWS_READ2(1,1),OLD_LAST_NEWS_READ(1,1)) - INTEGER*2 OLD_LAST_NEWS_READ2(4,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF = (LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF1 = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF1 = (LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF2 = .FALSE. - GO TO 10 - - ENTRY UPDATE_USERINFO_NEWS_ALWAYS - DIFF2 = .TRUE. - -10 IF (.NOT.DIFF2) THEN - DO I=1,FOLDER_MAX - DIFF2 = (LAST_NEWS_READ(1,I).NE. - & OLD_LAST_NEWS_READ(1,I)).OR. - & (LAST_NEWS_READ(2,I).NE. - & OLD_LAST_NEWS_READ(2,I)).OR.DIFF2 - END DO - END IF - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHARED - - IF (DIFF) THEN - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & LAST(J,I) = LAST_READ_BTIM(J,I) - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - END IF - - IF (DIFF1) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & OLD_LAST_SYS_BTIM(J,I) = LAST_SYS_BTIM(J,I) - LAST_SYS_BTIM(J,I) = OLD_LAST_SYS_BTIM(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF - - IF (DIFF2) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=2,1,-1 - IF (I.EQ.NEWS_FIND_SUBSCRIBE().OR. - & OLD_LAST_NEWS_READ2(1,I).NE.LAST_NEWS_READ2(1,I)) - & OLD_LAST_NEWS_READ(J,I) = LAST_NEWS_READ(J,I) - LAST_NEWS_READ(J,I) = OLD_LAST_NEWS_READ(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - CHARACTER*24 TIME1 - - TIME1 = TIME(FIRST_ALPHA(TIME):) - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:) - END DO - - IF (TIME1.EQ.'-') TIME1 = '-- :' - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder info - ELSE IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND. - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A)') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - IF (INCMD(:4).EQ.'SHOW') THEN - SAVE_FOLDER_Q1 = 0 - RETURN - END IF - IF (NEW_MESS.OR.NEWS_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1 - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0 - END IF - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE(IER) - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER) - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - - RETURN - END diff --git a/decus/vlt97a/bulletin/bulletin8.for b/decus/vlt97a/bulletin/bulletin8.for deleted file mode 100644 index ecb8e23..0000000 --- a/decus/vlt97a/bulletin/bulletin8.for +++ /dev/null @@ -1,2163 +0,0 @@ -C -C BULLETIN8.FOR, Version 10/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND. - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0, - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - END IF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE. - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THEN - ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX)) - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV) - END IF - END IF - END IF - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND. - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24 - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM) - P = 4 + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (BTEST(FOLDER_FLAG,14)) FROM = 'ANONYMOUS' - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - IF (NEWS_FEED()) THEN - BULL_POINT = NBULL - INCMD = 'COPY/ORIGINAL/LOCAL '// - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1 - & :INDEX(FOLDER_DESCRIP,'>')-1) - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - END IF - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT) - P = 4 + P - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER) - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - CALL CLOSE_BULLFOLDER - END IF - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = -1 - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV) - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - INIT = INIT + 2 - IF (INIT.GT.60) THEN - WRITE (6,'('' Bulletin aborting due to record lock'', - & '' problem. Alert system administrator.'')') - CALL EXIT - END IF - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /WINDOW/ WINDOW - - CHARACTER*80 MESSAGE - - WINDOW = 1 - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - - COMMON /TEMP_INPUT/ NODE_TEMP - CHARACTER NODE_TEMP*256 - - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,PASSWORD*32,TEMP_USER*12 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - RETURN - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C -C SUBROUTINE SET_FOLDER_FILE -C -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE, -C if = 1, set FOLDER1_FILE -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NUM.EQ.0) THEN - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE) - END IF - - RETURN - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C -C SUBROUTINE SET_FILE -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILE - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - ELSE - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)// - & '.]' - END IF - - RETURN - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12 - - DATA UPDATE/.FALSE./, JUST_NAME/.FALSE./ - - UPDATE = .TRUE. - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_UPDATE - - UPDATE = .NOT.UPDATE - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_NAME - - JUST_NAME = .NOT.JUST_NAME - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATE - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):) - - M = INDEX(FILDATE,'-') - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3) - - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN - FOLDER_FILE = FOLDER1_FILE - IF (JUST_NAME) THEN - JUST_NAME = .FALSE. - RETURN - END IF - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THEN - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHARED - END IF - END IF - - JUST_NAME = .FALSE. - - IF (UPDATE) THEN - READ (1'1) NBLOCK - REWRITE (1) NBLOCK + LENGTH - UPDATE = .FALSE. - END IF - - RETURN - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THEN - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE - MINGT0 = MIN(I,J) - END IF - - RETURN - END diff --git a/decus/vlt97a/bulletin/bulletin9.for b/decus/vlt97a/bulletin/bulletin9.for deleted file mode 100644 index 6760e7f..0000000 --- a/decus/vlt97a/bulletin/bulletin9.for +++ /dev/null @@ -1,2469 +0,0 @@ -C -C BULLETIN9.FOR, Version 2/28/97 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - - IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN - WRITE (6,'(A)') ' A new BULLETIN executable has been '// - & 'installed since your last use.' - WRITE (6,'(A)') - & ' Type HELP NEW_FEATURES for help on any new features.' - END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - EXTERNAL BULLETIN_SUBCOMMANDS - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IF - END IF - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE - WRITE (6,1000) - END IF - IF (.NOT.SUBSCRIBE) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - DO I = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IF - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1 - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THEN - NUM_FOLDER = 0 - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1), - & 'HIT any key for next page....') - END IF - END DO - IF (NUM_FOLDERS.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE IF (INEW) THEN - NEW = INEW - IF (REMOTE_SET.GE.3) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSE - CALL FIND_NEWEST_BULL - END IF - END IF - - IF (INCMD(:4).NE.'INDE') THEN - IER = CLI$DCL_PARSE('INDEX',BULLETIN_SUBCOMMANDS) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1010 FORMAT (' The following folders with new messages are present'/) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - FOLDER_PRESENT = CLI$PRESENT('FOLDER') - - IF (FOLDER_PRESENT) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z') - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME) - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURN - END IF - END IF - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid date specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURN - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN - END IF - ELSE IF (SINCE) THEN - IF (BULL_POINT.EQ.0) THEN - WRITE (6,'('' ERROR: No current message.'')') - RETURN - ELSE IF (NEWS) THEN - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THEN - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSE - STARTMSG = 1 - END IF - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - ELSE - IF (NEWS) THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1 - END DO - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND. - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0 - NEWSMSG = 1 - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THEN - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0 - ELSE - FOUND = .FALSE. - END IF - IF (FOUND.AND.NEWS) THEN - WRITE (6,'(1X,A,'' latest message read '', - & I,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'', - & '' to specified folder.'')') - END IF - END IF - IF (.NOT.ALL) THEN - IF (IER.NE.0) THEN - WRITE (6,'('' User info does not exist.'')') - END IF - IER = 2 - END IF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - CALL CLOSE_BULLUSER - ELSE - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - CALL CLOSE_BULLUSER - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - DATA SCRTYPE/-1/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESS - - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - IER1 = 1 - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER2) THEN - CALL ADD_DIRECTORIES - ELSE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IF - END IF - END DO - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - LDESCR = 0 - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - IF (NEWS_FEED()) THEN - CALL STRIP_HEADER(' ',-1,IER) - END IF - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - MAIL = BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0 - IF (MAIL) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.MAIL' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0 - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - ELSE IF (NEWS_FEED().OR.LEN_FROM.EQ.0 - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - SCRTYPE = 0 - SCRNAME = 'SYS$LOGIN:BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - IF (IER1.NE.0) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW') - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /STORED/ STORED - - CHARACTER*256 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.NEWS_FEED().AND. - & .NOT.BTEST(FOLDER_FLAG,11).AND..NOT.STORED) CLOSE (UNIT=3) - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - CHARACTER*24 TODAY - - COMMON /STORED/ STORED - DATA STORED /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THEN - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER - RETURN - ELSE IF (BUFFER(:5).EQ.'From:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE. - OLD_BUFFER_FROM = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Reply-To:') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - END IF - STORED = .TRUE. - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STORED - STORED = .FALSE. - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3) - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - IF (LEN_BUFFER.GT.0) THEN - IF (.NOT.TEXT) THEN - IF (.NOT.NEWS_FEED()) THEN - TEXT = .TRUE. - ELSE - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - END IF - IF (TEXT) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - ELSE - IF (TEXT) WRITE (3,'(A)') ' ' - END IF - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF (.NOT.STORED.AND. - & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') ' ' - END IF - CALL STORE_BULL(1,' ',NBLOCK) - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2 - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-') - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO - INEXDATE = .TRUE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - TEXT = .TRUE. - IF (NEWS_FEED()) THEN - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - IF (.NOT.STORED.AND. - & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAY - - CHARACTER USER_SAVE*12,PROC_SAVE*12 - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1 - FIRST_BREAK = .FALSE. - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - SCRTYPE = -1 - END IF - RETURN - END IF - - EXTIME = '00:00:00.00' - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2100' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - IF (SCRTYPE.EQ.0.AND.NEWS_FEED()) THEN - FOLDER1_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,'>')-1) - CALL SYS$SETAST(%VAL(1)) - CALL NEWS_POST('ignore',.TRUE.,IER,INDESCRIP) - IF (TEST_BULLCP().EQ.2) CALL SYS$SETAST(%VAL(0)) - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3) - END IF - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.EQ.0) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL GETUSER(PROC_SAVE) - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME) - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARD - END IF - CALL RESPOND_MAIL(SCRNAME,INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE(SCRNAME(:TRIM(SCRNAME))//';*') - CALL SETUSER(PROC_SAVE) - USERNAME = USER_SAVE - ELSE - CLOSE (UNIT=3) - END IF - ELSE IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - END IF - - CALL STRIP_HEADER(' ',-1,IER) - - SCRTYPE = -1 - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - - IF (.NOT.NEWS_FEED()) THEN - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - END IF - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(FROM,INFROM,LEN_INFROM) - - RETURN - END - - - SUBROUTINE GET_FROM(FROM,INFROM1,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INFROM1,FROM - - CHARACTER*256 INFROM - - INFROM = INFROM1 - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - I = INDEX(INFROM,'<') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<')+1:) ! personal-name - END IF - - I = INDEX(INFROM,'(') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'(')+1:) ! personal-name (net-name) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR.INFROM(I:I).LE.' '.OR. - & INFROM(I:I).GE.CHAR(127).OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) - I = I + 1 - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1 - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND.INFROM(I:I).GT.' '.AND. - & INFROM(I:I).LT.CHAR(127).AND. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.126) - & INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP).AND..NOT.NEWS_FEED()) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - CALL INIT_QUEUE(HEADER_Q1,INPUT) - IF (BLEN.EQ.-1) THEN - CALL INIT_QUEUE(HEADER_Q1,INPUT) - HEADER_Q = HEADER_Q1 - NHEAD = 0 - END IF - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - END IF - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) THEN ! of previous header line - IF (LAST_NEWSGROUPS) THEN - NEWSGROUPS = NEWSGROUPS(:TRIM(NEWSGROUPS))//BUFFER(2:) - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - END IF - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - LAST_NEWSGROUPS = .FALSE. - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.' - END IF - ELSE IF (BUFFER(:11).EQ.'Newsgroups:') THEN - NEWSGROUPS = BUFFER(13:) - LAST_NEWSGROUPS = .TRUE. - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - - RETURN - END - - - - - SUBROUTINE SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_NEWS_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified news group -C Note: If NOTIFY READNEW and BRIEF = 0, it is either news -C group removal or SET SUBSCRIBE command. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - ALL = .FALSE. - DEFAULT = 1 - NODEFAULT = 0 - SUB = ABS(BRIEF)+ABS(NOTIFY)+ABS(READNEW).EQ.0 - - IF (NOTIFY.EQ.1.AND.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: /NOTIFY is invalid with non-stored'', - & '' news group.'')') - RETURN - END IF - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - IF (CLI$PRESENT('NOPERMANENT').OR.CLI$PRESENT('PERMANENT').OR. - & (SUB.AND.(NODEFAULT.OR.CLI$PRESENT('NOPERMANENT')))) THEN - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (SUB) DEFAULT = 1 - ELSE IF (CLI$PRESENT('NOPERMANENT').OR.NODEFAULT) THEN - IF (NOTIFY.GE.0) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - IF (SUB) - & CALL SET_NEWS_FLAG(IER,-1,-1,-1) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*PERM ',INF_REC - END IF - END IF - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - IF (NODEFAULT.AND.SUB) THEN - NOTIFY = -1 - READNEW = -1 - BRIEF = -1 - END IF - IF (DEFAULT.OR.NODEFAULT) THEN - IF (NODEFAULT.AND..NOT.SUB) THEN - IF (NOTIFY.NE.-1) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - ELSE - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*DEFAULT ',INF_REC - END IF - END IF - IF ((ALL.OR.(SUB.AND.INCMD(:3).NE.'SET')).AND.IER.EQ.0) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY=TEMP_USER,IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - - RETURN - END - - - - - SUBROUTINE READ_INF_REC - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - RETURN - - ENTRY SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & INF_REC2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1.AND.TEMP_USER(:1).EQ.'*') THEN - WRITE (6,'('' ERROR: You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - IER = 0 - RETURN - END IF - - IF (INF_REC2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IF (NOTIFY+READNEW+BRIEF.EQ.-3) THEN - DO J=I,FOLDER_MAX-2 - CALL COPY2(INF_REC(1,J),INF_REC(1,J+1)) - END DO - END IF - IER = 1 - RETURN - END IF - - IF (NOTIFY+READNEW+BRIEF.EQ.-3) RETURN - - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(INF_REC2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(INF_REC(1,J),INF_REC(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - INF_REC2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - INF_REC2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - INF_REC(2,J) = F_START - 1 - ELSE - INF_REC2(2,J) = 0 - INF_REC(2,J) = F_NBULL - END IF - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IER = 1 - RETURN - END IF - END DO - - RETURN - END diff --git a/decus/vlt97a/bulletin/bullfiles.inc b/decus/vlt97a/bulletin/bullfiles.inc deleted file mode 100644 index af8ee2e..0000000 --- a/decus/vlt97a/bulletin/bullfiles.inc +++ /dev/null @@ -1,39 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vlt97a/bulletin/bullfolder.inc b/decus/vlt97a/bulletin/bullfolder.inc deleted file mode 100644 index 117f8fc..0000000 --- a/decus/vlt97a/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vlt97a/bulletin/bullmain.cld b/decus/vlt97a/bulletin/bullmain.cld deleted file mode 100644 index 32c0642..0000000 --- a/decus/vlt97a/bulletin/bullmain.cld +++ /dev/null @@ -1,34 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vlt97a/bulletin/bullnews.inc b/decus/vlt97a/bulletin/bullnews.inc deleted file mode 100644 index 251895d..0000000 --- a/decus/vlt97a/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vlt97a/bulletin/bullstart.com b/decus/vlt97a/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vlt97a/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vlt97a/bulletin/bulluser.inc b/decus/vlt97a/bulletin/bulluser.inc deleted file mode 100644 index 215a667..0000000 --- a/decus/vlt97a/bulletin/bulluser.inc +++ /dev/null @@ -1,53 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vlt97a/bulletin/changes.txt b/decus/vlt97a/bulletin/changes.txt deleted file mode 100644 index 977b040..0000000 --- a/decus/vlt97a/bulletin/changes.txt +++ /dev/null @@ -1,648 +0,0 @@ -V 2.24 - -When replying to a message in a news group that has been crossposted, give the -user the option of just posting the reply to the news group in which the -message is being read rather than all the news groups in the crosspost. -11/20/95 - -Messages added to folders and stored news groups are now marked as being read -so that the person does not see them when doing a READ/NEW. 11/20/95 - -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vlt97a/bulletin/cmds.mai b/decus/vlt97a/bulletin/cmds.mai deleted file mode 100644 index 1340739..0000000 --- a/decus/vlt97a/bulletin/cmds.mai +++ /dev/null @@ -1,22 +0,0 @@ -The address for getting BULLETIN is BULLETIN@PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file - (only one file per command). - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - -BULLETIN is also available via ANONYMOUS FTP from PFC.MIT.EDU, but the account -is set at low priority, so I suggest using it during non-prime hours. - - Mark diff --git a/decus/vlt97a/bulletin/copyright.txt b/decus/vlt97a/bulletin/copyright.txt deleted file mode 100644 index ee33a7e..0000000 --- a/decus/vlt97a/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vlt97a/bulletin/create.com b/decus/vlt97a/bulletin/create.com deleted file mode 100644 index 5e90fde..0000000 --- a/decus/vlt97a/bulletin/create.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vlt97a/bulletin/handout.txt b/decus/vlt97a/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vlt97a/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vlt97a/bulletin/install.com b/decus/vlt97a/bulletin/install.com deleted file mode 100644 index 758acd4..0000000 --- a/decus/vlt97a/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vlt97a/bulletin/instruct.com b/decus/vlt97a/bulletin/instruct.com deleted file mode 100644 index a9cf299..0000000 --- a/decus/vlt97a/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vlt97a/bulletin/instruct.txt b/decus/vlt97a/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vlt97a/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vlt97a/bulletin/login.com b/decus/vlt97a/bulletin/login.com deleted file mode 100644 index 5c0c2d5..0000000 --- a/decus/vlt97a/bulletin/login.com +++ /dev/null @@ -1,31 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! If you want to have more than one BULLETIN database, replace BULL_DIR -$! with the actual directory to allow redefining BULL_DIR. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vlt97a/bulletin/makefile b/decus/vlt97a/bulletin/makefile deleted file mode 100644 index 964fa04..0000000 --- a/decus/vlt97a/bulletin/makefile +++ /dev/null @@ -1,82 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.24" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vlt97a/bulletin/master.com b/decus/vlt97a/bulletin/master.com deleted file mode 100644 index 4cd0125..0000000 --- a/decus/vlt97a/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vlt97a/bulletin/mx.com b/decus/vlt97a/bulletin/mx.com deleted file mode 100644 index 47bd33c..0000000 --- a/decus/vlt97a/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_SOURCE to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vlt97a/bulletin/mx.mai b/decus/vlt97a/bulletin/mx.mai deleted file mode 100644 index ec864aa..0000000 --- a/decus/vlt97a/bulletin/mx.mai +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_LIBRARY") .eqs. "" -$ then say "BULL_LIBRARY logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_library/LIB,SYS$SYSTEM:SYS.STB/SEL,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_LIBRARY to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P4 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P4 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P4 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p4 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p2' 'p3' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p2' 'p3' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vlt97a/bulletin/news.alt b/decus/vlt97a/bulletin/news.alt deleted file mode 100644 index e33d065..0000000 --- a/decus/vlt97a/bulletin/news.alt +++ /dev/null @@ -1,254 +0,0 @@ - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales diff --git a/decus/vlt97a/bulletin/news.com b/decus/vlt97a/bulletin/news.com deleted file mode 100644 index fb7775e..0000000 --- a/decus/vlt97a/bulletin/news.com +++ /dev/null @@ -1,679 +0,0 @@ -$set nover -$copy/log sys$input NEWS.ALT -$deck - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales -$eod -$copy/log sys$input NEWS.CREATE -$deck -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - -$eod -$copy/log sys$input NEWS.MODERATORS -$deck -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com -$eod diff --git a/decus/vlt97a/bulletin/news.create b/decus/vlt97a/bulletin/news.create deleted file mode 100644 index dc1c840..0000000 --- a/decus/vlt97a/bulletin/news.create +++ /dev/null @@ -1,155 +0,0 @@ -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - diff --git a/decus/vlt97a/bulletin/news.moderators b/decus/vlt97a/bulletin/news.moderators deleted file mode 100644 index b53780f..0000000 --- a/decus/vlt97a/bulletin/news.moderators +++ /dev/null @@ -1,260 +0,0 @@ -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com diff --git a/decus/vlt97a/bulletin/news.txt b/decus/vlt97a/bulletin/news.txt deleted file mode 100644 index f52d95e..0000000 --- a/decus/vlt97a/bulletin/news.txt +++ /dev/null @@ -1,150 +0,0 @@ -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when a -user accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. It is also possible to -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) When the POST and -ADD commands are used with this folder, the messages will be posted to the news -group, rather than actually being added to the folder. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. diff --git a/decus/vlt97a/bulletin/nonsystem.txt b/decus/vlt97a/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vlt97a/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vlt97a/bulletin/optimize_rms.com b/decus/vlt97a/bulletin/optimize_rms.com deleted file mode 100644 index 4f42e3e..0000000 --- a/decus/vlt97a/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vlt97a/bulletin/pmdf.com b/decus/vlt97a/bulletin/pmdf.com deleted file mode 100644 index 732bcf2..0000000 --- a/decus/vlt97a/bulletin/pmdf.com +++ /dev/null @@ -1,1031 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input BULLETIN_MASTER.PAS_V32 -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *) -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - - outbound : text; - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL - 100; - - VAR - line, errorsto : vstring; - bigline : bigvstring; result : rp_bufstruct; - header : he_header; - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string); - - BEGIN (* try_something *) - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *) - end; (* try_something *) - - BEGIN (* return_bad_messages *) - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt'); - try_something (he_read_header (header, qu_rtxt), 'he_read_header'); - errorsto.length := 0; - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i]; - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto), - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr); - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *) - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages (tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable. - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT - -For V3.2: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check your -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vlt97a/bulletin/restart.com b/decus/vlt97a/bulletin/restart.com deleted file mode 100644 index 502bfa8..0000000 --- a/decus/vlt97a/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vlt97a/bulletin/setuser.mar b/decus/vlt97a/bulletin/setuser.mar deleted file mode 100644 index 153cb7b..0000000 --- a/decus/vlt97a/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vlt97a/bulletin/update.fil b/decus/vlt97a/bulletin/update.fil deleted file mode 100644 index 97fb572..0000000 --- a/decus/vlt97a/bulletin/update.fil +++ /dev/null @@ -1,11 +0,0 @@ -$ if p1 .nes. "" then FS 'P1' -$ COPY 'FM' [.SEND]/LOG -$ COPY 'FM' CMODA::IR:[BULLETIN] -$ TAB2SP 'FM' -$ RENAME 'FM' [-.NET] -$ PUR [.SEND]'FM' -$ PUR [-.NET]'FM' -$ IF FM .EQS. "CHMAIL.MAI" THEN P3 = "AAAREADME." -$ IF P2 .EQS. "" THEN COPY 'FM' [ANONYMOUS.BULLETIN]'P3' -$ IF P3 .EQS. "" THEN PUR [ANONYMOUS.BULLETIN]'FM' -$ IF P3 .NES. "" THEN PUR [ANONYMOUS.BULLETIN]'p3' diff --git a/decus/vlt97a/bulletin/upgrade.com b/decus/vlt97a/bulletin/upgrade.com deleted file mode 100644 index a2d77c4..0000000 --- a/decus/vlt97a/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vlt97a/bulletin/writemsg.txt b/decus/vlt97a/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vlt97a/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vms93a/bulletin/aaareadme b/decus/vms93a/bulletin/aaareadme deleted file mode 100644 index 7aaf853..0000000 --- a/decus/vms93a/bulletin/aaareadme +++ /dev/null @@ -1,77 +0,0 @@ -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -If you are running a version of BULLETIN older than 2.11, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. NOTE: -Problems can occur if the old version of BULLETIN is run after the -data files have been modified. Such a situation is possible on a -cluster where each node has installed the executable separately. To -help installation, a new command procedure UPGRADE.COM has been -included. Read the comments in the file for information on how to use -it. - -As of V2.0, BULLETIN is able to read USENET NEWS via TCP/IP using either -CMU, MULTINET, UCX, TWG, or via DECNET. It can also serve as a NEWS -gateway for DECNET nodes without direct access to the NEWS server, i.e. a -DECNET node without Internet access will be able to read NEWS. - -NOTE: The following commands can be sent to BULLETIN@PFC.MIT.EDU: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. (This does not describe the NEWS reader -feature, however.) - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -You will be receiving 21 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) BULLETIN10.FOR - 13) BULLETIN11.FOR - 14) ALLMACS.MAR - 15) BULLCOMS1.HLP - 16) BULLCOMS2.HLP - 17) BULLET1.COM - 18) BULLET2.COM - 19) PMDF.COM - 20) MX.COM - 21) NEWS.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. However, this only applies -to PMDF V3.2 or earlier, as later versions of PMDF have the necessary -interface code for BULLETIN included in it. In that case, or in case -you don't have PMDF, you can delete it. The same applies to MX. Then, -read AAAREADME.TXT for BULLETN installation instructions. If you are -using the news feature, NEWS.COM contains files which pertain to news. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@NERUS.PFC.MIT.EDU diff --git a/decus/vms93a/bulletin/aaareadme.txt b/decus/vms93a/bulletin/aaareadme.txt deleted file mode 100644 index fb97c8c..0000000 --- a/decus/vms93a/bulletin/aaareadme.txt +++ /dev/null @@ -1,201 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vms93a/bulletin/allmacs.mar b/decus/vms93a/bulletin/allmacs.mar deleted file mode 100644 index 5e644be..0000000 --- a/decus/vms93a/bulletin/allmacs.mar +++ /dev/null @@ -1,306 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler -; MOVL @#CTL$GL_PCB,R6 ; Address of current process -; MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler -; MOVL @#CTL$GL_PCB,R2 ; Address of current process -; MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVL R3,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler -; MOVL @#CTL$GL_PCB,R7 ; Address of current process -; MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler -; MOVL @#CTL$GL_PCB,R7 ; Address of current process -; MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vms93a/bulletin/board_digest.com b/decus/vms93a/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vms93a/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vms93a/bulletin/board_special.com b/decus/vms93a/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vms93a/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vms93a/bulletin/bull_news.c b/decus/vms93a/bulletin/bull_news.c deleted file mode 100644 index ae53923..0000000 --- a/decus/vms93a/bulletin/bull_news.c +++ /dev/null @@ -1,513 +0,0 @@ -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, struct dsc$descriptor *routine, int (**rtn)()); - -int gethostname1(int arg1,int arg2) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"gethostname"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} diff --git a/decus/vms93a/bulletin/bull_newsdummy.for b/decus/vms93a/bulletin/bull_newsdummy.for deleted file mode 100644 index a17d3ec..0000000 --- a/decus/vms93a/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,99 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END diff --git a/decus/vms93a/bulletin/bullcom.cld b/decus/vms93a/bulletin/bullcom.cld deleted file mode 100644 index dbd25ce..0000000 --- a/decus/vms93a/bulletin/bullcom.cld +++ /dev/null @@ -1,655 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 2/1/93 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED) - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULT - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER EDIT - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER FROM - QUALIFIER SUBJECT - QUALIFIER NEGATED - DISALLOW SEARCH_STRING AND REPLY - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vms93a/bulletin/bullcoms1.hlp b/decus/vms93a/bulletin/bullcoms1.hlp deleted file mode 100644 index eff793c..0000000 --- a/decus/vms93a/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1095 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers so -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file can -be specified which contains the text. If the editor is used for changing -the text, the old message text will be extracted. This can be suppressed -by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST - -If a mailer protocol is needs to be added to the network address in -order for it to be sent by VMS MAIL, i.e. protocol%"address", the -appropriate protocol can be specified by either hardcoding it into the -file BULLNEWS.INC before compiling BULLETIN, or by defining the system -logical name BULL_NEWS_MAILER (it is the same protocol used by the NEWS -feature in order to respond to NEWS messages). The default protocol is -IN%. If desired, you can specify the protocol with the address, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, the -folder will then be modified to point to that folder. For example if -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be shared -between more than one node. This capability is only present if the BULLCP -process is running on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message. -It can be a substring of the subject. This is in case you have forgotten -the exact subject that was specified. Case is not critical either. -You will be notified if the deletion was successful. -See also /NEGATED. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting messages -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed.A - - Format:s - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message.i -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description ofe -folder. -2 /EXPIRATIONl -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the -DIRECTORY command are to be written into the specified file. Allc -qualifiers which are valid for the EXTRACT command are valid in -conjunction with /EXTRACT except for /NEW which conflicts with the ( -DIRECTORY /NEW qualifier. The listof messages to be printed will be -displayed on the terminal (in nopaging format). -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS. -2 /FROMO - /FROM=[string]t - -Specifies that only messages whose username contains the specified stringe -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.a -See also /NEGATED. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don'tf -match the specified search command are displayed. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. e -2 /UNMARKEDa -Lists messages that have not been marked (marked messages are indicatedh -by an asterisk). Using /UNMARKED is equivalent to selecting the foldern -with /UNMARKED, i.e. only unmarked messages will be shown and be ablei -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEENw -Lists messages that have been seen (indicated by a greater than sign). a -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlye -seen messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. v -2 /UNSEENE -Lists messages that have not been seen (seen message are indicated by ar -greater than sign). Using /UNSEEN is equivalent to selecting the foldero -with /UNSEEN, i.e. only unseen messages will be shown and be able to beh -read. To see all messages, use either /ALL, or reselect the folder. a -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWSe -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The liste -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current messaget -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED.o -2 /SEARCH - /SEARCH=[string]y - -Specifies that only messages which contain the specified string aree -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.E -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.a -2 /START - /START=message_number - -Indicates the first message number you want to display. For example,t -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDEW -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings.e - - Format:f - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE.m -2 /FROM -Specifies to exclude the message based on the message owner. This ise -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL. -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROMt -and /SUBJECT cannot be specified at the same time. m -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following linee -must be present: - -folder_name:defaults:killo - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program.n -1 EXTRACTs -Synonym for FILE command. -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified. - - Format:W - FILE filename [message_number][-message_number1],[...] - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Copies all the messages in the current folder. -2 /FFe -Specifies that a form feed is placed between messages in the file. -2 /HEADERt - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 FIRST -Specifies that the first message in the folder is to be read.N -1 FORWARD -Synonym for MAIL command. -1 Folderst -All messages are divided into separate folders. New folders can beh -created by any user. As an example, the following creates a folder ford -GAMES related messages: - h -BULLETIN> CREATE GAMES -Enter a one line description of folder.e -GAMESo - -To see the list of available folders, use DIRECTORY/FOLDERS. To selecte -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, thatd -user will be alerted of topics of new messages at login time, and will h -then be given the option of reading them. Similar to READNEW is SHOWNEW,f -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option,a -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command.t - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in thet -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SETt -NODE. A remote folder is one which points to a folder on a remote DECNETc -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)r -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/d -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, ande -giving access to that UIC group. Only users in that UIC group will seei -the messages in that folder when they log in.e -1 HELP -To obtain help on any topic, type: - - HELP topico -1 INCLUDEt -Specifies to include reading messages based on the message owner or the -subject. If it is determined that a message is to be included, then the -message is read when a user tries to read a message by typing NEXT or -BACK, or by hitting the return key. Otherwise, it is skipped. Specify -the qualifier /FULL to make all EXCLUDEs and INCLUDEs for the specified -folder apply to all other BULLETIN commands, including directory -listings. - - Format: - INCLUDE [string] - -If a string is specified, then the message is included if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one INCLUDE may be -specified per folder. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all INCLUDEs. -2 /DISABLE -Specifies to permanently disable the INCLUDE.T -2 /FROMc -Specifies to include the message based on the message owner. This ise -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULLt -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. -2 /SUBJECT -Specifies to include the message based on the message subject. /FROMC -and /SUBJECT cannot be specified at the same time. g -2 Storing_INCLUDEs -INCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):stringg - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:killi - -excluding the folder_name causes it to apply to all folders. -1 INDEX/ -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for c -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after ones -has read a message. /RESTART must be specified to start from the firsto -folder if a scan is in progress. All other qualifiers are ignored while -a scan is in progress. - - Format:a - INDEX - -When a directory is displayed, you can read the first message in the e -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for olders -versions of BULLETIN.o -2 /MARKEDl -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED,f -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKEDt -Lists messages that have not been marked (marked messages are indicatedt -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read.a -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlyh -seen messages will be shown and be able to be read.i -2 /UNSEENm -Lists messages that have not been seen (seen message are indicated by an -greater than sign). Using /UNSEEN is equivalent to selecting the folderr -with /UNSEEN, i.e. only unseen messages will be shown and be able to bec -read. -2 /NEW - /[NO]NEWe - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message.D -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified.d -2 /RESTART -If specified, causes the listing to be reinitialized and start from ther -first folder.S -2 /SET - /[NO]SET, - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format: - LASTN -2 /EDITL -Specifies that the editor is to be used to read the message. This iss -useful for scanning a long message.s -2 /HEADERr - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commando -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEa -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format:d - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying ane -address that has quotes, in order to pass the quotes you must specifyN -triple quotes. I.e. a network address of the form xxx%"address" musta -be specified as xxx%"""address""". -2 /EDITf -Specifies that the editor is to be used to edit the message before -mailing it. -2 /HEADERm - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the e -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks (").t - -If you omit this qualifier, the description of the message will be usedg -as the subject.s -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directoryC -listing. A marked message can serve as a reminder of importantt -information. The UNMARK command sets the current or message-id messageg -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers]t - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to bya -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 MODIFY -Modifies the database information for the current folder. Only thei -owner of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted forC -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing listh -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTu -commands, the address of the mailing list should be included in thea -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST p -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to itn -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAMEp - /NAME=foldernamee - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not haver -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID.m -1 MOVE -Moves a message to another folder and deletes it from the current -folder.S - - Format:A - - MOVE folder-name [message_number][-message_number1]s - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,d -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPSl - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message tos -the specified NEWS group(s) in addition to the selected NEWS group.e -2 /HEADERa - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied.h -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.y -2 /ORIGINALt -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned byr -the person moving the message. -1 NEWS -Displays the list of available news groups.h - -Format:o - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed.o - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL willf -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /NEWGROUP -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B.h -2 /STOREDe -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over.f -2 /EDIT -Specifies that the editor is to be used to read the message. This isN -useful for scanning a long message.c -2 /HEADERA - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEi -Specifies to decode the message using ROT-13 coding. diff --git a/decus/vms93a/bulletin/bullcoms2.hlp b/decus/vms93a/bulletin/bullcoms2.hlp deleted file mode 100644 index 3d5a2fb..0000000 --- a/decus/vms93a/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1393 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with > at the -beginning of each line. This can be suppressed with /NOINDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. In -order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply surround -the exclusive text starting with the line "START " and ending -with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have -just read) for printing. The file created by the PRINT command -is not released to the print queue until you exit, unless you add -the qualifier /NOW or change one of the print job's qualifiers. -Multiple messages are concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected and /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read them. -(Note: Reading the last message does the same thing, but RESET does it -without having to read it.) -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header. -If a "search-string" is not specified, a search is made using the -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for -a match. If, during a search, no more matches or messages are found, -the next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the last -message. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUS -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name. - - Format: - - SET [NO]ANONYMOUS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. - - Format: - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If a -mailing address is present (see /DESCRIPTION), when messages are added -to the folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be -used if the POST command is entered. One use for this is a local board -which is also distributed to non-local users. - - Format: - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages. - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30" -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The forma -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY. -The time will always be 00:00, even if the time is specified on the line.e -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be:R - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account. - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV.c -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION. -2 BRIEF2 -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa). - - Format:e - - SET [NO]BRIEFf -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newA -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernameE - -Specifies the folder for which the option is to modified. If notr -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by thel -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier.e -2 COMPRESS -Specifies that messages added to the folder will be in compressed format. -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires a -very little cpu overhead.e - - Format:K - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. f -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed everye -time when logging in, until the new messages are read. Normally, theh -BRIEF setting causes notification only at the first time that new messages -are detected.o - - Format:s - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for ther -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges.u - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - - Format:o - - SET DEFAULT_EXPIRE days. - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages.s - - Format:e - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it.f -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - SET [NO]EXPIRE_LIMIT [days]c - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name]o -3 /MARKEDe -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected.t -2 GENERICd -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for theC -same user. -3 /DAYSh - /DAYS=number_of_dayse - -Specifies the number days that new messages will be displayed for upon -logging in. -2 KEYPAD s -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to bye -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI.x -2 LOGINU -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command.b - - Format:t - - SET [NO]LOGIN username -2 NEWS -Changes attributes of the specified news group or class of news groups.O -This command requires privileges. - - Format:r - - SET NEWS [news-group] - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALL - /NOALLa - -If specified with /CLASS or /DEFAULT, all groups that are presentlys -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of any -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the defaultf -attributes (using /DEFAULT) with /NOALL, the attributes for misc.testE -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. R -3 /CLASS - /CLASS=classnamet - -Specifies to modify attributes for a class of news groups rather than a -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes ofA -existing groups which are in the class are modified, and any groupsh -created in the future will automatically have those attributes.m -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETEa -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLEn -Specifies that the news group is enabled and can be accessed. This is -the default. -3 /EXPIRATIONy - /EXPIRATION=daysN - -Specifies the default expiration time for messages if none is specified. -The default is 7.a -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified isr --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default.E -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is posted -every month with an expiration date of one month in the future.i -3 /PRIVATE - /PRIVATEn - /NOPRIVATEd - -Specifies that the news group or class can have it's access modified byt -the SET ACCESS command. To accomplish this, a file is created ing -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access n -to news groups in that class is to set /NOPRIVATE, as then time won't be -wasted checking a file for ACLs. -3 /STOREDo - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessede -via the network from the server node. This results in faster access,o -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED., -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node.e - - Format:e - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder. - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node,f -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated.o -3 /FOLDERe - /FOLDER=foldernamee - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format:, - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are loggedL -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users fore -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specifiede -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERh - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY.s -3 /PERMANENT - /[NO]PERMANENT - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier.A -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN.o - - Format:a - - SET [NO]PAGE -2 POST_ONLYA -Specifies that the selected folder has the POST_ONLY attribute. Thise -causes the ADD command to mail the message to the mailing address if itt -is present (see /DESCRIPTION), rather than add to the folder. p - - Format:m - - SET [NO]POST_ONLYl -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format:t - - SET PRIVILEGES parametersS - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers.e -3 /IDc - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.n -2 PROMPT_EXPIREf -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format:f - - SET [NO]PROMPT_EXPIRE -2 READNEWr -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. - - Format:e - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersn -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand news -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENTh - -Specifies that READNEW is a permanent flag and cannot be changed by thee -individual. This is a privileged qualifier. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN.t - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format:s - - SET [NO]SHOWNEWe -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new userso -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newn -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernameh - -Specifies the folder for which the option is to modified. If nots -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENTE - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged qualifier. -2 STRIP -Affect only messages which are added via either the BBOARD option, ore -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped offt -before it is stored as a BULLETIN message. - - Format:r - - SET [NO]STRIPb - -The command SHOW FOLDER/FULL will show if STRIP has been set.a -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM foldert -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is aB -privileged command.T - - Format:S - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.s -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGST -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for thee -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected via -the SELECT command, information about that folder is shown.g - - Format:o - - SHOW FOLDER [folder-name]a -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder iso -private, and BBOARD information. This information is only those who -have access to that folder. -2 KEYPAD -Displays the keypad command definitions. - - Format:e - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either the SET KEYPAD COMMAND, orn -if /KEYPAD is specified on the command line, the keypad keys will be -defined as commands. The default settings for the keypad are shown viat -SHOW KEYPAD or HELP KEYPAD. Settings can be changed by using an -initialization file with DEFINE/KEY commands. BULLETIN looks first fora -the file pointed to by the logical name BULL_INIT and then for the filef -SYS$LOGIN:BULL.INI.a - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT).e -3 /STATE - /STATE=(state,state,...) - -Specifies the name of a state for which the specified key definitionse -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when -a key name has been specified. -2 NEWe -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format:t - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this.w -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command.e -3 /LOGIN - /[NO]LOGIN. - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDER - /FOLDER=[foldername] - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups.d -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSIONi -Shows the version of BULLETIN and the date that the executable was -linked. -1 SPAWNS -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format:f - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBEv -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of thet -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. e -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format: - UNDELETE [message-number]e -1 UNSUBSCRIBEd -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See thee -SUBSCRIBE command for further info. -1 Usenet_newsS -BULLETIN can also read USENET NEWS if your system has network access toi -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of w -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group ine -order to keep track of which messages you have read in that group. Most -of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read news groups with new messages, use INDEX/SUBSCRIBE. i -1 New_features -Here is a list of new features which may be of interest to the general e -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - --------------------------------------------------------------------------d -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group byd -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92s - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92E - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -V 2.09 - -Added /FROM, /NOREPLIES, & /NEGATED to SEARCH and DIRECTORY commands. -3/18/92m - -Changing keypad definitions using initialization file now possible. 3/12/92o - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Display time when reading news messages in local rather than GMT time. -12/8/91o - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91o - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive,U -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for then -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91o - -Fixed error in POST & RESPOND command. If a file was specified on the -command line, and /EDIT was specified, the file would be sent even if the -user quit out of the edit, rather than exitting (i.e. outputting a file). -10/21/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message -basis. Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91n - -Added /NOW to PRINT command. Messages no longer have to be printed one -message at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are -found by using the DIRECTORY command. 7/31/91r - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large -news group names. 7/31/91t - -Added FIRST command to read first message found in folder. 7/31/91m - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91Y - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more -than one folder at a time. 6/13/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -V2.04r - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91s -1 Customizing -A user can specify certain customized features by adding commands to the -file SYS$LOGIN:BULL.CUSTOM or in the file pointed to by the logical name -BULL_USER_CUSTOM. The following are the commands and formats presentlyv -available: - -To specify to include or exclude a message when reading messages, basedr -on a string found in the message's subject or address, add a line with the -format: - -folder_name:INCLUDE(or EXCLUDE):FROM(or SUBJECT):stringg - -Includes and excludes can be done using the INCLUDE and EXCLUDE commands.e - -The following are commands which allow certain switches to be the -default for a folder. The format is folder_name:defaults followed by -the specified qualifier (each qualifier is preceded by a :). If you -want the qualifiers to apply to all folders, omit the folder_name and -start the line with simply :defaults. - -To specify that /HEADER is the default for a folder, add :header, i.e. - -GENERAL:defaults:headere - -In order that INCLUDEs and EXCLUDEs be applied to all commands in a -folder, add :kill. (Adding /FULL to a INCLUDE or EXCLUDE command does -this for you). P diff --git a/decus/vms93a/bulletin/bulldir.inc b/decus/vms93a/bulletin/bulldir.inc deleted file mode 100644 index 7bdda8d..0000000 --- a/decus/vms93a/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 180 - - COMMON /NEWS_DIR/ NEWS_MSG_KEY,NEWS_MSG_BTIM_KEY,NEWS_MSGID - & ,NEWS_EX_BTIM_KEY,NEWS_POST_BTIM,NEWS_BLOCK,NEWS_LENGTH - & ,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*64 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_MSG_KEY,NEWS_HEADER_KEY - - CHARACTER*12 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*12 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_KEY,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vms93a/bulletin/bullet1.com b/decus/vms93a/bulletin/bullet1.com deleted file mode 100644 index 2c31b03..0000000 --- a/decus/vms93a/bulletin/bullet1.com +++ /dev/null @@ -1 +0,0 @@ -$set nover diff --git a/decus/vms93a/bulletin/bulletin.cld b/decus/vms93a/bulletin/bulletin.cld deleted file mode 100644 index dc7abbd..0000000 --- a/decus/vms93a/bulletin/bulletin.cld +++ /dev/null @@ -1,43 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vms93a/bulletin/bulletin.for b/decus/vms93a/bulletin/bulletin.for deleted file mode 100644 index 1715989..0000000 --- a/decus/vms93a/bulletin/bulletin.for +++ /dev/null @@ -1,1890 +0,0 @@ -C -C BULLETIN.FOR, Version 4/12/93 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION - - CALL OPEN_OLD_TAG - - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (NEWS_FEED().OR.REMOTE_SET.GE.3) THEN - INCMD = 'POST '//INCMD(4:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL RESPOND - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'INCL') THEN ! INCLUDE? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:2).EQ.'CO') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOCO') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN?. - CALL SET_LOGIN(.FALSE.)r - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE'): - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIREt - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS? - CALL SET_NEWS - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGSU - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDERG - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATIONO - FOLDER1 = SAVE_FOLDERN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER)X - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES?B - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER?C - CALL SHOW_USERM - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSIONO - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESSS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBEE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE?E - CALL UNDELETEF - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1) - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN?4 - CALL TAG(.FALSE.,2)U - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE= - END IF - -100 CONTINUE' - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXITA - - END DO( - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more preceding messages.') - - END - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z)S - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURNN - - END - - - - - - SUBROUTINE ADD -CL -C SUBROUTINE ADDM -CU -C FUNCTION: Adds bulletin to bulletin file. -CL - IMPLICIT INTEGER (A - Z)F - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODEC - CHARACTER*32 NODES(10)D - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITL - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULTR - DATA EDIT_DEFAULT/.FALSE./R - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLFOLDER.INC'W - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIPF - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8e - - CHARACTER INEXDATE*12,INEXTIME*12 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8T - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THENa - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IFe - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT')s - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF& - - CALL DISABLE_CTRL ! Disable CTRL-Y & -CC - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THENs - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'L - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH,! - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED')K - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENC - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IFT - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF_ - - SELECT_FOLDERS = .FALSE./ - IF (CLI$PRESENT('SELECT_FOLDER')) THEN. - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910> - SELECT_FOLDERS = .TRUE.N - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER_ - END IF( - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THENB - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',' - & READONLY,SHARED,ERR=920,FORM='FORMATTED')T - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',R - & READONLY,SHARED,ERR=920,FORM='FORMATTED')_ - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT! - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1A - WRITE (3,'(A)') INPUT(:ILEN) - END IFE - END DOn - CLOSE (UNIT=4)F - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER)( - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges( - END IF) - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set andT - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910E - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present?T - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IFT - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privilegesL - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abortS - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IFR - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?L - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THENc - SYSTEM = SYSTEM.OR.8. - END IF - END IFf - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?R - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083)_ - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00' - END IF - END IF$ - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privilegesT - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abortE - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE)C - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name ifP - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSEO - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)F - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bitE - INEXDATE = '5-NOV-2000' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60) - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60)r - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DOl - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IFL - - SELECT_NODES = .FALSE.b - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE.e - END IFe - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown - IF (.NOT.IER) GO TO 910A - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY?P - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified! - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSEO - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: ". - -CE -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal._ -CE - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specifiedT - IF (LEN_P.EQ.0) THEN ! If no file param specifiedM - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')N - LEN_P = 1 - ELSE - CLOSE (UNIT=3)I - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')D - IF (CLI$PRESENT('EXTRACT')) THENC - CONTEXT = 0) - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN= - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IFR - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')= - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IFD - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35I - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record countT - IF (ILEN.GT.LINE_LENGTH) GO TO 950r - ICOUNT = ICOUNT + 1 + MIN(ILEN,80)c - BLENGTH = BLENGTH + ILEN - 1 + 2D - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with_ - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW',t - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counterI - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTHM - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredL - ICOUNT = ICOUNT + ILEN ! Update counter - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch fileI - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outF - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE. - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting.'', - & '' A truncated message will be broadcast.'')') - CALL GET_INPUT_PROMPT(INPUT,ILEN, - & 'Type C to continue, A to only ADD message, or Q to Quit: ')( - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN' - BRDCST = .TRUE. - END IF - END IF' - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST') - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT'. - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1)' - ! If not permanent or shutdown specify datea - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH)L - IF (IER.EQ.0) THENe - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN)S - END IFD - END DOS - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THENI - WRITE (6,'('' Message successfully sent to node '',A)')s - & NODES(POINT_NODE)O - ELSE - WRITE (6,'('' Error while sending message to node '',A)')O - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80)E - GO TO 940 - END IFM - REWIND (UNIT=3) - END DO - END IFL - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95D - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -C -C Add bulletin to bulletin file and directory entry for to directory file.C -C: - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1t - FOLDER1 = NODES(I): - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry: - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! UsernameM - END IF) - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK_ - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THENS - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '//) - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK)L - END IFC - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6,N - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK)H - END IF - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletinM - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletinD - LENGTH = OCOUNT - (NBLOCK+1) + 1. - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IF( - - CALL ADD_ENTRY ! Add the new directory entryL - - CALL CLOSE_BULLFIL ! Finished adding bulletinA - - IF (FOLDER_NUMBER.GE.0) THENT - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -CO -C If user is adding message, an no new messages, update last read time for_ -C folder, so user is not alerted of new message which is owned by user. -CG - IF (DIFF.GE.0) THENE - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)C - END IF - END IFL - - CALL CLOSE_BULLDIR ! Totally finished with add -CH -C Broadcast the bulletin if requested.L -C_ - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THENB - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'),S - & CLI$PRESENT('CLUSTER')) - END IFQ -C' -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP, -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same clusterI -C as that of the BULLCP node. -CE - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET)I - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER'))( - END IFN - ELSE IF (.NOT.IER) THENR - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR.( - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THENe - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL DISABLE_PRIVSU - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT,I - & INDESCRIP(:LENDES),STATUS) - CALL ENABLE_PRIVS - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',I - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')N - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',M - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IFA - END IF - END DOC - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DOA - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN_ - FOLDER_NUMBER = OLD_FOLDER_NUMBERC - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER)C - END IFI - - IF (CLI$PRESENT('EXTRACT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IFE - - RETURNO - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100)I - GOTO 100( - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GOTO 100) - -930 WRITE (ERROR_UNIT,1025): - CALL CLOSE_BULLFILw - CALL CLOSE_BULLDIR - CLOSE (UNIT=3)e - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018)T - CLOSE (UNIT=3)E - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A)T -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')T -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for systemO - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdownL - & if folder is remote.')P -2010 FORMAT(A) -2020 FORMAT(1X,A)E - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER)E - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM)L - IF (.NOT.IER) RETURNT - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1L - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC'L - - INCLUDE 'BULLFOLDER.INC'A - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER LOCALNODE*8,RESPONSE*4S - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE.4 - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND)T - DO WHILE (REC_LOCK(IER)) E - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURNL - END IFU - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DOY - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN: - IER = 0t - I = 1t - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER)A - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128s - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDERP - ELSE' - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN,T - & 'Want to try again? (Y/N with Y as default): ')N - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THENI - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')')T - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURNE - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'F - - COMMON /INDESCRIP/ INDESCRIPE - CHARACTER*(INPUT_LENGTH) INDESCRIPh - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been readn - WRITE(6,'('' ERROR: You have not read any message.'')')L - RETURN ! And returnI - END IFU - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinI - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHAREDE - - ILEN = LINE_LENGTH + 1r - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)R - END IF) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:), - ELSEc - INDESCRIP = DESCRIP - END IFo - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIRI - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'RE:'//INDESCRIP(4:) - ELSEE - INDESCRIP = 'RE: '//INDESCRIP, - END IFM - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP)) - - CALL ADDt - - RETURNd - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - E - IMPLICIT INTEGER (A-Z)D - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUTS - - CALL INIT_ITMLSTN - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST)D - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV. -CT -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS:C -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z)I - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info. - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIVS - IMPLICIT INTEGER (A-Z)_ - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'_ - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER)L - CALL CLOSE_BULLUSERI - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2)S - END IFA - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR.) - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN' - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE.E - END IFR - - RETURNQ - END - - - - LOGICAL FUNCTION OPER_PRIVn - IMPLICIT INTEGER (A-Z)f - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURNB - END - - - ( - SUBROUTINE GETUSER(USERNAME)T -C -C SUBROUTINE GETUSERA -C. -C FUNCTION: -C To get username of present process.! -C OUTPUTS: -C USERNAME - Username owner of present process.E -C( - - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 charactersU - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist_ - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info_ - - RETURN, - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG)Q - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC'L - - DATA READ_UAI/.FALSE./Q - - COMMON /BULL_CUSTOM/ BULL_CUSTOMT - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE.( - RETURN - END IF - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))T - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE. - END IFF - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURN' - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')')S - RETURN - END IFL - - CALL DISABLE_PRIVSO - - SAVE_KEYPAD_MODE = KEYPAD_MODEA - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN. - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN) - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN()( - END IF1 - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPADL - - CALL ENABLE_PRIVS - - RETURN - END_ - - - SUBROUTINE ATTACH. - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS( - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item listE - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,)U - ELSE. - CALL INIT_ITMLST ! Initialize item listN - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)I - END IFA - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODEI - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPADE - - RETURNR - ENDx - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -CE -C The largest message that can be broadcasted is dependent on system' -C and user quotas. The following limit is 12 lines of ( 80 characters +B -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7)A - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2O - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message?E - BROAD(:36) = ! Say who the bulletin is fromS - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROMR - BLENGTH = 37 ! Start adding next line here - ELSEO - BROAD(:34) = ! Say who the bulletin is fromA - & CR//LF//LF//'NEW BULLETIN FROM: '//FROME - BLENGTH = 35 ! Start adding next line here - END IFD - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1O - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURNA - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN)U - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long?W - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO& - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER), - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL?I - IF (CLUSTER) THEN( - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN( - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,) - END IF - END IFE - - CALL SYS$SETRWM(%VAL(0))E - - RETURNL - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -CE -C SUBROUTINE GET_FOLDER_INFOA -CS -C FUNCTION: Obtains & verifies folder names from command line.. -C' - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLFOLDER.INC'U - - EXTERNAL CLI$_ABSENTI - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODEU - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes. - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP)E - DO WHILE (TRIM(NODE_TEMP).GT.0)R - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',')0 - IF (COMMA.GT.0) THENE - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM))2 - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN( - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IFO - FOLDER_NUMBER = -1R - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN( - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM)4 - RETURN - ELSE IF (READ_ONLY) THENI - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM)T - IER = 0 - RETURN_ - END IFO - END DO - END DO - - IER = 1 - - RETURNE - END diff --git a/decus/vms93a/bulletin/bulletin.hlp b/decus/vms93a/bulletin/bulletin.hlp deleted file mode 100644 index dd8a657..0000000 --- a/decus/vms93a/bulletin/bulletin.hlp +++ /dev/null @@ -1,144 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vms93a/bulletin/bulletin.lnk b/decus/vms93a/bulletin/bulletin.lnk deleted file mode 100644 index 00b763e..0000000 --- a/decus/vms93a/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.18" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.18" diff --git a/decus/vms93a/bulletin/bulletin0.for b/decus/vms93a/bulletin/bulletin0.for deleted file mode 100644 index ec205d4..0000000 --- a/decus/vms93a/bulletin/bulletin0.for +++ /dev/null @@ -1,2020 +0,0 @@ -C -C BULLETIN0.FOR, Version 5/5/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - CALL REMOTE_DELETE(SBULL,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN ! If not owner of message - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.EQ.FROM - END IF - IF (ASK) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.TEST_NEWS_OWNER()) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM) - IER = SYS$ASCTIM(,INPUT,EX_BTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - IF (.NOT.READ_TAG) THEN - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - END IF - EXTRACTING = CLI$PRESENT('EXTRACT') - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - ELSE - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - END IF - OUTPUT = EXTRACTING.OR.PRINTING - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - START = .FALSE. - SINCE = .FALSE. - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - SINCE = .TRUE. - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - GO TO 9999 - END IF - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - NEGATED = CLI$PRESENT('NEGATED') - IF (CLI$PRESENT('SEARCH')) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('FROM')) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - NEGATED = .TRUE. - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - FROM_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) NUM = NUM + 1 - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - END IF - I = I - 1 - END DO - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - END IF - IF (NUM.GT.0) I = I - 1 - END DO - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) NUM = NUM + 1 - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) J = J + 1 - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I1 = SBULLr - I = SBULL - DO WHILE (I.LE.EBULL) - CALL READDIR(I1,IER) ! Into the queue - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1e - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY)e - I = I + 1 - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1. - END IF - I1 = I1 + 1O - END DOG - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE)R - IF (I.EQ.0.AND.IER1.EQ.0) THEN6 - EBULL = EBULL - SBULL + DIR_COUNTO - SBULL = DIR_COUNT_ - I = SBULLO - END IFI - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28)L - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)I - I = I + 1 - END DOI - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSEM - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0E - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THENT - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,a - & TAG_TYPE) - END IFO - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE) - IER1 = 1L - ELSE - EBULL = EBULL_SAVEU - END IF - END IF - END IFU - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999C - END IFE - END IF - ELSE - NBULL = 0V - END IFE - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THENL - CALL CLOSE_BULLDIR ! We don't need file anymorel - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THENd - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THENE - DIR_TYPE = 'seen' - END IFT - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF - -CN -C Directory entries are now in queue. Output queue entries to screen.B -C - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULLS - ELSEB - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IFL - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DOn - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ')R - OUTLINE(I+1:) = OUTLINE(I+2:)R - END DO - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ') - OUTLINE(I:) = OUTLINE(I+1:)E - END DON - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINEs - BULL_PARAMETER = ' 'e - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1)) THENu - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THEN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IFT - IF (PRINTING) THENA - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - END IFT - WRITE (6,'(1X,A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN, - WRITE(6,1005)O - ELSE - WRITE(6,1000) - END IFI - - TAG = (BULL_TAG.AND.REMOTE_SET.EQ.0).OR. - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to headerD - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE)d - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_DT - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)S - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IFL - END DO - END IFS - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = IW - IF (.NOT.REPLY_FIRST) THEN) - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THENL - START_SEARCH = BULL_POINT - END IFF - IF (ANY_SEARCH.OR.OUTPUT) THENI - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED_FILES = .FALSE. - END IFC - DO WHILE (I.LE.EBULL) - IF (.NOT.ANY_SEARCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (CLOSED_FILES) THENI - CLOSED_FILES = .FALSE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - CALL GET_SEARCH(FOUND,SEARCH_STRING,START_SEARCH,.FALSE. - & ,SUBJECT,REPLY_FIRST,.FALSE.,.TRUE.,FROM_SEARCH, - & NEGATED) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE)( - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE.D - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THENr - SEARCH_STRING = ' ' - START_SEARCH = FOUNDL - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN. - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE.N - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28)R - TAG_TYPE = DUMMY - END IF - ELSEa - I = EBULL + 1 - END IFi - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.LE.EBULL) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN - OUTLINE = '>'O - ELSEs - OUTLINE = ' 'w - END IF - IF (BTEST(SYSTEM,29)) THENb - OUTLINE(2:) = '*' - ELSEe - OUTLINE(2:) = ' ' - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3)E - IF ((EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) - & .AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin?( - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin?h - EXPIRES = 'Permanent'D - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11)r - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9)t - ELSEf - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11)s - END IFN - WRITE(6,'(1X,A)') OUTLINE - IF (OUTPUT) THENn - FOUND_MSG = .TRUE.i - CALL SYS$SETAST(%VAL(0)) - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES)s - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES)1 - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0e - ELSE - MSG_NUM = -MSG_NUME - END IF= - END IF - CALL SYS$SETAST(%VAL(1)) - END IF= - END IF - I = I + 10 - IF (ANY_SEARCH) IER = SYS$CANTIM(,)L - END DO( - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.OUTPUT) THEN! - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THENN - DIR_COUNT = FOUND + 1 - ELSE. - DIR_COUNT = NBULL + 1 - END IFR - END IF - END IFr - - IF (DIR_COUNT.GT.NBULL.OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THEN - ! Outputted all entries? - DIR_COUNT = -1 ! Yes. Set counter to -1. - IF (PRINTING) THEN P - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THENY - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IFE - ELSE IF (EXTRACTING.AND.FOUND_MSG) THENU - CALL FILE(0,CLOSED_FILES) - END IF - ELSEL - WRITE(6,1010) ! Else say there are moreA - END IF_ - -9999 POSTTIME = .FALSE. - NEXT = .FALSE.a - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/)+ - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILESu - - IMPLICIT INTEGER (A-Z)r - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER)R - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER)A - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z)T - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I)D - END DOI - - RETURN, - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT) -CN -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C) - IMPLICIT INTEGER (A - Z)L - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC') - - EXTERNAL CLI$_ABSENTL - - CHARACTER*128 FILENAME - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THEN - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IFN - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THENI - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IF - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?d - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)I - IF (EBULL.GT.F_NBULL) EBULL = F_NBULLI - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL_ - IER = 0B - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSEP - SBULL = BULL_POINT - EBULL = SBULLL - IER = 0 - END IFP - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEND - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFILN - CALL CLOSE_BULLDIRR - CLOSE (UNIT=3) ! Bulletin copy completedE - OPENED = .FALSE.B - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P)* - RETURN - END IF2 - ELSEC - SBULL = FILE_NUM - EBULL = SBULLN - END IFA - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH,. - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THENA - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')S - ELSE IF (CLI$PRESENT('FF')) THENR - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesI - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN_ - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE.= - FIRST = .TRUE. - END IFF - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin' - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENTf - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THENO - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1I - IF (FBULL1.GT.SBULL) GO TO 100F - CLOSE (UNIT=3,STATUS='DELETE')= - OPENED = .FALSE.R - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURNS - ELSE IF (REMOTE_SET) THENC - CALL REMOTE_READ_MESSAGE(FBULL,IER1)= - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSEI - CALL GET_REMOTE_MESSAGE(IER1)P - END IF - IF (IER1.NE.0) GO TO 100T - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)r - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THENr - WRITE(3,1060) FROM,DATE//' '//TIME(:8)i - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into fileC - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DON - -100 IF (FILE_NUM.GT.0) THENm - FILE_NUM = -FILE_NUM - RETURN - END IFN - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created.t - WRITE(6,1040)d - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - ELSEO - WRITE(6,1045)) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,)g - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F)S - END IF. - - GO TO 10 - -900 WRITE(6,1000)C - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN. - -1000 FORMAT(' ERROR: Error in opening file.')) -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I)_ -1040 FORMAT(' Message ',A,' written to ',A)S -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A)S -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN)M - - CALL LIB$MOVC3(8,IN,OUT) - - RETURNE - END - - - - SUBROUTINE LOGIN0 -CH -C SUBROUTINE LOGIN, -C' -C FUNCTION: Alerts user of new messages upon logging in., -C' - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - G - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'L - - INCLUDE 'BULLFOLDER.INC'+ - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPTf - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHE - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)s - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/E - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/' - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)( - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2)N - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - FOLDER_NAME = FOLDERD - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)a - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -Ct -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -CE - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THENT - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSED - RETURN ! Don't notify_ - END IF - END IF - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRYN - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG( - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONGT - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DOD - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN= - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSE - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing.N - END IFR - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user fileB - CALL EXIT ! Go away...R - END IF. - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set) - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM)F - END DO. - WRITE (9,IOSTAT=IER) USERNAME,B - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IFE - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD'). - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER. - CALL EXIT ! If no header, no messagesH - END IF. - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C) -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility.1 -C. - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM) - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THENA - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM)L - END IF - END IF( - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READM - 1 - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER)= - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN_ - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1)E - END IF - CALL CLOSE_BULLUSER+ - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1)1 - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IFW - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1))1 - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1))T - ELSES - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM)R - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM)_ - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta timeL - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IFQ - END IF - END IF - END IFE - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))I - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THENB - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - END IFD - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login timeE - ! for system messages. - END IFN - - IF (LOGIN_SWITCH) THENU - IF (READIT.EQ.1) THEN. - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSERI - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))U - IF (DIFF1.LT.0) THEN' - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IFE - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LOGIN_BTIM_NEW) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THENE - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IFT - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSEt - NBULL = F_NBULL. - END IF. - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1L - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR.L - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1N - IF (IER1.EQ.0) THEN. - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1_ - END IF - END IF - - IF (REMOTE_SET) THENS - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY)I - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER)I - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTEN - GO TO 9999E - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN. - ICOUNT = NBULL + START - ICOUNT1A - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100= - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY)R - IER = ICOUNT + 1A - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user?) - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IFC - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THENG - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? E - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)( - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)R - ELSE IF (.NOT.SYSTEM_SWITCH) THENE - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM)s - END IF - IF (DIFF.LT.0) THENr - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEND - BULL_POINT = ICOUNT - 1E - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.O - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100w - END IFt - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IFI - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THENE - NSYS = NSYS + 1( - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100L - END IF= - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF/ - END IF - END DOI -100 CALL CLOSE_BULLDIR -CW -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -CL - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THENh - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesD - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2F - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1( - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT)) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0N - DO J=1,NSYSM - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)= - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))a - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTET - ELSE - CALL GET_REMOTE_MESSAGE(IER)' - END IF - IF (IER.GT.0) THENO - CALL CLOSE_BULLFIL - GO TO 9999 - END IFA - END IF_ - INPUT = ' 'H - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1A - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)B - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)N - END IF. - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DOT - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFILE - GO TO 9999N - END IFX - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)T - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATEN - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2I - END IFM - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1L - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messagesT - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IFI - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THENO - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next pageE - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....')) - WRITE (6,'(1X)')I - CALL LIB$ERASE_PAGE(1,1) ! Clear the screenA - PAGE = 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) '+'//INPUT(:ILEN) - ILEN = 03 - ELSE - WRITE(6,1060) '+'//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - ELSE2 - PAGE = PAGE + 1l - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) ' '//INPUT(:ILEN) - ILEN = 0n - ELSE - WRITE(6,1060) ' '//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:) - ILEN = ILEN - PAGE_WIDTH - END IF - END IFX - END IFE - END DO - IF (NGEN.EQ.0) THEN - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1E - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1F - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2U - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next pageL - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1T - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies. - FIRST_WRITE = .FALSE. ! if this is first write to screen.A - END IFR - WRITE (6,'(''+'',A,$)') CTRL_GF - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2B - I = 0A - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY)n - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....')0 - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1, - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')')+ - ELSEF - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IFE - ! Bulletin number is stored in SYSTEM - ELSEF - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEML - END IFI - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0)T - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THENI - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated.D - END IF -C -C Instruct users how to read displayed messages if READNEW not selected.N -CI - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030)E - ELSE IF (NGEN.EQ.0) THENI - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1T - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILENR - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - PAGE = PAGE + 1N - ELSEC - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1T - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILENQ - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)//D - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN)a - & //' '//FOLDER_NAME(:FLEN)//2 - & ' to read these messages.' - END IF - PAGE = PAGE + 1L - END IF - -9999 IF (LOGIN_SWITCH) THENN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW)L - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF - RETURN. - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'))T -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - o - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list_ - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlistE - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)),E - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THENG - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0R - END IFE - - RETURN - END - diff --git a/decus/vms93a/bulletin/bulletin1.for b/decus/vms93a/bulletin/bulletin1.for deleted file mode 100644 index b4b56d3..0000000 --- a/decus/vms93a/bulletin/bulletin1.for +++ /dev/null @@ -1,2202 +0,0 @@ -C -C BULLETIN1.FOR, Version 3/31/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_P = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_P = LEN_P + I + 1 - BULL_PARAMETER(LEN_P:LEN_P) = ',' - END DO - LEN_P = LEN_P - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:I)//'""'// - & BULL_PARAMETER(I+1:) - I = I + 2 - LEN_P = LEN_P + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',BULL_PARAMETER(:LEN_P) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*32,DEFAULT_USER*12 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - IF (IER1.EQ.0) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THEN - I = IER - ELSE - NUM_COPY = NUM_COPY + 1 - END IF - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (.NOT.ORIGINAL.AND.REMOTE_SET.EQ.4).OR.REMOTE_SET.EQ.3 - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0.AND.NEWS_FEED()) THEN - IF (.NOT.ORIGINAL) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - IER1 = .FALSE. - ELSE - REMOTE_SET = 3 - END IF - END IF - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - ELSE - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF (TO_NEWS.AND.ORIGINAL) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2000' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (REMOTE_SET.GE.3.AND..NOT.ORIGINAL) THEN - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT) - ELSE - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (POST_NEWS) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder infoi -Cs -C If user is adding message, an no new messages, update last read time foro -C folder, so user is not alerted of new message which is owned by user. -Cs - IF (DIFF.GE.0) THENo - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)')F - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THENC - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//P - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSEC - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')')2 - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADERS - IF (ORIGINAL.AND.(NEWS_FEED().OR.REMOTE_SET.EQ.4)) RETURN - - FOLDER_NUMBER = SAVE_FOLDER_NUMBERt - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1)! - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THENr - WRITE (6,'('' WARNING: Original messages not deleted.'')')L - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IFe - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -CP -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C* - - IMPLICIT INTEGER (A-Z)3 - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC', - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_ABSENTT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE.// - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND.T - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')')T - GO TO 200& - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0/ - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN)D - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0)E - IF (CHANGED) THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IFt - -50 IF (PRINT_NUM.EQ.0) THEN' - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)E - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN, - CALL CLOSE_BULLFILA - CALL CLOSE_BULLDIRT - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THENR - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error.0 - RETURN - ELSE - SBULL = BULL_POINT: - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015)E - IF (OPENED) THEN - CALL CLOSE_BULLFILp - CALL CLOSE_BULLDIR - END IF_ - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN) - END IF - ELSED - SBULL = PRINT_NUM - EBULL = SBULLm - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name' - IF (QLEN.EQ.0) THENE - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')L - - CALL ENABLE_PRIVSG - END IF' - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER')R - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified messageA - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENTR - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THENP - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 1002 - CLOSE (UNIT=24,STATUS='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFILI - CALL CLOSE_BULLDIR' - END IFX - RETURN - ELSE IF (REMOTE_SET) THENL - CALL REMOTE_READ_MESSAGE(I,IER1)( - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTET - ELSEC - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100e - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)M - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN/ - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8)S - END IF_ - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THENC - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENI - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN)L - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into fileD - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DOR - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):). - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)N - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)L - END IF - -1040 FORMAT(' Message ',A,' sent to printer.') -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE.F - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS'))e - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE))H - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0)' - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) - END IF - - CALL DISABLE_PRIVSO - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)1 - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSES - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A,o - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE.e - GO TO 50 - END IF: - - RETURNA - -900 CALL ERRSNS(IDUMMY,IER)O - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER)r - RETURN. - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:')P -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -CE -C SUBROUTINE READ_MSG -Ci -C FUNCTION: Reads a specified bulletin. -CL -C PARAMETER:L -C READ_COUNT - Variable to store the record in the message fileR -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -CO - IMPLICIT INTEGER (A - Z)N - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'$ - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READITR - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING) - LOGICAL PAGINGR - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER, - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./H - - COMMON /POST/ POSTTIMEL - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_IDE - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./S - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPF - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/D - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH)+ - CHARACTER HEADLINE*132 - - LOGICAL SINCE,PAGE= - - EXTERNAL CLI$_NEGATED - - KILL = BTEST(BULL_USER_CUSTOM,3)= - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3)R - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this isQ - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THENE - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE.H - END IF - ROTC = CLI$PRESENT('ROTATE') - END IFF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3)T - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)C - ELSE IF (CLI$PRESENT('ALL')) THENO - READ_TAG = IBSET(0,1) + IBSET(0,2)U - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSEU - BULL_READ = 1 - END IFI - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THENV - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)I - GO TO 9999T - END IFN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSEe - CALL SYS_BINTIM(DATETIME,MSG_BTIM)u - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHAREDL - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIRe - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified?L - NEW = .TRUE.P - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),S - & F_NEWEST_BTIM)N - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IFe - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIRL - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THENT - WRITE (6,'('' No new messages are present.'')')B - GO TO 9999 - END IFE - END IF) - BULL_READ = IER - IER = IER + 1 - END IF - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THENe - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999S - ELSEP - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE.M - END IF - END IFU - - NEXT = .FALSE.X - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THENE - NEXT = .TRUE.O - ELSE IF (INCMD(:4).EQ.'READ') THENg - IF (.NOT.SINCE.AND..NOT.NEWE - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IFL - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THENL - IER = 0T - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR.o - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THENN - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THENH - MSG_NUM = F_NBULL+1 - ELSEB - MSG_NUM = BULL_NOWN - END IF. - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1E - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHAREDT - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHAREDR - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE, - CALL GET_THIS_OR_NEXT_TAG - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0I - END IFN - END IFE - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)E - IF (IER1.EQ.0) IER = BULL_READ + 1I - END IF - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1I - END DOE - CALL CLOSE_BULLDIR. - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1E - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READ) - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSED - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THEN& - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSED - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0: - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IFL - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IFN - END IF - END IFN - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND.F - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHAREDE - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry' - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE.C - CALL READDIR(BULL_READ,IER) - END IF - END IFL - IF (REMOTE_SET.LT.3.AND.= - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THENU - READ_COUNT = 0D - IF (IER.NE.BULL_READ+1) THENE - CALL READDIR(0,IER)L - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IFC - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THENL - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0' - END IFs - CALL CLOSE_BULLDIR) - ELSE - IER = 0 - END IF - END IFi - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THENE - WRITE(6,1030) ! If not, then error out) - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFILE - GO TO 9999 - END IFL - - BULL_POINT = BULL_READ ! Update bulletin counterM - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED' - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEND - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN= - INFROM = INPUT(7:ILEN)L - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN1 - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - - IF (.NOT.OK) THENS - BULL_NOW = MSG_NUME - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THENS - BULL_READ = MSG_NUM - 1S - ELSE - BULL_READ = MSG_NUM + 1o - END IF - IF (REMOTE_SET) CALL CLOSE_BULLFILI - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THENE - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)_ - END IF - ELSEe - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - GO TO 50= - END IF - - BLOCK = BLOCK_SAVE - END IFY - - NEXT = .FALSE.T - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1))( - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)& - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2)E - ELSER - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - END IF( - - EDIT = .FALSE. - - PAGE_WIDTH = REAL_PAGE_WIDTH - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THENE - IF (CLI$PRESENT('EDIT')) THEN, - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')) - IF (IER.NE.0) THENF - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)3 - GO TO 9999E - END IFR - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTH - PAGE = .FALSE. - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ')= - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSEI - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULLN - END IFR - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:)( - END DOM - I = TRIM(HEADLINE)N - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN)S - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)), - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE)) - END IFE - - END = 1 ! Outputted 1 line to screenT - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THENI - IF (REMOTE_SET.NE.3) THEN) - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)G - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?B - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5)D - END IFI - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT))A - ELSET - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IFE - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1r - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:)s - DO WHILE (TRIM(INPUT).GT.0)L - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN( - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROMO - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1O - END IFP - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)l - END IF' - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:)G - DO WHILE (TRIM(INPUT).GT.0)t - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THENW - WRITE(3,'(A)') INPUT(:I)( - ELSEp - WRITE(6,'(1X,A)') INPUT(:I) - END IFs - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - IF (EDIT) WRITE(3,'(1X)') - ELSE - END = END + 1D - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP)O - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP))T - IF (LINE_OFFSET.EQ.1) THEN) - CHAR_OFFSET = 1 - PAGE_WIDTHN - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IFT - END IF - END IFI - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1C - CALL CLOSE_BULLFIL ! End of bulletin file readT - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)')D - END = END + 1 -CE -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory' -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?T - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headT - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointerH - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSEE - READ_COUNT = BLOCK ! Init bulletin record counterd - END IFe - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF) - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THENI - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN' - CHAR_OFFSET = 1f - BUFFER = INPUT(:PAGE_WIDTH)M - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSEO - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)) - END IFF - ELSEE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTHb - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN' - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0) - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF_ - END IFE - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE.( - END IF. - END IF - END DOI - - CALL CLOSE_BULLFIL ! End of bulletin file read' - - IF (EDIT) THEN, - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')o - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter - GO TO 9999 - END IFR - -C -C Bulletin page is now in temporary memory, so output to terminal.N -C Note that if this is a /READ, the first line will have problems withE -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at theR -C end of the previous page. The output gets confused and thinks it mustE -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -CV - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO, - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counterI - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC)R - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read?e - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletinU - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IFC - -9999 POSTTIME = .FALSE.C - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3)E - RETURN' - -1030 FORMAT(' No more messages.')U -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z)L - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN. - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A')U - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DOG - - RETURNm - END - - - - - - - SUBROUTINE READNEW(REDO)' -C$ -C SUBROUTINE READNEWR -CQ -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'B - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1E - EQUIVALENCE (INREAD4,INREAD) - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL) - - FIRST_MESSAGE = BULL_POINTC - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first timeT - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there isS - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get inputI - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN, - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)')E - ELSE IF (INREAD.EQ.'E') THENC - WRITE (6,'(''+xit'',$)')E - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO6 - DO I=1,FLONG ! Test for new messages in SYSTEM folders( - IF (NEW_MSG(I).NE.0) RETURN) - END DO0 - CALL EXIT - ELSEE - WRITE (6,'(''+o'',$)')P - END IF - RETURN ! If NO, exitG - ! Include QUIT to be consistent with next questionL - ELSE - CALL LIB$ERASE_PAGE(1,1)0 - END IF - END IFP - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')')4 - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF6 - - READ_COUNT = 0 ! Initialize display pointerR - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - BULL_POINT_READ = BULL_POINTL - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed?0 - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and systemE - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it.R - BULL_POINT = BULL_POINT + 1 - GO TO 100 - END IF - CALL CLOSE_BULLDIR - END IFC - - GO TO 12) - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IFH - - BULL_POINT = BULL_POINT_SAVEC - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVEI - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSES - WRITE(6,1030)C - END IFI - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper caseO - - BLOCK_SAVE = BLOCKE - LENGTH_SAVE = LENGTHI - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)')S - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory( - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THENA - ! If F then copy bulletin to file( - WRITE (6,'(''+ '')') ! Move cursor from end of prompt lines - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF)E - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]'I - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IFe - END IF - - LEN_FOLDER = TRIM(FOLDER)P - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THENh - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//u - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEFr - END IFI - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P)L - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)R - CALL FILE(READ_COUNT)P - GO TO 11 - ELSE IF (INREAD.EQ.'P') THENG - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR.R - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)')S - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THENA - WRITE (6,'(''+U'',$)')R - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THENS - WRITE (6,'(''+B'',$)')F - INCMD = 'RESPOND/LIST'M - ELSE - GO TO 11_ - END IFE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')')A - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLYT - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THENt - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletinI - CALL CLOSE_BULLDIR ! Exit' - WRITE(6,1010) - RETURN' - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletinsA - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')')G - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READH - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12E - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010)S - RETURN - END IFL - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message',_ - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.')A -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),',F - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$)) -1040 FORMAT(' Type P to post reply, U to reply to user,', - & ' B to do both, or other to quit: ',$) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C= -C SUBROUTINE SET_DEFAULT_EXPIRE -C) -C FUNCTION: Sets default expiration date. -CC - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFOLDER.INC'' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3B - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THENY - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3E - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)E - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THENP - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')')r - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDERL - ELSEI - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF_ - - RETURN) - END - - - - - LOGICAL FUNCTION NEWS_FEED() - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLFOLDER.INC'E - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - I = SLIST + 1N - FLEN = TRIM(FOLDER_DESCRIP)T - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN9 - I = FLEN + 1P - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR.D - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND.E - & FOLDER_DESCRIP(I:I).NE.'@'.AND.R - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE. - I = FLEN + 2N - END IFE - END DO - IF (I.EQ.FLEN+1) NEWS_FEED = .TRUE.T - END IFN - - RETURN. - END diff --git a/decus/vms93a/bulletin/bulletin10.for b/decus/vms93a/bulletin/bulletin10.for deleted file mode 100644 index de03334..0000000 --- a/decus/vms93a/bulletin/bulletin10.for +++ /dev/null @@ -1,2992 +0,0 @@ -C -C BULLETIN10.FOR, Version 5/5/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - IF (END_LINE.GT.257.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - END IF - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - 2 - IF (BUFFER(EB+2:EB+2).NE.LF) EB = EB + 2 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - CALL NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER()) THEN - CALL NEWS_POST('cancel',0,IER,'Delete news item.') - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - BACKSEARCH = END - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START.OR.REALEND.EQ.0) THEN - IF (REALEND.GT.0) THEN - IF (REALEND.GE.F_NBULL) RETURN - END = REALEND - REALEND = 0 - END IF - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DESCRIP = TEMP(257:512) - CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*4 - DATA HOUR /' '/ - - PARAMETER NZONES = 4 - - COMMON /ZONE/ ZONE,LZONE - - CHARACTER ZONES*(NZONES*4) - CHARACTER*4 ZONE - DATA ZONES /'EST CST MST PST '/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4) - ELSE - HOUR = '00' - END IF - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:TRIM(HOUR)),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_L_TI(DATE,TIME(:2),,,) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR))//':00',GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - NEWSGROUPS = ' ' - LREF = 0 - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - - DO WHILE (BUFFER(SB:EB).NE.'.') - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(BUFFER(SB1:EB),EB-SB1+1) - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - END IF - END IF - END DO - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'3FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - START = -1 - IER = SYS$ASCTIM(,TIME,IN_BTIM,) - CALL DATE_TIME(TIME) - SKIP = 0 - DO WHILE (SKIP.GE.0) - IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( - & FOLDER_NAME))//' '//TIME)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'23') THEN - IF (.NOT.NEWS_READ()) CALL EXIT - DO I=1,SKIP - IF (.NOT.NEWS_READ()) CALL EXIT - END DO - FIRST = BUFFER(SB:EB) - IF (FIRST.EQ.'.') RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL EXIT - END DO - IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) - & CALL EXIT - IF (.NOT.NEWS_READ()) CALL EXIT - IF (BUFFER(:2).EQ.'22') THEN - IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN - I = F_NBULL + 1 - DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. - & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) - & .OR.I.GT.F_NBULL)) - I = I - 1 - IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (I.GE.F_START) START = I - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END IF - RETURN - END IF - END IF - SKIP = SKIP + 1 - END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - ELSE - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - CHARACTER*256 TEMP,TEMP1 - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IF - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0 - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE - IER = NEWS_READ() - IF (IER.AND.BUFFER(SB:EB).NE.'.') THEN - IER = 0 - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THEN - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF (INDEX(TEMP,': ').EQ.0.AND. - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255) THEN - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IF - END IF - IF (LOCAL_UPDATE1.NE.0) THENs - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF 1 - ELSE - HEADER_SEEN = .TRUE.e - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1a - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)a - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0, - INPUT = INPUT(:ILEN)//CHAR(0)R - ILEN = -128) - ELSE - ILEN = 128 - END IF - END IF - ELSE1 - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0E - ELSED - CALL SYS_GETMSG(IER1) - LENGTH = 0S - IER1 = IER - CALL DISCONNECT_REMOTEL - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IFL - ELSE IF (ABS(ILEN).EQ.128) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO( - - RETURN. - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER)N - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -CI -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node.A -CN - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH_ - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /READIT/ READITT - - COMMON /NEWS_INIT/ END_READ - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - - DIMENSION DUMMY(4)S - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - END_READ = 0 - IF (.NOT.NEWS_LOGIN()) THENR - IER = 2 - RETURN1 - END IF - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name differentF - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1E - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,E - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THENN - IF (.NOT.SAME) THEN' - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1C - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE.E - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIRD - REMOTE_SET = REMOTE_SET_SAVEO - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THENM - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THENT - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+'N - SYSLOG = .TRUE. - END IFC - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNERP - FOLDER_BBOARD_SAVE = FOLDER1_BBOARDR - FOLDER_NUMBER_SAVE = FOLDER1_NUMBERS - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY,( - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSEN - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY,_ - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IFF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVEE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE) - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND.U - & TEST_BULLCP().NE.2) THEN ! Not BULLCP processR - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)A - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)I - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE)E - IF (IER.EQ.0) REWRITE (4) USER_ENTRY& - CALL CLOSE_BULLUSER - END IFP - END IF - IER = 2A - ELSE) - CLOSE (UNIT=31-REMOTE_UNIT)I -CG -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time.O -C. - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1)T - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY)U - IF (SYSLOG) THENC - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3))M - END IFD - END IF - IER = 0T - END IFO - - RETURND - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EBe - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_IDi - - COMMON /NEXT/ NEXTI - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUP( - - CHARACTER*8 NUMBERW - - DIMENSION IN_BTIM(2)O - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THENT - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEYH - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADERF - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT1 - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IFO - RETURND - ELSE) - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THENE - IF (ICOUNT.EQ.0) THEN( - NBULL = F_NBULL - ICOUNT = 1S - RETURNH - ELSE IF (ICOUNT.EQ.-1) THENU - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN_ - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXITE - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXITR - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF, - IF (BUFFER(:2).NE.'22') THEN( - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1N - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURNI - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXITN - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF - END DOS - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITR - IF (BUFFER(:3).NE.'223') RETURN$ - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT) - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THENE - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITN - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURNF - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1))R - IF (.NOT.IER) RETURN' - START = ICOUNTQ - BULLETIN_NUM = START( - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0 - CALL NEWS_HEADER(IER)Q - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN1 - END IF - BLOCK = START1 - MSG_NUM = START - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM)T - - IMPLICIT INTEGER (A-Z)O - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8U - INPUT(9-I:9-I) = MSG_KEY(I:I)N - END DO( - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN' - END - - - - SUBROUTINE NEWS_GROUP(IER)( - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EBS - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP. - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1))N - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN, - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) - IF (.NOT.IER) RETURNN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1))I - IF (.NOT.IER) RETURNT - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT') - IF (.NOT.IER) RETURN( - - IER = NEWS_READ() - IF (.NOT.IER) RETURN. - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURN_ - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME) - - CHARACTER*20 TIME - - I = 1 - LTIME = TRIM(INTIME) - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR.B - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1E - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM)_ - RETURN - END IFL - - CALL STR$UPCASE(TIME,INTIME(I:))1 - - DO J = 1,2M - I = 13 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-'S - END DOR - - IF (I.EQ.LEN(TIME)) RETURN2 - - IF (TIME(I+3:I+3).EQ.' ') THEN - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IFE - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1M - END DOU - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) RETURN - - CALL SYS_BINTIM(TIME(:I-2),BTIM) - - IF (INDEX(INTIME,'GMT').GT.0) CALL CONVERT_FROM_GMT(BTIM) - - RETURNC - END - - - - SUBROUTINE NEWS_LISTD - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'B - - COMMON /BUFFER/ BUFFER,SB,EBI - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - CHARACTER TODAY*24_ - - DIMENSION EXPIRED(2)E - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURNF - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR.R - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER))T - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL OPEN_BULLNEWS_SHARED ! Open folder fileM - - NEWS_FOLDER1_BBOARD = '::'A - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14 - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)N - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMA - END IFN - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMITI - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNT - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) - IF (IER1.EQ.0) THENT - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2F - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0T - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1R - IF (IER.NE.0.OR.IER1.NE.0) THEN - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLEN - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN , - NEWS_FOLDER = NEWS_FOLDER1(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COMB - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DOE - IF (FLEN.GT.44) THENE - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)//t - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB)F - END IF' - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER))T - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DOL - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO) - NEWS_FOLDER1_NUMBER = NEWS_F_COUNTT - IF (IER2.EQ.0) THEN T - NEWS_F1_FLAG = NEWS_F_FLAG - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THENE - NEWS_F1_EXPIRE = NEWS_F_EXPIRE - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMITT - END IF - ELSEE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE)E - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)S - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)D - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1)) - IF (BTEST(NEWS_F1_FLAG,8)) THEN ' - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0C - NEWS_F1_LAST = 0 - END IFM - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND.E - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN1 - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF, - ELSE IF (BTEST(NEWS_F1_FLAG,8).AND.. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THENI - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THENR - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IFF - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IFF - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE._ - IF (FLEN.GT.44) THEN - IF (NEWS_FOLDER1_DESCRIP.NE.B - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)R - UPDATE = .TRUE.E - END IFN - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THENE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IFL - IF (SPECIAL) THEN - IF (UPDATE) THENS - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF= - ELSE IF (.NOT.UPDATE) THEN1 - UPDATE = F1_START.NE.NEWS_F1_START.OR.S - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - END DO1 - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)R - NEWS_F1_COUNT = NEWS_F_COUNTE - REWRITE (7) NEWS_FOLDER1_COM - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0)S - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7)D - CALL READ_FOLDER_FILE_TEMP(IER) - END DO( - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THENO - NEWS_F1_NBULL = F1_NBULLL - NEWS_F1_START = F1_STARTE - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THENE - IF (NEWS_F1_FIRST.GT.F1_START.AND.C - & NEWS_F1_FIRST.GT.F1_NBULL) THENU - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF_ - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),_ - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER))C - END IF - END IFA - ELSE IF (((F1_START.NE.NEWS_F1_START.OR.T - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.NE.0.AND.(.NOT.BTEST(NEWS_F1_FLAG,8).OR. - & NEWS_F1_NBULL.LT.NEWS_F1_START)) THEN - DELETE (UNIT=7)E - IER = 0E - END IF - END IFN - END DO - END IFT - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - - RETURNU - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN, - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a'))T - END IF - END DO - - RETURN_ - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC'. - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREFD - CHARACTER*256 REFERENCES) - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAMEN - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS' - CHARACTER*256 NEWSGROUPSR - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4F - - COMMON /LOCALPOST/ LOCAL_POSTR - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINEI - CHARACTER*12 MSGNUM - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER TODAY*24,UNAME*132' - DATA UNAME /'()'/ - - DIMENSION NOW(2)A - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.FILEOPEN) THENS - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1)) - IF (IER1.NE.0) RETURN - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900I - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3)T - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW)A - IER = SYS$ASCTIM(,TODAY,NOW,) - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THENT - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900B - IF (BUFFER(:3).NE.'340') THENF - WRITE (6,'('' ERROR: Posting not allowed.'')')E - GO TO 900 - END IF - ELSE - I = INDEX(NEWS_MSGID,'.') - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//E - & NEWS_MSGID(:I-1)//_ - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256)C - IF (IER.NE.0) RETURNC - LOCAL_POST = .TRUE. - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1S - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP_ - ELSE IF (.NOT.BTEST(FOLDER_FLAG,8).AND.h - & TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - INPUT = 'Newsgroups: '//NEWSGROUPS - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER)R - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0 - DO WHILE (CLI$GET_VALUE('GROUPS',FOLDER1_NAME,FLEN) - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT))P - CALL LOWERCASE(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1)E - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9)) THEN ) - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST, - & FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - END IFT - END DO - CALL CLOSE_BULLNEWS - END IFH - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900U - END IF - ATSIGN = INDEX(PATHNAME,'@')S - PCSIGN = INDEX(PATHNAME,'%') - CALL LOWERCASE(USERNAME)) - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 9001 - ELSEE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900F - END IFT - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME)E - - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - CALL STR$UPCASE(FROM_LINE,FROM_LINE)0 - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME) - SUBJECT_LINE = SUBJECTP - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT))))D - & GO TO 900 - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))): - & GO TO 900 - END IFC - - IF (NGROUPS.GT.0) THEN - FROM = USERNAME - DESCRIP = SUBJECT. - END IF - - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//'>')) GO TO 900 - - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION)1 - END IF - LORGAN = TRIM(ORGANIZATION). - END IFI - - IF (LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN)))t - & GO TO 900= - END IFE - - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//S - & ZONE(:LZONE))) GO TO 900 - - IF (REMOTE_SET.EQ.4.AND..NOT. - & (CREATE.OR.FILENAME.EQ.'cancel')) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE( - & FIRST_ALPHA(EXDATE):2)( - & //' '//EXDATE(4:6)//' '//EXDATE(10:TRIM(EXDATE))I - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900E - ELSE - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT)o - END IF - EXTIME = '00:00:00.00'A - END IF - END IFT - - IF (CREATE) THENR - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURNM - END IF - - IF (FILENAME.EQ.'cancel') THENO - IF (.NOT.NEWS_WRITE('Control: cancel <'R - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURNR - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_READ()) RETURNL - IF (BUFFER(:3).EQ.'240') IER = 0C - ELSE - CLOSE (UNIT=8,STATUS='SAVE')E - IER = 0 - END IF - LOCAL_POST = .FALSE. - RETURN - END IF. - - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - - IER1 = 0 - DO WHILE (IER1.EQ.0)) - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2T - END IF - IF (IER1.EQ.0) THENE - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DOB - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THENE - IF (.NOT.NEWS_WRITE('.')) GO TO 900m - IF (.NOT.NEWS_READ()) GO TO 900! - IF (BUFFER(:3).EQ.'240') THEN= - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:EB)A - END IF - ELSET - LENGTH = (LENGTH+127)/128 - GROUP_LIST = GROUP_LIST1E - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - DO I=NGROUPS,1,-1T - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1)_ - FOLDER_NUMBER = -1R - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN E - CALL ADD_LOCAL_NEWS(8) - END IF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVED - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0E - END IFA - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - - LOCAL_POST = .FALSE.) - - RETURNW - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAMEI - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME)= - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')')E - RETURN' - END IF - END IF_ - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME)F - LPATH = TRIM(PATHNAME)L - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME)D - - IMPLICIT INTEGER (A-Z)_ - - CHARACTER*(*) NAME - - TEST_NEWS = .FALSE. - - DO I=1,LEN(NAME). - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - END DOI - - TEST_NEWS = .TRUE. - - RETURNQ - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1D - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM)( - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM)E - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM)e - IF (NUM.EQ.0) RETURN - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER)i - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULLN - FIRST = F1_START - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - CALL OTS$CVT_L_TI(F_LAST+1,NUMBER,,,) - REMOTE_SET = 3S - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)I - CALL MOVE(.FALSE.)I - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNTD - NEW_NEWS_F_END = NEWS_F_ENDS - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF- - F_LAST = LAST - NEWS_F_FIRST = FIRSTN - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS - RETURN. - END IF - END DOL - - RETURNT - END - - - - - SUBROUTINE NEWS2BULL - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BUFFER/ BUFFER,SB,EBN - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER TIME*20,FIRST*80,FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBER( - - DIMENSION SAVE_F_NEWEST_BTIM(2),NOW(2)S - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV) - - CALL NEWS_LIST= - - CALL UPDATE_LOCAL_NEWS( - - CALL SEND_POST - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1. - - CALL OPEN_BULLFOLDER_SHARED ! Get folder fileL - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - ELIST = INDEX(FOLDER_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN - IF (FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR.E - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))) THEN - NUM_FOLDERS = NUM_FOLDERS + 1A - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IFI - END IF, - END IF - END DOO - - CALL CLOSE_BULLFOLDER ! We don't need file anymoreD - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT - - FOLDER_Q = FOLDER_Q1F - POINT_FOLDER = 0E - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)O - POINT_FOLDER = POINT_FOLDER + 1N - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)T - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARDN - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1). - IF (IER) THEN - SAVE_LAST = F_LASTC - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER)N - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIPU - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)O - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN) - SAVE_LAST = F_NBULLT - CALL OPEN_BULLFOLDER_ - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LAST3 - FOLDER_BBOARD = 'NONEFEED') - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDERE - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - REMOTE_SET = 3, - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1)O - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLFOLDERT - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1)O - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1) - END IFN - CALL CLOSE_BULLFOLDER - END IF - END IF - END DOT - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME)M - - IMPLICIT INTEGER (A-Z)N - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - CHARACTER*(*) TIMEO - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+U - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)//C - & TIME(16:17)//TIME(19:20)N - - RETURN. - END - - - - SUBROUTINE ALLPRIV) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1U - PROCPRIV(2) = -1O - NEEDPRIV(1) = -1: - NEEDPRIV(2) = -1) - - RETURN% - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z)1 - - INCLUDE 'BULLFOLDER.INC'R - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COMR - - NEWS_FOLDER1 = FOLDER1D - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1( - END DO - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNTE - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)C - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COMR - NEWS_F1_COUNT = NEWS_F_COUNTT - REWRITE (7) NEWS_FOLDER1_COM - - RETURN0 - END - - - - SUBROUTINE SUBSCRIBE - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')')( - RETURN - END IF - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 11 - END DO - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')')E - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE - WRITE (6,'('' You are now subscribed to '',A,''.'')')I - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER)I - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1))E - END IFI - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THENB - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THENR - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1))M - LAST_NEWS_READ(2,J) = F_START - 1 - ELSE. - LAST_NEWS_READ2(2,J) = 0N - LAST_NEWS_READ(2,J) = F_NBULL - END IF. - CALL CLOSE_BULLNEWS - RETURNB - END IF - END DOT - - END - - - - - - SUBROUTINE UNSUBSCRIBE0 - - IMPLICIT INTEGER (A-Z)s - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC', - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE1 - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')')L - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IFE - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1))S - END DO5 - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0E - - CALL FREE_TAGS(I) - - RETURN= - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'N - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0A - RETURN - END IF. - - RETURNN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER)E - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'A - - I = NEWS_FIND_SUBSCRIBE1() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0S - RETURN - END IFP - - RETURNB - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLUSER.INC'F - - INCLUDE 'BULLFOLDER.INC'E - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR. - & (LAST_NEWS_READ(2,I).GT.F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)F - END IFE - - RETURN: - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG)= - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'S - - IF (SUBNUM.EQ.0) THEN - COUNT = 0 - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1C - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THEN. - COUNT = COUNT + 1C - END IF - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT)E - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSEE - SUBNUM = 0 - END IFR - - RETURNN - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES)F -CL -C SUBROUTINE NEWS_NEW_NOTIFICATIONE -CF - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLUSER.INC'1 - - COMMON /READIT/ READITR - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)L - - MESSAGES = .FALSE.E - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1 - - FOLDER_DESCRIP = ' 'N - REORDER = 0 - DO WHILE (SUBNUM.GT.0) - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)A - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)L - FOLDER1_DESCRIP = FOLDER_DESCRIPN - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER)_ - UNLOCK 7 - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 10 - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THENE - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - ELSE IF (IER.NE.0) THEN - SUBNUM = -1O - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR.R - & F_START.GT.F_NBULL) THEND - IER = 1 - END IF - END IF - IF (IER.EQ.0.AND.SUBNUM.GT.0) THENN - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND.( - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN_ - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)T - IF (DIFF.GT.0) IER = 1 - END IF - END IFE - END IF_ - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN - WRITE (6,'('' There are new messages in folder '',L - & A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)F - ELSE - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1)1 - IF (IER1) THENS - CALL LOGIN_FOLDERD - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THENI - SAVE_BULL_POINT = BULL_POINTR - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IFT - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IFL - END IF - END DOY - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE_ - - CALL CLOSE_BULLNEWS - - RETURNO - END - - - SUBROUTINE REORDER_SUBSCRIBEO - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFOLDER.INC'R - - INCLUDE 'BULLUSER.INC'. - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0) - I = I + 1I - END DON - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1D - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER), - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1)1 - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2 - TEMP = LAST_NEWS_READ(L,J), - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K)L - LAST_NEWS_READ(L,K) = TEMP - END DO_ - END IFB - END DO - END DO - - RETURNT - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)G - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'F - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENR - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) - - RETURNA - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'S - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENN - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15)A - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC'N - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENL - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IFE - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURNH - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC', - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1N - END DOC - - NEWS_FIND_SUBSCRIBE = I - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1M - END DOD - - NEWS_FIND_SUBSCRIBE1 = IM - - RETURN - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLUSER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IFM - - IF (NOTIFY.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13)A - IF (NOTIFY.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13), - IF (READNEW.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - - CALL UPDATE_USERINFO - - RETURN - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT)O - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNTS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE/ - CHARACTER*12 MSGNUM - - REWIND UNIT - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM)( - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '//) - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK)O - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6,E - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) - END IFF - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1T - SYSTEM = 0 - CALL ADD_ENTRY' - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - ENDT - - - - SUBROUTINE UPDATE_NEWS_FOLDER -CO -C SUBROUTINE UPDATE_NEWS_FOLDER -CI -C FUNCTION: Updates folder info due to new message. -CO - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'/ - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWS_F_NEWEST_BTIM)' - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_ENDs - F_COUNT = NEW_F_COUNTF - END IF( - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1N - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM))T - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_NEWEST_EX_BTIM_KEY(5:)I - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SEND_POSTO - - IMPLICIT INTEGER (A-Z) M - - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280E - L - CHARACTER FILE*132 - 1 - C = 0 - N - IF (.NOT.NEWS_LOGIN()) RETURN - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST',FILE,C)) - IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURNL - IF (BUFFER(:3).NE.'340') RETURN - - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IF - END DO' - IF (INPUT.NE.'.') THEN ' - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') / - END DOP - -100 CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) ( - - INCLUDE '($MAILDEF)'+ - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVSU - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100E - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST) - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0)E - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVSS - - IF (UNAME.EQ.'()') THEN - UNAME = ' '1 - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IF - - RETURN1 - END diff --git a/decus/vms93a/bulletin/bulletin11.for b/decus/vms93a/bulletin/bulletin11.for deleted file mode 100644 index 25f8044..0000000 --- a/decus/vms93a/bulletin/bulletin11.for +++ /dev/null @@ -1,2524 +0,0 @@ -C -C BULLETIN11.FOR, Version 4/29/93 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(2),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(2),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*10 BULL_MARK_DIR - - CHARACTER*12 TAG_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - UNLOCK 13 - END IF - - NTRIES = 0 - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURN - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1), - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IF - - RETURN - END - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*10 BULL_MARK_DIR - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - ELSE - MARKUNIT = 23 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1 - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEY - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IF - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY) - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURN - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - TAG_TYPE = 0 - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR. - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN - IF (IER.EQ.0) UNLOCK 13 - IER = 0 - MESSAGE = MSG_NUM - ELSE - IER = 36 - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)n - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF1 - - IER = 36e - - HEADER = .FALSE.I - - TAG_TYPE = 0o - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)o - RETURN - END IFt - - DO WHILE (IER.NE.0) - I = 0l - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),U - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) THENL - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)T - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IFo - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:)M - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THENS - I = 2 - END IF - END IF - END IFI - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I)U - DO WHILE (REC_LOCK(IER))U - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY( - END DO) - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I)B - IER = 0 - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THENS - MSG_KEY = NEXT_MSG_KEY - RETURNR - ELSE - MSG_KEY = NEXT_MSG_KEYE - END IF - END DOT - - RETURN( - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE)_ - - IMPLICIT INTEGER (A-Z)( - - INCLUDE 'BULLFOLDER.INC'( - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT)0 - CLOSE_IT = .NOT.CLOSE_ITw - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHAREDT - - DO MESSAGE = MSG_NUM+1,F_NBULLP - CALL READDIR(MESSAGE,IER)E - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE)O - IF (IER.EQ.0) THENB - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR. - RETURNL - END IFS - END IF - END DOT - - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIRL - - RETURNA - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z)L - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2)) - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURNT - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY) - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER). - & INPUT_KEY - END DO - - CLOSE_IT = .FALSE.P - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY)T - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR.1 - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - CALL DECREMENT_MSG_KEYL - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR_SHAREDR - CLOSE_IT = .TRUE. - END IFr - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THENU - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGEA - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIRL - RETURN - ELSE. - DELETE (UNIT=13)F - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER))E - READ (13,IOSTAT=IER) INPUT_KEYE - END DO - END IF - END IF - - END DOG - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC's - - COMMON /NEWS_MARK/ NEWS_MARK_ - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECA - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))E - EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(2),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)& - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE.E - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1_ - DO M=1,2S - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THENB - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1I - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1n - LIMIT = 256/(NEWS_FORMAT+1)O - NEWS_NUMBER = LAST_NEWS_READ2(1,I) - K = 5-NEWS_FORMAT*2S - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1N - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THENR - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IFL - SET_LIST = .FALSE. - END IF - IF (J.EQ.NEWS_TAG(2,M,I)) THEN. - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0) - END DO - K = LIMIT + 1 - END IF - IF (K.GT.LIMIT) THENB - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2 - NEWS_REC = NEWS_REC + 1( - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER)/ - IF (IER.EQ.0) THENG - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF- - END DO - END IF - END IFI - END DO - END IF - END DO0 - END DO - CLOSE (UNIT=23)E - END IFT - - RETURNI - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z)N - - COMMON /NEWS_MARK/ NEWS_MARKJ - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)D - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)U - - IF (NEWS_FORMAT.EQ.0) THENI - NEWS_MARK2(I) = JU - ELSE - NEWS_MARK(I) = J - END IFL - - RETURN, - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG) - - IMPLICIT INTEGER (A-Z)S - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUM - NEWS_TAG(I) = 0 - END DOE - - RETURN_ - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'I - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))B - EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(2),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)3 - - DO I=1,2 - IF (NEWS_TAG(3,I,ISUB).GT.0) THEN - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB))N - NEWS_TAG(3,I,ISUB) = 0, - NEWS_NUMBER = NEWS_FOLDER_NUMBER - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARKN - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER)S - END IF - END DO= - END IF - - DO J=I,FOLDER_MAX-2 - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J))N - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0R - END DO - END DO. - - RETURNA - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE)N - - IMPLICIT INTEGER (A-Z)1 - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY - - IER = 36S - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE) - IF (IER.EQ.0) THENI - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THEN - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM) - END IF - IER = 36 - END IF - END IFT - END DO - BULL_READ = MSG_NUMN - IF (CLOSE_IT) CALL CLOSE_BULLDIR & - ELSES - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0 - MSG_KEY = BULLDIR_HEADER - IER = 0Y - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THEN - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)( - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEYO - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)L - ELSE - IER = 36G - END IF - END IFE - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEYE - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I))M - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1)J - I = 9 - ELSE - I = I + 1 - END IF - END DOJ - - RETURN - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C, -C SUBROUTINE SET_GENERICB -C) -C FUNCTION: Enables or disables "GENERIC" display, i.e. displayingT -C general bulletins continually for a certain amount of days. -CI - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'0 - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'(N - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)N - - IF (IER.EQ.0) THENM - IF (GENERIC) THENT - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE_ - NEW_FLAG(2) = ' 7'3 - END IFF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURNE - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -CE -C SUBROUTINE SET_BRIEF_CONTINUOUS -CE -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -CU - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLUSER.INC'C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THENT - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0S - END IF. - - IF (IER.EQ.0) REWRITE (4) USER_ENTRYS - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGINB -C) -C FUNCTION: Enables or disables bulletin display at login.3 -CG - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC'Y - - CHARACTER TODAY*24B - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THENL - WRITE (6,'(U - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IFM - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)H - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)N - IF (IER.EQ.0) THENG - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THENA - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSEL - WRITE (6,'('' ERROR: Specified username not found.'')'), - END IF8 - - CALL CLOSE_BULLUSER - - RETURNM - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*)_ - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2)& - - CALL INIT_ITMLST_ - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT))S - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST)) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z)) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1I - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURNG - END - - - - SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)'T - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL DISABLE_PRIVSE - - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))// - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))//W - & SUBJECT(INDEX(SUBJECT,'""')+2:) - END DO - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR)Y - - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 1001 - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO))D - I = INDEX(SENDTO(J:),',') - 1T - IF (I.EQ.-1) I = TRIM(SENDTO(J:))T - CALL INIT_ITMLST - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0)A - IF (.NOT.STATUS) GO TO 100 - J = J + I_ - IF (SENDTO(J:J).EQ.',') J = J + 1 - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO))G - CALL END_ITMLST(ATTRIBUTE_ITMLST) - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0)U - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0)S - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - CALL LIB$REVERT - - RETURN - ENDA - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,) - - RETURNH - END - - - - - SUBROUTINE SET_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC'E - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_PN - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /KEEPLOCK/ KEEPLOCK: - - COMMON /NEXT/ NEXTS - - DIMENSION EXPIRED(2) - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN, - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IFE - - ENTRY SHOW_NEWS - - LIMIT = -2D - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1))L - IF (.NOT.IER.OR.LIMIT.LT.-1) THENA - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')')A - RETURN' - END IF - END IF - - EXPIRE = -1E - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1))S - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN. - END IF I - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR.1 - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')') - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder fileL - - IF (CLI$PRESENT('DEFAULT')) THEN_ - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)S - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN( - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1) - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')') - CALL CLOSE_BULLNEWS - RETURND - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_PB - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSEA - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF( - IF (BTEST(FOLDER1_FLAG,0)) THENM - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER)V - CLOSE (UNIT=3,DISPOSE='DELETE')A - END IF - RETURN - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DOT - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT_ - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED)I - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE) - FOLDER1_NUMBER = NEWS_F1_COUNTB - FOLDER1 = BULL_PARAMETERA - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10)E - CALL WRITE_FOLDER_FILE_TEMP(IER)E - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMPG - REWRITE (7) NEWS_FOLDER1_COMH - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER)R - END IF M - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURNR - END IF - END IFG - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS')_ - DEFAULT = CLI$PRESENT('DEFAULT')C - ALL = CLI$PRESENT('ALL') - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE')K - ENABLE = CLI$PRESENT('ENABLE')G - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - Y - STORED = 0L - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN 1 - F1_LAST = 0 - F1_COUNT = 0K - F1_START = 0 - F1_NBULL = 0A - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IFD - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ')E - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN' - WRITE (6,'('' Stored setting was not removed.'')')R - CALL CLOSE_BULLNEWS - RETURNA - END IF - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(BULLNEWSDIR_FILE(I - & :TRIM(BULLNEWSDIR_FILE))//';*') t - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))1 - & //'[.BULLNEWS*]*.*;*')' - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*')I - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWSA - FOLDER_SAVE = FOLDER' - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBERA - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - FOLDER = FOLDER_SAVEI - CALL OPEN_BULLDIR_SHARED - KEEPLOCK = .TRUE. - NEXT = .TRUE. - BULL_DELETE = 1 - F_START = 0 - F_NBULL = 999999T - CALL READDIR(BULL_DELETE,IER) - DO WHILE (IER.EQ.BULL_DELETE+1) - DELETE (2) - CALL READDIR(BULL_DELETE,IER) - END DO - NEXT = .FALSE. - KEEPLOCK = .FALSE. - CALL CLOSE_BULLDIR - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0M - F1_NBULL = 0E - F1_COUNT = 0 - F1_LAST = 0U - END IFR - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8)E - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)T - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN) - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),E - & STATUS='OLD',IOSTAT=IER)( - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP),E - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3) - IF (IER.NE.0) THEN B - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3)O - END IF - CALL RESET_PROTECTIONR - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IF, - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)T - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN D - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG_ - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIREN - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMITT - END IF. - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)A - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THENE - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') R - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')')E - ELSEN - WRITE (6,'('' Default is not stored.'')')T - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)A - ELSE IF (CLASS) THEN - WRITE (6,'('' Expiration is DEFAULT value.'')')T - ELSEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')'), - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THENO - WRITE (6,'('' Default expiration limit is '',A,''.'')')O - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSEL - WRITE (6,'('' There is no default expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IFG - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)A - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')') - ELSED - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)I - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)I - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,)L - IF (F1_EXPIRE_LIMIT.GT.0) THENS - WRITE (6,'('' Expiration limit is '',A,''.'')')_ - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN C - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSEE - WRITE (6,'('' There is no expiration limit.'')') - END IFT - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IFA - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER)R - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1% - ELSE( - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)). - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IFC - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWSB - RETURN - END IFI - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN. - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP)( - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER) - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THENH - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER)) - END IF - FOUND = .FALSE. - MODALL = INDEX(GROUP,'.').NE.LGS - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR.L - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.'))L - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWSO - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL OPEN_BULLDIR_SHARED - KEEPLOCK = .TRUE._ - NEXT = .TRUE.E - BULL_DELETE = 1' - F_START = 0C - F_NBULL = 999999D - CALL READDIR(BULL_DELETE,IER)N - DO WHILE (IER.EQ.BULL_DELETE+1)E - DELETE (2)( - CALL READDIR(BULL_DELETE,IER) - END DO - NEXT = .FALSE. - KEEPLOCK = .FALSE. - CALL CLOSE_BULLDIR - END IF - CALL OPEN_BULLNEWS_SHAREDA - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0G - F1_NBULL = 0N - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) . - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 03 - F1_START = 0F - F1_NBULL = 0W - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0S - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE) - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER) - END DOS - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER)I - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER)E - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER)R - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER)) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF) - RETURNE - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')')D - IER = 0O - DO WHILE (IER.EQ.0)E - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0C - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 01 - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR.V - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0S - F1_NBULL = 0M - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER)W - END DO - END IFE - - FOLDER_NUMBER = -1_ - FOLDER1 = FOLDERD - CALL SELECT_FOLDER(.FALSE.,IER)_ - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0E - CALL SELECT_FOLDER(.FALSE.,IER)V - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER))R - END IF_ - - CALL CLOSE_BULLNEWS - - RETURN - END) - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLUSER.INC'G - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'W - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - IER = SYS_TRNLNM_SYSTEM('BULL_USER_CUSTOM',BULL_PARAMETER)F - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS6 - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH)D - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)C - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IF - - FULL = CLI$PRESENT('FULL')E - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P)) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error outP - RETURNU - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN fileD - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)& - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENG - IF (CLI$PRESENT('SUBJECT')) THENM - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - ELSEO - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IF - ELSE - INPUT = FROM, - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:)S - ELSE - INPUT = DESCRIP - END IFU - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (CLI$PRESENT('SUBJECT')) THEND - INPUT = 'SUBJECT:'//INPUT_ - ELSE - INPUT = 'FROM:'//INPUT - END IF' - - IF (EXCLUDE) THEN - INPUT = ':EXCLUDE:'//INPUT - ELSE( - INPUT = ':INCLUDE:'//INPUT - END IF - - FLEN = TRIM(FOLDER_NAME)E - INPUT = FOLDER_NAME(:FLEN)//INPUT - - ILEN = TRIM(INPUT)E - ALL = CLI$PRESENT('ALL') - DISABLE = CLI$PRESENT('DISABLE')I - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) - & WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - CLOSE (UNIT=4,DISPOSE='SAVE') - RETURN - END IFs - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERU - IF (IER.EQ.0) THEN 6 - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THEN - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5)N - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill'G - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF (STREQ(OLD_BUFFER(:OLEN),INPUT(:ILEN))) THENS - IF (.NOT.DISABLE) THEN - WRITE (6,'('' ERROR: Entry already present.'')') U - CLOSE (UNIT=4) D - CLOSE (UNIT=3) R - RETURN - END IFI - ELSE IF (.NOT.(ALL.AND.INPUT(:FLEN+8).EQ. - & OLD_BUFFER(:MIN(FLEN+8,OLEN)))) THEN - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN) - END IFe - END IF - END DO. - - IF (.NOT.DISABLE) THENZ - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)B - IF (FULL) WRITE (4,'(A)',IOSTAT=IER) - & FOLDER_NAME(:FLEN)//':defaults:kill'E - END IFE - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC's - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOME - DATA BULL_USER_CUSTOM/.FALSE./I - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEO - DATA SCRATCH_B1/0/L - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - BULL_USER_CUSTOM = .FALSE.= - - IER = SYS_TRNLNM_SYSTEM('BULL_USER_CUSTOM',BULL_PARAMETER)R - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'L - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURN - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER)E - SCRATCH_B1 = SCRATCH_B ! Init header pointeri - END IFn - - NINCLUDE = 0' - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERO - IF (IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ.I - & OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+1,OLEN))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL LOWERCASE(OLD_BUFFER)U - IF (INDEX(OLD_BUFFER(TRIM(FOLDER_NAME)+2:),'defaults')C - & .EQ.1) THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1 - END IFB - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - END IF - END DO - - CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1)) - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'J - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMT - DATA BULL_USER_CUSTOM/.FALSE./L - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE' - DATA SCRATCH_B1/0/Q - - CHARACTER*(*) STRING,STRING1 - - INCLUDE_MSG = .TRUE. - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURNA - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME)A - - INC = .FALSE. - - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER)' - IF (STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THEN - IF (.NOT.INC) INCLUDE_MSG = .FALSE. - INC = .TRUE.S - END IF - IF ((STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:').AND.$ - & (STRFIND(STRING(:TRIM(STRING)),OLD_BUFFER - & (FLEN+15:OLEN)).OR. - & STREQ(STRING(:TRIM(STRING)),OLD_BUFFER - & (FLEN+15:FLEN+14+TRIM(STRING))))).OR.L - & (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND.Y - & STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER - & (FLEN+18:OLEN)))) THEN - INCLUDE_MSG = STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')M - IF (.NOT.INCLUDE_MSG) RETURNS - END IF0 - END IF - END DOM - - RETURND - END - - - - FUNCTION STRFIND(STRING,STRING1) - - IMPLICIT INTEGER (A-Z)L - - CHARACTER*(*) STRING,STRING1 - - L = LEN(STRING1)N - DO I=0,LEN(STRING)-LS - J = 1 - DO WHILE (J.LE.L) - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J))) - IF (DIFF.NE.0.AND.DIFF.NE.32) THENI - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = .TRUE.L - RETURN' - ELSEN - J = J + 1E - END IFM - END DO - END DOA - - STRFIND = .FALSE. - - RETURN4 - END diff --git a/decus/vms93a/bulletin/bulletin2.for b/decus/vms93a/bulletin/bulletin2.for deleted file mode 100644 index fb65ba7..0000000 --- a/decus/vms93a/bulletin/bulletin2.for +++ /dev/null @@ -1,2243 +0,0 @@ -C -C BULLETIN2.FOR, Version 3/26/93 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::'.OR.NEWS_FEED()) THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPLY') THEN - BULL_PARAMETER = 'mailing list.' - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'RE:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'RE: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - IF (IER.NE.0) FILESPEC = .FALSE. - CALL ENABLE_PRIVS - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - IF (CLI$GET_VALUE('CC',INPUT,ILEN)) THEN - CALL ADD_PROTOCOL(INPUT,ILEN) - INFROM = INPUT(:ILEN) - LENFRO = ILEN - IF (MSG_OWN) THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - END IF - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - ILEN = TRIM(INPUT) - IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(INPUT(7:),ILEN) - INFROM = INFROM(:LENFRO)//INPUT(7:) - LENFRO = LENFRO + ILEN - 6 - END IF - IF (EDIT.AND.TEXT) THEN - IF (INPUT(ILEN:ILEN).EQ.'"') ILEN = ILEN - 1 - INPUT = INPUT(7:ILEN) - ILEN = ILEN - 6 - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:) - ILEN = TRIM(INPUT) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:ILEN)//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THEN - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - IER = 0 - END IF - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')')r - END IF - END IFe - IF (IER.EQ.0.AND.LENFRO.GT.0) THENn - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IFg - END IF - ELSEo - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,g - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')n - IF (.NOT.FILESPEC) THENe - WRITE (6,'('' Enter message: End with ctrl-z,'',e - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I,S - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered' - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch fileO - END IF - END DOL - ELSE - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THENt - ICOUNT = ICOUNT + 1e - WRITE (3,'(A)') INPUT(:ILEN) - END IFR - END DO - CLOSE (UNIT=4)H - FILESPEC = .FALSE.L - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3)_ - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSEN - IER = 0 - END IF: - CLOSE (UNIT=3)n - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN7 - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM,L - & INDESCRIP,STATUS)I - END IF - END IF - END IFB - IF (IER.NE.0) THENO - WRITE (6,'('' ERROR: No message added.'')'). - IF (.NOT.STATUS) THENE - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ')B - IF (STREQ(INPUT(:1),'Y')) THEN - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR',o - & 'SYS$LOGIN:BULL.SAV')L - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IFE - END IF - END IFR - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')) - - RETURNR - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C -C SUBROUTINE ADD_SIGNATUREf -Ca -C FUNCTION: Adds signature to message being mailed/posted. -C - IMPLICIT INTEGER (A-Z)y - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATURE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/ - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURNs - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THENU - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED')U - END IFO - - IF (IER.NE.0) RETURN= - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IFY - - ICOUNT = 0B - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUTP - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME)))B - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT)I - IF (.NOT.MATCH) THENN - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT)D - END DOO - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IFO - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE.G - ELSEI - ICOUNT = ICOUNT + 1I - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' '. - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN)' - END IFT - END IF - END DO. - - CLOSE (UNIT=4)V - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1)L - - IMPLICIT INTEGER (A-Z)F - - CHARACTER*(*) INPUT,INPUT1F - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.DIFF.NE.32) RETURN - END DO( - - STREQ = .TRUE.X - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -CA -C SUBROUTINE RESPOND_MAIL -C -C FUNCTION: Sends mail to address.A -CC - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC'o - - INCLUDE 'BULLFOLDER.INC'S - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,INDESCRIP*(LINE_LENGTH)B - - INDESCRIP = SUBJECT - LENDES = TRIM(INDESCRIP)E - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES) - IF (INDESCRIP(I:I).EQ.'"') THEN' - IF (LENDES.EQ.LINE_LENGTH) THEN - INDESCRIP(I:I) = '`'R - ELSEE - INDESCRIP = INDESCRIP(:I)//'"'6 - & //INDESCRIP(I+1:)r - I = I + 1 - LENDES = LENDES + 1 - END IF - END IF - I = I + 1 - END DOe - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0I - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD)t - - IF (LISTSERV) THEN - IF (SYS_TRNLNM('MX_NODE_NAME',MAILER)) THEN2 - REPLY_TO = .NOT.SYS_TRNLNM('MX_REPLY_TO',MAILER)v - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - REPLY_TO = .NOT.SYS_TRNLNM('PMDF_REPLY_TO',MAILER) - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - END IF - END IFY - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEND - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))//E - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)D - & //'""" """'//INDESCRIP(:LENDES)//'""" 'I - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IFT - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//INDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE - I = INDEX(SENDTO,'%""') + 3I - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THENE - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THEN - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THENO - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN_ - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF2 - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & INDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) -CS -C Use the following if you do not have VMS V5.3 or greater.E -CE -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//B -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//INDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IF( - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV) THENT - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('PMDF_REPLY_TO')D - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('MX_REPLY_TO') - END IFa - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -CN -C FUNCTION CONFIRM_USER -Cr -C FUNCTION: Confirms that username is valid user. -CI - IMPLICIT INTEGER (A-Z)I - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN) - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACEE -CC -C FUNCTION: CHANGE command subroutine.N -CF - IMPLICIT INTEGER (A - Z)I - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'N - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWER - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')')A - RETURN - END IF - -C( -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL')4 - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THENB - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the errorN - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are readingE - EBULL = SBULLS - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entryE - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN) - END IF - ELSET - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')')s - RETURNd - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THENe - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1)e - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IFo - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THENE - SBULL = 1 - EBULL = NBULL - END IF - END IFR - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')')E - RETURNN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THENE - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')')! - RETURNf - END IF - END IFO - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN. - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THENR - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURNY - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'',6 - & '' permitted for remote folder.'')'). - RETURN - END IF - END IF0 - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'() - & '' ERROR: Not enough privileges to change to permanent.'')')E - RETURN - END IFM -C_ -C Check to see if specified bulletin is present, and if the userE -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHAREDv - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULLE - CALL READDIR(I,IER) ! Get info for specified messagesE - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. E - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIRg - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner?e - WRITE(6,1090) ! If not, then error out.S - RETURND - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletinL -CO - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND.' - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND.E - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')')r - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THENL - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER)L - PERMANENT = BTEST(SYSTEM,1)F - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11)T - INEXTIME = INPUT(13:23) - END IFO - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletinL - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES)O - END IFR - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP))S - END IFd - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message1 - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')')Y - & NUMBER_PARAMW - WRITE(6,'('' All messages up to that message were modified.'')') - RETURNI - END IF - END IF - - REC1 = 0 - - LENFROM = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')E - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)_ - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)R - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENS - INFROM = INPUT(:ILEN) - LENFROM = ILENs - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IFm - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into fileP - WRITE (3,'(A)') INPUT(:ILEN)T - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THENM -C_ -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.A -CR - N - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data_ - REC1 = 1G - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)L - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specifiedr - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THENA - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specifiedG - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified. - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW',g - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy messageL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENn - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into fileI - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IFE - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IFL - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1')f - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')l - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',E - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesm - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950) - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THENR - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with( - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1, - END IF - END IFR - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long.' - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH' - ELSE IF (ILEN.GT.0) THEN ! If good input line enteredW - ICOUNT = ICOUNT + 1 + ILEN ! Increment character countL - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THENI - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C= -C Add bulletin to bulletin file and directory entry for to directory file.E -CI - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIPE - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entryN - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR.L - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THENF - ! If message disappeared, try to find it.R - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ') - NUMBER_PARAM = 0 - IER = 1R - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER)' - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find messageO - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')'). - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')')N - END IF - GO TO 100 - END IF - END IF( - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced. - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3)H - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.'T - CALL CLOSE_BULLFIL' - CALL CLOSE_BULLDIRB - CLOSE (UNIT=3)N - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVES - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER)) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN) - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entryB - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVEL - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THENI - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description header( - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT, - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0)I - ELSE IF (CLI$PRESENT('GENERAL')) THENU - SYSTEM = IBCLR(SYSTEM,0)O - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THENL - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,1)I - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2)Q - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3)R - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COMe - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IFn - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURNM - -910 WRITE(6,1010): - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020)F - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100I - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)' - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.')R -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')E -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.')M -1100 FORMAT(' Message(s) is not owned by you.',_ - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A)Q - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME). - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENTT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header inI - NEWEST_EXTIME = EXTIME ! the directory fileL - CALL WRITEDIR(0,IER)n - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THENe - IF (BTEST(SYSTEM,2)) THENE - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THENr - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THENA - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THENA - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'',o - & '' Invalid node name specified.'')') - END IF - END IF, - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)E - WRITE (EXTIME,'(I4)') NODE_NUMBER_ - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11C - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//N - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1. - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time: - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IFN - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -CE -C FUNCTION: Search for bulletin with specified string -C/ - IMPLICIT INTEGER (A - Z)Y - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*132 SEARCH_STRING - - EXTERNAL CLI$_ABSENT - - IF (INCMD.NE.'SEAR') NFOLDER = 1U - - IF (CLI$PRESENT('SELECT_FOLDER')) THENL - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0) - END IFS - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME - NFOLDER = NFOLDER + 1S - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DOT - - IF (CLI$PRESENT('SELECT_FOLDER')) SCRATCH_F = SCRATCH_F1, - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IFN - - IF (CLI$PRESENT('NOREPLIES')) THENE - SEARCH_STRING = 'RE:'A - SEARCH_LEN = 3 - ELSEE - IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN) - END IF( - - IF (NFOLDER.GT.0) FOUND = 0 - - DO WHILE (NFOLDER.GT.0.AND.FOUND.LE.0)D - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1) _ - & CALL GET_SEARCH(FOUND,SEARCH_STRING,START_BULL, - & CLI$PRESENT('REVERSE'),CLI$PRESENT('SUBJECT')) - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'), - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES')) ) - IF (FOUND.EQ.-1) THENO - NFOLDER = 0 - ELSE IF (FOUND.LE.0) THENQ - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1) NFOLDER = NFOLDER - 1 - IF (NFOLDER.GT.0) THEN) - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME)N - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME)). - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,E - & FOLDER1_NAME)L - END IFA - END IF - END DOE - END IFR - END IF - END DO* - - IF (FOUND.GT.0) THENR - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - WRITE (6,'('' No messages found with given search string.'')') - ELSE IF (FOUND.EQ.-2) THEN` - WRITE (6,'('' ERROR: No more messages.'')')" - END IF& - - RETURNC - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,START_BULL,REVERSE, - & SUBJECT,REPLY,FILES,START,FROM_SEARCH,NEGATE)S -CP -C SUBROUTINE GET_SEARCH -C= -C FUNCTION: Search for bulletin with specified string -CV - IMPLICIT INTEGER (A - Z)_ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'X - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAGL - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEXT/ NEXT, - - CHARACTER*(*) SEARCH_STRING - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - CHARACTER*53 DESCRIP1 - - FOUND = -1B - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST: - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE) - IER1 = .TRUE.B - END IFR - A - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THENE - ! If no search string entered' - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURNL - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THEN' - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - END IFL - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN' - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3E - NEGATED = NEGATE - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4N - NEGATED = NEGATE - ELSE IF (REPLY) THENE - NEGATED = NEGATE - CALL READDIR(START_BULL,IER) - IF (START_BULL+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')')S - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLS - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (REVERSE) START_BULL = START_BULL - 2: - END IF - END IF - - SAVE_STRING = SEARCH_STRING - SEARCH_LEN = TRIM(SAVE_STRING)= - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case. - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.T - & REVERSE.OR.REPLY) THENE - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or lastF - END IF - IF (REVERSE) THENO - END_BULL = 1n - STEP_BULL = -1 - ELSE - END_BULL = NBULLT - STEP_BULL = 1 - END IF - END IFD - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIRE - CALL CANCEL_CTRLC_ASTo - CALL ENABLE_CTRL - RETURN - END IFA - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - SAVE_BULL_SEARCH = 0R - DO BULL_SEARCH = START_BULL+1, END_BULL, STEP_BULL - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY)O - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY)E - END IFA - ELSEE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,T - & BULL_SEARCH,DUMMY)L - END IFN - IF (IER.EQ.0) THEN - IER = BULL_SEARCH + 1 - ELSE6 - GO TO 800 - END IFi - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THENE - IF (SEARCH_MODE.EQ.4) THEN) - CALL STR$UPCASE(DESCRIP1,FROM) - ELSEf - CALL STR$UPCASE(DESCRIP1,DESCRIP)0 - END IFr - IF ((SEARCH_MODE.GE.3.AND.n - & INDEX(DESCRIP1,SEARCH_STRING(:SEARCH_LEN)).GT.0).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1.AND. - & DESCRIP1(:4).EQ.'RE: ')))) THEN - IF (.NOT.NEGATED) THENe - FOUND = BULL_SEARCH6 - GO TO 900i - END IF f - ELSE IF (FLAG.EQ.1) THENN - WRITE (6,'('' Search aborted.'')')R - GO TO 900 - ELSE IF (NEGATED) THEN e - FOUND = BULL_SEARCH - GO TO 900 - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THENd - IF (REMOTE_SET) THENN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE. - GO TO 900N - ELSE - CALL GET_REMOTE_MESSAGE(IER)m - IF (IER.GT.0) GO TO 900m - END IF - END IFD - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0)T - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)F - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THENR - FOUND = BULL_SEARCHo - IF (.NOT.NEGATED) GO TO 900R - ELSE IF (FLAG.EQ.1) THENO - WRITE (6,'('' Search aborted.'')') - GO TO 900( - END IF - END DOY - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSER - FOUND = -1 - END IF - END IFi - END IF - END DOs - -800 FOUND = 0 - -900 IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURNl - END - - - - - SUBROUTINE UNDELETE -CL -C SUBROUTINE UNDELETE -CO -C FUNCTION: Undeletes deleted message.C -CI - IMPLICIT INTEGER (A - Z)H - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLFOLDER.INC'l - - EXTERNAL CLI$_ABSENTD - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')')e - RETURN - END IFh -Ce -C Get the bulletin number to be undeleted._ -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?L - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I)e - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error.( - ELSEE - BULL_DELETE = BULL_POINT ! Delete the file we are readingo - END IFc - - IF (BULL_DELETE.LE.0) GO TO 920 - -CV -C Check to see if specified bulletin is present, and if the userO -C is permitted to delete the bulletin.E -CW - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?( - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IFI - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,W - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner?A - WRITE(6,1040) ! Then error out.X - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?& - WRITE(6,1030) ! If not, then error out. - GOTO 100 - END IF - END IF - END IFN - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:) - END IF - END IFe - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date= - WRITE (6,'('' Message was undeleted.'')')L - ELSEL - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)T - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COMD - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I)L - ELSE' - WRITE (6,'('' Message was undeleted.'')')D - END IF9 - ELSE - CALL DISCONNECT_REMOTE - END IF - END IFE - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010)S - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.')E -1020 FORMAT(' ERROR: Specified message number has incorrect format.')D -1030 FORMAT(' ERROR: Specified message was not found.')L -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.')N - - END - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z)W - - INCLUDE 'BULLNEWS.INC'' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - IF (LMAIL.EQ.0) THENO - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN= - MAIL_PROTOCOL = MAILERT - END IF - LMAIL = TRIM(MAIL_PROTOCOL)= - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%'G - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -11 - RETURNL - END IF - END IF - - AT = INDEX(INPUT,'@') - IF (AT.GT.0) INPUT = INPUT(:INDEX(INPUT(AT:),' ')+AT-2) - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"'s - - IF (ILEN.NE.0) ILEN = ILEN + LMAIL + 2P - - RETURN - END diff --git a/decus/vms93a/bulletin/bulletin3.for b/decus/vms93a/bulletin/bulletin3.for deleted file mode 100644 index be4c2a4..0000000 --- a/decus/vms93a/bulletin/bulletin3.for +++ /dev/null @@ -1,2228 +0,0 @@ -C -C BULLETIN3.FOR, Version 5/13/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (.NOT.IER1) THEN - CALL TPU$EDIT(' ',OUT) - ELSE - CALL TPU$EDIT(INFILE,OUT) - END IF - IER1 = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - ! TPU does CLI$ stuff which wipes our parsed command line - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(28) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - CALL DELETE_EXPIRED_NEWS(NOW) - CALL SYS$SETAST(%VAL(1)) - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - CALL SYS$SETAST(%VAL(0)) - CALL REGISTER_BULLCP - IER1 = 1 - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES3 - CALL SYS$SETAST(%VAL(1))o - - BBOARD_LOOP = BBOARD_LOOP + 1t - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND.o - & NEWS_LOOP.EQ.0) CALL CREATE_PROCESS('BULLCP NEWS')i - CALL SYS$SETAST(%VAL(1)) - - NEWS_LOOP = NEWS_LOOP + 1i - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIMEO - CALL HIBER('15') ! Wait for 15 minutes -CN -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folderA -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))U - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF& - CALL SYS$SETAST(%VAL(1))_ - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folderE - CALL SELECT_FOLDER(.FALSE.,IER)s - CALL SYS$SETAST(%VAL(1)) - END DO_ - - RETURNn - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEMO - - IMPLICIT INTEGER (A-Z)t - - INCLUDE 'BULLFOLDER.INC'M - - INCLUDE 'BULLUSER.INC'a - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER NODENAME*8e - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)0 - - CALL OPEN_BULLFOLDER_SHAREDe - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER)u - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THENO - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,B - & BTEST(FOLDER_FLAG,2),NODENAME - END IF. - CALL SETUSER(USERNAME)R - CALL OPEN_BULLFOLDER_SHAREDL - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'I - - INTEGER SHUTDOWN_BTIM(FLONG)M - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8M - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)N - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSERF - - DO WHILE (REC_LOCK(IER))T - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG,E - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG( - END DO) - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)e - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0t - SHUTDOWN_FLAG(I) = 0. - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0N - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,E - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGt - CALL CLOSE_BULLUSERa - ELSEi - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGT - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - TEMP_USER = ':'I - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER)T - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME( - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DOM - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN_ - END IF - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,M - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"')B - - IF (IER.NE.0) THEN0 - CALL ERRSNS(IDUMMY,IDUMMY,INODE)e - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR._ - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE) - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IFX - CLOSE (UNIT=REMOTE_UNIT)N - END DO - END IF- - - RETURNW - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG)i - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)_ - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSERN - - DO WHILE (REC_LOCK(IER))! - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGc - END DOi - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER)t - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO) - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THENN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGi - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGL - END IF - - CALL CLOSE_BULLUSER - - RETURNR - END - - - - - - SUBROUTINE HIBER(MIN) -C_ -C SUBROUTINE HIBER -CL -C FUNCTION: Waits for specified time period in minutes.e -Ct - IMPLICIT INTEGER (A-Z)S - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format.B - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN_ - END - - - - SUBROUTINE WAIT_SEC(PARAM)E -C -C SUBROUTINE WAIT_SECN -CS -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z)L - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF)G - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURNe - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -C -C SUBROUTINE DELETE_EXPIRED_NEWSM -CE -C FUNCTION: -C. -C Delete any expired message in local news folders. -CE - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT1 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - INTEGER TODAY(2),DAY(2),NEXT_EX_BTIM(2) - - CHARACTER*8 TODAY_KEY - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - - IF (IER.NE.0) THENN - CALL CLOSE_BULLNEWS - RETURN - END IF - - CALL SYS_BINTIM('-',TODAY) - - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END DO - CALL NEWS_TO_FOLDERf - - UNLOCK 7 - - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - GO TO 1000S - ELSE IF (REMOTE_SET.NE.4) THEN - REMOTE_SET = 4t - CALL OPEN_BULLDIR_SHAREDE - END IFO - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0O - NDEL = -1I - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM)e - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. e - IF (NDEL.GT.NEWS_F_END) THENN - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1e - CALL READ_NEXT_EXPIRED(NDEL)W - ELSE IF (EXDATE(8:9).EQ.'18'.OR. ! Deleted manually? - & INDEX(EXDATE,'1900').GT.0) THEN - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) O - EXTIME = ASCTIME(13:23)l - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0 - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM)A - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0 - UNLOCK 2A - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER)U - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_STARTE - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0O - END DOT - F_START = I2 - NEXT = .FALSE. - END IF - CALL READDIR(F_NBULL,IER)E - IF (DN.OR.F_NBULL.EQ.IER) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I), - I = I - 1 - CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = II - END DO - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM)T - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13)A - CALL REWRITE_FOLDER_FILE(IER)D - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2)X - CALL READ_FIRST_EXPIRED(NDEL)F - END DOR - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO' - - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS( - -1000 IF (NOW) THEN - CONTEXT = 0P - IER = LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT) - IF (IER) IER = CONV$RECLAIM(BULLNEWSDIR_FILE)Q - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - DO I=1,31( - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;')E - END DO D - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IFN - - RETURN( - END - - - - SUBROUTINE DELETE_EXPIRED -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C( -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files,T -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and) -C was replaced with a 128 byte record compressed format). -CO - - IMPLICIT INTEGER (A-Z)d - - INCLUDE 'BULLUSER.INC'D - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'X - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)r - - CHARACTER UPTIME_DATE*12,UPTIME_TIME*12 - - CALL OPEN_BULLDIR_SHARED ! Open directory fileP - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFILL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present?I - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')= - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND.O - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0= - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENX - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF. - IER1 = 1R - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN, - CALL CLOSE_BULLDIRa - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to updates - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENP - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)a - END IF - END IF, - CALL CLOSE_BULLDIRp - - RETURN) - END - - - - - SUBROUTINE BBOARD -Cp -C SUBROUTINE BBOARD -C, -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -CR - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'e - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSe - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76d - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64( - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/,HEADER_Q1/0/ - - CALL SYS$SETAST(%VAL(0))o - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF)E - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(HEADER_Q1,INPUT)N - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from fileA - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)a - END IF - END DOc - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1))R - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900= - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1))& - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0E - -1 POINT_FOLDER = POINT_FOLDER + 1E - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0))I - - FOLDER_Q_SAVE = FOLDER_QD - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1P -C= -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD accountU - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uicM - END IF) - - LEN_B = TRIM(BBOARD_DIRECTORY)T - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)//M - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors, - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THENO - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)u - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)C - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST')A - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV'e - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)//P - & '''F$GETJPI("","USERNAME")'''S - WRITE(11,'(A)') '$ MAIL'T - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL'N - WRITE(11,'(A)') 'READ/NEW'I - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL'h - WRITE(11,'(A)') 'SELECT/NEW'& - CLOSE(UNIT=11)l - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)), - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)). - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN( - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//C - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))( - CALL SYS$SETAST(%VAL(0))E - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))e - CALL SYS$SETAST(%VAL(0)) - END IF - END IFn - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM)t - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account, - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD/ - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1))' - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM)O - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THENf - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DOI - - INTO = INTO(:TRIM(INTO))) - CALL STR$TRIM(INTO,INTO)L - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD)C - HEADER_Q = 0E - NHEAD = 0 - IF (.NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - HEADER_Q = HEADER_Q1 - IER = 0L - CALL STRIP_HEADER(' ',0,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTS - IF (IER.EQ.0) THENE - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP)I - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - NHEAD = NHEAD + 1 - END IF, - END DO - - FOUND = .FALSE.t - J = 0) - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS)U - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM)T - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THENU - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP)E - END IF - IF (J.EQ.1.OR.F_BBOARD.NE.FOLDER1_BBOARD) THEN - FLEN = TRIM(F_BBOARD) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1R - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND)_ - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DOT - END IF_ - END IF - END IFL - END DOi - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COML - END IF - - IF (NHEAD.EQ.0) THENL - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - ELSE. - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT)R - NHEAD = NHEAD - 1) - END IFo - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0)_ - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5W - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM)R - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" lineA - I = I - 1 - END DOE - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER)T - - ISTART = 0N - NBLANK = 0L - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1N - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ')i - END DOi - NBLANK = 0I - CALL WRITE_MESSAGE_LINE(INPUT)S - END IF - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - ELSE - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)E - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)S - & .AND.IER.EQ.0)N - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTL - END DOA - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IFe - END IF - END DO( - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1))H - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input fileu - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL$ - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THENA - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER)$ - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM)s - REWRITE (4) USER_HEADER ! Rewrite headerT - CALL CLOSE_BULLUSERA - END IFC - CALL SYS$SETAST(%VAL(1))L - - CALL SYS$SETAST(%VAL(0))E - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & .NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) CALL NEWS2BULL - CALL SYS$SETAST(%VAL(1))N - - RETURNI - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE. - - LEN_BBOARD = LEN(BBOARD) - 1Y - - DO I=1,TRIM(INPUT)-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND. - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND.B - & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR.0 - & INDEX(' .@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0)) - & RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURNO - END - - - - LOGICAL FUNCTION ALPHA(IN)( - - CHARACTER*(*) INL - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURN - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIPi - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN1 - - BBOARD_NAME = FOLDER_DESCRIP(I+1:)O - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!')C - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DOC - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@')S - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%')L - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN) - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z)I - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(28) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE')R - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')B - IF (IER.NE.0) RETURNE - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT'L - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT'O - WRITE(11,'(A)') '$B/'//'''F$PROCESS()'''E - WRITE(11,'(A)') '$EXIT:'L - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11)S - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionU - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0)V - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',,/ - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND))_ - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))T - IF (.NOT.IER.AND..NOT.DEL) THENL - CALL DELPRC('BULLCP NEWS',DEL)( - IER = .NOT.DEL= - ELSE - IER = .TRUE. - END IF - END DOE - - RETURNE - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI)B -C, -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z)$ - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(28) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list= - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist) - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENTT - END IF - END IF: - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2))' - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2))B - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2))N - - RETURN - END - . - - - - SUBROUTINE GETUIC(GRP,MEM)$ -CS -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job.U -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UICE -CN - - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listN - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistR - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN_ - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -CL -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C, - - IMPLICIT INTEGER (A-Z)U - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLSTF - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST)E - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,)I - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURNA - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSD - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointeri - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)I - - DO I=1,NUM_FOLDERSI - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)S - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR.f - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND.T - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO: - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:)L - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IFe - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THENC - NEW_MAIL(I) = .TRUE.N - ELSEE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE.M - END IF - END DOO - - CLOSE (10)B - - RETURNI - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN)T -C8 -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN)I -C. -C FUNCTION: -C To get image name of process.E -C OUTPUT: -C IMAGNAME - Image name of process_ -C ILEN - Length of imagename) -C. - - IMPLICIT INTEGER (A-Z)H - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listC - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN))A - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN_ - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START)N - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THENE - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START)P - ELSED - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START)I - IF (START.EQ.0) THEN - START = -1O - END IF - END IF- - - RETURN= - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2). - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY)D - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN. - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1_ - CALL READDIR(START,IER) - END DO_ - - CALL CLOSE_BULLDIR - - RETURNE - END - - - - - - SUBROUTINE READ_NOTIFY? - - IMPLICIT INTEGER (A-Z)9 - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'_ - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER))A - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE_ - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0S - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTEN - END IF - - CALL CLOSE_BULLDIR( - - RETURNM - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z)H - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAM, - - DATA OBIO/0/,OCPU/0/,ODIO/0/E - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAM - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listR - S - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU))B - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IF - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1 - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM)L - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.( - END DO - END IFM - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND. - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIOD - ODIO = DIOF - OCPU = CPUF - IER = 0 - RETURNE - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IFM - RETURNB - END diff --git a/decus/vms93a/bulletin/bulletin4.for b/decus/vms93a/bulletin/bulletin4.for deleted file mode 100644 index d938fed..0000000 --- a/decus/vms93a/bulletin/bulletin4.for +++ /dev/null @@ -1,2194 +0,0 @@ -C -C BULLETIN4.FOR, Version 2/26/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(BUFFER,0,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' ') THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - ELSE - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/, COMP /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new dates - - RETURNf - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT)A -CM -C SUBROUTINE GET_LINE -CL -C FUNCTION: -C Gets line of input from terminal.M -Ca -C OUTPUTS:i -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST.O -CN - - IMPLICIT INTEGER (A-Z)T - - LOGICAL*1 DESCRIP(8),DTYPE,CLASSr - INTEGER*2 LENGTHt - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITa - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGL - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE.$ - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT)d - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -CI -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE andE -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1A -C. - - CALL DECLARE_CTRLC_ASTT - - LEN_INPUT = 0 ! Nothing inputted yet - -C_ -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line.% -C( - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTN - IF (IER.NE.0) LEN_INPUT = -2 L - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with promptb - ELSEd - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no prompt - END IFI - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER)D - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT)l - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input?e - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of lineD - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DOt - CALL CONVERT_TABS(INPUT,LEN_INPUT)+ - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say soR - END IF - ELSEn - LEN_INPUT = -1 ! If CTRL-C, say so - END IFe - RETURNn - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z)U - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT)L - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THENS - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DOT - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMITD - INPUT(I:I) = ' ' - END DOD - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z)I - - CHARACTER*(*) INCHARE - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURNN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logicalT - CHARACTER*(*) OUTPUT ! byte to character valueL - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT)L - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routineD - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...')A - CALL SYS$CANEXH()O - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXITt - END IFo - FLAG = 1 ! to set flag - RETURNA - END - - - - SUBROUTINE DECLARE_CTRLC_ASTT -C1 -C SUBROUTINE DECLARE_CTRLC_AST2 -C -C FUNCTION: -C Declares a CTRLC ast.Y -C NOTES:S -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/.h -Cr - IMPLICIT INTEGER (A-Z)T - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINEL - COMMON /TERM_CHAN/ TERM_CHANI - - COMMON /CTRLC_FLAG/ FLAGE - - FLAG = 0 ! Init CTRL-C flagS - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOe - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN. - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOL - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURNI - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -CI -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z)R - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHANI - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGH - - COMMON /READIT/ READIT1 - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2)R - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./P - - DO I=1,LEN(DATA)E - DATA(I:I) = ' '9 - END DO_ - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),U - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.. - ELSET - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURNO - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT)a - - DO I=1,LEN(DATA) - DATA(I:I) = ' 'A - END DOI - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),R - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE., - ELSEe - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),R - & TRM$M_TM_NOECHO) - END IFD - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN)N - - DO I=1,LEN(DATA)N - DATA(I:I) = ' 'R - END DOM - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),D - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE.' - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,,S - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM)U - END IFa - - RETURNi - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal, - - CALL DECLARE_CTRLC_ASTT - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID)K - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)& - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPADU - ELSE IF (READIT.EQ.0) THEN: - CALL SET_NOKEYPADD - END IFS - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9')T - MASK(2) = IBCLR(MASK(2),I-32)= - END DO& - - RETURN8 - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH)( -C) -C SUBROUTINE GETPAGSIZN -C( -C FUNCTION: -C Gets page size of the terminal.I -CA -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z)) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH))T - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132)A - - RETURN' - END - - - - - - LOGICAL FUNCTION SLOW_TERMINALI -CE -C FUNCTION SLOW_TERMINALD -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less).. -C) -C OUTPUTS:G -C SLOW_TERMINAL = .true. if slow, .false. if not. -CH - - IMPLICIT INTEGER (A-Z)U - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHANA - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)') - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,)L - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSEE - SLOW_TERMINAL = .FALSE.( - END IFO - - RETURNE - END - - - - - SUBROUTINE SHOW_PRIV -CF -C SUBROUTINE SHOW_PRIVt -Cb -C FUNCTION: -C To show privileges necessary for managing bulletin board.O -C- - - IMPLICIT INTEGER (A-Z)t - - INCLUDE 'BULLUSER.INC'K - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT filea - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not presentN - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file_ - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV) - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR.E - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THENN - WRITE (6,'(1X,A)') PRIVS(I) - END IFE - END DO - ELSEI - WRITE (6,'('' ERROR: Cannot show privileges.'')')P - END IF: - - CALL CLOSE_BULLUSER ! All finished with BULLUSERN - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER)2 - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)))T - END IF - - RETURN: - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z)F - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA',L - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/A - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN1 - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IFN - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDsR - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IFU - IF (.NOT.IER) CALL SYS_GETMSG(IER)E - END DO - RETURN - END IF - - OFFPRIV(1) = 0I - OFFPRIV(2) = 0T - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privilegesL - PRIV_FOUND = -1P - I = 0( - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURNB - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THENT - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')')T - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSEI - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)T - END IFU - ELSE - IF (PRIV_FOUND.LT.32) THENM - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE( - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32)R - END IFL - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1))E - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2))M - REWRITE (4) USER_HEADER_ - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')')A - END IFH - - CALL CLOSE_BULLUSER ! All finished with BULLUSERO - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -CK -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.E -C IER - Return error from attempting to set ACL. -CE -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256t - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)'e - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS='N - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THENT - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THENF - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')')U - CALL SYS_GETMSG(IER)t - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16)A - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,). - END IFR - END IF - END IF1 - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(P - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IFL - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP)N - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILEN - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,)F - END IFF - - RETURNT - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -CO -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -CU -C NOTE: The ID must be in the RIGHTS data base. -CO - IMPLICIT INTEGER (A-Z)d - - INCLUDE 'BULLFOLDER.INC'B - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256U - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item listi - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT))s - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlisti - ELSEr - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT))g - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistN - END IFZ - - IF (INDEX(ACCESS,'C').GT.0) THENO - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(M - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)M - RETURN - END IFA - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP)_ - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IFD - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDERn -C -C SUBROUTINE CREATE_FOLDER. -CI -C FUNCTION: Creates a new bulletin folder.C -CC - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOMM - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER - RETURN - END IFa - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THENN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IFE - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')') - RETURN - END IFi - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR.s - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')')N - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B)T - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDERE - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '',F - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAX: - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)F - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND.r - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'',d - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0E - DO WHILE (LENDES.EQ.0)) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES)E - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN= - WRITE (6,'('' Aborting folder creation.'')')P - RETURNE - ELSE IF (LENDES.GT.80) THEN ! If too many characters+ - WRITE(6,'('' ERROR: folder must be < 80 characters.'')')T - LENDES = 0O - END IF - END DOl - - CALL OPEN_BULLFOLDER ! Open folder filex - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0)! - ! See if folder exists - - IF (IER.EQ.0) THENo - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF) - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THENN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURNU - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDERI - RETURN - ELSE IF (CLI$PRESENT('ID')) THENL - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURNP - END IFE - ELSEI - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER)U - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURNM - END IF - END IFL - FOLDER_OWNER = FOLDER1_OWNERO - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present usernameE - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IFD - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)I - -CS -C Folder file is placed in the directory FOLDER_DIRECTORY.I -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')')E - GO TO 910= - ELSEL - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IFE - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,S - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')L - - IF (IER.NE.0) THENT - WRITE(6,'('' ERROR: Cannot create folder directory file.'')')d - CALL ERRSNS(IDUMMY,IER)S - CALL SYS_GETMSG(IER) - GO TO 910( - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THENN - WRITE(6,'('' ERROR: Cannot create folder message file.'')')E - CALL ERRSNS(IDUMMY,IER)T - CALL SYS_GETMSG(IER) - GO TO 910 - END IFL - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)( - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))E - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1)o - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))0 - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1)' - IF (.NOT.IER) THEN - WRITE(6,S - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER)o - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IFA - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1)' - LAST_NUMBER = LAST_NUMBER + 1 - END DOG - - IF (IER.EQ.0) THEN, - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAXE - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF4 - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 07 - NBULL = 0N - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name?o - REMOTE_SET = .FALSE.H - CALL OPEN_BULLDIR ! If so, store name in directory fileN - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIRr - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*'t - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE.l - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0)N - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULLn - END IF - - FOLDER_OWNER = FOLDER1_OWNERi - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11)n - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12)h - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0)T - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0s - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN( - BRIEF = 1V - READNEW = 1) - END IF( - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)')/ - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000E - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE.E - CLOSE (UNIT=1,STATUS='DELETE')/ - CLOSE (UNIT=2,STATUS='DELETE')U - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionO - - RETURNE - - END - - - - INTEGER FUNCTION CHKPRO(INPUT)I -C -C Description:G -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL.o -Cr - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))//i - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary formatx - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checkingE - - CALL INIT_ITMLST ! Initialize item listF - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has theL - ! rights-id assigned to it - RETURNo - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -CO -C SUBROUTINE CREATE_NEWS_FOLDER -C -C FUNCTION: Creates a new newsgroup. -C - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLFOLDER.INC'C - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT! - DATA EDIT_DEFAULT/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME)C - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED')L - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesD - END IFT -C. -C If file specified in command, read file.m -C Else, read from the terminal./ -C8 - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specifiedN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',P - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')D - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')I - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',N - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')T - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTHg - ELSE IF (ILEN.GE.0) THEN ! If good input line entered_ - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file- -2010 FORMAT(A)E - ICOUNT = ICOUNT + ILENe - END IFA - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outS - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER,A - & 'Adding newsgroup.')R - CLOSE (UNIT=3)N - - RETURN - -920 WRITE(6,1020)I -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURNI - -910 WRITE(6,1010)_ -1010 FORMAT (' No news group was added.')A - CLOSE (UNIT=3)( - RETURN, - - END - - - - - SUBROUTINE INIT_COMPRESS, - - IMPLICIT INTEGER (A-Z)R - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127) - CHARACTER*2 B - - CHARACTER*(*) IN,OUTR - CHARACTER*255 T - - DO I=0,127G - DO J=0,127 - A(J,I) = ' ' - END DO - END DOE - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DOT - R - J = 1 - DO I=1,8 - J = J + 1N - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)( - END DO - DO I=10,31 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO_ - DO I=127,254E - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)) - END DO - - RETURN, - - ENTRY COMPRESS(IN,OUT,O)T - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - T(O:O) = A(ICHAR(IN(K:)).AND.127,ICHAR(IN(K+1:)).AND.127)A - IF (T(O:O).NE.' ') THENa - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND.i - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1))K - C = C + 1 - K = K + 1 - END DO_ - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1)K - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0)E - O = O + 1 - ELSE - T(O:O) = IN(K:K) - K = K + 1 - O = O + 1 - END IF - END DO' - IF (K.EQ.L) THENB - T(O:O) = IN(K:K) - ELSE - O = O - 1D - END IF - - OUT = T - - RETURN( - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1H - T(O:O) = IN(I+2:I+2) - END DO - I = I + 3 - ELSEF - B = UNMAP(J)E - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1_ - T(O:O) = IN(I:I)E - ELSEL - O = O + 2_ - T(O-1:O) = B - END IF_ - I = I + 1 - END IF - END DO - - OUT = T(:O) - - RETURNI - END diff --git a/decus/vms93a/bulletin/bulletin5.for b/decus/vms93a/bulletin/bulletin5.for deleted file mode 100644 index 3b641d6..0000000 --- a/decus/vms93a/bulletin/bulletin5.for +++ /dev/null @@ -1,2342 +0,0 @@ -C -C BULLETIN5.FOR, Version 3/9/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3.OR.FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - FOLDER_SET = .FALSE. - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & F1_START.GT.0) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_NBULL = F1_NBULL - F_START = F1_START - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - FOLDER_NAME = FOLDER - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - REMOTE_SET_NEW = 1 - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11)) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s news group.'')') - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP( - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN - WRITE (6,'('' Folder only accessible for reading.'')') - END IF/ - READ_ONLY = .TRUE.s - ELSEn - READ_ONLY = .FALSE. - END IF - ELSEt - READ_ONLY = .FALSE. - END IFo - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THENs - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THENi - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DATO - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.R - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2))I - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0M - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IFC - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to updatee - END IF - ELSET - NBULL = 0 - END IFL - CALL CLOSE_BULLDIRE - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IFA - END IFL - - IF (OUTPUT) THENN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1)T - BULL_PARAMETER = 'MARKED' - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2). - BULL_PARAMETER = 'SEEN'N - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENTC - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THENF - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED'F - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THENU - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN'R - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IFE - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THEND - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)N - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2)( - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THENE - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - WRITE(6,'('' WARNING: No '',A, - & '' messages found.'')')( - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IF - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THENU - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IFE - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND.G - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)L - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0)p - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletinsT - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IFA - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE.1 - ELSE IF (OUTPUT) THEN. - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER)E - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0E - END IF - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -CL -C SUBROUTINE UPDATE_FOLDER( -CE -C FUNCTION: Updates folder info due to new message. -CR - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'_ - - IF (FOLDER_NUMBER.LT.0) RETURNQ - - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileR - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message?R - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IFL - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURNe - END - - - - SUBROUTINE SHOW_FOLDERx -Cc -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder.t -C' - - IMPLICIT INTEGER (A-Z)t - - INCLUDE 'BULLUSER.INC'D - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG)L - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)'U - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THENH - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IFE - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THENR - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IFE - - IF (TEST_NEWS(FOLDER1)) THEN F - INCMD = 'SET NEWS 'Q - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL ', - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)D - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')')N - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN6 - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSEe - WRITE (6,1010) FOLDER1,FOLDER1_OWNER,( - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF( - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACLE - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THENT - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remoteT - & BTEST(FOLDER1_FLAG,0)) THEN ! and private?i - WRITE (6,'('' Access is limited.'')')C - END IFR - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1O - WRITE_ACCESS = 1O - ELSE_ - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',E - & USERNAME,READ_ACCESS,WRITE_ACCESS)m - END IFE - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN( - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSET - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIRE - CALL READDIR(0,IER)X - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0) - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '',R - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IFO - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF' - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')1 - IF (BTEST(GROUPB1,31)) THENT - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')')' - END IF - END IFL - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIREA - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSEG - WRITE (6,'('' No default expiration set.'')') - END IF0 - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IFO - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')')e - END IFC - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')'). - END IFD - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IFs - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IFF - IF (BTEST(FOLDER1_FLAG,10)) THEN_ - WRITE (6,'('' POST_ONLY has been set.'')')L - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THENB - WRITE (6,'('' COMPRESS has been set.'')') - END IFT - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')')L - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IFS - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERMt - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THENs - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND., - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THENR - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')')e - ELSE - WRITE (6,'('' Default is BRIEF.'')')n - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND.E - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE.U - WRITE (6,'('' Default is READNEW, which is permanent.'')')I - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.O - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE.U - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')')M - ELSE - WRITE (6,'('' Default is SHOWNEW.'')')U - END IF - END IF - END IFE - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.I - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')')C - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')')D - END IF - END IFW - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEND - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSEO - WRITE (6,'('' Default is NONOTIFY.'')') - END IF! - CALL CLOSE_BULLUSER - END IF - END IFE - - CALL CLOSE_BULLFOLDER - - RETURNE - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/,) - & ' Description: ',A)o -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/,: - & ' Description: ',A)L - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT)/ -CN -C SUBROUTINE DIRECTORY_FOLDERSF -C -C FUNCTION: Display all FOLDER entries. -C. - IMPLICIT INTEGER (A - Z) - - INCLUDE '($SSDEF)'N - - INCLUDE 'BULLFOLDER.INC'N - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGF - - COMMON /CTRLC_FLAG/ FLAGF - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/o - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' 'N - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN0 - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IFF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. I - STORED = .FALSE. Y - CLASS = .FALSE.M - NEW = .FALSE.S - FOLDER_COUNT = 1 ! Init folder number counterE - NLINE = 1A - START = .FALSE.L - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE.S - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IFe - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')')L - CALL CLOSE_BULLFOLDER_ - CALL NEWS_LISTM - CALL OPEN_BULLNEWS_SHAREDE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER)D - END IF - COUNT = CLI$PRESENT('COUNT')( - IF (COUNT) TOTAL_COUNT = 0E - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE'). - NEW = CLI$PRESENT('NEWGROUPS') - CLASS = CLI$PRESENT('CLASS')O - IF (CLASS) THEN - CALL CLOSE_BULLFOLDERX - CALL OPEN_BULLNEWS_SHAREDH - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THENA - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - ELSEG - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THENL - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER)F - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER) - FOLDER_COUNT = -1 - RETURNM - ELSEN - START = .TRUE. - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN)S - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THENR - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0 - FOLDER_COUNT = -1D - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN= - SUBNUM = -2E - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)A - END IFO - -CF -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memoryD -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -CR - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DECLARE_CTRLC_ASTE - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE.B - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IFQ - END DO. - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2_ - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THENR - NEW_NEWS = FOLDER1_NUMBER) - ELSE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP)L - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND.E - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)),T - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1I - END IF - END IFL - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSEC - READ_ACCESS = 1 - END IFr - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSEE - FSTATUS1 = ' ' - END IF - IF (.NOT.NEWS_TEST) THENL - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100R - END IF - END IF_ - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN - IER1 = 1E - MORE = .TRUE. - END IF! - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DOL - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymoreW - - IF (FLAG.EQ.1) THEN, - WRITE (6,'('' Folder search aborted.'')') - FOLDER_COUNT = -1M - RETURN - END IFL - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1 - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IFL - -CC -C Folder entries are now in queue. Output queue entries to screen. -CN - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THENN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))')_ - ELSE IF (CLASS) THENC - WRITE (6,'(1X,''Class'',/,1X,(''-''))')R - ELSE IF (SUBSCRIBE) THENw - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))')_ - ELSER - WRITE (6,'(1X,''News group'',X,''Status'',7X,R - & ''First Last'',/,1X,(''-''))') - END IFR - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1' - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THENU - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF( - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE. - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL,B - & FOLDER1_OWNER - END IF - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42)G - J = INDEX(FOLDER1_DESCRIP,' ')E - IF (J.GT.0) THENS - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1)e - END IFI - ELSEM - FSTATUS1 = ' ' - END IFt - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNTO - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0F - END IFe - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1),W - & F1_START,F1_NBULL,NEWS_NEW-1E - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),& - & F1_START,F1_NBULL,NEWS_NEW-1N - END IF - ELSEE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IFS - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER - IF (NEWS_TEST.AND.FLAG.NE.1) THENs - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - FOUND = .FALSE. - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - CALL READ_FOLDER_FILE_TEMP(IER) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSEF - FSTATUS1 = ' 'S - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND.R - & .NOT.BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THENP - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2)L - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1)R - ELSE - FOUND1 = .TRUE. - END IF - END IFI - FOUND = FOUND1 - ELSE - FOUND = .TRUE. - END IFN - END IFT - END DO - MORE = MORE.AND.FOUND - IF (MORE) THENE - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND) FLAG = 1C - END IF - END DOC - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_ASTA - CALL CLOSE_BULLFOLDER - END IFe - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNTR - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSEl - WRITE(6,1100) ! Else say there are moreI - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF) - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10). -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/)M - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -CI -C FUNCTION: Set access on folder for specified ID.0 -CT -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny accessT -C= - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'A - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENTK - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132L - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN) - ALL = .TRUE. - ELSE1 - ALL = .FALSE.E - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE.S - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE( - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDERd - NEWS = INDEX(FOLDER1,'.').GT.0E - - IF (NEWS) THEN( - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.'l - END IF - CALL OPEN_BULLNEWS - ELSER - CALL OPEN_BULLFOLDER ! Open folder file - END IF' - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN. - WRITE (6,N - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THENE - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE - CALL SET_FOLDER_FILE(1)3 - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTIONU - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),r - & STATUS='NEW',IOSTAT=IER)O - CLOSE (UNIT=3) - CALL RESET_PROTECTIONO - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')')N - RETURN( - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')')E - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0)l - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENs - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THENP - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THENl - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER)N - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')')T - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THENe - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILEA - REMOTE_SET_SAVE = REMOTE_SET_ - REMOTE_SET = .FALSE.P - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE' - CALL SET_FOLDER_FILE(0) - END IF - END IF' - ELSE - CALL DEL_ACL('*','R',IER) - END IFI - IF (.NOT.IER) THENH - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER)R - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN)I - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THENI - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)W - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER)D - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)')T - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THENF - CLOSE (UNIT=3) - INPUT = ' 'I - ELSE. - FILE_OPEN = .TRUE. - END IFe - ELSE - FILE_OPEN = .FALSE. - END IFL - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1: - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2F - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1)P - INPUT = INPUT(COMMA+1:)T - ELSE - ID = INPUT - INPUT = ' 'L - END IF - ILEN = TRIM(ID)1 - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THENO - WRITE (6,'('' ERROR: Cannot modify access'',R - & '' for owner of folder.'')') - ELSEO - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSEI - CALL ADD_ACL(ID,'R+W',IER) - END IFS - ELSE_ - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF, - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN)' - CALL SYS_GETMSG(IER)( - ELSE - WRITE(6,'('' Access modified for '',A,''.'')')F - & ID(:ILEN)' - END IF - END IFM - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUTi - IF (IER.NE.0) THEN - CLOSE (UNIT=3)D - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IFL - END DOE - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS - ELSEB - CALL OPEN_BULLFOLDER - END IFE - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER), - CALL CLOSE_BULLFOLDER - END IF - END IFD - - RETURND - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -CN -C SUBROUTINE CHKACL -CB -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check.) -C IERACL - Error returned for attempt to open file.( -CR - - IMPLICIT INTEGER (A-Z)R - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)'P - - CHARACTER*256 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THENp - IERACL = SS$_NORMAL.OR.IERACL - END IFE - - RETURNA - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -Cs -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C' -C PARAMETERS: -C FILENAME - Name of file to check.) -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C. - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME,E - & %VAL(ACL_ITMLST))S - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN' - READ_ACCESS = 0 - END IF_ - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))U - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF2 - - RETURN_ - END - - - - - SUBROUTINE SHOWACL(FILENAME). -CE -C SUBROUTINE SHOWACLf -Ct -C FUNCTION: Shows users who are allowed to read private bulletin. -Ct -C PARAMETERS: -C FILENAME - Name of file to check.E -C - IMPLICIT INTEGER (A-Z)_ - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAMEB - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAMEC - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER)L - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS, - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENE - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM. - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DOW - - RETURN' - - ENTRY WRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWSN - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMt - ELSE - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IF) - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWSN - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSEE - REWRITE (7,IOSTAT=IER) FOLDER_COM, - END IF' - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMI - ELSE_ - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IFR - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER))N - IF (NEWS_OPEN) THENE - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COMN - END IF - END DOP - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNC - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER))_ - IF (NEWS_OPEN) THENT - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM0 - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DOD - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURNL - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER))n - IF (NEWS_OPEN) THEN) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COMA - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURNT - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER))( - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COMN - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNE - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)n - - DO WHILE (REC_LOCK(IER))e - IF (NEWS_OPEN) THENw - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COME - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURNR - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER))N - IF (NEWS_OPEN) THENO - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DOT - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1O - - RETURNE - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))N - IF (NEWS_OPEN) THENE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DOS - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1E - - RETURNA - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))F - IF (NEWS_OPEN) THEN( - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COMO - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))L - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COMF - END IF - END DOC - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1h - - RETURNn - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))E - IF (NEWS_OPEN) THEN. - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COMA - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DOe - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNh - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z)n - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)'s - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC'n - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAMEt - - DO WHILE (REC_LOCK(IER)). - READ (4,IOSTAT=IER) USER_ENTRY - END DO) - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAMEE - - RETURNL - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER)B - - SAVE_USERNAME = USERNAMEE - - DO WHILE (REC_LOCK(IER)). - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAMEA - TEMP_USER = KEY_NAME - - RETURNE - - ENTRY READ_USER_FILE_HEADER(IER)B - - DO WHILE (REC_LOCK(IER))C - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM,A - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DON - - RETURND - - ENTRY WRITE_USER_FILE_NEW(IER) - - DO I=1,FLONGN - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I)E - END DO - - ENTRY WRITE_USER_FILE(IER)D - - DO WHILE (REC_LOCK(IER))) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DOD - - RETURNL - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - L - IMPLICIT INTEGER (A-Z)P - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - 2 - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_'_ - END DO: - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)F - - NEW_NEWS_ACCESS = E - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS' - - RETURNR - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - F - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO, - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C))E - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' ' - ELSE - FILE = FILE(:L) - END IF - END DO - - RETURNR - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z)C - - CHARACTER*(*) INPUT,FIND - - F = LEN(FIND) - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURNE - END DOP - - RETURN - END diff --git a/decus/vms93a/bulletin/bulletin6.for b/decus/vms93a/bulletin/bulletin6.for deleted file mode 100644 index 3f2daee..0000000 --- a/decus/vms93a/bulletin/bulletin6.for +++ /dev/null @@ -1,2510 +0,0 @@ -C -C BULLETIN6.FOR, Version 5/4/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:TRIM(NEWS_FOLDER)) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1(:TRIM(NEWS_FOLDER1)) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULL - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LAST - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMIT - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(81:84) = BUFFER(85:) - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',t - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',L - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',u - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))v - & //'.BULLFIL',STATUS='OLD',m - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)f - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')U - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8)D - NEMPTY = 0= - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00'N - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCKL - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFERI - END DO. - CALL WRITEDIR(ICOUNT-1,IER1)I - ICOUNT = ICOUNT + 1 - END IF - END DOM - - CLOSE (UNIT=9) - CLOSE (UNIT=2)_ - CLOSE (UNIT=10) - CLOSE (UNIT=1)N - - CALL RESET_PROTECTION - RETURNW - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -CS -C SUBROUTINE CONVERT_BULLFILE -CE -C FUNCTION: Converts bulletin data file to new format file. -CY -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'U - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')')i - - CALL CLOSE_BULLDIR. - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDERC - -100 READ (7,FMT=FOLDER_FMT,ERR=200)B - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER))2 - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD',O - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER,C - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,C - & FORM='UNFORMATTED')A - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN. - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER)) - NBLOCK = NBLOCK + 1E - SBLOCK = NBLOCKL - DO J=BLOCK,LENGTH+BLOCK-1L - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK)2 - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IFL - - CLOSE (UNIT=10) - CLOSE (UNIT=1)T - - CALL CLOSE_BULLDIRT - GOTO 100& - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -C -C SUBROUTINE CONVERT_BULLFOLDER -CA -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC') - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'M - - INCLUDE '($FORIOSDEF)'v - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']'))T - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1))E - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',R - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO& - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE')A - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0)L - IF (ASK_SIZE.EQ.184) THENL - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)',= - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPI - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)',R - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)_ - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN ' - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST) - ELSEO - F_LAST = 0 - END IFN - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBC - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LASTO - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSEO - F_NUMBER = 0 - DO WHILE (IER.EQ.0)D - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)_ - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPS - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER)) - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)= - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0)Y - END IFF - DO WHILE (FILE_LOCK(IER,IER1))t - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))1 - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',F - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN: - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DOS - IF (IER.EQ.FOR$IOS_FILNOTFOU) THENG - F_NEWEST_BTIM(1) = 0L - F_NEWEST_BTIM(2) = 0 - ELSE= - CALL READDIR(0,IER)& - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATEL - NEWEST_TIME = TIMEO - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IFL - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE)I - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0D - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7)O - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE)& - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURNA - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -C -C SUBROUTINE CONVERT_BULLNEWS -CM -C FUNCTION: Converts bulletin NEWS file to new format. -C - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'N - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. '' - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME))F - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']'))E - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1O - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1))S - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED',A - & ORGANIZATION='INDEXED',IOSTAT=IER,F - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DON - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',) - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600,E - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER,n - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0I - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE)U - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE)r - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0& - NEWS_F_END = 0e - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108) - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:)H - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1 - IF (LMOVE.LE.0) THENN - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP - ELSEl - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE))I - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):)' - END IFI - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7)e - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)I - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE)6 - - CALL RESET_PROTECTION - - RETURNU - END - - - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C= -C FUNCTION: Converts user file to new format which has 8 bytes added. -Ci - - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'N - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIMEH - - WRITE (6,'('' Converting data files to new format. Please wait.'')')I - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))E - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,2 - & KEY=(1:12:CHARACTER))& - INQUIRE (UNIT=9,RECORDSIZE=RECL)E - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')')W - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')_ - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE), - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)D - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN8 - CALL SET_PROTECTION' - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',U - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IFR - - IF (IER.NE.0) THEND - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)U - CALL SYS_GETMSG(IER1)I - CALL RESET_PROTECTIONN - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X( - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0U - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR.I - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50f - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THENE - TEMP_USER = BUFFER(:12)X - LOGIN_DATE = BUFFER(13:23)D - LOGIN_TIME = BUFFER(24:31)A - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))N - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1))L - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM)) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,) - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF' - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM,Q - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag! - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN_ - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFN - END DO - END IF& - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4)O - - CALL RESET_PROTECTION - - RETURNF - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIRD -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -CI -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.S -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -CI - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'N - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXTS - - COMMON /KEEPLOCK/ KEEPLOCKI - DATA KEEPLOCK/.FALSE./O - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - CHARACTER*4 CFOLDER_NUMBER_ - - CHARACTER*8 NEWS_KEYS - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER))1 - IF (REMOTE_SET.EQ.4) THENE - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DON - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSEL - DIR_NUM = 0 - END IFE - END IFL - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURNG - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THENA - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIRE - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER, - END IFA - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0& -C -C Check to see if cleanup of empty file space is necessary, which isA -C defined here as being 50 blocks (200 128byte records). Also checkL -C to see if cleanup was in progress but didn't properly finish. -CT - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THENS - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP')R - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSEC - IF (.NOT.REMOTE_SET) THENT - DO WHILE (REC_LOCK(IER))O - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY_ - ELSE - READ(2,KEYGE=NEWS_KEY(ICOUNT,FOLDER_NUMBER) - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRYI - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSEE - READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER) - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRYO - END IFT - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START)D - ICOUNT = ICOUNT - 1O - READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER)= - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IFO - END IF - IF (IER.EQ.0) THEN - NUM = GET_INTEGER(%REF(NEWS_MSG_KEY)) - IF (NUM.NE.FOLDER_NUMBER) THEN - IER = 36N - UNLOCK 2L - ELSE_ - MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:))) - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND.R - & MSG_NUM.GT.F_START) THEN - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAMEW - & (FOLDER,IER2) - F_START = MSG_NUMS - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IF - END IFF - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THENO - ICOUNT = MSG_NUME - BULLETIN_NUM = ICOUNT - END IF - END IF - ELSEC - IF (DIR_NUM.EQ.ICOUNT-1) THENL - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97)E - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) A - & BULLDIR_ENTRY - END IFI - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 - END IFO - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97)F - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) E - & BULLDIR_ENTRY - END IFE - END IF - END IFW - END DOF - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBINE - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSER - DIR_NUM = -1P - END IFA - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IF' - - IF (IER.EQ.0) THEN1 - IF (.NOT.REMOTE_SET) THEN - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1 - END IFR - END IFE - END IF - - RETURNS - - END - - - - CHARACTER*8 FUNCTION NEWS_KEY(ICOUNT,FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z)R - - CHARACTER*4 INTEGER_KEY - - NEWS_KEY = INTEGER_KEY(FOLDER_NUMBER)//INTEGER_KEY(ICOUNT)M - - RETURNE - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM)G - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z)E - - INTEGER TEMPR - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM9 - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I)' - END DO, - - RETURN' - END - - - SUBROUTINE READDIR_KEYGE(IER) -C= -C SUBROUTINE READDIR_KEYGE_ -CG -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified.' -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS:) -C IER - If 0, no entry found. Else contains message number. -C) - - IMPLICIT INTEGER (A - Z)A - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC') - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/2/N - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFILB - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMG - - CHARACTER*4 INTEGER_KEY - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.4.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRYM - ELSEE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THENC - NUM = GET_INTEGER(%REF(NEWS_MSG_KEY))U - IF (NUM.NE.FOLDER_NUMBER) THEN - IER = 36T - UNLOCK 2 - ELSE - MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:))) - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.4.AND.MSG_NUM.NE.0) THEN n - IF (MSG_NUM.GT.NEWS_F_END) THENo - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36r - UNLOCK 2 - END IF - END IF - END IF - END IF - ELSEU - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '//_ - & BULLDIR_ENTRY(66:97), - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF= - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFILP - ELSE - IER = 0 - DIR_NUM = -1R - END IF - ELSES - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THENU - IF (BTEST(BULL_USER_CUSTOM,3)) THEN) - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10 - END IF - END IF - - RETURN= - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IFO - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN( - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z): - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY(5:)),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY(5:)),%DESCR(EX_BTIM)) - IF (POSTTIME) CALL COPY2(MSG_BTIM,NEWS_POST_BTIM)A - DESCRIP = NEWS_DESCRIP, - FROM = NEWS_FROM B - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IFe - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11)t - EXTIME = DATETIME(13:23)1 - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME(:11)Z - TIME = DATETIME(13:23)N - - RETURNU - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -CT -C SUBROUTINE WRITEDIR -CW -C FUNCTION: Writes the entry for the specified bulletin in the' -C directory file.U -CI -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.( -C If 0, write the header of the directory file. -C OUTPUTS:W -C IER - Error status from WRITE. -CB - - IMPLICIT INTEGER (A - Z)O - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'O - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*8 NEWS_KEY' - - CONV = .TRUE. - - GO TO 10L - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE.O - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADERr - ELSE - IER = -1, - IF (DIR_NUM.EQ.0) THENI - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSEE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF' - END IF - IF (IER.NE.0) THENE - IF (REMOTE_SET.EQ.4) THEN - IER = 0I - ELSE_ - READ (2,KEYID=0,KEY=0,IOSTAT=IER)D - IF (IER.EQ.0) THEN ) - REWRITE (2,IOSTAT=IER) BULLDIR_HEADERI - END IF - END IFC - END IFO - IF (IER.NE.0) THENK - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IFE - END IF1 - END IF - ELSE_ - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRYR - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRYO - END IFM - END IFO - IF (IER.NE.0) THENA - IF (REMOTE_SET.EQ.4) THEN - DO WHILE (REC_LOCK(IER).AND. - & BULLETIN_NUM.NE.NEWS_F_END+1) - READ (2,KEYID=1,KEY=NEWS_KEY(C - & BULLETIN_NUM,FOLDER_NUMBER),IOSTAT=IER)E - END DO - ELSEA - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IF, - IF (REMOTE_SET.EQ.4.AND.w - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN( - CALL SPECIAL_NEWSDIR_ENTRY(IER)M - ELSE IF (IER.EQ.0) THENM - IF (REMOTE_SET.EQ.4) THENE - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEND - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IFD - END IFN - END IF - END IFX - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXITS - - DIR_NUM = -1I - - RETURNE - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER)E - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - DIMENSION BTIM(2) - - CHARACTER*8 NEWS_KEY6 - - READ (2,KEYID=3,KEY=NEWS_MSGID,IOSTAT=IER) INPUT(:84)R - DO WHILE (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).NE.FOLDER_NUMBER) - READ (2,IOSTAT=IER) INPUT(:84) - IF (NEWS_MSGID.NE.INPUT(21:84)) IER = 2 - END DO - - IF (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).EQ.FOLDER_NUMBER) THEN , - IER = 2 - RETURN - END IFN - -10 IER1 = 0N - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=1,KEYGT=NEWS_KEY(NEWS_F_END,FOLDER_NUMBER), - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO O - DO WHILE (IER1.EQ.0), - FNUM = GET_INTEGER(%REF(INPUT)). - IF (FNUM.NE.FOLDER_NUMBER) THEN5 - IER1 = 2A - ELSE - CALL GET_MSGKEY(%REF(INPUT(85:)),%DESCR(BTIM))& - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IFR - F_COUNT = F_COUNT + 1 - NEWS_F_END = GET_INTEGER(%REF(INPUT(5:))) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO A - END IF - END DON - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IF) - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY A - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10B - ELSEE - F_COUNT = F_COUNT + 1L - END IF - - RETURNR - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' , - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*8 NEWS_KEY - - CHARACTER*4 INTEGER_KEY - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM)4 - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM)F - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE)) - END IFF - - RETURN= - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*4 INTEGER_KEY - - CHARACTER*8 NEWS_KEY - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THENT - CALL COPY2(NEWS_POST_BTIM,MSG_BTIM)U - END IF - , - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - IF (LOCAL_POST) THENI - CALL COPY2(NEWS_POST_BTIM,MSG_BTIM)I - END IFN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIPE - NEWS_FROM = FROMI - NEWS_BLOCK = BLOCKE - NEWS_LENGTH = LENGTH( - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)L - NEWS_MSG_KEY = NEWS_KEY(MSG_NUM,FOLDER_NUMBER) - NEWS_MSG_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY_ - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - NEWS_EX_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY - ELSEH - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IFD - - RETURNE - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - I - COMMON /KEYID/ NEWS_KEYIDE - - COMMON /KEEPLOCK/ KEEPLOCKI - ) - CHARACTER*4 INTEGER_KEY - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 4E - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY)1 - CALL READDIR_KEYGE(NDEL)) - KEEPLOCK = .FALSE.D - NEWS_KEYID = 2R - - RETURNT - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C, -C SUBROUTINE READACLE -CR -C FUNCTION: Reads the ACL of a file. -CB -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information.E -CN - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*)I - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENTZ - CTXT = 0 - END IF. - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)I - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+0 - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))),7 - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE., - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR.T - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1I - END_ID = INDEX(ACLSTR,',ACCESS') - 1D - IF (ACLSTR(END_ID:END_ID).EQ.']') THENA - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII))' - IF (ACLSTR(START_ID:START_ID).NE.','.AND.S - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IFE - END DO_ - IF (ASCII) THEN - START_ID = START_ID + 1T - END_ID = END_ID - 1I - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1L - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF3 - END IFL - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THENM - IF (ACC_TYPE.EQ.1) THENT - WRITE (6,'(A - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(_ - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF( - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN: - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)S - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2) - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)R - OUTLEN = 1 - ELSE_ - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO' - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILEL - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLUSER.INC'A - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THENS - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')M - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)E - ELSE - CALL ENABLE_CTRLT - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFT - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW',t - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))E - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)C - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX)8 - END DOL - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9)T - - RETURNU - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z)G - , - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)E - CALL ENABLE_CTRL_EXIT - - RETURN2 - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -CT -C SUBROUTINE COPY_ACL -Ce -C FUNCTION: -C Copy ACLs from one file to another fileU -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILEE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl outputR - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,)= - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURNI - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C3 -C SUBROUTINE COPY_ACL1F -C( -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines) -C since must convert location of string into a character string. -C% - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,). - ! Read input file acl= - - IF (.NOT.IER) THENR - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT1 - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,L - & %LOC(ACLENT))F - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist) - IER = SYS$CHANGE_ACL! - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,)+ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied firstE - END DO - RETURN - END IFI - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output filet - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT,t - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DOt - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC'U - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./ - - IF (CHECKED) RETURN - - CHECKED = .TRUE.T - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C)D - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORYT - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE) - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE - CALL ADD_DIRECTORY(BULLNEWS_FILE)E - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - END IFE - - CALL CHECK_DIR(FOLDER_DIRECTORY)E - CALL CHECK_DIR(NEWS_DIRECTORY) - - CALL ADD_DIRECTORIES - - RETURN - ENDT - A - - - SUBROUTINE ADD_DIRECTORIES - - INCLUDE 'BULLFILES.INC'. - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE)s - - RETURN. - END - - - - SUBROUTINE CHECK_DIR(DIRECTORY) - - IMPLICIT INTEGER (A-Z)) - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - IF (.NOT.SYS_TRNLNM_SYSTEM(DIRECTORY,TEST)) RETURN) - - CALL SYS_TRNLNM(DIRECTORY,TEST1)c - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER)h - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST)o - END DOs - - IF (TEST.NE.TEST1) THEN - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER)' - CLOSE(UNIT=3,STATUS='DELETE') - CALL ENABLE_PRIVS/ - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)')F - & TEST1(:TRIM(TEST1)) - CALL EXIT - END IF - DIRECTORY = TEST1 - ELSE( - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - END IF_ - - RETURN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z)) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:). - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:). - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY N - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':' - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURN& - END= diff --git a/decus/vms93a/bulletin/bulletin7.for b/decus/vms93a/bulletin/bulletin7.for deleted file mode 100644 index ed39fdb..0000000 --- a/decus/vms93a/bulletin/bulletin7.for +++ /dev/null @@ -1,2248 +0,0 @@ -C -C BULLETIN7.FOR, Version 4/29/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER1_NAME.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - IF (.NOT.NEW_DATE) THEN - DIFF = COMPARE_DATE(NEWEST_DATE,DATE) - IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_TIME,TIME) - END IF - IF (DIFF.GE.0) NEW_DATE = .TRUE. - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(:11) - TIME = TODAY_TIME(13:23) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX))E - CALL ADD_2_ITMLST_WITH_RETr - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))p - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1M - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT)L - - IMPLICIT INTEGER (A-Z)a - - CHARACTER*(*) INPUT,OUTPUTt - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))N - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist( - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IF - - RETURNN - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1)i - - IMPLICIT INTEGER (A-Z)b - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./o - - IF (INIT) THEN - FILE_LOCK = 1e - INIT = .FALSE. - ELSEa - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)i - IF (IER1.EQ.RMS$_FLK) THENy - FILE_LOCK = 1n - CALL WAIT_SEC('01') - ELSEl - FILE_LOCK = 0 - INIT = .TRUE.l - END IFo - ELSE - FILE_LOCK = 0 - IER1 = 0) - INIT = .TRUE. - END IF - END IFD - - RETURNH - END - - - - SUBROUTINE ENABLE_CTRLI - - IMPLICIT INTEGER (A-Z)P - - COMMON /CTRLY/ CTRLY) - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODED - - QUIT = 1E - - ENTRY ENABLE_CTRL_EXITE - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0D - IF (QUIT.EQ.1) LEVEL = LEVEL - 1O - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF. - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IFI - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,)F - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL CLOSE_TAG - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z)G - - COMMON /CTRLY/ CTRLYE - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/n - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN_ - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it.I -CU - IMPLICIT INTEGER (A - Z)f - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'I - - CHARACTER FILENAME*132,BUFFER*128 - - CALL OPEN_BULLDIR_SHAREDO - -CI -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C* - - DO WHILE (REC_LOCK(IER))A - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER2 - END DOG - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN, - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for''( - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER))Q - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSEn - CALL SYS_GETMSG(IER1)C - END IFE - CALL CLOSE_BULLDIRS - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER)T - ICOUNT = BLOCK - DO J=1,LENGTHR - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF$ - WRITE(11) BUFFER_ - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL_ - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',H - & '*.BULLFIL') - IER = 1L - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR',E - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1S - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IFN - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))E - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',N - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,T - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',E - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THENP - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',F - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,I - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')T - IF (IER.NE.0) THEN& - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER)U - IF (IER1.EQ.0) THEND - WRITE (6,'('' IOSTAT error = '',I)') IERT - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11)T - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,)C - RETURN - END IF - END IF( - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0_ - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULLR - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)_ - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for''E - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER))U - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSED - CALL SYS_GETMSG(IER1)M - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURNI - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0)E - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR, - CALL OPEN_BULLDIR ! Open with no sharingL - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header, - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//E - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*',C - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURNV - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)T -C -C SUBROUTINE CLEANUP_DIRFILE -C: -C FUNCTION: Reorder directory file after deletions.L -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process_ -C was abnormally terminated. -C. - IMPLICIT INTEGER (A - Z)I - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVEA - - CHARACTER*12 DATE_SAVE,EXDATE_SAVE - CHARACTER*12 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRYA - DATE_SAVE = DATEG - TIME_SAVE = TIMEN - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIMEE - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL)C - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in fileD - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL). - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DOL - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER)) - RETURN - END IFI - LENGTH = -LENGTH ! Indicate starting point by writingE - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion( - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1R - DO K=J,NBULLN - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY)y - END IF - END DOd - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_QM - BLOCK_SAVE = BLOCK) - MSG_NUM_SAVE = MSG_NUMB - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST)_ - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THENA - MOVE_TO = MSG_NUM_SAVE + 1F - MOVE_FROM = MSG_NUM + 1 - END IF - END DOb - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DOI - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessaryE - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL2 - CALL READDIR(J,IER)E - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of filen - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IFI - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IFr - - CALL WRITEDIR(0,IER)a - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVEI - DATE = DATE_SAVEE - TIME = TIME_SAVE. - EXDATE = EXDATE_SAVES - EXTIME = EXTIME_SAVE) - - RETURNV - END - - - SUBROUTINE SHOW_FLAGS -CA -C SUBROUTINE SHOW_FLAGS -CD -C FUNCTION: Show user flags._ -CE - IMPLICIT INTEGER (A - Z)- - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THENT - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF1 - -CE -C Find user entry in BULLUSER.DAT to obtain flags._ -CT - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user fileI - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THENG - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURNI - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))s - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THENs - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.E - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.( - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - END IF6 - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THENA - WRITE (6,'('' No flags are set.'')') - END IF( - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER - - RETURNI - END - - - SUBROUTINE SET2(FLAG,NUMBER)A - - IMPLICIT INTEGER (A-Z)P - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1))P - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER)C - - IMPLICIT INTEGER (A-Z)I - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1))- - - RETURN- - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z)b - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))i - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL)t -Cl -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -Cm - - IMPLICIT INTEGER (A-Z)s - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF ***s - PARAMETER pscan$_BEGIN = '00000000'Xh - PARAMETER pscan$_ACCOUNT = '00000001'X - PARAMETER pscan$_AUTHPRI = '00000002'Xa - PARAMETER pscan$_CURPRIV = '00000003'X. - PARAMETER pscan$_GRP = '00000004'Xs - PARAMETER pscan$_HW_MODEL = '00000005'X - PARAMETER pscan$_HW_NAME = '00000006'Xr - PARAMETER pscan$_JOBPRCCNT = '00000007'Xd - PARAMETER pscan$_JOBTYPE = '00000008'Xe - PARAMETER pscan$_MASTER_PID = '00000009'X - PARAMETER pscan$_MEM = '0000000A'Xd - PARAMETER pscan$_MODE = '0000000B'X - PARAMETER pscan$_NODE_CSID = '0000000C'X - PARAMETER pscan$_NODENAME = '0000000D'X - - PARAMETER pscan$_OWNER = '0000000E'X- - PARAMETER pscan$_PRCCNT = '0000000F'X - PARAMETER pscan$_PRCNAM = '00000010'X - PARAMETER pscan$_PRI = '00000011'Xl - PARAMETER pscan$_PRIB = '00000012'X - PARAMETER pscan$_STATE = '00000013'XE - PARAMETER pscan$_STS = '00000014'XE - PARAMETER pscan$_TERMINAL = '00000015'X - PARAMETER pscan$_UIC = '00000016'X - PARAMETER pscan$_USERNAME = '00000017'X - PARAMETER pscan$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER pscan$_END = '00000019'XC - PARAMETER pscan$k_type = '00000081'XI - PARAMETER pscan$M_OR = '00000001'XH - PARAMETER pscan$M_BIT_ALL = '00000002'X - PARAMETER pscan$M_BIT_ANY = '00000004'X - PARAMETER pscan$M_GEQ = '00000008'X - PARAMETER pscan$M_GTR = '00000010'X - PARAMETER pscan$M_LEQ = '00000020'X - PARAMETER pscan$M_LSS = '00000040'X - PARAMETER pscan$M_PREFIX_MATCH = '00000080'XC - PARAMETER pscan$M_WILDCARD = '00000100'XA - PARAMETER pscan$M_CASE_BLIND = '00000200'XL - PARAMETER pscan$M_EQL = '00000400'X - PARAMETER pscan$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER pscan$S_OR = 1C - PARAMETER pscan$V_OR = 0C - PARAMETER pscan$S_BIT_ALL = 1 - PARAMETER pscan$V_BIT_ALL = 1 - PARAMETER pscan$S_BIT_ANY = 1 - PARAMETER pscan$V_BIT_ANY = 2 - PARAMETER pscan$S_GEQ = 1 - PARAMETER pscan$V_GEQ = 3 - PARAMETER pscan$S_GTR = 1 - PARAMETER pscan$V_GTR = 4 - PARAMETER pscan$S_LEQ = 1 - PARAMETER pscan$V_LEQ = 5 - PARAMETER pscan$S_LSS = 1 - PARAMETER pscan$V_LSS = 6 - PARAMETER pscan$S_PREFIX_MATCH = 1E - PARAMETER pscan$V_PREFIX_MATCH = 7D - PARAMETER pscan$S_WILDCARD = 1O - PARAMETER pscan$V_WILDCARD = 8V - PARAMETER pscan$S_CASE_BLIND = 1R - PARAMETER pscan$V_CASE_BLIND = 9) - PARAMETER pscan$S_EQL = 1 - PARAMETER pscan$V_EQL = 10V - PARAMETER pscan$S_NEQ = 1 - PARAMETER pscan$V_NEQ = 11i - BYTE %FILL (2)E - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listP - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IFT - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistE - - IER = 1 - TERMINAL(:1) = CHAR(0)1 - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0))H - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.E - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IERE - - RETURNV - END - - - - - - SUBROUTINE OPEN_USERINFOo -Ce -C SUBROUTINE OPEN_USERINFOR -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -CM - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC'O - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)G - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)m - DATA USERINFO_READ /.FALSE./i - - EQUIVALENCE (LAST_READ_BTIM(1,1),LAST(1,1)) - DIMENSION LAST(2,FOLDER_MAX)E - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED' - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LASTM - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAXN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IFE - END DO - END IFE - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - END IF1 - - IF (IER.NE.0) THEN) - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD',d - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2)Y - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT fileM - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER)F - END IFB - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THENU - DO I=1,FOLDER_MAXL - LAST_READ_BTIM(1,I) = READ_BTIM(1)E - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IFL - END IF - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIMS - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU)))A - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAXI - LAST_SYS_BTIM(1,I) = 0F - LAST_SYS_BTIM(2,I) = 0_ - END DO - END IF - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINFM - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM)C - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ)R - - USERINFO_READ = .TRUE.O - - RETURN - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -CR -C SUBROUTINE READ_NEWS_USERINFO -CM - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC'T - - CHARACTER*(*) NAMES - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1)))' - ELSEC - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2)))C - END IFM - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READL - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU)))M - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF( - IF (IER.NE.0) THENR - DO I=1,FOLDER_MAX_ - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IFE - - RETURN - END - - - - - SUBROUTINE UPDATE_USERINFOA -CE -C SUBROUTINE UPDATE_USERINFO -Cr -C FUNCTION: Updates the latest message read times for each folder. -CV - IMPLICIT INTEGER (A - Z)S - - INCLUDE 'BULLUSER.INC'D - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)w - - EQUIVALENCE (LAST_READ_BTIM(1,1),LAST(1,1)) - DIMENSION LAST(2,FOLDER_MAX) - - IF (.NOT.USERINFO_READ) RETURNr - - DIFF = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF.AND.FNUM.LE.FOLDER_MAX) - DIFF = LAST_READ_BTIM(1,FNUM).NE.OLD_LAST_READ_BTIM(1,FNUM)E - IF (.NOT.DIFF) THEN( - DIFF = LAST_READ_BTIM(2,FNUM).NE.OLD_LAST_READ_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1L - END DO_ - - DIFF1 = .FALSE. - FNUM = 1_ - - DO WHILE (.NOT.DIFF1.AND.FNUM.LE.FOLDER_MAX)N - DIFF1 = LAST_SYS_BTIM(1,FNUM).NE.OLD_LAST_SYS_BTIM(1,FNUM) - IF (.NOT.DIFF1) THEN - DIFF1 = LAST_SYS_BTIM(2,FNUM).NE.OLD_LAST_SYS_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1G - END DOO - - DIFF2 = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF2.AND.FNUM.LE.FOLDER_MAX) - DIFF2 = LAST_NEWS_READ(1,FNUM).NE.OLD_LAST_NEWS_READ(1,FNUM) - IF (.NOT.DIFF2) THEN - DIFF2 = LAST_NEWS_READ(2,FNUM).NE.OLD_LAST_NEWS_READ(2,FNUM) - END IF - FNUM = FNUM + 1 - END DOT - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHARED_ - - IF (DIFF) THENL - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IFl - - IF (DIFF1) THEN - LU = TRIM(USERNAME)E - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))M - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF( - - IF (DIFF2) THEN - LU = TRIM(USERNAME)R - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))A - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READL - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN( - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1)))N - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2)))n - END IF - END IFC - - CALL CLOSE_BULLINF_ - - RETURNN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM)N - - IMPLICIT INTEGER (A-Z)U - - INTEGER BTIM(2) - - CHARACTER*(*) TIME_ - - CHARACTER*24 TIME1f - - TIME1 = TIME(FIRST_ALPHA(TIME):)X - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:)I - END DON - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM)I - END IFE - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -CS -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -Ci -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have beenL -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit.N -CY - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLFOLDER.INC'I - - INCLUDE 'BULLUSER.INC'T - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG). - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHA - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATEC - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUMI - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder infoO - ELSE IF (.NOT.LOGIN_SWITCH) THENE - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login timeE - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't. - END IF ! think it's called via LOGINT - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM0 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)C - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flagK - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENR - CALL SET2(NEW_MSG,FOLDER_NUMBER)E - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.I - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THENL - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND.L - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM)e - ELSEp - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)I - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN) - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1L - END IF - END IF - END IFY - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND. - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messagesE - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IFO - END IF - END DOE - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)d - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THENL - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),T - & F_NEWEST_BTIM), - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM). - ! No. Unread system messages?D - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IFF - END IFO - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS)S - IF (INCMD(:4).EQ.'SHOW') THEN - SAVE_FOLDER_Q1 = 0 - RETURNL - END IF - IF (NEW_MESS.OR.NEWS_MESS) THENL - WRITE (6,'('' Type SELECT followed by foldername to'',L - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN. - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0F - DO WHILE (NEW_COUNT.GT.0)F - NEW_COUNT = NEW_COUNT / 10S - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletinsR - ELSEE - BULL_POINT = 0: - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)L - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)T - END IF( - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSEo - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)E - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1S - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER)Y - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERU - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder ''A - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder ''R - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF_ - DIFF = 0 - END IF - END IFI - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERo - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THENM - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORYN - BULL_POINT = SAVE_BULL_POINT - END DOE - END IF_ - END IF - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS)E - CALL EXITN - END IFT - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS! - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLFOLDER.INC'n - - INCLUDE 'BULLUSER.INC'h - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUMo - DATA SAVE_FOLDER_Q1/0/R - - COMMON /READIT/ READITM - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATER - CHARACTER*4 SEPARATE - D - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM)U - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders. - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENe - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.a - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THENI - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSIONL - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.X - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR.A - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C= -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -Co - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THENt - FOLDER_FLAG = IBSET(FOLDER_FLAG,2)N - CALL REWRITE_FOLDER_FILE(IER)( - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - CALL MODIFY_SYSTEM_LIST(1)r - END IFr - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURNb - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLFOLDER.INC'r - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER))_ - - RETURNO - END diff --git a/decus/vms93a/bulletin/bulletin8.for b/decus/vms93a/bulletin/bulletin8.for deleted file mode 100644 index e92ba25..0000000 --- a/decus/vms93a/bulletin/bulletin8.for +++ /dev/null @@ -1,2049 +0,0 @@ -C -C BULLETIN8.FOR, Version 3/3/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).GT.0) THEN - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(READ_EFS(UNIT_INDEX), - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/ - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(WRITE_EFS(UNIT_INDEX), - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(WRITE_EFS(UNIT_INDEX), - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)E - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK)M - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE)G - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV)R - - ILEN = READ_IOSB(2,UNIT_INDEX)T - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER))L - - REMOTE_SET = .FALSE.O - REC_SAVE(UNIT_INDEX) = 0N - USERNAME = USER_SAVE(UNIT_INDEX)I - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX)U - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THEN5 - ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX)) - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX))F - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND.L - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THENS - CALL CHECK_BULLETIN_PRIV(USERNAME)R - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV) - END IFX - END IF - END IFA - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND.E - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IFD - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN, - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:)))C - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE A - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folderT - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE ' - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFOU - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real._ - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:)))L - ELSER - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),I - & %REF(BUFFER(9:))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1)E - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IFf - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:)))' - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24o - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1),T - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1),r - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),R - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))B - END IFX - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1)/ - IF (IER.AND.IER1) THEN - IF (SYSLOG) THENR - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSEB - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IFQ - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER= - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX)I - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message lineA - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1R - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP))) - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + Pa - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + PI - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM)( - P = 4 + PC - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)E - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND.W - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)B - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN( - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit presentM - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THENM - SYSTEM = 0M - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IFX - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREAE - DO I=1,11A - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0'T - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//E - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IFF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + PX - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THENB - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL)I - P = 4 + PA - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0)T - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFILC - OENTRY = OUT_HEAD(UNIT_INDEX)K - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTHS - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)F - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THENA - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin, - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder fileL - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodesD - TEMP_USER = ':'A - DO WHILE (TEMP_USER(:1).EQ.':')A - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME_ - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node thatA - END IF ! originated the messageY - END DOE - IF (TEMP_USER(:1).NE.':') THENN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE._ - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000( - END IF - CALL SETUSER(USERNAME) ! Reset to original usernameI - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THENE - CALL ERRSNS(IDUMMY,IDUMMY,INODE)) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR.K - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THENM - DELETE (4) - END IFE - ELSEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH)G - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER)L - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127))N - I = I + 128R - END DOI - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entryD - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)T - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THENE - CALL READDIR(ICOUNT,IER)N - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THENI - BUFFER(5:) = BULLDIR_ENTRYI - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0)U - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL)K - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)N - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1E - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)S - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)W - CALL SET_FOLDER_FILE(0)C - CALL OPEN_BULLDIRI - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)U - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER)4 - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENW - CALL CLOSE_BULLDIRE - BUFFER = 'ERROR: Cannot find message to delete.', - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000T - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROMT - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN_ - CALL CLOSE_BULLDIR_ - BUFFER = 'ERROR: Insufficient privileges to delete message.') - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE)D - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read messageK - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)R - CALL SET_FOLDER_FILE(0)W - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX)X - DO I=BLOCK,BLOCK+LENGTH-1A - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)D - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX)N - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTHM - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)_ - OUT_SAVE(UNIT_INDEX) = OENTRYC - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)N - CALL SET_FOLDER_FILE(0)A - CALL OPEN_BULLDIR - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5D - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT)( - P = 4 + P - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIRD - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000D - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP))O - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + PO - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + PR - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P/ - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV()I - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR.) - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000I - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTHA - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE), - WRITE (1'NBLOCK+I) INQUEUEU - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletinL - IF (NEW_LENGTH.GT.0) THEN, - NEMPTY = NEMPTY + LENGTHE - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1D - END IF - CALL WRITEDIR(ICOUNT,IER)C - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1),N - & BTEST(MSGTYPE,2),EXDATE,EXTIME)N - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General?L - END IF - CALL WRITEDIR(ICOUNT,IER)C - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P4 - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + PR - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)L - CALL OPEN_BULLDIRM - CALL READDIR(BULL_DELETE,IER)/ - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENA - CALL CLOSE_BULLDIRV - BUFFER = 'ERROR: Cannot find message to undelete.'K - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000N - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM, - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN1 - CALL CLOSE_BULLDIR_ - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000T - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + PE - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + PO - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0)P - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER)M - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG)C - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)R - CALL OPEN_BULLUSER_SHAREDM - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) O - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAGL - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG( - NEW_FLAG (I) = 0I - END DOR - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER,N - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSERQ - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast messageQ - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THENo - IF (SCRATCH(UNIT_INDEX).EQ.0) THENQ - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IFN - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:)))N - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX))C - IF (ILEN.GT.20) THENN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER) - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER)A - END IFI - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0 - DO WHILE (IER.EQ.0)R - CALL READ_FOLDER_FILE(IER)_ - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER)I - END IF' - END DO - CALL CLOSE_BULLFOLDERI - END IFN - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IFR - - RETURNR - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLUSER.INC'P - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC's - - PARAMETER MAXLINK = 10S - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)U - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)X - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12O - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX)Y - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)L - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFON - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),R - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX)L - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX)O - END IFE - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND.F - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND.( - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THENA - DIFF1 = -1U - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND._ - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0M - END IF. - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IFI - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURNU - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM). - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM)E - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)L - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX)R - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)I - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)M - - RETURN( - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THENR - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS)0 - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV)Y - END IFE - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT)T -C -C SUBROUTINE GETACC -CE -C FUNCTION: -C To get account of present process. -C OUTPUTS:E -C ACCOUNT - ACCOUNT owner of present process.A -C. - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -CH -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS:( -C STS - Status word of present process.: -C( - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistI - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoE - - RETURN) - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z)B - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB)M - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)'0 - - DATA INIT /.TRUE./f - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSEN - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - REC_LOCK = 1L - ELSE - REC_LOCK = 0% - INIT = .TRUE. - END IF - END IF( - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT)E - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN! - END DO - RETURNl - END - - SUBROUTINE SYS_GETMSG(IER)e - - IMPLICIT INTEGER (A-Z)A - - CHARACTER*80 MESSAGEt - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURNd - END - - - - SUBROUTINE HELP(LIBRARY)O - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFOE -C( -C SUBROUTINE GET_NODE_INFOS -CT -C FUNCTION: Gets local node name and obtains node names fromD -C command line.U -CG - - IMPLICIT INTEGER (A-Z)T - - EXTERNAL CLI$_ABSENTI - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10): - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256,PASSWORD*32,TEMP_USER*12 - - NODE_ERROR = .FALSE.N - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THENN - LOCAL_NODE = LOCAL_NODE(2:)E - L_NODE = L_NODE - 1I - END IF - - NODE_NUM = 0 ! Initialize number of nodesC - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',')N - IF (COMMA.GT.0) THENN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1)E - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE1 - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF= - NLEN = TRIM(NODES(NODE_NUM))0 - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN) - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN). - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1E - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD)v - IF (TRIM(PASSWORD).EQ.0) THENE - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DOT - NODE_ERROR = .TRUE. - RETURNG - END IFd - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')')' - END IF - END DO - END IFS - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1D - LOCAL_NODE_FOUND = .TRUE.L - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUMR - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED',I - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM)O - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IFC - END DOR - END DO - ELSEC - LOCAL_NODE_FOUND = .TRUE.U - END IFS - RETURNB - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C! -C SUBROUTINE SET_FOLDER_FILE1 -CX -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE,) -C if = 1, set FOLDER1_FILEA -CN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'U - - IF (NUM.EQ.0) THENC - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE)N - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE)_ - END IFT - - RETURNC - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C -C SUBROUTINE SET_FILE -C - IMPLICIT INTEGER (A-Z)e - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILEE - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERE - ELSE - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//B - & '.]' - END IF0 - - RETURN) - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12M - - DATA UPDATE/.FALSE./M - - UPDATE = .TRUE. - - ENTRY SET_BULLFIL_UPDATEC - - UPDATE = .NOT.UPDATE( - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) O - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATEG - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):) - - M = INDEX(FILDATE,'-')E - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3)A - P - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN N - FOLDER_FILE = FOLDER1_FILE - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THENM - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHARED) - END IF - END IF) - E - IF (UPDATE) THEN - READ (1'1) NBLOCK, - REWRITE (1) NBLOCK + LENGTH - UPDATE = .FALSE. - END IF - - RETURNB - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THENA - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE/ - MINGT0 = MIN(I,J)M - END IF - - RETURN) - END diff --git a/decus/vms93a/bulletin/bulletin9.for b/decus/vms93a/bulletin/bulletin9.for deleted file mode 100644 index 281bd5d..0000000 --- a/decus/vms93a/bulletin/bulletin9.for +++ /dev/null @@ -1,2085 +0,0 @@ -C -C BULLETIN9.FOR, Version 5/10/93 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA DISPLAY_ID/0/,KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - - IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN - WRITE (6,'(A)') ' A new BULLETIN executable has been '// - & 'installed since your last use.' - WRITE (6,'(A)') - & ' Type HELP NEW_FEATURES for help on any new features.' - END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IF - END IF - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN0 - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSEa - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1O - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)I - END IFZ - END IFE - END DOI - - CALL CLOSE_BULLFOLDER ! We don't need file anymore, - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSEO - WRITE (6,1000) - END IFI - IF (.NOT.SUBSCRIBE) THENF - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSEc - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42)E - DO I = 1,NUM_FOLDERSS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THENN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THENs - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THENn - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1),T - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IFR - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSEB - DATETIME = ' NONE'N - END IFc - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1U - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THEN - NUM_FOLDER = 0i - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1),O - & 'HIT any key for next page....')' - END IF - END DOC - IF (NUM_FOLDERS.EQ.0) THEN_ - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IFL - WRITE (6,1060)d - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURNR - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0_ - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1L - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1a - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0R - END IF - END DOB - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0_ - RETURN - END IFS - END IF - t - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)C - ELSE IF (INEW) THEN - NEW = INEWE - IF (REMOTE_SET.GE.3) THENE - CALL NEWS_GET_NEWEST_MESSAGE(IER)H - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSEI - CALL FIND_NEWEST_BULL' - END IFl - END IF - - CALL DIRECTORY(DIR_COUNT)S - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040)D - ELSE - INDEX_COUNT = 0 - END IF - END IFL - - RETURNO - -1000 FORMAT (' The following folders are present'/)W -1010 FORMAT (' The following folders with new messages are present'/) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12)I -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...')R -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USERF -C_ -C SUBROUTINE SHOW_USERN -CN -C FUNCTION: Shows information for specified users./ -CM - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLFOLDER.INC'Y - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAGR - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX)( - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2)L - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL')O - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER_ - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)O - - FOLDER_PRESENT = CLI$PRESENT('FOLDER')N - - IF (FOLDER_PRESENT) THEND - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z') - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME)T - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER)E - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURNS - END IF - END IF) - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START')T - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THENR - WRITE (6,'('' ERROR: Invalid date specified.'')')R - RETURN - END IFO - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURNP - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),S - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THENN - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURNT - END IFM - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURNT - END IF - ELSE IF (SINCE) THEN_ - IF (BULL_POINT.EQ.0) THENE - WRITE (6,'('' ERROR: No current message.'')') - RETURNP - ELSE IF (NEWS) THENC - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THENR - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSEK - STARTMSG = 1 - END IFT - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_ASTT - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0, - DO WHILE (IER.EQ.0.AND.FLAG.NE.1)_ - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST_ - END DO - ELSEY - IF (NEWS) THEND - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU)))B - IF (LU.GT.1) THEN) - TEMP_USER(LU-1:LU-1) =E - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))D - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IFF - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST, - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THENT - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1S - END DOD - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND.R - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN' - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0K - NEWSMSG = 1, - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER, - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THENK - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0, - ELSE - FOUND = .FALSE.K - END IF, - IF (FOUND.AND.NEWS) THENS - WRITE (6,'(1X,A,'' latest message read '',) - & I,''.'')')P - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')'), - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'',S - & '' to specified folder.'')')R - END IF - END IFY - IF (.NOT.ALL) THENG - IF (IER.NE.0) THENI - WRITE (6,'('' User info does not exist.'')') - END IFI - IER = 2 - END IFB - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED, - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSEA - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IFG - ELSE - WRITE (6,'('' Entry for specified user not found.'')')Y - END IF - CALL CLOSE_BULLUSER - ELSEC - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1)A - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND.T - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM)E - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THENQ - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IFU - END IF - END DO - CALL CLOSE_BULLUSER/ - END IF= - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN( - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C) -C FUNCTION: Opens specified folder in order to add message.I -C= -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROMG -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS:t -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP_ - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROB - CHARACTER*12 PROTOCOL - DATA LPRO/0/P - - COMMON /DIGEST/ LDESCR,FIRST_BREAKO - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIPL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATEE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXTI - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPEy - DATA SCRTYPE/0/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocessT - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESSE - - FOLDER1_DIRECTORY = FOLDER_DIRECTORYE - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDERi - - IF (IER.NE.0) THEN - IER1 = 1R - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IFe - END DO - IF (IER2) THENI - CALL ADD_DIRECTORIESD - ELSEE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IF - END IF - END DOX - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folderH - FOLDER_SET = .FALSE. ! indicate itT - ELSE ! Else it's another folderT - FOLDER_SET = .TRUE. ! indicate it - END IF_ - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCKE - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - - LEN_FROM = TRIM(IN_FROM)_ - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1o - LEN_FROM = 0 - END IFE - - IF (LEN_FROM.EQ.0.OR. - & (BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0$ - IF (IER1.NE.0) THENU - OPEN (UNIT=3,DISPOSE='DELETE',FILE='BULL.SCR',: - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW')K - SCRTYPE = 1 - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF( - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THENE - CALL STORE_FROM(INFROM,LEN_FROM)u - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol! - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP. - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF- - ELSE - DESCRIP = ' ' - END IF - END IFN - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE.$ - - RETURNE - END - - - - SUBROUTINE WRITEOUT_STORED - - IMPLICIT INTEGER (A-Z)P - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*256 BUFFERf - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3)R - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURNY - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -CP -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder._ -C) -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'F - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPX - COMMON /MAIN_HEADER_INFO/ INEXDATER - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAKO - DATA FIRST_BREAK/.TRUE./A - - COMMON /TEXT_PRESENT/ TEXTU - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFERg - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINEe - - CHARACTER*24 TODAY - - DATA STORED /.FALSE./ ' - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THENL - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN) - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = t - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFERs - RETURN - ELSE IF (BUFFER(:5).EQ.'From:') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:)E - OLD_BUFFER_FROM = .TRUE.) - OLD_BUFFER_SUBJ = .FALSE. - RETURNK - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE.a - OLD_BUFFER_FROM = .FALSE. - RETURNH - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:)a - OLD_BUFFER_FROM = .TRUE.S - OLD_BUFFER_SUBJ = .FALSE. - RETURNR - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THENp - LPRO = INDEX(INFROM,'%"') + 1s - PROTOCOL = INFROM(:LPRO) - END IFE - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCRI - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE= - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIPf - IF (.NOT.BTEST(FOLDER_FLAG,5)) THENn - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE_ - DESCRIP = ' ' - END IF - END IFT - STORED = .TRUE.. - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STOREDE - STORED = .FALSE. - END IFR - END IF - OLD_BUFFER_FROM = .FALSE.e - OLD_BUFFER_SUBJ = .FALSE.E - RETURN - END IFm - IF (BTEST(FOLDER_FLAG,5)) THENi - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE.d - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THENs - IF (.NOT.FIRST_BREAK) THEN2 - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3)p - END IFI - LFROM = 0 - LDESCR = 0 - RETURNu - ELSE IF (.NOT.FIRST_BREAK) THENP - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSES - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IFE - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1V - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM)T - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM)R - END IF - END IFD - RETURN - END IF) - ELSE - IF (LEN_BUFFER.GT.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - ELSE - WRITE (3,'(A)') ' ' - END IFe - TEXT = .TRUE. - RETURNy - END IF - END IFf - - IF (LEN_BUFFER.EQ.0) THEN ! If empty lineT - CALL STORE_BULL(1,' ',NBLOCK) ! just store one space - ELSE - IF (LEN_DESCRP.EQ.0) THENl - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:)N - LEN_DESCRP = LEN_BUFFER - END IFL - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE.T - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO* - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THENF - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1T - ELSE0 - EXDATE(1:2) = BUFFER(I:I+1)' - I = I + 2 - END IF - NODATE = .FALSE. - ELSE( - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-')S - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2' - ELSEL - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4I - END IF - END IFW - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DOE - INEXDATE = .TRUE. - END IF_ - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - IF (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11)) THENI - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH))M - END IF - TEXT = .TRUE. - END IFS - - RETURNI - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -CN -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -CS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'N - - COMMON /DIGEST/ LDESCR,FIRST_BREAKO - - COMMON /SCRTYPE/ SCRTYPEI - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPT - COMMON /MAIN_HEADER_INFO/ INEXDATET - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAYB - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN - CALL STORE_FROM(INFROM,LEN_FROM). - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1 - FIRST_BREAK = .FALSE._ - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THEND - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM)C - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEND - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)L - END IF - ELSE - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IFe - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - RETURN - END IF1 - - EXTIME = '00:00:00.00' - IF (INEXDATE) THENe - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format' - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great?) - & .OR.IER.LE.0) THEN ! or expiration date not futureG - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time?E - EXDATE = '5-NOV-2000' ! no, so set date far in future/ - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0E - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with addE - - IF (BTEST(FOLDER_FLAG,11)) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:)A - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)( - INPUT = INPUT(:ILEN)N - CALL ADD_PROTOCOL(INPUT,ILEN)N - CLOSE (UNIT=3,STATUS='SAVE')! - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN_ - IER = LIB$SET_LOGICALO - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICALN - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE_ - USERNAME = FOLDER - END IFt - IF (SCRTYPE.EQ.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INPUT,H - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')E - ELSE1 - CALL RESPOND_MAIL('BULL.SCR',INPUT, - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('BULL.SCR;*')F - END IF- - END IF - END IFT - - CALL UPDATE_FOLDER - - RETURNO - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"'S - I = LPRO + 1_ - LEN_INFROM = LEN_INFROM + LPRO + 1A - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = ''''0 - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN< - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF0 - I = I + 1 - END DO - END IFT - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DOe - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:)U - LEN_INFROM = LEN_INFROM - 1N - END DOF - - TWO_SPACE = INDEX(INFROM,' ')i - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:)E - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DOS - - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK)M - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program) - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(INFROM,LEN_INFROM)L - - RETURNL - END - - - SUBROUTINE GET_FROM(INFROM,LEN_INFROM)w - - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INFROMM - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards.. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DOE - - DO WHILE (INDEX(INFROM,'<').GT.0.AND. ! Name may be of form - & INDEX(INFROM,'@').GT.INDEX(INFROM,'<')) - INFROM = INFROM(INDEX(INFROM,'<')+1:)! personal-name N - END DO - - DO WHILE (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name)M - & INDEX(INFROM,'@').GT.INDEX(INFROM,'('))' - INFROM = INFROM(INDEX(INFROM,'(')+1:)I - END DOE - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.''''))R - I = I + 1u - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1= - - I = 1 ! Trim username to end at a alpha characterI - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND.d - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''') - I = I + 1I - END DO' - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THENL - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO) - - RETURNT - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z)) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' 'L - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DOS - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THENI - ! Is length > allowable subject length?L - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IFR - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP)))_ - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -CA -C SUBROUTINE STRIP_HEADER -C_ -C FUNCTION: Indicates whether line is part of mail message header. -CP -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -CC -C OUTPUTS:H -C IER - If true, line should be stripped. Else, end of header. -CR - IMPLICIT INTEGER (A - Z)) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINES - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) BUFFERR - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE.I - CONT_LINE = .FALSE. - RETURN - END IFE - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' 'D - CONT_LINE = .FALSE.H - END IFS - - IER = .TRUE.T - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuationE - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header line) - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THENE - DATE_LINE(TRIM(DATE_LINE)+1:) = '.'O - END IF - END IFR - RETURNO - ELSE - I = I + 1 - END IF - END DOF - - IER = .FALSE. - CONT_LINE = .FALSE. - - RETURN - END diff --git a/decus/vms93a/bulletin/bullfiles.inc b/decus/vms93a/bulletin/bullfiles.inc deleted file mode 100644 index 2b73469..0000000 --- a/decus/vms93a/bulletin/bullfiles.inc +++ /dev/null @@ -1,41 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWSDIR_FILE,BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data - CHARACTER*80 BULLNEWSDIR_FILE /'BULLNEWSDIR.DAT'/ - ! Directory listing for LOCAL news groups -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vms93a/bulletin/bullfolder.inc b/decus/vms93a/bulletin/bullfolder.inc deleted file mode 100644 index 117f8fc..0000000 --- a/decus/vms93a/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vms93a/bulletin/bullmain.cld b/decus/vms93a/bulletin/bullmain.cld deleted file mode 100644 index 4ca45c0..0000000 --- a/decus/vms93a/bulletin/bullmain.cld +++ /dev/null @@ -1,33 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vms93a/bulletin/bullnews.inc b/decus/vms93a/bulletin/bullnews.inc deleted file mode 100644 index 251895d..0000000 --- a/decus/vms93a/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vms93a/bulletin/bullstart.com b/decus/vms93a/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vms93a/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vms93a/bulletin/bulluser.inc b/decus/vms93a/bulletin/bulluser.inc deleted file mode 100644 index 22d7a3a..0000000 --- a/decus/vms93a/bulletin/bulluser.inc +++ /dev/null @@ -1,49 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vms93a/bulletin/changes.txt b/decus/vms93a/bulletin/changes.txt deleted file mode 100644 index 31864ac..0000000 --- a/decus/vms93a/bulletin/changes.txt +++ /dev/null @@ -1,533 +0,0 @@ -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vms93a/bulletin/cmds.mai b/decus/vms93a/bulletin/cmds.mai deleted file mode 100644 index 1340739..0000000 --- a/decus/vms93a/bulletin/cmds.mai +++ /dev/null @@ -1,22 +0,0 @@ -The address for getting BULLETIN is BULLETIN@PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file - (only one file per command). - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - -BULLETIN is also available via ANONYMOUS FTP from PFC.MIT.EDU, but the account -is set at low priority, so I suggest using it during non-prime hours. - - Mark diff --git a/decus/vms93a/bulletin/copyright.txt b/decus/vms93a/bulletin/copyright.txt deleted file mode 100644 index 9d8b44d..0000000 --- a/decus/vms93a/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for research and -educational purposes only, this software and its documentation without fee -or royalty is hereby granted, provided that you agree to comply with the -following copyright notice and statements, including the disclaimer, and -that the same appear on ALL copies of the software and documentation, -including modifications that you make for internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vms93a/bulletin/create.com b/decus/vms93a/bulletin/create.com deleted file mode 100644 index dafb9d5..0000000 --- a/decus/vms93a/bulletin/create.com +++ /dev/null @@ -1,55 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ MAC ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vms93a/bulletin/create_use_this_one.com b/decus/vms93a/bulletin/create_use_this_one.com deleted file mode 100644 index 9ddb7ac..0000000 --- a/decus/vms93a/bulletin/create_use_this_one.com +++ /dev/null @@ -1,56 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN0 -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN1 -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN2 -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN3 -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN4 -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN5 -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN6 -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN7 -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN8 -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN9 -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN10 -$ FORTRAN/EXTEND/nocheck'FQ' BULLETIN11 -$ MACro ALLMACS -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ on error then exit -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vms93a/bulletin/handout.txt b/decus/vms93a/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vms93a/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vms93a/bulletin/install.com b/decus/vms93a/bulletin/install.com deleted file mode 100644 index 758acd4..0000000 --- a/decus/vms93a/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vms93a/bulletin/instruct.com b/decus/vms93a/bulletin/instruct.com deleted file mode 100644 index 49627f6..0000000 --- a/decus/vms93a/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vms93a/bulletin/instruct.txt b/decus/vms93a/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vms93a/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vms93a/bulletin/login.com b/decus/vms93a/bulletin/login.com deleted file mode 100644 index e4302af..0000000 --- a/decus/vms93a/bulletin/login.com +++ /dev/null @@ -1,28 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vms93a/bulletin/makefile b/decus/vms93a/bulletin/makefile deleted file mode 100644 index cadd432..0000000 --- a/decus/vms93a/bulletin/makefile +++ /dev/null @@ -1,82 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.18" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vms93a/bulletin/master.com b/decus/vms93a/bulletin/master.com deleted file mode 100644 index f1c5834..0000000 --- a/decus/vms93a/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel:C -$ !I -$ run pmdf_root:[exe]ftcp_master -$ goto out1l -$ ! -$ CN_channel:i -$ !s -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277M -$ !L -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master( -$ goto out1_ -$ !+ -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vms93a/bulletin/mx.com b/decus/vms93a/bulletin/mx.com deleted file mode 100644 index 7d87c28..0000000 --- a/decus/vms93a/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */L - - } - } - } - rms_get(&rcptrab); /* Read next recipient */e - }u - - - /* Close the RMS files */r - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab);f - - tracemsg("BULLETIN message processed");y - exit(SS$_NORMAL); /* Always return success */ - -}L -$eod t -$copy/log sys$input MX_BULL.TXTm -$deckM - MX_BULL_ - An MX SITE transport. - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution:- - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN?h ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site.t - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including theS -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands:n - - SEND ALL Sends all bulletin files.. - SEND filename Sends the specified file.e - BUGS Sends a list of the latest bug fixes.D - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. Thei -build procedure for MX_BULL expects the logical BULL_SOURCE to point to theo -BULLETIN library. You must define this logical (or edit the .COM file)m -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct):L - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>"* - -3. If you don't have a SITE transport already defined, simply copyu - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULLe - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin deliveringc -messages to BULLETIN.t - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail tod -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETINm -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL) - MAIL> SENDU - To: MX%"GENERAL@BULLETIN" - Subj: This is a test....a - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITEu -agent, since the @BULLETIN path was defined as a SITE path.f - -To facilitate the automatic delivery of messages to BULLETIN folders, youi -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN"""/ - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN"""t - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to/ -BULLETIN via MX_BULL.d - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST ..../ - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.)u - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder.M - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwardingm -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When maild -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the messagee -to the Local agent, which discovers that the mail is forwarded tos -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUEf - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The; -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logicalf -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return addressr -for BULLETIN messages will look something like the following:t - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM:s - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayedW -to death, leaving a bad address on the "From:" line. This frequently happensa -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by:b - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnety - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226s - Western Kentucky University - Bowling Green, KY 42101 -$eod t -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$decka -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headersb -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1.u -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3i -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"?( -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file/ -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it upn -$ close tmp !...t -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr;s -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:"b -$ endifb -$ exit 1 !Always return success -$eod N diff --git a/decus/vms93a/bulletin/mx.mai b/decus/vms93a/bulletin/mx.mai deleted file mode 100644 index 7d87c28..0000000 --- a/decus/vms93a/bulletin/mx.mai +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */L - - } - } - } - rms_get(&rcptrab); /* Read next recipient */e - }u - - - /* Close the RMS files */r - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab);f - - tracemsg("BULLETIN message processed");y - exit(SS$_NORMAL); /* Always return success */ - -}L -$eod t -$copy/log sys$input MX_BULL.TXTm -$deckM - MX_BULL_ - An MX SITE transport. - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution:- - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN?h ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site.t - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including theS -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands:n - - SEND ALL Sends all bulletin files.. - SEND filename Sends the specified file.e - BUGS Sends a list of the latest bug fixes.D - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. Thei -build procedure for MX_BULL expects the logical BULL_SOURCE to point to theo -BULLETIN library. You must define this logical (or edit the .COM file)m -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct):L - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>"* - -3. If you don't have a SITE transport already defined, simply copyu - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULLe - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin deliveringc -messages to BULLETIN.t - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail tod -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETINm -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL) - MAIL> SENDU - To: MX%"GENERAL@BULLETIN" - Subj: This is a test....a - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITEu -agent, since the @BULLETIN path was defined as a SITE path.f - -To facilitate the automatic delivery of messages to BULLETIN folders, youi -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN"""/ - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN"""t - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to/ -BULLETIN via MX_BULL.d - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST ..../ - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.)u - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder.M - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwardingm -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When maild -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the messagee -to the Local agent, which discovers that the mail is forwarded tos -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUEf - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The; -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logicalf -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return addressr -for BULLETIN messages will look something like the following:t - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM:s - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayedW -to death, leaving a bad address on the "From:" line. This frequently happensa -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by:b - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnety - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226s - Western Kentucky University - Bowling Green, KY 42101 -$eod t -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$decka -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headersb -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1.u -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3i -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"?( -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file/ -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it upn -$ close tmp !...t -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr;s -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:"b -$ endifb -$ exit 1 !Always return success -$eod N diff --git a/decus/vms93a/bulletin/news.alt b/decus/vms93a/bulletin/news.alt deleted file mode 100644 index e33d065..0000000 --- a/decus/vms93a/bulletin/news.alt +++ /dev/null @@ -1,254 +0,0 @@ - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales diff --git a/decus/vms93a/bulletin/news.create b/decus/vms93a/bulletin/news.create deleted file mode 100644 index dc1c840..0000000 --- a/decus/vms93a/bulletin/news.create +++ /dev/null @@ -1,155 +0,0 @@ -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - diff --git a/decus/vms93a/bulletin/news.moderators b/decus/vms93a/bulletin/news.moderators deleted file mode 100644 index b53780f..0000000 --- a/decus/vms93a/bulletin/news.moderators +++ /dev/null @@ -1,260 +0,0 @@ -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com diff --git a/decus/vms93a/bulletin/news.txt b/decus/vms93a/bulletin/news.txt deleted file mode 100644 index e426286..0000000 --- a/decus/vms93a/bulletin/news.txt +++ /dev/null @@ -1,141 +0,0 @@ -BULLETIN has the capability to read and post messages to USENET NEWS in a -client mode. News groups can also be stored on disk. Selected groups or -set of groups which are commonly read can be selected to be stored, thus making -reading of such groups much faster than having to access them over a network. -Note that since the number of groups is well over 2000 makes it unreasonable at -most sites to store them all. - -BULLETIN (actually BULLCP) can act as as a gateway between decnet and tcp for -NEWS, which allows decnet nodes without tcp access to be able to access a tcp -news server. This method does not require spawning any processes, since the -detached process BULLCP is always present, so the access is very fast. - -Since BULLETIN uses a shared database to store info on the NEWS groups and -periodically updates it, there is no need for that to be done when a user -accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. - -It is also possible to feed NEWS groups into a "real" BULLETIN folder. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -If you have a cluster where one node is an internet node, and the rest -non-internet nodes, you'll have to create a startup procedure that defines -BULL_NEWS_SERVER to be the internet news server address only on the node (or -nodes) on the cluster that have actually internet access. The other nodes will -have BULL_NEWS_SERVER defined as the decnet node name that BULLCP is running on -in the cluster. (Of course, BULLCP will have to be running on a node with -internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. BULLCP will update NEWS every hour. If you -want to change this frequency, define the logical name BULL_NEWS_UPDATE to the -number of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" -for 30 minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does -the update. You can watch how long it takes for this to run in order to -determine if you want to change the update period). If you ever want to force -NEWS to be updated, simply restart BULLCP. - -It is suggested that you run OPTIMIZE_RMS.COM on BULLNEWS.DAT, as it will cause -the file to be compressed and will allow updates to run much faster (factor of -5 or more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -News groups can be specified as being stored on disk via the SET NEWS command. -See the online help for more info. After converting such groups, when BULLCP -wakes up, it will start the storing process. This can take a long time if you -have a lot of groups. An index file pointing to the stored messages is created -and called BULL_DIR:BULLNEWSDIR.DAT. After the storage process is complete you -should consider running OPTIMIZE_RMS.COM on it (and anytime after you convert a -sizable amount of groups). - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. diff --git a/decus/vms93a/bulletin/nonsystem.txt b/decus/vms93a/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vms93a/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vms93a/bulletin/optimize_rms.com b/decus/vms93a/bulletin/optimize_rms.com deleted file mode 100644 index fc0b91d..0000000 --- a/decus/vms93a/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = P4 -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vms93a/bulletin/pmdf.com b/decus/vms93a/bulletin/pmdf.com deleted file mode 100644 index 85c77b1..0000000 --- a/decus/vms93a/bulletin/pmdf.com +++ /dev/null @@ -1,1031 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input BULLETIN_MASTER.PAS_V32i -$deck' -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound);; - -(*******************************************************************)a -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *) -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - - outbound : text; - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL - 100; - - VAR - line, errorsto : vstring; - bigline : bigvstring; result : rp_bufstruct; - header : he_header; - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string); - - BEGIN (* try_something *) - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *) - end; (* try_something *) - - BEGIN (* return_bad_messages *) - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt'); - try_something (he_read_header (header, qu_rtxt), 'he_read_header'); - errorsto.length := 0; - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i]; - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto), - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr); - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *) - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages (tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable. - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT - -For V3.2: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check your -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vms93a/bulletin/restart.com b/decus/vms93a/bulletin/restart.com deleted file mode 100644 index 502bfa8..0000000 --- a/decus/vms93a/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vms93a/bulletin/setuser.mar b/decus/vms93a/bulletin/setuser.mar deleted file mode 100644 index 153cb7b..0000000 --- a/decus/vms93a/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vms93a/bulletin/update.fil b/decus/vms93a/bulletin/update.fil deleted file mode 100644 index e7332c3..0000000 --- a/decus/vms93a/bulletin/update.fil +++ /dev/null @@ -1,7 +0,0 @@ -$ IF P2 .EQS. "" THEN COPY 'P1' [ANONYMOUS.BULLETIN] -$ COPY 'P1' [.SEND] -$ TAB2SP 'P1' -$ RENAME 'P1' [-.NET] -$ PUR [.SEND]'p1' -$ PUR [-.NET]'p1' -$ PUR [ANONYMOUS.BULLETIN]'p1' diff --git a/decus/vms93a/bulletin/upgrade.com b/decus/vms93a/bulletin/upgrade.com deleted file mode 100644 index a2d77c4..0000000 --- a/decus/vms93a/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vms93a/bulletin/writemsg.txt b/decus/vms93a/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vms93a/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vms93b/bulletin/aaareadme b/decus/vms93b/bulletin/aaareadme deleted file mode 100644 index ee7f983..0000000 --- a/decus/vms93b/bulletin/aaareadme +++ /dev/null @@ -1,78 +0,0 @@ -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -If you are running a version of BULLETIN older than 2.11, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. NOTE: -Problems can occur if the old version of BULLETIN is run after the -data files have been modified. Such a situation is possible on a -cluster where each node has installed the executable separately. To -help installation, a new command procedure UPGRADE.COM has been -included. Read the comments in the file for information on how to use -it. - -As of V2.0, BULLETIN is able to read USENET NEWS via TCP/IP using either -CMU, MULTINET, UCX, TWG, or via DECNET. It can also serve as a NEWS -gateway for DECNET nodes without direct access to the NEWS server, i.e. a -DECNET node without Internet access will be able to read NEWS. - -NOTE: The following commands can be sent to BULLETIN@PFC.MIT.EDU: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. (This does not describe the NEWS reader -feature, however.) - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -You will be receiving 22 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) BULLETIN10.FOR - 13) BULLETIN11.FOR - 14) ALLMACS.MAR - 15) BULLCOMS1.HLP - 16) BULLCOMS2.HLP - 17) BULLET1.COM - 18) BULLET2.COM - 19) PMDF.COM - 20) MX.COM - 21) NEWS.COM - 22) ALLMACS_AXP.MAR - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. However, this only applies -to PMDF V3.2 or earlier, as later versions of PMDF have the necessary -interface code for BULLETIN included in it. In that case, or in case -you don't have PMDF, you can delete it. The same applies to MX. Then, -read AAAREADME.TXT for BULLETN installation instructions. If you are -using the news feature, NEWS.COM contains files which pertain to news. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@NERUS.PFC.MIT.EDU diff --git a/decus/vms93b/bulletin/aaareadme.txt b/decus/vms93b/bulletin/aaareadme.txt deleted file mode 100644 index fb97c8c..0000000 --- a/decus/vms93b/bulletin/aaareadme.txt +++ /dev/null @@ -1,201 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vms93b/bulletin/allmacs.mar b/decus/vms93b/bulletin/allmacs.mar deleted file mode 100644 index b7498eb..0000000 --- a/decus/vms93b/bulletin/allmacs.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vms93b/bulletin/allmacs_axp.mar b/decus/vms93b/bulletin/allmacs_axp.mar deleted file mode 100644 index efb71ec..0000000 --- a/decus/vms93b/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vms93b/bulletin/board_digest.com b/decus/vms93b/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vms93b/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vms93b/bulletin/board_special.com b/decus/vms93b/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vms93b/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vms93b/bulletin/bull_news.c b/decus/vms93b/bulletin/bull_news.c deleted file mode 100644 index af86395..0000000 --- a/decus/vms93b/bulletin/bull_news.c +++ /dev/null @@ -1,705 +0,0 @@ -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0) -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} diff --git a/decus/vms93b/bulletin/bullcom.cld b/decus/vms93b/bulletin/bullcom.cld deleted file mode 100644 index 1e09510..0000000 --- a/decus/vms93b/bulletin/bullcom.cld +++ /dev/null @@ -1,665 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 11/29/93 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED) - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULT - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER FROM - QUALIFIER SUBJECT - QUALIFIER NEGATED - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW SEARCH_STRING AND REPLY - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vms93b/bulletin/bullcoms1.hlp b/decus/vms93b/bulletin/bullcoms1.hlp deleted file mode 100644 index eff793c..0000000 --- a/decus/vms93b/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1095 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers so -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file can -be specified which contains the text. If the editor is used for changing -the text, the old message text will be extracted. This can be suppressed -by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST - -If a mailer protocol is needs to be added to the network address in -order for it to be sent by VMS MAIL, i.e. protocol%"address", the -appropriate protocol can be specified by either hardcoding it into the -file BULLNEWS.INC before compiling BULLETIN, or by defining the system -logical name BULL_NEWS_MAILER (it is the same protocol used by the NEWS -feature in order to respond to NEWS messages). The default protocol is -IN%. If desired, you can specify the protocol with the address, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, the -folder will then be modified to point to that folder. For example if -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be shared -between more than one node. This capability is only present if the BULLCP -process is running on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message. -It can be a substring of the subject. This is in case you have forgotten -the exact subject that was specified. Case is not critical either. -You will be notified if the deletion was successful. -See also /NEGATED. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting messages -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed.A - - Format:s - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message.i -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description ofe -folder. -2 /EXPIRATIONl -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the -DIRECTORY command are to be written into the specified file. Allc -qualifiers which are valid for the EXTRACT command are valid in -conjunction with /EXTRACT except for /NEW which conflicts with the ( -DIRECTORY /NEW qualifier. The listof messages to be printed will be -displayed on the terminal (in nopaging format). -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS. -2 /FROMO - /FROM=[string]t - -Specifies that only messages whose username contains the specified stringe -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.a -See also /NEGATED. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don'tf -match the specified search command are displayed. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. e -2 /UNMARKEDa -Lists messages that have not been marked (marked messages are indicatedh -by an asterisk). Using /UNMARKED is equivalent to selecting the foldern -with /UNMARKED, i.e. only unmarked messages will be shown and be ablei -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEENw -Lists messages that have been seen (indicated by a greater than sign). a -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlye -seen messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. v -2 /UNSEENE -Lists messages that have not been seen (seen message are indicated by ar -greater than sign). Using /UNSEEN is equivalent to selecting the foldero -with /UNSEEN, i.e. only unseen messages will be shown and be able to beh -read. To see all messages, use either /ALL, or reselect the folder. a -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWSe -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The liste -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current messaget -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED.o -2 /SEARCH - /SEARCH=[string]y - -Specifies that only messages which contain the specified string aree -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.E -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.a -2 /START - /START=message_number - -Indicates the first message number you want to display. For example,t -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDEW -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings.e - - Format:f - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE.m -2 /FROM -Specifies to exclude the message based on the message owner. This ise -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL. -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROMt -and /SUBJECT cannot be specified at the same time. m -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following linee -must be present: - -folder_name:defaults:killo - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program.n -1 EXTRACTs -Synonym for FILE command. -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified. - - Format:W - FILE filename [message_number][-message_number1],[...] - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Copies all the messages in the current folder. -2 /FFe -Specifies that a form feed is placed between messages in the file. -2 /HEADERt - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 FIRST -Specifies that the first message in the folder is to be read.N -1 FORWARD -Synonym for MAIL command. -1 Folderst -All messages are divided into separate folders. New folders can beh -created by any user. As an example, the following creates a folder ford -GAMES related messages: - h -BULLETIN> CREATE GAMES -Enter a one line description of folder.e -GAMESo - -To see the list of available folders, use DIRECTORY/FOLDERS. To selecte -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, thatd -user will be alerted of topics of new messages at login time, and will h -then be given the option of reading them. Similar to READNEW is SHOWNEW,f -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option,a -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command.t - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in thet -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SETt -NODE. A remote folder is one which points to a folder on a remote DECNETc -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)r -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/d -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, ande -giving access to that UIC group. Only users in that UIC group will seei -the messages in that folder when they log in.e -1 HELP -To obtain help on any topic, type: - - HELP topico -1 INCLUDEt -Specifies to include reading messages based on the message owner or the -subject. If it is determined that a message is to be included, then the -message is read when a user tries to read a message by typing NEXT or -BACK, or by hitting the return key. Otherwise, it is skipped. Specify -the qualifier /FULL to make all EXCLUDEs and INCLUDEs for the specified -folder apply to all other BULLETIN commands, including directory -listings. - - Format: - INCLUDE [string] - -If a string is specified, then the message is included if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one INCLUDE may be -specified per folder. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all INCLUDEs. -2 /DISABLE -Specifies to permanently disable the INCLUDE.T -2 /FROMc -Specifies to include the message based on the message owner. This ise -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULLt -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. -2 /SUBJECT -Specifies to include the message based on the message subject. /FROMC -and /SUBJECT cannot be specified at the same time. g -2 Storing_INCLUDEs -INCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):stringg - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:killi - -excluding the folder_name causes it to apply to all folders. -1 INDEX/ -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for c -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after ones -has read a message. /RESTART must be specified to start from the firsto -folder if a scan is in progress. All other qualifiers are ignored while -a scan is in progress. - - Format:a - INDEX - -When a directory is displayed, you can read the first message in the e -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for olders -versions of BULLETIN.o -2 /MARKEDl -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED,f -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKEDt -Lists messages that have not been marked (marked messages are indicatedt -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read.a -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlyh -seen messages will be shown and be able to be read.i -2 /UNSEENm -Lists messages that have not been seen (seen message are indicated by an -greater than sign). Using /UNSEEN is equivalent to selecting the folderr -with /UNSEEN, i.e. only unseen messages will be shown and be able to bec -read. -2 /NEW - /[NO]NEWe - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message.D -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified.d -2 /RESTART -If specified, causes the listing to be reinitialized and start from ther -first folder.S -2 /SET - /[NO]SET, - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format: - LASTN -2 /EDITL -Specifies that the editor is to be used to read the message. This iss -useful for scanning a long message.s -2 /HEADERr - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commando -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEa -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format:d - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying ane -address that has quotes, in order to pass the quotes you must specifyN -triple quotes. I.e. a network address of the form xxx%"address" musta -be specified as xxx%"""address""". -2 /EDITf -Specifies that the editor is to be used to edit the message before -mailing it. -2 /HEADERm - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the e -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks (").t - -If you omit this qualifier, the description of the message will be usedg -as the subject.s -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directoryC -listing. A marked message can serve as a reminder of importantt -information. The UNMARK command sets the current or message-id messageg -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers]t - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to bya -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 MODIFY -Modifies the database information for the current folder. Only thei -owner of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted forC -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing listh -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTu -commands, the address of the mailing list should be included in thea -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST p -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to itn -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAMEp - /NAME=foldernamee - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not haver -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID.m -1 MOVE -Moves a message to another folder and deletes it from the current -folder.S - - Format:A - - MOVE folder-name [message_number][-message_number1]s - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,d -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPSl - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message tos -the specified NEWS group(s) in addition to the selected NEWS group.e -2 /HEADERa - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied.h -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.y -2 /ORIGINALt -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned byr -the person moving the message. -1 NEWS -Displays the list of available news groups.h - -Format:o - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed.o - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL willf -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /NEWGROUP -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B.h -2 /STOREDe -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over.f -2 /EDIT -Specifies that the editor is to be used to read the message. This isN -useful for scanning a long message.c -2 /HEADERA - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEi -Specifies to decode the message using ROT-13 coding. diff --git a/decus/vms93b/bulletin/bullcoms2.hlp b/decus/vms93b/bulletin/bullcoms2.hlp deleted file mode 100644 index 75c9fae..0000000 --- a/decus/vms93b/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1411 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with > at the -beginning of each line. This can be suppressed with /NOINDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. In -order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply surround -the exclusive text starting with the line "START " and ending -with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have -just read) for printing. The file created by the PRINT command -is not released to the print queue until you exit, unless you add -the qualifier /NOW or change one of the print job's qualifiers. -Multiple messages are concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line. -This can be suppressed with /NOINDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected and /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read them. -(Note: Reading the last message does the same thing, but RESET does it -without having to read it.) -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header. -If a "search-string" is not specified, a search is made using the -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for -a match. If, during a search, no more matches or messages are found, -the next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the last -message. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUS -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name. - - Format: - - SET [NO]ANONYMOUS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. - - Format: - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If a -mailing address is present (see /DESCRIPTION), when messages are added -to the folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be -used if the POST command is entered. One use for this is a local board -which is also distributed to non-local users. - - Format: - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages. - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30" -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The forma -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY. -The time will always be 00:00, even if the time is specified on the line.e -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be:R - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account. - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV.c -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION. -2 BRIEF2 -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa). - - Format:e - - SET [NO]BRIEFf -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newA -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernameE - -Specifies the folder for which the option is to modified. If notr -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by thel -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier.e -2 COMPRESS -Specifies that messages added to the folder will be in compressed format. -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires a -very little cpu overhead.e - - Format:K - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. f -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed everye -time when logging in, until the new messages are read. Normally, theh -BRIEF setting causes notification only at the first time that new messages -are detected.o - - Format:s - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for ther -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges.u - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - - Format:o - - SET DEFAULT_EXPIRE days. - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages.s - - Format:e - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it.f -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format:e - - SET [NO]EXPIRE_LIMIT [days]r - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) e -2 EXCLUDE -Specifies to ignore any EXCLUDEs or INCLUDEs that are present. - - Format:) - - SET [NO]EXCLUDES - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or INCLUDEs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information.R - - Format:o - - SET FOLDER [node-name::][folder-name]r -3 /MARKEDn -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 GENERICo -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format:e - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for thel -same user. -3 /DAYSn - /DAYS=number_of_days - -Specifies the number days that new messages will be displayed for upon -logging in. -2 KEYPAD e -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format:s - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to byt -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI.n -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command.t - - Format:e - - SET [NO]LOGIN username -2 NEWS -Changes attributes of the specified news group or class of news groups." -This command requires privileges. - - Format:p - - SET NEWS [news-group]e - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALLe - /NOALLr - -If specified with /CLASS or /DEFAULT, all groups that are presentlyI -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of anye -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the defaultt -attributes (using /DEFAULT) with /NOALL, the attributes for misc.testm -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. s -3 /CLASS - /CLASS=classnamel - -Specifies to modify attributes for a class of news groups rather than aa -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes ofh -existing groups which are in the class are modified, and any groupss -created in the future will automatically have those attributes.a -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETE -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLEo -Specifies that the news group is enabled and can be accessed. This isy -the default. -3 /EXPIRATION - /EXPIRATION=daysh - -Specifies the default expiration time for messages if none is specified. -The default is 7.a -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified ise --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default.i -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is postedt -every month with an expiration date of one month in the future.s -3 /PRIVATE - /PRIVATEs - /NOPRIVATEm - -Specifies that the news group or class can have it's access modified bya -the SET ACCESS command. To accomplish this, a file is created inN -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access -to news groups in that class is to set /NOPRIVATE, as then time won't be -wasted checking a file for ACLs. -3 /STOREDc - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessedo -via the network from the server node. This results in faster access,t -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED. -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node.n - - Format:. - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder.e - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node, -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated., -3 /FOLDERo - /FOLDER=foldernamef - -Specifies the folder for which the node information is to modified.m -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format:m - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are loggedd -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users fors -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specifiedi -folder. This is a privileged qualifier. It will only affect brand newo -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernameg - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENTA - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier.f -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN.n - - Format: - - SET [NO]PAGE -2 POST_ONLY -Specifies that the selected folder has the POST_ONLY attribute. Thise -causes the ADD command to mail the message to the mailing address if its -is present (see /DESCRIPTION), rather than add to the folder. i - - Format: - - SET [NO]POST_ONLYl -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format: - - SET PRIVILEGES parametersm - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers. -3 /IDy - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.c -2 PROMPT_EXPIRES -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format:r - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command.a - - Format:r - - SET [NO]READNEWE - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder).r -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersn -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newF -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERh - /FOLDER=foldernamef - -Specifies the folder for which the option is to modified. If note -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENTt - -Specifies that READNEW is a permanent flag and cannot be changed by the, -individual. This is a privileged qualifier. -2 SHOWNEWe -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN.o - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format: - - SET [NO]SHOWNEWp -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersr -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newa -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERr - /FOLDER=foldernamep - -Specifies the folder for which the option is to modified. If notm -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that SHOWNEW is a permanent flag and cannot be changed by thef -individual, except if changing to READNEW. This is a privileged qualifier. -2 STRIPp -Affect only messages which are added via either the BBOARD option, oru -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped offr -before it is stored as a BULLETIN message. - - Format:o - - SET [NO]STRIPa - -The command SHOW FOLDER/FULL will show if STRIP has been set.s -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM foldere -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is ay -privileged command. - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGS, -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for thee -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected via -the SELECT command, information about that folder is shown.c - - Format:n - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. Thisa -includes DUMP & SYSTEM settings, the access list if the folder isa -private, and BBOARD information. This information is only those who -have access to that folder.f -2 KEYPAD -Displays the keypad command definitions. - - Format:n - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either the SET KEYPAD COMMAND, orn -if /KEYPAD is specified on the command line, the keypad keys will be -defined as commands. The default settings for the keypad are shown viaV -SHOW KEYPAD or HELP KEYPAD. Settings can be changed by using an -initialization file with DEFINE/KEY commands. BULLETIN looks first forv -the file pointed to by the logical name BULL_INIT and then for the file -SYS$LOGIN:BULL.INI.b - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -3 /STATE - /STATE=(state,state,...)s - -Specifies the name of a state for which the specified key definitionsI -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when E -a key name has been specified. -2 NEWe -Shows folders which have new unread messages for which BRIEF or READNEWa -have been set. (Note: If you enter BULLETIN but do not read new unreadO -messages, you will not be notified about them the next time you enterE -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this.h -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command.m -3 /LOGIN - /[NO]LOGINe - -Specifies that only those users which do not have NOLOGIN set are to bew -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDER - /FOLDER=[foldername]i - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups.n -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSIONR -Shows the version of BULLETIN and the date that the executable was -linked.N -1 SPAWNs -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format:r - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBEd -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of thet -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. i -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format:n - UNDELETE [message-number]h -1 UNSUBSCRIBEa -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See thec -SUBSCRIBE command for further info. -1 Usenet_newso -BULLETIN can also read USENET NEWS if your system has network access to -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of h -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group ini -order to keep track of which messages you have read in that group. Most -of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read news groups with new messages, use INDEX/SUBSCRIBE. i -1 New_features -Here is a list of new features which may be of interest to the general -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - --------------------------------------------------------------------------l -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93r - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group byy -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92g - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92n - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -V 2.09 - -Added /FROM, /NOREPLIES, & /NEGATED to SEARCH and DIRECTORY commands. -3/18/92d - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Display time when reading news messages in local rather than GMT time. -12/8/91e - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91e - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive,d -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the -command line, and /EDIT was specified, the file would be sent even if the -user quit out of the edit, rather than exitting (i.e. outputting a file). -10/21/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message -basis. Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91. - -Added /NOW to PRINT command. Messages no longer have to be printed one -message at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are -found by using the DIRECTORY command. 7/31/91e - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large -news group names. 7/31/91o - -Added FIRST command to read first message found in folder. 7/31/91t - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91u - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more -than one folder at a time. 6/13/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -V2.04a - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 -1 CustomizingE -A user can specify certain customized features by adding commands to the -file SYS$LOGIN:BULL.CUSTOM or in the file pointed to by the logical name -BULL_USER_CUSTOM. The following are the commands and formats presentlyP -available: - -To specify to include or exclude a message when reading messages, basedc -on a string found in the message's subject or address, add a line with the -format: - -folder_name:INCLUDE(or EXCLUDE):FROM(or SUBJECT):stringf - -Includes and excludes can be done using the INCLUDE and EXCLUDE commands.] - -The following are commands which allow certain switches to be the -default for a folder. The format is folder_name:defaults followed by -the specified qualifier (each qualifier is preceded by a :). If you -want the qualifiers to apply to all folders, omit the folder_name and -start the line with simply :defaults. - -To specify that /HEADER is the default for a folder, add :header, i.e. p - -GENERAL:defaults:headeru - -In order that INCLUDEs and EXCLUDEs be applied to all commands in a -folder, add :kill. (Adding /FULL to a INCLUDE or EXCLUDE command does -this for you). diff --git a/decus/vms93b/bulletin/bulldir.inc b/decus/vms93b/bulletin/bulldir.inc deleted file mode 100644 index 7bdda8d..0000000 --- a/decus/vms93b/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 180 - - COMMON /NEWS_DIR/ NEWS_MSG_KEY,NEWS_MSG_BTIM_KEY,NEWS_MSGID - & ,NEWS_EX_BTIM_KEY,NEWS_POST_BTIM,NEWS_BLOCK,NEWS_LENGTH - & ,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*64 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_MSG_KEY,NEWS_HEADER_KEY - - CHARACTER*12 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*12 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_KEY,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vms93b/bulletin/bullet1.com b/decus/vms93b/bulletin/bullet1.com deleted file mode 100644 index 2c31b03..0000000 --- a/decus/vms93b/bulletin/bullet1.com +++ /dev/null @@ -1 +0,0 @@ -$set nover diff --git a/decus/vms93b/bulletin/bulletin.cld b/decus/vms93b/bulletin/bulletin.cld deleted file mode 100644 index dc7abbd..0000000 --- a/decus/vms93b/bulletin/bulletin.cld +++ /dev/null @@ -1,43 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vms93b/bulletin/bulletin.for b/decus/vms93b/bulletin/bulletin.for deleted file mode 100644 index 44d91c3..0000000 --- a/decus/vms93b/bulletin/bulletin.for +++ /dev/null @@ -1,1891 +0,0 @@ -C -C BULLETIN.FOR, Version 8/12/93 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION - - CALL OPEN_OLD_TAG - - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (NEWS_FEED().OR.REMOTE_SET.GE.3) THEN - INCMD = 'POST '//INCMD(4:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL RESPOND - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'INCL') THEN ! INCLUDE? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS? - CALL SET_NEWS - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE? - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE? - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATION - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1) - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN? - CALL TAG(.FALSE.,2) - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - -100 CONTINUE - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more preceding messages.') - - END - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN - - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - CHARACTER INEXDATE*12,INEXTIME*12 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT') - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60) - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60) - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - IF (CLI$PRESENT('EXTRACT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35 - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - BLENGTH = BLENGTH + ILEN - 1 + 2 - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE. - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting.'', - & '' A truncated message will be broadcast.'')') - CALL GET_INPUT_PROMPT(INPUT,ILEN, - & 'Type C to continue, A to only ADD message, or Q to Quit: ') - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN - BRDCST = .TRUE. - END IF - END IF - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! Username - END IF - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THEN - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '// - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK) - END IF - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletin - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IF - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF (FOLDER_NUMBER.GE.0) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF -C -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP, -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same cluster -C as that of the BULLCP node. -C - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET) - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - ELSE IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR. - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL DISABLE_PRIVS - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & INDESCRIP(:LENDES),STATUS) - CALL ENABLE_PRIVS - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IF - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (CLI$PRESENT('EXTRACT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER LOCALNODE*8,RESPONSE*4 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'RE:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'RE: '//INDESCRIP - END IF - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP)) - - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG) - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC' - - DATA READ_UAI/.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE. - RETURN - END IF - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE. - END IF - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURN - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')') - RETURN - END IF - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN) - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN() - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - RETURN - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END diff --git a/decus/vms93b/bulletin/bulletin.hlp b/decus/vms93b/bulletin/bulletin.hlp deleted file mode 100644 index dd8a657..0000000 --- a/decus/vms93b/bulletin/bulletin.hlp +++ /dev/null @@ -1,144 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vms93b/bulletin/bulletin.lnk b/decus/vms93b/bulletin/bulletin.lnk deleted file mode 100644 index 6cdd588..0000000 --- a/decus/vms93b/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.19" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.19" diff --git a/decus/vms93b/bulletin/bulletin0.for b/decus/vms93b/bulletin/bulletin0.for deleted file mode 100644 index c703914..0000000 --- a/decus/vms93b/bulletin/bulletin0.for +++ /dev/null @@ -1,2051 +0,0 @@ -C -C BULLETIN0.FOR, Version 12/2/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - CALL REMOTE_DELETE(SBULL,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN ! If not owner of message - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.EQ.FROM - END IF - IF (ASK) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.TEST_NEWS_OWNER()) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM) - IER = SYS$ASCTIM(,INPUT,EX_BTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - IF (.NOT.READ_TAG) THEN - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - END IF - EXTRACTING = CLI$PRESENT('EXTRACT') - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - ELSE - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - ANY_SEARCH = .FALSE. - END IF - OUTPUT = EXTRACTING.OR.PRINTING - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - START = .FALSE. - SINCE = .FALSE. - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - SINCE = .TRUE. - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - GO TO 9999 - END IF - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - NEGATED = CLI$PRESENT('NEGATED') - IF (CLI$PRESENT('SEARCH')) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('FROM')) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3 - NEGATED = .TRUE. - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - FROM_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) NUM = NUM + 1 - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - END IF - I = I - 1 - END DO - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - END IF - IF (NUM.GT.0) I = I - 1 - END DO - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) NUM = NUM + 1 - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) J = J + 1 - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I1 = SBULL - I = SBULL - DO WHILE (I.LE.EBULL) - CALL READDIR(I1,IER) ! Into the queue - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1 - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - I = I + 1 - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1 - END IF - I1 = I1 + 1 - END DO - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - EBULL = EBULL - SBULL + DIR_COUNT - SBULL = DIR_COUNT - I = SBULL - END IF - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY, - & TAG_TYPE) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVE - END IF - END IF - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - END IF - ELSE - NBULL = 0 - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN - DIR_TYPE = 'seen' - END IF - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULL - ELSE - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IF - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ') - OUTLINE(I:) = OUTLINE(I+1:) - END DO - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINE - BULL_PARAMETER = ' ' - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1)) THEN - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THEN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IF - IF (PRINTING) THEN - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - END IF - WRITE (6,'(1X,A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(6,1005) - ELSE - WRITE(6,1000) - END IF - - TAG = (BULL_TAG.AND.REMOTE_SET.EQ.0).OR. - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THEN - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN - START_SEARCH = BULL_POINT - END IF - IF (ANY_SEARCH.OR.OUTPUT) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED_FILES = .FALSE. - END IF - DO WHILE (I.LE.EBULL) - IF (.NOT.ANY_SEARCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (CLOSED_FILES) THEN - CLOSED_FILES = .FALSE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - CALL GET_SEARCH(FOUND,SEARCH_STRING,1,SLEN,0, - & START_SEARCH,.FALSE.,SUBJECT,REPLY_FIRST,.FALSE., - & .TRUE.,FROM_SEARCH,NEGATED,MATCH_MODE) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - TAG_TYPE = DUMMY - END IF - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.LE.EBULL) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN - OUTLINE = '>' - ELSE - OUTLINE = ' ' - END IF - IF (BTEST(SYSTEM,29)) THEN - OUTLINE(2:) = '*' - ELSE - OUTLINE(2:) = ' ' - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3) - IF ((EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) - & .AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin? - EXPIRES = 'Permanent' - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11) - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9) - ELSE - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11) - END IF - WRITE(6,'(1X,A)') OUTLINE - IF (OUTPUT) THEN - FOUND_MSG = .TRUE. - CALL SYS$SETAST(%VAL(0)) - NEXT = .FALSE. - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES) - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES) - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0 - ELSE - MSG_NUM = -MSG_NUM - END IF - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1)) - END IF - END IF - I = I + 1 - IF (ANY_SEARCH) IER = SYS$CANTIM(,) - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.OUTPUT) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IF - END IF - - IF (DIR_COUNT.GT.NBULL.OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THEN - ! Outputted all entries? - DIR_COUNT = -1 ! Yes. Set counter to -1. - IF (PRINTING) THEN - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THEN - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IF - ELSE IF (EXTRACTING.AND.FOUND_MSG) THEN - CALL FILE(0,CLOSED_FILES) - END IF - ELSE - WRITE(6,1010) ! Else say there are more - END IF - -9999 POSTTIME = .FALSE. - NEXT = .FALSE. - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/) -1010 FORMAT(1X,/,' Press RETURN for more...',/) - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER) - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT) -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER*128 FILENAME - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THEN - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IF - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THEN - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IF - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = FILE_NUM - EBULL = SBULL - END IF - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE. - FIRST = .TRUE. - END IF - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1 - IF (FBULL1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - OPENED = .FALSE. - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(FBULL,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DO - -100 IF (FILE_NUM.GT.0) THEN - FILE_NUM = -FILE_NUM - RETURN - END IF - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created. - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - END IF - - GO TO 10 - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message ',A,' written to ',A) -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A) -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN) - - CALL LIB$MOVC3(8,IN,OUT) - - RETURN - END - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - FOLDER_NAME = FOLDER - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSE - RETURN ! Don't notify - END IF - END IF - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSE - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM) - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time - ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSER - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LOGIN_BTIM_NEW) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100 - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - INREAD = '+' - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' ' - END IF - IF (LEFT) THEN - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN) - LEFT = .FALSE. - ILEN = 0 - INREAD = '+' - ELSE IF (ILEN.LE.WIDTH) THEN - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN) - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSE - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ') - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH) - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0) - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DO - IF (INPUT(ILEN:ILEN).EQ.' ') THEN - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEN - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE. - ELSE - WIDTH = PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE (6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - PAGE = PAGE + 1 - ELSE - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)// - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN) - & //' '//FOLDER_NAME(:FLEN)// - & ' to read these messages.' - END IF - PAGE = PAGE + 1 - END IF - -9999 IF (LOGIN_SWITCH) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IF - - RETURN - END - diff --git a/decus/vms93b/bulletin/bulletin1.for b/decus/vms93b/bulletin/bulletin1.for deleted file mode 100644 index 419725b..0000000 --- a/decus/vms93b/bulletin/bulletin1.for +++ /dev/null @@ -1,2202 +0,0 @@ -C -C BULLETIN1.FOR, Version 7/28/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_P = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_P = LEN_P + I + 1 - BULL_PARAMETER(LEN_P:LEN_P) = ',' - END DO - LEN_P = LEN_P - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:I)//'""'// - & BULL_PARAMETER(I+1:) - I = I + 2 - LEN_P = LEN_P + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',BULL_PARAMETER(:LEN_P) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*32,DEFAULT_USER*12 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - IF (IER1.EQ.0) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THEN - I = IER - ELSE - NUM_COPY = NUM_COPY + 1 - END IF - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (.NOT.ORIGINAL.AND.REMOTE_SET.EQ.4).OR.REMOTE_SET.EQ.3 - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0.AND.NEWS_FEED()) THEN - IF (.NOT.ORIGINAL) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - IER1 = .FALSE. - ELSE - REMOTE_SET = 3 - END IF - END IF - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - ELSE - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF (TO_NEWS.AND.ORIGINAL) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2000' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (REMOTE_SET.GE.3.AND..NOT.ORIGINAL) THEN - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT) - ELSE - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (POST_NEWS) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADER - IF (ORIGINAL.AND.(NEWS_FEED().OR.REMOTE_SET.EQ.4)) RETURN - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IF - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./ - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND. - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0 - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN) - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0) - IF (CHANGED) THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IF - -50 IF (PRINT_NUM.EQ.0) THEN - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = PRINT_NUM - EBULL = SBULL - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name - IF (QLEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - END IF - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100 - CLOSE (UNIT=24,STATUS='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - END IF - -1040 FORMAT(' Message ',A,' sent to printer.') -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE. - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) - END IF - - CALL DISABLE_PRIVS - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A, - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE. - GO TO 50 - END IF - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ_MSG -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /POST/ POSTTIME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH) - CHARACTER HEADLINE*132 - - LOGICAL SINCE,PAGE - - EXTERNAL CLI$_NEGATED - - KILL = BTEST(BULL_USER_CUSTOM,3) - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3) - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE. - END IF - ROTC = CLI$PRESENT('ROTATE') - END IF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSE - BULL_READ = 1 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - NEW = .TRUE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - END IF - END IF - BULL_READ = IER - IER = IER + 1 - END IF - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999 - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IF - - NEXT = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - IF (.NOT.SINCE.AND..NOT.NEW - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THEN - IER = 0 - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR. - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN - MSG_NUM = F_NBULL+1 - ELSE - MSG_NUM = BULL_NOW - END IF - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE - CALL GET_THIS_OR_NEXT_TAG - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0 - END IF - END IF - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END IF - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END DO - CALL CLOSE_BULLDIR - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READ - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSE - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0 - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IF - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE. - CALL READDIR(BULL_READ,IER) - END IF - END IF - IF (REMOTE_SET.LT.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - IF (IER.NE.BULL_READ+1) THEN - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0 - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) ! If not, then error out - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEN - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - - IF (.NOT.OK) THEN - BULL_NOW = MSG_NUM - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN - BULL_READ = MSG_NUM - 1 - ELSE - BULL_READ = MSG_NUM + 1 - END IF - IF (REMOTE_SET) CALL CLOSE_BULLFIL - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - GO TO 50 - END IF - - BLOCK = BLOCK_SAVE - END IF - - NEXT = .FALSE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - END IF - - EDIT = .FALSE. - - PAGE_WIDTH = REAL_PAGE_WIDTH - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN - IF (CLI$PRESENT('EDIT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 9999 - END IF - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTH - PAGE = .FALSE. - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSE - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL - END IF - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:) - END DO - I = TRIM(HEADLINE) - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)) - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - ELSE - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROM - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - IF (EDIT) WRITE(3,'(1X)') - ELSE - END = END + 1 - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IF - END IF - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) THEN - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter - GO TO 9999 - END IF - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - -9999 POSTTIME = .FALSE. - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - RETURN - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO - - RETURN - END - - - - - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1 - EQUIVALENCE (INREAD4,INREAD) - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - BULL_POINT_READ = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - - GO TO 12 - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - - BULL_POINT = BULL_POINT_SAVE - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN - ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL FILE(0,.TRUE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THEN - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THEN - WRITE (6,'(''+B'',$)') - INCMD = 'RESPOND/LIST' - ELSE - GO TO 11 - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')') - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLY - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message', - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),', - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) -1040 FORMAT(' Type P to post reply, U to reply to user,', - & ' B to do both, or other to quit: ',$) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END - - - - - LOGICAL FUNCTION NEWS_FEED() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - I = SLIST + 1 - FLEN = TRIM(FOLDER_DESCRIP) - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN - I = FLEN + 1 - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND. - & FOLDER_DESCRIP(I:I).NE.'@'.AND. - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE - I = FLEN + 2 - END IF - END DO - IF (I.EQ.FLEN+1) NEWS_FEED = .TRUE. - END IF - - RETURN - END diff --git a/decus/vms93b/bulletin/bulletin10.for b/decus/vms93b/bulletin/bulletin10.for deleted file mode 100644 index eb517c6..0000000 --- a/decus/vms93b/bulletin/bulletin10.for +++ /dev/null @@ -1,3047 +0,0 @@ -C -C BULLETIN10.FOR, Version 1/10/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - IF (END_LINE.GT.257.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - END IF - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - 2 - IF (BUFFER(EB+2:EB+2).NE.LF) EB = EB + 2 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - CALL NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER().OR.SETPRV_PRIV()) THEN - CALL NEWS_POST('cancel',0,IER,'Delete news item.') - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - BACKSEARCH = END - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.127) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8 - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONE - CHARACTER*4 ZONE - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/ - - CHARACTER*8 TIMES(1) - DATA TIMES /'-5:30'/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - IF (INDEX(ZONES,ZONE).LT.5) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) - END IF - ELSE - HOUR = '00:00' - END IF - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_L_TI(DATE,TIME(:2),,,) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - CHARACTER*256 TEMP_FROM_LINE - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - NEWSGROUPS = ' ' - LREF = 0 - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.') - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.127) - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - TEMP_FROM_LINE = FROM_LINE - CALL GET_FROM(TEMP_FROM_LINE(7:),TRIM(FROM_LINE)) - LAST_FROM = .TRUE. - ELSE - LAST_FROM = .FALSE. - END IF - END IF - END DO - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'3FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - START = -1 - IER = SYS$ASCTIM(,TIME,IN_BTIM,) - CALL DATE_TIME(TIME) - SKIP = 0 - DO WHILE (SKIP.GE.0) - IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( - & FOLDER_NAME))//' '//TIME)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'23') THEN - IF (.NOT.NEWS_READ()) CALL EXIT - DO I=1,SKIP - IF (.NOT.NEWS_READ()) CALL EXIT - END DO - FIRST = BUFFER(SB:EB) - IF (FIRST.EQ.'.') RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL EXIT - END DO - IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) - & CALL EXIT - IF (.NOT.NEWS_READ()) CALL EXIT - IF (BUFFER(:2).EQ.'22') THEN - IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN - I = F_NBULL + 1 - DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. - & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) - & .OR.I.GT.F_NBULL)) - I = I - 1 - IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (I.GE.F_START) START = I - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END IF - RETURN - END IF - END IF - SKIP = SKIP + 1 - END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2 - IER = IER1 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - CHARACTER*256 TEMP,TEMP1 - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IF - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0 - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE - IER = NEWS_READ() - IF (IER.AND.BUFFER(SB:EB).NE.'.') THEN - IER = 0 - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THEN - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF (INDEX(TEMP,': ').EQ.0.AND. - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255) THEN - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IF - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IF - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF - ELSE - HEADER_SEEN = .TRUE. - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128 - ELSE - ILEN = 128 - END IF - END IF - ELSE - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ABS(ILEN).EQ.128) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /READIT/ READIT - - COMMON /NEWS_INIT/ END_READ - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - - DIMENSION DUMMY(4) - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - END_READ = 0 - IF (.NOT.NEWS_LOGIN()) THEN - IER = 2 - RETURN - END IF - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY) - IF (SYSLOG) THEN - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3)) - END IF - END IF - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUP - - CHARACTER*8 NUMBER - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURN - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1 - RETURN - ELSE IF (ICOUNT.EQ.-1) THEN - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THEN - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURN - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - START = ICOUNT - BULLETIN_NUM = START - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0 - CALL NEWS_HEADER(IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - BLOCK = START - MSG_NUM = START - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN - END - - - - SUBROUTINE NEWS_GROUP(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)) - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT') - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURN - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME - - CHARACTER*20 TIME - - I = 1 - LTIME = TRIM(INTIME) - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:)) - - DO J = 1,2 - I = 1 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-' - END DO - - IF (I.EQ.LEN(TIME)) RETURN - - IF (TIME(I+3:I+3).EQ.' ') THEN - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IF - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DO - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) RETURN - - CALL SYS_BINTIM(TIME(:I-2),BTIM) - - IF (INDEX(INTIME,'GMT').GT.0) CALL CONVERT_FROM_GMT(BTIM) - - RETURN - END - - - - SUBROUTINE NEWS_LIST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - CHARACTER TODAY*24 - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR. - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER)) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - NEWS_FOLDER1_BBOARD = '::' - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14 - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNT - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1 - IF (IER.NE.0.OR.IER1.NE.0) THEN - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLEN - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN - NEWS_FOLDER = NEWS_FOLDER1(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)// - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - END IF - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - IF (IER2.EQ.0) THEN - NEWS_F1_FLAG = NEWS_F_FLAG - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN - NEWS_F1_EXPIRE = NEWS_F_EXPIRE - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1) - IF (BTEST(NEWS_F1_FLAG,8)) THEN - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_LAST = 0 - END IF - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE. - IF (FLEN.GT.44) THEN - IF (NEWS_FOLDER1_DESCRIP.NE. - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - IF (SPECIAL) THEN - IF (UPDATE) THEN - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF - ELSE IF (.NOT.UPDATE) THEN - UPDATE = F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.F1_START.AND. - & NEWS_F1_FIRST.GT.F1_NBULL) THEN - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE), - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (((F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND.(.NOT.BTEST(NEWS_F1_FLAG,8).OR. - & NEWS_F1_NBULL.LT.NEWS_F1_START - & .OR.NEWS_F1_START.EQ.0)) THEN - DELETE (UNIT=7) - IER = 0 - END IF - END IF - END DO - END IF - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DO - - RETURN - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4 - - COMMON /LOCALPOST/ LOCAL_POST - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER TODAY*24,UNAME*132 - DATA UNAME /'()'/ - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1) - IF (IER1.NE.0) RETURN - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900 - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3) - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSE - I = INDEX(NEWS_MSGID,'.') - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & NEWS_MSGID(:I-1)// - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256) - IF (IER.NE.0) RETURN - LOCAL_POST = .TRUE. - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1 - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP - ELSE IF (.NOT.BTEST(FOLDER_FLAG,8).AND. - & TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - INPUT = 'Newsgroups: '//NEWSGROUPS - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER) - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0 - DO WHILE (CLI$GET_VALUE('GROUPS',FOLDER1_NAME,FLEN) - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT)) - CALL LOWERCASE(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1) - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9)) THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST, - & FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - END IF - END DO - CALL CLOSE_BULLNEWS - END IF - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900 - END IF - ATSIGN = INDEX(PATHNAME,'@') - PCSIGN = INDEX(PATHNAME,'%') - CALL LOWERCASE(USERNAME) - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - END IF - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME) - - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - CALL STR$UPCASE(FROM_LINE,FROM_LINE) - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME) - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'// - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECT - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) - & GO TO 900 - END IF - - IF (NGROUPS.GT.0) THEN - FROM = USERNAME - DESCRIP = SUBJECT - END IF - - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//'>')) GO TO 900 - - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION) - END IF - LORGAN = TRIM(ORGANIZATION) - END IF - - IF (LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN))) - & GO TO 900 - END IF - - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & ZONE(:LZONE))) GO TO 900 - - IF (REMOTE_SET.EQ.4.AND..NOT. - & (CREATE.OR.FILENAME.EQ.'cancel')) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE( - & FIRST_ALPHA(EXDATE):2) - & //' '//EXDATE(4:6)//' '//EXDATE(10:TRIM(EXDATE)) - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900 - ELSE - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT) - END IF - EXTIME = '00:00:00.00' - END IF - END IF - - IF (CREATE) THEN - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURN - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).EQ.'240') IER = 0 - ELSE - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - LOCAL_POST = .FALSE. - RETURN - END IF - - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2 - END IF - IF (IER1.EQ.0) THEN - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DO - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') THEN - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:EB) - END IF - ELSE - LENGTH = (LENGTH+127)/128 - GROUP_LIST = GROUP_LIST1 - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - DO I=NGROUPS,1,-1 - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1) - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL ADD_LOCAL_NEWS(8) - END IF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - - LOCAL_POST = .FALSE. - - RETURN - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURN - END IF - END IF - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME) - LPATH = TRIM(PATHNAME) - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NAME - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME) - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE. - END DO - - TEST_NEWS = MAYBE_NEWS - - RETURN - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) RETURN - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULL - FIRST = F1_START - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - CALL OTS$CVT_L_TI(F_LAST+1,NUMBER,,,) - REMOTE_SET = 3 - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNT - NEW_NEWS_F_END = NEWS_F_END - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - F_LAST = LAST - NEWS_F_FIRST = FIRST - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE NEWS2BULL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER TIME*20,FIRST*80,FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBER - - DIMENSION SAVE_F_NEWEST_BTIM(2),NOW(2) - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV - - CALL NEWS_LIST - - CALL UPDATE_LOCAL_NEWS - - CALL SEND_POST - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - ELIST = INDEX(FOLDER_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN - IF ((FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR. - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))).AND. - & INDEX(FOLDER_DESCRIP(SLIST+2:),'@').EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARD - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (IER) THEN - SAVE_LAST = F_LAST - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER) - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN - SAVE_LAST = F_NBULL - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LAST - FOLDER_BBOARD = 'NONEFEED' - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - REMOTE_SET = 3 - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1) - END IF - CALL CLOSE_BULLFOLDER - END IF - END IF - END DO - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - CHARACTER*(*) TIME - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+ - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)// - & TIME(16:17)//TIME(19:20) - - RETURN - END - - - - SUBROUTINE ALLPRIV - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1 - PROCPRIV(2) = -1 - NEEDPRIV(1) = -1 - NEEDPRIV(2) = -1 - - RETURN - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COM - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - RETURN - END - - - - SUBROUTINE SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')') - RETURN - END IF - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE - WRITE (6,'('' You are now subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - LAST_NEWS_READ(2,J) = F_START - 1 - ELSE - LAST_NEWS_READ2(2,J) = 0 - LAST_NEWS_READ(2,J) = F_NBULL - END IF - CALL CLOSE_BULLNEWS - RETURN - END IF - END DO - - END - - - - - - SUBROUTINE UNSUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - - CALL FREE_TAGS(I) - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE1() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR. - & (LAST_NEWS_READ(2,I).GT.F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0 - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THENr - COUNT = COUNT + 1n - END IFe - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT). - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE - SUBNUM = 0 - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES)R -C -C SUBROUTINE NEWS_NEW_NOTIFICATION -CW - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'A - - COMMON /READIT/ READITF - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)R - - MESSAGES = .FALSE. - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1) - - FOLDER_DESCRIP = ' 'F - REORDER = 0 - DO WHILE (SUBNUM.GT.0)N - IER = 1. - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)D - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - FOLDER1_DESCRIP = FOLDER_DESCRIP) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUM2 - UNLOCK 7 - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1 - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - ELSE IF (IER.NE.0) THEN - SUBNUM = -1S - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR.R - & F_START.GT.F_NBULL) THENI - IER = 1E - END IF_ - END IFT - IF (IER.EQ.0.AND.SUBNUM.GT.0) THENE - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR.( - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR.N - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)T - IF (DIFF.GT.0) IER = 1N - END IF - END IFC - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN - WRITE (6,'('' There are new messages in folder '',H - & A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)E - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - ELSE - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1)E - IF (IER1) THEN - CALL LOGIN_FOLDERZ - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBERA - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINTS - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IFL - END IF - END DOR - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBEE - - CALL CLOSE_BULLNEWS - - RETURN) - END - - - SUBROUTINE REORDER_SUBSCRIBEE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'S - - INCLUDE 'BULLUSER.INC'E - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0)E - I = I + 1S - END DOC - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1D - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1) - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2I - TEMP = LAST_NEWS_READ(L,J)M - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K)( - LAST_NEWS_READ(L,K) = TEMP - END DO - END IFE - END DO - END DO. - - RETURN - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)C - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENE - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IFI - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14)I - - RETURNM - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER)C - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENR - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IFU - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15)& - - RETURNM - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLUSER.INC'I - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENR - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE.& - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURND - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBERM - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1A - END DO - - NEWS_FIND_SUBSCRIBE = I - - RETURNR - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'H - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1) - END DOQ - - NEWS_FIND_SUBSCRIBE1 = Ip - - RETURN - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z)W - - INCLUDE 'BULLUSER.INC'T - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IFA - - IF (NOTIFY.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13)= - IF (NOTIFY.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13)T - IF (READNEW.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - - CALL UPDATE_USERINFOO - - RETURNE - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNTE - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINEI - CHARACTER*12 MSGNUM - - REWIND UNIT - ) - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM). - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '// - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK)D - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN1 - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6, - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) - END IFN - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THENT - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1X - SYSTEM = 0T - CALL ADD_ENTRY - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - ENDT - - - - SUBROUTINE UPDATE_NEWS_FOLDER -C -C SUBROUTINE UPDATE_NEWS_FOLDER -C -C FUNCTION: Updates folder info due to new message. -CU - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'M - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN( - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWS_F_NEWEST_BTIM) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNTE - END IF& - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1 - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_NEWEST_EX_BTIM_KEY(5:)M - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURN1 - END - - - - SUBROUTINE SEND_POST - - IMPLICIT INTEGER (A-Z) I - - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280O - 1 - CHARACTER FILE*132 - E - C = 0 - . - IF (.NOT.NEWS_LOGIN()) RETURN' - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST',FILE,C)) ' - IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURNA - IF (BUFFER(:3).NE.'340') RETURN - E - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IF: - END DO - IF (INPUT.NE.'.') THEN 1 - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - END DO - -100 CLOSE (UNIT=3) - - RETURNX - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)'T - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVS( - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100: - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST) - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0)L - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - - IF (UNAME.EQ.'()') THEN - UNAME = ' ' - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IF - - RETURNE - END diff --git a/decus/vms93b/bulletin/bulletin11.for b/decus/vms93b/bulletin/bulletin11.for deleted file mode 100644 index 909a48e..0000000 --- a/decus/vms93b/bulletin/bulletin11.for +++ /dev/null @@ -1,2667 +0,0 @@ -C -C BULLETIN11.FOR, Version 1/11/94 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*12 BULL_MARK_DIR - CHARACTER*12 TAG_KEY,INPUT_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,) - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1) - ELSE - UNLOCK 13 - END IF - END IF - - NTRIES = 0 - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),) - IF (IER1.NE.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128,DISPOSE='DELETE', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1) - NEWS_MARK2(1) = NEWS_MARK2(2) - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURN - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1), - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IF - - RETURN - END - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - - CHARACTER*12 BULL_MARK_DIR - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSE - MARKUNIT = 23 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1 - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEY - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IF - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY) - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURN - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - TAG_TYPE = 0 - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR. - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN - IF (IER.EQ.0) UNLOCK 13 - IER = 0 - MESSAGE = MSG_NUM - ELSE - IER = 36 - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - IER = 36 - - HEADER = .FALSE. - - TAG_TYPE = 0 - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) THEN - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:) - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THEN - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I) - IER = 0 - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - MSG_KEY = NEXT_MSG_KEY - RETURN - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DO - - RETURN - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - DO MESSAGE = MSG_NUM+1,F_NBULL - CALL READDIR(MESSAGE,IER) - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE) - IF (IER.EQ.0) THEN - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END DO - - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2) - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURN - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER) - & INPUT_KEY - END DO - - CLOSE_IT = .FALSE. - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - CALL DECREMENT_MSG_KEY - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR_SHARED - CLOSE_IT = .TRUE. - END IF - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - DELETE (UNIT=13) - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER)) - READ (13,IOSTAT=IER) INPUT_KEY - END DO - END IF - END IF - - END DO - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE. - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1 - DO M=1,2 - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1 - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1 - LIMIT = 256/(NEWS_FORMAT+1) - NEWS_NUMBER = LAST_NEWS_READ2(1,I) - K = 5-NEWS_FORMAT*2 - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1 - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IF - SET_LIST = .FALSE. - END IF - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0) - END DO - K = LIMIT + 1 - END IF - IF (K.GT.LIMIT) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2 - NEWS_REC = NEWS_REC + 1 - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - IF (IER.EQ.0) THEN - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IF - END DO - END IF - END DO - END DO - CLOSE (UNIT=23) - END IF - - RETURN - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = J - ELSE - NEWS_MARK(I) = J - END IF - - RETURN - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG) - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUM - NEWS_TAG(I) = 0 - END DO - - RETURN - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - DO I=1,2 - IF (NEWS_TAG(3,I,ISUB).GT.0) THEN - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB)) - NEWS_TAG(3,I,ISUB) = 0 - NEWS_NUMBER = NEWS_FOLDER_NUMBER - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER) - END IF - END DO - END IF - - DO J=I,FOLDER_MAX-2 - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J)) - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0 - END DO - END DO - - RETURN - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY - - IER = 36 - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE) - IF (IER.EQ.0) THEN - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THEN - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM) - END IF - IER = 36 - END IF - END IF - END DO - BULL_READ = MSG_NUM - IF (CLOSE_IT) CALL CLOSE_BULLDIR - ELSE - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0 - MSG_KEY = BULLDIR_HEADER - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THEN - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36 - END IF - END IF - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*24 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1)) - - CALL DISABLE_PRIVS - - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))// - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:) - END DO - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR) - - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO)) - I = INDEX(SENDTO(J:),',') - 1 - IF (I.EQ.-1) I = TRIM(SENDTO(J:)) - CALL INIT_ITMLST - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - J = J + I - IF (SENDTO(J:J).EQ.',') J = J + 1 - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) - IF (SETPRV_PRIV()) THEN - CALL ENABLE_PRIVS - CALL ADD_2_ITMLST - & (TRIM(USERNAME),MAIL$_SEND_FROM_LINE,%LOC(USERNAME)) - END IF - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO)) - CALL END_ITMLST(ATTRIBUTE_ITMLST) - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - CALL LIB$REVERT - - RETURN - END - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,) - - RETURN - END - - - - - SUBROUTINE SET_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /NEXT/ NEXT - - DIMENSION EXPIRED(2) - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IF - - ENTRY SHOW_NEWS - - LIMIT = -2 - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1)) - IF (.NOT.IER.OR.LIMIT.LT.-1) THEN - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')') - RETURN - END IF - END IF - - EXPIRE = -1 - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1)) - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN - END IF - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR. - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')') - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - IF (CLI$PRESENT('DEFAULT')) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1 - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - RETURN - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE) - FOLDER1_NUMBER = NEWS_F1_COUNT - FOLDER1 = BULL_PARAMETER - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10) - CALL WRITE_FOLDER_FILE_TEMP(IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMP - REWRITE (7) NEWS_FOLDER1_COM - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER) - END IF - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - END IF - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS') - DEFAULT = CLI$PRESENT('DEFAULT') - ALL = CLI$PRESENT('ALL') - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE') - ENABLE = CLI$PRESENT('ENABLE') - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - - STORED = 0 - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN - WRITE (6,'('' Stored setting was not removed.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(BULLNEWSDIR_FILE( - & :TRIM(BULLNEWSDIR_FILE))//';*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'[.BULLNEWS*]*.*;*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_SAVE = FOLDER - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - FOLDER = FOLDER_SAVE - CALL OPEN_BULLDIR_SHARED - KEEPLOCK = .TRUE. - NEXT = .TRUE. - BULL_DELETE = 1 - F_START = 0 - F_NBULL = 999999 - CALL READDIR(BULL_DELETE,IER) - DO WHILE (IER.EQ.BULL_DELETE+1) - DELETE (2) - CALL READDIR(BULL_DELETE,IER) - END DO - NEXT = .FALSE. - KEEPLOCK = .FALSE. - CALL CLOSE_BULLDIR - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0 - F1_NBULL = 0 - F1_COUNT = 0 - F1_LAST = 0 - END IF - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3) - IF (IER.NE.0) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - END IF - CALL RESET_PROTECTION - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IF - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THEN - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')') - ELSE - WRITE (6,'('' Default is not stored.'')') - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS) THEN - WRITE (6,'('' Expiration is DEFAULT value.'')') - ELSE - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Default expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no default expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')') - ELSE - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IF - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER) - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) - END IF - FOUND = .FALSE. - MODALL = INDEX(GROUP,'.').NE.LG - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR. - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.')) - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL OPEN_BULLDIR_SHARED - KEEPLOCK = .TRUE. - NEXT = .TRUE. - BULL_DELETE = 1 - F_START = 0 - F_NBULL = 999999 - CALL READDIR(BULL_DELETE,IER) - DO WHILE (IER.EQ.BULL_DELETE+1) - DELETE (2) - CALL READDIR(BULL_DELETE,IER) - END DO - NEXT = .FALSE. - KEEPLOCK = .FALSE. - CALL CLOSE_BULLDIR - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER) - END DO - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER) - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - RETURN - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - END DO - END IF - - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IF - - FULL = CLI$PRESENT('FULL') - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P)) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (CLI$PRESENT('SUBJECT')) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IF - ELSE - INPUT = FROM - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:) - ELSE - INPUT = DESCRIP - END IF - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - INPUT = 'SUBJECT:'//INPUT - ELSE - INPUT = 'FROM:'//INPUT - END IF - - IF (EXCLUDE) THEN - INPUT = ':EXCLUDE:'//INPUT - ELSE - INPUT = ':INCLUDE:'//INPUT - END IF - - FLEN = TRIM(FOLDER_NAME) - INPUT = FOLDER_NAME(:FLEN)//INPUT - - ILEN = TRIM(INPUT) - ALL = CLI$PRESENT('ALL') - DISABLE = CLI$PRESENT('DISABLE') - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) - & WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - CLOSE (UNIT=4,DISPOSE='SAVE') - RETURN - END IF - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERL - IF (IER.EQ.0) THEN - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THEN - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5)C - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill' - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF (STREQ(OLD_BUFFER(:OLEN),INPUT(:ILEN))) THENI - IF (.NOT.DISABLE) THEN - WRITE (6,'('' ERROR: Entry already present.'')') S - CLOSE (UNIT=4) ( - CLOSE (UNIT=3) S - RETURN - END IF - ELSE IF (.NOT.(ALL.AND.INPUT(:FLEN+8).EQ. - & OLD_BUFFER(:MIN(FLEN+8,OLEN)))) THEN - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN) - END IFD - END IF - END DOE - - IF (.NOT.DISABLE) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)o - IF (FULL) WRITE (4,'(A)',IOSTAT=IER) - & FOLDER_NAME(:FLEN)//':defaults:kill'. - END IF - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL CHECK_CUSTOM - - RETURN - ENDE - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'W - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEO - DATA SCRATCH_B1/0/a - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THEN - BULL_USER_CUSTOM = .FALSE. - ELSE' - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IFL - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'I - - OPEN(UNIT=17,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)),A - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURNC - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?A - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER)M - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IFT - - NINCLUDE = 0D - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ. - & OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+1,OLEN))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1). - CALL LOWERCASE(OLD_BUFFER)L - IF (INDEX(OLD_BUFFER(TRIM(FOLDER_NAME)+2:),'defaults')E - & .EQ.1) THENF - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1r - END IFT - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THENA - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - END IF - END DO. - - CLOSE (UNIT=17) - - RETURN - END - - - - E - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1) - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'. - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./L - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE - DATA SCRATCH_B1/0/p - - CHARACTER*(*) STRING,STRING1e - - INCLUDE_MSG = .TRUE.O - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURNE - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - INC = .FALSE. - - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)! - OLEN = TRIM(OLD_BUFFER)S - IF (STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THEN. - IF (.NOT.INC) INCLUDE_MSG = .FALSE. - INC = .TRUE. - END IF_ - IF ((STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:').AND.L - & (STRFIND(STRING(:TRIM(STRING)),OLD_BUFFER) - & (FLEN+15:OLEN)).OR. - & STREQ(STRING(:TRIM(STRING)),OLD_BUFFER - & (FLEN+15:FLEN+14+TRIM(STRING))))).OR._ - & (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND.I - & STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER - & (FLEN+18:OLEN)))) THEN - INCLUDE_MSG = STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')0 - IF (.NOT.INCLUDE_MSG) RETURNe - END IF' - END IF - END DOO - - RETURNw - END - - - - FUNCTION STRFIND(STRING,STRING1)D - - IMPLICIT INTEGER (A-Z)P - - CHARACTER*(*) STRING,STRING1' - - L = LEN(STRING1)C - DO I=0,LEN(STRING)-LI - J = 1L - DO WHILE (J.LE.L) - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J)))A - IF (DIFF.NE.0.AND.DIFF.NE.32) THENA - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = .TRUE.N - RETURNL - ELSEN - J = J + 1 - END IFS - END DO - END DOL - - STRFIND = .FALSE. - - RETURN - END diff --git a/decus/vms93b/bulletin/bulletin2.for b/decus/vms93b/bulletin/bulletin2.for deleted file mode 100644 index 750c0e4..0000000 --- a/decus/vms93b/bulletin/bulletin2.for +++ /dev/null @@ -1,2364 +0,0 @@ -C -C BULLETIN2.FOR, Version 2/10/94 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::'.OR.NEWS_FEED()) THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'RE:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'RE: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - IF (IER.NE.0) FILESPEC = .FALSE. - CALL ENABLE_PRIVS - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.EQ.0) THEN - INFROM = INPUT(:ILEN)//',' - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - ILEN = TRIM(INPUT) - IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(INPUT(7:),ILEN) - INFROM = INFROM(:LENFRO)//INPUT(7:) - LENFRO = LENFRO + ILEN - 6 - END IF - IF (EDIT.AND.TEXT) THEN - IF (INPUT(ILEN:ILEN).EQ.'"') ILEN = ILEN - 1 - INPUT = INPUT(7:ILEN) - ILEN = ILEN - 6 - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:) - ILEN = TRIM(INPUT) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:ILEN)//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THEN - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - IER = 0 - END IF - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')') - END IF - END IF - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IF - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (.NOT.FILESPEC) THEN - WRITE (6,'('' Enter message: End with ctrl-z,'', - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - ELSE - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IF - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IF - END IF - END IF - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No message added.'')') - IF (.NOT.STATUS) THEN - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ') - IF (STREQ(INPUT(:1),'Y')) THEN - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV') - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IF - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C -C SUBROUTINE ADD_SIGNATURE -C -C FUNCTION: Adds signature to message being mailed/posted. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATURE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/ - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURN - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) RETURN - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IF - - ICOUNT = 0 - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME))) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THEN - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END DO - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IF - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE. - ELSE - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' ' - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - END DO - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,INPUT1 - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.DIFF.NE.32) RETURN - END DO - - STREQ = .TRUE. - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -C -C SUBROUTINE RESPOND_MAIL -C -C FUNCTION: Sends mail to address. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,INDESCRIP*(LINE_LENGTH) - - INDESCRIP = SUBJECT - LENDES = TRIM(INDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES) - IF (INDESCRIP(I:I).EQ.'"') THEN - IF (LENDES.EQ.LINE_LENGTH) THEN - INDESCRIP(I:I) = '`' - ELSE - INDESCRIP = INDESCRIP(:I)//'"' - & //INDESCRIP(I+1:) - I = I + 1 - LENDES = LENDES + 1 - END IF - END IF - I = I + 1 - END DO - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0 - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD) - - IF (LISTSERV) THEN - IF (SYS_TRNLNM('MX_NODE_NAME',MAILER)) THEN - REPLY_TO = .NOT.SYS_TRNLNM('MX_REPLY_TO',MAILER) - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - REPLY_TO = .NOT.SYS_TRNLNM('PMDF_REPLY_TO',MAILER) - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - END IF - END IF - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO) - & //'""" """'//INDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IF - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//INDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE - I = INDEX(SENDTO,'%""') + 3 - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THEN - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THEN - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THEN - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & INDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) -C -C Use the following if you do not have VMS V5.3 or greater. -C -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//INDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IF - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV) THEN - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('PMDF_REPLY_TO') - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('MX_REPLY_TO') - END IF - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: CHANGE command subroutine. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWER - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IF - -C -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')') - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')') - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - LENFROM = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description header - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT, - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10) - - EXTERNAL CLI$_ABSENT - - NFOLDER = 1 - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - END IF - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME - NFOLDER = NFOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DO - - IF (CLI$PRESENT('SELECT_FOLDER')) SCRATCH_F = SCRATCH_F1 - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IF - - IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SEARCH_LEN(1) = 3 - SEARCH_NUM = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - SEARCH_NUM = 1 - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1 - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM) - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1 - ELSE - SEARCH_STRING = ' ' - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IF (NFOLDER.GT.0) FOUND = 0 - - DO WHILE (NFOLDER.GT.0.AND.FOUND.LE.0) - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL, - & CLI$PRESENT('REVERSE'),CLI$PRESENT('SUBJECT') - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'), - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),MATCH_MODE) - IF (FOUND.EQ.-1) THEN - NFOLDER = 0 - ELSE IF (FOUND.LE.0) THEN - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1) NFOLDER = NFOLDER - 1 - IF (NFOLDER.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F, - & FOLDER1_NAME) - END IF - END IF - END DO - END IF - END IF - END DO - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - WRITE (6,'('' No messages found with given search string.'')') - ELSE IF (FOUND.EQ.-2) THEN - WRITE (6,'('' ERROR: No more messages.'')') - END IF - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN, - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE) -C -C SUBROUTINE GET_SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEXT/ NEXT - LOGICAL NEXT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*4 SAVECMD - - CHARACTER*56 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THEN - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(START_BULL,IER) - IF (START_BULL+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - END IF - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR. - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last - END IF - IF (REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0 - BULL_SEARCH = START_BULL+1 - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR. - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY) - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - ELSE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - IF (IER.EQ.0) THEN - IER = BULL_SEARCH + 1 - ELSE - GO TO 800 - END IF - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - IF (SEARCH_MODE.EQ.4) THEN - CALL STR$UPCASE(DESCRIP1,FROM) - ELSE - CALL STR$UPCASE(DESCRIP1,DESCRIP) - END IF - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1.AND. - & DESCRIP1(:4).EQ.'RE: ')))) THEN - IF (.NOT.NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - GO TO 900 - ELSE IF (NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - MATCHES = 0 - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE. - END DO - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THEN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I) - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR. - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - GO TO 900 - END IF - END DO - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE - FOUND = -1 - END IF - END IF - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULL - END DO - -800 FOUND = 0 - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - END IF - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - NEXT = .FALSE. - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMD - - RETURN - END - - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE) - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRING - - OLD_MATCH = .FALSE. - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURN - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE. - RETURN - END IF - J = J + SEARCH_LEN(I) - END DO - - RETURN - END - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')') - RETURN - END IF -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:)o - END IF - END IFe - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')'): - ELSE. - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COMU - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I)L - ELSE - WRITE (6,'('' Message was undeleted.'')')* - END IF( - ELSE - CALL DISCONNECT_REMOTE( - END IF - END IFr - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010)F - GO TO 900 - -920 WRITE(6,1020), - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.')2 -1030 FORMAT(' ERROR: Specified message was not found.')& -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.')L - - END - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z)C - - INCLUDE 'BULLNEWS.INC'I - - CHARACTER*20 MAIL_PROTOCOLI - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - IF (INDEX(INPUT,'<').GT.0.AND. ! Name may be of formN - & INDEX(INPUT,'@').GT.INDEX(INPUT,'<')) THEN - INPUT = INPUT(INDEX(INPUT,'<'):)! personal-name - END IFP - - IF (LMAIL.EQ.0) THEN - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THENT - MAIL_PROTOCOL = MAILER - END IF - LMAIL = TRIM(MAIL_PROTOCOL)7 - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%' - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1. - RETURN - END IF - END IF_ - - AT = INDEX(INPUT,'@') - IF (AT.GT.0) INPUT = INPUT(:INDEX(INPUT(AT:),' ')+AT-2) - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"' - - IF (ILEN.NE.0) ILEN = ILEN + LMAIL + 2h - - RETURN' - END diff --git a/decus/vms93b/bulletin/bulletin3.for b/decus/vms93b/bulletin/bulletin3.for deleted file mode 100644 index fe37ad4..0000000 --- a/decus/vms93b/bulletin/bulletin3.for +++ /dev/null @@ -1,2281 +0,0 @@ -C -C BULLETIN3.FOR, Version 1/18/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_EDT' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THEN - CALL EDT$EDIT(' ',OUT) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT) - ELSE - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IF - END IF - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT - ELSE - WRITE(6,'('' Could not activate editor.'')') - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE) - - RETURN - END - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - CALL DELETE_EXPIRED_NEWS(NOW) - CALL SYS$SETAST(%VAL(1)) - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - CALL SYS$SETAST(%VAL(0)) - CALL REGISTER_BULLCP - IER1 = 1 - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - - BBOARD_LOOP = BBOARD_LOOP + 1 - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & NEWS_LOOP.EQ.0) CALL CREATE_PROCESS('BULLCP NEWS') - CALL SYS$SETAST(%VAL(1)) - - NEWS_LOOP = NEWS_LOOP + 1 - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIME - CALL HIBER('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - DIMENSION NEW_SYSTEM_FLAG(FLONG) - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2)) - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER) - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - CALL SETUSER(USERNAME) - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAG - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - END DO - FOLDER_FLAG = FOLDER1_FLAG - FOLDER_NUMBER = 0 - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - CALL CLOSE_BULLUSER - ELSE - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DO - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IF - CLOSE (UNIT=REMOTE_UNIT) - END DO - END IF - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE HIBER(MIN) -C -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -C -C SUBROUTINE DELETE_EXPIRED_NEWS -C -C FUNCTION: -C -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - INTEGER TODAY(2),DAY(2),NEXT_EX_BTIM(2) - - CHARACTER*8 TODAY_KEY - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - CALL SYS_BINTIM('-',TODAY) - - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END DO - CALL NEWS_TO_FOLDER - - UNLOCK 7 - - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - GO TO 1000 - ELSE IF (REMOTE_SET.NE.4) THEN - REMOTE_SET = 4 - CALL OPEN_BULLDIR_SHARED - END IF - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0 - NDEL = -1 - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM) - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. - IF (NDEL.GT.NEWS_F_END) THEN - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1 - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (EXDATE(8:9).EQ.'18'.OR. ! Deleted manually? - & INDEX(EXDATE,'1900').GT.0) THEN - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) - EXTIME = ASCTIME(13:23) - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0 - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0 - UNLOCK 2 - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER) - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_START - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0 - END DO - F_START = I - NEXT = .FALSE. - END IF - CALL READDIR(F_NBULL,IER) - IF (DN.OR.F_NBULL.EQ.IER) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I) - I = I - 1 - CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = I - END DO - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - -1000 IF (NOW) THEN - CONTEXT = 0 - IER = LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT) - IF (IER) IER = CONV$RECLAIM(BULLNEWSDIR_FILE) - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - DO I=1,31 - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;') - END DO - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IF - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER UPTIME_DATE*12,UPTIME_TIME*12 - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/,HEADER_Q1/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(HEADER_Q1,INPUT) - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'READ/NEW' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - HEADER_Q = 0 - NHEAD = 0 - IF (.NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - HEADER_Q = HEADER_Q1 - IER = 0 - CALL STRIP_HEADER(' ',0,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.EQ.0) THEN - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP) - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - NHEAD = NHEAD + 1 - END IF - END DO - - FOUND = .FALSE. - J = 0 - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THEN - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP) - END IF - IF (J.EQ.1.OR.F_BBOARD.NE.FOLDER1_BBOARD) THEN - FLEN = TRIM(F_BBOARD) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DO - END IF - END IF - END IF - END DO - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COM - END IF - - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - ELSE - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - ELSE - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & .NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) CALL NEWS2BULL - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE. - - LEN_BBOARD = LEN(BBOARD) - 1 - - DO I=1,TRIM(INPUT)-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND. - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND. - & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR. - & (INDEX(' .@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0 - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND. - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALPHA(IN) - - CHARACTER*(*) IN - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURN - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN - - BBOARD_NAME = FOLDER_DESCRIP(I+1:) - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!') - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DO - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0) - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - IF (.NOT.IER.AND..NOT.DEL) THEN - CALL DELPRC('BULLCP NEWS',DEL) - IER = .NOT.DEL - ELSE - IER = .TRUE. - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI) -C -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF - END IF - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2)) - - RETURN - END - - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DO - - CALL CLOSE_BULLDIR - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAM - - DATA OBIO/0/,OCPU/0/,ODIO/0/ - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAM - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU)) - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IF - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1 - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - END IF - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND. - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIO - ODIO = DIO - OCPU = CPU - IER = 0 - RETURN - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IF - RETURN - END diff --git a/decus/vms93b/bulletin/bulletin4.for b/decus/vms93b/bulletin/bulletin4.for deleted file mode 100644 index fe84908..0000000 --- a/decus/vms93b/bulletin/bulletin4.for +++ /dev/null @@ -1,2191 +0,0 @@ -C -C BULLETIN4.FOR, Version 10/20/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(BUFFER,0,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' ') THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - ELSE - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/, COMP /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '', - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAX - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - LENDES = 0 - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACL - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_OWNER = FOLDER1_OWNER - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -C -C Description: -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -C -C SUBROUTINE CREATE_NEWS_FOLDER -C -C FUNCTION: Creates a new newsgroup. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME) - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF -C -C If file specified in command, read file. -C Else, read from the terminal. -C - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file -2010 FORMAT(A) - ICOUNT = ICOUNT + ILEN - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER, - & 'Adding newsgroup.') - CLOSE (UNIT=3) - - RETURN - -920 WRITE(6,1020) -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURN - -910 WRITE(6,1010) -1010 FORMAT (' No news group was added.') - CLOSE (UNIT=3) - RETURN - - END - - - - - SUBROUTINE INIT_COMPRESS - - IMPLICIT INTEGER (A-Z) - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127 - DO J=0,127 - A(J,I) = ' ' - END DO - END DO - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DO - - J = 1 - DO I=1,8 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=10,31 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=127,254 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - - RETURN - - ENTRY COMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.127) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.127) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:))) - IF (T(O:O).NE.' ') THEN - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND. - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1)) - C = C + 1 - K = K + 1 - END DO - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1) - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0) - O = O + 1 - ELSE - T(O:O) = IN(K:K) - K = K + 1 - O = O + 1 - END IF - END DO - IF (K.EQ.L) THEN - T(O:O) = IN(K:K) - ELSE - O = O - 1 - END IF - - OUT = T - - RETURN - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1 - T(O:O) = IN(I+2:I+2) - END DO - I = I + 3 - ELSE - B = UNMAP(J) - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1 - T(O:O) = IN(I:I) - ELSE - O = O + 2 - T(O-1:O) = B - END IF - I = I + 1 - END IF - END DO - - OUT = T(:O) - - RETURN - END diff --git a/decus/vms93b/bulletin/bulletin5.for b/decus/vms93b/bulletin/bulletin5.for deleted file mode 100644 index e419f48..0000000 --- a/decus/vms93b/bulletin/bulletin5.for +++ /dev/null @@ -1,2349 +0,0 @@ -C -C BULLETIN5.FOR, Version 12/18/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3.OR.FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG - IF (BTEST(FOLDER1_FLAG,2)) THEN - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAG - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & F1_START.GT.0) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_NBULL = F1_NBULL - F_START = F1_START - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - FOLDER_NAME = FOLDER - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - REMOTE_SET_NEW = 1 - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11)) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s news group.'')') - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP( - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN - WRITE (6,'('' Folder only accessible for reading.'')') - END IF - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THEN - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - BULL_PARAMETER = 'MARKED' - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - BULL_PARAMETER = 'SEEN' - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED' - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN' - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - WRITE(6,'('' WARNING: No '',A, - & '' messages found.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IF - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE. - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IF - - IF (TEST_NEWS(FOLDER1)) THEN - INCMD = 'SET NEWS ' - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL ' - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Access is limited.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0) - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,10)) THEN - WRITE (6,'('' POST_ONLY has been set.'')') - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THEN - WRITE (6,'('' COMPRESS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/, - & ' Description: ',A) -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/, - & ' Description: ',A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/ - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' ' - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. - STORED = .FALSE. - CLASS = .FALSE. - NEW = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counter - NLINE = 1 - START = .FALSE. - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE. - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - CALL NEWS_LIST - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - END IF - COUNT = CLI$PRESENT('COUNT') - IF (COUNT) TOTAL_COUNT = 0 - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - NEW = CLI$PRESENT('NEWGROUPS') - CLASS = CLI$PRESENT('CLASS') - IF (CLASS) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - ELSE - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER) - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER - FOLDER_COUNT = -1 - RETURN - ELSE - START = .TRUE. - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN) - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0 - FOLDER_COUNT = -1 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN - SUBNUM = -2 - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DECLARE_CTRLC_AST - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE. - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2 - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THEN - NEW_NEWS = FOLDER1_NUMBER - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP) - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)), - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - END IF - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - FSTATUS1 = ' ' - END IF - IF (.NOT.NEWS_TEST) THEN - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN - IER1 = 1 - MORE = .TRUE. - END IF - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DO - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Folder search aborted.'')') - FOLDER_COUNT = -1 - RETURN - END IF - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1 - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THEN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))') - ELSE IF (CLASS) THEN - WRITE (6,'(1X,''Class'',/,1X,(''-''))') - ELSE IF (SUBSCRIBE) THEN - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,''Status'',7X, - & ''First Last'',/,1X,(''-''))') - END IF - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1 - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - ELSE - FSTATUS1 = ' ' - END IF - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNT - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0 - END IF - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - END IF - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IF - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER - IF (NEWS_TEST.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - FOUND = .FALSE. - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - CALL READ_FOLDER_FILE_TEMP(IER) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - FSTATUS1 = ' ' - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND. - & .NOT.BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1) - ELSE - FOUND1 = .TRUE. - END IF - END IF - FOUND = FOUND1 - ELSE - FOUND = .TRUE. - END IF - END IF - END DO - MORE = MORE.AND.FOUND - IF (MORE) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND) FLAG = 1 - END IF - END DO - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - END IF - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNT - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSE - WRITE(6,1100) ! Else say there are more - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10) -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS) THEN - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.' - END IF - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER ! Open folder file - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - CALL RESET_PROTECTION - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')') - RETURN - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0) - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER) - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE - CALL SET_FOLDER_FILE(0) - END IF - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ELSE - ID = INPUT - INPUT = ' ' - END IF - ILEN = TRIM(ID) - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IF - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*256 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURN - - ENTRY WRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER_COM - END IF - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z)R - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)'s - - CHARACTER*(*) KEY_NAMEr - - INCLUDE 'BULLUSER.INC'/ - - CHARACTER*12 SAVE_USERNAMEn - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME, - - DO WHILE (REC_LOCK(IER))_ - READ (4,IOSTAT=IER) USER_ENTRY - END DOf - - TEMP_USER = USERNAMEr - USERNAME = SAVE_USERNAMEZ - - RETURNU - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAMEC - - DO WHILE (REC_LOCK(IER))C - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRYE - END DOL - - USERNAME = SAVE_USERNAME. - TEMP_USER = KEY_NAMET - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER)a - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DO - - RETURNL - - ENTRY WRITE_USER_FILE_NEW(IER) - - DO I=1,FLONGT - SET_FLAG(I) = SET_FLAG_DEF(I)I - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)I - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DOR - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURNE - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z)2 - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - _ - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_'U - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)F - - NEW_NEWS_ACCESS = ( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS' - - RETURNO - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - N - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_'R - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)G - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C)) - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' 'R - ELSE - FILE = FILE(:L) - END IF - END DOE - - RETURN - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z)D - - CHARACTER*(*) INPUT,FINDA - - F = LEN(FIND)D - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURNL - END DON - - RETURNR - END diff --git a/decus/vms93b/bulletin/bulletin6.for b/decus/vms93b/bulletin/bulletin6.for deleted file mode 100644 index 50383db..0000000 --- a/decus/vms93b/bulletin/bulletin6.for +++ /dev/null @@ -1,2504 +0,0 @@ -C -C BULLETIN6.FOR, Version 6/16/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1))) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULL - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LAST - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMIT - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(81:84) = BUFFER(85:) - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL RESET_PROTECTION - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - IF (ASK_SIZE.EQ.184) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST) - ELSE - F_LAST = 0 - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LAST - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER)) - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0 - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -C -C SUBROUTINE CONVERT_BULLNEWS -C -C FUNCTION: Converts bulletin NEWS file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. '' - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0 - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE) - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0 - NEWS_F_END = 0 - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108) - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:) - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1 - IF (LMOVE.LE.0) THEN - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP - ELSE - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE)) - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) - END IF - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SET_PROTECTION - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL RESET_PROTECTION - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXT - - COMMON /KEEPLOCK/ KEEPLOCK - DATA KEEPLOCK/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - CHARACTER*4 CFOLDER_NUMBER - - CHARACTER*8 NEWS_KEY - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSE - DIR_NUM = 0 - END IF - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURN - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEYGE=NEWS_KEY(ICOUNT,FOLDER_NUMBER) - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRY - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER) - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER) - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF - END IF - IF (IER.EQ.0) THEN - NUM = GET_INTEGER(%REF(NEWS_MSG_KEY)) - IF (NUM.NE.FOLDER_NUMBER) THEN - IER = 36 - UNLOCK 2 - ELSE - MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:))) - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND. - & MSG_NUM.GT.F_START) THEN - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER,IER2) - F_START = MSG_NUM - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IF - END IF - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THEN - ICOUNT = MSG_NUM - BULLETIN_NUM = ICOUNT - END IF - END IF - ELSE - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 - END IF - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END IF - END DO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IF - - IF (IER.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1 - END IF - END IF - END IF - - RETURN - - END - - - - CHARACTER*8 FUNCTION NEWS_KEY(ICOUNT,FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 INTEGER_KEY - - NEWS_KEY = INTEGER_KEY(FOLDER_NUMBER)//INTEGER_KEY(ICOUNT) - - RETURN - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM) - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z) - - INTEGER TEMP - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I) - END DO - - RETURN - END - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/2/ - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - CHARACTER*4 INTEGER_KEY - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.4.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THEN - NUM = GET_INTEGER(%REF(NEWS_MSG_KEY)) - IF (NUM.NE.FOLDER_NUMBER) THEN - IER = 36 - UNLOCK 2 - ELSE - MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:))) - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.4.AND.MSG_NUM.NE.0) THEN - IF (MSG_NUM.GT.NEWS_F_END) THEN - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36 - UNLOCK 2 - END IF - END IF - END IF - END IF - ELSE - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - IER = 0 - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10 - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY(5:)),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY(5:)),%DESCR(EX_BTIM)) - IF (POSTTIME) CALL COPY2(MSG_BTIM,NEWS_POST_BTIM) - DESCRIP = NEWS_DESCRIP - FROM = NEWS_FROM - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IF - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11) - EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME(:11) - TIME = DATETIME(13:23) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*8 NEWS_KEY - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - ELSE - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - DO WHILE (REC_LOCK(IER).AND. - & BULLETIN_NUM.NE.NEWS_F_END+1) - READ (2,KEYID=1,KEY=NEWS_KEY( - & BULLETIN_NUM,FOLDER_NUMBER),IOSTAT=IER) - END DO - ELSE - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IF - IF (REMOTE_SET.EQ.4.AND. - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN - CALL SPECIAL_NEWSDIR_ENTRY(IER) - ELSE IF (IER.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEN - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - DIMENSION BTIM(2) - - CHARACTER*8 NEWS_KEY - - READ (2,KEYID=3,KEY=NEWS_MSGID,IOSTAT=IER) INPUT(:84) - DO WHILE (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).NE.FOLDER_NUMBER) - READ (2,IOSTAT=IER) INPUT(:84) - IF (NEWS_MSGID.NE.INPUT(21:84)) IER = 2 - END DO - - IF (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).EQ.FOLDER_NUMBER) THEN - IER = 2 - RETURN - END IF - -10 IER1 = 0 - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=1,KEYGT=NEWS_KEY(NEWS_F_END,FOLDER_NUMBER), - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - DO WHILE (IER1.EQ.0) - FNUM = GET_INTEGER(%REF(INPUT)) - IF (FNUM.NE.FOLDER_NUMBER) THEN - IER1 = 2 - ELSE - CALL GET_MSGKEY(%REF(INPUT(85:)),%DESCR(BTIM)) - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IF - F_COUNT = F_COUNT + 1 - NEWS_F_END = GET_INTEGER(%REF(INPUT(5:))) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - END IF - END DO - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IF - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSE - F_COUNT = F_COUNT + 1 - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*8 NEWS_KEY - - CHARACTER*4 INTEGER_KEY - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*4 INTEGER_KEY - - CHARACTER*8 NEWS_KEY - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_POST_BTIM,MSG_BTIM) - END IF - - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - IF (LOCAL_POST) THEN - CALL COPY2(NEWS_POST_BTIM,MSG_BTIM) - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP - NEWS_FROM = FROM - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - NEWS_MSG_KEY = NEWS_KEY(MSG_NUM,FOLDER_NUMBER) - NEWS_MSG_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - NEWS_EX_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY - ELSE - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - - RETURN - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KEYID/ NEWS_KEYID - - COMMON /KEEPLOCK/ KEEPLOCK - - CHARACTER*4 INTEGER_KEY - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 4 - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - CALL READDIR_KEYGE(NDEL) - KEEPLOCK = .FALSE. - NEWS_KEYID = 2 - - RETURN - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII)) - IF (ACLSTR(START_ID:START_ID).NE.','.AND. - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DO - IF (ASCII) THEN - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl output - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C -C SUBROUTINE COPY_ACL1 -C -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - ! Read input file acl - - IF (.NOT.IER) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURNt - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z)r - - INCLUDE 'BULLFILES.INC'T - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./N - - IF (CHECKED) RETURN - - CHECKED = .TRUE.l - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C)U - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORY+ - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE)B - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE - CALL ADD_DIRECTORY(BULLNEWS_FILE)O - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - END IF - - CALL CHECK_DIR(FOLDER_DIRECTORY) - CALL CHECK_DIR(NEWS_DIRECTORY)B - - CALL ADD_DIRECTORIESN - - RETURN - ENDO - B - - - SUBROUTINE ADD_DIRECTORIES! - - INCLUDE 'BULLFILES.INC' - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE) - - RETURNE - END - - - - SUBROUTINE CHECK_DIR(DIRECTORY) - - IMPLICIT INTEGER (A-Z)U - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - IF (.NOT.SYS_TRNLNM_SYSTEM(DIRECTORY,TEST)) RETURNU - - CALL SYS_TRNLNM(DIRECTORY,TEST1)D - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER)T - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST)/ - END DO - - IF (TEST.NE.TEST1) THEN - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER)N - CLOSE(UNIT=3,STATUS='DELETE') - CALL ENABLE_PRIVSN - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)')E - & TEST1(:TRIM(TEST1))N - CALL EXIT - END IF - DIRECTORY = TEST1N - ELSE! - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - END IFO - - RETURN) - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:)R - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:)X - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY & - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':'& - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURN - ENDT diff --git a/decus/vms93b/bulletin/bulletin7.for b/decus/vms93b/bulletin/bulletin7.for deleted file mode 100644 index a4570b8..0000000 --- a/decus/vms93b/bulletin/bulletin7.for +++ /dev/null @@ -1,2284 +0,0 @@ -C -C BULLETIN7.FOR, Version 12/22/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER1_NAME.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(:11) - TIME = TODAY_TIME(13:23) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIR - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX)) - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1 - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IF - - RETURN - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0 - CALL SET_FOLDER_FILE(0) - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FILENAME*132,BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0) - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*12 DATE_SAVE,EXDATE_SAVE - CHARACTER*12 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - END IF - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER pscan$_BEGIN = '00000000'X - PARAMETER pscan$_ACCOUNT = '00000001'X - PARAMETER pscan$_AUTHPRI = '00000002'X - PARAMETER pscan$_CURPRIV = '00000003'X - PARAMETER pscan$_GRP = '00000004'X - PARAMETER pscan$_HW_MODEL = '00000005'X - PARAMETER pscan$_HW_NAME = '00000006'X - PARAMETER pscan$_JOBPRCCNT = '00000007'X - PARAMETER pscan$_JOBTYPE = '00000008'X - PARAMETER pscan$_MASTER_PID = '00000009'X - PARAMETER pscan$_MEM = '0000000A'X - PARAMETER pscan$_MODE = '0000000B'X - PARAMETER pscan$_NODE_CSID = '0000000C'X - PARAMETER pscan$_NODENAME = '0000000D'X - PARAMETER pscan$_OWNER = '0000000E'X - PARAMETER pscan$_PRCCNT = '0000000F'X - PARAMETER pscan$_PRCNAM = '00000010'X - PARAMETER pscan$_PRI = '00000011'X - PARAMETER pscan$_PRIB = '00000012'X - PARAMETER pscan$_STATE = '00000013'X - PARAMETER pscan$_STS = '00000014'X - PARAMETER pscan$_TERMINAL = '00000015'X - PARAMETER pscan$_UIC = '00000016'X - PARAMETER pscan$_USERNAME = '00000017'X - PARAMETER pscan$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER pscan$_END = '00000019'X - PARAMETER pscan$k_type = '00000081'X - PARAMETER pscan$M_OR = '00000001'X - PARAMETER pscan$M_BIT_ALL = '00000002'X - PARAMETER pscan$M_BIT_ANY = '00000004'X - PARAMETER pscan$M_GEQ = '00000008'X - PARAMETER pscan$M_GTR = '00000010'X - PARAMETER pscan$M_LEQ = '00000020'X - PARAMETER pscan$M_LSS = '00000040'X - PARAMETER pscan$M_PREFIX_MATCH = '00000080'X - PARAMETER pscan$M_WILDCARD = '00000100'X - PARAMETER pscan$M_CASE_BLIND = '00000200'X - PARAMETER pscan$M_EQL = '00000400'X - PARAMETER pscan$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER pscan$S_OR = 1 - PARAMETER pscan$V_OR = 0 - PARAMETER pscan$S_BIT_ALL = 1 - PARAMETER pscan$V_BIT_ALL = 1 - PARAMETER pscan$S_BIT_ANY = 1 - PARAMETER pscan$V_BIT_ANY = 2 - PARAMETER pscan$S_GEQ = 1 - PARAMETER pscan$V_GEQ = 3 - PARAMETER pscan$S_GTR = 1 - PARAMETER pscan$V_GTR = 4 - PARAMETER pscan$S_LEQ = 1 - PARAMETER pscan$V_LEQ = 5 - PARAMETER pscan$S_LSS = 1 - PARAMETER pscan$V_LSS = 6 - PARAMETER pscan$S_PREFIX_MATCH = 1 - PARAMETER pscan$V_PREFIX_MATCH = 7 - PARAMETER pscan$S_WILDCARD = 1 - PARAMETER pscan$V_WILDCARD = 8 - PARAMETER pscan$S_CASE_BLIND = 1 - PARAMETER pscan$V_CASE_BLIND = 9 - PARAMETER pscan$S_EQL = 1 - PARAMETER pscan$V_EQL = 10 - PARAMETER pscan$S_NEQ = 1 - PARAMETER pscan$V_NEQ = 11 - BYTE %FILL (2) - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -C -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -C -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE)) -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1 -C UJPIMODE = -1 -C TERMINAL(1:1) = CHAR(0) -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./ - - DIMENSION LAST(2,FOLDER_MAX) - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IF - END DO - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - DO I=1,FOLDER_MAX - DO J=1,2 - LAST(J,I) = LAST_READ_BTIM(J,I) - END DO - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIM - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0 - LAST_SYS_BTIM(2,I) = 0 - END DO - END IF - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -C -C SUBROUTINE READ_NEWS_USERINFO -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) NAME - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2))) - END IF - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READ - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - - DIMENSION LAST(2,FOLDER_MAX) - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF.AND.FNUM.LE.FOLDER_MAX) - DIFF = LAST_READ_BTIM(1,FNUM).NE.OLD_LAST_READ_BTIM(1,FNUM) - IF (.NOT.DIFF) THEN - DIFF = LAST_READ_BTIM(2,FNUM).NE.OLD_LAST_READ_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1 - END DO - - DIFF1 = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF1.AND.FNUM.LE.FOLDER_MAX) - DIFF1 = LAST_SYS_BTIM(1,FNUM).NE.OLD_LAST_SYS_BTIM(1,FNUM) - IF (.NOT.DIFF1) THEN - DIFF1 = LAST_SYS_BTIM(2,FNUM).NE.OLD_LAST_SYS_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1 - END DO - - DIFF2 = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF2.AND.FNUM.LE.FOLDER_MAX) - DIFF2 = LAST_NEWS_READ(1,FNUM).NE.OLD_LAST_NEWS_READ(1,FNUM) - IF (.NOT.DIFF2) THEN - DIFF2 = LAST_NEWS_READ(2,FNUM).NE.OLD_LAST_NEWS_READ(2,FNUM) - END IF - FNUM = FNUM + 1 - END DO - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHARED - - IF (DIFF) THEN - READ (9,KEY=USERNAME,IOSTAT=IER) - DO I=1,FOLDER_MAX - DO J=1,2 - LAST(J,I) = LAST_READ_BTIM(J,I) - END DO - END DO - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - - IF (DIFF1) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF - - IF (DIFF2) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - CHARACTER*24 TIME1 - - TIME1 = TIME(FIRST_ALPHA(TIME):) - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:) - END DO - - IF (TIME1.EQ.'-') TIME1 = '-- :' - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder info - ELSE IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND. - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - IF (INCMD(:4).EQ.'SHOW') THEN - SAVE_FOLDER_Q1 = 0 - RETURN - END IF - IF (NEW_MESS.OR.NEWS_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1 - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0 - END IF - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE(IER) - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER) - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - - RETURN - END diff --git a/decus/vms93b/bulletin/bulletin8.for b/decus/vms93b/bulletin/bulletin8.for deleted file mode 100644 index becaed5..0000000 --- a/decus/vms93b/bulletin/bulletin8.for +++ /dev/null @@ -1,2120 +0,0 @@ -C -C BULLETIN8.FOR, Version 1/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).GT.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND. - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0, - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - END IF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE. - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THEN - ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX)) - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV) - END IF - END IF - END IF - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND. - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24 - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM) - P = 4 + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT) - P = 4 + P - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER) - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - CALL CLOSE_BULLFOLDER - END IF - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = -1 - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV) - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - REC_LOCK = 1 - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*80 MESSAGE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256,PASSWORD*32,TEMP_USER*12 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - RETURN - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C -C SUBROUTINE SET_FOLDER_FILE -C -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE, -C if = 1, set FOLDER1_FILE -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NUM.EQ.0) THEN - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE) - END IF - - RETURN - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C -C SUBROUTINE SET_FILE -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILE - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - ELSE - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)// - & '.]' - END IF - - RETURN - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12 - - DATA UPDATE/.FALSE./ - - UPDATE = .TRUE. - - ENTRY SET_BULLFIL_UPDATE - - UPDATE = .NOT.UPDATE - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATE - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):) - - M = INDEX(FILDATE,'-') - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3) - - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN - FOLDER_FILE = FOLDER1_FILE - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THEN - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHARED - END IF - END IF - - IF (UPDATE) THEN - READ (1'1) NBLOCK - REWRITE (1) NBLOCK + LENGTH - UPDATE = .FALSE. - END IF - - RETURN - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THEN - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE - MINGT0 = MIN(I,J) - END IF - - RETURN - END diff --git a/decus/vms93b/bulletin/bulletin9.for b/decus/vms93b/bulletin/bulletin9.for deleted file mode 100644 index 136e86a..0000000 --- a/decus/vms93b/bulletin/bulletin9.for +++ /dev/null @@ -1,2093 +0,0 @@ -C -C BULLETIN9.FOR, Version 1/27/94 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA DISPLAY_ID/0/,KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - - IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN - WRITE (6,'(A)') ' A new BULLETIN executable has been '// - & 'installed since your last use.' - WRITE (6,'(A)') - & ' Type HELP NEW_FEATURES for help on any new features.' - END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IF - END IF - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE - WRITE (6,1000) - END IF - IF (.NOT.SUBSCRIBE) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - DO I = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IF - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1 - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THEN - NUM_FOLDER = 0 - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1), - & 'HIT any key for next page....') - END IF - END DO - IF (NUM_FOLDERS.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE IF (INEW) THEN - NEW = INEW - IF (REMOTE_SET.GE.3) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSE - CALL FIND_NEWEST_BULL - END IF - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1010 FORMAT (' The following folders with new messages are present'/) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - FOLDER_PRESENT = CLI$PRESENT('FOLDER') - - IF (FOLDER_PRESENT) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z') - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME) - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURN - END IF - END IF - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid date specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURN - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN - END IF - ELSE IF (SINCE) THEN - IF (BULL_POINT.EQ.0) THEN - WRITE (6,'('' ERROR: No current message.'')') - RETURN - ELSE IF (NEWS) THEN - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THEN - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSE - STARTMSG = 1 - END IF - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - ELSE - IF (NEWS) THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1 - END DO - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND. - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0 - NEWSMSG = 1 - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THEN - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0 - ELSE - FOUND = .FALSE. - END IF - IF (FOUND.AND.NEWS) THEN - WRITE (6,'(1X,A,'' latest message read '', - & I,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'', - & '' to specified folder.'')') - END IF - END IF - IF (.NOT.ALL) THEN - IF (IER.NE.0) THEN - WRITE (6,'('' User info does not exist.'')') - END IF - IER = 2 - END IF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - CALL CLOSE_BULLUSER - ELSE - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - CALL CLOSE_BULLUSER - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPE - DATA SCRTYPE/-1/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESS - - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - IER1 = 1 - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER2) THEN - CALL ADD_DIRECTORIES - ELSE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IF - END IF - END DO - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - IF (LEN_FROM.EQ.0.OR. - & (BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0) - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0 - IF (IER1.NE.0) THEN - OPEN (UNIT=3,DISPOSE='DELETE',FILE='BULL_DIR:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW') - SCRTYPE = 1 - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*256 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3) - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - CHARACTER*24 TODAY - - DATA STORED /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THEN - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER - RETURN - ELSE IF (BUFFER(:5).EQ.'From:') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE. - OLD_BUFFER_FROM = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - STORED = .TRUE. - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STORED - STORED = .FALSE. - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3) - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - IF (LEN_BUFFER.GT.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - ELSE - WRITE (3,'(A)') ' ' - END IF - TEXT = .TRUE. - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - CALL STORE_BULL(1,' ',NBLOCK) ! just store one space - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2 - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-') - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO - INEXDATE = .TRUE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - IF (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11)) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - TEXT = .TRUE. - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /SCRTYPE/ SCRTYPE - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAY - - CHARACTER USER_SAVE*12 - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1 - FIRST_BREAK = .FALSE. - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - RETURN - END IF - - EXTIME = '00:00:00.00' - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2000' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.GE.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME) - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARD - END IF - IF (SCRTYPE.EQ.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INPUT, - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - CALL RESPOND_MAIL('BULL.SCR',INPUT, - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('BULL.SCR;*') - END IF - CALL SETUSER(USER_SAVE) - USERNAME = USER_SAVE - ELSE - CLOSE (UNIT=3) - END IF - SCRTYPE = -1 - END IF - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(INFROM,LEN_INFROM) - - RETURN - END - - - SUBROUTINE GET_FROM(INFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INFROM - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - DO WHILE (INDEX(INFROM,'<').GT.0.AND. ! Name may be of form - & INDEX(INFROM,'@').GT.INDEX(INFROM,'<')) - INFROM = INFROM(INDEX(INFROM,'<')+1:)! personal-name - END DO - - DO WHILE (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name) - & INDEX(INFROM,'@').GT.INDEX(INFROM,'(')) - INFROM = INFROM(INDEX(INFROM,'(')+1:) - END DO - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) - I = I + 1 - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1 - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.127) - & INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - END IF - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header line - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.' - END IF - END IF - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - - RETURN - END diff --git a/decus/vms93b/bulletin/bullfiles.inc b/decus/vms93b/bulletin/bullfiles.inc deleted file mode 100644 index 2b73469..0000000 --- a/decus/vms93b/bulletin/bullfiles.inc +++ /dev/null @@ -1,41 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWSDIR_FILE,BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data - CHARACTER*80 BULLNEWSDIR_FILE /'BULLNEWSDIR.DAT'/ - ! Directory listing for LOCAL news groups -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vms93b/bulletin/bullfolder.inc b/decus/vms93b/bulletin/bullfolder.inc deleted file mode 100644 index 117f8fc..0000000 --- a/decus/vms93b/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vms93b/bulletin/bullmain.cld b/decus/vms93b/bulletin/bullmain.cld deleted file mode 100644 index 4ca45c0..0000000 --- a/decus/vms93b/bulletin/bullmain.cld +++ /dev/null @@ -1,33 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vms93b/bulletin/bullnews.inc b/decus/vms93b/bulletin/bullnews.inc deleted file mode 100644 index 251895d..0000000 --- a/decus/vms93b/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vms93b/bulletin/bullstart.com b/decus/vms93b/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vms93b/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vms93b/bulletin/bulluser.inc b/decus/vms93b/bulletin/bulluser.inc deleted file mode 100644 index 22d7a3a..0000000 --- a/decus/vms93b/bulletin/bulluser.inc +++ /dev/null @@ -1,49 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vms93b/bulletin/changes.txt b/decus/vms93b/bulletin/changes.txt deleted file mode 100644 index 40a730e..0000000 --- a/decus/vms93b/bulletin/changes.txt +++ /dev/null @@ -1,563 +0,0 @@ -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vms93b/bulletin/copyright.txt b/decus/vms93b/bulletin/copyright.txt deleted file mode 100644 index ee33a7e..0000000 --- a/decus/vms93b/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vms93b/bulletin/create.com b/decus/vms93b/bulletin/create.com deleted file mode 100644 index 983ae41..0000000 --- a/decus/vms93b/bulletin/create.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vms93b/bulletin/handout.txt b/decus/vms93b/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vms93b/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vms93b/bulletin/install.com b/decus/vms93b/bulletin/install.com deleted file mode 100644 index 758acd4..0000000 --- a/decus/vms93b/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vms93b/bulletin/instruct.com b/decus/vms93b/bulletin/instruct.com deleted file mode 100644 index a9cf299..0000000 --- a/decus/vms93b/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vms93b/bulletin/instruct.txt b/decus/vms93b/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vms93b/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vms93b/bulletin/login.com b/decus/vms93b/bulletin/login.com deleted file mode 100644 index e4302af..0000000 --- a/decus/vms93b/bulletin/login.com +++ /dev/null @@ -1,28 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vms93b/bulletin/master.com b/decus/vms93b/bulletin/master.com deleted file mode 100644 index f1c5834..0000000 --- a/decus/vms93b/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel:C -$ !I -$ run pmdf_root:[exe]ftcp_master -$ goto out1l -$ ! -$ CN_channel:i -$ !s -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277M -$ !L -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master( -$ goto out1_ -$ !+ -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vms93b/bulletin/mx.com b/decus/vms93b/bulletin/mx.com deleted file mode 100644 index 7d87c28..0000000 --- a/decus/vms93b/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */L - - } - } - } - rms_get(&rcptrab); /* Read next recipient */e - }u - - - /* Close the RMS files */r - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab);f - - tracemsg("BULLETIN message processed");y - exit(SS$_NORMAL); /* Always return success */ - -}L -$eod t -$copy/log sys$input MX_BULL.TXTm -$deckM - MX_BULL_ - An MX SITE transport. - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution:- - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN?h ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site.t - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including theS -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands:n - - SEND ALL Sends all bulletin files.. - SEND filename Sends the specified file.e - BUGS Sends a list of the latest bug fixes.D - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. Thei -build procedure for MX_BULL expects the logical BULL_SOURCE to point to theo -BULLETIN library. You must define this logical (or edit the .COM file)m -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct):L - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>"* - -3. If you don't have a SITE transport already defined, simply copyu - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULLe - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin deliveringc -messages to BULLETIN.t - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail tod -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETINm -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL) - MAIL> SENDU - To: MX%"GENERAL@BULLETIN" - Subj: This is a test....a - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITEu -agent, since the @BULLETIN path was defined as a SITE path.f - -To facilitate the automatic delivery of messages to BULLETIN folders, youi -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN"""/ - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN"""t - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to/ -BULLETIN via MX_BULL.d - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST ..../ - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.)u - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder.M - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwardingm -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When maild -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the messagee -to the Local agent, which discovers that the mail is forwarded tos -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUEf - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The; -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logicalf -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return addressr -for BULLETIN messages will look something like the following:t - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM:s - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayedW -to death, leaving a bad address on the "From:" line. This frequently happensa -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by:b - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnety - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226s - Western Kentucky University - Bowling Green, KY 42101 -$eod t -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$decka -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headersb -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1.u -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3i -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"?( -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file/ -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it upn -$ close tmp !...t -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr;s -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:"b -$ endifb -$ exit 1 !Always return success -$eod N diff --git a/decus/vms93b/bulletin/news.com b/decus/vms93b/bulletin/news.com deleted file mode 100644 index fb7775e..0000000 --- a/decus/vms93b/bulletin/news.com +++ /dev/null @@ -1,679 +0,0 @@ -$set nover -$copy/log sys$input NEWS.ALT -$deck - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales -$eod -$copy/log sys$input NEWS.CREATE -$deck -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - -$eod -$copy/log sys$input NEWS.MODERATORS -$deck -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com -$eod diff --git a/decus/vms93b/bulletin/news.create b/decus/vms93b/bulletin/news.create deleted file mode 100644 index dc1c840..0000000 --- a/decus/vms93b/bulletin/news.create +++ /dev/null @@ -1,155 +0,0 @@ -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - diff --git a/decus/vms93b/bulletin/news.txt b/decus/vms93b/bulletin/news.txt deleted file mode 100644 index c7bbe0f..0000000 --- a/decus/vms93b/bulletin/news.txt +++ /dev/null @@ -1,150 +0,0 @@ -BULLETIN has the capability to read and post messages to USENET NEWS in a -client mode. News groups can also be stored on disk. Selected groups or set -of groups which are commonly read can be selected to be stored, thus making -reading of such groups much faster than having to access them over a network. -Note that since the number of groups is well over 2000 makes it unreasonable -at most sites to store them all. - -BULLETIN (actually BULLCP) can act as as a gateway between decnet and tcp for -NEWS, which allows decnet nodes without tcp access to be able to access a tcp -news server. This method does not require spawning any processes, since the -detached process BULLCP is always present, so the access is very fast. - -Since BULLETIN uses a shared database to store info on the NEWS groups and -periodically updates it, there is no need for that to be done when a user -accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. - -It is also possible to feed NEWS groups into a "real" BULLETIN folder. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. - -The instructions for installation are as follows. Define BULL_NEWS_SERVER to -be a system logical name pointing to either your internet or decnet NEWS node. -If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -If you have a cluster where one node is an internet node, and the rest -non-internet nodes, you'll have to create a startup procedure that defines -BULL_NEWS_SERVER to be the internet news server address only on the node (or -nodes) on the cluster that have actually internet access. The other nodes -will have BULL_NEWS_SERVER defined as the decnet node name that BULLCP is -running on in the cluster. (Of course, BULLCP will have to be running on a -node with internet access.) - -NOTE: If you want to disable the DECNET gateway feature, then before starting -BULLCP, define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -If you want to enable the TCP gateway, you must define BULL_TCP_NEWS_GATEWAY -(NOTE: This presently only works with MULTINET.) - - $ DEFINE/SYSTEM BULL_TCP_NEWS_GATEWAY "TRUE" - -BULL_TCP_NEWS_GATEWAY can be defined to point to a file name which contains ip -names that are allowed access. The file should contain real ip names. Blank -lines and comments (preceded by #) are allowed. If you want a whole domain to -be allowed, specify the domain preceded by a ., i.e. .pfc.mit.edu . - -You can also specify that BULLCP is ONLY to act oas a NEWS gateway. This -is to allow adding the news gateway to an site that you have DECNET access to, -but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. BULLCP will update NEWS every hour. If you -want to change this frequency, define the logical name BULL_NEWS_UPDATE to the -number of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" -for 30 minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does -the update. You can watch how long it takes for this to run in order to -determine if you want to change the update period). If you ever want to force -NEWS to be updated, simply restart BULLCP. - -It is suggested that you run OPTIMIZE_RMS.COM on BULLNEWS.DAT, as it will cause -the file to be compressed and will allow updates to run much faster (factor of -5 or more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -News groups can be specified as being stored on disk via the SET NEWS command. -See the online help for more info. After converting such groups, when BULLCP -wakes up, it will start the storing process. This can take a long time if you -have a lot of groups. An index file pointing to the stored messages is created -and called BULL_DIR:BULLNEWSDIR.DAT. After the storage process is complete you -should consider running OPTIMIZE_RMS.COM on it (and anytime after you convert a -sizable amount of groups). - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to FTP.UU.NET -via ANONYMOUS FTP and look through the directory uumap or uunet-sites to find a -USENET node near you to contact. diff --git a/decus/vms93b/bulletin/nonsystem.txt b/decus/vms93b/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vms93b/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vms93b/bulletin/optimize_rms.com b/decus/vms93b/bulletin/optimize_rms.com deleted file mode 100644 index fc0b91d..0000000 --- a/decus/vms93b/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = P4 -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vms93b/bulletin/pmdf.com b/decus/vms93b/bulletin/pmdf.com deleted file mode 100644 index 85c77b1..0000000 --- a/decus/vms93b/bulletin/pmdf.com +++ /dev/null @@ -1,1031 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input BULLETIN_MASTER.PAS_V32i -$deck' -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound);; - -(*******************************************************************)a -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *) -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - - outbound : text; - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL - 100; - - VAR - line, errorsto : vstring; - bigline : bigvstring; result : rp_bufstruct; - header : he_header; - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string); - - BEGIN (* try_something *) - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *) - end; (* try_something *) - - BEGIN (* return_bad_messages *) - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt'); - try_something (he_read_header (header, qu_rtxt), 'he_read_header'); - errorsto.length := 0; - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i]; - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto), - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr); - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *) - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages (tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable. - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT - -For V3.2: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check your -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vms93b/bulletin/restart.com b/decus/vms93b/bulletin/restart.com deleted file mode 100644 index 502bfa8..0000000 --- a/decus/vms93b/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vms93b/bulletin/setuser.mar b/decus/vms93b/bulletin/setuser.mar deleted file mode 100644 index 153cb7b..0000000 --- a/decus/vms93b/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vms93b/bulletin/upgrade.com b/decus/vms93b/bulletin/upgrade.com deleted file mode 100644 index a2d77c4..0000000 --- a/decus/vms93b/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vms93b/bulletin/writemsg.txt b/decus/vms93b/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vms93b/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vms94a/bulletin/aaareadme.txt b/decus/vms94a/bulletin/aaareadme.txt deleted file mode 100644 index fb97c8c..0000000 --- a/decus/vms94a/bulletin/aaareadme.txt +++ /dev/null @@ -1,201 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vms94a/bulletin/allmacs.mar b/decus/vms94a/bulletin/allmacs.mar deleted file mode 100644 index b7498eb..0000000 --- a/decus/vms94a/bulletin/allmacs.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vms94a/bulletin/allmacs_axp.mar b/decus/vms94a/bulletin/allmacs_axp.mar deleted file mode 100644 index efb71ec..0000000 --- a/decus/vms94a/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vms94a/bulletin/board_digest.com b/decus/vms94a/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vms94a/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vms94a/bulletin/board_special.com b/decus/vms94a/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vms94a/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vms94a/bulletin/bull_news.c b/decus/vms94a/bulletin/bull_news.c deleted file mode 100644 index 4f09cd3..0000000 --- a/decus/vms94a/bulletin/bull_news.c +++ /dev/null @@ -1,705 +0,0 @@ -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} diff --git a/decus/vms94a/bulletin/bull_newsdummy.for b/decus/vms94a/bulletin/bull_newsdummy.for deleted file mode 100644 index a17d3ec..0000000 --- a/decus/vms94a/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,99 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END diff --git a/decus/vms94a/bulletin/bullcom.cld b/decus/vms94a/bulletin/bullcom.cld deleted file mode 100644 index d591dfd..0000000 --- a/decus/vms94a/bulletin/bullcom.cld +++ /dev/null @@ -1,667 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 3/11/94 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED) - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER FROM - QUALIFIER SUBJECT - QUALIFIER NEGATED - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW SEARCH_STRING AND REPLY - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vms94a/bulletin/bullcoms1.hlp b/decus/vms94a/bulletin/bullcoms1.hlp deleted file mode 100644 index b82fcf6..0000000 --- a/decus/vms94a/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1106 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with -> at the beginning of each line. This can be -suppressed or the indentation character changed with /[NO]INDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers so -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file can -be specified which contains the text. If the editor is used for changing -the text, the old message text will be extracted. This can be suppressed -by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST - -If a mailer protocol is needs to be added to the network address in -order for it to be sent by VMS MAIL, i.e. protocol%"address", the -appropriate protocol can be specified by either hardcoding it into the -file BULLNEWS.INC before compiling BULLETIN, or by defining the system -logical name BULL_NEWS_MAILER (it is the same protocol used by the NEWS -feature in order to respond to NEWS messages). The default protocol is -IN%. If desired, you can specify the protocol with the address, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. The -identifier can not be any longer than 12 characters. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, the -folder will then be modified to point to that folder. For example if -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be shared -between more than one node. This capability is only present if the BULLCP -process is running on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message.H -It can be a substring of the subject. This is in case you have forgotten -the exact subject that was specified. Case is not critical either.p -You will be notified if the deletion was successful. -See also /NEGATED. -2 /USERNAMEo -Specifies username to be used at remote DECNET nodes when deleting messagesg -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORYe -Lists a summary of the messages. The message number, submitter's name,a -date, and subject of each message is displayed.a - - Format:N - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message.a -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description ofl -folder. -2 /EXPIRATIONt -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the -DIRECTORY command are to be written into the specified file. Alle -qualifiers which are valid for the EXTRACT command are valid in -conjunction with /EXTRACT except for /NEW which conflicts with the D -DIRECTORY /NEW qualifier. The listof messages to be printed will be -displayed on the terminal (in nopaging format). -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS.e -2 /FROM - /FROM=[string]e - -Specifies that only messages whose username contains the specified stringn -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.a -See also /NEGATED. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don'tm -match the specified search command are displayed.e -2 /MARKEDt -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see allh -messages, use either /ALL, or reselect the folder. N -2 /UNMARKEDn -Lists messages that have not been marked (marked messages are indicatedE -by an asterisk). Using /UNMARKED is equivalent to selecting the folderb -with /UNMARKED, i.e. only unmarked messages will be shown and be ablei -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEENl -Lists messages that have been seen (indicated by a greater than sign). e -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlya -seen messages will be shown and be able to be read. To see alli -messages, use either /ALL, or reselect the folder. e -2 /UNSEENx -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the foldere -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWSO -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The listE -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current messagei -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED.. -2 /SEARCHa - /SEARCH=[string]t - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.t -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.i -2 /START - /START=message_number - -Indicates the first message number you want to display. For example,, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDE -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings.i - - Format:e - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. e - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE.e -2 /FROMP -Specifies to exclude the message based on the message owner. This isd -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULLe -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROMl -and /SUBJECT cannot be specified at the same time. n -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):strings - -In order for /FULL to be the default for a folder, the following line. -must be present: - -folder_name:defaults:kill> - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program.K -1 EXTRACT -Synonym for FILE command.e -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified.N - - Format:e - FILE filename [message_number][-message_number1],[...] - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Copies all the messages in the current folder. -2 /FF -Specifies that a form feed is placed between messages in the file. -2 /HEADERT - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the h -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 FIRSTt -Specifies that the first message in the folder is to be read. -1 FORWARD -Synonym for MAIL command.L -1 Folderso -All messages are divided into separate folders. New folders can beh -created by any user. As an example, the following creates a folder fors -GAMES related messages: - s -BULLETIN> CREATE GAMES -Enter a one line description of folder.h -GAMESR - -To see the list of available folders, use DIRECTORY/FOLDERS. To selectt -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, thatc -user will be alerted of topics of new messages at login time, and will a -then be given the option of reading them. Similar to READNEW is SHOWNEW,o -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option,/ -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command.d - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in thes -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SETh -NODE. A remote folder is one which points to a folder on a remote DECNETa -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)t -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, and -giving access to that UIC group. Only users in that UIC group will seei -the messages in that folder when they log in.U -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INCLUDEd -Specifies to include reading messages based on the message owner or the -subject. If it is determined that a message is to be included, then the -message is read when a user tries to read a message by typing NEXT or -BACK, or by hitting the return key. Otherwise, it is skipped. Specify -the qualifier /FULL to make all EXCLUDEs and INCLUDEs for the specified -folder apply to all other BULLETIN commands, including directory -listings. - - Format:s - INCLUDE [string] - -If a string is specified, then the message is included if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one INCLUDE may be -specified per folder. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all INCLUDEs. -2 /DISABLE -Specifies to permanently disable the INCLUDE.c -2 /FROMe -Specifies to include the message based on the message owner. This is. -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. -2 /SUBJECT -Specifies to include the message based on the message subject. /FROMD -and /SUBJECT cannot be specified at the same time. a -2 Storing_INCLUDEs -INCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):stringt - -In order for /FULL to be the default for a folder, the following linee -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 INDEXa -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after onei -has read a message. /RESTART must be specified to start from the firstr -folder if a scan is in progress. All other qualifiers are ignored while b -a scan is in progress. - - Format:n - INDEX - -When a directory is displayed, you can read the first message in the e -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for olderc -versions of BULLETIN. -2 /MARKEDl -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED,s -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKEDs -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folderc -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read.e -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). a -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlyT -seen messages will be shown and be able to be read.s -2 /UNSEENo -Lists messages that have not been seen (seen message are indicated by an -greater than sign). Using /UNSEEN is equivalent to selecting the folderT -with /UNSEEN, i.e. only unseen messages will be shown and be able to ber -read.t -2 /NEW - /[NO]NEWu - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message.n -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified.N -2 /RESTART -If specified, causes the listing to be reinitialized and start from thel -first folder.c -2 /SET - /[NO]SETp - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format:e - LASTk -2 /EDITe -Specifies that the editor is to be used to read the message. This ise -useful for scanning a long message.c -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commanda -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEa -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format:L - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying ane -address that has quotes, in order to pass the quotes you must specifye -triple quotes. I.e. a network address of the form xxx%"address" musth -be specified as xxx%"""address""". -2 /EDITi -Specifies that the editor is to be used to edit the message before -mailing it., -2 /HEADERe - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the e -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of moret -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be usedi -as the subject.a -1 MARK -Sets the current or message-id message as marked. Marked messages area -displayed with an asterisk in the left hand column of the directory. -listing. A marked message can serve as a reminder of importantp -information. The UNMARK command sets the current or message-id messageD -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers]f - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to bys -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGINn -will be used. -1 MODIFY -Modifies the database information for the current folder. Only theg -owner of the folder or a user with privileges can use this command. - - Format:u - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted forc -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing listg -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTe -commands, the address of the mailing list should be included in they -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presentlye -assigned to it. Any process which has that identifier assigned to itc -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAMEt - /NAME=foldernamer - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID.m -1 MOVE -Moves a message to another folder and deletes it from the current -folder.S - - Format:A - - MOVE folder-name [message_number][-message_number1]s - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,d -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPSl - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message tos -the specified NEWS group(s) in addition to the selected NEWS group.e -2 /HEADERa - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied.h -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.y -2 /ORIGINALt -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned byr -the person moving the message. -1 NEWS -Displays the list of available news groups.h - -Format:o - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed.o - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL willf -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /NEWGROUP -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B.h -2 /STOREDe -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over.f -2 /EDIT -Specifies that the editor is to be used to read the message. This isN -useful for scanning a long message.c -2 /HEADERA - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commandH -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEi -Specifies to decode the message using ROT-13 coding. diff --git a/decus/vms94a/bulletin/bullcoms2.hlp b/decus/vms94a/bulletin/bullcoms2.hlp deleted file mode 100644 index 452527f..0000000 --- a/decus/vms94a/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1348 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with -> at the -beginning of each line. This can be suppressed or the indentation -character changed with /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. In -order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply surround -the exclusive text starting with the line "START " and ending -with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have -just read) for printing. The file created by the PRINT command -is not released to the print queue until you exit, unless you add -the qualifier /NOW or change one of the print job's qualifiers. -Multiple messages are concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /INDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. - -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected and /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read them. -(Note: Reading the last message does the same thing, but RESET does it -without having to read it.) -1 QUIT -Exits the BULLETIN program. -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text strings. - - Format: - - SEARCH search-string[,...] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description -header. If a no search string is specified, a search is made using the -previously specified string, starting with the message following the one -you are currently reading (or have just read). Once started, a search -can be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for a -match. If, during a search, no more matches or messages are found, the -next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /MATCH - /MATCH[=option] - -Interprets and matches multiple search strings in one of the following -ways: - - AND A match occurs only if all of the strings are found. - - OR A match occurs if any of the strings are found. - - XOR A match occurs if only one of the strings is found. - -If you specify none of these options, the default is /MATCH=OR. If you -specify the /NEGATED qualifier, you will get the negated operation. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the last -message. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUS -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name. - - Format: - - SET [NO]ANONYMOUS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. - - Format: - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If a -mailing address is present (see /DESCRIPTION), when messages are added -to the folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be -used if the POST command is entered. One use for this is a local board -which is also distributed to non-local users. - - Format: - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2.t - - Format: - - SET BBOARD [username]o - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages.t - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30"h -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The form. -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY.s -The time will always be 00:00, even if the time is specified on the line.p -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature.o -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be:r - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account.r - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV.I -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION.f -2 BRIEFI -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa).A - - Format:l - - SET [NO]BRIEFU -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newe -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER3 - /FOLDER=foldernamec - -Specifies the folder for which the option is to modified. If nota -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by the/ -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier. -2 COMPRESS -Specifies that messages added to the folder will be in compressed format.a -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires L -very little cpu overhead.. - - Format:p - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. . -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed everym -time when logging in, until the new messages are read. Normally, thea -BRIEF setting causes notification only at the first time that new messages -are detected.E - - Format: - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for theE -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used.s - - Format:e - - SET DEFAULT_EXPIRE dayse - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages.. - - Format: - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it. -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format:n - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) . -2 EXCLUDE -Specifies to ignore any EXCLUDEs or INCLUDEs that are present. - - Format: - - SET [NO]EXCLUDE - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or INCLUDEs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format:h - - SET FOLDER [node-name::][folder-name]w -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will haven -to be reselected.s -2 GENERICa -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format:U - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for thea -same user. -3 /DAYSu - /DAYS=number_of_days - -Specifies the number days that new messages will be displayed for upon -logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to bys -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI.r -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command. - - Format:s - - SET [NO]LOGIN username -2 NAME -Copies all stored settings from one user to another. Used when a user's -account name is changed. - - Format:I - - SET NAME old-username new-username -2 NEWS -Changes attributes of the specified news group or class of news groups. -This command requires privileges. - - Format:i - - SET NEWS [news-group]/ - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALLt - /NOALL - -If specified with /CLASS or /DEFAULT, all groups that are presentlyr -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of anyr -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the defaultr -attributes (using /DEFAULT) with /NOALL, the attributes for misc.testr -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. -3 /CLASS - /CLASS=classnamen - -Specifies to modify attributes for a class of news groups rather than al -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes ofs -existing groups which are in the class are modified, and any groups -created in the future will automatically have those attributes. -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETEd -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLEg -Specifies that the news group is enabled and can be accessed. This is -the default. -3 /EXPIRATIONS - /EXPIRATION=days - -Specifies the default expiration time for messages if none is specified. -The default is 7. -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified iss --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default.r -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is postedl -every month with an expiration date of one month in the future.e -3 /PRIVATE - /PRIVATEM - /NOPRIVATEa - -Specifies that the news group or class can have it's access modified byo -the SET ACCESS command. To accomplish this, a file is created inp -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access e -to news groups in that class is to set /NOPRIVATE, as then time won't be -wasted checking a file for ACLs. -3 /STOREDs - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessedi -via the network from the server node. This results in faster access,5 -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED.n -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node.h - - Format:a - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder.m - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node,h -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated.s -3 /FOLDERf - /FOLDER=foldername - -Specifies the folder for which the node information is to modified.p -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are loggedp -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared.i -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users foro -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specifiedA -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernameT - -Specifies the folder for which the option is to modified. If nots -specified, the selected folder is modified. Valid only with NONOTIFY.R -3 /PERMANENT - /[NO]PERMANENT: - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier.m -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN.t - - Format:n - - SET [NO]PAGE -2 POST_ONLYS -Specifies that the selected folder has the POST_ONLY attribute. This. -causes the ADD command to mail the message to the mailing address if iti -is present (see /DESCRIPTION), rather than add to the folder. i - - Format:c - - SET [NO]POST_ONLYg -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format:r - - SET PRIVILEGES parametersI - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers.r -3 /ID' - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.' -2 PROMPT_EXPIREl -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command.E - - Format:F - - SET [NO]READNEWt - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder).a -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new userst -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernamep - -Specifies the folder for which the option is to modified. If notE -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENTB - -Specifies that READNEW is a permanent flag and cannot be changed by thes -individual. This is a privileged qualifier. -2 SHOWNEW[ -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format:l - - SET [NO]SHOWNEWP -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newe -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERs - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENTe - -Specifies that SHOWNEW is a permanent flag and cannot be changed by thee -individual, except if changing to READNEW. This is a privileged qualifier. -2 STRIPs -Affect only messages which are added via either the BBOARD option, orn -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped offd -before it is stored as a BULLETIN message. - - Format:d - - SET [NO]STRIPt - -The command SHOW FOLDER/FULL will show if STRIP has been set.h -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM foldere -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is an -privileged command. - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.u -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGSd -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected viar -the SELECT command, information about that folder is shown.n - - Format:o - - SHOW FOLDER [folder-name]l -3 /FULLo -Control whether all information of the folder is displayed. Thisv -includes DUMP & SYSTEM settings, the access list if the folder isi -private, and BBOARD information. This information is only those who -have access to that folder.a -2 KEYPAD -Displays the keypad command definitions. - - Format:a - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either the SET KEYPAD COMMAND, or -if /KEYPAD is specified on the command line, the keypad keys will be -defined as commands. The default settings for the keypad are shown viao -SHOW KEYPAD or HELP KEYPAD. Settings can be changed by using an -initialization file with DEFINE/KEY commands. BULLETIN looks first fore -the file pointed to by the logical name BULL_INIT and then for the filec -SYS$LOGIN:BULL.INI. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT).i -3 /STATE - /STATE=(state,state,...)i - -Specifies the name of a state for which the specified key definitions -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when -a key name has been specified. -2 NEWh -Shows folders which have new unread messages for which BRIEF or READNEWf -have been set. (Note: If you enter BULLETIN but do not read new unreadt -messages, you will not be notified about them the next time you enterc -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command.h -3 /LOGIN - /[NO]LOGINS - -Specifies that only those users which do not have NOLOGIN set are to ben -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDERe - /FOLDER=[foldername] - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups.n -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSIONl -Shows the version of BULLETIN and the date that the executable was -linked.b -1 SPAWNn -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format:t - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBEl -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of the -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. b -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format:e - UNDELETE [message-number] -1 UNSUBSCRIBES -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See thed -SUBSCRIBE command for further info. -1 Usenet_newse -BULLETIN can also read USENET NEWS if your system has network access toc -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of m -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group inn -order to keep track of which messages you have read in that group. Most -of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read news groups with new messages, use INDEX/SUBSCRIBE. n -1 New_features -Here is a list of new features which may be of interest to the general i -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - --------------------------------------------------------------------------e -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93v - -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93d - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group byi -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92 - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 diff --git a/decus/vms94a/bulletin/bulldir.inc b/decus/vms94a/bulletin/bulldir.inc deleted file mode 100644 index 7bdda8d..0000000 --- a/decus/vms94a/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 180 - - COMMON /NEWS_DIR/ NEWS_MSG_KEY,NEWS_MSG_BTIM_KEY,NEWS_MSGID - & ,NEWS_EX_BTIM_KEY,NEWS_POST_BTIM,NEWS_BLOCK,NEWS_LENGTH - & ,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*64 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_MSG_KEY,NEWS_HEADER_KEY - - CHARACTER*12 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*12 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_KEY,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vms94a/bulletin/bullet1.com b/decus/vms94a/bulletin/bullet1.com deleted file mode 100644 index 2c31b03..0000000 --- a/decus/vms94a/bulletin/bullet1.com +++ /dev/null @@ -1 +0,0 @@ -$set nover diff --git a/decus/vms94a/bulletin/bulletin.cld b/decus/vms94a/bulletin/bulletin.cld deleted file mode 100644 index dc7abbd..0000000 --- a/decus/vms94a/bulletin/bulletin.cld +++ /dev/null @@ -1,43 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vms94a/bulletin/bulletin.for b/decus/vms94a/bulletin/bulletin.for deleted file mode 100644 index 2bad18d..0000000 --- a/decus/vms94a/bulletin/bulletin.for +++ /dev/null @@ -1,1903 +0,0 @@ -C -C BULLETIN.FOR, Version 3/28/94 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IF - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION - - CALL OPEN_OLD_TAG - - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -C -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read from - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (NEWS_FEED().OR.REMOTE_SET.GE.3) THEN - INCMD = 'POST '//INCMD(4:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL RESPOND - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,1060) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'INCL') THEN ! INCLUDE? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN?/ - CALL SET_LOGIN(.FALSE.)t - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS?C - CALL SET_NEWSI - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE?O - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4)R - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE?C - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4)G - ELSE IF (BULL_PARAMETER(:4).EQ.'NAME') THEN ! SET NAME? - CALL SET_NEWNAME - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW?Y - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGSE - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDERT - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATION. - FOLDER1 = SAVE_FOLDERI - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER)I - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES?A - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER?I - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSIONA - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESSO - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBEB - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE?A - CALL UNDELETER - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1)D - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN?. - CALL TAG(.FALSE.,2)( - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - -100 CONTINUEI - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DOC - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more preceding messages.') - - END - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z)S - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN - - END - - - - - - SUBROUTINE ADDG -CS -C SUBROUTINE ADD( -CG -C FUNCTION: Adds bulletin to bulletin file. -CV - IMPLICIT INTEGER (A - Z)R - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10)T - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITN - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT( - DATA EDIT_DEFAULT/.FALSE./e - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIPn - CHARACTER*(INPUT_LENGTH) INDESCRIPa - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8. - - CHARACTER INEXDATE*12,INEXTIME*12,INDENT*4 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF, - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT')L - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IFO - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C) - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THENM - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,D - & RECL=LINE_LENGTH,t - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED')M - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENR - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENR - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - LENI = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THENM - CALL CLI$GET_VALUE('INDENT',INDENT,LENI)L - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LENI.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE= - WRITE (3,'(A)') INDENT(:LENI)//INPUT(:ILEN)e - END IFr - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IFU - - SELECT_FOLDERS = .FALSE.t - IF (CLI$PRESENT('SELECT_FOLDER')) THENL - CALL GET_FOLDER_INFO(IER)L - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE.N - ELSEF - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IFn - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THENR - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',o - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',P - & READONLY,SHARED,ERR=920,FORM='FORMATTED')E - IER = 0 - ICOUNT = 0) - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THENE - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1E - WRITE (3,'(A)') INPUT(:ILEN) - END IFS - END DO. - CLOSE (UNIT=4) - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER)H - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privilegese - END IFE - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910n - END IFo - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IFE - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privilegesI - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?E - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?L - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083), - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00' - END IF - END IFT - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abortQ - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE)U - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name ifF - WRITE (6,1090) ! remote folder, as no codee - GO TO 910 ! present to send the name.t - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)s - END IF? - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2000' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60)e - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60) - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DOA - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THENs - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940o - SELECT_NODES = .TRUE.i - END IFo - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown E - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11)E - INEXTIME = INPUT(13:23)( - END IFC - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY?_ - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specifiedR - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSER - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IFE - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: "M - -CD -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.( -C_ - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',% - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED'). - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')E - IF (CLI$PRESENT('EXTRACT')) THEND - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THENd - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')u - END IF - END IF= - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',t - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')) - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'I - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35 - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count_ - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80)U - BLENGTH = BLENGTH + ILEN - 1 + 2 - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with. - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'= - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW',r - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counterM - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTHI - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counterL - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch fileO - END IF' - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out: - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE.R - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting.'', - & '' A truncated message will be broadcast.'')') - CALL GET_INPUT_PROMPT(INPUT,ILEN,H - & 'Type C to continue, A to only ADD message, or Q to Quit: ') - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THENA - BRDCST = .TRUE. - END IF - END IF - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THENA - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST)E - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT'))H - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT'n - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1e - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodesL - INLINE = INLINE(:LEN_INLINE)o - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH)N - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN)o - END IF - END DO: - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN? - WRITE (6,'('' Message successfully sent to node '',A)'). - & NODES(POINT_NODE) - ELSE- - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE)L - WRITE (6,'(A)') INPUT(:80)H - GO TO 940 - END IFU - REWIND (UNIT=3) - END DO - END IFE - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95A - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -CI -C Add bulletin to bulletin file and directory entry for to directory file. -CC - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I). - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entryC - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! UsernameF - END IF - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCKN - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THENI - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '//) - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK)E - END IFL - IF (LENDES.GT.LEN(DESCRIP)) THEN( - CALL STORE_BULL(LENDES+6,i - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK)A - END IFE - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletinE - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1) - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IFE - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLFIL ! Finished adding bulletinE - - IF (FOLDER_NUMBER.GE.0) THENR - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, an no new messages, update last read time forE -C folder, so user is not alerted of new message which is owned by user. -C) - IF (DIFF.GE.0) THENT - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)T - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)A - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add -C -C Broadcast the bulletin if requested.E -C( - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'),D - & CLI$PRESENT('CLUSTER')) - END IF_ -CA -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP,e -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same clusterY -C as that of the BULLCP node. -CE - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET) - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IFB - ELSE IF (.NOT.IER) THENE - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR.G - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THENT - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1. - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL DISABLE_PRIVSE - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT,E - & INDESCRIP(:LENDES),STATUS)Y - CALL ENABLE_PRIVS - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',L - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',L - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IFA - END IF - END DOE - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO1 - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN. - FOLDER_NUMBER = OLD_FOLDER_NUMBERA - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER)F - END IFT - - IF (CLI$PRESENT('EXTRACT')) THEND - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IFE - - RETURNA - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100)A - GOTO 100E - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GOTO 100( - -930 WRITE (ERROR_UNIT,1025)_ - CALL CLOSE_BULLFILL - CALL CLOSE_BULLDIRD - CLOSE (UNIT=3)T - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018)F - CLOSE (UNIT=3)L - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)E - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')I -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A)$ -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')X -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system3 - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcastP - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdownQ - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A)E - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER)A - - IMPLICIT INTEGER (A-Z)0 - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURNP - - BTIM(1) = -BTIM(1) ! Convert to negative delta timeH - BTIM(2) = -BTIM(2)-1R - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURNF - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER LOCALNODE*8,RESPONSE*4 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURNE - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE.I - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) L - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURN0 - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DOA - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,S - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"')H - - IF (IER.EQ.0) THENR - IER = 0, - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER)Q - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128N - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER_ - ELSED - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN,F - & 'Want to try again? (Y/N with Y as default): ')( - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THENH - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')')T - END IF - END IF - - CLOSE (UNIT=17) - - RETURNH - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1B - - RETURNE - END - - - - SUBROUTINE REPLYU - - IMPLICIT INTEGER (A - Z)C - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'U - - COMMON /INDESCRIP/ INDESCRIPU - CHARACTER*(INPUT_LENGTH) INDESCRIPA - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been readR - WRITE(6,'('' ERROR: You have not read any message.'')')N - RETURN ! And returnR - END IF. - - CALL OPEN_BULLDIR_SHAREDE - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF_ - - CALL OPEN_BULLFIL_SHARED' - - ILEN = LINE_LENGTH + 1A - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)H - END IFD - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:)2 - ELSEE - INDESCRIP = DESCRIPA - END IFW - - CALL CLOSE_BULLFIL_ - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THENA - INDESCRIP = 'RE:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'RE: '//INDESCRIPU - END IFU - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP))A - - CALL ADDS - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z)N - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST) - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST)) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURNN - END - - - - SUBROUTINE GETPRIVW -CY -C SUBROUTINE GETPRIVN -C' -C FUNCTION: -C To get process privileges. -C OUTPUTS:N -C PROCPRIV - Returned privileges -CF - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistQ - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoE - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV' - IMPLICIT INTEGER (A-Z)P - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/N - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'n - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER)G - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1)N - NEEDPRIV(2) = USERPRIV(2)2 - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THENB - SETPRV_PRIV = .TRUE. - ELSEI - SETPRV_PRIV = .FALSE.. - END IFC - - RETURNA - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z)e - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - / - SUBROUTINE GETUSER(USERNAME) -CM -C SUBROUTINE GETUSERM -CL -C FUNCTION: -C To get username of present process.T -C OUTPUTS:O -C USERNAME - Username owner of present process.T -C - - IMPLICIT INTEGER (A-Z)( - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters- - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistN - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoE - - RETURNC - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG)L - - IMPLICIT INTEGER (A - Z)/ - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC'M - - DATA READ_UAI/.FALSE./C - - COMMON /BULL_CUSTOM/ BULL_CUSTOM_ - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN O - CAPTIVE = .FALSE. - RETURN - END IFU - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))R - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE.E - END IFI - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURN. - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z)D - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')')I - RETURN - END IFE - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE) - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THENI - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN)= - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSEP - CALL LIB$SPAWN()R - END IFE - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END, - - - SUBROUTINE ATTACHT - - IMPLICIT INTEGER (A - Z)E - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHANE - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESSS - - IF (CLI$PRESENT('PROCESS')) THENI - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list1 - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,)N - ELSEN - CALL INIT_ITMLST ! Initialize item listE - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)E - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODEL - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER)L - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPADL - - RETURNI - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -CE -C The largest message that can be broadcasted is dependent on systemE -C and user quotas. The following limit is 12 lines of ( 80 characters +( -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway.E -CU - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2E - CHARACTER*(BRDCST_LIMIT) BROAD= - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH' - - IF (RING_BELL) THEN ! Include BELL in message?' - BROAD(:36) = ! Say who the bulletin is fromH - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE) - BROAD(:34) = ! Say who the bulletin is from' - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IFL - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1_ - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUTT - IF (IER.NE.0) RETURN? - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN)' - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will beC - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long?T - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DOP - - RETURNT - - ENTRY BROADCAST(ALL,CLUSTER)r - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL?9 - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,)n - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,,t - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,)x - END IF - END IFt - - CALL SYS$SETRWM(%VAL(0))A - - RETURNL - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C, -C SUBROUTINE GET_FOLDER_INFOL -C -C FUNCTION: Obtains & verifies folder names from command line. -C5 - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENTE - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODEp - CHARACTER*32 NODES(10)E - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP)F - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP)E - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0)I - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN_ - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM))I - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF( - FOLDER_NUMBER = -10 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THENM - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM)N - RETURN) - ELSE IF (READ_ONLY) THEN_ - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM)E - IER = 0 - RETURN - END IF. - END DO - END DOI - - IER = 1 - - RETURNA - END diff --git a/decus/vms94a/bulletin/bulletin.hlp b/decus/vms94a/bulletin/bulletin.hlp deleted file mode 100644 index dd8a657..0000000 --- a/decus/vms94a/bulletin/bulletin.hlp +++ /dev/null @@ -1,144 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vms94a/bulletin/bulletin.lnk b/decus/vms94a/bulletin/bulletin.lnk deleted file mode 100644 index 6cdd588..0000000 --- a/decus/vms94a/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.19" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.19" diff --git a/decus/vms94a/bulletin/bulletin0.for b/decus/vms94a/bulletin/bulletin0.for deleted file mode 100644 index f4ee9cd..0000000 --- a/decus/vms94a/bulletin/bulletin0.for +++ /dev/null @@ -1,2057 +0,0 @@ -C -C BULLETIN0.FOR, Version 12/2/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - CALL REMOTE_DELETE(SBULL,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN ! If not owner of message - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.EQ.FROM - END IF - IF (ASK) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.TEST_NEWS_OWNER()) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM) - IER = SYS$ASCTIM(,INPUT,EX_BTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - IF (.NOT.READ_TAG) THEN - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - END IF - EXTRACTING = CLI$PRESENT('EXTRACT') - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - ELSE - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - ANY_SEARCH = .FALSE. - END IF - OUTPUT = EXTRACTING.OR.PRINTING - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - START = .FALSE. - SINCE = .FALSE. - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - SINCE = .TRUE. - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - GO TO 9999 - END IF - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - NEGATED = CLI$PRESENT('NEGATED') - IF (CLI$PRESENT('SEARCH')) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('FROM')) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3 - NEGATED = .TRUE. - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - FROM_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) NUM = NUM + 1 - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - END IF - I = I - 1 - END DO - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - END IF - IF (NUM.GT.0) I = I - 1 - END DO - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) NUM = NUM + 1 - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) J = J + 1 - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULLM - EBULL = MIN(EBULL,NBULL) - END IFt - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I1 = SBULLr - I = SBULL - DO WHILE (I.LE.EBULL) - CALL READDIR(I1,IER) ! Into the queue - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1f - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY)C - I = I + 1P - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1_ - END IF - I1 = I1 + 1C - END DOE - ELSE IF (READ_TAG) THENO - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE)' - IF (I.EQ.0.AND.IER1.EQ.0) THEND - EBULL = EBULL - SBULL + DIR_COUNTE - SBULL = DIR_COUNTR - I = SBULL - END IFR - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28)T - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THENO - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY)E - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,_ - & TAG_TYPE) - END IFU - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVEU - IER1 = 1 - ELSE - EBULL = EBULL_SAVEL - END IF - END IFA - END IFL - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THENA - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTET - GO TO 99993 - END IFu - END IF - ELSED - NBULL = 0G - END IFl - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THENC - CALL CLOSE_BULLDIR ! We don't need file anymoreI - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THENT - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN, - DIR_TYPE = 'seen' - END IF - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME))N - ELSE - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IFi - -C> -C Directory entries are now in queue. Output queue entries to screen.o -Co - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULL) - ELSE) - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IF - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ') - OUTLINE(I+1:) = OUTLINE(I+2:)b - END DOs - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO. - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ')L - OUTLINE(I:) = OUTLINE(I+1:)L - END DO - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINE1 - BULL_PARAMETER = ' '. - IF (READ_TAG) THENT - IF (BTEST(READ_TAG,1)) THEND - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THENT - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IFT - IF (PRINTING) THEN - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - END IFE - WRITE (6,'(1X,A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN. - WRITE(6,1005)L - ELSEI - WRITE(6,1000)! - END IF - - TAG = (BULL_TAG.AND.REMOTE_SET.EQ.0).OR.) - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to headerT - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)S - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE)t - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_DE - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)F - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IFF - END DO - END IFN - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = II - IF (.NOT.REPLY_FIRST) THEN_ - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THENE - START_SEARCH = BULL_POINTQ - END IF - IF (ANY_SEARCH.OR.OUTPUT) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED_FILES = .FALSE. - END IF' - DO WHILE (I.LE.EBULL) - IF (.NOT.ANY_SEARCH) THENE - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (CLOSED_FILES) THENE - CLOSED_FILES = .FALSE. - CALL OPEN_BULLDIR_SHAREDT - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHAREDR - END IFf - CALL GET_SEARCH(FOUND,SEARCH_STRING,1,SLEN,0,R - & START_SEARCH,.FALSE.,SUBJECT,REPLY_FIRST,.FALSE., - & .TRUE.,FROM_SEARCH,NEGATED,MATCH_MODE) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,. - & TAG_TYPE)) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE.& - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THENR - SEARCH_STRING = ' ' - START_SEARCH = FOUNDg - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THENm - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 10 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE.: - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - TAG_TYPE = DUMMY - END IF - ELSE - I = EBULL + 1 - END IFd - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.LE.EBULL) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN. - OUTLINE = '>'I - ELSET - OUTLINE = ' '_ - END IFS - IF (BTEST(SYSTEM,29)) THEN - OUTLINE(2:) = '*'T - ELSE - OUTLINE(2:) = ' 'A - END IF( - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3) - IF ((EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) - & .AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin?w - EXPIRES = 'Permanent't - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown't - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11)o - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9) - ELSET - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11)E - END IF - WRITE(6,'(1X,A)') OUTLINE - IF (OUTPUT) THEN - FOUND_MSG = .TRUE.' - CALL SYS$SETAST(%VAL(0)) - NEXT = .FALSE.= - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES)I - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES) - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0E - ELSE - MSG_NUM = -MSG_NUM_ - END IF$ - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1))U - END IFU - END IF - I = I + 10 - IF (ANY_SEARCH) IER = SYS$CANTIM(,) - END DO1 - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.OUTPUT) THEN, - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THEN) - DIR_COUNT = FOUND + 1E - ELSEE - DIR_COUNT = NBULL + 1E - END IFL - END IF - END IFL - - IF (DIR_COUNT.GT.NBULL.OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THENF - ! Outputted all entries? - DIR_COUNT = -1 ! Yes. Set counter to -1. - IF (PRINTING) THEN S - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THENl - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)I - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IFO - ELSE IF (EXTRACTING.AND.FOUND_MSG) THENB - CALL FILE(0,CLOSED_FILES) - END IF - ELSE - WRITE(6,1010) ! Else say there are more - END IFt - -9999 POSTTIME = .FALSE.o - NEXT = .FALSE. - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/)M -1010 FORMAT(1X,/,' Press RETURN for more...',/) - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9)) - - END - - - SUBROUTINE CLOSE_FILESO - - IMPLICIT INTEGER (A-Z)O - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER), - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN1 - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z)( - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8A - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO( - - RETURN' - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT) -CL -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z)U - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - EXTERNAL CLI$_ABSENTB - - CHARACTER*128 FILENAMEF - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THENI - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')')I - RETURN - END IFL - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THENA - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IFT - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?C - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)F - IF (EBULL.GT.F_NBULL) EBULL = F_NBULLR - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1R - EBULL = F_NBULL$ - IER = 0N - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSEG - SBULL = BULL_POINT - EBULL = SBULLY - IER = 0 - END IFI - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL$ - CALL CLOSE_BULLDIRE - CLOSE (UNIT=3) ! Bulletin copy completedI - OPENED = .FALSE.r - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P)( - RETURN - END IF - ELSEL - SBULL = FILE_NUM - EBULL = SBULLT - END IF - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F)) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH,, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THENS - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IFH - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE. - FIRST = .TRUE. - END IFE - - DO FBULL = SBULL,EBULLE - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THENE - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1R - IF (FBULL1.GT.SBULL) GO TO 100R - CLOSE (UNIT=3,STATUS='DELETE')T - OPENED = .FALSE.) - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(FBULL,IER1)D - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1)s - END IFq - IF (IER1.NE.0) GO TO 100l - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12)t - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THENI - WRITE(3,1060) FROM,DATE//' '//TIME(:8)A - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN. - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DOP - -100 IF (FILE_NUM.GT.0) THENU - FILE_NUM = -FILE_NUM - RETURN - END IFl - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created. - WRITE(6,1040)$ - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)A - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F)L - END IFT - - GO TO 10S - -900 WRITE(6,1000) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURND - -1000 FORMAT(' ERROR: Error in opening file.')s -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:')_ -1030 FORMAT(' ERROR: Following bulletin was not found: ',I)( -1040 FORMAT(' Message ',A,' written to ',A) -1045 FORMAT(' Messages ',A,'-',$)I -1046 FORMAT('+',A,' written to ',A)I -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN)M - - CALL LIB$MOVC3(8,IN,OUT) - - RETURND - END - - - - SUBROUTINE LOGIN -CC -C SUBROUTINE LOGINE -CG -C FUNCTION: Alerts user of new messages upon logging in.N -Ce - IMPLICIT INTEGER (A - Z), - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'G - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPTN - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)_ - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATEE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list headerG - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/' - - DATA FIRST_WRITE/.TRUE./E - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)T - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - FOLDER_NAME = FOLDER - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)e - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THENU - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSE - RETURN ! Don't notifyL - END IF - END IF - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM). - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRYF - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR.1 - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO. - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSEL - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing._ - END IFO - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file1 - CALL EXIT ! Go away...T - END IF) - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHAREDG - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM). - END DON - WRITE (9,IOSTAT=IER) USERNAME,T - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINFL - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header. - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messagesU - END IFL - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entryL -C1 -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility.E -CH - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM) - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user.L - - IF (SYSTEM_SWITCH) THEND - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM)E - END IF - END IF - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER. - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1)_ - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERD - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN+ - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0E - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,) - & LAST_READ_BTIM(1,FOLDER_NUMBER+1))U - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - ELSEE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM)0 - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM)A - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time_ - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IFU - END IF - END IF( - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messagesD - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THENG - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1)U - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM)= - END IFL - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IFB - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login timeN - ! for system messages. - END IFE - - IF (LOGIN_SWITCH) THEND - IF (READIT.EQ.1) THENB - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSERL - END IFU - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THENL - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THENP - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,N - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))L - IF (DIFF1.LT.0) THEN) - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1),F - & LOGIN_BTIM_NEW) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)I - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IFU - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSER - NBULL = F_NBULL - END IFL - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT))B - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR11 - SYS_NUM = SYS_NUM1D - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR.. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1L - IF (IER1.EQ.0) THENO - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1T - END IF - END IF - - IF (REMOTE_SET) THEN( - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY)I - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER)S - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIRD - CALL DISCONNECT_REMOTE0 - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IFT - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1H - ELSE - ICOUNT = ICOUNT1R - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100B - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 10 - ELSE - CALL READDIR(ICOUNT,IER)F - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user?S - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IFF - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? e - NSYS = NSYS + 1F - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)_ - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - END IF - IF (DIFF.LT.0) THENM - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN' - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.u - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100M - END IFN - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IFO - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THEN: - NSYS = NSYS + 1. - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))E - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for displayA - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THENT - BULL_POINT = ICOUNT - 1E - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100I - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF( - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages,I -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C. - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THENL - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesU - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2r - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1G - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT)L - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0( - DO J=1,NSYSG - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)L - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE' - ELSE - CALL GET_REMOTE_MESSAGE(IER)I - END IF - IF (IER.GT.0) THENO - CALL CLOSE_BULLFIL - GO TO 9999 - END IF_ - END IF - INPUT = ' 'A - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1D - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)S - END IFE - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)Y - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFILF - GO TO 9999 - END IFE - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)T - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATEN - END DOE - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2I - END IFA - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1R - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messagesU - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT)E - I = I + 1 - END IFV - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THENI - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next pageO - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....')T - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - INREAD = '+' - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' 'F - END IFN - IF (LEFT) THENF - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN) - LEFT = .FALSE. - ILEN = 0 - INREAD = '+'e - ELSE IF (ILEN.LE.WIDTH) THEN - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN)E - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSEU - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ')E - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH)& - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH0 - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0): - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DOI - IF (INPUT(ILEN:ILEN).EQ.' ') THENE - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' '_ - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEN - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE. - ELSE - WIDTH = PAGE_WIDTH - END IF - END IFE - END IF - END DO - IF (NGEN.EQ.0) THENH - WRITE (6,'(A)') ! Write delimiting blank lineM - END IF - PAGE = PAGE + 1 - END IFA - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2O - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next pageR - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)')E - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_GA - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen.E - END IFP - WRITE (6,'(''+'',A,$)') CTRL_GR - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020)m - WRITE(6,1025) - PAGE = PAGE + 2e - I = 0o - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY)P - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screenD - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1U - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')')P - ELSEL - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IFR - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEMU - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THENd - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated.P - END IFA -C. -C Instruct users how to read displayed messages if READNEW not selected.N -CE - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND._ - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030)U - ELSE IF (NGEN.EQ.0) THENU - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1B - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILENC - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.'A - PAGE = PAGE + 1 - ELSE - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1o - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)//E - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN) - & //' '//FOLDER_NAME(:FLEN)//p - & ' to read these messages.' - END IF - PAGE = PAGE + 1B - END IFE - -9999 IF (LOGIN_SWITCH) THENI - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IFL - RETURNU - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'))E -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.')G -1080 FORMAT(' ',/) - - END - - - S - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z)H - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listE - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlistB - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)),L - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THENT - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0U - END IFE - - RETURN - END - diff --git a/decus/vms94a/bulletin/bulletin1.for b/decus/vms94a/bulletin/bulletin1.for deleted file mode 100644 index ef3e0a3..0000000 --- a/decus/vms94a/bulletin/bulletin1.for +++ /dev/null @@ -1,2243 +0,0 @@ -C -C BULLETIN1.FOR, Version 3/23/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_P = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_P = LEN_P + I + 1 - BULL_PARAMETER(LEN_P:LEN_P) = ',' - END DO - LEN_P = LEN_P - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:I)//'""'// - & BULL_PARAMETER(I+1:) - I = I + 2 - LEN_P = LEN_P + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',BULL_PARAMETER(:LEN_P) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*32,DEFAULT_USER*12 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - IF (IER1.EQ.0) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THEN - I = IER - ELSE - NUM_COPY = NUM_COPY + 1 - END IF - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (.NOT.ORIGINAL.AND.REMOTE_SET.EQ.4).OR.REMOTE_SET.EQ.3 - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0.AND.NEWS_FEED()) THEN - IF (.NOT.ORIGINAL) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - IER1 = .FALSE. - ELSE - REMOTE_SET = 3 - END IF - END IF - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - ELSE - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF (TO_NEWS.AND.ORIGINAL) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2000' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (REMOTE_SET.GE.3.AND..NOT.ORIGINAL) THEN - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT) - ELSE - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (POST_NEWS) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder infoi -Cs -C If user is adding message, an no new messages, update last read time foro -C folder, so user is not alerted of new message which is owned by user. -Cs - IF (DIFF.GE.0) THENo - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)')F - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THENC - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//P - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSEC - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')')2 - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADERS - IF (ORIGINAL.AND.(NEWS_FEED().OR.REMOTE_SET.EQ.4)) RETURN - - FOLDER_NUMBER = SAVE_FOLDER_NUMBERt - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1)! - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THENr - WRITE (6,'('' WARNING: Original messages not deleted.'')')L - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IFe - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -CP -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C* - - IMPLICIT INTEGER (A-Z)3 - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC', - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_ABSENTT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE.// - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND.T - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')')T - GO TO 200& - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0/ - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN)D - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0)E - IF (CHANGED) THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IFt - -50 IF (PRINT_NUM.EQ.0) THEN' - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)E - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN, - CALL CLOSE_BULLFILA - CALL CLOSE_BULLDIRT - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THENR - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error.0 - RETURN - ELSE - SBULL = BULL_POINT: - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015)E - IF (OPENED) THEN - CALL CLOSE_BULLFILp - CALL CLOSE_BULLDIR - END IF_ - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN) - END IF - ELSED - SBULL = PRINT_NUM - EBULL = SBULLm - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name' - IF (QLEN.EQ.0) THENE - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')L - - CALL ENABLE_PRIVSG - END IF' - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER')R - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified messageA - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENTR - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THENP - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 1002 - CLOSE (UNIT=24,STATUS='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFILI - CALL CLOSE_BULLDIR' - END IFX - RETURN - ELSE IF (REMOTE_SET) THENL - CALL REMOTE_READ_MESSAGE(I,IER1)( - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTET - ELSEC - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100e - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)M - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN/ - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8)S - END IF_ - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THENC - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENI - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN)L - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into fileD - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DOR - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):). - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)N - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)L - END IF - -1040 FORMAT(' Message ',A,' sent to printer.') -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE.F - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS'))e - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE))H - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0)' - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) - END IF - - CALL DISABLE_PRIVSO - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)1 - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSES - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A,o - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE.e - GO TO 50 - END IF: - - RETURNA - -900 CALL ERRSNS(IDUMMY,IER)O - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER)r - RETURN. - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:')P -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -CE -C SUBROUTINE READ_MSG -Ci -C FUNCTION: Reads a specified bulletin. -CL -C PARAMETER:L -C READ_COUNT - Variable to store the record in the message fileR -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -CO - IMPLICIT INTEGER (A - Z)N - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'$ - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READITR - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING) - LOGICAL PAGINGR - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER, - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./H - - COMMON /POST/ POSTTIMEL - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_IDE - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./S - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPF - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/D - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH)+ - CHARACTER HEADLINE*132 - - LOGICAL SINCE,PAGE= - - EXTERNAL CLI$_NEGATED - - KILL = BTEST(BULL_USER_CUSTOM,3)= - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3)R - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this isQ - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THENE - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE.H - END IF - ROTC = CLI$PRESENT('ROTATE') - END IFF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3)T - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)C - ELSE IF (CLI$PRESENT('ALL')) THENO - READ_TAG = IBSET(0,1) + IBSET(0,2)U - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSEU - BULL_READ = 1 - END IFI - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THENV - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)I - GO TO 9999T - END IFN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSEe - CALL SYS_BINTIM(DATETIME,MSG_BTIM)u - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHAREDL - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIRe - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified?L - NEW = .TRUE.P - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),S - & F_NEWEST_BTIM)N - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IFe - CALL OPEN_BULLDIR_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READDIR_KEYGE(IER) - IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_BTIM) - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY)T - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - CALL CLOSE_BULLDIR - WRITE (6,'('' No new messages are present.'')') - GO TO 9999A - END IF - END DO - CALL CLOSE_BULLDIRf - ELSEw - IER = 0 - DO WHILE (IER.EQ.0) - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - MSG_NUM = IER - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(IER)I - IER = 0 - END IF - ELSE IF (IER.EQ.0) THENN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - END IF_ - END DO - END IF' - BULL_READ = IER - IER = IER + 1 - END IF - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THENR - WRITE (6,'('' No messages past specified date.'')') - GO TO 99992 - ELSE. - BULL_READ = IER - IER = IER + 1 - END IFE - SINCE = .TRUE.I - END IF - END IF - - NEXT = .FALSE.= - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THENC - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THENI - IF (.NOT.SINCE.AND..NOT.NEW - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THEN - IER = 0) - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR. - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THENP - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THENI - MSG_NUM = F_NBULL+1 - ELSEI - MSG_NUM = BULL_NOWL - END IF - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1n - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED= - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSEH - CALL GET_THIS_OR_NEXT_TAG - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0, - END IF) - END IF - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1I - END IFE - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1F - END DO1 - CALL CLOSE_BULLDIRI - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1' - ELSE IF (NEXT.OR.SINCE.OR.NEW) THENl - OLD_NEXT = NEXT - NEXT = .FALSE.( - IF (NEW) MSG_NUM = BULL_READ - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSEE - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THENr - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSEA - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0. - END IFE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IF - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSEE - IER = 0 - END IFo - END IF - END IF) - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND.i - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THENE - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entryC - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3H - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE.) - CALL READDIR(BULL_READ,IER) - END IFE - END IFE - IF (REMOTE_SET.LT.3.AND.I - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THENL - READ_COUNT = 0( - IF (IER.NE.BULL_READ+1) THENA - CALL READDIR(0,IER)N - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THENU - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0 - END IFo - CALL CLOSE_BULLDIRy - ELSE - IER = 0 - END IF - END IFE - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THENG - WRITE(6,1030) ! If not, then error outS - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IFB - - BULL_POINT = BULL_READ ! Update bulletin counterS - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEN - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN. - INFROM = INPUT(7:ILEN)4 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENN - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - - IF (.NOT.OK) THENR - BULL_NOW = MSG_NUM - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THENI - BULL_READ = MSG_NUM - 1O - ELSER - BULL_READ = MSG_NUM + 1B - END IF' - IF (REMOTE_SET) CALL CLOSE_BULLFILR - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THENE - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)) - END IF - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - GO TO 50( - END IF - - BLOCK = BLOCK_SAVE - END IFI - - NEXT = .FALSE. - IF (REMOTE_SET.LT.3) THEN - IF (INCMD(:4).NE.'SEAR') THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF. - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2)U - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN_ - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSEE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEND - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL)P - END IF - IF (INCMD(:4).NE.'SEAR') THENT - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ)X - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.BULL_READ) CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ)I - END IF - END IFI - - EDIT = .FALSE.O - - PAGE_WIDTH = REAL_PAGE_WIDTHT - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THENT - IF (CLI$PRESENT('EDIT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST'), - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 9999S - END IF_ - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTH - PAGE = .FALSE. - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSED - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULLL - END IF2 - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:)! - END DOy - I = TRIM(HEADLINE) - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME)E - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN). - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE))! - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE))F - END IFX - - END = 1 ! Outputted 1 line to screenO - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THENs - IF (REMOTE_SET.NE.3) THENR - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5), - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?T - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF0 - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IFn - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT))I - ELSEO - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IFL - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:): - DO WHILE (TRIM(INPUT).GT.0)L - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEND - WRITE(3,'(A)') INPUT(:I) - ELSEC - WRITE(6,'(1X,A)') INPUT(:I) - END IFC - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSEH - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROML - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN), - END IFE - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:)T - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN: - WRITE(3,'(A)') INPUT(:I)N - ELSEL - WRITE(6,'(1X,A)') INPUT(:I) - END IFN - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - IF (EDIT) WRITE(3,'(1X)')R - ELSE( - END = END + 1 - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP))A - IF (LINE_OFFSET.EQ.1) THEN. - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IFS - END IF - END IFP - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1R - CALL CLOSE_BULLFIL ! End of bulletin file readD - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)')E - END = END + 1 -C& -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory_ -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.u -Cs - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?M - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headF - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer: - END IFr - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSE - READ_COUNT = BLOCK ! Init bulletin record counterT - END IFE - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IFT - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0' - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE.U - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THENO - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN, - CHAR_OFFSET = 1( - BUFFER = INPUT(:PAGE_WIDTH)) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE. - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)C - END IF' - ELSET - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH' - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THENu - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0E - ELSE. - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IFN - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE.l - END IFe - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file readN - - IF (EDIT) THEN - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter_ - GO TO 9999 - END IF - -CE -C Bulletin page is now in temporary memory, so output to terminal.C -C Note that if this is a /READ, the first line will have problems withE -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at thee -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -CI - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counterY - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC)U - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read?E - IF (ILEN.GT.0) THEN ! Yes, there are still moreI - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletinI - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IFI - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF' - -9999 POSTTIME = .FALSE.S - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3)W - RETURN3 - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/)_ - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z)C - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THENS - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a'), - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO) - - RETURNW - END - - - - - - - SUBROUTINE READNEW(REDO)8 -C -C SUBROUTINE READNEWC -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C0 - - IMPLICIT INTEGER (A-Z)) - - INCLUDE 'BULLUSER.INC'G - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'W - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGN - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1: - EQUIVALENCE (INREAD4,INREAD)4 - - DATA LEN_FILE_DEF /0/, INREAD/0/H - - LOGICAL SLOW,SLOW_TERMINALR - - FIRST_MESSAGE = BULL_POINTM - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first timeU - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there ist - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletinsL - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get inputE - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper caseW - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THENC - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)'), - ELSE IF (INREAD.EQ.'E') THEN_ - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO_ - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURNB - END DOL - CALL EXIT - ELSET - WRITE (6,'(''+o'',$)')S - END IFS - RETURN ! If NO, exitL - ! Include QUIT to be consistent with next questionS - ELSE - CALL LIB$ERASE_PAGE(1,1)F - END IF - END IFI - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')')) - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1' - END IF - END IF) - - READ_COUNT = 0 ! Initialize display pointerL - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - BULL_POINT_READ = BULL_POINTS - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed?E - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and systemA - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it.n - BULL_POINT = BULL_POINT + 1 - GO TO 10a - END IF - CALL CLOSE_BULLDIR - END IFA - - GO TO 12L - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IFD - - BULL_POINT = BULL_POINT_SAVE - LENGTH = LENGTH_SAVEE - BLOCK = BLOCK_SAVEA - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSEA - WRITE(6,1030)i - END IFn - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper casee - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH. - BULL_POINT_SAVE = BULL_POINTA - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)')L - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directoryT - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE.. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN+ - ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt lineE - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEND - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF)T - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]'R - LEN_FILE_DEF = ILEN + 5 - ELSE. - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF) - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,N - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//. - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEFE - END IF) - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P)E - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL FILE(0,.TRUE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THENI - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR.. - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD)) - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)')D - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THENF - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THENM - WRITE (6,'(''+B'',$)')M - INCMD = 'RESPOND/LIST' - ELSE - GO TO 11_ - END IFE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPONDL - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')')N - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLY - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletinG - CALL CLOSE_BULLDIR ! Exit_ - WRITE(6,1010) - RETURNN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletinsL - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')')E - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ3 - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12E - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010)G - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message',E - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.')A -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),',X - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$)E -1040 FORMAT(' Type P to post reply, U to reply to user,',N - & ' B to do both, or other to quit: ',$)L - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -CM -C SUBROUTINE SET_DEFAULT_EXPIRE -CI -C FUNCTION: Sets default expiration date. -C. - IMPLICIT INTEGER (A-Z)( - - INCLUDE 'BULLFOLDER.INC'L - - INCLUDE 'BULLUSER.INC'N - - CHARACTER EXPIRE*3A - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN: - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN)l - IF (EX_LEN.GT.3) EX_LEN = 3) - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)( - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THENa - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THENN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMPS - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER)/ - CALL CLOSE_BULLFOLDERe - ELSE' - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF& - - RETURNi - END - - - - - LOGICAL FUNCTION NEWS_FEED() - - IMPLICIT INTEGER (A-Z)H - - INCLUDE 'BULLFOLDER.INC'N - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN' - I = SLIST + 1) - FLEN = TRIM(FOLDER_DESCRIP)) - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THENC - I = FLEN + 1I - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR., - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND. - & FOLDER_DESCRIP(I:I).NE.'@'.AND.T - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE - I = FLEN + 2N - END IF - END DO - IF (I.EQ.FLEN+1) NEWS_FEED = .TRUE.C - END IFI - - RETURNT - END diff --git a/decus/vms94a/bulletin/bulletin10.for b/decus/vms94a/bulletin/bulletin10.for deleted file mode 100644 index 78b46fc..0000000 --- a/decus/vms94a/bulletin/bulletin10.for +++ /dev/null @@ -1,3073 +0,0 @@ -C -C BULLETIN10.FOR, Version 4/6/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - IF (END_LINE.GT.257.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - END IF - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - 2 - IF (BUFFER(EB+2:EB+2).NE.LF) EB = EB + 2 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - CALL NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER()) THEN - CALL NEWS_POST('cancel',0,IER,'Delete news item.') - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = SETPRV_PRIV().OR.FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - BACKSEARCH = END - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.127) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8 - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONE - CHARACTER*4 ZONE - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/ - - CHARACTER*8 TIMES(1) - DATA TIMES /'-5:30'/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - IF (INDEX(ZONES,ZONE).LT.5) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) - END IF - ELSE - HOUR = '00:00' - END IF - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_L_TI(DATE,TIME(:2),,,) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - CHARACTER*256 TEMP_FROM_LINE - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - NEWSGROUPS = ' ' - LREF = 0 - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.') - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.127) - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - TEMP_FROM_LINE = FROM_LINE - CALL GET_FROM(TEMP_FROM_LINE(7:),TRIM(FROM_LINE)) - LAST_FROM = .TRUE. - ELSE - LAST_FROM = .FALSE. - END IF - END IF - END DO - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'3FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - START = -1 - IER = SYS$ASCTIM(,TIME,IN_BTIM,) - CALL DATE_TIME(TIME) - SKIP = 0 - DO WHILE (SKIP.GE.0) - IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( - & FOLDER_NAME))//' '//TIME)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'23') THEN - IF (.NOT.NEWS_READ()) CALL EXIT - DO I=1,SKIP - IF (.NOT.NEWS_READ()) CALL EXIT - END DO - FIRST = BUFFER(SB:EB) - IF (FIRST.EQ.'.') RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL EXIT - END DO - IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) - & CALL EXIT - IF (.NOT.NEWS_READ()) CALL EXIT - IF (BUFFER(:2).EQ.'22') THEN - IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN - I = F_NBULL + 1 - DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. - & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) - & .OR.I.GT.F_NBULL)) - I = I - 1 - IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (I.GE.F_START) START = I - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END IF - RETURN - END IF - END IF - SKIP = SKIP + 1 - END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2 - IER = IER1 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - CHARACTER*256 TEMP,TEMP1 - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IF - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1M - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)( - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THENM - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0E - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1U - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)2 - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSEN - IER = NEWS_READ() - IF (IER.AND.BUFFER(SB:EB).NE.'.') THEN - IER = 0R - LTEMP = EB-SB+1U - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THENQ - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF (INDEX(TEMP,': ').EQ.0.AND.I - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR(U - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255) THENR - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IFA - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IF - IF (LOCAL_UPDATE1.NE.0) THENE - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF D - ELSE - HEADER_SEEN = .TRUE.N - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)+ - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0. - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128 - ELSE - ILEN = 128 - END IF - END IFU - ELSE( - TEMP = TEMP(129:) - END IFU - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE. - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER( - CALL DISCONNECT_REMOTES - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF, - ELSE IF (ABS(ILEN).EQ.128) THENI - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DOA - - RETURN) - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER)I - - IMPLICIT INTEGER (A-Z)_ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURNX - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -CL -C SUBROUTINE CONNECT_REMOTE_FOLDER -CL -C FUNCTION: Connects to folder that is located on other DECNET node.7 -C2 - IMPLICIT INTEGER (A-Z)L - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH) - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)S - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATEA - - COMMON /READIT/ READIT( - - COMMON /NEWS_INIT/ END_READ - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'_ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE' - - DIMENSION DUMMY(4). - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - END_READ = 0 - IF (.NOT.NEWS_LOGIN()) THENN - IER = 2 - RETURNW - END IF - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name differentE - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IFR - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,_ - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THENL - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILEA - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SETN - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR_ - REMOTE_SET = REMOTE_SET_SAVES - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THENI - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IFI - END IF - IF (.NOT.SYSLOG) THEN/ - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNERS - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER' - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN. - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY,& - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE3 - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND.$ - & TEST_BULLCP().NE.2) THEN ! Not BULLCP processG - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)e - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)T - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE). - IF (IER.EQ.0) REWRITE (4) USER_ENTRY& - CALL CLOSE_BULLUSER - END IFE - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT), -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a differentE -C folder, or folder specified with "::", then update last read time.O -CI - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1), - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY)U - IF (SYSLOG) THEN - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3))O - END IF - END IF - IER = 0_ - END IF) - - RETURN - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'Z - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB0 - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /NEXT/ NEXTF - LOGICAL NEXT /.FALSE./0 - - COMMON /NEWGROUP/ NEWGROUPW - - CHARACTER*8 NUMBER - - DIMENSION IN_BTIM(2)E - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THENE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT' - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEYE - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADERT - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXITI - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF_ - RETURNR - ELSEU - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IFC - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBINM - END IF - ELSE IF (REMOTE_SET.EQ.3) THENF - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1r - RETURNs - ELSE IF (ICOUNT.EQ.-1) THENt - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXITb - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THENr - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXITM - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE. - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXITD - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THENI - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START)_ - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURNN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER))( - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITI - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITD - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THENS - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITA - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITC - END IF) - END IFC - IF (BUFFER(:2).NE.'22') RETURNL - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1))I - IF (.NOT.IER) RETURN - START = ICOUNT - BULLETIN_NUM = START. - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0L - CALL NEWS_HEADER(IER)= - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - BLOCK = START - MSG_NUM = START( - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IFN - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM)P - - IMPLICIT INTEGER (A-Z)E - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8G - INPUT(9-I:9-I) = MSG_KEY(I:I)U - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURNO - END - - - - SUBROUTINE NEWS_GROUP(IER)O - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /BUFFER/ BUFFER,SB,EBU - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUPC - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)) - IF (.NOT.IER) RETURN) - - IER = NEWS_READ() - IF (.NOT.IER) RETURNI - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1))W - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1))E - IF (.NOT.IER) RETURNU - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1))M - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT')J - IF (.NOT.IER) RETURNN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURN( - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME - - CHARACTER*20 TIME - - I = 1 - LTIME = TRIM(INTIME)E - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9')))1 - I = I + 1 - END DOM - - IF (I.GT.LTIME) THENT - CALL SYS_BINTIM('-',BTIM)R - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:))H - - DO J = 1,2_ - I = 1T - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-' - END DOE - - IF (I.EQ.LEN(TIME)) RETURN) - - IF (TIME(I+3:I+3).EQ.' ') THEN. - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IFF - - I = 1 - DO J = 1,20 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1. - END DOI - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) RETURN - - CALL SYS_BINTIM(TIME(:I-2),BTIM)O - - IF (INDEX(INTIME,'GMT').GT.0) CALL CONVERT_FROM_GMT(BTIM) - - RETURNL - END - - - - SUBROUTINE NEWS_LISTF - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC'D - - COMMON /BUFFER/ BUFFER,SB,EBM - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - COMMON /NEWSLIST/ NEWSLIST - - CHARACTER TODAY*241 - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURNp - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR.D - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER))L - - LOCAL_UPDATE = LOCAL_UPDATE1 - - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED ! Open folder fileE - - NEWS_FOLDER1_BBOARD = '::'T - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)D - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14F - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)I - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM= - END IF - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIREE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNTE - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1= - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1)E - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER)O - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1))) - SP = EP + 2F - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1))C - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1N - IF (IER.NE.0.OR.IER1.NE.0) THENE - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1T - I = FLEND - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN I - NEWS_FOLDER = NEWS_FOLDER1(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM( - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DON - IF (FLEN.GT.44) THENR - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)//T - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - END IFR - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DOO - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - IF (IER2.EQ.0) THEN J - NEWS_F1_FLAG = NEWS_F_FLAG - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN - NEWS_F1_EXPIRE = NEWS_F_EXPIRE1 - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSEE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IFB - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)S - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)B - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1). - IF (BTEST(NEWS_F1_FLAG,8)) THEN & - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0E - NEWS_F1_LAST = 0 - END IF - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND.( - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN9 - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IFF - ELSE IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN( - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM/ - END IF - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IFF - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE.S - IF (FLEN.GT.44) THENS - IF (NEWS_FOLDER1_DESCRIP.NE.n - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN. - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)N - UPDATE = .TRUE./ - END IF - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN( - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IFF - IF (SPECIAL) THEN - IF (UPDATE) THENI - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF) - ELSE IF (.NOT.UPDATE) THENF - UPDATE = F1_START.NE.NEWS_F1_START.OR.: - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - END DO= - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)S - NEWS_F1_COUNT = NEWS_F_COUNT) - REWRITE (7) NEWS_FOLDER1_COM - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)_ - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0)L - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7)I - CALL READ_FOLDER_FILE_TEMP(IER) - END DOC - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THENR - NEWS_F1_NBULL = F1_NBULLN - NEWS_F1_START = F1_START1 - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THENE - IF (NEWS_F1_FIRST.GT.F1_START.AND. - & NEWS_F1_FIRST.GT.F1_NBULL) THENO - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMI - END IFO - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),B - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IFN - ELSE IF (((F1_START.NE.NEWS_F1_START.OR.R - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND.(.NOT.BTEST(NEWS_F1_FLAG,8).OR. - & NEWS_F1_NBULL.LT.NEWS_F1_STARTU - & .OR.NEWS_F1_START.EQ.0)) THEN - DELETE (UNIT=7)I - IER = 0N - END IFE - END IF - END DO - END IFW - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - NEWSLIST = .FALSE.L - - RETURNT - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN) - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a'))Q - END IF - END DO. - - RETURNA - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLNEWS.INC'T - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'A - - INCLUDE 'BULLFILES.INC'E - - COMMON /BUFFER/ BUFFER,SB,EBS - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREFC - CHARACTER*256 REFERENCES. - - COMMON /PATH/ PATHNAME,LPATH5 - CHARACTER*132 PATHNAME. - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPSI - CHARACTER*256 NEWSGROUPS$ - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4E - - COMMON /LOCALPOST/ LOCAL_POST. - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE+ - CHARACTER*12 MSGNUM - - CHARACTER*(*) FILENAME,SUBJECT( - - CHARACTER TODAY*24,UNAME*132 - DATA UNAME /'()'/ - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THENR - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1)M - IF (IER1.NE.0) RETURN - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900 - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3)T - END IFA - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW)R - IER = SYS$ASCTIM(,TODAY,NOW,) - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:)I - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THENN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900S - IF (BUFFER(:3).NE.'340') THENE - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSE6 - I = INDEX(NEWS_MSGID,'.')O - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//U - & NEWS_MSGID(:I-1)//R - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER,L - & STATUS='NEW',DISPOSE='DELETE',RECL=256), - IF (IER.NE.0) RETURNH - LOCAL_POST = .TRUE. - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1 - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP) - ELSE IF (.NOT.BTEST(FOLDER_FLAG,8).AND. - & TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - INPUT = 'Newsgroups: '//NEWSGROUPSE - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER)E - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0 - DO WHILE (CLI$GET_VALUE('GROUPS',FOLDER1_NAME,FLEN) - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT))F - CALL LOWERCASE(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1)I - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9)) THEN = - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:TRIM(FOLDER1_NAME)). - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,D - & FOLDER1) - NGROUPS = NGROUPS + 1E - END IF - END IF - END DOT - CALL CLOSE_BULLNEWS - END IFE - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900P - END IFT - ATSIGN = INDEX(PATHNAME,'@')= - PCSIGN = INDEX(PATHNAME,'%')E - CALL LOWERCASE(USERNAME)E - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'. - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900D - END IF: - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME)P - - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900F - CALL STR$UPCASE(FROM_LINE,FROM_LINE)R - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME)L - L - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'//T - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECT - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF)))E - & GO TO 900 - END IFI - - IF (NGROUPS.GT.0) THEN1 - FROM = USERNAME - DESCRIP = SUBJECT - END IF - - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//'>')) GO TO 900 - - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:)g - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION)I - END IF - LORGAN = TRIM(ORGANIZATION) - END IFI - - IF (LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN)))N - & GO TO 900 - END IF+ - - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//N - & ZONE(:LZONE))) GO TO 900 - - IF (REMOTE_SET.EQ.4.AND..NOT._ - & (CREATE.OR.FILENAME.EQ.'cancel')) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE( - & FIRST_ALPHA(EXDATE):2) - & //' '//EXDATE(4:6)//' '//EXDATE(10:TRIM(EXDATE)) - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900T - ELSE - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT)A - END IF - EXTIME = '00:00:00.00'M - END IF - END IFE - - IF (CREATE) THENS - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURNI - END IF - - IF (FILENAME.EQ.'cancel') THENF - IF (.NOT.NEWS_WRITE('Control: cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURNO - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURNN - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_READ()) RETURNT - IF (BUFFER(:3).EQ.'240') IER = 0U - ELSE - CLOSE (UNIT=8,STATUS='SAVE')D - IER = 0 - END IF - LOCAL_POST = .FALSE. - RETURN - END IFE - - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - - IER1 = 0L - DO WHILE (IER1.EQ.0)R - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2U - END IF - IF (IER1.EQ.0) THEN - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DOI - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN) - IF (.NOT.NEWS_WRITE('.')) GO TO 900= - IF (.NOT.NEWS_READ()) GO TO 900L - IF (BUFFER(:3).EQ.'240') THEN - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:EB) - IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN( - WRITE (6,'('' Use /INDENT to change indentation'',$)') - WRITE (6,'(''+ character. See Manager for permanent'',$)') - WRITE (6,'(''+ change.'')') - END IF - END IF - ELSET - LENGTH = (LENGTH+127)/128E - GROUP_LIST = GROUP_LIST1A - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - DO I=NGROUPS,1,-1 - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1), - FOLDER_NUMBER = -11 - CALL SELECT_FOLDER(.FALSE.,IER)W - IF (IER) THEN _ - CALL ADD_LOCAL_NEWS(8) - END IFF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE1 - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - IF (.NOT.NEWS_WRITE('.')) GO TO 900E - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IFD - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - - LOCAL_POST = .FALSE.E - - RETURN - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLUSER.INC'W - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME. - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THENE - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME)B - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')')N - RETURNL - END IF - END IFD - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME)I - LPATH = TRIM(PATHNAME)L - - RETURNL - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME) - - IMPLICIT INTEGER (A-Z)R - - CHARACTER*(*) NAME - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME)i - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE.i - END DO - - TEST_NEWS = MAYBE_NEWSF - - RETURNE - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1( - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM)C - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM)E - IF (NUM.EQ.0) RETURN - M - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULL - FIRST = F1_STARTH - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - CALL OTS$CVT_L_TI(F_LAST+1,NUMBER,,,) - REMOTE_SET = 3- - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.)) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNTE - NEW_NEWS_F_END = NEWS_F_ENDF - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM)N - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1_ - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THENR - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - F_LAST = LAST - NEWS_F_FIRST = FIRSTE - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS E - RETURN2 - END IF - END DO. - - RETURNU - END - - - - - SUBROUTINE NEWS2BULLT - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BUFFER/ BUFFER,SB,EBE - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER TIME*20,FIRST*80,FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBERN - - DIMENSION SAVE_F_NEWEST_BTIM(2),NOW(2)E - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIVA - - CALL NEWS_LISTO - - CALL UPDATE_LOCAL_NEWSN - - CALL SEND_POST - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1G - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - ELIST = INDEX(FOLDER_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN - IF ((FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR. - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))).AND. - & INDEX(FOLDER_DESCRIP(SLIST+2:),'@').EQ.0) THENO - NUM_FOLDERS = NUM_FOLDERS + 1N - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IFL - END IFI - END IF - END DO) - - CALL CLOSE_BULLFOLDER ! We don't need file anymoreL - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXITA - - FOLDER_Q = FOLDER_Q1M - POINT_FOLDER = 0. - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)T - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)F - CALL SELECT_FOLDER(.FALSE.,IER)N - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARDN - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1)5 - IF (IER) THEN - SAVE_LAST = F_LAST, - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER)( - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIP. - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)N - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THENH - SAVE_LAST = F_NBULL - CALL OPEN_BULLFOLDERA - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1)O - F_LAST = SAVE_LASTE - FOLDER_BBOARD = 'NONEFEED'G - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - REMOTE_SET = 3 - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST)B - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.)W - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1)' - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1)= - END IF_ - CALL CLOSE_BULLFOLDER - END IF% - END IF - END DOE - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME)R - - IMPLICIT INTEGER (A-Z)E - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH. - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - CHARACTER*(*) TIMEA - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+) - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)//T - & TIME(16:17)//TIME(19:20)N - - RETURN - END - - - - SUBROUTINE ALLPRIV - - IMPLICIT INTEGER (A-Z)E - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1A - PROCPRIV(2) = -1= - NEEDPRIV(1) = -1N - NEEDPRIV(2) = -1I - - RETURNN - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COM( - - NEWS_FOLDER1 = FOLDER1D - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DOE - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)I - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_COUNT = NEWS_F_COUNT/ - REWRITE (7) NEWS_FOLDER1_COME - - RETURNI - END - - - - SUBROUTINE SUBSCRIBEI - - IMPLICIT INTEGER (A-Z)( - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'D - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')')D - RETURN - END IF) - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1O - END DO/ - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')')Y - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')')T - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSEN - WRITE (6,'('' You are now subscribed to '',A,''.'')')X - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IFt - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(T - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER)D - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1))0 - END IFS - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN1 - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THENL - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - LAST_NEWS_READ(2,J) = F_START - 1 - ELSE - LAST_NEWS_READ2(2,J) = 0D - LAST_NEWS_READ(2,J) = F_NBULL - END IFF - CALL CLOSE_BULLNEWS - RETURNE - END IF - END DOD - - END - - - - - - SUBROUTINE UNSUBSCRIBE1 - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC'_ - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSEM - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')')B - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IFR - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1))+ - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0F - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0T - - CALL FREE_TAGS(I) - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'O - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0 - RETURN - END IFF - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER), - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'O - - I = NEWS_FIND_SUBSCRIBE1()F - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0O - RETURN - END IFR - - RETURN+ - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLUSER.INC'I - - INCLUDE 'BULLFOLDER.INC'E - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR. - & (LAST_NEWS_READ(2,I).GT.F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER)S - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)L - END IF) - - RETURN - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG)E - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0_ - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THENA - COUNT = COUNT + 1U - END IF0 - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT)N - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE0 - SUBNUM = 0 - END IF - - RETURNS - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES) -C -C SUBROUTINE NEWS_NEW_NOTIFICATIONC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'U - - INCLUDE 'BULLUSER.INC'1 - - COMMON /READIT/ READITO - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)U - - MESSAGES = .FALSE. - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1 - - FOLDER_DESCRIP = ' 'F - REORDER = 0 - DO WHILE (SUBNUM.GT.0)S - IER = 1N - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)S - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)1 - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER)F - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUM - UNLOCK 7 - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1 - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THENL - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - ELSE IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR.T - & F_START.GT.F_NBULL) THEN - IER = 1) - END IFI - END IF_ - IF (IER.EQ.0.AND.SUBNUM.GT.0) THENN - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND.L - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEND - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR.D - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (DIFF.GT.0) IER = 1D - END IF - END IFT - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THENF - WRITE (6,'('' There are new messages in folder '',) - & A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)L - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - ELSER - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1)C - IF (IER1) THENE - CALL LOGIN_FOLDERC - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IFF - END IF - END IFE - CALL OPEN_BULLNEWS_SHARED - END IFA - END IF - END DO - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE - - CALL CLOSE_BULLNEWS - - RETURN7 - END - - - SUBROUTINE REORDER_SUBSCRIBEI - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'L - - INCLUDE 'BULLUSER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0) - I = I + 1 - END DO - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1 - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER)N - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1)C - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2D - TEMP = LAST_NEWS_READ(L,J) - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K) - LAST_NEWS_READ(L,K) = TEMP - END DO - END IFW - END DO - END DON - - RETURNE - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLUSER.INC'U - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENS - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IFS - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14)I - - RETURN- - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER)R - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC', - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN' - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF' - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15)C - - RETURNC - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'C - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEND - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IFT - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE.W - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURNL - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE()E - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC'6 - - INCLUDE 'BULLFOLDER.INC'A - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBERR - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1I - END DO - - NEWS_FIND_SUBSCRIBE = I - - RETURNE - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'N - - INCLUDE 'BULLFOLDER.INC'M - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 11 - END DO - - NEWS_FIND_SUBSCRIBE1 = I0 - - RETURNI - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC'T - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF2 - - IF (NOTIFY.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13) - IF (NOTIFY.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13)G - IF (READNEW.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - - CALL UPDATE_USERINFO_ - - RETURN/ - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT)M - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - REWIND UNIT - N - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '// - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK) - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THENL - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6, - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) - END IF' - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THENs - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1 - SYSTEM = 0 - CALL ADD_ENTRYG - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE UPDATE_NEWS_FOLDER -CE -C SUBROUTINE UPDATE_NEWS_FOLDER -CR -C FUNCTION: Updates folder info due to new message. -C1 - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THENE - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWS_F_NEWEST_BTIM)) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_ENDE - F_COUNT = NEW_F_COUNTI - END IF - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1 - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM))S - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_NEWEST_EX_BTIM_KEY(5:) - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURNO - END - - - - SUBROUTINE SEND_POST0 - - IMPLICIT INTEGER (A-Z) t - - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - T - CHARACTER FILE*132 - / - C = 0 - R - IF (.NOT.NEWS_LOGIN()) RETURNI - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST',FILE,C)) P - IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURN_ - IF (BUFFER(:3).NE.'340') RETURN - E - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0)A - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (INPUT(:5).EQ.'From:') - & BULL_PARAMETER = INPUT(7:INDEX(INPUT,'@')-1)) - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IFS - END DOT - IF (INPUT.NE.'.') THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - IF (BUFFER(:3).NE.'240') THEN - CLOSE (UNIT=3) - CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER))E - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER)I - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD')e - END IF - CLOSE (UNIT=3,STATUS='DELETE') I - END DO) - -100 CLOSE (UNIT=3) - - RETURN/ - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) g - - INCLUDE '($MAILDEF)'N - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVSD - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100I - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST) - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0)E - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS) - - IF (UNAME.EQ.'()') THEN - UNAME = ' 'E - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IFD - - RETURN - END diff --git a/decus/vms94a/bulletin/bulletin11.for b/decus/vms94a/bulletin/bulletin11.for deleted file mode 100644 index 4907f1c..0000000 --- a/decus/vms94a/bulletin/bulletin11.for +++ /dev/null @@ -1,2802 +0,0 @@ -C -C BULLETIN11.FOR, Version 1/11/94 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*12 BULL_MARK_DIR - CHARACTER*12 TAG_KEY,INPUT_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,) - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1) - ELSE - UNLOCK 13 - END IF - END IF - - NTRIES = 0 - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),) - IF (IER1.NE.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128,DISPOSE='DELETE', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1) - NEWS_MARK2(1) = NEWS_MARK2(2) - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE) - - IMPLICIT INTEGER (A-Z)& - - INCLUDE 'BULLUSER.INC'N - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURND - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1),( - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IFR - - RETURNS - END - - - - SUBROUTINE OPEN_NEW_TAG(IER)U - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'G - - INCLUDE 'BULLFOLDER.INC'N - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARKU - DIMENSION NEWS_MARK(128)E - - CHARACTER*12 BULL_MARK_DIRU - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IFD - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13N - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSER - MARKUNIT = 23O - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW',N - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)), - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0E - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IFR - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN. - WRITE (6,'('' Cannot create mark file.'')')E - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEND - WRITE (6,'('' IOSTAT error = '',I)') IERT - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1I - END IF - ELSE) - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)')I - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))S - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 11 - END IF - - RETURNT - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY))S - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:))D - - RETURN_ - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEYN - - CHARACTER*8 NEXT_MSG_KEY. - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IFO - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IFC - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY)= - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADERG - END IF - RETURN - END IFE - - MSG_KEY = BULLDIR_HEADERN - - HEADER = .TRUE. - - DO J=1,2Y - IF (BTEST(READ_TAG,J)) I = J - END DO_ - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURNT - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)_ - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IFT - - TAG_TYPE = 0N - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DOT - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO, - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR.N - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND.( - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THENW - IF (IER.EQ.0) UNLOCK 13 - IER = 0E - MESSAGE = MSG_NUML - ELSE - IER = 36 - END IFE - - RETURNT - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY) - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)E - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF_ - - IER = 36= - - HEADER = .FALSE.E - - TAG_TYPE = 0T - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)T - RETURN - END IFS - - DO WHILE (IER.NE.0) - I = 0T - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEY= - END DO( - IF (IER.EQ.0) THENE - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)I - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IFE - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:)' - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THENR - I = 2 - END IF - END IFI - END IF - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER))N - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEYU - END DOI - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I) - IER = 0 - RETURN2 - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THENT - MSG_KEY = NEXT_MSG_KEY - RETURN_ - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DOV - - RETURN( - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE)H - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHAREDI - - DO MESSAGE = MSG_NUM+1,F_NBULLI - CALL READDIR(MESSAGE,IER)I - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE)S - IF (IER.EQ.0) THEN) - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIRG - RETURN - END IFP - END IF - END DOA - - IER = 36P - IF (CLOSE_IT) CALL CLOSE_BULLDIRS - - RETURNM - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z)M - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2)O - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURNE - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J)H - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEYE - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER)M - & INPUT_KEY - END DOL - - CLOSE_IT = .FALSE.r - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY)i - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)i - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR.r - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURNP - ELSE - CALL DECREMENT_MSG_KEYT - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THENS - CALL OPEN_BULLDIR_SHARED - CLOSE_IT = .TRUE. - END IFo - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:))( - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THENE - MESSAGE = MESSAGE - 1E - MSG_NUM = MESSAGEE - MSG_KEY = BULLDIR_HEADER - END IFf - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - DELETE (UNIT=13)S - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER))F - READ (13,IOSTAT=IER) INPUT_KEYA - END DO - END IFR - END IF - - END DOE - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC'_ - - COMMON /NEWS_MARK/ NEWS_MARKL - DIMENSION NEWS_MARK(128). - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECF - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)_ - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)O - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE.D - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1' - DO M=1,2 - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THENG - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1L - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1T - LIMIT = 256/(NEWS_FORMAT+1)E - NEWS_NUMBER = LAST_NEWS_READ2(1,I)( - K = 5-NEWS_FORMAT*2T - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN. - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1' - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IFE - SET_LIST = .FALSE. - END IF$ - IF (J.EQ.NEWS_TAG(2,M,I)) THENA - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0)S - END DO - K = LIMIT + 1T - END IFe - IF (K.GT.LIMIT) THENW - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2M - NEWS_REC = NEWS_REC + 1 - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER))L - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER)R - IF (IER.EQ.0) THENL - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IFN - END DO - END IF - END DOR - END DO - CLOSE (UNIT=23)i - END IFf - - RETURN - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z), - - COMMON /NEWS_MARK/ NEWS_MARKE - DIMENSION NEWS_MARK(128)I - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)A - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = JN - ELSEG - NEWS_MARK(I) = J - END IFF - - RETURNT - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG)S - - IMPLICIT INTEGER (A-Z)A - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUMD - NEWS_TAG(I) = 0L - END DOB - - RETURN& - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'M - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARKL - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECE - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)s - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)s - - DO I=1,2, - IF (NEWS_TAG(3,I,ISUB).GT.0) THENE - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB))I - NEWS_TAG(3,I,ISUB) = 0M - NEWS_NUMBER = NEWS_FOLDER_NUMBERT - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER))A - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARKY - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER) - END IF - END DO - END IF - - DO J=I,FOLDER_MAX-2 - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J))D - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0O - END DO - END DOE - - RETURN - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE)D - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY_ - - IER = 36G - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE)S - IF (IER.EQ.0) THENE - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THENN - IF (.NOT.BTEST(READ_TAG,3)) THENG - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM) - END IF - IER = 36 - END IF - END IFA - END DO - BULL_READ = MSG_NUMT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - ELSEA - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0E - MSG_KEY = BULLDIR_HEADER - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THEN. - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF1 - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)C - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUMB - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36 - END IF - END IF) - - RETURNT - END - - - SUBROUTINE DECREMENT_MSG_KEY - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I))N - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DOI - - RETURNS - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -CI -C SUBROUTINE SET_GENERICR -C3 -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying) -C general bulletins continually for a certain amount of days.A -C) - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC', - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THENS - WRITE (6,'(P - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN) - IF (GENERIC) THEN= - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSEF - NEW_FLAG(2) = ' 7'O - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE( - WRITE (6,'('' ERROR: Specified username not found.'')')Y - END IFK - - CALL CLOSE_BULLUSER - - RETURNE - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -CD -C SUBROUTINE SET_BRIEF_CONTINUOUS -CE -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -CE - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLUSER.INC'L - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSEL - NEW_FLAG(2) = 0T - END IFA - - IF (IER.EQ.0) REWRITE (4) USER_ENTRYA - - CALL CLOSE_BULLUSER - - RETURN' - END - - - SUBROUTINE SET_LOGIN(LOGIN) -CN -C SUBROUTINE SET_LOGINN -CT -C FUNCTION: Enables or disables bulletin display at login.N -C( - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLUSER.INC'R - - CHARACTER TODAY*24S - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THENM - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IFL - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)A - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)R - IF (IER.EQ.0) THENS - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN' - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')')A - END IFG - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z)E - - CHARACTER USERNAME*(*),ACCOUNT*(*)N - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2)L - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT))E - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST)= - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2)( - - RETURNH - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4)( - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1O - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN, - END - - - - SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)'( - - INCLUDE 'BULLUSER.INC'T - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1))S - - CALL DISABLE_PRIVS' - - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))//: - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))//N - & SUBJECT(INDEX(SUBJECT,'""')+2:)2 - END DO - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR) - - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100D - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO))L - I = INDEX(SENDTO(J:),',') - 1 - IF (I.EQ.-1) I = TRIM(SENDTO(J:)) - CALL INIT_ITMLSTV - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0)E - IF (.NOT.STATUS) GO TO 100 - J = J + IC - IF (SENDTO(J:J).EQ.',') J = J + 1 - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) - IF (SETPRV_PRIV()) THEN - CALL ENABLE_PRIVSE - CALL ADD_2_ITMLST - & (TRIM(USERNAME),MAIL$_SEND_FROM_LINE,%LOC(USERNAME)) - END IFO - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO))R - CALL END_ITMLST(ATTRIBUTE_ITMLST) - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0)/ - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS( - CALL LIB$REVERT - - RETURN - ENDD - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,)_ - - RETURNR - END - - - - - SUBROUTINE SET_NEWS3 - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC'T - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_PO - CHARACTER*64 BULL_PARAMETERT - R - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /NEXT/ NEXTQ - - DIMENSION EXPIRED(2) - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THENI - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IFb - - ENTRY SHOW_NEWS - - LIMIT = -2( - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1))L - IF (.NOT.IER.OR.LIMIT.LT.-1) THENN - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')') - RETURN - END IF M - END IF - - EXPIRE = -1E - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1))M - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURNE - END IF R - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR.M - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')')F - RETURNE - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - IF (CLI$PRESENT('DEFAULT')) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)N - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THENL - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1, - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')')3 - CALL CLOSE_BULLNEWS - RETURN - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN0 - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE_ - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IFC - IF (BTEST(FOLDER1_FLAG,0)) THEN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE')U - END IF - RETURN - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)= - DO WHILE (IER.EQ.0)E - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER)E - END DOL - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT( - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULTW - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT( - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED), - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)1 - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE)N - FOLDER1_NUMBER = NEWS_F1_COUNTN - FOLDER1 = BULL_PARAMETER - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10)E - CALL WRITE_FOLDER_FILE_TEMP(IER)N - IF (IER.NE.0) THENP - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURNG - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMP - REWRITE (7) NEWS_FOLDER1_COMW - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER)A - END IF L - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURNS - END IF - END IF= - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT, - - CLASS = CLI$PRESENT('CLASS') - DEFAULT = CLI$PRESENT('DEFAULT')L - ALL = CLI$PRESENT('ALL')& - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE') - ENABLE = CLI$PRESENT('ENABLE')E - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - I - STORED = 0L - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN M - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0R - F1_NBULL = 0T - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF, - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,N - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN) - WRITE (6,'('' Stored setting was not removed.'')') - CALL CLOSE_BULLNEWS - RETURN. - END IFI - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(BULLNEWSDIR_FILE( - & :TRIM(BULLNEWSDIR_FILE))//';*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))M - & //'[.BULLNEWS*]*.*;*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))R - & //'BULLNEWS*.DIR;*')N - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THENN - CALL CLOSE_BULLNEWS - FOLDER_SAVE = FOLDERR - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - FOLDER = FOLDER_SAVER - CALL OPEN_BULLDIR_SHARED - KEEPLOCK = .TRUE. - NEXT = .TRUE. - BULL_DELETE = 1 - F_START = 0 - F_NBULL = 999999 - CALL READDIR(BULL_DELETE,IER) - DO WHILE (IER.EQ.BULL_DELETE+1) - DELETE (2) - CALL READDIR(BULL_DELETE,IER), - END DO - NEXT = .FALSE.D - KEEPLOCK = .FALSE. - CALL CLOSE_BULLDIR - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 03 - F1_NBULL = 0E - F1_COUNT = 0 - F1_LAST = 0O - END IF. - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8)G - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)_ - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THENF - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER)M - CLOSE (UNIT=3,DISPOSE='DELETE')L - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IFM - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN= - CALL SET_PROTECTIONT - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP),R - & STATUS='OLD',IOSTAT=IER)T - CLOSE (UNIT=3) - IF (IER.NE.0) THEN S - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - END IF - CALL RESET_PROTECTIONT - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IFD - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)K - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN R - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG. - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE) - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMITG - END IFU - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)_ - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THENN - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') B - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')')D - ELSE= - WRITE (6,'('' Default is not stored.'')')A - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)_ - ELSE IF (CLASS) THENI - WRITE (6,'('' Expiration is DEFAULT value.'')') - ELSE, - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')') - END IF. - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,)6 - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Default expiration limit is '',A,''.'')')1 - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')')E - ELSEK - WRITE (6,'('' There is no default expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IFG - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)E - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')') - ELSEK - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)S - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)L - IF (FOLDER1_BBEXPIRE.GT.0) THEN+ - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN_ - WRITE (6,'('' Expiration limit is '',A,''.'')')E - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')')P - ELSEZ - WRITE (6,'('' There is no expiration limit.'')') - END IFC - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IFR - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER)K - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1r - WRITE_ACCESS = 1N - ELSEB - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IFE - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWSN - RETURN - END IFY - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN. - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP)S - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER)R - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THENS - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER)3 - END IF - FOUND = .FALSE.B - MODALL = INDEX(GROUP,'.').NE.LG6 - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR. - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.'))T - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWSI - FOLDER_NUMBER = FOLDER1_NUMBER_ - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THENN - CALL OPEN_BULLDIR_SHARED - KEEPLOCK = .TRUE.A - NEXT = .TRUE.E - BULL_DELETE = 1M - F_START = 0( - F_NBULL = 999999V - CALL READDIR(BULL_DELETE,IER) - DO WHILE (IER.EQ.BULL_DELETE+1)E - DELETE (2)W - CALL READDIR(BULL_DELETE,IER) - END DO - NEXT = .FALSE. - KEEPLOCK = .FALSE. - CALL CLOSE_BULLDIR - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) W - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0S - F1_COUNT = 0F - F1_START = 0E - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE' - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER)L - END DOS - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') R - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER)W - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER)N - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER))O - END IFI - RETURNf - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')')_ - IER = 0W - DO WHILE (IER.EQ.0)V - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0( - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0) - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR.2 - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0I - F1_START = 0 - F1_NBULL = 0_ - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)W - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)2 - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER)S - END DO - END IFE - - FOLDER_NUMBER = -11 - FOLDER1 = FOLDERV - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0E - CALL SELECT_FOLDER(.FALSE.,IER)N - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF_ - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLUSER.INC'Y - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER+ - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM4 - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'S - - CALL DISABLE_PRIVSA - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH)O - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)E - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THENL - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IFE - - FULL = CLI$PRESENT('FULL')R - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P)) THEN_ - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error outN - RETURNN - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN fileS - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)M - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (CLI$PRESENT('SUBJECT')) THENG - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)G - ELSER - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IFT - ELSE - INPUT = FROM - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:) - ELSEU - INPUT = DESCRIP - END IFL - END IF - - CALL CLOSE_BULLFIL - END IF( - - IF (CLI$PRESENT('SUBJECT')) THEN - INPUT = 'SUBJECT:'//INPUT - ELSEE - INPUT = 'FROM:'//INPUT - END IFD - - IF (EXCLUDE) THEN - INPUT = ':EXCLUDE:'//INPUT - ELSE) - INPUT = ':INCLUDE:'//INPUT - END IFF - - FLEN = TRIM(FOLDER_NAME)" - INPUT = FOLDER_NAME(:FLEN)//INPUT - - ILEN = TRIM(INPUT)a - ALL = CLI$PRESENT('ALL') - DISABLE = CLI$PRESENT('DISABLE')E - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) - & WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)O - CLOSE (UNIT=4,DISPOSE='SAVE')6 - RETURN - END IFE - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERE - IF (IER.EQ.0) THEN - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THENL - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5)) - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill'm - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF (STREQ(OLD_BUFFER(:OLEN),INPUT(:ILEN))) THEN_ - IF (.NOT.DISABLE) THEN - WRITE (6,'('' ERROR: Entry already present.'')') g - CLOSE (UNIT=4) o - CLOSE (UNIT=3) - RETURN - END IF - ELSE IF (.NOT.(ALL.AND.INPUT(:FLEN+8).EQ.I - & OLD_BUFFER(:MIN(FLEN+8,OLEN)))) THEN - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN)E - END IFG - END IF - END DO - - IF (.NOT.DISABLE) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)C - IF (FULL) WRITE (4,'(A)',IOSTAT=IER) - & FOLDER_NAME(:FLEN)//':defaults:kill' - END IFN - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL CHECK_CUSTOM - - RETURN - ENDC - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./h - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE - DATA SCRATCH_B1/0/E - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THEN. - BULL_USER_CUSTOM = .FALSE. - ELSEE - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IFL - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'E - - OPEN(UNIT=17,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)),n - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURNB - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?, - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headC - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IFL - - NINCLUDE = 0A - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ.% - & OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+1,OLEN))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1)T - CALL LOWERCASE(OLD_BUFFER) - IF (INDEX(OLD_BUFFER(TRIM(FOLDER_NAME)+2:),'defaults')O - & .EQ.1) THENB - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1N - END IF) - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THEN) - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - END IF - END DOI - - CLOSE (UNIT=17) - - RETURN - END - - - - - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1)O - - IMPLICIT INTEGER (A-Z)Q - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'V - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./R - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEO - DATA SCRATCH_B1/0/ - - CHARACTER*(*) STRING,STRING1J - - INCLUDE_MSG = .TRUE.D - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURNS - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - INC = .FALSE. - - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER)S - IF (STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THENT - IF (.NOT.INC) INCLUDE_MSG = .FALSE. - INC = .TRUE. - END IF - IF ((STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:').AND.M - & (STRFIND(STRING(:TRIM(STRING)),OLD_BUFFER - & (FLEN+15:OLEN)).OR.S - & STREQ(STRING(:TRIM(STRING)),OLD_BUFFER - & (FLEN+15:FLEN+14+TRIM(STRING))))).OR.G - & (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND. - & STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER - & (FLEN+18:OLEN)))) THEN - INCLUDE_MSG = STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE') - IF (.NOT.INCLUDE_MSG) RETURN - END IFA - END IF - END DOA - - RETURNI - END - - - - FUNCTION STRFIND(STRING,STRING1)_ - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) STRING,STRING1 - - L = LEN(STRING1)R - DO I=0,LEN(STRING)-LD - J = 1' - DO WHILE (J.LE.L)L - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J)))M - IF (DIFF.NE.0.AND.DIFF.NE.32) THEN - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = .TRUE.E - RETURNO - ELSED - J = J + 1_ - END IF - END DO - END DO - - STRFIND = .FALSE. - - RETURNI - END - - - - - SUBROUTINE SET_NEWNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)S - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)E - COMMON /USERINFO/ LAST(2,FOLDER_MAX)B - - CHARACTER*12 NEW,OLDI - - IF (.NOT.SETPRV_PRIV()) THEN. - WRITE (6,'('' ERROR: No privs to set a new name.'')')u - RETURN - END IF - - CALL CLI$GET_VALUE('OLDNAME',OLD,LENO) - CALL CLI$GET_VALUE('NEWNAME',NEW,LENN)A - - CALL OPEN_BULLUSER_SHARED - - TEMP_USER = USERNAME - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY - END DO - - IF (IER.EQ.0) THENE - USERNAME = NEW - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=NEW) - END DO R - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) USER_ENTRY - ELSE - REWRITE (4,IOSTAT=IER) USER_ENTRY - END IF E - END IF - - USERNAME = TEMP_USER - DO WHILE (REC_LOCK(IER1)) - READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY - END DO - - CALL CLOSE_BULLUSER - - IF (IER.NE.0) THENI - WRITE (6,'('' ERROR: Old name not found.'')') - RETURN - END IFR - - CALL OPEN_BULLINF_SHAREDC - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN) - WRITE (9,IOSTAT=IER) NEW,LAST - ELSEa - REWRITE (9,IOSTAT=IER) NEW,LAST_ - END IF - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER))R - READ (9,KEY=NEW,IOSTAT=IER) - END DO E - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF E - ELSEO - DO WHILE (REC_LOCK(IER))D - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO)))L - NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN)))N - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - IF (LENO.GT.1) THEN - OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1)))N - ELSE= - OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2))) - END IF - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - IF (LENN.GT.1) THEN - NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1))) - ELSEP - NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))) - END IFR - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN( - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO ) - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF _ - ELSEE - DO WHILE (REC_LOCK(IER))E - READ (9,KEY=NEW,IOSTAT=IER) - END DO I - IF (IER.EQ.0) DELETE (9) - END IFL - - CALL CLOSE_BULLINFI - - RETURN - END' diff --git a/decus/vms94a/bulletin/bulletin2.for b/decus/vms94a/bulletin/bulletin2.for deleted file mode 100644 index 2d05bf0..0000000 --- a/decus/vms94a/bulletin/bulletin2.for +++ /dev/null @@ -1,2374 +0,0 @@ -C -C BULLETIN2.FOR, Version 3/11/94 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::'.OR.NEWS_FEED()) THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'RE:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'RE: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - IF (IER.NE.0) FILESPEC = .FALSE. - CALL ENABLE_PRIVS - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.EQ.0) THEN - INFROM = INPUT(:ILEN)//',' - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - ILEN = TRIM(INPUT) - IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(INPUT(7:),ILEN) - INFROM = INFROM(:LENFRO)//INPUT(7:) - LENFRO = LENFRO + ILEN - 6 - END IF - IF (EDIT.AND.TEXT) THEN - IF (INPUT(ILEN:ILEN).EQ.'"') ILEN = ILEN - 1 - INPUT = INPUT(7:ILEN) - ILEN = ILEN - 6 - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:) - ILEN = TRIM(INPUT) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:ILEN)//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_P = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LEN_P.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') BULL_PARAMETER(:LEN_P)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THEN - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSEs - IER = 0r - END IFs - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME)r - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP)b - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')')s - END IF - END IFS - IF (IER.EQ.0.AND.LENFRO.GT.0) THENT - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS)I - END IFZ - END IF - ELSEL - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,U - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (.NOT.FILESPEC) THENB - WRITE (6,'('' Enter message: End with ctrl-z,'',Y - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input lineE - ICOUNT = 0 ! Character count counterA - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too longN - WRITE(6,'('' ERROR: Input line length > '',I,O - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredN - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DOU - ELSE - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUTI - IF (IER.EQ.0) THEN - ICOUNT = ICOUNT + 1' - WRITE (3,'(A)') INPUT(:ILEN) - END IFE - END DO) - CLOSE (UNIT=4)( - FILESPEC = .FALSE. - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3)' - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,. - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IFR - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN: - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM,O - & INDESCRIP,STATUS) - END IF - END IF - END IF - IF (IER.NE.0) THENE - WRITE (6,'('' ERROR: No message added.'')')n - IF (.NOT.STATUS) THEN - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ')' - IF (STREQ(INPUT(:1),'Y')) THEN/ - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV')N - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IF - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')m - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C= -C SUBROUTINE ADD_SIGNATURE -CA -C FUNCTION: Adds signature to message being mailed/posted., -C) - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATUREI - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/M - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURNE - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THENE - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED')) - END IF - - IF (IER.NE.0) THENR - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY,I - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) RETURNt - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IF - - ICOUNT = 0O - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUTe - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME)))N - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT)I - IF (.NOT.MATCH) THEN. - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT' - ILEN = TRIM(INPUT)E - END DO - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IFo - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE. - ELSEF - ICOUNT = ICOUNT + 1) - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' ' - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN)A - END IFE - END IF - END DOL - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURNf - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1)u - - IMPLICIT INTEGER (A-Z)' - - CHARACTER*(*) INPUT,INPUT1D - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.DIFF.NE.32) RETURN - END DOL - - STREQ = .TRUE.C - - RETURNS - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -CT -C SUBROUTINE RESPOND_MAIL -Cf -C FUNCTION: Sends mail to address.P -CP - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'L - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,INDESCRIP*(LINE_LENGTH)' - - INDESCRIP = SUBJECT - LENDES = TRIM(INDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES)t - IF (INDESCRIP(I:I).EQ.'"') THENF - IF (LENDES.EQ.LINE_LENGTH) THEN - INDESCRIP(I:I) = '`'( - ELSEC - INDESCRIP = INDESCRIP(:I)//'"'H - & //INDESCRIP(I+1:) - I = I + 1 - LENDES = LENDES + 1 - END IFS - END IF - I = I + 1R - END DOE - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0D - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD)O - - IF (LISTSERV) THEN_ - IF (SYS_TRNLNM('MX_NODE_NAME',MAILER)) THENG - REPLY_TO = .NOT.SYS_TRNLNM('MX_REPLY_TO',MAILER)N - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - REPLY_TO = .NOT.SYS_TRNLNM('PMDF_REPLY_TO',MAILER)2 - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - END IF - END IF - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THENF - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)) - & //'""" """'//INDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IF0 - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//INDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE_ - I = INDEX(SENDTO,'%""') + 3O - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THEN - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THENA - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THENF - SENDTO(I+1:) = '\'//SENDTO(I+1:)E - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THENE - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & INDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS)a -Cm -C Use the following if you do not have VMS V5.3 or greater.( -C= -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//( -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//INDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IFE - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV) THENR - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('PMDF_REPLY_TO') - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('MX_REPLY_TO')D - END IF. - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -CT -C FUNCTION: Confirms that username is valid user. -C. - IMPLICIT INTEGER (A-Z)_ - - CHARACTER*(*) USERNAMEE - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: CHANGE command subroutine.z -C - IMPLICIT INTEGER (A - Z)l - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTO - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'& - - INCLUDE 'BULLFOLDER.INC'H - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH)A - CHARACTER*4 ANSWERY - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')')E - RETURN - END IF' - -CD -C Get the bulletin number to be replaced. -Ct - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THENB - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error, - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL, - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURNd - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')')S - RETURNO - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THENE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE.R - ELSE IF (CLI$PRESENT('ALL')) THENE - SBULL = 1 - EBULL = NBULL - END IF - END IF' - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')')F - RETURNY - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')')T - RETURNn - END IF - END IFr - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')')( - RETURN( - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURNE - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE.I - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')')n - RETURNT - END IF - END IFV - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'(L - & '' ERROR: Not enough privileges to change to permanent.'')')u - RETURN - END IFe -Cl -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -CO - - CALL OPEN_BULLDIR_SHARED1 - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULLe - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. 1 - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner?t - WRITE(6,1090) ! If not, then error out. - RETURN' - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IFP - -CL -C If no switches were given, replace the full bulletin_ -CE - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND.e - & (.NOT.CLI$PRESENT('HEADER')).AND.i - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND.O - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF( - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN_ - WRITE (6,'('' ERROR: Cannot change text when replacing'',D - & '' more than one messsage.'')')D - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN/ - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1)r - IF (.NOT.IER) GO TO 910E - INEXDATE = INPUT(:11)) - INEXTIME = INPUT(13:23) - END IFR - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THENN - WRITE(6,1050) ! Request header for bulletinS - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES)R - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP))O - END IFL - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find messageS - CALL CLOSE_BULLDIRL - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')')) - & NUMBER_PARAME - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - LENFROM = 0m - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,a - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')n - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER). - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)_ - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENC - INFROM = INPUT(:ILEN) - LENFROM = ILENR - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENI - IF (LENDES.EQ.0.AND..NOT.DOALL) THENC - INDESCRIP = INPUT(:ILEN)) - LENDES = ILEN - END IFB - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into fileT - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -Cs -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)$ - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specifiedE - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specifiedE - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specifiedL - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy messageD - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)M - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into filef - WRITE (3,'(A)') INPUT(:ILEN). - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')G - END IF6 - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1')E - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',. - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THENP - CALL DISABLE_PRIVSO - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',( - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesM - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950) - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THENS - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line withT - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IFN - END IFD - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input lineI - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTHE - ELSE IF (ILEN.GT.0) THEN ! If good input line enteredN - ICOUNT = ICOUNT + 1 + ILEN ! Increment character countU - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THENR - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outS - ENDIF - - END IF - -CH -C Add bulletin to bulletin file and directory entry for to directory file.T -C0 - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIPN - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entryN - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR.T - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it.N - IF (IER.NE.NUMBER_PARAM+1) DATE = ' '. - NUMBER_PARAM = 0 - IER = 1L - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER)M - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find messageM - CALL CLOSE_BULLDIR: - CLOSE (UNIT=3,STATUS='SAVE')- - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')')I - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')')( - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletinM - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK)T - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.'n - CALL CLOSE_BULLFILE - CALL CLOSE_BULLDIR - CLOSE (UNIT=3): - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER)U - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THENW - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description header - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT,L - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THENC - SYSTEM = IBSET(SYSTEM,0)T - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER)T - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR.( - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THENF - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THENI - MSGTYPE = IBSET(MSGTYPE,1)L - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2). - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3)/ - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIPD - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER)f - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COMe - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I)H - END IFO - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DOF - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURNE - -910 WRITE(6,1010)( - CLOSE (UNIT=3,ERR=100) - GOTO 100X - -920 WRITE(6,1020)B - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100E - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)T - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')T -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.')H -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.')F -1100 FORMAT(' Message(s) is not owned by you.',c - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A)N - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT= - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12' - - IF (EXPIRE) THENS - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIMEN - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header ine - NEWEST_EXTIME = EXTIME ! the directory filet - CALL WRITEDIR(0,IER)R - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN! - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2)a - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER)s - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000'= - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN= - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000'A - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THENO - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THENT - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'',E - & '' Invalid node name specified.'')')N - END IFY - END IFR - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)Q - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//M - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present timeg - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF' - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C' -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z)L - - INCLUDE 'BULLFOLDER.INC'' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10)E - - EXTERNAL CLI$_ABSENT) - - NFOLDER = 1 - - IF (CLI$PRESENT('SELECT_FOLDER')) THENi - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0L - END IF - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME_ - NFOLDER = NFOLDER + 1O - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DOE - - IF (CLI$PRESENT('SELECT_FOLDER')) SCRATCH_F = SCRATCH_F1N - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IFT - - IF (CLI$PRESENT('NOREPLIES')) THENP - SEARCH_STRING = 'RE:', - SEARCH_LEN(1) = 3D - SEARCH_NUM = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' 'T - SEARCH_NUM = 1 - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1D - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM). - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1T - ELSEN - SEARCH_STRING = ' ' - END IFT - - MATCH_MODE = 0R - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IFT - - IF (NFOLDER.GT.0) FOUND = 0 - - DO WHILE (NFOLDER.GT.0.AND.FOUND.LE.0) - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR.N - & SCRATCH_F.NE.SCRATCH_F1) D - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL, - & CLI$PRESENT('REVERSE'),CLI$PRESENT('SUBJECT')A - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'),U - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),MATCH_MODE) - IF (FOUND.EQ.-1) THENR - NFOLDER = 0 - ELSE IF (FOUND.LE.0) THEN, - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1) NFOLDER = NFOLDER - 1I - IF (NFOLDER.GT.0) THENU - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME)' - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME))& - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1. - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F, - & FOLDER1_NAME)R - END IFE - END IF - END DOR - END IFS - END IF - END DOO - - IF (FOUND.GT.0) THENP - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - WRITE (6,'('' No messages found with given search string.'')') - ELSE IF (FOUND.EQ.-2) THEN, - WRITE (6,'('' ERROR: No more messages.'')') - END IFN - - RETURNS - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN, - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE)) -C -C SUBROUTINE GET_SEARCH -C( -C FUNCTION: Search for bulletin with specified string -C" - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC') - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUPT - - COMMON /NEXT/ NEXT - LOGICAL NEXT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*4 SAVECMD ) - - CHARACTER*56 DESCRIP1 - - FOUND = -1O - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_ASTN - - IF (TRIM(SEARCH_STRING).EQ.0) THEN+ - IER1 = .FALSE. - ELSE( - IER1 = .TRUE.( - END IF - N - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string enteredE - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')')E - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURNE - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THEN( - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THENT - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4_ - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THEN - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(START_BULL,IER) - IF (START_BULL+1.NE.IER) THENC - WRITE (6,'('' ERROR: No message being read.'')')P - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURNE - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2D - END IF - END IF, - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper caseM - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.G - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THENC - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last' - END IF - IF (REVERSE) THENQ - START_BULL = MIN(START_BULL,NBULL-1)F - END_BULL = 1E - STEP_BULL = -1b - ELSE - END_BULL = NBULLT - STEP_BULL = 1 - END IF - END IFn - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIRL - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IFE - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0L - BULL_SEARCH = START_BULL+1L - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR.E - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY), - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY)i - END IFe - ELSEn - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY)L - END IFE - IF (IER.EQ.0) THENU - IER = BULL_SEARCH + 1 - ELSEF - GO TO 800 - END IFT - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THENS - IF (SEARCH_MODE.EQ.4) THENN - CALL STR$UPCASE(DESCRIP1,FROM) - ELSEY - CALL STR$UPCASE(DESCRIP1,DESCRIP)T - END IF - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1.AND. - & DESCRIP1(:4).EQ.'RE: ')))) THEN - IF (.NOT.NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - ELSE IF (FLAG.EQ.1) THENR - WRITE (6,'('' Search aborted.'')')E - GO TO 900 - ELSE IF (NEGATED) THEN h - FOUND = BULL_SEARCH - GO TO 900 - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN - IF (REMOTE_SET) THENN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE' - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900e - END IF - END IFs - ILEN = LINE_LENGTH + 1i - MATCHES = 0b - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE.E - END DO - DO WHILE (ILEN.GT.0)D - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)S - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THENN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I) - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR. - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THEN1 - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900I - ELSE IF (FLAG.EQ.1) THENn - WRITE (6,'('' Search aborted.'')') - GO TO 900 - END IFe - END DOS - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCHN - GO TO 900 - ELSES - FOUND = -1 - END IF - END IFH - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULL. - END DO - -800 FOUND = 0R - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER)D - END IF - END IF. - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file readn - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL. - - NEXT = .FALSE. - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMDC - - RETURN - END - E - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE) - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRINGE - I - OLD_MATCH = .FALSE.P - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURN - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE. - RETURN - END IF - J = J + SEARCH_LEN(I)N - END DO - - RETURN= - END - - - - SUBROUTINE UNDELETE -CI -C SUBROUTINE UNDELETE -CC -C FUNCTION: Undeletes deleted message.L -C - IMPLICIT INTEGER (A - Z)F - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'o - - INCLUDE 'BULLFOLDER.INC'A - - EXTERNAL CLI$_ABSENT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')') - RETURN - END IF -Cm -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSEA - BULL_DELETE = BULL_POINT ! Delete the file we are readingN - END IF6 - - IF (BULL_DELETE.LE.0) GO TO 920 - -CU -C Check to see if specified bulletin is present, and if the userE -C is permitted to delete the bulletin.N -C. - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out.r - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?n - WRITE(6,1030) ! If not, then error outE - GOTO 100 - END IF - END IF - END IFI - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:) - END IF - END IF. - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration dateO - WRITE (6,'('' Message was undeleted.'')')U - ELSEI - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE. - WRITE (6,'('' Message was undeleted.'')')U - END IFE - ELSE - CALL DISCONNECT_REMOTE( - END IF - END IF6 - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010)H - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.')) -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.')( -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.')$ - - END - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z)T - - INCLUDE 'BULLNEWS.INC'S - - CHARACTER*20 MAIL_PROTOCOLI - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - IF (INDEX(INPUT,'<').GT.0.AND. ! Name may be of formN - & INDEX(INPUT,'@').GT.INDEX(INPUT,'<')) THEN - INPUT = INPUT(INDEX(INPUT,'<'):)! personal-name - END IFS - - IF (LMAIL.EQ.0) THENT - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN - MAIL_PROTOCOL = MAILER - END IF - LMAIL = TRIM(MAIL_PROTOCOL)o - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%'C - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1t - RETURN - END IF - END IF - - AT = INDEX(INPUT,'@') - IF (AT.GT.0) INPUT = INPUT(:INDEX(INPUT(AT:),' ')+AT-2) - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"'w - - IF (ILEN.NE.0) ILEN = ILEN + LMAIL + 2r - - RETURNn - END diff --git a/decus/vms94a/bulletin/bulletin3.for b/decus/vms94a/bulletin/bulletin3.for deleted file mode 100644 index f5d17b0..0000000 --- a/decus/vms94a/bulletin/bulletin3.for +++ /dev/null @@ -1,2287 +0,0 @@ -C -C BULLETIN3.FOR, Version 4/4/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_EDT' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THEN - CALL EDT$EDIT('NL:',OUT) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT) - ELSE - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IF - END IF - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT - ELSE - WRITE(6,'('' Could not activate editor.'')') - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE) - - RETURN - END - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IFo - END IFo - END IF - END IFt - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1))h - END DOg - CALL SYS$SETAST(%VAL(0))n - CALL DELETE_EXPIRED_NEWS(NOW) - CALL SYS$SETAST(%VAL(1))e - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IFe - CALL SYS$SETAST(%VAL(0))r - CALL REGISTER_BULLCP - IER1 = 1E - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY)_ - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IFT - END DOE - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1))E - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIESD - CALL SYS$SETAST(%VAL(1))S - - BBOARD_LOOP = BBOARD_LOOP + 1x - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND.e - & NEWS_LOOP.EQ.0) CALL CREATE_PROCESS('BULLCP NEWS')i - CALL SYS$SETAST(%VAL(1)) - - NEWS_LOOP = NEWS_LOOP + 1 - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIME' - CALL HIBER('15') ! Wait for 15 minutesr -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folderI -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))r - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IFe - CALL SYS$SETAST(%VAL(1)). - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEMN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'M - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8E - - DIMENSION NEW_SYSTEM_FLAG(FLONG)Q - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)N - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2)) - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THENE - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER)_ - CALL SELECT_FOLDER(.FALSE.,IER1)d - IF (IER1) THENE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IFE - CALL SETUSER(USERNAME)n - CALL OPEN_BULLFOLDER_SHAREDi - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DOe - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAG, - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2)T - CALL MODIFY_SYSTEM_LIST(0) - END IF - END DO - FOLDER_FLAG = FOLDER1_FLAG - FOLDER_NUMBER = 0 - - RETURN0 - END - - - - - SUBROUTINE REGISTER_BULLCP_ - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLUSER.INC'E - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)Y - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8I - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)0 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER))T - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG,A - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO2 - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - IF (IER.NE.0) THENE - DO I=1,FLONG - SYSTEM_FLAG(I) = 0a - SHUTDOWN_FLAG(I) = 0e - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0M - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,_ - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGE - CALL CLOSE_BULLUSER. - ELSES - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGs - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURNE - END IF - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAMEu - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DOv - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THENI - CALL CLOSE_BULLUSER - RETURNU - END IF - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"')_ - - IF (IER.NE.0) THENd - CALL ERRSNS(IDUMMY,IDUMMY,INODE)t - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR.) - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IFI - ELSE) - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IFA - CLOSE (UNIT=REMOTE_UNIT)E - END DO - END IFQ - - RETURNR - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z)G - - INCLUDE 'BULLUSER.INC'T - - INTEGER SHUTDOWN_BTIM(FLONG)w - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSERE - - DO WHILE (REC_LOCK(IER))T - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DOI - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER)O - - SEEN_FLAG = 0 - DO I=1,FLONGS - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO_ - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,T - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGM - END IF - - CALL CLOSE_BULLUSER - - RETURNE - END - - - - - - SUBROUTINE HIBER(MIN) -CU -C SUBROUTINE HIBER -CD -C FUNCTION: Waits for specified time period in minutes.L -C( - IMPLICIT INTEGER (A-Z)F - INTEGER TIMADR(2) ! Buffer containing timeE - ! in desired system format. - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN_ - END - - - - SUBROUTINE WAIT_SEC(PARAM)d -C -C SUBROUTINE WAIT_SECa -C -C FUNCTION: Waits for specified time period in seconds.t -C - IMPLICIT INTEGER (A-Z)L - INTEGER TIMADR(2) ! Buffer containing timee - ! in desired system format.E - CHARACTER PARAM*(*) - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF). - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer.h - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set.h - - RETURNr - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -Cn -C SUBROUTINE DELETE_EXPIRED_NEWS -Ca -C FUNCTION: -Cd -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'! - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXTd - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - INTEGER TODAY(2),DAY(2),NEXT_EX_BTIM(2) - - CHARACTER*8 TODAY_KEY - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1)I - - IF (IER.NE.0) THENR - CALL CLOSE_BULLNEWS - RETURN - END IFB - - CALL SYS_BINTIM('-',TODAY)G - ) - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END DO - CALL NEWS_TO_FOLDER( - - UNLOCK 7 - - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - GO TO 1000 - ELSE IF (REMOTE_SET.NE.4) THEN - REMOTE_SET = 4N - CALL OPEN_BULLDIR_SHAREDP - END IF - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0O - NDEL = -1R - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM)= - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. - IF (NDEL.GT.NEWS_F_END) THEN. - CALL READ_NEXT_EXPIRED(NDEL)I - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1 - CALL READ_NEXT_EXPIRED(NDEL)L - ELSE IF (EXDATE(8:9).EQ.'18'.OR. ! Deleted manually? - & INDEX(EXDATE,'1900').GT.0) THEN - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) ) - EXTIME = ASCTIME(13:23). - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0D - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) T - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0p - UNLOCK 2D - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER) - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_START, - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0Y - END DO. - F_START = IE - NEXT = .FALSE.W - END IF - CALL READDIR(F_NBULL,IER)D - IF (DN.OR.F_NBULL.EQ.IER) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I) - I = I - 1 - CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = Im - END DOL - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13)0 - CALL REWRITE_FOLDER_FILE(IER)E - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2)E - CALL READ_FIRST_EXPIRED(NDEL)' - END DO! - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO( - - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - -1000 IF (NOW) THEN A - CONTEXT = 0e - IER = LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT)I - IF (IER) IER = CONV$RECLAIM(BULLNEWSDIR_FILE) - CALL COPY2(EX_BTIM,TODAY)w - BULLFIL = 0 - DO I=1,31t - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFILE - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;')E - END DO I - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IFE - - RETURNT - END - - - - SUBROUTINE DELETE_EXPIRED -C' -C SUBROUTINE DELETE_EXPIRED -CE -C FUNCTION: -CA -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record sizeE -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed andg -C was replaced with a 128 byte record compressed format). -CE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'l - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'p - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)I - - CHARACTER UPTIME_DATE*12,UPTIME_TIME*12 - - CALL OPEN_BULLDIR_SHARED ! Open directory fileF - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFILl - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls?- - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')A - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND.e - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked?E - SHUTDOWN = 0' - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENR - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IFT - IER1 = 1F - END IF - IF (IER.LE.0.OR.IER1.LE.0) THENE - CALL CLOSE_BULLDIR2 - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN= - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IFO - END IFN - CALL CLOSE_BULLDIR - - RETURNI - END - - - - - SUBROUTINE BBOARD -CL -C SUBROUTINE BBOARD -CD -C FUNCTION: Converts mail to BBOARD into non-system bulletins.C -CE - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'A - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERST - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP3 - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76C - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64. - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/,HEADER_Q1/0/ - - CALL SYS$SETAST(%VAL(0))A - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF)L - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(HEADER_Q1,INPUT) - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1D - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file" - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from fileT - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)L - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymoref - CALL SYS$SETAST(%VAL(1))g - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1))M - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1D - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900_ - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1T -C -C The process is set to the BBOARD uic and username in order to createD -C a spawned process that is able to read the BBOARD mail (a real kludge). -CL - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD accountI - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uicB - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY)E - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)//$ - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errorsR - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)e - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)J - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST')w - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT'e - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV'F - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")'''i - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ'S - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL'H - WRITE(11,'(A)') 'READ/NEW' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL'i - WRITE(11,'(A)') 'SELECT/NEW'N - CLOSE(UNIT=11)O - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1))c - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))) - CALL SYS$SETAST(%VAL(0))M - END IF - ELSEs - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARDs - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THENs - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))F - CALL SYS$SETAST(%VAL(0))C - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//) - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0))R - END IF - END IFO - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM)L - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1))C - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM)/ - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store usernameE - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject_ - ELSE IF (INPUT(:3).EQ.'To:') THENE - INTO = INPUT(5:) ! Store addressN - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DOt - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO)y - CALL STR$UPCASE(INTO,INTO)e - FLEN = TRIM(FOLDER_BBOARD)T - HEADER_Q = 0 - NHEAD = 0 - IF (.NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - HEADER_Q = HEADER_Q1 - IER = 0A - CALL STRIP_HEADER(' ',0,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP)C - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTE - IF (IER.EQ.0) THENE - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP)B - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - NHEAD = NHEAD + 1 - END IFP - END DO - - FOUND = .FALSE.U - J = 0' - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS)U - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THENW - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP) - END IF - IF (J.EQ.1.OR.F_BBOARD.NE.FOLDER1_BBOARD) THEN - FLEN = TRIM(F_BBOARD) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1P - END DOO - END IFL - END IF - END IFp - END DOm - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COMA - END IF - - IF (NHEAD.EQ.0) THENO - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - ELSE - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT)D - NHEAD = NHEAD - 1R - END IF5 - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0)A - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5< - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM)T - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the dateo - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1S - END DO) - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER)W - - ISTART = 0 - NBLANK = 0D - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IFE - ELSE - ISTART = 1_ - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ')Q - END DOR - NBLANK = 0_ - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - ELSE - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0)N - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTT - END DOB - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSEC - NBLANK = NBLANK + 1 - END IFE - END IF - END DO) - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1))f - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input fileS - CALL SYS$SETAST(%VAL(1))I - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THENO - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER)E - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM)I - REWRITE (4) USER_HEADER ! Rewrite headerE - CALL CLOSE_BULLUSERO - END IF - CALL SYS$SETAST(%VAL(1))) - - CALL SYS$SETAST(%VAL(0))L - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & .NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) CALL NEWS2BULL - CALL SYS$SETAST(%VAL(1))U - - RETURN) - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE.T - - LEN_BBOARD = LEN(BBOARD) - 1I - - DO I=1,TRIM(INPUT)-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND.r - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND.w - & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR.h - & (INDEX(' .@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0N - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE.U - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND. - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO_ - - DETECT_BBOARD = .FALSE. - - RETURNT - END - - - - LOGICAL FUNCTION ALPHA(IN) - - CHARACTER*(*) INA - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURNL - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP)O - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIPU - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURNR - - BBOARD_NAME = FOLDER_DESCRIP(I+1:)S - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!')L - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:)D - I = INDEX(BBOARD_NAME,'!') - END DOS - - I = INDEX(BBOARD_NAME,'>')I - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%')Q - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURNE - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND)E - - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE')F - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)F - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')2 - IF (IER.NE.0) RETURNS - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT'' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()'''O - WRITE(11,'(A)') '$EXIT:'O - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11)R - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionO - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0)W - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',,( - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - IF (.NOT.IER.AND..NOT.DEL) THENT - CALL DELPRC('BULLCP NEWS',DEL)R - IER = .NOT.DELM - ELSE - IER = .TRUE.X - END IF - END DO - - RETURN. - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI)I -C -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listD - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistT - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2))) - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF - END IF2 - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) S - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2))O - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2))W - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2))O - - RETURN - END - R - - - - SUBROUTINE GETUIC(GRP,MEM)G -C -C SUBROUTINE GETUIC(UIC) -CT -C FUNCTION: -C To get UIC of process submitting the job.R -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UICD -CM - - IMPLICIT INTEGER (A-Z)N - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listL - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistT - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)) -CE -C SUBROUTINE GET_UPTIME -CE -C FUNCTION: Gets time of last reboot. -Ct - - IMPLICIT INTEGER (A-Z)T - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2)M - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLSTH - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST)U - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURNL - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z)t - - INCLUDE 'BULLFOLDER.INC'e - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS( - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointerd - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERSI - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)N - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR.A - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND.a - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DOo - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF8 - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THENE - NEW_MAIL(I) = .TRUE.1 - ELSEE - NEW_MAIL(I) = .FALSE. - END IFO - ELSE - NEW_MAIL(I) = .TRUE.R - END IF - END DO= - - CLOSE (10)K - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -CE -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN)T -CY -C FUNCTION: -C To get image name of process.D -C OUTPUT: -C IMAGNAME - Image name of process0 -C ILEN - Length of imagenameO -CI - - IMPLICIT INTEGER (A-Z)R - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAMED - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listE - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN))G - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistT - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURNM - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2). - - IF (REMOTE_SET) THEN_ - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START)N - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START)D - IF (START.EQ.0) THEN - START = -1W - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z)H - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2)E - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY)d - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 11 - CALL READDIR(START,IER) - END DOA - - CALL CLOSE_BULLDIR) - - RETURN_ - END - - - - - - SUBROUTINE READ_NOTIFYE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)). - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE, - END DOT - - IF (IER.NE.0) THENE - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF= - - CALL CLOSE_BULLDIRD - - RETURNI - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAM - - DATA OBIO/0/,OCPU/0/,ODIO/0/. - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAMI - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listN - - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU))B - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IF - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1( - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM)D - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.H - END DO - END IFE - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND.M - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIOE - ODIO = DIO - OCPU = CPU_ - IER = 0 - RETURND - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IF - RETURNL - END diff --git a/decus/vms94a/bulletin/bulletin4.for b/decus/vms94a/bulletin/bulletin4.for deleted file mode 100644 index 70083c9..0000000 --- a/decus/vms94a/bulletin/bulletin4.for +++ /dev/null @@ -1,2197 +0,0 @@ -C -C BULLETIN4.FOR, Version 10/20/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(BUFFER,0,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' ') THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - ELSE - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/, COMP /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new dates - - RETURNf - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT)A -CM -C SUBROUTINE GET_LINE -CL -C FUNCTION: -C Gets line of input from terminal.M -Ca -C OUTPUTS:i -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST.O -CN - - IMPLICIT INTEGER (A-Z)T - - LOGICAL*1 DESCRIP(8),DTYPE,CLASSr - INTEGER*2 LENGTHt - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITa - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGL - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE.$ - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT)d - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -CI -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE andE -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1A -C. - - CALL DECLARE_CTRLC_ASTT - - LEN_INPUT = 0 ! Nothing inputted yet - -C_ -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line.% -C( - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTN - IF (IER.NE.0) LEN_INPUT = -2 L - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with promptb - ELSEd - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no prompt - END IFI - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER)D - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT)l - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input?e - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of lineD - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DOt - CALL CONVERT_TABS(INPUT,LEN_INPUT)+ - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say soR - END IF - ELSEn - LEN_INPUT = -1 ! If CTRL-C, say so - END IFe - RETURNn - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z)U - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT)L - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THENS - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DOT - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMITD - INPUT(I:I) = ' ' - END DOD - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z)I - - CHARACTER*(*) INCHARE - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURNN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logicalT - CHARACTER*(*) OUTPUT ! byte to character valueL - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT)L - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routineD - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...')A - CALL SYS$CANEXH()O - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXITt - END IFo - FLAG = 1 ! to set flag - RETURNA - END - - - - SUBROUTINE DECLARE_CTRLC_ASTT -C1 -C SUBROUTINE DECLARE_CTRLC_AST2 -C -C FUNCTION: -C Declares a CTRLC ast.Y -C NOTES:S -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/.h -Cr - IMPLICIT INTEGER (A-Z)T - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINEL - COMMON /TERM_CHAN/ TERM_CHANI - - COMMON /CTRLC_FLAG/ FLAGE - - FLAG = 0 ! Init CTRL-C flagS - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOe - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN. - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOL - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURNI - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -CI -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z)R - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHANI - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGH - - COMMON /READIT/ READIT1 - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2)R - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./P - - DO I=1,LEN(DATA)E - DATA(I:I) = ' '9 - END DO_ - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),U - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.. - ELSET - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURNO - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT)a - - DO I=1,LEN(DATA) - DATA(I:I) = ' 'A - END DOI - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),R - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE., - ELSEe - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),R - & TRM$M_TM_NOECHO) - END IFD - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN)N - - DO I=1,LEN(DATA)N - DATA(I:I) = ' 'R - END DOM - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),D - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE.' - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,,S - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM)U - END IFa - - RETURNi - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal, - - CALL DECLARE_CTRLC_ASTT - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID)K - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)& - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPADU - ELSE IF (READIT.EQ.0) THEN: - CALL SET_NOKEYPADD - END IFS - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9')T - MASK(2) = IBCLR(MASK(2),I-32)= - END DO& - - RETURN8 - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH)( -C) -C SUBROUTINE GETPAGSIZN -C( -C FUNCTION: -C Gets page size of the terminal.I -CA -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z)) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH))T - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132)A - - RETURN' - END - - - - - - LOGICAL FUNCTION SLOW_TERMINALI -CE -C FUNCTION SLOW_TERMINALD -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less).. -C) -C OUTPUTS:G -C SLOW_TERMINAL = .true. if slow, .false. if not. -CH - - IMPLICIT INTEGER (A-Z)U - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHANA - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)') - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,)L - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THENE - SLOW_TERMINAL = .TRUE. - ELSEN - SLOW_TERMINAL = .FALSE.C - END IF - - RETURNT - END - - - - - SUBROUTINE SHOW_PRIVo -Cd -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board.n -Ce - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'u - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)'n - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT fileC - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV0 - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')')D - DO I=0,38. - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSER - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF) - - CALL CLOSE_BULLUSER ! All finished with BULLUSER/ - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)))P - END IF' - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C+ -C SUBROUTINE SET_PRIV -C. -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'( - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVSE - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA',R - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/O - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2)R - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THENL - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IFA - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THENT - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs* - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSEE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IFP - - OFFPRIV(1) = 0T - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privilegesU - PRIV_FOUND = -1 - I = 0/ - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1)U - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = IN - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURNO - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN/ - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN1 - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')')L - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSER - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)T - END IFP - ELSE - IF (PRIV_FOUND.LT.32) THENR - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32)F - END IFE - END IF - END DOO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1))U - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2))E - REWRITE (4) USER_HEADERR - WRITE (6,'('' Privileges successfully modified.'')') - ELSEL - WRITE (6,'('' ERROR: Cannot modify privileges.'')')U - END IFR - - CALL CLOSE_BULLUSER ! All finished with BULLUSERn - - RETURNi - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -CL -C SUBROUTINE ADD_ACLF -CE -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.L -C IER - Return error from attempting to set ACL. -CG -C NOTE: The ID must be in the RIGHTS data base. -C_ - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLFOLDER.INC'. - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256E - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)'o - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,)F - IF (.NOT.IER) THENH - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THENS - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')')s - CALL SYS_GETMSG(IER)S - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IFF - END IF - END IFI - IF (.NOT.IER) RETURNF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IFF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP)) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE( - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,). - END IF - - RETURNE - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C= -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.D -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -Cf - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFOLDER.INC'k - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT))r - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistc - ELSEh - CALL INIT_ITMLST ! Initialize item liste - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT))m - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistI - END IFU - - IF (INDEX(ACCESS,'C').GT.0) THENI - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(E - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IFA - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE! - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IFT - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDERM -C4 -C SUBROUTINE CREATE_FOLDERC -C' -C FUNCTION: Creates a new bulletin folder.a -Cr - - IMPLICIT INTEGER (A-Z)1 - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'M - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER! - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THENN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IFT - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')')c - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')')) - RETURN - END IFe - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified?n - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name: - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B)O - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '',L - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAXr - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)- - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND.H - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURNf - END IF - END IF - - LENDES = 0E - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES)m - ELSE - WRITE (6,'('' Enter one line description of folder.'')')E - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THENS - WRITE (6,'('' Aborting folder creation.'')')) - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characterso - WRITE(6,'('' ERROR: folder must be < 80 characters.'')')S - LENDES = 0o - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder fileI - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0)e - ! See if folder existso - - IF (IER.EQ.0) THENS - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IFe - - IF (CLI$PRESENT('OWNER')) THEND - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THENO - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURNe - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THENR - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURNZ - END IFU - ELSER - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IFE - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE. - FOLDER_OWNER = USERNAME ! Get present usernameF - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)D - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY.E -C The file prefix is the name of the folder.R -CA - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')')P - GO TO 910U - ELSE) - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER_ - END IFA - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,N - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')D - - IF (IER.NE.0) THEN( - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER)L - CALL SYS_GETMSG(IER) - GO TO 910_ - END IF. - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,_ - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')')3 - CALL ERRSNS(IDUMMY,IER)' - CALL SYS_GETMSG(IER) - GO TO 910C - END IFI - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THENF - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACL. - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)E - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))l - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1)R - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))' - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1)A - IF (.NOT.IER) THEN - WRITE(6,X - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER)E - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IFT - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1)0 - LAST_NUMBER = LAST_NUMBER + 1 - END DOM - - IF (IER.EQ.0) THENp - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')')( - & FOLDER_MAXA - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910) - ELSEm - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IFM - - IF (.NOT.CLI$PRESENT('NODE')) THENr - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0u - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name?n - REMOTE_SET = .FALSE.E - CALL OPEN_BULLDIR ! If so, store name in directory filei - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIRb - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*'n - FOLDER1 = FOLDERL - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0)t - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_OWNER = FOLDER1_OWNERY - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11)- - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0)N - - CLOSE (UNIT=1)O - CLOSE (UNIT=2) - - NOTIFY = 0i - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THENE - BRIEF = 1E - READNEW = 1S - END IFP - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)')C - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000C - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE.P - CLOSE (UNIT=1,STATUS='DELETE')P - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionI - - RETURNN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT)' -C -C Description: -C Parse given identify into binary ACL format.o -C Call SYS$CHKPRO to check if present process has readR -C access to an object if the object's protection is the ACL. -CN - IMPLICIT INTEGER (A-Z)n - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format, - IF (.NOT.CHKPRO) RETURN ! Exit if can'tE - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item listR - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has theI - ! rights-id assigned to it - RETURNF - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -CR -C SUBROUTINE CREATE_NEWS_FOLDER -CN -C FUNCTION: Creates a new newsgroup.L -CN - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLFOLDER.INC'M - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTa - DATA EDIT_DEFAULT/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME)I - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED')T - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesm - END IF -C -C If file specified in command, read file.E -C Else, read from the terminal.I -CT - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')P - LEN_P = 1 - ELSE - CLOSE (UNIT=3)F - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')( - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',) - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED'). - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTHI - ELSE IF (ILEN.GE.0) THEN ! If good input line entered- - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch fileg -2010 FORMAT(A)S - ICOUNT = ICOUNT + ILENT - END IFT - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outM - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER, - & 'Adding newsgroup.')M - CLOSE (UNIT=3)F - - RETURNA - -920 WRITE(6,1020)C -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURNO - -910 WRITE(6,1010)A -1010 FORMAT (' No news group was added.')R - CLOSE (UNIT=3) - RETURNt - - END - - - - - SUBROUTINE INIT_COMPRESSS - - IMPLICIT INTEGER (A-Z)L - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127)L - CHARACTER*2 B - - CHARACTER*(*) IN,OUTL - CHARACTER*255 T - - DO I=0,127H - DO J=0,127 - A(J,I) = ' ' - END DO - END DOA - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DO - T - J = 1 - DO I=1,8I - J = J + 1L - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DOS - DO I=10,31G - J = J + 1T - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)' - END DO - DO I=127,254A - J = J + 1R - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)1 - END DOM - - RETURN. - - ENTRY COMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.127) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.127) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:)))_ - IF (T(O:O).NE.' ') THENd - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND., - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1))H - C = C + 1 - K = K + 1 - END DOE - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1)R - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0), - O = O + 1 - ELSE - T(O:O) = IN(K:K)T - K = K + 1 - O = O + 1 - END IF - END DO - IF (K.EQ.L) THENF - T(O:O) = IN(K:K) - ELSE - O = O - 1 - END IFT - - OUT = T - - RETURN- - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1a - T(O:O) = IN(I+2:I+2) - END DOP - I = I + 3 - ELSE_ - B = UNMAP(J)F - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1d - T(O:O) = IN(I:I)I - ELSE( - O = O + 2 - T(O-1:O) = B - END IF - I = I + 1 - END IF - END DOR - - OUT = T(:O) - - RETURNG - END diff --git a/decus/vms94a/bulletin/bulletin5.for b/decus/vms94a/bulletin/bulletin5.for deleted file mode 100644 index 61ad6cb..0000000 --- a/decus/vms94a/bulletin/bulletin5.for +++ /dev/null @@ -1,2355 +0,0 @@ -C -C BULLETIN5.FOR, Version 12/18/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3.OR.FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & FOLDER1_NUMBER.EQ.0) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG - IF (BTEST(FOLDER1_FLAG,2)) THEN - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAG - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & F1_START.GT.0) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_NBULL = F1_NBULL - F_START = F1_START - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - FOLDER_NAME = FOLDER - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - REMOTE_SET_NEW = 1 - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11)) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s news group.'')') - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP(P - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSEr - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN - WRITE (6,'('' Folder only accessible for reading.'')') - END IFE - READ_ONLY = .TRUE.N - ELSED - READ_ONLY = .FALSE. - END IFg - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THENI - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DATA - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.r - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0( - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENT - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IFR - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSEA - NBULL = 0F - END IFR - CALL CLOSE_BULLDIR( - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF. - - IF (OUTPUT) THENF - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1)_ - BULL_PARAMETER = 'MARKED'A - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2)_ - BULL_PARAMETER = 'SEEN'F - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THENN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED' - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT. - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN) - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN'T - ELSEF - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF( - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THENF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)L - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2)C - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THENE - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))M - ELSE - WRITE(6,'('' WARNING: No '',A,G - & '' messages found.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IFR - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN( - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IFB - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.LT.3) THENS - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)G - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find itW - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0H - DO WHILE (NEW_COUNT.GT.0)) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1E - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletinsD - ELSE - BULL_POINT = 0 - END IF - END IFF - END IF - END IF( - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE. - ELSE IF (OUTPUT) THENR - WRITE (6,'('' Cannot access specified folder.'')')S - CALL SYS_GETMSG(IER)U - END IF - ELSE ! Folder not foundR - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0R - END IFB - - RETURNC - - END - - - - - - SUBROUTINE UPDATE_FOLDER -CI -C SUBROUTINE UPDATE_FOLDER_ -CG -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'_ - - IF (FOLDER_NUMBER.LT.0) RETURN. - - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileo - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)T - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message?M - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IFA - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURNC - END - - - - SUBROUTINE SHOW_FOLDER -CC -C SUBROUTINE SHOW_FOLDERE -C* -C FUNCTION: Shows the information on any folder., -CE - - IMPLICIT INTEGER (A-Z)G - - INCLUDE 'BULLUSER.INC'U - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG). - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THENF - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF) - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IFB - - IF (INDEX(FOLDER1,'::').NE.0) THENA - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IF. - - IF (TEST_NEWS(FOLDER1)) THEN E - INCMD = 'SET NEWS 'B - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL 'a - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)E - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THENE - WRITE (6,'('' ERROR: Specified folder was not found.'')')H - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THENN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER,F - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER,L - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IFI - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1)T - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THENC - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remoteI - & BTEST(FOLDER1_FLAG,0)) THEN ! and private?R - WRITE (6,'('' Access is limited.'')')N - END IF( - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1c - WRITE_ACCESS = 1 - ELSEI - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',o - & USERNAME,READ_ACCESS,WRITE_ACCESS)/ - END IFa - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THENO - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN! - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSEl - CALL SET_FOLDER_FILE(1)0 - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIRI - CALL READDIR(0,IER)A - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0)U - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') I - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF: - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN)A - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THENi - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')* - IF (BTEST(GROUPB1,31)) THENE - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')')F - END IF - END IF( - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IFD - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIREA - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSEE - WRITE (6,'('' No default expiration set.'')') - END IFr - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IFC - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IFL - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')')f - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')')L - END IFL - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IFR - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF0 - IF (BTEST(FOLDER1_FLAG,10)) THEN_ - WRITE (6,'('' POST_ONLY has been set.'')')e - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THENE - WRITE (6,'('' COMPRESS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')') - END IFM - IF (F1_EXPIRE_LIMIT.GT.0) THENS - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IFE - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERMw - PERM = .FALSE.a - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THENe - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.- - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THENr - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')')o - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND.N - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE.S - WRITE (6,'('' Default is READNEW, which is permanent.'')')O - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSEL - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')')M - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF_ - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.M - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THENS - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')')T - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')')( - END IF' - END IF. - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEND - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE! - WRITE (6,'('' Default is NONOTIFY.'')') - END IF' - CALL CLOSE_BULLUSER - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/,n - & ' Description: ',A) -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/, - & ' Description: ',A)N - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT)% -C( -C SUBROUTINE DIRECTORY_FOLDERSA -C. -C FUNCTION: Display all FOLDER entries. -CQ - IMPLICIT INTEGER (A - Z). - - INCLUDE '($SSDEF)'_ - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING0 - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/ - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' 'E - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN0 - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IFF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. I - STORED = .FALSE. Y - CLASS = .FALSE.M - NEW = .FALSE.S - FOLDER_COUNT = 1 ! Init folder number counterE - NLINE = 1A - START = .FALSE.L - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE.S - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IFe - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')')L - CALL CLOSE_BULLFOLDER_ - CALL NEWS_LISTM - CALL OPEN_BULLNEWS_SHAREDE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER)D - END IF - COUNT = CLI$PRESENT('COUNT')( - IF (COUNT) TOTAL_COUNT = 0E - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE'). - NEW = CLI$PRESENT('NEWGROUPS') - CLASS = CLI$PRESENT('CLASS')O - IF (CLASS) THEN - CALL CLOSE_BULLFOLDERX - CALL OPEN_BULLNEWS_SHAREDH - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THENA - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - ELSEG - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THENL - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER)F - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER) - FOLDER_COUNT = -1 - RETURNM - ELSEN - START = .TRUE. - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN)S - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THENR - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0 - FOLDER_COUNT = -1D - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN= - SUBNUM = -2E - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)A - END IFO - -CF -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memoryD -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -CR - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DECLARE_CTRLC_ASTE - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE.B - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IFQ - END DO. - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2_ - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THENR - NEW_NEWS = FOLDER1_NUMBER) - ELSE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP)L - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND.E - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)),T - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1I - END IF - END IFL - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSEC - READ_ACCESS = 1 - END IFr - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSEE - FSTATUS1 = ' ' - END IF - IF (.NOT.NEWS_TEST) THENL - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100R - END IF - END IF_ - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN - IER1 = 1E - MORE = .TRUE. - END IF! - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DOL - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymoreW - - IF (FLAG.EQ.1) THEN, - WRITE (6,'('' Folder search aborted.'')') - FOLDER_COUNT = -1M - RETURN - END IFL - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1 - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IFL - -CC -C Folder entries are now in queue. Output queue entries to screen. -CN - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THENN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))')_ - ELSE IF (CLASS) THENC - WRITE (6,'(1X,''Class'',/,1X,(''-''))')R - ELSE IF (SUBSCRIBE) THENw - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))')_ - ELSER - WRITE (6,'(1X,''News group'',X,''Status'',7X,R - & ''First Last'',/,1X,(''-''))') - END IFR - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1' - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THENU - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF( - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE. - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL,B - & FOLDER1_OWNER - END IF - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42)G - J = INDEX(FOLDER1_DESCRIP,' ')E - IF (J.GT.0) THENS - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1)e - END IFI - ELSEM - FSTATUS1 = ' ' - END IFt - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNTO - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0F - END IFe - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1),W - & F1_START,F1_NBULL,NEWS_NEW-1E - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),& - & F1_START,F1_NBULL,NEWS_NEW-1N - END IF - ELSEE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IFS - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER - IF (NEWS_TEST.AND.FLAG.NE.1) THENs - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - FOUND = .FALSE. - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - CALL READ_FOLDER_FILE_TEMP(IER) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSEF - FSTATUS1 = ' 'S - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND.R - & .NOT.BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THENP - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2)L - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1)R - ELSE - FOUND1 = .TRUE. - END IF - END IFI - FOUND = FOUND1 - ELSE - FOUND = .TRUE. - END IFN - END IFT - END DO - MORE = MORE.AND.FOUND - IF (MORE) THENE - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND) FLAG = 1C - END IF - END DOC - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_ASTA - CALL CLOSE_BULLFOLDER - END IFe - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNTr - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSEl - WRITE(6,1100) ! Else say there are moreI - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF) - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10). -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/)M - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -CI -C FUNCTION: Set access on folder for specified ID.0 -C_ -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny accessT -C= - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'A - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENTK - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132L - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN) - ALL = .TRUE. - ELSE1 - ALL = .FALSE.E - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE.S - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE( - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDERd - NEWS = INDEX(FOLDER1,'.').GT.0E - - IF (NEWS) THENC - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.'l - END IF - CALL OPEN_BULLNEWS - ELSER - CALL OPEN_BULLFOLDER ! Open folder file - END IF' - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN. - WRITE (6,N - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THENE - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE - CALL SET_FOLDER_FILE(1)3 - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTIONU - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),r - & STATUS='NEW',IOSTAT=IER)O - CLOSE (UNIT=3) - CALL RESET_PROTECTIONO - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')')N - RETURN( - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')')E - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0)l - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENs - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THENP - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THENl - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER)N - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')')T - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THENe - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILEA - REMOTE_SET_SAVE = REMOTE_SET_ - REMOTE_SET = .FALSE.P - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE' - CALL SET_FOLDER_FILE(0) - END IF - END IF' - ELSE - CALL DEL_ACL('*','R',IER) - END IFI - IF (.NOT.IER) THENH - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER)R - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN)I - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THENI - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)W - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER)D - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)')T - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THENF - CLOSE (UNIT=3) - INPUT = ' 'I - ELSE. - FILE_OPEN = .TRUE. - END IFe - ELSE - FILE_OPEN = .FALSE. - END IFL - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1: - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2F - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1)P - INPUT = INPUT(COMMA+1:)T - ELSE - ID = INPUT - INPUT = ' 'L - END IF - ILEN = TRIM(ID)1 - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THENO - WRITE (6,'('' ERROR: Cannot modify access'',R - & '' for owner of folder.'')') - ELSEO - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSEI - CALL ADD_ACL(ID,'R+W',IER) - END IFS - ELSEI - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF, - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN)' - CALL SYS_GETMSG(IER)( - ELSE - WRITE(6,'('' Access modified for '',A,''.'')')F - & ID(:ILEN)' - END IF - END IFM - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT= - IF (IER.NE.0) THEN - CLOSE (UNIT=3)P - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IFo - END DOr - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THENo - IF (NEWS) THENf - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IFn - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER)T - CALL CLOSE_BULLFOLDER - END IF - END IFL - - RETURNT - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -CR -C SUBROUTINE CHKACL -C= -C FUNCTION: Checks ACL of given file. -CE -C PARAMETERS: -C FILENAME - Name of file to check.I -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z)U - - CHARACTER*(*) FILENAME. - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)'E - - CHARACTER*256 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THENW - IERACL = SS$_NORMAL.OR.IERACLS - END IF_ - - RETURNH - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -CE -C SUBROUTINE CHECK_ACCESS -CE -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check.E -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access.R -C2 - - IMPLICIT INTEGER (A-Z)Q - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME,E - & %VAL(ACL_ITMLST)) - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THENL - READ_ACCESS = 0R - END IF_ - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then ofD - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IFR - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))E - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME)) -CN -C SUBROUTINE SHOWACLH -C. -C FUNCTION: Shows users who are allowed to read private bulletin. -C) -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAMET - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH)D - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAMEA - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_OPEN/ NEWS_OPENe - - ENTRY WRITE_FOLDER_FILE(IER)u - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - - DO WHILE (REC_LOCK(IER))i - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURNX - - ENTRY WRITE_FOLDER_FILE_TEMP(IER)' - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS' - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSET - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IFS - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER)8 - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWSa - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER_COM9 - END IFu - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) D - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMH - ELSE. - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IFF - - RETURN_ - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER))F - IF (NEWS_OPEN) THENI - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COMT - END IF - END DO) - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNL - - ENTRY READ_FOLDER_FILE_TEMP(IER)) - - DO WHILE (REC_LOCK(IER))E - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COME - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DOL - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN1 - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENI - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COMD - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DOU - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBERR - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER))= - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN, - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)D - - DO WHILE (REC_LOCK(IER))I - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DOF - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1E - - RETURNE - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENR - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM& - END IF - END DOL - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER11 - - RETURN1 - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))S - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DOF - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1R - - RETURNT - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENI - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM. - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURNR - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))I - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM, - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1. - - RETURN& - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))1 - IF (NEWS_OPEN) THENM - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNT - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z)D - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)'T - - CHARACTER*(*) KEY_NAMEO - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAMEa - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAMEs - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DOB - - TEMP_USER = USERNAMEL - USERNAME = SAVE_USERNAME - - RETURNF - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAMEF - - DO WHILE (REC_LOCK(IER))R - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY) - END DO& - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME1 - - RETURNR - - ENTRY READ_USER_FILE_HEADER(IER)i - - DO WHILE (REC_LOCK(IER))a - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DO) - - RETURNF - - ENTRY WRITE_USER_FILE_NEW(IER)O - - DO I=1,FLONG. - SET_FLAG(I) = SET_FLAG_DEF(I)e - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)S - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I)n - END DO) - - ENTRY WRITE_USER_FILE(IER)E - - DO WHILE (REC_LOCK(IER))W - WRITE (4,IOSTAT=IER) USER_ENTRY) - END DOE - - RETURN - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - n - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - . - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO( - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)' - - NEW_NEWS_ACCESS = ) - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS'n - - RETURN - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - W - IMPLICIT INTEGER (A-Z)s - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - L - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_'F - END DOT - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)E - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C))& - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' ' - ELSE - FILE = FILE(:L) - END IF - END DOR - - RETURNP - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z)E - - CHARACTER*(*) INPUT,FINDM - - F = LEN(FIND)T - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURN - END DOM - - RETURN - END diff --git a/decus/vms94a/bulletin/bulletin6.for b/decus/vms94a/bulletin/bulletin6.for deleted file mode 100644 index 4a9b30d..0000000 --- a/decus/vms94a/bulletin/bulletin6.for +++ /dev/null @@ -1,2531 +0,0 @@ -C -C BULLETIN6.FOR, Version 4/5/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSLIST/ NEWSLIST - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & BUFFERCOUNT=127, - & ORGANIZATION='INDEXED',IOSTAT=IER) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - COMMON /NEWSLIST/ NEWSLIST - DATA NEWSLIST/0/ - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & BUFFERCOUNT=127, - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - END IF - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1))) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULL - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LAST - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMIT - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(81:84) = BUFFER(85:) - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRYn - ICOUNT = ICOUNT + 1 - END IF - END DOe - -800 CLOSE (UNIT=9,DISPOSE='KEEP')L - CLOSE (UNIT=2)p - -900 CALL RESET_PROTECTION - - RETURNs - - END - - - - SUBROUTINE CONVERT_BULLFILES1 -C -C SUBROUTINE CONVERT_BULLFILESd -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs).u -Ct - - IMPLICIT INTEGER (A-Z)& - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'B - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')')S - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',= - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',E - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))I - & //'.BULLFIL',STATUS='OLD',B - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,U - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8)s - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00'O - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK3 - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER= - WRITE(1,'(A)') BUFFER0 - END DO - CALL WRITEDIR(ICOUNT-1,IER1)A - ICOUNT = ICOUNT + 1 - END IF - END DOL - - CLOSE (UNIT=9)S - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL RESET_PROTECTION - RETURNF - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)M -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C& -C SUBROUTINE CONVERT_BULLFILE -CT -C FUNCTION: Converts bulletin data file to new format file. -C8 -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -CE - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILED - - WRITE (6,'('' Converting data files to new format. Please wait.'')')T - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200)H - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & ,STATUS='OLD',D - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER,L - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,T - & FORM='UNFORMATTED')= - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE)D - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THENS - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER)R - NBLOCK = NBLOCK + 1I - SBLOCK = NBLOCK_ - DO J=BLOCK,LENGTH+BLOCK-1E - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IFR - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR1 - GOTO 100N - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURNI - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -CE -C SUBROUTINE CONVERT_BULLFOLDER -CT -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC', - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'A - - INCLUDE '($FORIOSDEF)'F - - CHARACTER*(*) FILENAME& - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']'))K - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1B - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN1 - F_NUMBER = 0 - DO WHILE (IER.EQ.0)( - IF (ASK_SIZE.EQ.184) THENI - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)O - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPD - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)',1 - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)N - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP) - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM1 - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM)= - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN S - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST) - ELSEI - F_LAST = 0 - END IFI - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER)I - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBI - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LAST= - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSEn - F_NUMBER = 0 - DO WHILE (IER.EQ.0)N - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)S - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPE - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER))M - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0)1 - END IF& - DO WHILE (FILE_LOCK(IER,IER1))B - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))_ - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',( - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0E - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE_ - NEWEST_TIME = TIMEF - CALL WRITEDIR(0,IER)O - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF' - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE)O - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATEY - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBE - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,06 - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)S - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE)E - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -C -C SUBROUTINE CONVERT_BULLNEWS -CI -C FUNCTION: Converts bulletin NEWS file to new format.F -C, - IMPLICIT INTEGER (A-Z)& - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'D - - INCLUDE '($FORIOSDEF)'1 - - CHARACTER*(*) FILENAMEE - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. ''I - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME))F - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1i - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1))E - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED', - & ORGANIZATION='INDEXED',IOSTAT=IER,_ - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',c - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600,N - & ORGANIZATION='INDEXED',IOSTAT=IER,A - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE')R - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0N - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE)X - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE) - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0R - NEWS_F_END = 0E - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108)E - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:)E - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT): - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL). - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1 - IF (LMOVE.LE.0) THENT - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP. - ELSES - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE))6 - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):)N - END IF - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)O - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE)E - - CALL RESET_PROTECTION - - RETURN+ - END - - - - SUBROUTINE CONVERT_USERFILE -CD -C SUBROUTINE CONVERT_USERFILE -CI -C FUNCTION: Converts user file to new format which has 8 bytes added. -CT - - IMPLICIT INTEGER (A-Z)( - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'S - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME& - - WRITE (6,'('' Converting data files to new format. Please wait.'')'): - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))E - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD') - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',H - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,' - & KEY=(1:12:CHARACTER))A - INQUIRE (UNIT=9,RECORDSIZE=RECL)X - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE)= - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)2 - ELSE - CALL ENABLE_CTRLN - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFD - - IF (IER.EQ.0) THEN - CALL SET_PROTECTIONH - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IFU - - IF (IER.NE.0) THEN0 - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)I - CALL SYS_GETMSG(IER1)f - CALL RESET_PROTECTIONE - CALL ENABLE_CTRL_EXITS - END IF - - DO I=1,FLONGR - NEW_FLAG(I) = 'FFFFFFFF'XE - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DOL - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR.E - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0T - DO WHILE (IER.EQ.0)O - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THENE - TEMP_USER = BUFFER(:12)M - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31)E - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))D - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1))A - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,N - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFL - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM,R - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flagO - DO WHILE (IER.EQ.0)= - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFL - END DO - END IFO - - IER = 0 - - CLOSE (UNIT=9)E - CLOSE (UNIT=4) - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIRI -C' -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -CE -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -CC - - IMPLICIT INTEGER (A - Z)( - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC', - - COMMON /PROMPT/ COMMAND_PROMPTS - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXTG - - COMMON /KEEPLOCK/ KEEPLOCK - DATA KEEPLOCK/.FALSE./N - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BULLFIL/ BULLFILX - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMR - - CHARACTER*4 CFOLDER_NUMBERO - - CHARACTER*8 NEWS_KEYR - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER))L - IF (REMOTE_SET.EQ.4) THENI - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DOT - IF (IER.EQ.0) THENQ - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSE) - DIR_NUM = 0 - END IFA - END IFS - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURND - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIRE - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF, - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0= -C, -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also checkR -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP')e - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IFE - END IF - ELSEU - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEYGE=NEWS_KEY(ICOUNT,FOLDER_NUMBER) - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRYA - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THENP - READ(2,IOSTAT=IER) NEWSDIR_ENTRY+ - ELSEU - READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER) - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START)N - ICOUNT = ICOUNT - 1 - READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER)I - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF_ - END IF - IF (IER.EQ.0) THEN - NUM = GET_INTEGER(%REF(NEWS_MSG_KEY)) - IF (NUM.NE.FOLDER_NUMBER) THEN - IER = 36F - UNLOCK 2W - ELSEL - MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:))) - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND.O - & MSG_NUM.GT.F_START) THEN5 - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAMET - & (FOLDER,IER2) - F_START = MSG_NUM1 - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IF_ - END IFL - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THEN - ICOUNT = MSG_NUMF - BULLETIN_NUM = ICOUNT - END IF/ - END IF - ELSEF - IF (DIR_NUM.EQ.ICOUNT-1) THENC - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97)= - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) O - & BULLDIR_ENTRY - END IFE - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 1 - END IF - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97)F - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) E - & BULLDIR_ENTRY - END IFE - END IF - END IFW - END DOF - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBINE - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSER - DIR_NUM = -1P - END IFA - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IF' - - IF (IER.EQ.0) THEN1 - IF (.NOT.REMOTE_SET) THEN - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1 - END IFR - END IFE - END IF - - RETURNS - - END - - - - CHARACTER*8 FUNCTION NEWS_KEY(ICOUNT,FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z)R - - CHARACTER*4 INTEGER_KEY - - NEWS_KEY = INTEGER_KEY(FOLDER_NUMBER)//INTEGER_KEY(ICOUNT)M - - RETURNE - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM)G - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z)E - - INTEGER TEMPR - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM9 - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I)' - END DO, - - RETURN' - END - - - SUBROUTINE READDIR_KEYGE(IER) -C= -C SUBROUTINE READDIR_KEYGE_ -CG -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified.' -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS:) -C IER - If 0, no entry found. Else contains message number. -C) - - IMPLICIT INTEGER (A - Z)A - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC') - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/2/N - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFILB - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMG - - CHARACTER*4 INTEGER_KEY - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.4.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRYM - ELSEE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THENC - NUM = GET_INTEGER(%REF(NEWS_MSG_KEY))U - IF (NUM.NE.FOLDER_NUMBER) THEN - IER = 36T - UNLOCK 2 - ELSE - MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:))) - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.4.AND.MSG_NUM.NE.0) THEN n - IF (MSG_NUM.GT.NEWS_F_END) THENo - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36r - UNLOCK 2 - END IF - END IF - END IF - END IF - ELSEU - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '//_ - & BULLDIR_ENTRY(66:97), - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF= - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFILP - ELSE - IER = 0 - DIR_NUM = -1R - END IF - ELSES - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THENU - IF (BTEST(BULL_USER_CUSTOM,3)) THEN) - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10 - END IF - END IF - - RETURN= - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IFO - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN( - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z): - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY(5:)),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY(5:)),%DESCR(EX_BTIM)) - IF (POSTTIME) CALL COPY2(MSG_BTIM,NEWS_POST_BTIM)A - DESCRIP = NEWS_DESCRIP, - FROM = NEWS_FROM B - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IFe - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11)t - EXTIME = DATETIME(13:23)1 - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,)E - - DATE = DATETIME(:11)Z - TIME = DATETIME(13:23)N - - RETURNU - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -CT -C SUBROUTINE WRITEDIR -CW -C FUNCTION: Writes the entry for the specified bulletin in the' -C directory file.U -CI -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.( -C If 0, write the header of the directory file. -C OUTPUTS:W -C IER - Error status from WRITE. -CB - - IMPLICIT INTEGER (A - Z)O - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'O - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*8 NEWS_KEY' - - CONV = .TRUE. - - GO TO 10L - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE.D - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADERr - ELSE - IER = -1, - IF (DIR_NUM.EQ.0) THENI - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSEE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF' - END IF - IF (IER.NE.0) THENE - IF (REMOTE_SET.EQ.4) THEN - IER = 0I - ELSE_ - READ (2,KEYID=0,KEY=0,IOSTAT=IER)D - IF (IER.EQ.0) THEN ) - REWRITE (2,IOSTAT=IER) BULLDIR_HEADERI - END IF - END IFC - END IFO - IF (IER.NE.0) THENK - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IFE - END IF1 - END IF - ELSE_ - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRYR - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRYO - END IFM - END IFO - IF (IER.NE.0) THENT - IF (REMOTE_SET.EQ.4) THEN - DO WHILE (REC_LOCK(IER).AND. - & BULLETIN_NUM.NE.NEWS_F_END+1) - READ (2,KEYID=1,KEY=NEWS_KEY(C - & BULLETIN_NUM,FOLDER_NUMBER),IOSTAT=IER)E - END DO - ELSEA - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IF, - IF (REMOTE_SET.EQ.4.AND.w - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN( - CALL SPECIAL_NEWSDIR_ENTRY(IER)M - ELSE IF (IER.EQ.0) THENM - IF (REMOTE_SET.EQ.4) THENE - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEND - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IFD - END IFN - END IF - END IFX - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXITS - - DIR_NUM = -1I - - RETURNE - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER)E - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - DIMENSION BTIM(2) - - CHARACTER*8 NEWS_KEY6 - - READ (2,KEYID=3,KEY=NEWS_MSGID,IOSTAT=IER) INPUT(:84)R - DO WHILE (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).NE.FOLDER_NUMBER) - READ (2,IOSTAT=IER) INPUT(:84) - IF (NEWS_MSGID.NE.INPUT(21:84)) IER = 2 - END DO - - IF (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).EQ.FOLDER_NUMBER) THEN , - IER = 2 - RETURN - END IFN - -10 IER1 = 0N - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=1,KEYGT=NEWS_KEY(NEWS_F_END,FOLDER_NUMBER), - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO O - DO WHILE (IER1.EQ.0), - FNUM = GET_INTEGER(%REF(INPUT)). - IF (FNUM.NE.FOLDER_NUMBER) THEN5 - IER1 = 2A - ELSE - CALL GET_MSGKEY(%REF(INPUT(85:)),%DESCR(BTIM))& - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IFR - F_COUNT = F_COUNT + 1 - NEWS_F_END = GET_INTEGER(%REF(INPUT(5:))) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO A - END IF - END DON - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IF) - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY A - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10B - ELSEE - F_COUNT = F_COUNT + 1L - END IF - - RETURNR - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' , - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*8 NEWS_KEY - - CHARACTER*4 INTEGER_KEY - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM)4 - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM)F - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE)) - END IFF - - RETURN= - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*4 INTEGER_KEY - - CHARACTER*8 NEWS_KEY - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THENT - CALL COPY2(NEWS_POST_BTIM,MSG_BTIM)U - END IF - , - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - IF (LOCAL_POST) THENI - CALL COPY2(NEWS_POST_BTIM,MSG_BTIM)I - END IFN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIPE - NEWS_FROM = FROMI - NEWS_BLOCK = BLOCKE - NEWS_LENGTH = LENGTH( - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)L - NEWS_MSG_KEY = NEWS_KEY(MSG_NUM,FOLDER_NUMBER) - NEWS_MSG_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY_ - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - NEWS_EX_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY - ELSEH - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IFD - - RETURNE - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - I - COMMON /KEYID/ NEWS_KEYIDE - - COMMON /KEEPLOCK/ KEEPLOCKI - ) - CHARACTER*4 INTEGER_KEY - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 4E - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY)1 - CALL READDIR_KEYGE(NDEL)) - KEEPLOCK = .FALSE.D - NEWS_KEYID = 2R - - RETURNT - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C, -C SUBROUTINE READACLE -CR -C FUNCTION: Reads the ACL of a file. -CB -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information.E -CN - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*)I - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENTZ - CTXT = 0 - END IF. - - DO ACC_TYPE=1,2 - POINT = 1E - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)I - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+0 - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))),7 - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE., - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR.T - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1I - END_ID = INDEX(ACLSTR,',ACCESS') - 1D - IF (ACLSTR(END_ID:END_ID).EQ.']') THENA - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII))' - IF (ACLSTR(START_ID:START_ID).NE.','.AND.S - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IFE - END DO_ - IF (ASCII) THEN - START_ID = START_ID + 1T - END_ID = END_ID - 1I - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1L - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF3 - END IFL - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THENM - IF (ACC_TYPE.EQ.1) THENT - WRITE (6,'(A - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(_ - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF( - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN: - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)S - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2) - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)R - OUTLEN = 1 - ELSE_ - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO' - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILEL - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLUSER.INC'A - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THENS - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')M - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)E - ELSE - CALL ENABLE_CTRLT - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFT - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW',t - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))E - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)C - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DOL - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9)T - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z)G - , - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)E - CALL ENABLE_CTRL_EXIT - - RETURN2 - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -CT -C SUBROUTINE COPY_ACL -Ce -C FUNCTION: -C Copy ACLs from one file to another fileI -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILEE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl outputR - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,)= - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURNI - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C3 -C SUBROUTINE COPY_ACL1F -C( -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines) -C since must convert location of string into a character string. -C% - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,). - ! Read input file acl= - - IF (.NOT.IER) THENR - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT1 - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,L - & %LOC(ACLENT))F - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist) - IER = SYS$CHANGE_ACLO - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,)+ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied firstE - END DO - RETURN - END IFI - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output filet - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT,t - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DOt - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z)( - - INCLUDE 'BULLFILES.INC'U - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./S - - IF (CHECKED) RETURN - - CHECKED = .TRUE.T - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C)D - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORYT - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE) - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE - CALL ADD_DIRECTORY(BULLNEWS_FILE)E - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - END IFE - - CALL CHECK_DIR(FOLDER_DIRECTORY)E - CALL CHECK_DIR(NEWS_DIRECTORY) - - CALL ADD_DIRECTORIES - - RETURN - ENDT - A - - - SUBROUTINE ADD_DIRECTORIES - - INCLUDE 'BULLFILES.INC'. - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE)s - - RETURN. - END - - - - SUBROUTINE CHECK_DIR(DIRECTORY) - - IMPLICIT INTEGER (A-Z)) - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - IF (.NOT.SYS_TRNLNM_SYSTEM(DIRECTORY,TEST)) RETURN) - - CALL SYS_TRNLNM(DIRECTORY,TEST1)c - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER)h - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST)o - END DOs - - IF (TEST.NE.TEST1) THEN - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER)' - CLOSE(UNIT=3,STATUS='DELETE') - CALL ENABLE_PRIVS/ - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)')F - & TEST1(:TRIM(TEST1)) - CALL EXIT - END IF - DIRECTORY = TEST1 - ELSE( - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - END IF_ - - RETURN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z)) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:). - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:). - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY N - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':' - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURN& - END= diff --git a/decus/vms94a/bulletin/bulletin7.for b/decus/vms94a/bulletin/bulletin7.for deleted file mode 100644 index bcc0c9d..0000000 --- a/decus/vms94a/bulletin/bulletin7.for +++ /dev/null @@ -1,2288 +0,0 @@ -C -C BULLETIN7.FOR, Version 3/28/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER1_NAME.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - DATE = TODAY_TIME(:11) - TIME = TODAY_TIME(13:23) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIR - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX)) - CALL ADD_2_ITMLST_WITH_RETW - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))E - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlistM - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1M - - RETURN0 - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT)0 - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))T - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlistE - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IFY - - RETURN. - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1)N - - IMPLICIT INTEGER (A-Z)T - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./H - - IF (INIT) THENO - FILE_LOCK = 1A - INIT = .FALSE. - ELSER - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)L - IF (IER1.EQ.RMS$_FLK) THEN) - FILE_LOCK = 1E - CALL WAIT_SEC('01') - ELSE_ - FILE_LOCK = 0L - INIT = .TRUE.L - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0O - INIT = .TRUE. - END IF - END IFI - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLFOLDER.INC'N - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODEL - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXITE - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1( - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THENL - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -CD - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,)B - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1)I - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0a - CALL SET_FOLDER_FILE(0)T - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXITu - END IF - QUIT = 0 ! Reinitialize - - RETURNu - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z)l - - COMMON /CTRLY/ CTRLYE - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/F - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN_ - END - - - - - SUBROUTINE CLEANUP_BULLFILE -CO -C SUBROUTINE CLEANUP_BULLFILE -CR -C FUNCTION: Searches for empty space in bulletin file and deletes it.N -CO - IMPLICIT INTEGER (A - Z)T - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER FILENAME*132,BUFFER*128 - - CALL OPEN_BULLDIR_SHARED, - -C1 -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADERO - END DO_ - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THENe - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSEB - CALL SYS_GETMSG(IER1)L - END IFU - CALL CLOSE_BULLDIRA - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURNA - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTHT - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFERT - END DOR - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100T - END IFO - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFILf - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',s - & '*.BULLFIL') - IER = 1p - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR',I - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETES - IER = 1P - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,E - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',A - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',- - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,o - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')o - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER)t - IF (IER1.EQ.0) THENa - WRITE (6,'('' IOSTAT error = '',I)') IERn - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11)s - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,)r - RETURN - END IFa - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR',r - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0o - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULLk - CALL READDIR(I,IER)h - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)- - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY- - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for''I - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER))L - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSEA - CALL SYS_GETMSG(IER1)N - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIRC - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN( - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0), - END DOL - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIRN - CALL OPEN_BULLDIR ! Open with no sharingA - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory headerC - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER)L - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//E - & '.BULLFIL;-1') - END DOD - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER)E - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//f - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*',r - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -Ct -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions.s -C Is called either directly after a deletion, or isD -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting processd -C was abnormally terminated. -CI - IMPLICIT INTEGER (A - Z)C - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*12 DATE_SAVE,EXDATE_SAVE_ - CHARACTER*12 TIME_SAVE,EXTIME_SAVEL - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATEe - TIME_SAVE = TIME - EXDATE_SAVE = EXDATEn - EXTIME_SAVE = EXTIMEs - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL)n - CALL READDIR(I,IER)o - IF (IER.NE.I+1) THEN ! Have we found a deleted entry?l - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in filee - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)l - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DOE - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER)C - RETURNE - END IF - LENGTH = -LENGTH ! Indicate starting point by writingD - CALL WRITEDIR(I,IER) ! next entry into deleted entry) - FIRST_DELETE = I ! with negative length. - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progressD - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1E - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IFD - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Ql - BLOCK_SAVE = BLOCKs - MSG_NUM_SAVE = MSG_NUME - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST)C - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THENN - MOVE_TO = MSG_NUM_SAVE + 1w - MOVE_FROM = MSG_NUM + 1 - END IF - END DOU - ! If no duplicate entry found for this - ! entry, see if one exists for anyD - END DO ! of the other entries - END IF - I = I + 1R - END DO6 - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessaryE - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULLD - CALL READDIR(J,IER)= - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1R - END IF - END DOl - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF' - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IFS - - CALL WRITEDIR(0,IER)_ - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVEM - DATE = DATE_SAVEw - TIME = TIME_SAVEa - EXDATE = EXDATE_SAVEB - EXTIME = EXTIME_SAVES - - RETURNB - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -CA -C FUNCTION: Show user flags.R -CE - IMPLICIT INTEGER (A - Z)U - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'S - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THENL - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF - -C& -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user fileI - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN, - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURNM - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THENT - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.S - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THENE - WRITE (6,'('' SHOWNEW is set.'')') - END IFS - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')')S - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THENR - WRITE (6,'('' No flags are set.'')') - END IFE - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER0 - - RETURNS - END - - - SUBROUTINE SET2(FLAG,NUMBER)N - - IMPLICIT INTEGER (A-Z)T - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1))& - - RETURNS - END - - - SUBROUTINE CLR2(FLAG,NUMBER)M - - IMPLICIT INTEGER (A-Z)) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))_ - - RETURNR - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL)L -C, -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in.D -CE - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF ***F - PARAMETER PSCAN$_BEGIN = '00000000'XT - PARAMETER PSCAN$_ACCOUNT = '00000001'XY - PARAMETER PSCAN$_AUTHPRI = '00000002'XD - PARAMETER PSCAN$_CURPRIV = '00000003'X - PARAMETER PSCAN$_GRP = '00000004'X - PARAMETER PSCAN$_HW_MODEL = '00000005'X - PARAMETER PSCAN$_HW_NAME = '00000006'X - PARAMETER PSCAN$_JOBPRCCNT = '00000007'XF - PARAMETER PSCAN$_JOBTYPE = '00000008'X_ - PARAMETER PSCAN$_MASTER_PID = '00000009'X - PARAMETER PSCAN$_MEM = '0000000A'X - PARAMETER PSCAN$_MODE = '0000000B'X - PARAMETER PSCAN$_NODE_CSID = '0000000C'X - PARAMETER PSCAN$_NODENAME = '0000000D'X O - PARAMETER PSCAN$_OWNER = '0000000E'Xd - PARAMETER PSCAN$_PRCCNT = '0000000F'X - PARAMETER PSCAN$_PRCNAM = '00000010'X - PARAMETER PSCAN$_PRI = '00000011'XR - PARAMETER PSCAN$_PRIB = '00000012'X - PARAMETER PSCAN$_STATE = '00000013'X - PARAMETER PSCAN$_STS = '00000014'XI - PARAMETER PSCAN$_TERMINAL = '00000015'X - PARAMETER PSCAN$_UIC = '00000016'X - PARAMETER PSCAN$_USERNAME = '00000017'X - PARAMETER PSCAN$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER PSCAN$_END = '00000019'XS - PARAMETER PSCAN$k_type = '00000081'X( - PARAMETER PSCAN$M_OR = '00000001'X& - PARAMETER PSCAN$M_BIT_ALL = '00000002'X - PARAMETER PSCAN$M_BIT_ANY = '00000004'X - PARAMETER PSCAN$M_GEQ = '00000008'X - PARAMETER PSCAN$M_GTR = '00000010'X - PARAMETER PSCAN$M_LEQ = '00000020'X - PARAMETER PSCAN$M_LSS = '00000040'X - PARAMETER PSCAN$M_PREFIX_MATCH = '00000080'X - PARAMETER PSCAN$M_WILDCARD = '00000100'X - PARAMETER PSCAN$M_CASE_BLIND = '00000200'X - PARAMETER PSCAN$M_EQL = '00000400'X - PARAMETER PSCAN$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER PSCAN$S_OR = 1 - PARAMETER PSCAN$V_OR = 0C - PARAMETER PSCAN$S_BIT_ALL = 1 - PARAMETER PSCAN$V_BIT_ALL = 1 - PARAMETER PSCAN$S_BIT_ANY = 1 - PARAMETER PSCAN$V_BIT_ANY = 2 - PARAMETER PSCAN$S_GEQ = 1 - PARAMETER PSCAN$V_GEQ = 3 - PARAMETER PSCAN$S_GTR = 1 - PARAMETER PSCAN$V_GTR = 4 - PARAMETER PSCAN$S_LEQ = 1 - PARAMETER PSCAN$V_LEQ = 5 - PARAMETER PSCAN$S_LSS = 1 - PARAMETER PSCAN$V_LSS = 6 - PARAMETER PSCAN$S_PREFIX_MATCH = 1/ - PARAMETER PSCAN$V_PREFIX_MATCH = 7H - PARAMETER PSCAN$S_WILDCARD = 1 - PARAMETER PSCAN$V_WILDCARD = 8! - PARAMETER PSCAN$S_CASE_BLIND = 1( - PARAMETER PSCAN$V_CASE_BLIND = 9Y - PARAMETER PSCAN$S_EQL = 1 - PARAMETER PSCAN$V_EQL = 10 - PARAMETER PSCAN$S_NEQ = 1 - PARAMETER PSCAN$V_NEQ = 11I - BYTE %FILL (2)O - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -CA -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -CV -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item lista -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME))H -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE)) -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1 -C UJPIMODE = -1I -C TERMINAL(1:1) = CHAR(0)S -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,)0 -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item liste - ! Now add items to listY - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlistT - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IFL - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistO - - IER = 1 - TERMINAL(:1) = CHAR(0)I - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0)), - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.) - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER( - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFOD -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -CD - IMPLICIT INTEGER (A - Z)E - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)( - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX)l - DATA USERINFO_READ /.FALSE./ - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHAREDU - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DOA - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAXE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IFI - END DO - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET'R - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAXE - DO J=1,2R - LAST_READ_BTIM(J,I) = LAST(J,I) - END DOA - END DO - END IF - - IF (IER.NE.0) THEN1 - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER)O - END IFE - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX_ - LAST_READ_BTIM(1,I) = READ_BTIM(1)F - LAST_READ_BTIM(2,I) = READ_BTIM(2)E - END DO - END IF. - END IF - DO I=1,FOLDER_MAXI - DO J=1,2R - LAST(J,I) = LAST_READ_BTIM(J,I)V - END DOG - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - END IFF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIMM - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU)))E - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0E - LAST_SYS_BTIM(2,I) = 04 - END DO - END IFR - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM)G - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - USERINFO_READ = .TRUE.i - - RETURNa - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -C -C SUBROUTINE READ_NEWS_USERINFO -C - IMPLICIT INTEGER (A - Z)1 - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) NAMEc - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1)))( - ELSEI - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2))) - END IFL - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READU - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU)))G - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSEA - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IFI - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAXO - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IFR - - RETURN! - END - - - - - SUBROUTINE UPDATE_USERINFOF -CT -C SUBROUTINE UPDATE_USERINFO -CP -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC'e - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)l - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - IF (.NOT.USERINFO_READ) RETURNU - - DIFF = .FALSE. - FNUM = 1, - - DO WHILE (.NOT.DIFF.AND.FNUM.LE.FOLDER_MAX) - DIFF = LAST_READ_BTIM(1,FNUM).NE.OLD_LAST_READ_BTIM(1,FNUM) - IF (.NOT.DIFF) THENR - DIFF = LAST_READ_BTIM(2,FNUM).NE.OLD_LAST_READ_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1 - END DOA - - DIFF1 = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF1.AND.FNUM.LE.FOLDER_MAX)N - DIFF1 = LAST_SYS_BTIM(1,FNUM).NE.OLD_LAST_SYS_BTIM(1,FNUM) - IF (.NOT.DIFF1) THEN - DIFF1 = LAST_SYS_BTIM(2,FNUM).NE.OLD_LAST_SYS_BTIM(2,FNUM)U - END IF - FNUM = FNUM + 1N - END DO- - - DIFF2 = .FALSE. - FNUM = 1T - - DO WHILE (.NOT.DIFF2.AND.FNUM.LE.FOLDER_MAX)I - DIFF2 = LAST_NEWS_READ(1,FNUM).NE.OLD_LAST_NEWS_READ(1,FNUM) - IF (.NOT.DIFF2) THEN - DIFF2 = LAST_NEWS_READ(2,FNUM).NE.OLD_LAST_NEWS_READ(2,FNUM)S - END IF - FNUM = FNUM + 1N - END DOY - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHAREDN - - IF (DIFF) THENU - READ (9,KEY=USERNAME,IOSTAT=IER) - DO I=1,FOLDER_MAX - DO J=1,2M - LAST(J,I) = LAST_READ_BTIM(J,I)W - END DO& - END DO - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF_ - - IF (DIFF1) THEN - LU = TRIM(USERNAME)N - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))( - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF - - IF (DIFF2) THEN - LU = TRIM(USERNAME)M - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))A - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READV - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READI - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THENI - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2)))N - END IF - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM)T - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - CHARACTER*24 TIME1 - - TIME1 = TIME(FIRST_ALPHA(TIME):)I - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:) - END DOE - - IF (TIME1.EQ.'-') TIME1 = '-- :'O - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM)O - END IFA - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -CD -C FUNCTION: -Ci -C Update user's last read bulletin date. If new bulletins have been. -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -CF - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'_ - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT_ - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)R - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)T - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATEC - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUME - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)= - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder infoe - ELSE IF (.NOT.LOGIN_SWITCH) THENe - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - CALL SHOW_NEW_VERSIONF - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER)h - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder infoE - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGINe - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUME - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)P - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flagN - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN1 - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.i - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN& - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSET - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR.L - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THENO - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)H - IF (IER.LE.15) DIFF = -1 - END IF - END IFR - END IF - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND.t - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)R - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F - & F_NEWEST_BTIM)T - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM)E - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM)* - ! No. Unread system messages?U - IF (DIFF.GT.0) THEN ! No, update last read time./ - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IFR - END IF - IF (DIFF.LT.0) THEN2 - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF: - END IFE - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS)O - IF (INCMD(:4).EQ.'SHOW') THEN= - SAVE_FOLDER_Q1 = 0R - RETURN - END IF - IF (NEW_MESS.OR.NEWS_MESS) THENO - WRITE (6,'('' Type SELECT followed by foldername to'',E - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER)R - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0_ - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10I - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletinsD - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)N - END IF( - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THENT - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM)R - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)T - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1) - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER)n - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERC - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder ''E - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - ELSEF - WRITE (6,'('' There are new messages in folder ''D - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0F - END IF - END IFR - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERE - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINTL - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORYd - BULL_POINT = SAVE_BULL_POINT - END DOt - END IFa - END IF - END IF - END IFp - END IFe - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS)y - CALL EXITI - END IFI - - RETURNA - END - - - - - SUBROUTINE READ_IN_FOLDERSU - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFOLDER.INC'R - - INCLUDE 'BULLUSER.INC'1 - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUMS - DATA SAVE_FOLDER_Q1/0/V - - COMMON /READIT/ READITA - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)g - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATEs - CHARACTER*4 SEPARATE - E - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM)E - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folderst - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1D - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENC - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THENn - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.t - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR.n - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -Co -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed., -CL - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN_ - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE(IER)Y - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER) - END IFB - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DOe - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURNO - END - - - - - SUBROUTINE DISCONNECT_REMOTEG - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC't - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER))( - - RETURNT - END diff --git a/decus/vms94a/bulletin/bulletin8.for b/decus/vms94a/bulletin/bulletin8.for deleted file mode 100644 index b10c24d..0000000 --- a/decus/vms94a/bulletin/bulletin8.for +++ /dev/null @@ -1,2131 +0,0 @@ -C -C BULLETIN8.FOR, Version 4/20/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).GT.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND. - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0, - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - END IF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)I - - FORMAT = 0a - - IF (IER.NE.0) THEN/ - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT',P - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)y - FORMAT = 1 - END IFe - - NETUAF_NUM = 0r - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:)( - NLEN = NLEN - 12f - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64)l - SKIP = 4 + ICHAR(NETUAF(65:65))X - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THENM - ULEN = ICHAR(NETUAF(65:65))G - NETUAF(65:) = NETUAF(69:)U - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSET - NETUAF(65:) = 'DECNET' - END IF - END IFH - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DOO - - CLOSE (UNIT=7)M - - RETURNB - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX)N - - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLFOLDER.INC'R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 20D - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)Y - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFB - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK). - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)L - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK)B - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV)L - - ILEN = READ_IOSB(2,UNIT_INDEX)I - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE.A - REC_SAVE(UNIT_INDEX) = 0A - USERNAME = USER_SAVE(UNIT_INDEX)I - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX))K - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THENP - ! Do we need priv info?R - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THENC - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX))B - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX))2 - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND.E - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV)I - END IFG - END IF - END IF_ - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND.O - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IFH - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN( - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE X - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))). - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folderI - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE C - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER)L - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFOO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real.C - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSEC - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),F - & %REF(BUFFER(9:)))F - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1)U - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1)D - END IF) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:)))R - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24N - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1),L - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1),C - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),( - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IFi - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM' - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1)S - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSET - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF_ - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER_ - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX)M - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message lineM - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP))H - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + PX - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P) - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM)Y - P = 4 + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)N - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)A - END IF, - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THENT - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THENO - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF+ - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)E - WRITE (EXTIME,'(I4)') NODE_NUMBERO - WRITE (EXTIME(7:),'(I4)') NODE_AREAM - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0'U - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//E - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF. - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P( - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THENL - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL)D - P = 4 + PN - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + PD - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0)) - CALL OPEN_BULLDIRO - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX)M - LENGTH = LEN_SAVE(UNIT_INDEX)R - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTHX - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)G - WRITE (1'NBLOCK+I) INQUEUEA - END DO - IF (BROAD) THENI - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin2 - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder fileT - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodesV - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':')U - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER)M - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAMEL - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node thatT - END IF ! originated the message) - END DO - IF (TEMP_USER(:1).NE.':') THENI - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE.I - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000= - END IF - CALL SETUSER(USERNAME) ! Reset to original usernameA - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN_ - CALL ERRSNS(IDUMMY,IDUMMY,INODE)_ - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR.C - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN_ - DELETE (4) - END IF& - ELSEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH)) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER). - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128( - END DOA - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IFE - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry( - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)A - CALL SET_FOLDER_FILE(0)L - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER)_ - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:)))W - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THENN - BUFFER(5:) = BULLDIR_ENTRY, - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER)1 - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0)X - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX). - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL)N - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)R - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY)P - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)I - OUT_SAVE(UNIT_INDEX) = OENTRYK - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)1 - CALL SET_FOLDER_FILE(0)N - CALL OPEN_BULLDIRU - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER)I - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THENP - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)T - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER)X - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENI - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000E - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROMS - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENU - CALL CLOSE_BULLDIRT - BUFFER = 'ERROR: Insufficient privileges to delete message.'L - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000A - END IF - CALL REMOVE_ENTRYU - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE), - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read messageV - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)) - CALL SET_FOLDER_FILE(0)I - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX)N - DO I=BLOCK,BLOCK+LENGTH-1, - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)O - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTHA - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)_ - OUT_SAVE(UNIT_INDEX) = OENTRYO - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)S - CALL SET_FOLDER_FILE(0)O - CALL OPEN_BULLDIRN - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT) - P = 4 + P_ - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIRS - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000A - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP))O - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + PF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV()4 - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR.F - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR.I - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000E - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFILI - NEW_LENGTH = LEN_SAVE(UNIT_INDEX)K - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX)E - DO I=1,NEW_LENGTHD - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)I - WRITE (1'NBLOCK+I) INQUEUE. - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletinN - IF (NEW_LENGTH.GT.0) THENS - NEMPTY = NEMPTY + LENGTHZ - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1A - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1),. - & BTEST(MSGTYPE,2),EXDATE,EXTIME)M - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General?G - END IF - CALL WRITEDIR(ICOUNT,IER)) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIRC - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR' - BUFFER = 'ERROR: Cannot find message to undelete.'L - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000C - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROMM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIRM - BUFFER = 'ERROR: Insufficient privileges to undelete message.'N - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000F - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + PE - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + PO - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0)P - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER)M - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG)C - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)R - CALL OPEN_BULLUSER_SHAREDB - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) O - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAGL - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG( - NEW_FLAG (I) = 0I - END DOR - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER,A - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSERQ - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast messageQ - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THENo - IF (SCRATCH(UNIT_INDEX).EQ.0) THENQ - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IFN - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:)))N - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX))C - IF (ILEN.GT.20) THENN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER) - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER)A - END IFI - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0 - DO WHILE (IER.EQ.0)R - CALL READ_FOLDER_FILE(IER)_ - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER)I - END IF' - END DO - CALL CLOSE_BULLFOLDERI - END IFN - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IFR - - RETURNR - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLUSER.INC'P - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC's - - PARAMETER MAXLINK = 20S - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)U - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)X - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12O - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX)Y - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)L - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFON - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),R - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX)L - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX)O - END IFE - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND.F - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND.( - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THENA - DIFF1 = -1U - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND._ - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0M - END IF. - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IFI - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURNU - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM). - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM)E - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)L - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX)R - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)I - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)M - - RETURN( - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THENR - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS)0 - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV)Y - END IFE - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT)T -C -C SUBROUTINE GETACC -CE -C FUNCTION: -C To get account of present process. -C OUTPUTS:E -C ACCOUNT - ACCOUNT owner of present process.A -C. - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -CH -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS:( -C STS - Status word of present process.R -CW - - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info) - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB)U - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUSB - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)'L - - DATA INIT /.TRUE./R - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSER - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - REC_LOCK = REC_LOCK + 2 - IF (REC_LOCK.GT.60) THEN - WRITE (6,'('' Bulletin aborting due to record lock'', - & '' problem. Alert system administrator.'')') - CALL EXIT - END IFL - ELSE - REC_LOCK = 0K - INIT = .TRUE. - END IF - END IFI - - RETURNA - END - - INTEGER FUNCTION TRIM(INPUT)F - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURNT - END DOR - RETURNA - END - - SUBROUTINE SYS_GETMSG(IER)N - - IMPLICIT INTEGER (A-Z)X - - CHARACTER*80 MESSAGEL - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURNC - END - - - - SUBROUTINE HELP(LIBRARY)H - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' '( - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURNE - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names fromE -C command line.L -CB - - IMPLICIT INTEGER (A-Z)= - - EXTERNAL CLI$_ABSENTH - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10)C - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256,PASSWORD*32,TEMP_USER*12E - - NODE_ERROR = .FALSE.N - - LOCAL_NODE_FOUND = .FALSE.E - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THENI - LOCAL_NODE = LOCAL_NODE(2:)J - L_NODE = L_NODE - 1O - END IFO - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',')= - IF (COMMA.GT.0) THENN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1)S - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE& - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM))) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)B - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1c - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)n - POINT_NODE = NODE_NUMD - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD)T - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0)S - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DOV - NODE_ERROR = .TRUE. - RETURN - END IFN - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"',D - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')')E - END IF - END DO - END IFr - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)//P - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED',_ - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER)( - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM)B - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE.L - RETURN - END IF - END IFA - END DO - END DO - ELSEE - LOCAL_NODE_FOUND = .TRUE.N - END IFS - RETURNE - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C -C SUBROUTINE SET_FOLDER_FILET -CD -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE,S -C if = 1, set FOLDER1_FILE_ -CN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'N - - IF (NUM.EQ.0) THENL - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE)T - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE) - END IFM - - RETURNt - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -CB -C SUBROUTINE SET_FILE -C - IMPLICIT INTEGER (A-Z)m - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILE - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE =0 - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERI - ELSEI - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//D - & '.]' - END IFH - - RETURNI - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'K - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12 - - DATA UPDATE/.FALSE./N - - UPDATE = .TRUE. - - ENTRY SET_BULLFIL_UPDATEU - - UPDATE = .NOT.UPDATEE - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) I - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATE - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):)C - - M = INDEX(FILDATE,'-') - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3)T - U - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN T - FOLDER_FILE = FOLDER1_FILE - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THENA - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHARED_ - END IF - END IFE - - IF (UPDATE) THEN - READ (1'1) NBLOCKS - REWRITE (1) NBLOCK + LENGTH0 - UPDATE = .FALSE. - END IFA - - RETURNU - END - - - - INTEGER FUNCTION MINGT0(I,J)R - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THEN - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE - MINGT0 = MIN(I,J)A - END IF - - RETURNN - END diff --git a/decus/vms94a/bulletin/bulletin9.for b/decus/vms94a/bulletin/bulletin9.for deleted file mode 100644 index 689923d..0000000 --- a/decus/vms94a/bulletin/bulletin9.for +++ /dev/null @@ -1,2099 +0,0 @@ -C -C BULLETIN9.FOR, Version 1/27/94 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA DISPLAY_ID/0/,KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - - IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN - WRITE (6,'(A)') ' A new BULLETIN executable has been '// - & 'installed since your last use.' - WRITE (6,'(A)') - & ' Type HELP NEW_FEATURES for help on any new features.' - END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IF - END IF - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN7 - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSEa - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1O - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)I - END IFZ - END IFE - END DOI - - CALL CLOSE_BULLFOLDER ! We don't need file anymore, - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSEO - WRITE (6,1000) - END IFI - IF (.NOT.SUBSCRIBE) THENF - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSEc - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42)E - DO I = 1,NUM_FOLDERSS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THENN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THENs - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THENn - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1),T - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IFR - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSEB - DATETIME = ' NONE'N - END IFc - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1U - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THEN - NUM_FOLDER = 0i - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1),O - & 'HIT any key for next page....')' - END IF - END DOC - IF (NUM_FOLDERS.EQ.0) THEN_ - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IFL - WRITE (6,1060)d - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURNR - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0_ - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1L - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1a - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0R - END IF - END DOB - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0_ - RETURN - END IFS - END IF - t - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)C - ELSE IF (INEW) THEN - NEW = INEWE - IF (REMOTE_SET.GE.3) THENE - CALL NEWS_GET_NEWEST_MESSAGE(IER)H - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSEI - CALL FIND_NEWEST_BULL' - END IFl - END IF - - CALL DIRECTORY(DIR_COUNT)S - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040)D - ELSE - INDEX_COUNT = 0 - END IF - END IFL - - RETURNO - -1000 FORMAT (' The following folders are present'/)W -1010 FORMAT (' The following folders with new messages are present'/) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12)I -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...')R -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USERF -C_ -C SUBROUTINE SHOW_USERN -CN -C FUNCTION: Shows information for specified users./ -CM - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLFOLDER.INC'Y - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAGR - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX)( - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2)L - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL')O - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER_ - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)O - - FOLDER_PRESENT = CLI$PRESENT('FOLDER')N - - IF (FOLDER_PRESENT) THEND - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z') - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME)T - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER)E - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURNS - END IF - END IF) - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START')T - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THENR - WRITE (6,'('' ERROR: Invalid date specified.'')')R - RETURN - END IFO - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURNP - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),S - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THENN - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURNT - END IFM - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURNT - END IF - ELSE IF (SINCE) THEN_ - IF (BULL_POINT.EQ.0) THENE - WRITE (6,'('' ERROR: No current message.'')') - RETURNP - ELSE IF (NEWS) THENC - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THENR - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSEK - STARTMSG = 1 - END IFT - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_ASTT - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0, - DO WHILE (IER.EQ.0.AND.FLAG.NE.1)_ - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST_ - END DO - ELSEY - IF (NEWS) THEND - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU)))B - IF (LU.GT.1) THEN) - TEMP_USER(LU-1:LU-1) =E - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))D - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IFF - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST, - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THENT - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1S - END DOD - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND.R - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN' - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0K - NEWSMSG = 1, - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER, - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THENK - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0, - ELSE - FOUND = .FALSE.K - END IF, - IF (FOUND.AND.NEWS) THENS - WRITE (6,'(1X,A,'' latest message read '',) - & I,''.'')')P - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')'), - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'',S - & '' to specified folder.'')')R - END IF - END IFY - IF (.NOT.ALL) THENG - IF (IER.NE.0) THENI - WRITE (6,'('' User info does not exist.'')') - END IFI - IER = 2 - END IFB - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED, - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSEA - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IFG - ELSE - WRITE (6,'('' Entry for specified user not found.'')')Y - END IF - CALL CLOSE_BULLUSER - ELSEC - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1)A - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND.T - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM)E - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THENQ - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IFU - END IF - END DO - CALL CLOSE_BULLUSER/ - END IF= - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN( - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C) -C FUNCTION: Opens specified folder in order to add message.I -C= -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROMG -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS:t -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP_ - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROB - CHARACTER*12 PROTOCOL - DATA LPRO/0/P - - COMMON /DIGEST/ LDESCR,FIRST_BREAKO - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIPL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATEE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXTI - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPEy - DATA SCRTYPE/-1/h - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocessR - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESSB - - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDERp - - IF (IER.NE.0) THEN - IER1 = 1A - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY)e - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN e - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER2) THENi - CALL ADD_DIRECTORIESE - ELSE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IFl - END IF - END DOC - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folderL - FOLDER_SET = .FALSE. ! indicate itL - ELSE ! Else it's another folder2 - FOLDER_SET = .TRUE. ! indicate it - END IFE - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory filer - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0E - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - - LEN_FROM = TRIM(IN_FROM)N - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1n - LEN_FROM = 0 - END IF) - - IF (LEN_FROM.EQ.0.OR. - & (BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0) - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0, - IF (IER1.NE.0) THEN& - OPEN (UNIT=3,DISPOSE='DELETE',FILE='BULL_DIR:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW') - SCRTYPE = 1 - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THENQ - CALL STORE_FROM(INFROM,LEN_FROM)a - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol( - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO)F - END IF - LEN_DESCRP = TRIM(IN_DESCRIP)0 - IF (LEN_DESCRP.GT.0) THENK - INDESCRIP = IN_DESCRIPk - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)K - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - - OLD_BUFFER = ' '$ - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE.P - - RETURN - END - - - - SUBROUTINE WRITEOUT_STOREDt - - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLFOLDER.INC'l - - CHARACTER*256 BUFFERu - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3)E - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -CT -C SUBROUTINE WRITE_MESSAGE_LINE -CH -C FUNCTION: Writes one line of message into folder.K -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'U - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROL - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATET - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK: - DATA FIRST_BREAK/.TRUE./t - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFERo - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE/ - - CHARACTER*24 TODAY, - - DATA STORED /.FALSE./ 0 - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THENE - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = r - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER! - RETURN. - ELSE IF (BUFFER(:5).EQ.'From:') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:)_ - OLD_BUFFER_FROM = .TRUE.E - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE. - OLD_BUFFER_FROM = .FALSE. - RETURNc - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:)T - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURNE - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THENE - LPRO = INDEX(INFROM,'%"') + 1n - PROTOCOL = INFROM(:LPRO) - END IFt - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)n - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIPU - IF (.NOT.BTEST(FOLDER_FLAG,5)) THENE - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE' - DESCRIP = ' ' - END IF - END IFL - STORED = .TRUE.r - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STOREDZ - STORED = .FALSE. - END IFf - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE.f - RETURN - END IFu - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE.E - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN0 - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSEP - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3)O - END IFT - LFROM = 0 - LDESCR = 0 - RETURNe - ELSE IF (.NOT.FIRST_BREAK) THENL - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THENc - LDESCR = LEN_BUFFER - 9! - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM) - CALL STORE_FROM(INFROM,LFROM)T - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM)R - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSEE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IFV - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1R - CALL STORE_FROM(PROTOCOL(:LPRO)//A - & BUFFER(7:LEN_BUFFER)//'"',LFROM)E - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM)I - END IF - END IFH - RETURNT - END IF - ELSE - IF (LEN_BUFFER.GT.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - ELSEH - WRITE (3,'(A)') ' ' - END IFa - TEXT = .TRUE. - RETURN - END IF - END IFU - - IF (LEN_BUFFER.EQ.0) THEN ! If empty lineo - CALL STORE_BULL(1,' ',NBLOCK) ! just store one space - ELSE - IF (LEN_DESCRP.EQ.0) THENL - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IFT - END IF - IF (.NOT.INEXDATE) THEN/ - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER)L - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN= - IF (NODATE) THENE - IF (INDEX(BUFFER(I:),' ').EQ.2) THENE - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE( - EXDATE(1:2) = BUFFER(I:I+1)) - I = I + 2_ - END IFE - NODATE = .FALSE.$ - ELSEE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-')Q - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4P - END IFR - END IFB - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DOL - INEXDATE = .TRUE. - END IFR - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - IF (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11)) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH))( - END IF - TEXT = .TRUE. - END IFA - - RETURNL - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -CT -C SUBROUTINE FINISH_MESSAGE_ADD -C( -C FUNCTION: Writes message entry into directory file and closes folder -CN -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'U - - COMMON /DIGEST/ LDESCR,FIRST_BREAKF - - COMMON /SCRTYPE/ SCRTYPE - - COMMON /TEXT_PRESENT/ TEXTI - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPB - COMMON /MAIN_HEADER_INFO/ INEXDATEF - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAY - - CHARACTER USER_SAVE*12) - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THENE - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THENE - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1_ - FIRST_BREAK = .FALSE.' - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THENE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN( - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)r - END IF_ - ELSE - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF6 - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - RETURN - END IFL - - EXTIME = '00:00:00.00'E - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF_ - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time?R - EXDATE = '5-NOV-2000' ! no, so set date far in future1 - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IFE - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with addE - - CALL UPDATE_FOLDERM - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.GE.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<')_ - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)e - INPUT = INPUT(:ILEN)O - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE')E - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME)_ - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEND - IER = LIB$SET_LOGICALF - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICALG - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARD( - END IFT - IF (SCRTYPE.EQ.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INPUT,. - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')N - ELSE - CALL RESPOND_MAIL('BULL.SCR',INPUT,D - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('BULL.SCR;*')I - END IF - CALL SETUSER(USER_SAVE) - USERNAME = USER_SAVES - ELSE - CLOSE (UNIT=3)A - END IF - SCRTYPE = -1 - END IF - - RETURNI - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z)U - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROF - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROMe - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"'F - I = LPRO + 1X - LEN_INFROM = LEN_INFROM + LPRO + 10 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = ''''F - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:)S - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THENA - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IFO - I = I + 1 - END DO - END IF_ - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' 'T - END DOM - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ')S - INFROM = INFROM(2:)R - LEN_INFROM = LEN_INFROM - 1, - END DOX - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:)L - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DOO - - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK)E - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol programE - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(INFROM,LEN_INFROM)N - - RETURNL - END - - - SUBROUTINE GET_FROM(INFROM,LEN_INFROM)' - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INFROMF - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards.1 - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@'))N - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DON - - DO WHILE (INDEX(INFROM,'<').GT.0.AND. ! Name may be of form - & INDEX(INFROM,'@').GT.INDEX(INFROM,'<'))F - INFROM = INFROM(INDEX(INFROM,'<')+1:)! personal-name - END DO. - - DO WHILE (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name) - & INDEX(INFROM,'@').GT.INDEX(INFROM,'('))E - INFROM = INFROM(INDEX(INFROM,'(')+1:) - END DOV - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.''''))' - I = I + 1T - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1R - - I = 1 ! Trim username to end at a alpha characterO - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''')d - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN) - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a'))N - END IF - END DOS - - RETURN6 - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.127) - & INDESCRIP(I:I) = ' 'S - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:)E - LEN_DESCRP = LEN_DESCRP - 1_ - END DOU - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THENT - ! Is length > allowable subject length?( - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//L - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IFE - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP)))O - - RETURN_ - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER)T -C_ -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C= -C INPUTS: -C BUFFER - Character string containing input line of message.R -C BLEN - Length of character string. If = 0, initialize subroutine. -CL -C OUTPUTS:A -C IER - If true, line should be stripped. Else, end of header. -CE - IMPLICIT INTEGER (A - Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE.F - CONT_LINE = .FALSE.T - RETURN - END IF= - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - END IF - - IER = .TRUE.N - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuationS - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header lineD - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuationM - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN)E - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THENs - DATE_LINE(TRIM(DATE_LINE)+1:) = '.'E - END IF - END IFE - RETURNL - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - - RETURNd - END diff --git a/decus/vms94a/bulletin/bullfiles.inc b/decus/vms94a/bulletin/bullfiles.inc deleted file mode 100644 index 2b73469..0000000 --- a/decus/vms94a/bulletin/bullfiles.inc +++ /dev/null @@ -1,41 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWSDIR_FILE,BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data - CHARACTER*80 BULLNEWSDIR_FILE /'BULLNEWSDIR.DAT'/ - ! Directory listing for LOCAL news groups -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vms94a/bulletin/bullfolder.inc b/decus/vms94a/bulletin/bullfolder.inc deleted file mode 100644 index 117f8fc..0000000 --- a/decus/vms94a/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vms94a/bulletin/bullmain.cld b/decus/vms94a/bulletin/bullmain.cld deleted file mode 100644 index 4ca45c0..0000000 --- a/decus/vms94a/bulletin/bullmain.cld +++ /dev/null @@ -1,33 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vms94a/bulletin/bullnews.inc b/decus/vms94a/bulletin/bullnews.inc deleted file mode 100644 index 251895d..0000000 --- a/decus/vms94a/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vms94a/bulletin/bullstart.com b/decus/vms94a/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vms94a/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vms94a/bulletin/bulluser.inc b/decus/vms94a/bulletin/bulluser.inc deleted file mode 100644 index 22d7a3a..0000000 --- a/decus/vms94a/bulletin/bulluser.inc +++ /dev/null @@ -1,49 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vms94a/bulletin/bulluser.old b/decus/vms94a/bulletin/bulluser.old deleted file mode 100755 index 4bd0cf974f7de240006eeb8de140a66bedfbe231..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 54272 zcmZPo14c#$Mpjk}1_p)$42%ps3_J`BTnt=bDI|gi%2pr%n4#(r6cdwda!815QfR1b zNQf*mLx?N`L%3{uSeR^DXsB#>xNJ^%xNKHPh-`LfsBBJH7)VukxNI&+CM--gKO{u9 zAS6UKFFaf}KP*hPAT(4qHzY(h2P6)X4-c0u2oIMn4hfMh1c`-&fZ0W%pWm~3@uC`?E%F*H;*AuLQ*w>~^vwk|we zRxdFuOg14rTs9>E0C=5XS@{kbOiqKHmN|3`sLuISO!epyJY>*?v!)5D3 zLS*$5LPBKueHj=SSQ!`?6hLtm&A`CG4;4rN2|zJO49a9+U`RnQ!7N6&eo*=WaX{D> zEC(S#dLqla#!op-hY*5IBg~@^fHXRzcVPUc$6=@+MvgsiqvY_zH z3J(W|F(?IQhlR;zhK0%Igoc7sB}l#?EKC*@)*yLMn#=>GK~UNX50@wg#%BHZ&BH z)}T>Z8x|&86CN&G9Ud-Q8(tGGTNe@{3({bi7#=PQiem#%NP)B&fcVTo zWqW*|GcYrBvIaAN;+}zliIIVk0hE1B7#JB8gc%;(|CM9Ab~?j@b5Ru*Yo{|XI54oX zGyMPm|33pG11B?shz0{M2Lq@$0L3f=6B7dySi2Yl2ZNTMe~71Bqyi_yWJv~y8gnLQ z1`uRm5Mp3u3~&wdRbXZSnZ(2(%3#FA!oUL7ZNVfdOQ@A|nF>gSa9CCqILNm~>k5n&}KM5hhj!R*wr3j=h65*^FMd16!XS)nl^=s2 zSdj(;8>6#pn4hD95JN+icjuE!(-;yeGQhMD0~fLuD+VjD7Ig+zCSQLSLj@s*1xpVx zzi*t#;4otW8;E8?)e*=L2-cy(z{F~V#R36T<(6-m1(3}82fgu6ilHGm-iriIDh$JaF&i!ER+h(P9J-~($>XJBXa4~lg3b5sz( z@CYd8;L*a*zz@~|in#zc=P<_zj4*d$Z~-d;85-gk6cQQ?GIWlmU2pO<28K099DZNT z1t$l%p+XEoU>%YS?2M@jd5O93xCW&dP!bnoa%OM_t1)NbVsLcyb8!s{_V>f$!+r*C zCQt%rW)R^(%_<@cB486t7+4vdJRBoIahAr35@qo1dO5QBr7l;?!x=?o8^YdL~^g-^c$g8^7S$a)W7R~L}= z{H|L!u9?oDaD35Ww@LV|w_&gWYd2$HXY_IQa}5VY?*nd)rcJA-GbDUo={iXTzX8?^ z)?foH8910+Bfuf3AjFWcOIzvbqG=2b(Z*o9pMecg+%Peqg@F`<6xa+S24+UzD3A}> zK1wc~JDp*{QU7MvJ=5?8pfrOtShEfT2P0DaZD(bxSTmjBfnixL$SWv8D8?YhCBwi7 zE-SfY8JHmqc?MPpLy>_U!cbx0hA=c3_#q5U1_21ekU<#2&|wgPFmxG2!3=N#N|JI& zkw}kWCjJE`l%oqC8|VGbBhLp223}jtFt#KuN>74iGMML!C__`n8v4DlR*=#+lYag z#We_&%PS^L4}CF(p~2@cn8v4Bi$M#l*@S_W$;ZbNlusPYFI-}kE^8lQG; z25qo*kiUc6T|s$d_w6jDhf^39T$IiR(fD*5G8n>iv-p6W?oj2wH08w<1_kknU>cup z9R?k+ZbJqpW{|rdEVccx@c9&m2VWUJf@pktbs2QQdW{)am_s~4MdN|HvqQ5%A>Otw z3`FD6jU|`KF|a@q8a%rxFt9;H;Q3CEfde9<#J~w*C^K+D81O8q%D@8=QDfkRFw`0N zAPmaVDY#L@4Qj}sl+%Mc3>g@n&t~9YIK*nr0BNs-8*m&93=F0WYz$7WAt9h@rQz4H ziGH)EGd#G^v;;(>L>yX?3~IuG^nPGflaorP!dbcO@Jy}GNX;ja}yEis68 zHb#G^ApbB0AqIx$I&b-xPiJ7LpPjZh6+=HiJE(05E+Lpei4LUQl!2AWGYp*S7+TA| zl}JrzXxLO<9p8ddC1BRcpjIA8KPa#I`TKx8zu?2~n8y>QGcYvm342h2VmnwrACmQ; z+y>GPvOXxt5tL;bjz{0J0afWW&-S~n#MF+`dIq&1LHdmtSeSyHL2WDt-LB(*mQ81P z;Cl9;!E6-mObjLr$bL6xFlPX1He+CA403bopKYxt6IE`UJz`?I`dcl6jQ=5W1 z{2&927?_#-eHDZl9!#Ea<@%cG3=Y9L^?O&KS&kO(+zi}c+pQQl7(;!0Tp?M0fizE= z59<_$2baEShzm^x)yD`2fP)Xk{}v1uU_(G{f*@}X#~_ywP+>do2DkmsX$%Yg?gY2h z@V5zg8F;~Fm@u$0M!NY2ff_akq8@XnfhzTrHUC#)wyTgs(UQRutQ{1V&W^sGK0cr# z_drR#_D|>O3=JLiCLkJL4lrdf1)E^Tz|Iup6YA^?N<|8XN2&@U@?hw}?Pe{KbTl#k{DCD~N5*rinCjn545|n<-8Q7SE z9K*oLpTRnAp1|_y3=6j2ee{(Fi@hj52X$jWCKxd=GlzgYeL&e-?WW9h1_vEkf(=?h z20^gK?ck!Afq@I= zJ}4jRSPceIh_!gUh{tI#?YP5-7|kFjp@%DR`nU$r*)YGyPhnUfdQVU~ehR2SWrg<; z1yS3)>I~}O3<0W5{Cq&AKtkQ|iQcJG7#?sdPXf^>Wr!e3Z31dAgR%jrCJgfgx3?X_ z9PINWr!YKdSq!GpbR*|vL_QE@V1h(9W`>YpV1-Cw<_u{D4v3Tt11E$5&nt2a+z=6x zGK~s@AVe2&vCO2#pau>*koSGOJwa`L2D3W?pdcSkLC?T2dlCaLgEFfXgAXWAK*s-g z!Ry=gu}#;Q z&fqZ36uk(?EPO#@DK`^p*3dgm+G9Gn3Sx&OdB_MP+OP^}coAv@ zlbd6x56FlIQv@YASSB(s=&V-)(I_nlOjm#^GLR9L3|vehL5}X8j?NySR)E9x{qsRp zZ^Kgd7of@(rwDX%oGd?2L;0=%o*>d zF)T1ThOiwp;0Ya}LL1BlHKjoML1R3A?mmt#pg?G_JE*dF&2)wZa}uxAuR(JFTB8s& zo(D1j)ENl!13Tfs!Va##%cnCOh>ev3(fGm;)FJ_CH)UXE40Zx}9y(syVDK2>esI4F zYf=C;$3gl*)`vOzftuqEOXqjbm^Pgu;o+uj&KvR8l2F)C`F*PE zbOwj6kQLKiL0*TC?V*Jnr~wAjYRbUI|+(T|1q@;YUbrUnzzbl=KQ3W`OEu3JL->Sr2e09tI8hFKF1Tu!%rK3o{6VbGZcQVbjrDH#SX2t$^E8^Vxd z;DIpY8F(QKPy-9B3)H{@GeGSjFauQIf*7EZk&7}TK*msL1Q)_NTnY?)1YHkmeu1q; z(uZJz{KOy%HU!dALsyC!E}%LTtO`_zf*J6T!n6x4PoWuLH^RLQXG~#W_@FSmy$O`2 zkn(^iN%#2>3f^)&`$T!mzr!X|!*vvm&5koIZW>95N1#1RnB_CH%!c?#m zt)6B*g@K{yY6pl$%DfmOKA^S(C@UE@gfKzc10 zSQ-6YLqKEN2N*v_pKG4Nuz<^E!ue(lhjZ~T2!iHs6%@czxC~67mK(?jZ3cEGAOA2% za7QYkjo<%D^ArY!du!){Xf!v7afvZ7f)fKGUx9`^!Lg{tzyguNlhdRbI3a3?$#Qs7 zFDYpZT<~KKxQ#|00|OTkkq6FQ43m@?gc#1Tm@znk`QQ;WAqEBp3kFUGcYi-mXAkhS zRzluh6Zib-3<@>QGAl#yS0#)Lj0_+nv>4c!{9Sw@eQ4{Z9gj_?Gdze3$UJokqhJ>U zk2``ifojYkUmx(Gg+df>*8Vlq85j=E|GA4m4FqcTf%Ka&Ff)gOn(GQCzpfuIn8wgB z=fMpSjnd}Bm`MUn8iTZha(s}Z8>sRu7P!pTJDs87uaj5$qX8F1leuMz{U~=9dL4}S-0xrvgr&Cozl^lCgKlo zP;(WeAJkXz^aXd-4j61vUbJR9!+|@&wQ~uC9H@;6(r&=O!~$xtE37y_Yo_FMh663J zGiFO-SdCN%gNKYjTFn?(nfyaSKy9Q4w{zYF@lI!0@GJKhh{hl6pdm+)0ia2OFo?^G z|L1@f94x4*DfHZrkx)>IX=4UsaIl**urh|af}5AH&H`*+7sYzaA{!DKXX9QcGj!PViAVtQLG0w@<5u^LCtGW<8pz#o6=-Z(^&A}>fM-wd}2(XW*tZe zsF@V*=?5BIYT!J!{a@8|h6UxBz8k^GObnE~kV6?Xpa{}s$-vIw;ppP&0&1N(>@elC z2X)C#9hC*q1UzcOU;+**(BPhriz_5kI*7fv!7>NbHCxEcItRaJK`lIxBS2F@pbBw8 z)A@?@mD3p>2$$?OO~I>|3p4}9SIkLGX%hn z=Tc!1gfKuYEU?>&@G=9qVFXr|gQ&3BDGUtnkArD^ zx;v1@B_`HIV7$KIVV1a zAz_tZD2PVWi|lJI5e7y`S_F;Yfm0V~1P{!B=VwrZ5G(@fdVv|Bv28E|PgVzw;DOb^ z^E_z087zV)^OKb~M&k;1TtNy5r9}+l4A)sq83Mt4CeUgHad7*OgTc$+!w)h5n9wkd zO>^yZh6C@ai*(k4OM6ImV*+J2G1Orv(69~22r~v2CO>ec?l4t^vms;(=uPw2RAwo=GXLNN9hAf<5kgmRXu5CJlLrKI(5RH_1m>I;- zOaM)TgG>PR0YP)%4kpQJS*xZqJn(;~#t;te+Nc?*Eeg^Ls;m7xgG0a#a0RXP zU$qxaXHaNYd!j?2VFGH7f(!tS9tHb>SA8syE=Z9Et=|+37i?XHVZRs?sDS{|11c*# z!OcMa6&-UxjhX(=PqhS^kf0e$kY-RbE;I;KBQ&(=>;^S~9^_X$yW3;fhg{MyfrjZo zx3Xs_L*xqLdq13{Io$yN9b08N{N3;>N9d;2(oN0J<7{nvUfI)#CO zAxIlU6Nqup^fkx`Q2XEC88qJZK-a(EF=#QI^f8C0OYl1Yv|b*fo0$dN-BGwa{n0g} z=?n{&zH42(8l2!^(G4E^LYegjHDf`#%^BDj1Dqjqjt$2mG(WmbXHfX63mY{@<+hCrFg(D;!yo|4^6+s3Pzw)ahzSD= zV`va~Uz{LxfGy^+?A;Z7{ zVaPIYLKt!kTo4ARQUL1$RSIARsQm_JfT{p61Jo)4Ge8YNFay*O1T#QQAP|EGV%i`u zgc=S3MHCo=TZ|z8fq7_z2*fIkus~Br43~?DAVxB0*%XEc2bUaLxD2heiM9$4)b@iU zF;*rQA4gCz4@OyE}Bfp57L3zkk{SfDu_ zOrvQ=ZVQ1Lfgru$o*t-xc_0#Ey?NOb28ZeWU>Z#?O8x@10705{88{hy9i2TwqZ~nn zx`L#{%EW0?7#0+!gK0D)#F#)$Kaf69&pgNpypqI0@W{umjwuWa(hWX=Xf!=2)`Hr8 zAnisBEX=-+ph1m<&e!ROmrY?jYE-s*AS;0tW-`%BC z7!FLG4W`lbBijyc0D@8)zML(|zzRuo6lQTyyANy^JgE>&Cv*A zfy4{$2!iI`Mb->53~Vf>4DMh7a63STfq}t>fs4V{F)B33)z2F=amldA;gOBjbOwg4 zjED*e_tYV%4G1#Ef`OCK+1W8D$P>Ki_Ce>Gbg|Xb84jFT{o&aRj5-N9{V{>6MUWBZ z4D8H7j?UiTexJfNmiJlHr!zdL6@obfsbWQ&g#$IhKqi2CUXWq@1F!zGfJT=Zw#g@Q zVUEzC*bf?31L+2>r*nnO9x8lh3;A|&8iRuG8O-@dj9MAgjsqEB&cMOs=jZ9?4sMAh z{Qkwy1e(WFS+LF89e)sj8a5ykK%wa78szE>S5gpSR91J@BpMgic;1f9*Eej@4Ne0qy z0}4mipfFGHUI&G+lzDSOjT7D7i$FAd1OVJ65n_C#Hui4mco0Y8ul#tf`X!Oq|Ux#6sSO|jc_hK8jVTDHtU zY3PBpBNxb^`B{)|O9p1fAW#F1;gRh#&@uvsxqLroKw8+4Hr@g7Y&MGk11Ar|Wa#7$ zICpY^c8q{BDwik&3pmGei8HW47!nNZ5C&)l2CN1&V+m#`GYCSYR2YOH3{?hU2t$KG z49ox-&qbLLTrjf`47dwGv#nsKC@~0t?c*ZKP2d?*us-q(pg=2V{14_K1_mxQ1`&w6 z)fq$~445P|AaN@IO|PQq0S(zf!W|J-F!LCo{k^-kzfV?9VQ_H2FL0_7tyzUOhzHuq z0!mrnJnkAC3@#}j-2FCpYVi~Xg}=q~Kr~7YMKeH#0R+K|zL~uJeH=ku=7gh{oNt0g z*jWFAX?*%+8Dtqi4gj@}{C#|bLtGs}O{@b)W7mE%L!{g5}c@bH9Of^VU*p?OrJvEgr=2I9R@N=tzXf(Yj!47IngESj5FtdOc z*(*$)ym)El6b6RBC%`nCW@L*&ZE28RQwBC>AIA`IciF*&2dSpDrZ zh{j_8cx5BFT)`}h#TZy2WdmlREXlwDkpfMWgSBH8)1b8}U@3TE2bw4cizqViL$ni9 ze&Q~Q7$JthTn;MqttT)jGH|mRF&Kb&kPW*vrZq7cQPN06rg9lIaK-IiM z^Q)be;963Qi9rmrjs?xaLUgk*db)y=Yvm4Y_ z1leuEz|80q02)5|%G$W#_B4hEtx}AvkRcpM?F?EghhaOYtq0N$X4P&dWb9~1=)zaH)bbyFV9EN@&(AOJ!8%Rp9x3baVq zFo@e1h_dbhtyFce$3u1=Q7Zk2UrbuCxYC` z1sV>)p$0tl4VD89r+^u7Ps5GIqn{fb1eBTrwih1iWVr+-p@14|po9V{;3K14K?RM& zV!a>IW>XjrJlfADV}`$x3~H@`v>P+9GQuX23u<5KrcPm4aB4l6Mkyvxw?lwhY9QSv z3~bDxG72<2o{;mgcX7lN28WGP`am=u?VyGlNIPh=zN;f-^+m(6Caak#Qy3W1BCJ6) znsyYwgIa4K{h&^`bC7F@V-Tp6N$8xvHD=0Wh6Pt%gK2ywfSPO|6F{No9tv)>IfRC2 z&qp~75b1gg~8zohcJjnGXo_MKutH0eiH^(<{(HIDjW{)Ech^)VZpOm zU>c8hL?I!@zywL)@X|tpfdwLhndL!K7T}Z&FGxU3R=^^ld2BEPG-Uy1fMy%O49b!{ zctHoq9LQo$n)n%1hJf${dj>UzFjiBBFc6Ocy#7xO-2P)>2=)L)^MQ8)8<(t^&XBO< z#QC%yl)4zBE&=V|0O_nZ|G+>pYl7nTW$M0Mvkl7{JEp=?)q6 zc97c@d1~==1_o!9wI!$(F-BDYK0*d$0H`wc2?I4E6-1BU1~mc{_P4$&(O~``un=`O5hJgDa z4=hY~w3SU~NYK(==sg)D6+;Uv#7=ThqYPvMsJ!%t%%LkpRyG}8Go7I!;ZOt*fmRu4 z%oC&?v>7$j-Q6`f#1qmog6?2B@JNK~4ij21fTIGrVZ#J!n}Li0b(TFN9l=8s3TX+a zK*NRyoX&;pMFqV38WuX{P=l7vfr6kk1du@VR)b>`vgSe(++AXfwY5aLC}F$LJSNR)kh7N zPhoKI{(loh_J5-86G)m$@Yk+`~9>@St(hC9~A9LWk=e71Hbk52J}Nh%td$dLS*Jqjtg^ot?pr)!cY~ZqUHj?ibqE zXQEgM@-9jl18V9)^)q_9dV+^M6{fF}F#(;x7Rjj(qVdHPsF4NIZ^^*L5bhWf0z1Nv zp-x*Ibcou4)N7wz?Gg*7EPd$02;CdX$CD6 z^#L!sbJ(^dM=fVMgTn4dr$IDk(*&h?1RDAS82~ONqaah;Ccij9t)qmgj3%JHulNE0 z)KUj&2aPuegIf9x+ILrg_B1nuq^wpYusi|O!UJgrm+--!;8m&z*bhuT-8!9tLI235 z)##hE(eeqXX$R5|8jtXG1n&i5h}**&K6^St!^~@QwJ`ToAg6Uu!w#g|60}dy#|>0H zCGeJ*{sXNLZChjxqLF+Kjy6v81%IHCH;@^ip}Wwa5LX|NDGHy`q)vc(dz;S4f@maD zFcKiBw*)f4f`N@8A_TGl=fK|z%~Gl93=Z!uBS!9UuM+{)b08x?#Z9CabX?}ZHruF9 z(472xcK!)=Ca0FE-Iy>9lzMBpBX*#UonzQ6&L9r98C2Xr$DJ1hwclO{+IF=(_yLH<7kCm35@7At z44e#6j-bPiz=vHq++7@EY%-0ZVc&HyO&|w=Mz29$0IhZQ^8_Chq@bl*tuH%`p<#0B zA_G~BMl$*_l%O*dK_-B_;Q<*wS2(h2@eRGPSzwxg`$3~}Anl-mtx#|OuwZZSz}D;U$vq$k%s3^ph(L`2ntKMBU;sL3!PnOn zIx_TN<~F|g!08MQA9StH`-A)d-dBZOfU<$6pFvu=88{h|N^^2bQj1FzN)*V_Mg^M{ zK$a_%fO_E|yx{-RX$%SM;b0o+7*W(kPPjZ#qM)F4wHy@tV(9BAv1@^bTZ8RiO^`kX z+5hy_5Arf-Ei#B^00HdIgy!;dyQ31cr!p)E_ztG~8N`?wL{Zn^W7iKVBFNSZD`Utu z08&Jet(`K*g8~%;U;o8m!0>`u0o-Z^pZ_cho{R$Ry$JFE?|pBWcX8ncP;PwL=S(O! zGBb#SwVN`qFnT(JDinuDU%s#f0390u`#Dkxvr_7AF5t z(6Jc|x1_%-fwrDF?o-c#tdfFFCW3XNGzi!jq`=l&GjK44x%xS|27%7ONC=zn4%)Sn z5VD4~2K^j6@GLfHB|JRgftRI#90A%-;O`EZ6+I9fbFP(nIzz(G&xm^MKhAToIT>WY z4l!Y110DJaIeR2$vf@%uwHDju0HV=q2juDNG$leE) z=^!6~hP^^vL!vmkPg!O{UpJ95F!1X|4m(r?Vb!r}w&2pkA` zeja>k&FRIa`2?D!0u0LFxHAJCLIjBI{t`AgCY#-U^9>>OA_W!a~7R5ogsnAo1YW^>BelL z3>skl?6Aoa*o+HBhCpX+C^7@&M?VGZkQ=iU$M6W~EF8`oJR8fWF+8Xf;04i0If)np zKrS$t9F-)77LVu^2!_={3=G+Mz8Z|v7!(Y${6I8mHdCsfLhC^%C{g5o%6tzBb}+`M zghmBMLtr!n1|$T2Ir{i0fR68v5AY8T(NGVL3|8^+clY$OatihF(F=ACQrFQ72?}-9 z)A4i-(vg=oRg-oFNyP^^208k=hPVc4%1b+Xx+!RQx(4aF2I?7TDky{pd4{+uXqf4! zYpAO$_@)*YC#I(=6qhC^rxq8dmFDDBDiq`wm!ziXsjF+MYsyR8x%vdVg3NIZQm|Dp z015cHD0sTbOWQg7_y@ZxXoUKChS(Z|lp@=u=ji96=i}<<7UZwz9s;sE#KYB3UfR(a zEjw4;OeZYfE)lO zn)1>XU@bnLPAV?0KCU6I@gSwxylJhat|>1sZ4u-e5*p+uFAZ|EygW!GIMgY~KQzSC z&sD+E#U(x%bjol@XppN0$S6=q>wp-3j=rusZvH+lu0io2wx+zZyt9G=F3k{Gw@^Q4 z&}65Tf@4Zbu|jcXdR}5lX;G>|2_h7dQZw_?6><|Zb5c|Ep$S3W8RT)_03T0h&kzOB zYHHAa84X9>D6k)#Jsg7^okLuMv^2Cd6_6YS@(x1M(8xjooI2rNl9#q{aSU-p6IIYh zOX-L(&Z-O^+tvaI!_U5t?pn)%|^3)OCVf9bNqW zd?F!9%sSY^G04?L$I~B_xNJdL%FRE>*H#@wg2rH7AW;TN0igT@NmYHRYwPUEqf4`T2+Ffo%g9I>8}9u7MDB8dheSI_klo%ViYQ zHNmo=xC57k^3rx-Jqor8$U4leK(=Wj=PnH^u+2zGTT>HM_7HTq9mptjhueWt5W>lt z3XmvrMDtH@2nT}&!z~6z2GHGIjLhJBSU_h!C@3g6xdwqwaR)cqz}wQnECmG@NAQ8b zV4j;N=-@^$Q^DOIdfc3Xf`W&mk1Iq}LBY!}48~OO2JI||@_Zek`%)DY6hLAg%D5B6epOe0P2y$@PO2(qn3__z-S1J zhQMeDjE2By2#kin0EU1zLl}b^g8_pggFAx^Lm-1VgA;=ggAe$M5zswZ%nUa<893fE z*fI#PNP*8g2G9QpgD*Y+ElL4R$AgYecDNrb0b2U2;1QP(qLBtYF^1lm89-NmGB8+! zZea3p0Zpna2nViKtDeq~U}UH}`#N~c6|wXeJbI3?Gyyb)0lJV1blN27xW5B>cY@BX zn9guu!VSrs3HT=-Kyw!$y(SDyOrRO*10Fd^wj9$L8W{f`_{j*?i()XMi%V{UR&XTDT4XY5C4SvJ4Dw*zpd)*Ipr?Z-c!;%wjwML=r}woPbG}B5iI+hE ztO>k)0&+J%K<5fR&}~7->`MeNwV=$=faZrl7mR?m3itizM>3~$xv4jGcYhP zf#!rj;RRZ91`aPFhJ?aoe~;3s3HpwEo8fG>0O@&@f?t{y|W!u2Zpmn;=Gogi^4h z?aalfYXO-VM9@x-=-ZYb?m)YWcGptbc6dW`LT35I3+efkxGZ7#=*Hw_7=OIzz%ge@00@ zaNMIAfZTuuwdp|mbr@I~JR!%4AGkg5(a-#83<-MQ9)oDi&=+L_wd6qBKub`eCyF;* zc=dEGXsy(j58CYnnoyvo97wwc0}J#-@rIahQ&d4aMqAG?#Iu84jT+dXMX#X10$nr- z-j~<#Iwl)*z)3?a^ZY^r>#IPklR%n5&INUmK!=6AwOG{$+8Sss`%RO;=15SJ5#(IZ z=1ACa;u1Lp@{^}AFs$e<2GJ;igpo-=O-7Ibpmw)Ec-{Ge1?*fbGp92+>|t&!Gr{mL zN)81zU_iP-2c19;6z`Pz6t!U*!-Dc)FpXk4IDa5VG3dl4kmt=9SQxz_2L)Sy3Yi7! zn`LMufM~FO+*w16K@*%sK|2P(hmt2;T3MYo0kk<*`;}5RUdJmyuehPa3{bJjgkeC# zM!}~b%NuSG;Rsx=Sn%q7C2#3;28FI)Z6F$@A&9#CALk}jo*c!aAut*OqalDl1a?1UaA)vm0qw&8DP&@15CI>F zXUf3N;0roc3bY@C;YLcn(1hs>2jr}Gu4}_6qLGIrSQtdX`ayT{K+jKD!2G~Yd;JuK z2E}=9AR1gjfQvowIhW`gQb6atfDSzaZAsRX(CXs^$>`r61V+Qy86?2EL0h|AeL%C}LJSRe)+Vn3 zZDKTtY(7rlL@F-maf+a(m?!8gFpvWp*siDVcAv)3@O57Xh$avUpn4V*3ZUJHUY?*9 zq(d*$KhOgB1!CzXy9n$}0_|)8=?1wVGB_j%e4YD&lAcqUm!>f|Bx)ksut@QMHW11U zJ=D>Ffs+CMp^j)RLQy8r5G=@gP%}Iz%pZJzWkT)-?mCs}3=7UbEoV^%ry(?bD9vzC z3k_rhXkabCF(3fEW%~is0|ihkO<`f|=LP};e1Z(h;7BxNU}g#eokW-LZOwA!wbL0M zB=GzK?GQw&KS50_VAQ|ZO*_3It>eaXfi`-kC5z}X$%Ta^xv5K zqICp72B0K;Q0o+A0x03Qg0~eWwAs`KWK3sRaAGZN>jKR27`nw6G{9~*2cO0TJs#2F zRMK+L29N`-raA9W_uyjq9*cH`W%i3(Cr@V}Mmwksf;s_mAQ;pM4MJkvD@&#`9GLbt zXJ0T{7+^Sp3MMcxU^8Ta&5m{A*QOEa3|L^I_=Gegz~M1UjE2By2#kgREkfWS1A`C4 zR%XbZYzz$G+ucC7zJgj`Za%J_!OkAwxw(Wn`p1@mM)5d&CZ7ZEr^USijfp`VJe>?` z147SEVpump;|A#VU4B_j5KW-ro9$aomc0E|k6iGu+$D-PNR7U~0;Tyqfb z4h8M(R(Sn;?Iy^jI*?Nxpr_8GRK=inAjk>E3``8*eTYI04BOhLGdN5-w=7o(+zvo% z0wIsIfZAUW-7Jidec1=LZZrn9VGjrVP`NP8?2M$5d{;?oGPjDP6%>CBC4m3*T z%X6|3^9(E$w}aZBpmYFgL5D!D5MD18ATe_~L&DOD-1WL(*TcdNqZz@=06N2%fdO>x zRH#dkt0QPYvth$jw!Z&U85Sgqvx8{NGyoY21bJEuwD&G34D9R#hxGMkplRJB>*Crm zcm9bnfd&9UnoJnj7(JaJ?e&DO=Sx-APG@NN#I|e|W>_J&_CO=PAg_Xg%EuS9o>ho} zVS)O&D$qdyeBXXEp^iFZcosCE2eKYCqU8fVKebC{>TS?50AVTKjs!G=hT}k*bwIZg zK-bR-F*GohNE%F>&d|Uy^X{x87zterwAd9~8i3~`N!JfK3Ifv#|fyb3b2MIAv46p z7{tV&*{=U$eM2C-G4wf&T&ai-K-Xg7K7&Q_~+X1u& z5Hy_(I&9C+1zd+eIQp&$baGh3xrpur%<5PSyzCC7M}vWh88q6JFzw;CIMwM43uG1I z&pX5>TLb2mCGS*Gn@?+b_Qv%H$m(496_rD6__?> zJ^;0iJ~Bx75*Q!kV2}Z81~nL5gQCD5RFFEw($q7ZAt7E{=1~X!))8oI3v`niXq_ME z4!i~Lm!Af$TU(&|;8Z~oe!ZLwvS7PGdO<5A7i_x83OW`+LG}sbE66M{PET_&$bt2O zt~&_^UpC^<_MmDLsA-k+rTi*^mI`Qs8RlwGbIu{h-*kr$s6D7D{}cad1WcfbWmr^! zLi<45%#&=O1NvXq-38HTV{s^{3AD@*q*sT5mB|lszWf6AdyU+z(-|C^TUAy-jUnG+5L$u^D&VjN4L^eKDrCqgeHmdnoq^$h?5f9*b5M{Y3b{cFYI}p6 z4r)+_frh>p{JtV&18U4}`z#Kk@dX!X>=mRLl!1L6on8F>9DP7%_$}BN9R^ywdtmk_ zX;3EupBbPQEy({`3~bCE(7W^&$cYM?E}qWt;K;1)fvA@PfSV3Xpn*q_#ipQZf5G>% z9C-FF@MY9=hKAs9eW?lHG6Nb-j0~J0O(^jUn$`wc3SK$_y)1F@yvy~IrZY7B?D`F& zQQVAn>oBOz1k#SUEb)Ms%ck31(-{;JZ|nxqD7sP4eFlw}gWPV!z{(80aMz(I-0P^z zbcTkL>o$Pseg-xs21W)x%zh$hG8tqu=mrMpjyBLywc6*(S59YW*jUHgkAJkD0X)}> zVZwui#&3OdDKUZJ(X2BOpfxA6L}om$$D8EwRA~J5GlixxIP6OY(${R9Sw z(~elD4mlV^nLx+PfzBKT%^Zg~dOHS#nsE>QziORhH=W^tOU=QZm@Bc6Yduh_5v1RQ zft4lFF&Ny$$eS*FdO4^BKX)8NqZB@<3u>5H8N|U3H)CL9@^ymT5&57d#a4CgbcO>- zHI~p;Cw#OHyk-V@yp5ef5^Mly($XmsGUB#?ZNC4}OH&yZ9HlYWVu>hU@&%mM{3!?G)0o23-=?6K%)yF3obdD_SDjWu3l98P=7>sqNGdyr^ zIH3U<_CvEDIS@e&J&=B524*Hm%E@x}YV4TK&=4pT1ft<*z6*eElR}F_P*V@28x($S z&?tEDCM=I@@pJ}-9U4bW2wXn_T7L-AZ_L2NW(3*-BjDxW!8x6Q!A5s_uM43D2xu4) zq#M-g^YDZpGoE0x;$O(3=?n{W?_bSn#~*y4Rv*X+P|pW?%=m%>SL{I3&J2fS51C?i zEX0_E7$8Shn?R2lcUT@QQ<^xHA))^vm?n_sK+PtQm7q~-Pv}wM3X`KlzfPUb;IKRA z<5fb#+@OXN$N=z2FZdMH2In31H&a1J7q9&if`9QP0|U|kAet#(*Q|DwA<`7+&I*c5 zz*07X$H72`g3>eSlmHKKK!K)-N7wLheLB=D(?!o=Z z?SF))F(?RjcYtV=?2gu60&5>7MnhmU1V%$(fI=YLf+3oriv_ZilYs%e10$LNv_p=C z!O;)2ZfZfy#=D0nns=yf3s7d3cFCQoN@u$I#X(I_P|nhC57@?b}RPNokD1>JzE@cW8{fm4yf~S%y7l06*Of7(h3@w^l%LVFB@dA{_*GU^63l-$M`}TQ7^`3F-l-Hu^3=e|D_`DZ^tVf#pM;n9zEnfpUz=DB;!3lJzIe6(` zL+#bg0shk&9-N=(cTw3S5RxZkQ5E?|EkDt=6NfZF09BS5=6TpfKtP5A}u zAKMjzHUYgY5jl*1Ooxe|K?Cd!&;T=d6`#Vx#F)s&=?o1mtu1q&q67j)JP0so!Zfph zN0%M6YKkq^PG@k?(^KB$4R$*$1Ti!VGZ=z3gAzfIyAN1D!_%bevq9Tw. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vms94a/bulletin/cmds.mai b/decus/vms94a/bulletin/cmds.mai deleted file mode 100644 index 1340739..0000000 --- a/decus/vms94a/bulletin/cmds.mai +++ /dev/null @@ -1,22 +0,0 @@ -The address for getting BULLETIN is BULLETIN@PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file - (only one file per command). - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - -BULLETIN is also available via ANONYMOUS FTP from PFC.MIT.EDU, but the account -is set at low priority, so I suggest using it during non-prime hours. - - Mark diff --git a/decus/vms94a/bulletin/copyright.txt b/decus/vms94a/bulletin/copyright.txt deleted file mode 100644 index ee33a7e..0000000 --- a/decus/vms94a/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vms94a/bulletin/create.com b/decus/vms94a/bulletin/create.com deleted file mode 100644 index 983ae41..0000000 --- a/decus/vms94a/bulletin/create.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vms94a/bulletin/handout.txt b/decus/vms94a/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vms94a/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vms94a/bulletin/install.com b/decus/vms94a/bulletin/install.com deleted file mode 100644 index 758acd4..0000000 --- a/decus/vms94a/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vms94a/bulletin/instruct.com b/decus/vms94a/bulletin/instruct.com deleted file mode 100644 index a9cf299..0000000 --- a/decus/vms94a/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vms94a/bulletin/instruct.txt b/decus/vms94a/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vms94a/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vms94a/bulletin/login.com b/decus/vms94a/bulletin/login.com deleted file mode 100644 index e4302af..0000000 --- a/decus/vms94a/bulletin/login.com +++ /dev/null @@ -1,28 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vms94a/bulletin/master.com b/decus/vms94a/bulletin/master.com deleted file mode 100644 index f1c5834..0000000 --- a/decus/vms94a/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel:C -$ !I -$ run pmdf_root:[exe]ftcp_master -$ goto out1l -$ ! -$ CN_channel:i -$ !s -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277M -$ !L -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master( -$ goto out1_ -$ !+ -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vms94a/bulletin/mx.com b/decus/vms94a/bulletin/mx.com deleted file mode 100644 index 7d87c28..0000000 --- a/decus/vms94a/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */L - - } - } - } - rms_get(&rcptrab); /* Read next recipient */e - }u - - - /* Close the RMS files */r - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab);f - - tracemsg("BULLETIN message processed");y - exit(SS$_NORMAL); /* Always return success */ - -}L -$eod t -$copy/log sys$input MX_BULL.TXTm -$deckM - MX_BULL_ - An MX SITE transport. - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution:- - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN?h ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site.t - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including theS -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands:n - - SEND ALL Sends all bulletin files.. - SEND filename Sends the specified file.e - BUGS Sends a list of the latest bug fixes.D - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. Thei -build procedure for MX_BULL expects the logical BULL_SOURCE to point to theo -BULLETIN library. You must define this logical (or edit the .COM file)m -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct):L - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>"* - -3. If you don't have a SITE transport already defined, simply copyu - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULLe - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin deliveringc -messages to BULLETIN.t - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail tod -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETINm -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL) - MAIL> SENDU - To: MX%"GENERAL@BULLETIN" - Subj: This is a test....a - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITEu -agent, since the @BULLETIN path was defined as a SITE path.f - -To facilitate the automatic delivery of messages to BULLETIN folders, youi -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN"""/ - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN"""t - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to/ -BULLETIN via MX_BULL.d - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST ..../ - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.)u - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder.M - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwardingm -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When maild -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the messagee -to the Local agent, which discovers that the mail is forwarded tos -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUEf - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The; -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logicalf -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return addressr -for BULLETIN messages will look something like the following:t - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM:s - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayedW -to death, leaving a bad address on the "From:" line. This frequently happensa -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by:b - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnety - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226s - Western Kentucky University - Bowling Green, KY 42101 -$eod t -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$decka -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headersb -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1.u -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3i -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"?( -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file/ -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it upn -$ close tmp !...t -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr;s -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:"b -$ endifb -$ exit 1 !Always return success -$eod N diff --git a/decus/vms94a/bulletin/mx.mai b/decus/vms94a/bulletin/mx.mai deleted file mode 100644 index ec864aa..0000000 --- a/decus/vms94a/bulletin/mx.mai +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_LIBRARY") .eqs. "" -$ then say "BULL_LIBRARY logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_library/LIB,SYS$SYSTEM:SYS.STB/SEL,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_LIBRARY to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P4 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P4 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P4 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p4 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p2' 'p3' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p2' 'p3' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vms94a/bulletin/news.com b/decus/vms94a/bulletin/news.com deleted file mode 100644 index fb7775e..0000000 --- a/decus/vms94a/bulletin/news.com +++ /dev/null @@ -1,679 +0,0 @@ -$set nover -$copy/log sys$input NEWS.ALT -$deck - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales -$eod -$copy/log sys$input NEWS.CREATE -$deck -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - -$eod -$copy/log sys$input NEWS.MODERATORS -$deck -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com -$eod diff --git a/decus/vms94a/bulletin/news.create b/decus/vms94a/bulletin/news.create deleted file mode 100644 index dc1c840..0000000 --- a/decus/vms94a/bulletin/news.create +++ /dev/null @@ -1,155 +0,0 @@ -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - diff --git a/decus/vms94a/bulletin/news.moderators b/decus/vms94a/bulletin/news.moderators deleted file mode 100644 index b53780f..0000000 --- a/decus/vms94a/bulletin/news.moderators +++ /dev/null @@ -1,260 +0,0 @@ -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com diff --git a/decus/vms94a/bulletin/news.txt b/decus/vms94a/bulletin/news.txt deleted file mode 100644 index 09bfc38..0000000 --- a/decus/vms94a/bulletin/news.txt +++ /dev/null @@ -1,159 +0,0 @@ -BULLETIN has the capability to read and post messages to USENET NEWS in a -client mode. News groups can also be stored on disk. Selected groups or set -of groups which are commonly read can be selected to be stored, thus making -reading of such groups much faster than having to access them over a network. -Note that since the number of groups is well over 2000 makes it unreasonable -at most sites to store them all. - -BULLETIN (actually BULLCP) can act as as a gateway between decnet and tcp for -NEWS, which allows decnet nodes without tcp access to be able to access a tcp -news server. This method does not require spawning any processes, since the -detached process BULLCP is always present, so the access is very fast. - -Since BULLETIN uses a shared database to store info on the NEWS groups and -periodically updates it, there is no need for that to be done when a user -accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. - -It is also possible to feed NEWS groups into a "real" BULLETIN folder. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. - -The instructions for installation are as follows. Define BULL_NEWS_SERVER to -be a system logical name pointing to either your internet or decnet NEWS node. -If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -If you have a cluster where one node is an internet node, and the rest -non-internet nodes, you'll have to create a startup procedure that defines -BULL_NEWS_SERVER to be the internet news server address only on the node (or -nodes) on the cluster that have actually internet access. The other nodes -will have BULL_NEWS_SERVER defined as the decnet node name that BULLCP is -running on in the cluster. (Of course, BULLCP will have to be running on a -node with internet access.) - -NOTE: If you want to disable the DECNET gateway feature, then before starting -BULLCP, define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -If you want to enable the TCP gateway, you must define BULL_TCP_NEWS_GATEWAY -(NOTE: This presently only works with MULTINET, and you must have UCX -emulation enabled, i.e. enable UCXQIO from the SCU and do a SET -LOAD-UCX-DRIVER TRUE from the NCU.) - - $ DEFINE/SYSTEM BULL_TCP_NEWS_GATEWAY "TRUE" - -BULL_TCP_NEWS_GATEWAY can be defined to point to a file name which contains ip -names that are allowed access. The file should contain real ip names. Blank -lines and comments (preceded by #) are allowed. If you want a whole domain to -be allowed, specify the domain preceded by a ., i.e. .pfc.mit.edu . - -You can also specify that BULLCP is ONLY to act oas a NEWS gateway. This -is to allow adding the news gateway to an site that you have DECNET access to, -but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. BULLCP will update NEWS every hour. If you -want to change this frequency, define the logical name BULL_NEWS_UPDATE to the -number of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" -for 30 minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does -the update. You can watch how long it takes for this to run in order to -determine if you want to change the update period). If you ever want to force -NEWS to be updated, simply restart BULLCP. - -It is suggested that you run OPTIMIZE_RMS.COM on BULLNEWS.DAT, as it will cause -the file to be compressed and will allow updates to run much faster (factor of -5 or more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -News groups can be specified as being stored on disk via the SET NEWS command. -See the online help for more info. After converting such groups, when BULLCP -wakes up, it will start the storing process. This can take a long time if you -have a lot of groups. An index file pointing to the stored messages is created -and called BULL_DIR:BULLNEWSDIR.DAT. After the storage process is complete you -should consider running OPTIMIZE_RMS.COM on it (and anytime after you convert a -sizable amount of groups). - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) - -BULLETIN is set up so that when a person replies to a message and extract the -original message into the reply message, it uses the idention string "->" for -the extracted text. The reason for this rather than ">" is that some news -servers won't allow messages which have more extracted text than new text and -test for ">". If you want to change that, then change the default strings for -all the INDENT qualifier line in the file BULLCOM.CLD before compiling. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to FTP.UU.NET -via ANONYMOUS FTP and look through the directory uumap or uunet-sites to find a -USENET node near you to contact. diff --git a/decus/vms94a/bulletin/nonsystem.txt b/decus/vms94a/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vms94a/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vms94a/bulletin/optimize_rms.com b/decus/vms94a/bulletin/optimize_rms.com deleted file mode 100644 index fc0b91d..0000000 --- a/decus/vms94a/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = P4 -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vms94a/bulletin/pmdf.com b/decus/vms94a/bulletin/pmdf.com deleted file mode 100644 index 85c77b1..0000000 --- a/decus/vms94a/bulletin/pmdf.com +++ /dev/null @@ -1,1031 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input BULLETIN_MASTER.PAS_V32i -$deck' -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound);; - -(*******************************************************************)a -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *) -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - - outbound : text; - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL - 100; - - VAR - line, errorsto : vstring; - bigline : bigvstring; result : rp_bufstruct; - header : he_header; - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string); - - BEGIN (* try_something *) - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *) - end; (* try_something *) - - BEGIN (* return_bad_messages *) - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt'); - try_something (he_read_header (header, qu_rtxt), 'he_read_header'); - errorsto.length := 0; - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i]; - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto), - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr); - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *) - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages (tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable. - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT - -For V3.2: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check your -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vms94a/bulletin/restart.com b/decus/vms94a/bulletin/restart.com deleted file mode 100644 index 502bfa8..0000000 --- a/decus/vms94a/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vms94a/bulletin/setuser.mar b/decus/vms94a/bulletin/setuser.mar deleted file mode 100644 index 153cb7b..0000000 --- a/decus/vms94a/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vms94a/bulletin/update.fil b/decus/vms94a/bulletin/update.fil deleted file mode 100644 index e7332c3..0000000 --- a/decus/vms94a/bulletin/update.fil +++ /dev/null @@ -1,7 +0,0 @@ -$ IF P2 .EQS. "" THEN COPY 'P1' [ANONYMOUS.BULLETIN] -$ COPY 'P1' [.SEND] -$ TAB2SP 'P1' -$ RENAME 'P1' [-.NET] -$ PUR [.SEND]'p1' -$ PUR [-.NET]'p1' -$ PUR [ANONYMOUS.BULLETIN]'p1' diff --git a/decus/vms94a/bulletin/upgrade.com b/decus/vms94a/bulletin/upgrade.com deleted file mode 100644 index a2d77c4..0000000 --- a/decus/vms94a/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vms94a/bulletin/writemsg.txt b/decus/vms94a/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vms94a/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vms94b/bulletin/aaareadme.txt b/decus/vms94b/bulletin/aaareadme.txt deleted file mode 100644 index db559f3..0000000 --- a/decus/vms94b/bulletin/aaareadme.txt +++ /dev/null @@ -1,89 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:26:10.99 -To: EVERHART -CC: -Subj: BULLETIN utility. - -Date: Fri, 19 Aug 1994 17:25:33 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172533.21438991@PFC.MIT.EDU> -Subject: BULLETIN utility. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -If you are running a version of BULLETIN older than 2.11, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. NOTE: -Problems can occur if the old version of BULLETIN is run after the -data files have been modified. Such a situation is possible on a -cluster where each node has installed the executable separately. To -help installation, a new command procedure UPGRADE.COM has been -included. Read the comments in the file for information on how to use -it. - -As of V2.0, BULLETIN is able to read USENET NEWS via TCP/IP using either -CMU, MULTINET, UCX, TWG, or via DECNET. It can also serve as a NEWS -gateway for DECNET nodes without direct access to the NEWS server, i.e. a -DECNET node without Internet access will be able to read NEWS. - -NOTE: The following commands can be sent to BULLETIN@PFC.MIT.EDU: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. (This does not describe the NEWS reader -feature, however.) - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -You will be receiving 22 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) BULLETIN10.FOR - 13) BULLETIN11.FOR - 14) ALLMACS.MAR - 15) BULLCOMS1.HLP - 16) BULLCOMS2.HLP - 17) BULLET1.COM - 18) BULLET2.COM - 19) PMDF.COM - 20) MX.COM - 21) NEWS.COM - 22) ALLMACS_AXP.MAR - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. However, this only applies -to PMDF V3.2 or earlier, as later versions of PMDF have the necessary -interface code for BULLETIN included in it. In that case, or in case -you don't have PMDF, you can delete it. The same applies to MX. Then, -read AAAREADME.TXT for BULLETN installation instructions. If you are -using the news feature, NEWS.COM contains files which pertain to news. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@NERUS.PFC.MIT.EDU diff --git a/decus/vms94b/bulletin/allmacs.mar b/decus/vms94b/bulletin/allmacs.mar deleted file mode 100644 index e75d05f..0000000 --- a/decus/vms94b/bulletin/allmacs.mar +++ /dev/null @@ -1,323 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:28:09.72 -To: EVERHART -CC: -Subj: ALLMACS.MAR - -Date: Fri, 19 Aug 1994 17:26:07 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172607.21438991@PFC.MIT.EDU> -Subject: ALLMACS.MAR - -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID stringM - MOVL IDENT(AP), R8E - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCIIT - - $ASCTIM_S - - TIMBUF=@TIME(AP), -N - TIMADR=IHI$Q_LINKTIME(R7): - - RET - -.END diff --git a/decus/vms94b/bulletin/allmacs_axp.mar b/decus/vms94b/bulletin/allmacs_axp.mar deleted file mode 100644 index 83f5ad7..0000000 --- a/decus/vms94b/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,323 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:28:28.47 -To: EVERHART -CC: -Subj: ALLMACS_AXP.MAR - -Date: Fri, 19 Aug 1994 17:26:08 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172608.21438991@PFC.MIT.EDU> -Subject: ALLMACS_AXP.MAR - -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R81 - MOVC5 R0, (R7), #32, -j - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIMEL - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCIIu - - $ASCTIM_S - - TIMBUF=@TIME(AP), -S - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vms94b/bulletin/bullcoms1.hlp b/decus/vms94b/bulletin/bullcoms1.hlp deleted file mode 100644 index 9db7073..0000000 --- a/decus/vms94b/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1126 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:33:28.71 -To: EVERHART -CC: -Subj: BULLCOMS1.HLP - -Date: Fri, 19 Aug 1994 17:26:10 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172610.21438991@PFC.MIT.EDU> -Subject: BULLCOMS1.HLP - -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with -> at the beginning of each line. This can be -suppressed or the indentation character changed with /[NO]INDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message.P -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commandr -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages havee -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed.. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen theT -message to be notified of it a second time. You can select qualifiers sol -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file cang -be specified which contains the text. If the editor is used for changing -the text, the old message text will be extracted. This can be suppressedf -by the qualifier /NEW. - - Format:b - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expirationo -date and message headers can be changed if this qualifier is specified.i -2 /EDITa - /[NO]EDIT -Determines whether or not the editor is invoked to edit the messageX -you are replacing. The old message text is read into the editor unlessE -a file-name or /NEW is specified. /EDIT is the default if you have: -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time]d - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description.c -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totallye -new text is to be read in. -2 /NUMBERp - /NUMBER=message_number[-message_number1]e - -Specifies the message or messages to be replaced. If this qualifier is m -omitted, the message that is presently being read will be replaced.. -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent.a -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computerF -shutdown. This option is restricted to SYSTEM folders.O -2 /SUBJECT - /SUBJECT=descriptione - -Specifies the subject of the message to be added.f -2 /SYSTEMo -Specifies that the message is to be made a SYSTEM message. This is ao -privileged command and is restricted to SYSTEM folders. -2 /TEXTt -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format:n - - COPY folder-name [message_number][-message_number1]d - -The folder-name is the name of the folder to which the message is to bei -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder.m -2 /GROUPSh - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message toa -the specified NEWS group(s) in addition to the selected NEWS group.A -2 /HEADERa - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied.i -The default is /NOHEADER.L -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINALa -Specifies that the owner of the copied message will be the original ownerg -of the message. The default is that the copied message will be owned by -the person copying the message.. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM.f - - Format:o - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYSr -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read.s -2 /ADD_ONLYp -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to thex -folder, they will also be mailed to the address. Users are preventedd -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF foru -more information.) -2 /DESCRIPTION - /DESCRIPTION=descriptionP - -Specifies the description of the folder, which is displayed using theP -SHOW FOLDER command. If omitted, you are prompted for a description.I - -If this folder is to receive messages from a network mailing listm -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTe -commands, the address of the mailing list should be included in theo -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST - -If a mailer protocol is needs to be added to the network address inA -order for it to be sent by VMS MAIL, i.e. protocol%"address", the -appropriate protocol can be specified by either hardcoding it into the -file BULLNEWS.INC before compiling BULLETIN, or by defining the system -logical name BULL_NEWS_MAILER (it is the same protocol used by the NEWSp -feature in order to respond to NEWS messages). The default protocol ist -IN%. If desired, you can specify the protocol with the address, i.e. - - INFOVAX MAILING LIST t -2 /IDe -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presentlye -assigned to it. Any process which has that identifier assigned to itA -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. The -identifier can not be any longer than 12 characters. - -Note: This feature will not work during remote access to the folder. -2 /NODEe - /NODE=node - -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually storedt -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, then -folder will then be modified to point to that folder. For example ifi -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be sharedt -between more than one node. This capability is only present if the BULLCPa -process is running on the remote node via the BULL/STARTUP command.e -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information ise -only updated every 15 minutes (same algorithm for updating BBOARDs -messages), or if a user accesses that folder. Thus, if the folder isl -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the usery -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes.e -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder.d -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID.e -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have beenm -granted access via the SET ACCESS command. Note: This option uses ACLst -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAMEi - /REMOTENAME=foldernamel -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name.s -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only withR -respect to adding or modifying messages. All users can read the folder. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.s -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. Ifr -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data fileS -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENTs -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format:E - - CURRENTE -2 /EDITB -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message.e -2 /HEADERu - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEi -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the currente -message is deleted. Only the original owner or a privileged user canE -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want thet -message deleted immediately, use the /IMMEDIATE qualifier. - - Format:t - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It isd -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot beo -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This willC -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk.i -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...])c - -Specifies to delete the message at the listed DECNET nodes. The BULLETINI -utility must be installed properly on the other nodes. You can specifyt -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on them -other nodes. The /SUBJECT must be specified to identify the specificg -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subjects - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message. -It can be a substring of the subject. This is in case you have forgottena -the exact subject that was specified. Case is not critical either.t -You will be notified if the deletion was successful. -See also /NEGATED. -2 /USERNAMEh -Specifies username to be used at remote DECNET nodes when deleting messagesu -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORYf -Lists a summary of the messages. The message number, submitter's name,a -date, and subject of each message is displayed.d - - Format:t - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message.o -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description ofs -folder. -2 /EXPIRATIONf -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the -DIRECTORY command are to be written into the specified file. Allt -qualifiers which are valid for the EXTRACT command are valid in -conjunction with /EXTRACT except for /NEW which conflicts with the T -DIRECTORY /NEW qualifier. The listof messages to be printed will be -displayed on the terminal (in nopaging format). -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS. -2 /FROM - /FROM=[string]d - -Specifies that only messages whose username contains the specified string -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.t -See also /NEGATED. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don't -match the specified search command are displayed.o -2 /MARKEDt -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see allr -messages, use either /ALL, or reselect the folder. e -2 /UNMARKEDr -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be ableo -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEENo -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlye -seen messages will be shown and be able to be read. To see allO -messages, use either /ALL, or reselect the folder. . -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to beW -read. To see all messages, use either /ALL, or reselect the folder. . -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWSe -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED. -2 /SEARCH - /SEARCH=[string] - -Specifies that only messages which contain the specified string arew -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.o -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.a -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDEE -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings. - - Format: - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. e - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE. -2 /FROM[ -Specifies to exclude the message based on the message owner. This isf -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROMe -and /SUBJECT cannot be specified at the same time. p -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):stringl - -In order for /FULL to be the default for a folder, the following linee -must be present: - -folder_name:defaults:killd - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program.t -1 EXTRACTe -Synonym for FILE command.e -1 FILE -Copies the current message to the named file. If the file exists, the -message is appended to the file, unless the /NEW qualifier is specified. s - - Format: - FILE [filename] [message_number][-message_number1],[...] - -If the filename is omitted, a file will be created based on the name of -the folder. - -A range of messages to be copied can optionally be specified, i.e. FILE -2-5. The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. a - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. -2 /ALL -Copies all the messages in the current folder. -2 /FFe -Specifies that a form feed is placed between messages in the file. -2 /HEADERu - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 FIRSTh -Specifies that the first message in the folder is to be read.e -1 FORWARDe -Synonym for MAIL command.i -1 Folders -All messages are divided into separate folders. New folders can beg -created by any user. As an example, the following creates a folder fory -GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder.o -GAMESe - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that -user will be alerted of topics of new messages at login time, and will E -then be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option,a -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command.l - -A folder can be restricted to only certain users, if desired. This is f -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATEa -rather than /PRIVATE is specified, all users can read the messages in thed -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote DECNETE -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)p -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM// -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, ands -giving access to that UIC group. Only users in that UIC group will seee -the messages in that folder when they log in.i -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INCLUDEe -Specifies to include reading messages based on the message owner or the -subject. If it is determined that a message is to be included, then the -message is read when a user tries to read a message by typing NEXT or -BACK, or by hitting the return key. Otherwise, it is skipped. Specify -the qualifier /FULL to make all EXCLUDEs and INCLUDEs for the specified -folder apply to all other BULLETIN commands, including directory -listings. - - Format: - INCLUDE [string] - -If a string is specified, then the message is included if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one INCLUDE may be -specified per folder. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all INCLUDEs. -2 /DISABLE -Specifies to permanently disable the INCLUDE.o -2 /FROM -Specifies to include the message based on the message owner. This isr -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. -2 /SUBJECT -Specifies to include the message based on the message subject. /FROM -and /SUBJECT cannot be specified at the same time. i -2 Storing_INCLUDEs -INCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):stringE - -In order for /FULL to be the default for a folder, the following linet -must be present: - -folder_name:defaults:killd - -excluding the folder_name causes it to apply to all folders. -1 INDEXh -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for i -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after onel -has read a message. /RESTART must be specified to start from the firstm -folder if a scan is in progress. All other qualifiers are ignored while h -a scan is in progress. - - Format:t - INDEX - -When a directory is displayed, you can read the first message in the -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for olderf -versions of BULLETIN.o -2 /MARKEDT -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED, -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKEDB -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the foldere -with /UNMARKED, i.e. only unmarked messages will be shown and be ables -to be read.U -2 /SEEND -Lists messages that have been seen (indicated by a greater than sign). e -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlyl -seen messages will be shown and be able to be read.e -2 /UNSEENF -Lists messages that have not been seen (seen message are indicated by ao -greater than sign). Using /UNSEEN is equivalent to selecting the folderi -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read.o -2 /NEW - /[NO]NEWt - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message. -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified.L -2 /RESTART -If specified, causes the listing to be reinitialized and start from thei -first folder.m -2 /SET - /[NO]SETU - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format:s - LASTo -2 /EDITo -Specifies that the editor is to be used to read the message. This iss -useful for scanning a long message.s -2 /HEADERe - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command. -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format:a - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying ant -address that has quotes, in order to pass the quotes you must specifyh -triple quotes. I.e. a network address of the form xxx%"address" musti -be specified as xxx%"""address""". -2 /EDITi -Specifies that the editor is to be used to edit the message before -mailing it.V -2 /HEADERw - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the f -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks (").r - -If you omit this qualifier, the description of the message will be useds -as the subject.r -1 MARK -Sets the current or message-id message as marked. Marked messages arer -displayed with an asterisk in the left hand column of the directoryo -listing. A marked message can serve as a reminder of importantS -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers]i - UNMARK [message-number or numbers] - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to bym -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGINS -will be used. -1 MODIFY -Modifies the database information for the current folder. Only the -owner of the folder or a user with privileges can use this command. - - Format:p - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted forn -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing listn -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTi -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST ] -2 /IDa -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presentlyB -assigned to it. Any process which has that identifier assigned to ite -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAMEU - /NAME=foldernamep - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not havel -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID. -1 MOVE -Moves a message to another folder and deletes it from the current -folder.g - - Format:c - - MOVE folder-name [message_number][-message_number1]a - -The folder-name is the name of the folder to which the message is to ben -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,a -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPSo - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message toe -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER, - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied.n -The default is /NOHEADER.E -2 /MERGE -Specifies that the original date and time of the moved messages ares -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned byt -the person moving the message. -1 NEWS -Displays the list of available news groups.i - -Format:l - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed.g - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL willa -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /DEFAULT -If specified, will show news groups that have be defined as default -groups using the SET SUBSCRIBE command., -2 /NEWGROUPO -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /PERMANENT -If specified, will show news groups that have be defined as permanent -groups using the SET SUBSCRIBE command.S -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B.- -2 /STORED- -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. -2 /EDIT -Specifies that the editor is to be used to read the message. This isR -useful for scanning a long message. -2 /HEADERF - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commande -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEl -Specifies to decode the message using ROT-13 coding. diff --git a/decus/vms94b/bulletin/bullcoms2.hlp b/decus/vms94b/bulletin/bullcoms2.hlp deleted file mode 100644 index 6e9b9fd..0000000 --- a/decus/vms94b/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1402 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:40:22.45 -To: EVERHART -CC: -Subj: BULLCOMS2.HLP - -Date: Fri, 19 Aug 1994 17:26:12 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172612.21438991@PFC.MIT.EDU> -Subject: BULLCOMS2.HLP - -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with -> at the -beginning of each line. This can be suppressed or the indentation -character changed with /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message -to the specified NEWS group(s) in addition to the selected NEWS group. -Logical names are allowed. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. -In order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply -surround the exclusive text starting with the line "START " -and ending with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The file created by the PRINT command is not -released to the print queue until you exit, unless you add the qualifier -/NOW or change one of the print job's qualifiers. Multiple messages are -concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL level -to find out the name of the mounted form and the default form for a -particular queue. If you specify a form whose stock is different from -the stock of the form mounted on the queue, your job is placed in a -pending state until the stock of the mounted form of the queue is set -equal to the stock of the form associated with the job. (In order to -have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the file -or files have been printed. If /NONOTIFY is specified, there is no -notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. If you -specify a number greater than the number of messages in the folder, the -last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -/HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by aC -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be- -read. To see all messages, use either /ALL, or reselect the folder. O -2 /UNSEENW -Specifies to read only messages that have not been seen (seen messager -are indicated by a greater than sign). Using /UNSEEN is equivalent toc -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. e -2 /NEW -Specifies to read the first unread message.o -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than onet -screenful at a time, and that have a remote printer that can then prints -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specifiedc -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format:d - REMOVE folder-name -1 REPLYe -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /INDENT and /EXTRACT. - - Format:p - REPLY [file-name]l -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT.e -2 /INDENTn - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier.o -1 RESPONDc -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply maila -message to the owner of the currently read message.d - - Format:T - RESPOND [file-name]n - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed ine -place of MAIL, and the parameters passed to it are the username and subjectr -of the message. -2 /CCr - /CC=user[s] -Specifies additional users that should receive the reply.d -2 /EDITl -Specifies that the editor is to be used for creating the reply mailr -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT.f -2 /GROUPST - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group.i - -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected and /LIST is present. Specifiese -to send the message to the specified NEWS group(s) in addition to theu -selected NEWS group. -2 /LISTd -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /INDENTe - /[NO]INDENT=stringR - -See /EXTRACT for information on this qualifier.s -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information.I -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of moret -than one word, enclose the text in quotation marks (").A - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ".w -1 RESET -Resets the new message counter for the selected folder or news group.u -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read.h - - Format:F - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read them. -(Note: Reading the last message does the same thing, but RESET does it -without having to read it.)k -1 QUIT -Exits the BULLETIN program.s -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text strings.s - - Format: - - SEARCH search-string[,...] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description -header. If a no search string is specified, a search is made using the -previously specified string, starting with the message following the one -you are currently reading (or have just read). Once started, a search -can be aborted by typing a CTRL-C. -2 /EDITO -Specifies that the editor is to be used for reading the message. -2 /FOLDERN - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for a -match. If, during a search, no more matches or messages are found, the -next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. -2 /FROMi -Specifies that only the username of the messages are to be searched. -2 /MATCH - /MATCH[=option] - -Interprets and matches multiple search strings in one of the following -ways: - - AND A match occurs only if all of the strings are found. - - OR A match occurs if any of the strings are found.u - - XOR A match occurs if only one of the strings is found.t - -If you specify none of these options, the default is /MATCH=OR. If you -specify the /NEGATED qualifier, you will get the negated operation. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:).l -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the laste -message. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched.u -1 SEEN -Sets the current or message-id message as seen. This allows you to keepd -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directorya -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers]h - UNSEEN [message-number or numbers]s - -Keeping track of seen messages requires very little overhead for NEWSt -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable thet -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEENa -command again. T - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't cared -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to bye -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGINs -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created.m - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.)e - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command.l -2 /MARKEDt -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKEDB -Specifies to read only messages that have not been marked (markedh -messages are indicated by an asterisk). p - -After using, in order to see all messages, the folder will have -to be reselected.e -2 /SEENc -Specifies to read only messages that have been seen (indicated by ac -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected.x -2 /UNSEENs -Specifies to read only messages that have not been seen (seen messagev -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected.e -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format:E - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format:r - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster.e - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" .s -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format:/ - - SET ACCESS /ALL [folder-name]h -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warningn -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUSa -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name. - - Format:R - - SET [NO]ANONYMOUSf -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. - - Format: - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If a -mailing address is present (see /DESCRIPTION), when messages are added -to the folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be -used if the POST command is entered. One use for this is a local boardm -which is also distributed to non-local users. E - - Format:g - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format:r - - SET BBOARD [username]R - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages.e - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30" -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The forms -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY.. -The time will always be 00:00, even if the time is specified on the line.y -3 /EXPIRATIONa - /EXPIRATION=daysi - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature.e -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be:h - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account.l - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV.s -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION.j -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa).s - - Format:o - - SET [NO]BRIEFl -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newc -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernamea - -Specifies the folder for which the option is to modified. If notl -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by they -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier.t -2 COMPRESS -Specifies that messages added to the folder will be in compressed format.t -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires e -very little cpu overhead.r - - Format:s - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. r -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed everyi -time when logging in, until the new messages are read. Normally, ther -BRIEF setting causes notification only at the first time that new messages -are detected.S - - Format:O - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for thee -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges.O - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used.d - - Format: - - SET DEFAULT_EXPIRE daysI - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages.h - - Format:i - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format:B - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it. -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format:d - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) a -2 EXCLUDEd -Specifies to ignore any EXCLUDEs or INCLUDEs that are present. - - Format:A - - SET [NO]EXCLUDEo - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or INCLUDEs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 FILE_DIRECTORY -Select the directory where messages are written to when using the -EXTRACT or file COMMAND. By default, the message is written into the -current directory. t - - Format:l - - SET FILE_DIRECTORY [directory] - -If directory is omitted, the setting is removed. Note: This information -is stored in the customization file (SYS$LOGIN:BULL.CUSTOM). -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information.i - - Format: - - SET FOLDER [node-name::][folder-name]e -3 /MARKEDc -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will haveo -to be reselected.D -2 GENERICa -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -3 /DAYS - /DAYS=number_of_dayst - -Specifies the number days that new messages will be displayed for upon -logging in. -2 KEYPAD m -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format:T - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to byo -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command.W - - Format:R - - SET [NO]LOGIN username -2 NAME -Copies all stored settings from one user to another. Used when a user's -account name is changed. - - Format: - - SET NAME old-username new-username -2 NEWS -Changes attributes of the specified news group or class of news groups.e -This command requires privileges.O - - Format: - - SET NEWS [news-group]w - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALLt - /NOALLE - -If specified with /CLASS or /DEFAULT, all groups that are presentlyu -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of anyi -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the defaulto -attributes (using /DEFAULT) with /NOALL, the attributes for misc.testr -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. -3 /CLASS - /CLASS=classname - -Specifies to modify attributes for a class of news groups rather than at -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes ofs -existing groups which are in the class are modified, and any groupst -created in the future will automatically have those attributes.e -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETEU -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLEo -Specifies that the news group is enabled and can be accessed. This isp -the default. -3 /EXPIRATIONn - /EXPIRATION=dayse - -Specifies the default expiration time for messages if none is specified. -The default is 7.q -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified isa --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default. -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is postedr -every month with an expiration date of one month in the future. -3 /PRIVATE - /PRIVATEg - /NOPRIVATEd - -Specifies that the news group or class can have it's access modified by, -the SET ACCESS command. To accomplish this, a file is created ine -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access a -to news groups in that class is to set /NOPRIVATE, as then time won't be -wasted checking a file for ACLs. -3 /STOREDC - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessedb -via the network from the server node. This results in faster access,b -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED. -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder.E - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node, -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated.L -3 /FOLDER - /FOLDER=foldernameN - -Specifies the folder for which the node information is to modified.. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format:t - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are logged. -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared.p -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for) -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newU -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERs - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If notr -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENTm - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier.o -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN.e - - Format:E - - SET [NO]PAGE -2 POST_ONLY -Specifies that the selected folder has the POST_ONLY attribute. Thisf -causes the ADD command to mail the message to the mailing address if ite -is present (see /DESCRIPTION), rather than add to the folder. m - - Format: - - SET [NO]POST_ONLY -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format:t - - SET PRIVILEGES parameterst - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers.e -3 /IDn - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.d -2 PROMPT_EXPIREO -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format:o - - SET [NO]PROMPT_EXPIRE -2 READNEWa -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command.v - - Format: - - SET [NO]READNEWS - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder).l -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newo -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERt - /FOLDER=foldernamet - -Specifies the folder for which the option is to modified. If notd -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENTe - -Specifies that READNEW is a permanent flag and cannot be changed by thee -individual. This is a privileged qualifier. -2 SHOWNEWe -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN.t - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format:g - - SET [NO]SHOWNEWr -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newV -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernamee - -Specifies the folder for which the option is to modified. If noth -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged qualifier. -2 STRIPa -Affect only messages which are added via either the BBOARD option, orf -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped offo -before it is stored as a BULLETIN message. - - Format: - - SET [NO]STRIP, - -The command SHOW FOLDER/FULL will show if STRIP has been set.l -2 SUBSCRIBEo -Can be used to force users to be subscribed to the selected news group. -This is a privileged command.l - - Format: - - SET SUBSCRIBEe - -Note: If you execute the commands SET SHOWNEW, READNEW, BRIEF, or NOTIFY, -and add /DEFAULT or /PERMAMENT, it is equivalent to doing a SET SUBSCRIBEn -command with the addition that the specified feature will be the default -and/or permanent setting.n -3 /ALL -Specifies that all present and future users will be subscribed to the news -group. -3 /DEFAULT - /[NO]DEFAULTw - -Specifies that new users will automatically be subscribed to the news group. -3 /PERMANENT - /[NO]PERMANENTg - -Specifies that new users will automatically be subscribed to the news groupg -and that users cannot unsubscribe the news group. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM foldera -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a/ -privileged command. - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.o -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for theL -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected viat -the SELECT command, information about that folder is shown.T - - Format: - - SHOW FOLDER [folder-name]h -3 /FULLe -Control whether all information of the folder is displayed. Thish -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder.o -2 KEYPAD -Displays the keypad command definitions. - - Format:f - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either the SET KEYPAD COMMAND, ore -if /KEYPAD is specified on the command line, the keypad keys will be -defined as commands. The default settings for the keypad are shown viah -SHOW KEYPAD or HELP KEYPAD. Settings can be changed by using an -initialization file with DEFINE/KEY commands. BULLETIN looks first form -the file pointed to by the logical name BULL_INIT and then for the fileg -SYS$LOGIN:BULL.INI.P - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT).f -3 /STATE - /STATE=(state,state,...) - -Specifies the name of a state for which the specified key definitionsm -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when T -a key name has been specified. -2 NEWm -Shows folders which have new unread messages for which BRIEF or READNEWe -have been set. (Note: If you enter BULLETIN but do not read new unreadR -messages, you will not be notified about them the next time you enterr -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format:P - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this.i -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGIN - -Specifies that only those users which do not have NOLOGIN set are to bel -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDERl - /FOLDER=[foldername]n - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups., -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSIONe -Shows the version of BULLETIN and the date that the executable was -linked.s -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBEi -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of the -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. d -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format:n - UNDELETE [message-number]l -1 UNSUBSCRIBEc -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See the -SUBSCRIBE command for further info. -1 Usenet_newst -BULLETIN can also read USENET NEWS if your system has network access to -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of U -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group iny -order to keep track of which messages you have read in that group. Most -of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read news groups with new messages, use INDEX/SUBSCRIBE. E -1 New_features -Here is a list of new features which may be of interest to the general d -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - -------------------------------------------------------------------------- -V 2.20 - -Logical names can be specified in POST/GROUPS=. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/11/94 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93w - -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93a - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group by -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92 - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92L - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 diff --git a/decus/vms94b/bulletin/bullet1.com b/decus/vms94b/bulletin/bullet1.com deleted file mode 100644 index 70f8f38..0000000 --- a/decus/vms94b/bulletin/bullet1.com +++ /dev/null @@ -1,2480 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 18:01:27.65 -To: EVERHART -CC: -Subj: BULLET1.COM - -Date: Fri, 19 Aug 1994 17:26:15 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172615.21438991@PFC.MIT.EDU> -Subject: BULLET1.COM - -$set nover -$copy/log sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running,9 - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. d - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. u - s - If you want to have more than one database, you can do so by redefining e - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster.e - E - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, orn - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COMu - This procedure adds 2 permanent messages which give a very briefo - description about the BULLETIN utility, and how to turn off optionalm - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARDM - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits themi - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you wantN - to have several different special procedure, you should name the commande - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions.T - -8) MASTER.COMa - If you are using PMDF, and want to use the BBOARD option, a set ofs - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for howe - to do this. - -9) OPTIMIZE_RMS.COMo - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed.o - - If you use the NEWS feature, it is suggest that you run this procedureo - on BULLNEWS.DAT after it is created. Compressing that file greatly speedsf - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (ori - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT.a -$eod m -$copy/log sys$input BULLDIR.INCo -$deckt - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIMe - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIMEH - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIPn - CHARACTER*12 FROM - LOGICAL SYSTEMl - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATEt - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIMEg - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY)$ - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER)e - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY)h - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256o - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH)i - - PARAMETER NEWSDIR_RECORD_LENGTH = 180 - - COMMON /NEWS_DIR/ NEWS_MSG_KEY,NEWS_MSG_BTIM_KEY,NEWS_MSGID - & ,NEWS_EX_BTIM_KEY,NEWS_POST_BTIM,NEWS_BLOCK,NEWS_LENGTHt - & ,NEWS_DESCRIP,NEWS_FROMt - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEYa - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUMp - & ,NEWS_NBULL - CHARACTER*64 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROMa - CHARACTER*8 NEWS_MSG_KEY,NEWS_HEADER_KEYt - - CHARACTER*12 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*12 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_KEY,NEWSDIR_ENTRY)a - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADERE - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER)T -$eod -$copy/log sys$input BULLETIN.HLP -$deckh -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that newI -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command]C - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS.E -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals).o - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added.h - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands.h -2 /EDITh -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keyse -correspond to BULLETIN commands. The default is /KEYPAD.i -2 /PAGEe - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory.U -2 /PGFLQUOTA - /PGFLQUOTA=pagesm - -Used if you want to specify the page file quota for the BULLCP process.a -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETINX -is aware that it is running on another node. (On the local node whereT -BULLCP is running, this logical name is automatically defined.) -2 /STOPT -Stops the BULLCP process without restarting a new one. (See /STARTUPW -for information on the BULLCP process.)A -2 /SYSTEME - /SYSTEM=[days]1 - -Displays system messages that have been recently added. The default isD -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages thatA -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed beforeH -the terminal type is known, and the default width is larger than what theT -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENTP - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process._ -$eod M -$copy/log sys$input BULLETIN.LNK -$deck, -$ ULIB = "NONE"I -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNETG -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET) -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINKL -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL-D - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHAREA -ID="V2.19" -$ EXIT -$ALINK:d -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPTa -ID="V2.20" -$eod . -$copy/log sys$input BULLFILES.INCt -$deckI -Ce -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -CT -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED.o -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY,s -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SUREv -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR")i -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORYl - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORYy - COMMON /FILES/ BULLNEWSDIR_FILE,BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -Cg -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME.c -Cn - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login timea - ! & folder flag settingse - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder datan - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of lastb - ! read messages of usersh - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data - CHARACTER*80 BULLNEWSDIR_FILE /'BULLNEWSDIR.DAT'/ - ! Directory listing for LOCAL news groupsh -Cs -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY.m -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILLo -C BE STORED IN THOSE SUBDIRECTORIES.l -CE - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ -$eod i -$copy/log sys$input BULLFOLDER.INC -$decku -!a -! The following 2 parameters can be modified if desired before compilation. -!o - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days thatx - ! BBOARDS can be set to.r - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING.c - PARAMETER ADDID = .TRUE. ! Allows users who are not in thee - ! rights data base to be addeda - ! according to uic number.s - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)'o - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE,e - & FOLDER_OWNER,a - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE,t - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT,t - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST,e - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2)g - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SETa - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/H - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COMd - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE,e - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST,V - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAMEl - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12t - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4q - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER,a - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST,n - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END m - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44m - CHARACTER NEWS_FOLDER_DESCRIP*36. - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COMt - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT,C - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT,P - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_ENDd - INTEGER NEWS_F1_NEWEST_BTIM(2)n - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) -$eod e -$copy/log sys$input BULLNEWS.INC -$decko - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILERd - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/T - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ -$eod E -$copy/log sys$input BULLUSER.INC -$decka -!B -! The parameter FOLDER_MAX should be changed to increase the maximum numbers -! of folders available. Due to storage via longwords, the maximum numberr -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -!p - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16a - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)'n - PARAMETER USER_HEADER_KEY = ' 'c - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEFs - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12w - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG)t - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2)w - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC dayst - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for foldero - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast( - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX)F - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DATD - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX)_ - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)), - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DATd - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX)O - INTEGER*2 INF_REC2(4,FOLDER_MAX)A - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod ( -$copy/log sys$input BULL_NEWS.CD -$deckH -#include T -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h"S -#include "multinet_root:[multinet.include.netinet]in.h"P -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet);L - -static struct dns {D - unsigned char function; - unsigned char call_code;R - short zeros;B - short length; - char string[512]; -} buf1, buf2;I - -struct sockaddr_un {F - short sun_family; /* AF_UNIX */L - char sun_path[109]; /* path name (gag) */F -}; -#else_ - -#if UCXI - -#include - -struct sockaddr {W - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8];R - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2];B -static struct sockaddr local_host, remote_host;R -struct itlist lhst_adrs, rhst_adrs;C - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff;g - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#elseo - -#if TWG - -#include -#include ! -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet);d - -#elseA - -#define CMU 1S -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip);n - -#endif - -#endif - -#endif - -static char task[20];I -$DESCRIPTOR(task_d,task);R - -static int s;P - -static struct iosb { - short status; - short size; - int info; -} iosb;L - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN())i -#elser -#ifdef VAXCe -#define va_count(n) vaxc$va_count(&n). -extern int vaxc$va_count();I -#else! -#define va_count(n) decc$va_count(&n) -extern int decc$va_count();P -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1)i -{o - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255];e - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]);L - va_start(ap, arg1);1 - arglist[1] = *arg1;o - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } elseE - return(0);I - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length);R - }E -#if TWGI - sin.sin_port = htons(119);w -#elseN - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connectionC - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#elset -#if UCXe - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_namec - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor commandL - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm};E - struct dsc$descriptor host_adM - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb;M - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0,r - &command,&host_name,&retlen,&host_ad,0,0) & 1)N - || !(nam_iosb.status & 1)) {T - sys$dassgn(s); - return(0);E - }N - } -#else, - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1);L -}I - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan;R -{( -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb;O - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0);o - - /*w - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET," - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /*l - * Create a "sockaddr_in" structure which describes the port wel - * want to listen to. Address INADDR_ANY means we will accepta - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /*n - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0,D - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan);g - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections_ - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5,m - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#elsec - return(0);r -#endif -}t - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{v -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast,) - 0,0,0,0,0,0,0) & 1)) {i - sys$dassgn(*listen_chan);k - return(0); - } - - return(1);e -#endif -}i - u -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb;t -{c -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128];e - char *cp, *h; - int s;2 - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1;s - - /*{ - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to usT - * a new channel to the connection. We could now closeA - * down the original socket if we didn't want to handle - * more connections.T - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0);n - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1)P - || !(accept_iosb->status & 1)) return(0);c - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */E - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX,] - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1))( - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} r - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */i - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr)));N - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1)L - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2,o - sizeof(buf2),0,0,0,0) & 1)l - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0;C - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++);; - if (*cp == '\n' || *cp == '#') continue;s - if (!strcmp(buf2.string,cp)) return (1);p - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp);1 - - return (0); -#endif -}l - -news_socket()( -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWGu - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) {t - sys$dassgn(s); - return(0); - } -#endif -#if UCXc - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET;T - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host;r - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) {1 - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0,E - UCX$C_DSC_ALL,0,0);u - sys$dassgn(s); - return(0); - } -#endif - - return(1);t -}* - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{t - if (mode == DECNET) return (1); - -#if MULTINET || TWGn - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0);* -#elseP -#if UCXi - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET;( - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host;0 - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0);t -#elsec - return(-1); -#endif -#endif - - return(1); -}s - -news_create()/ -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWGL - - /*. - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok).U - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) {e - sys$dassgn(s); - return(0); - } -#elsee -#if UCX - remote_host.inet_family = INET$C_AF_INET;f - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff;) - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1)f - || !(iosb.status & 1)) {& - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0,T - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#elsee - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1);h -}, - -news_create_bullcp(efn,biosb,astadr,astprm)f -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG) - - /*; - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#elsee -#if UCXo - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119);s - remote_host.inet_adrs = addr_buff;u - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#elseF - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1);t -}M - -news_connect() -{S - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0);R - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf;N -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMUy - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer,a - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#elset - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer,h - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1);s -}a - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{f -#if CMUt - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf,o - *len,0,!mode,0,0) & 1)) return(0);0 -#else| - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0);t -#endif - - return(1);t -} - -news_read_packet(buf)w -struct dsc$descriptor_s *buf;r -{ - static int n,len; - - len = buf->dsc$w_length;s - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n);a -}d - -news_gethostname(buf)s - -struct dsc$descriptor_s *buf;a -{p - if (mode == DECNET) return (-1);0 -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length));o -#elsec - return(-1); -#endif -#endif -}a -$eod e -$copy/log sys$input CHANGES.TXT -$decke -V 2.20 - -The FILE command no longer requires a file name, but will create a file5 -name from the folder's name. 5/25/94s - -Allow logical names to be specified in POST/GROUP. 5/12/94; - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94o - -Fix FROM header for news groups messages that have an address which continuess -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93* - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93S - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93( - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93g - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93t - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93f - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory duringg -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93E - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80.a -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93k - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93C - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/931 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/930 - -Fixed bug which caused only partial storage of specified local news groups.m -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged| -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93N - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to deletep -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/931 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92, - -Fixed problem with reply posting to stored news group not posting to propers -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups.f -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92d - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92o - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news( -groups to be stored on disk for quicker access by users (rather than being ) -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show allc -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show onlyo -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default._ -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWASTO -state. 11/5/92t - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92, - 0 -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA! -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13l -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92b - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92r - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used0 -if the POST command is entered. One use for this is a local board which ise -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92c - -Fixed several shutdown bugs. 7/23/92r - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. n -Bit 0 set = need privileges to create folder, 1 set = captive account cani -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only E -directories that are defined in the list of equivalence names pointed to byE -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92g - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92w - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92d - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91e - -Fixed bug with creation of folder files. If they were deleted after the foldero -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91e - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91e - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91n - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91d - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive,F -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91a - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit oute -of the edit, rather than exitting (i.e. outputting a file). 10/21/91. - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. u -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED tol -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing tof -indicate which messages have been SEEN. 7/31/91 N - -Added /NOW to PRINT command. Messages no longer have to be printed one messagef -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will bes -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91I - -Added /PRINT to DIRECTORY command to allow printing of messages which are foundd -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large newst -group names. 7/31/910 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that ther -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which areg -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more thanl -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page,O -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and then -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 . - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91n - -Added code to alert user if message too large to be fully broadcasted. 5/24/91. - -Added code to avoid erroneous notifications of new messages for an empty NEWSr -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91s - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in whichc -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (viaa -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actuallyE -read. 4/29/91 d - -Added capability of controlling the time between updates for BBOARD and NEWS inr -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/919 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91S - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribedh -news group folders. 4/25/91n - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the formerU -for real folders, the latter for news groups). 4/11/91t - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override thea -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for thee -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway softwarem -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet)._ - -Changed BBOARD algorithm so that it is now possible to have only one realo -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups.d - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DATV -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously,E -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. / - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS.o - -Added signature file for POST and RESPOND messages.l - -Added capability to specify file name for POST, REPLY, and RESPOND.d - -Added the line "In a previous message, wrote:" to theo -beginning of a message when /EXTRACT is specifiede - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and ith -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by ai -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages inn -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder whiche -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL.i - -V 1.91 - -Disallow SPAWN command for CAPTIVE account.n - -Fix MAIL command to correctly allow passing addresses with quotes, i.e.f -IN%"""MRL@NERUS.PFC.MIT.EDU""".i - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the messaged -was broadcasted when added using ADD/BROADCAST.m - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages.a - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used.e - -BULLETIN now will use the editor specified by the SET EDITOR command withine -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time.s - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typingo -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only thet -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has beenF -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has beend -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessingf -a remote node via /NODES (it would have required looking a the sources to find,e -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the commandr -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start wheren -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for theW -BULLCP process.t - -Added ATTACH command.s - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts withf -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It ifi -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out ofW -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searchingo -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETINg -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this isi -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is ai -remote system folder, when BULLETIN/LOGIN was executed, the same messages mightS -be displayed on both the local and remote nodes. BULLETIN now will know thato -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executinge -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect isn -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder.I - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF wass -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages.y - -A major bug was fixed which was introduced in previous mods to speed upe -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. -$eod o -$copy/log sys$input COPYRIGHT.TXTE -$deckD -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. Byi -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. n - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR1 -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESSs -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associatedc -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. -$eod o -$copy/log sys$input HANDOUT.TXTt -$deckd - Introduction to BULLETIN on the Vax - 2/88 AWo - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT.o - - The BULLETIN utility permits a user to create messages foru -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messagess -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of texte -written by a user or staff person and added to a particulare -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject linet -and the text of the message. BULLETIN will prompt the user ford -these things when a message is being added.e - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, ito -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to eachn -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Foldersi - - Different folders have been created to contain messages onF -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post toh -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the publicl - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as:b -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers.b -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 andw -Prolog journalsh -watch for new ones being added.s - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL,a -for short) at the '$' prompt. BULLETIN will display its prompti -'BULLETIN>'. Help is available from DCL command level ($) or fromd -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which foldersn -exist, the directory/folders command is used. for example: -typing:s - - BULLETIN> directory/folders - -will make a display like:i - - Folder Owner - *GENERAL SYSTEMR - *PUBLIC_ANNOUNCEMENTS BBEYERO - NETMONTH BITNETs - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread( -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all availablet -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the followinge -command would show what a user would do to switch to the folder0 -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTSa - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this foldert -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORYs -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquiredE -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, ito -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond:e - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message.....e - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently beingt -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff.f - - If the user sees something which he/she wants a copy of,i -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current messagec -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will bel -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ********e - -A person could then type -BULLETIN> extracts -file: FV.TXT: -BULLETIN>s - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'.a - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user cani -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message toT -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC byF -following the instructions in the handout 'Transferring filesT -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message usinga -the VAX editor or uploading a message from your PC (seer -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subjecto -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may alsoe -use the EDT text editor by issuing the command with thee -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTSt -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULDi -EXPIRE: ENTER ABsolute TIME: l - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The messagen -will be deleted automatically on the 20th of July as requested -by the user adding the message.i - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when newt -messages are in a folder, he should use the 'READNEW' option.A -This command does not force the reader to reading new messages,, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set toc -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTSt -folder has been set to PUBLIC_ANNOUNCEMENTST -BULLETIN> SET READNEWr - -Alternately, you may type SET SHOWNEW. This will just display ad -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send,l -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too.t - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod C -$copy/log sys$input INSTRUCT.TXT -$decke -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayedT -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can bel -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). h -$eod -$copy/log sys$input NEWS.TXT -$decky -BULLETIN has the capability to read and post messages to USENET NEWS in a -client mode. News groups can also be stored on disk. Selected groups or set -of groups which are commonly read can be selected to be stored, thus making -reading of such groups much faster than having to access them over a network. -Note that since the number of groups is well over 2000 makes it unreasonable -at most sites to store them all. c - -BULLETIN (actually BULLCP) can act as as a gateway between decnet and tcp for -NEWS, which allows decnet nodes without tcp access to be able to access a tcp -news server. This method does not require spawning any processes, since the -detached process BULLCP is always present, so the access is very fast. - -Since BULLETIN uses a shared database to store info on the NEWS groups and -periodically updates it, there is no need for that to be done when a user -accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. - -It is also possible to feed NEWS groups into a "real" BULLETIN folder. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. - -The instructions for installation are as follows. Define BULL_NEWS_SERVER to -be a system logical name pointing to either your internet or decnet NEWS node. -If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -If you have a cluster where one node is an internet node, and the rest -non-internet nodes, you'll have to create a startup procedure that defines -BULL_NEWS_SERVER to be the internet news server address only on the node (or -nodes) on the cluster that have actually internet access. The other nodes -will have BULL_NEWS_SERVER defined as the decnet node name that BULLCP is -running on in the cluster. (Of course, BULLCP will have to be running on a -node with internet access.)d - -NOTE: If you want to disable the DECNET gateway feature, then before starting -BULLCP, define the logical name: P - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -If you want to enable the TCP gateway, you must define BULL_TCP_NEWS_GATEWAY -(NOTE: This presently only works with MULTINET, and you must have UCX -emulation enabled, i.e. enable UCXQIO from the SCU and do a SET -LOAD-UCX-DRIVER TRUE from the NCU.) Where this feature is useful is to allow -an ip node access to a news server which it does not have permission to do soe -directly. - - $ DEFINE/SYSTEM BULL_TCP_NEWS_GATEWAY "TRUE"x - -BULL_TCP_NEWS_GATEWAY can be defined to point to a file name which contains ip -names that are allowed access. The file should contain real ip names. Blank -lines and comments (preceded by #) are allowed. If you want a whole domain to -be allowed, specify the domain preceded by a ., i.e. .pfc.mit.edu . - -You can also specify that BULLCP is ONLY to act as a NEWS gateway. Thish -is to allow adding the news gateway to an site that you have DECNET access to, -but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME,t -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), butd -you are accessing NEWS via DECNET, you can specify the hostname as follows:h - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address"e - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node.e - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message.d -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by definingt -the system logical name BULL_NEWS_ORGANIZATION.u - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining theo -system logical name BULL_NEWS_MAILER.. - -After installing the new BULLETIN, execute the command NEWS, which asks for al -list of all the news groups. Because this is the first time it is executed, ite -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. BULLCP will update NEWS every hour. If you -want to change this frequency, define the logical name BULL_NEWS_UPDATE to the -number of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" -for 30 minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does -the update. You can watch how long it takes for this to run in order to -determine if you want to change the update period). If you ever want to force -NEWS to be updated, simply restart BULLCP. - -It is suggested that you run OPTIMIZE_RMS.COM on BULLNEWS.DAT, as it will causea -the file to be compressed and will allow updates to run much faster (factor of -5 or more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will causei -subscribed users to be subscribed to the wrong news groups.e - -WARNING: One user discovered that his server (using bnews?) had a bug whichm -caused the updates to cause bogus "new messages" notifications for subscribedo -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will causeP -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute.W - -News groups can be specified as being stored on disk via the SET NEWS command. -See the online help for more info. After converting such groups, when BULLCPs -wakes up, it will start the storing process. This can take a long time if you -have a lot of groups. An index file pointing to the stored messages is createdt -and called BULL_DIR:BULLNEWSDIR.DAT. After the storage process is complete you -should consider running OPTIMIZE_RMS.COM on it (and anytime after you convert ar -sizable amount of groups). - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surroundedc -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".)e - -BULLETIN is set up so that when a person replies to a message and extract the -original message into the reply message, it uses the idention string "->" for -the extracted text. The reason for this rather than ">" is that some news -servers won't allow messages which have more extracted text than new text and -test for ">". If you want to change that, then change the default strings for -all the INDENT qualifier line in the file BULLCOM.CLD before compiling. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS readere -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the numberb -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no officials -way of doing so. However, one suggestion was to try connecting to FTP.UU.NET -via ANONYMOUS FTP and look through the directory uumap or uunet-sites to find a -USENET node near you to contact. -$eod s -$copy/log sys$input NONSYSTEM.TXTu -$deckr -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but onlyn -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in thise -manner, the bulletins can optionally be written to a file. If you have thes -subdirectory [.BULL] created, BULLETIN will use that directory as the defaultn -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEWo -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages.n -$eod c -$copy/log sys$input WRITEMSG.TXT -$decks -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoidb -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be writtenP -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead.e - -Call INIT_MESSAGE_ADD to initiate a message addition.l -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -Co -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found.e -Cl - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message.e -Cl - - CALL FINISH_MESSAGE_ADD -Ce -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/vms94b/bulletin/bullet2.com b/decus/vms94b/bulletin/bullet2.com deleted file mode 100644 index 02d8b11..0000000 --- a/decus/vms94b/bulletin/bullet2.com +++ /dev/null @@ -1,1613 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:34:56.82 -To: EVERHART -CC: -Subj: BULLET2.COM - -Date: Fri, 19 Aug 1994 17:26:20 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172620.21438991@PFC.MIT.EDU> -Subject: BULLET2.COM - -$set nover -$copy/log sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy/log sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy/log sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 5/25/94 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGEN - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)T - QUALIFIER ALLL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUEC - QUALIFIER GENERAL, NONNEGATABLE. - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUEp - QUALIFIER SYSTEM,NONNEGATABLEo - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBERs - DISALLOW NEW AND NOT EDITi - DISALLOW SYSTEM AND GENERALl - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATIONf - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADERP - DEFINE VERB COPYT - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder"" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALLE - QUALIFIER MERGEL - QUALIFIER ORIGINAL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE- - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE- - QUALIFIER ID, NONNEGATABLE -!" -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -!. - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED)O - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLEE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLET - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED)S - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLEu - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE)0 - DISALLOW ID AND NOT OWNER- - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETEE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LOCALh - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER)t - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHESs - KEYWORD AND - KEYWORD OR0 - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDERd - QUALIFIER ALLl - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLEe - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLEa - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED)E - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER HEADER, DEFAULT! - QUALIFIER NEWa - QUALIFIER PRINTa - QUALIFIER HEADER, DEFAULTr - QUALIFIER NOTIFY, DEFAULTy - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLEM - QUALIFIER FORM, VALUE, NONNEGATABLEO - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW- - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLEt - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)O - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLEa - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLEi - QUALIFIER NEGATED_ - DISALLOW NEGATED AND E - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY)U - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES)E - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES)= - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN)E - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWSM - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLEr - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBEn - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDERG - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT0 - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command.F - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command.) - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST)r - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLER - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILEj - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALLT - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE: - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients"m - VALUE(REQUIRED,IMPCAT,LIST)T - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULTg - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALLn - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECTE - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDERI - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLEN - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLEE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLEE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULTU - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBEE - QUALIFIER DEFAULTG - QUALIFIER PERMANENTT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLEO - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE, - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST= - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients"L - VALUE(REQUIRED,IMPCAT,LIST)F - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULTE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARKL - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFYU - QUALIFIER DESCRIPTIONN - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED)C - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVEA - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder", - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGEE - QUALIFIER NODESS - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODESI - DEFINE VERB NEWSH - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBES - QUALIFIER DEFAULT) - QUALIFIER PERMANENT - QUALIFIER NEWGROUPSF - QUALIFIER ALLL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STOREDD - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STOREDU - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE)E - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLEB - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXTE - QUALIFIER EDIT, NEGATABLEd - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POSTc - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)N - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUEN - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULTA - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURET - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST)N - QUALIFIER HEADER, DEFAULTM - QUALIFIER NOTIFY, DEFAULT1 - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOWO - QUALIFIER ALLL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUITW - DEFINE VERB READW - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALLI - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEWE - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)R - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)Y - QUALIFIER ALL, NONNEGATABLED - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLEE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLEB - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE, - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)L - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST,DEFAULT - QUALIFIER LOCALF - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE, - QUALIFIER PERMANENT, NONNEGATABLEL - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUEL - DISALLOW PERMANENT AND SHUTDOWNL - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE, - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE), - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)N - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUEU - QUALIFIER EXTRACTE - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATUREE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCHA - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) A - QUALIFIER EDIT - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)I - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REPLY, NONNEGATABLER - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REVERSE) - QUALIFIER FROM - QUALIFIER SUBJECTE - QUALIFIER NEGATED - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW SEARCH_STRING AND REPLY - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDERN - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"D - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODEF - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIREI - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERICC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGINM - KEYWORD NOLOGIN, SYNTAX=SET_LOGINJ - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARDT - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGST - KEYWORD BRIEF, SYNTAX=SET_FLAGSU - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGSL - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGSN - KEYWORD READNEW, SYNTAX=SET_FLAGSI - KEYWORD ACCESS, SYNTAX=SET_ACCESSN - KEYWORD NOACCESS, SYNTAX=SET_NOACCESSC - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGESE - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRED - KEYWORD NOPROMPT_EXPIREE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIREU - KEYWORD STRIP, - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLYA - KEYWORD NOPOST_ONLYL - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUSA - KEYWORD NOANONYMOUSF - KEYWORD EXCLUDEA - KEYWORD NOEXCLUDEE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBEL - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - DEFINE SYNTAX SET_FILE_DIRECTORYN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"L - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAMEN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"R - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODEL - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED)E - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED)R - DEFINE SYNTAX SET_NONODEE - QUALIFIER FOLDER, VALUE(REQUIRED)A - DEFINE SYNTAX SET_EXPIREN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"U - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED)s - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What") - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED)B - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT) - QUALIFIER NODEFAULT, NONNEGATABLEN - QUALIFIER ALL, NONNEGATABLEA - QUALIFIER PERMANENTd - QUALIFIER NOPERMANENT, NONNEGATABLE2 - QUALIFIER FOLDER, VALUE(REQUIRED)F - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"F - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLEA - QUALIFIER PERMANENTO - QUALIFIER NOPERMANENT, NONNEGATABLEA - QUALIFIER ALL, NONNEGATABLEU - QUALIFIER FOLDER, VALUE(REQUIRED)G - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"R - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT) - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENTE - QUALIFIER NOPERMANENT, NONNEGATABLEI - QUALIFIER ALL, NONNEGATABLEO - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT)U - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER)F - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLEE - QUALIFIER VMSMAIL, NONNEGATABLEU - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDERF - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"I - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER= - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESSB - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"= - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDERT - QUALIFIER ALL, NONNEGATABLEN - QUALIFIER CLASS, NONNEGATABLEL - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLYL - DEFINE SYNTAX SET_NEWSE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"A - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDERR - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED)N - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE B - QUALIFIER DISABLE, NONNEGATABLEP - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER), - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, D - TYPE=$NUMBER) - QUALIFIER PRIVATET - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE), - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"L - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLEA - QUALIFIER ALL, NONNEGATABLE_ - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"L - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST)L - DEFINE SYNTAX SET_DEFAULT_EXPIREO - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW, - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)C -!A -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER.E -! Otherwise, the CLI routines will reject the command, because itF -! first attempts to process the qualifier before process the parameter,A -! so it has no information the qualifiers are valid. -!S - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLEA - QUALIFIER ALL, SYNTAX=SHOW_USERD - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USERI - QUALIFIER LOGIN, SYNTAX=SHOW_USERE - QUALIFIER NOLOGIN, SYNTAX=SHOW_USERA - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGSD - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSIONT - DEFINE SYNTAX SHOW_FLAGSN - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)N - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)T - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINTD - DISALLOW PRINT AND SHOW_KEYR - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)S - QUALIFIER PRINT,DEFAULTR - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)O - PARAMETER P2, LABEL=SHOW_FOLDER_ - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)E - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALLN - QUALIFIER FOLDER, VALUE= - QUALIFIER LOGINR - QUALIFIER NOLOGINA - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAMEA - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULTA - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)O - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARKE - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETEI - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEENE - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE -$eod N -$copy/log sys$input BULLETIN.CLD -$deckE -!R -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table.= -! The alternative is to define a symbol to execute BULLETIN.O -! Either way will work, and it is up to the user's to decide whichA -! method to work. (If you don't know which, you probably should use2 -! the default symbol method.) -!S - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN" - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string)= - Qualifier ALLQ - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required)L - Qualifier EDIT - Qualifier KEYPAD, Defaultt - Qualifier LOGINE - Qualifier MARKED - Qualifier PAGE, DefaultE - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), DefaultN - Qualifier READNEWD - Qualifier REVERSE - !N - ! The following line causes a line to be outputted separating system notices.R - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired oneA - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!)A - !E - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUPE - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7")1 - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required)A - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP -$eod -$copy/log sys$input BULLMAIN.CLD -$deckI - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIND - PARAMETER P1, LABEL=SELECT_FOLDERP - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED)= - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LOGINA - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULTM - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEWA - QUALIFIER REVERSEA -!W -! The following line causes a line to be outputted separating system notices.U -! The line consists of a line of all "-"s, i.e.: -!--------------------------------------------------------------------------P -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!)A -!P - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULTD - QUALIFIER STARTUPR - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED)Y - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP -$eod C -$copy/log sys$input BULLSTART.COMM -$deckN -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXITE -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod P -$copy/log sys$input BULL_NEWSDUMMY.FOR -$deckL - INTEGER FUNCTION NEWS_ASSIGN()T - - NEWS_ASSIGN = 0 - - RETURNN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURNR - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L)F - - NEWS_SOCKET_BULLCP = 0 - - RETURN1 - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L)P - - NEWS_CREATE_BULLCP = 0 - - RETURNC - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N)F - - NEWS_WRITE_PACKET_BULLCP = 0E - - RETURNN - END - - - SUBROUTINE NEWS_DISCONNECTG - - RETURNI - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE.F - - RETURNS - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF)F - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0, - - RETURNL - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF)I - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0G - - RETURNU - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0R - - RETURNF - END -$eod U -$copy/log sys$input CREATE.COM -$deckI -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION"( -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO"W -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETINS -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10= -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOMl -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTIO -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTIH -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],-E - TWG$TCP:[NETDIST.INCLUDE.SYS],-O - TWG$TCP:[NETDIST.INCLUDE.VMS],-W - TWG$TCP:[NETDIST.INCLUDE.NETINET],-Y - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY= -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI:R -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK, -$UCX:= -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINKT -$CMU:N -$ CC'CCQ' BULL_NEWS -$ GOTO LINK1 -$DUMMY:H -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature."L -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN-I - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;*F -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL= -$ LIBRARY BULL *.OBJ;a -$ DELETE *.OBJ;* -$ @BULLETIN.LNKT -$eod -$copy/log sys$input INSTALL.COMN -$deckX -$ IF F$TRN("BULL_DIR") .EQS. ""E -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory."E -$ EXIT -$ ENDIFA -$ COPY BULLETIN.EXE BULL_DIR:E -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines andE -$! define the logical name BULL_HELP to be the help library directory, i.e.R -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY]= -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot.L -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN -$eod S -$copy/log sys$input INSTRUCT.COM -$deckL -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod b -$copy/log sys$input MAKEFILE.t -$deck -# Makefile for BULLETINo - e -Bulletin : Bulletin.Exe Bull.Hlb - o -Bulletin.Exe : Bull.Olbw - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel -i - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.20" $ - E -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \l - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.ExeD - u -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.Fors - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \- - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - r -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \n - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - ( -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \t - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - Y -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \l - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \t - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - D -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \F - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - U -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - = -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - i -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \- - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - p -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \b - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - n -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \L - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.ForA - = -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \P - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For( - X -Allmacs.Obj : Allmacs.marS - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cldU - Set Command /Obj Bullcom.CldL - I -Bullmain.Obj : Bullmain.cldR - Set Command /Obj Bullmain.Cld - S -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.HlbL -*.hlb :R - lib/help/cre $* -$eod _ -$copy/log sys$input OPTIMIZE_RMS.COM -$deckT -$ SET NOON -$ EXIT_STATUS = 1E -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1I -$ SPEC = F$SEARCH(FILENAME)C -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME")P -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDSC -$ WRITE SYS$OUTPUT "File not indexed"_ -$ GOTO GET_FILEE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT:F -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OKE -$! -$BATCH:E -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME)R -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292y -$ GOTO DONEE -$! -$FILE_EXISTS:= -$ NAME = F$PARSE(FILENAME,,,"NAME")1 -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN-_ - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed"D -$ EXIT_STATUS = 1000024, -$ GOTO DONEF -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OKI -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060T -$ GOTO DONEE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK")O -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC)X -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM"O -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT"/ -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT") -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERON -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO"G -$ ENDIF_ -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO"T -$ WRITE OUT "KC"K -$ WRITE OUT "NO"" -$ ENDIFT -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +-N - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILES -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC"U -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC"O -$ WRITE OUT "NO" -$ ENDIFN -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOPL -$! -$CLOSE_FILE: -$ WRITE OUT "E"V -$ CLOSE OUT" -$! -$ @'TEMP_FILEC -$ DELETE 'TEMP_FILE;*( -$ WRITE SYS$OUTPUT ""C -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONEU -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUSN -$eod F -$copy/log sys$input RESTART.COM) -$deck" -$ SET PROCESS/PRIVILEGE=ALLE -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALLS -DO DEASSIGN BULL_DISABLE/SYSTEMF -$ BULL/START -$eod -$copy/log sys$input SETUSER.MAR= -$deckR - .Title SETUSER -;E -; Program SetuserL -;I -; This program will change the username and UIC of the running process -;D -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -;d - .LIBRARY /SYS$LIBRARY:LIB.MLB/i - $PCBDEF ;define PCB offsetsm - $JIBDEF ;define JIB offsetsT - $UAFDEF ;define user authorization file offsetst -INFAB: $FAB FAC=GET - ;only gets on input fileU - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffixR - SHR= ;allow full sharing: -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this filei - ROP=NLK - ;don't lock read records_ - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of bufferR -BUFFER: .BLKB 2048 ;buffer for datas -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt stringF -COMMLDS:.WORD 0 ;space for number of bytes typed inE -FAODESC:.LONG 80 - .LONG FAOBUF/ -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1M - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0E -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12A -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME)a -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LISTt -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND ITe - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count1 - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear errore - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear errorl - $GET RAB=INRAB ;read a recordi - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok?i - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2)i - CLRL ITEND(R2)I - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format stringo - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group numberi - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytesI - P5=#OLDUSER,- ;address of old usernamer - P6=UAF$L_UIC+2(R7),- ;UIC, group number. - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get commandt - BLBC R0,ERROR ;low bit clear error -EXIT:I - $CLOSE FAB=INFAB - ;close file - ERR=ERROR. -ERROR: $EXIT_S R0 ;exit with error if anyB - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PIDr - MOVL PCB$L_UIC(R11),OLDUIC ;save old UICu - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old usernamea - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET U -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIBC - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit statusc - RET ;end of exec mode code - .END START ;end of program -$eod _ -$copy/log sys$input UPGRADE.COMS -$deckd -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and! -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should runE -$! the following procedure. R -$! -$! This is a sample upgrade procedure. You will have to modify referencesT -$! to the directory where the new executables are stored, which are markeda -$! with ***. You will also have to change the references to the proceduresE -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure! -$! with a parameter (i.e. @UPGRADE LINK), it will call those linkingF -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace theL -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient.T -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remoteT -$! folders, you can run restart.com immediately after upgrade.com ratherF -$! than waiting to install the new version on all nodes. Otherwise, youI -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALLN -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** N -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** L -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE")" -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;*" -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE")C -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;*O -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL" -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE"O -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! ***K -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLEL -$eod C diff --git a/decus/vms94b/bulletin/bulletin.for b/decus/vms94b/bulletin/bulletin.for deleted file mode 100644 index 657a2c1..0000000 --- a/decus/vms94b/bulletin/bulletin.for +++ /dev/null @@ -1,1940 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:38:46.19 -To: EVERHART -CC: -Subj: BULLETIN.FOR - -Date: Fri, 19 Aug 1994 17:25:35 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172535.21438991@PFC.MIT.EDU> -Subject: BULLETIN.FOR - -C -C BULLETIN.FOR, Version 8/10/94 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN3 - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P)r - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified?E - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN: - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')')o - CALL EXITd - END IFo - END IFr - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS) - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUMy - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THENi - CALL SHOW_SYSTEMl - END IF - END DO - END IFI - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder.$ -CD - - CALL OPEN_USERINFO - -CP -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -CM - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have beenU -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit.L -CA - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION' - - CALL OPEN_OLD_TAGN - - ELSE2 - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IFA - -C2 -C The MAIN loop for processing bulletin commands. -C - - DIR_COUNT = 0 ! # directory entry to continue bulletin read fromM - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder fromE - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN/ - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND.R - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THENL - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':'S - HLEN = HLEN + 1L - END IF - - LPROMPT = TRIM(COMMAND_PROMPT)S - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' 'T - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' '( - END IF_ - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN$ - IER = RMS$_EOFN - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ')U - INCMD = INCMD(2:IER), - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMDD - END IFD - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN' - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is noneN - LEN_P = 0 ! Indicate no parameter in commandE - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletine - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0c - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IFo - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has errorn - GO TO 100 ! ask for new command - END IF - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command.C - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1! - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THENt -C FOLDER_COUNT = -1I -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' 'e - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0D - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD'R - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL'n - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THENX - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (NEWS_FEED().OR.REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - WRITE (6,'('' ERROR: /FOLDER not valid when posting'',1 - & '' a message to a news group.'')') - ELSE - INCMD = 'POST '//INCMD(4:)C - IER = CLI$DCL_PARSEA - & (INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL RESPOND - END IF_ - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH?D - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THENU - WRITE(6,1060) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previousU - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE?A - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY?R - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE?F - CALL CREATE_FOLDER ! Go create the folderl - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning.B - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE?L - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all foldersi - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folderS - IF (IER) THEN ! If successfulS - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.) ! Copy bulletin to fileT - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR.d - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1E - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ)R - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP?C - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get helpt - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX?, - INDEX_COUNT = 1o - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'INCL') THEN ! INCLUDE? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1t - BULL_READ = 9999999L - CALL READ_MSG(READ_COUNT,BULL_READ)E - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAILR - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.)M - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders) - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT?_ - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL ADD - ELSEA - CALL RESPOND - END IFD - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)e - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified?e - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1N - CALL READ_MSG(READ_COUNT,BULL_READ)o - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY?E - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR.e - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLYt - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT)X - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER)_ - IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SET FOLDER?E - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'FI') THEN ! SET FILE_DIRECTORY?E - CALL SET_CUSTOM('file_directory')= - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIVN - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE.= - WRITE (6,'('' PAGE has been set.'')')O - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPADM - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD?N - CALL SET_NOKEYPAD_ - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')')O - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')')_ - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM?) - CALL SET_SYSTEM(.FALSE.)$ - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.)R - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD?( - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP')A - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP?n - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP')t - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST'). - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST?O - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS')e - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS?h - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS?G - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS')E - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS')0 - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY')K - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IFM - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY')' - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY')' - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY?S - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))o - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1)( - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE?D - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.)I - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE?c - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0)N - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))E - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1)L - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SH') THEN ! SET SHOWNEW?. - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))E - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1)f - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW?Y - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0)L - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))I - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW?Y - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')). - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF?A - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))Q - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')). - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0)e - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SU') THEN ! SET SUBSCRIBE? - IF (REMOTE_SET.GE.3) THEN - D1 = 0 - D2 = 0 - D3 = 0= - CALL SET_FOLDER_DEFAULT(D1,D2,D3) - ELSE - WRITE (6,'('' ERROR: Command invalid for folder.'')') D - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.)n - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEFu - CALL SET_BRIEF_CONTINUOUS(.TRUE.)E - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEFL - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC?: - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN?L - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS?T - CALL SET_NEWS - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE?( - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4)L - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE?) - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4)i - ELSE IF (BULL_PARAMETER(:4).EQ.'NAME') THEN ! SET NAME? - CALL SET_NEWNAMEN - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGSY - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDERA - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATIONI - FOLDER1 = SAVE_FOLDER' - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER)_ - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES?. - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER?L - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSIONL - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESSI - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBEI - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE. - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1)T - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN? - CALL TAG(.FALSE.,2)( - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE. - END IF - -100 CONTINUEO - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXITI - - END DOA - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more preceding messages.') - - END - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z)L - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURNE - - END - - - - - - SUBROUTINE ADDO -CN -C SUBROUTINE ADDF -CE -C FUNCTION: Adds bulletin to bulletin file. -CL - IMPLICIT INTEGER (A - Z)H - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10)E - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITO - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./( - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'. - - INCLUDE 'BULLFOLDER.INC'N - - COMMON /INDESCRIP/ INDESCRIPE - CHARACTER*(INPUT_LENGTH) INDESCRIPF - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8' - - CHARACTER INEXDATE*12,INEXTIME*12,INDENT*4Q - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8E - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THENL - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF_ - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT')_ - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IFC - - CALL DISABLE_CTRL ! Disable CTRL-Y & -CP - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THENW - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'i - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,L - & RECL=LINE_LENGTH,L - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED')A - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)? - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)R - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENT - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENR - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - LENI = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',INDENT,LENI)O - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LENI.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE_ - WRITE (3,'(A)') INDENT(:LENI)//INPUT(:ILEN)( - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IFO - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER)) - IF (.NOT.IER) GO TO 910) - SELECT_FOLDERS = .TRUE.L - ELSEO - NODE_NUM = 1 - NODES(1) = OLD_FOLDERS - END IF1 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THENN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',S - & READONLY,SHARED,ERR=920,FORM='FORMATTED')E - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED')N - IER = 0 - ICOUNT = 0N - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUTU - IF (IER.EQ.0) THENL - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1N - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DOS - CLOSE (UNIT=4) - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER)N - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesN - END IFU - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and$ - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910L - END IFE - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present?. - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910) - END IFE - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privilegesD - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abortm - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abortC - ELSE IF (CLI$PRESENT('CLUSTER')) THENA - SYSTEM = SYSTEM.OR.8T - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?. - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00'L - END IF - END IFG - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges3 - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abortO - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE)X - IF (IER.NE.%LOC(CLI$_ABSENT)) THENQ - IF (REMOTE_SET) THEN ! Can't specify node name ifE - WRITE (6,1090) ! remote folder, as no codeT - GO TO 910 ! present to send the name.I - END IFA - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE' - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)O - END IFU - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit. - INEXDATE = '5-NOV-2000' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60)P - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60)E - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE.. - IF (CLI$PRESENT('NODES')) THENF - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE.O - END IFD - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown E - IF (.NOT.IER) GO TO 910R - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23)E - END IF' - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY?O - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specifiedI - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF) - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -CD -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specifiedF - IF (LEN_P.EQ.0) THEN ! If no file param specifiedC - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',e - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3)/ - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')M - IF (CLI$PRESENT('EXTRACT')) THENU - CONTEXT = 0P - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THENA - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')U - END IF - END IF - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',N - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')R - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IFL - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35. - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count. - IF (ILEN.GT.LINE_LENGTH) GO TO 950I - ICOUNT = ICOUNT + 1 + MIN(ILEN,80)G - BLENGTH = BLENGTH + ILEN - 1 + 2/ - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line withD - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'G - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW',D - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counterE - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH) - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counterL - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch fileT - END IFE - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outE - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE. - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting.'', - & '' A truncated message will be broadcast.'')') - CALL GET_INPUT_PROMPT(INPUT,ILEN,E - & 'Type C to continue, A to only ADD message, or Q to Quit: ')F - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN, - BRDCST = .TRUE. - END IF - END IF - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THENQ - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST)H - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST'_ - IF (CLI$PRESENT('PERMANENT'))T - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT'R - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1' - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes, - INLINE = INLINE(:LEN_INLINE)E - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1)P - ! If not permanent or shutdown specify date, - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH)) - IF (IER.EQ.0) THEND - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN)S - END IFL - END DOL - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THENl - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE)D - WRITE (6,'(A)') INPUT(:80)& - GO TO 940 - END IF. - REWIND (UNIT=3) - END DO - END IFI - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95. - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IFY - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -Co -C Add bulletin to bulletin file and directory entry for to directory file. -Cn - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entryO - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! Username - END IFA - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THENE - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '// - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK)R - END IF! - IF (LENDES.GT.LEN(DESCRIP)) THENr - CALL STORE_BULL(LENDES+6,L - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK)C - END IFE - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletin - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1A - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IFD - - CALL ADD_ENTRY ! Add the new directory entryS - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF (FOLDER_NUMBER.GE.0) THENN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C: -C If user is adding message, an no new messages, update last read time forI -C folder, so user is not alerted of new message which is owned by user. -CX - IF (DIFF.GE.0) THENX - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)E - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)N - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add -C. -C Broadcast the bulletin if requested.. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THENE - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'),I - & CLI$PRESENT('CLUSTER')) - END IFE -CS -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP, -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same clusterm -C as that of the BULLCP node. -Ce - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET)I - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER'))l - END IFe - ELSE IF (.NOT.IER) THEN$ - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR.L - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THENL - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THENE - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1I - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL DISABLE_PRIVS - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT,I - & FOLDER(:TRIM(FOLDER))//' folder message: '//, - & INDESCRIP(:LENDES),STATUS) - CALL ENABLE_PRIVS - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')E - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IF - END IF - END DOO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9n - CLOSE (UNIT=I) - END DOu - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THENG - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER)& - END IF' - - IF (CLI$PRESENT('EXTRACT')) THEN= - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF) - - RETURNt - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100)g - GOTO 100 - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GOTO 100I - -930 WRITE (ERROR_UNIT,1025)n - CALL CLOSE_BULLFILC - CALL CLOSE_BULLDIRE - CLOSE (UNIT=3)i - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018)I - CLOSE (UNIT=3)I - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)T - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')U -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A)) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')F -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast' - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdownD - & if folder is remote.')I -2010 FORMAT(A) -2020 FORMAT(1X,A)M - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER)' - - IMPLICIT INTEGER (A-Z)N - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM)T - IF (.NOT.IER) RETURN1 - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1E - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN' - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'N - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2N - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8P - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*4D - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) I - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG) - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURN9 - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,n - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1n - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER)G - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128I - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDERE - ELSEL - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN,C - & 'Want to try again? (Y/N with Y as default): ')i - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THENe - WRITE (6,'('' Trying again...'')')D - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURNT - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURNr - END - - - - SUBROUTINE REPLY: - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'F - - COMMON /INDESCRIP/ INDESCRIPR - CHARACTER*(INPUT_LENGTH) INDESCRIP - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')')L - RETURN ! And returnL - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHAREDT - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)n - END IFi - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:)L - ELSE - INDESCRIP = DESCRIP - END IFI - - CALL CLOSE_BULLFILP - - CALL CLOSE_BULLDIR. - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THENB - INDESCRIP = 'RE:'//INDESCRIP(4:) - ELSER - INDESCRIP = 'RE: '//INDESCRIP - END IFC - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP)) - - CALL ADDL - - RETURNG - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - _ - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUTf - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST)i - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIVM -C+ -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS:M -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z)I - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z)i - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER)n - CALL CLOSE_BULLUSERS - NEEDPRIV(1) = USERPRIV(1)N - NEEDPRIV(2) = USERPRIV(2)P - END IFO - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR.C - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THENN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IFI - - RETURNE - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - X - SUBROUTINE GETUSER(USERNAME) -CI -C SUBROUTINE GETUSER -CN -C FUNCTION: -C To get username of present process.X -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 charactersA - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoG - - RETURN' - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG)A - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC'T - - DATA READ_UAI/.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOME - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE.9 - RETURN - END IF - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))_ - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE. - END IFU - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURNC - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z)A - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')')T - RETURN - END IFP - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODES - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN6 - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN)T - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN()r - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPADA - - CALL ENABLE_PRIVS - - RETURN5 - ENDR - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z)D - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHANi - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS - - IF (CLI$PRESENT('PROCESS')) THENR - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list. - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,)R - ELSEE - CALL INIT_ITMLST ! Initialize item listn - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)' - END IFF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODEE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER)Y - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPADT - - RETURN. - ENDR - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -CX -C The largest message that can be broadcasted is dependent on systemL -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -CC - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7)S - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message?R - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROMO - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is fromU - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IFR - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1N - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUTO - IF (IER.NE.0) RETURN' - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN)E - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will beG - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long?6 - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DOE - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL?. - IF (CLUSTER) THEN1 - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THENE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,)e - END IF - END IF, - - CALL SYS$SETRWM(%VAL(0)) - - RETURN. - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFOC -C -C FUNCTION: Obtains & verifies folder names from command line. -CR - - IMPLICIT INTEGER (A-Z)s - - INCLUDE 'BULLFOLDER.INC', - - EXTERNAL CLI$_ABSENTn - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10)T - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodesU - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP)S - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP)I - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0)e - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,','): - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IFT - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THENT - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IFU - FOLDER_NUMBER = -1) - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THENL - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM)T - RETURN - ELSE IF (READ_ONLY) THENe - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURNI - END IF( - END DO - END DOM - - IER = 1 - - RETURNP - END diff --git a/decus/vms94b/bulletin/bulletin0.for b/decus/vms94b/bulletin/bulletin0.for deleted file mode 100644 index 8115e12..0000000 --- a/decus/vms94b/bulletin/bulletin0.for +++ /dev/null @@ -1,2085 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:45:17.87 -To: EVERHART -CC: -Subj: BULLETIN0.FOR - -Date: Fri, 19 Aug 1994 17:25:37 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172537.21438991@PFC.MIT.EDU> -Subject: BULLETIN0.FOR - -C -C BULLETIN0.FOR, Version 8/10/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - CALL REMOTE_DELETE(SBULL,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN ! If not owner of message - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.EQ.FROM - END IF - IF (ASK) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.TEST_NEWS_OWNER()) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -CR - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message3 - EXDATE = EXDATE(:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99'1 - ELSE ! Permanent or ShutdownI - IF (EXDATE(2:2).EQ.'-') THENo - EXDATE = EXDATE(:6)//'19'//EXDATE(9:)t - ELSEt - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IFL - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration dateo - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from nowe - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM)o - IER = SYS$ASCTIM(,INPUT,EX_BTIM,)n - - END IFB - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration dateP - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THENC - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS U - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates.M - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THENW - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1)A - ELSEN - BULL_POINT = SBULL - 1P - END IF) - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURNm - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLFOLDER.INC'I - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-'))L - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVALP - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IFE - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVALo - IF (IER.NE.0) THENN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THENl - EVAL = F_NBULL - IER = 0I - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINTL - IER = 0I - END IFN - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2E - END IFE - - RETURNL - END - - ) - - SUBROUTINE DIRECTORY(DIR_COUNT) -Ci -C SUBROUTINE DIRECTORYN -Ct -C FUNCTION: Display directory of messages.U -CP - IMPLICIT INTEGER (A - Z)a - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'. - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGU - - DATA SCRATCH_D1/0/A - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILESU - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXTL - - COMMON /NEW_DIR/ NEWL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMf - - COMMON /NEWGROUP/ NEWGROUP - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/E - - NEXT = .TRUE. - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN)) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - T - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - IF (INCMD(:3).EQ.'DIR') THENA - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3)W - ELSE IF (CLI$PRESENT('UNSEEN')) THEND - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)n - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2)O - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IFE - END IF - IF (READ_TAG) THENR - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'',L - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF( - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)N - END IFN - END IF - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM')W - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH, - EXTRACTING = CLI$PRESENT('EXTRACT')L - PRINTING = CLI$PRESENT('PRINT')L - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - ELSE - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE.C - END IFI - OUTPUT = EXTRACTING.OR.PRINTING - -CL -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -CR - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1, - - CALL OPEN_BULLDIR_SHARED ! Get directory fileL - - CALL READDIR(0,IER) ! Does directory header exist? - START = .FALSE. - SINCE = .FALSE. - NEWDIR = .FALSE.l - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION')L - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE.E - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)N - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT( - IF (DIR_COUNT.LT.1) THENa - WRITE (6,'('' ERROR: Invalid starting message.'')')e - CALL CLOSE_BULLDIR - DIR_COUNT = 0: - GO TO 9999 - END IFg - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THENi - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - SINCE = .TRUE.y - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default., - IER = SYS$BINTIM('-- 00:00:00.00',TODAY)S - CALL GET_MSGKEY(TODAY,MSG_KEY)E - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM)U - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IFO - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified?A - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIRo - GO TO 9999m - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1),T - & MSG_KEY)e - END IFo - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THENh - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')')e - & FOLDER_NAME(:TRIM(FOLDER_NAME))' - GO TO 9999 - END IF( - END IF) - END IF - - IF (IER.EQ.0) THENg - WRITE (6,'('' No messages past specified date.'')')I - CALL CLOSE_BULLDIR - GO TO 9999 - ELSEL - DIR_COUNT = IERu - END IF - ELSE( - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - NEGATED = CLI$PRESENT('NEGATED')) - IF (CLI$PRESENT('SEARCH')) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN)M - ELSE IF (CLI$PRESENT('FROM')) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3E - NEGATED = .TRUE.L - END IF) - - MATCH_MODE = 0) - IF (CLI$PRESENT('MATCH')) THEND - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P)E - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1D - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2U - END IFN - - IER1 = 0L - - IF (READ_TAG) THENF - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THENi - WRITE (6,'('' ERROR: Qualifier not valid when '',e - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE.T - ANY_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IFD - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IFm - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THENN - MSG_NUM = DIR_COUNT-1L - ELSEC - CALL DECREMENT_MSG_KEY - END IF - END IFL - - IF (START.AND.DIR_COUNT.GT.NBULL) THENI - IF (READ_TAG) THEN - SBULL = NBULL + 1, - GO TO 100 - ELSE= - START = .FALSE.O - DIR_COUNT = NBULL, - END IFT - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1A - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSEF - DIFF = 1H - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER)o - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1)F - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2))T - & DIFF = 0 - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THENF - DIFF = DIFF - DIR_COUNT - 1 - ELSEE - DIFF = 1 - END IFi - END IFN - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IFC - - IER1 = 0/ - IF (REMOTE_SET.LT.3) F_START = 1C - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THENC - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE.B - I = DIR_COUNTR - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER)T - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) NUM = NUM + 1 - I = I + 1A - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND.I - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START)M - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1I - IF (I+1.EQ.IER) THENF - NUM = NUM + 1 - DIR_COUNT = I - END IFT - I = I - 1 - END DO - NEXT = .TRUE.E - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1L - END IFR - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE.N - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1R - EBULL = NBULLT - IF (SBULL.LT.1) SBULL = 1O - END IFi - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEND - NUM = EBULL - SBULL + 1 - I = EBULLI - NEXT = .FALSE. - NUM1 = 0, - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER)O - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - END IFA - IF (NUM.GT.0) I = I - 1H - END DOA - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE.I - NEXT = .TRUE.L - NUM = NUM1= - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THENN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) NUM = NUM + 1 h - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7h - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THENs - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) J = J + 1 - END DO - IF (MSG_NUM.GE.SBULL) THEN S - NUM = NUM + 2 , - SBULL = F_START - END IF - END IFD - END IF - EBULL = SBULL + NUM - 1E - END IFW - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THENN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULLL - IER1 = IERE - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY)A - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1( - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1V - END IFT - ELSE - IER = 0 - END IF - ELSEs - IER = 1 - END IF - END DOI - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THENM - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7)G - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO( - DO I=1,3M - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DOE - IF (IER.NE.0) THENE - EBULL = DIR_COUNTa - FBULL = FBULL + 2 - END IF - END IFT - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSEK - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1)e - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSEe - CALL DECREMENT_MSG_KEYl - END IF' - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IFE - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I1 = SBULLP - I = SBULL - DO WHILE (I.LE.EBULL) - CALL READDIR(I1,IER) ! Into the queue - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1A - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - I = I + 1D - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1 - END IF - I1 = I1 + 1 - END DOM - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE)D - IF (I.EQ.0.AND.IER1.EQ.0) THENR - EBULL = EBULL - SBULL + DIR_COUNT - SBULL = DIR_COUNTY - I = SBULLM - END IFE - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28)t - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1A - ELSET - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0F - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEND - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY)S - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,E - & TAG_TYPE)S - END IFT - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVED - END IF - END IF - END IFP - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN. - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTET - GO TO 9999 - END IF_ - END IF - ELSE( - NBULL = 0 - END IFR - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN_ - CALL CLOSE_BULLDIR ! We don't need file anymore - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN - DIR_TYPE = 'seen' - END IF( - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF1 - -C -C Directory entries are now in queue. Output queue entries to screen.D -CC - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULLD - ELSEA - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IF. - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ')G - OUTLINE(I+1:) = OUTLINE(I+2:)O - END DON - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ')G - OUTLINE(I+1:) = OUTLINE(I+2:)A - END DOR - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ')R - OUTLINE(I:) = OUTLINE(I+1:)I - END DO - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINEQ - BULL_PARAMETER = ' 'T - IF (READ_TAG) THENH - IF (BTEST(READ_TAG,1)) THEN. - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THEN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IFI - IF (PRINTING) THEN - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - END IF1 - WRITE (6,'(1X,A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)). - IF (EXPIRATION) THENH - WRITE(6,1005)= - ELSE. - WRITE(6,1000)A - END IF - - TAG = (BULL_TAG.AND.REMOTE_SET.EQ.0).OR.M - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to headerE - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)L - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1. - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)O - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IFR - END DO - END IF= - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THENA - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN - START_SEARCH = BULL_POINTI - END IF. - IF (ANY_SEARCH.OR.OUTPUT) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED_FILES = .FALSE. - END IFI - DO WHILE (I.LE.EBULL) - IF (.NOT.ANY_SEARCH) THENJ - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (CLOSED_FILES) THENL - CLOSED_FILES = .FALSE.I - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHAREDL - END IFN - CALL GET_SEARCH(FOUND,SEARCH_STRING,1,SLEN,0, - & START_SEARCH,.FALSE.,SUBJECT,REPLY_FIRST,.FALSE., - & .TRUE.,FROM_SEARCH,NEGATED,MATCH_MODE) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE)D - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THENL - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THENE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1T - NEXT = .FALSE. - CALL READDIR(FOUND,IER)L - NEXT = .TRUE.N - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28)A - TAG_TYPE = DUMMY - END IF - ELSEI - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.LE.EBULL) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THENL - OUTLINE = '>'L - ELSEG - OUTLINE = ' 'G - END IFD - IF (BTEST(SYSTEM,29)) THEN - OUTLINE(2:) = '*' - ELSE= - OUTLINE(2:) = ' 'U - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3)A - IF ((EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) - & .AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin? - EXPIRES = 'Permanent'( - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11) - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9) - ELSE - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11) - END IFQ - WRITE(6,'(1X,A)') OUTLINE - IF (OUTPUT) THEN, - FOUND_MSG = .TRUE. - CALL SYS$SETAST(%VAL(0))L - NEXT = .FALSE. - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES)E - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES) - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0 - ELSE - MSG_NUM = -MSG_NUM - END IFI - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1)), - END IFe - END IF - I = I + 1E - IF (ANY_SEARCH) IER = SYS$CANTIM(,)H - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter& - - IF (ANY_SEARCH.OR.OUTPUT) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1I - ELSED - DIR_COUNT = NBULL + 1) - END IFE - END IF - END IFI - - IF (DIR_COUNT.GT.NBULL.OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THENL - ! Outputted all entries? - DIR_COUNT = -1 ! Yes. Set counter to -1. - IF (PRINTING) THEN E - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THENE - INCMD = 'PRINT/NOW'D - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)- - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IFA - ELSE IF (EXTRACTING.AND.FOUND_MSG) THENO - CALL FILE(0,CLOSED_FILES) - END IF - ELSEH - WRITE(6,1010) ! Else say there are more - END IF1 - -9999 POSTTIME = .FALSE.T - NEXT = .FALSE. - RETURNO - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/)E -1010 FORMAT(1X,/,' Press RETURN for more...',/)L - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILESR - - INQUIRE(UNIT=1,OPENED=IER)F - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURNI - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8L - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DOE - - RETURN - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT) -CU -C SUBROUTINE FILE -CL -C FUNCTION: Copies a bulletin to a file. -Ce - IMPLICIT INTEGER (A - Z)E - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORYR - CHARACTER*64 FILE_DIRECTORY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT( - - CHARACTER*128 FILENAMEa - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THEN) - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IFI - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THEN - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IFc - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?' - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULLU - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1N - EBULL = F_NBULL: - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSET - SBULL = BULL_POINT - EBULL = SBULLL - IER = 0A - END IF - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THENT - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFILE - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P)R - RETURN - END IFP - ELSER - SBULL = FILE_NUM - EBULL = SBULLR - END IF' - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F)L - - IF (.NOT.IER) THEN - FILENAME = FOLDER - DO I=1,LEN(FILENAME)A - IF (FILENAME(I:I).EQ.'.') FILENAME(I:I) = '_'O - END DOR - FILENAME = FILENAME(:TRIM(FILENAME))//'.TXT' - LEN_F = TRIM(FILENAME). - END IF - - IF (TRIM(FILE_DIRECTORY).GT.0.AND.INDEX(FILENAME,':').EQ.0 - & .AND.INDEX(FILENAME,'[').EQ.0) THEN3 - FILENAME = FILE_DIRECTORY(:TRIM(FILE_DIRECTORY))//FILENAMEe - LEN_F = TRIM(FILENAME)Q - END IF - - CALL STR$UPCASE(FILENAME,FILENAME) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH,_ - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THENY - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')O - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IFI - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THENr - CALL OPEN_BULLDIR_SHAREDS - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE.P - FIRST = .TRUE. - END IFT - - DO FBULL = SBULL,EBULLE - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletinR - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT. - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THENE - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1 - IF (FBULL1.GT.SBULL) GO TO 100L - CLOSE (UNIT=3,STATUS='DELETE')P - OPENED = .FALSE. - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN& - ELSE IF (REMOTE_SET) THENE - CALL REMOTE_READ_MESSAGE(FBULL,IER1)F - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSEO - CALL GET_REMOTE_MESSAGE(IER1)R - END IFR - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12)( - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)C - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENA - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THENS - WRITE(3,1060) FROM,DATE//' '//TIME(:8)= - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENA - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into fileO - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DOE - -100 IF (FILE_NUM.GT.0) THEN) - FILE_NUM = -FILE_NUM - RETURN - END IF - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created.E - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F)5 - ELSEO - WRITE(6,1045)D - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)T - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - END IF - - GO TO 10T - -900 WRITE(6,1000) FILENAME(:LEN_F) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURNI - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:'), -1030 FORMAT(' ERROR: Following bulletin was not found: ',I)E -1040 FORMAT(' Message ',A,' written to ',A), -1045 FORMAT(' Messages ',A,'-',$)E -1046 FORMAT('+',A,' written to ',A)Y -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN)E - - CALL LIB$MOVC3(8,IN,OUT)F - - RETURN, - END - - - - SUBROUTINE LOGINU -CT -C SUBROUTINE LOGIN= -CU -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - N - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READITE - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGH - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPTN - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)R - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/' - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header- - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/e - - DATA FIRST_WRITE/.TRUE./P - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2)' - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - FOLDER_NAME = FOLDERR - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)I - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -CL -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -CS - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entryA - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THENR - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THENI - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSEY - RETURN ! Don't notifyI - END IF - END IFR - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRY: - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR.. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DON - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead usersa - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONGR - SET_FLAG(I) = SET_FLAG_DEF(I)B - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)B - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DOB - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THENE - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSEt - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF) - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IFO - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL setI - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHAREDL - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM)L - END DO. - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINFM - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IFB - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM)( - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header= - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSERP - CALL EXIT ! If no header, no messages - END IF= - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry_ -CG -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility.I -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM)S - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM)O - END IF - END IF. - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READL - T - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN) - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1)1 - END IF - CALL CLOSE_BULLUSER - RETURN - END IFE - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1)E - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - ENTRY LOGIN_FOLDERP - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login timeU - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN6 - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0A - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,N - & LAST_READ_BTIM(1,FOLDER_NUMBER+1))W - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)). - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM)L - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM)' - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta timeE - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IFa - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))_ - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messagesI - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEND - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1)E - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM)O - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgsR - END IFo - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THENs - ! Can folder have SYSTEM messages and /SYSTEM specified?E - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time - ! for system messages. - END IFE - - IF (LOGIN_SWITCH) THEN( - IF (READIT.EQ.1) THEN( - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSERL - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THENU - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,R - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))G - IF (DIFF1.LT.0) THENL - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1))P - END IFT - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1),E - & LOGIN_BTIM_NEW)C - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)C - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THENC - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF_ - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL1 - END IFt - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT))l - GEN_DIR = GEN_DIR1_ - SYS_DIR = SYS_DIR1o - SYS_NUM = SYS_NUM1f - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR.R - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1G - IF (IER1.EQ.0) THENM - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1, - END IF - END IFr - - IF (REMOTE_SET) THENT - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY)O - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER)i - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTEe - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IFe - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1( - ELSE - ICOUNT = ICOUNT1r - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100W - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY)F - IER = ICOUNT + 1s - ELSE - CALL READDIR(ICOUNT,IER)T - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user?T - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IFD - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THENL - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? R - NSYS = NSYS + 1. - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)E - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THENa - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)N - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM)D - END IF - IF (DIFF.LT.0) THEN. - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1N - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.D - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100G - END IF= - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IFm - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THENf - NSYS = NSYS + 1U - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))w - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 11 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100s - END IFk - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IFB - END IF - END DOU -100 CALL CLOSE_BULLDIR -CL -C Review new directory entries. If there are system messages,w -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies0 - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2d - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep...B - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0A - DO J=1,NSYSW - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)U - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))T - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTEI - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THENR - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IFY - INPUT = ' 'R - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1L - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)I - END IFE - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)U - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO( - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFILU - GO TO 9999T - END IFM - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATEt - END DOt - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2B - END IFN - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1J - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messagesS - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT)a - I = I + 1 - END IFb - IF (SYS_BUL.NE.0) THENO - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN. - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next pageG - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....')E - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screeno - PAGE = 1 - INREAD = '+'m - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' 'e - END IF/ - IF (LEFT) THEN - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN)U - LEFT = .FALSE. - ILEN = 0t - INREAD = '+'I - ELSE IF (ILEN.LE.WIDTH) THENE - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN)O - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSEC - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ')I - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH)L - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH( - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0)M - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DO - IF (INPUT(ILEN:ILEN).EQ.' ') THEN, - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' 'B - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEN - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE.D - ELSE - WIDTH = PAGE_WIDTH - END IF - END IFO - END IF - END DO - IF (NGEN.EQ.0) THENn - WRITE (6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1) - END IFN - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1S - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2N - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next pageH - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....')T - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_GL - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1N - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesC - FIRST_WRITE = .FALSE. ! if this is first write to screen.R - END IF - WRITE (6,'(''+'',A,$)') CTRL_GL - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025)O - PAGE = PAGE + 2I - I = 0E - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screenL - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1),I - & 'HIT Q(Quit listing) or any other key for next page....')A - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1! - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')')E - ELSEA - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF) - ! Bulletin number is stored in SYSTEM - ELSES - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEMM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0)C - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THENC - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated.L - END IFQ -C) -C Instruct users how to read displayed messages if READNEW not selected.L -C_ - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.R - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.'r - PAGE = PAGE + 1 - ELSE - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1) - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILENL - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)//o - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN)! - & //' '//FOLDER_NAME(:FLEN)// - & ' to read these messages.' - END IF - PAGE = PAGE + 1N - END IF - -9999 IF (LOGIN_SWITCH) THEN2 - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW)B - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF0 - RETURND - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'))f -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listF - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlistA - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)),G - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 01 - END IF_ - - RETURNU - END - diff --git a/decus/vms94b/bulletin/bulletin1.for b/decus/vms94b/bulletin/bulletin1.for deleted file mode 100644 index 9e7650f..0000000 --- a/decus/vms94b/bulletin/bulletin1.for +++ /dev/null @@ -1,2254 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:47:48.12 -To: EVERHART -CC: -Subj: BULLETIN1.FOR - -Date: Fri, 19 Aug 1994 17:25:40 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172540.21438991@PFC.MIT.EDU> -Subject: BULLETIN1.FOR - -C -C BULLETIN1.FOR, Version 3/23/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_P = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_P = LEN_P + I + 1 - BULL_PARAMETER(LEN_P:LEN_P) = ',' - END DO - LEN_P = LEN_P - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:I)//'""'// - & BULL_PARAMETER(I+1:) - I = I + 2 - LEN_P = LEN_P + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',BULL_PARAMETER(:LEN_P) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*32 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')')9 - RETURN - END IFr - WRITE (6,'('' Attempting to verify password name...'')')- - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::',r - & TYPE='SCRATCH',IOSTAT=IER)r - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')')t - RETURNe - ELSEy - WRITE (6,'('' Password was verified.'')') - END IFi - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSEl - FOLDER1_OWNER = FOLDER_OWNER - END IF. - - CALL OPEN_BULLFOLDER ! Open folder fileL - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURNS - END IF - END IFM - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IFe - - IF (IER.EQ.0) THEN, - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)E - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER)F - END IFB - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THENr - FOLDER_FLAG = IBSET(FOLDER_FLAG,6)I - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - CALL WRITE_FOLDER_FILE(IER)0 - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF( - - IF (IER.NE.0) THEN( - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF/ - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z)' - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSET - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IFI - - RETURNe - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -CA -C FUNCTION: Moves message from one folder to another. -C. - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /HEADER/ HEADER0 - - COMMON /NEXT/ NEXTA - - COMMON /NEWGROUP/ NEWGROUPN - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'R - - INCLUDE 'BULLFOLDER.INC'0 - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL')E - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep''D - & ,'' original owner.'')')p - RETURN - END IF - - ALL = CLI$PRESENT('ALL')L - - MERGE = CLI$PRESENT('MERGE')G - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entryU - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIRG - BULL_POINT = SAVE_BULL_POINTL - RETURN - END IF - - NUM_COPY = 1 - ELSEa - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')')_ - CALL CLOSE_BULLDIRI - RETURNN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1)= - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR, - RETURN - ELSEN - NUM_COPY = EBULL - SBULL + 1( - BULL_POINT = SBULL) - END IFC - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bullD - NEXT = .TRUE. ! If SBULL does not exist, will findJ - ELSE ! next message after SBULLY - SBULL1 = SBULL - CALL READDIR(SBULL,IER)' - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')')S - CALL CLOSE_BULLDIR - RETURN - END IF - END IFi - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1L - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IFo - - FROM_REMOTE = REMOTE_SETP - CALL CLI$GET_VALUE('FOLDER',FOLDER1)P - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR',T - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THENE - OPEN (UNIT=11,FILE='REMOTE.BULLFIL',' - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED')W - END IFR - ELSE - REWIND (12,IOSTAT=IER)' - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE.$ - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1E - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1T - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)F - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1)P - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTEI - ELSER - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0! - END IF - IF (LENGTH.EQ.0) IER = 1 ! Don't allow empty messagesc - IF (IER1.EQ.0) THENS - SCRATCH_R = SCRATCH_R1D - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128))C - ELSE' - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IFP - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DOe - END IF - IF (IER1.EQ.0) THENT - BLOCK = NBLOCKE - NBLOCK = NBLOCK + LENGTHR - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THENa - I = IER - ELSE - NUM_COPY = NUM_COPY + 1 - END IF - END IF - END DOI - CALL CLOSE_BULLFILn - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIRR - RETURN - END IF - END IFT - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDERt - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBERR - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (.NOT.ORIGINAL.AND.REMOTE_SET.EQ.4).OR.REMOTE_SET.EQ.3O - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')')' - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')')L - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0.AND.NEWS_FEED()) THENT - IF (.NOT.ORIGINAL) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1)L - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'',, - & '' is present.'')') - IER1 = .FALSE.E - ELSE - REMOTE_SET = 3T - END IF - END IF - END IFR - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1). - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12)E - CLOSE (UNIT=11)E - TEMP_FILE = .FALSE.0 - RETURN - END IFe -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,$ - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')C - ELSE - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THENP - EX = FOLDER_BBEXPIRE( - ELSEI - EX = NEWS_EXPIRE_DEFAULTG - END IF_ - CALL GET_EXDATE(EXDATE,EX)L - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletinI - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF. - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))d - & //SAVE_FOLDERL - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE))U - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',O - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1))R - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE))m - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DOM - END IF - ELSEC - IER= 0 - END IFC - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THENE - HEADER = .TRUE. - ELSE - HEADER = .FALSE./ - END IF - END IF6 - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THENU - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - END IF - END IFL - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF (TO_NEWS.AND.ORIGINAL) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)o - CALL CONVERT_ENTRY_FROMBIN_FOLDERi - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0_ - IF (FOLDER_BBEXPIRE.GT.0) THEN$ - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message( - EXDATE = '5-NOV-2000' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THENa - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THENA - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THENn - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THENm - CALL GET_EXDATE(EXDATE,LIMIT)L - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM)O - END IF - END IFA - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0? - GO TO 100' - END IFN - ELSEr - IF (FOLDER_BBEXPIRE.GT.0) THENU - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THENE - IER = 0 - GO TO 100 - END IF - END IFI - CALL GET_EXDATE(EXDATE,EX): - END IFa - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges?N - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message?I - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'',L - & '' shutdown message.'')')E - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSED - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14R - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present?W - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1)L - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT)C - EXTIME = '00:00:00.00'E - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THENF - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2R - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (REMOTE_SET.GE.3.AND..NOT.ORIGINAL) THEN1 - ILEN = LINE_LENGTH + 1S - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN)O - ELSEG - POST_SUBJECT = DESCRIPR - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN)c - END DO1 - - REWIND (UNIT=3) - - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT) - ELSE - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE' - - IF (IER.EQ.0) THEN: - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1A - END DOL - END IF - - IF (IER.EQ.0) THENN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUED - END DO - - IF (POST_NEWS) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFILR - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWSL - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder info -CR -C If user is adding message, an no new messages, update last read time forE -C folder, so user is not alerted of new message which is owned by user. -Cd - IF (DIFF.GE.0) THEN( - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF, - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with addE - - IF (IER.EQ.0) THENi - WRITE (6,'('' Successful copy to folder '',A)')1 - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THENE - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//E - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN( - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE' - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')')& - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADER - IF (ORIGINAL.AND.(NEWS_FEED().OR.REMOTE_SET.EQ.4)) RETURN - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1)L - - BULL_POINT = SAVE_BULL_POINTL - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THENE - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')')= - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')')U - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IFE - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C -C SUBROUTINE PRINTH -CA -C FUNCTION: Print header to queue. -CE - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'e - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL CLI$_ABSENTo - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./d - - OPENED = .FALSE.E - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND.4 - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')')U - GO TO 200U - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0E - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN)Q - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0)L - IF (CHANGED) THENL - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IFF - -50 IF (PRINT_NUM.EQ.0) THEN - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)= - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THENE - CALL CLOSE_BULLFIL) - CALL CLOSE_BULLDIRL - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THENO - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error.E - RETURNE - ELSE - SBULL = BULL_POINT. - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015)M - IF (OPENED) THENT - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURNE - END IF - ELSEF - SBULL = PRINT_NUME - EBULL = SBULLA - END IF, - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name - IF (QLEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE)) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')L - - CALL ENABLE_PRIVSL - END IFA - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE.I - END IF - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL_ - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENTB - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1Q - IF (I1.GT.SBULL) GO TO 100A - CLOSE (UNIT=24,STATUS='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFILF - CALL CLOSE_BULLDIRE - END IF, - RETURND - ELSE IF (REMOTE_SET) THENT - CALL REMOTE_READ_MESSAGE(I,IER1)l - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTEg - ELSES - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100. - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)o - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENo - IF (HEAD) THENs - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8). - END IFL - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THENI - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENr - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN)D - ELSE - IF (HEAD) WRITE(24,1050) DESCRIPB - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN)M - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into fileC - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DOa - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,)_ - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)M - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - END IF - -1040 FORMAT(' Message ',A,' sent to printer.')E -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THENT - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IFH - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN: - - FIRST = .TRUE.U - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS'))I - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE))U - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0)D - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM))R - END IFO - - CALL DISABLE_PRIVS - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM))E - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)C - IF (IER.AND.(.NOT.JBC_ERROR)) THENS - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE) - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A,e - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IFI - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE. - GO TO 50 - END IFI - - RETURNP - -900 CALL ERRSNS(IDUMMY,IER)1 - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER). - RETURNQ - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.')E -1015 FORMAT(' ERROR: Specified message number has incorrect format:')r -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -CA -C SUBROUTINE READ_MSG -C_ -C FUNCTION: Reads a specified bulletin. -CO -C PARAMETER:L -C READ_COUNT - Variable to store the record in the message fileE -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -Ci - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READITA - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING. - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXTW - LOGICAL NEXT /.FALSE./ - - COMMON /POST/ POSTTIMEW - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMI - DATA BULL_USER_CUSTOM/.FALSE./_ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPR - COMMON /MAIN_HEADER_INFO/ INEXDATER - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH)U - CHARACTER HEADLINE*132E - - LOGICAL SINCE,PAGEU - - EXTERNAL CLI$_NEGATED - - KILL = BTEST(BULL_USER_CUSTOM,3)B - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3)L - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screenM - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this isG - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR.R - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THENH - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE. - END IF - ROTC = CLI$PRESENT('ROTATE') - END IF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - IF (CLI$PRESENT('MARKED')) THENH - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3)! - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THENU - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)E - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2)0 - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSEL - BULL_READ = 1 - END IFL - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THENh - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)E - GO TO 9999O - END IFL - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified?R - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY)N - CALL GET_MSGKEY(TODAY,MSG_KEY)E - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF' - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIRA - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified?' - NEW = .TRUE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),D - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')')I - GO TO 9999 - ELSER - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY)i - END IFc - CALL OPEN_BULLDIR_SHAREDE - IER = 0 - DO WHILE (IER.EQ.0) - CALL READDIR_KEYGE(IER)E - IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_BTIM) - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY), - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - CALL CLOSE_BULLDIRS - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - END IF - END DO - CALL CLOSE_BULLDIR - ELSEA - IER = 0 - DO WHILE (IER.EQ.0) - CALL NEWS_GET_NEWEST_MESSAGE(IER), - IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - MSG_NUM = IER - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (IER.EQ.0) THENA - WRITE (6,'('' No new messages are present.'')') - GO TO 9999C - END IF. - END DO - END IFN - BULL_READ = IER - IER = IER + 1 - END IF - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN) - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999D - ELSEF - BULL_READ = IER - IER = IER + 1 - END IFB - SINCE = .TRUE. - END IF - END IFH - - NEXT = .FALSE.1 - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THENL - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THENB - IF (.NOT.SINCE.AND..NOT.NEWR - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER')R - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF_ - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THEN' - IER = 0p - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR.O - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN) - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN - MSG_NUM = F_NBULL+1 - ELSE' - MSG_NUM = BULL_NOWP - END IF - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1t - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR_ - IF (IER1.EQ.0) IER = BULL_READ + 1) - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHAREDD - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER)I - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE, - CALL GET_THIS_OR_NEXT_TAGT - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY)I - IF (IER1.NE.0) BULL_NOW = 0 - END IFN - END IFT - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)S - IF (IER1.EQ.0) IER = BULL_READ + 1S - END IF - DO WHILE (IER1.EQ.0)B - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1J - END DO' - CALL CLOSE_BULLDIR& - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY), - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1E - ELSE IF (NEXT.OR.SINCE.OR.NEW) THENR - OLD_NEXT = NEXT - NEXT = .FALSE.N - IF (NEW) MSG_NUM = BULL_READs - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSE& - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THEN' - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSEo - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0s - END IF, - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IFE - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSEi - IER = 0 - END IFT - END IF - END IFV - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THEN. - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHAREDo - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE. - CALL READDIR(BULL_READ,IER)M - END IF/ - END IFM - IF (REMOTE_SET.LT.3.AND.W - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THENC - READ_COUNT = 0I - IF (IER.NE.BULL_READ+1) THENE - CALL READDIR(0,IER)M - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF. - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0I - END IFE - CALL CLOSE_BULLDIRO - ELSE - IER = 0 - END IF - END IFL - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THENS - WRITE(6,1030) ! If not, then error out1 - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF3 - - BULL_POINT = BULL_READ ! Update bulletin counterP - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHAREDe - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THENa - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)O - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENF - INFROM = INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENE - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - - IF (.NOT.OK) THEN. - BULL_NOW = MSG_NUMR - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN' - BULL_READ = MSG_NUM - 1' - ELSE - BULL_READ = MSG_NUM + 1L - END IFE - IF (REMOTE_SET) CALL CLOSE_BULLFILE - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN+ - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)$ - END IF - ELSEG - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - GO TO 50) - END IF - - BLOCK = BLOCK_SAVE - END IF2 - - NEXT = .FALSE.T - IF (REMOTE_SET.LT.3) THEN - IF (INCMD(:4).NE.'SEAR') THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2)G - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN_ - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSEE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN' - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL)S - END IF - IF (INCMD(:4).NE.'SEAR') THENS - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ)T - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.BULL_READ) CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ)E - END IF - END IF - - EDIT = .FALSE.I - - PAGE_WIDTH = REAL_PAGE_WIDTH' - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THENR - IF (CLI$PRESENT('EDIT')) THENH - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THENe - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 9999E - END IFM - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTHI - PAGE = .FALSE.R - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSEI - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULLR - END IF - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:) - END DOW - I = TRIM(HEADLINE)e - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE))A - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE))N - END IF - - END = 1 ! Outputted 1 line to screenL - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THENE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)O - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?D - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSEE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5)R - END IFS - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IFN - IF (EDIT) THEN& - WRITE (3,'(A)') INPUT(:TRIM(INPUT))T - ELSEE - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IFI - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 13 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0)S - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THENV - WRITE(3,'(A)') INPUT(:I)U - ELSE) - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSEV - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROMS - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1L - END IFN - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)( - END IFI - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:)L - DO WHILE (TRIM(INPUT).GT.0). - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THENO - WRITE(3,'(A)') INPUT(:I)S - ELSEN - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1U - IF (EDIT) WRITE(3,'(1X)')I - ELSE. - END = END + 1A - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP)N - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP))R - IF (LINE_OFFSET.EQ.1) THEN. - CHAR_OFFSET = 1 - PAGE_WIDTHL - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IF - END IF - END IFU - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file readL - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)')W - END = END + 1 -CN -C Each page of the bulletin is buffered into temporary memory storage before) -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memoryR -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.M -C4 - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSEI - READ_COUNT = BLOCK ! Init bulletin record counterU - END IFA - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IFE - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0D - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE.R - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THENI - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN' - CHAR_OFFSET = 1F - BUFFER = INPUT(:PAGE_WIDTH)H - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE, - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)) - END IF - ELSEN - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTHC - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THENM - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0P - ELSEP - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF) - END IFN - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DOC - - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) THENT - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter - GO TO 9999 - END IF - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the1 -C end of the previous page. The output gets confused and thinks it mustR -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C) - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DOS - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter) - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC)T - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read?( - IF (ILEN.GT.0) THEN ! Yes, there are still moreL - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletinN - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IFI - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - -9999 POSTTIME = .FALSE.E - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3), - RETURN - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/)N - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z)R - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THENE - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A')E - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DOR - - RETURNA - END - - - - - - - SUBROUTINE READNEW(REDO)E -C= -C SUBROUTINE READNEWn -Co -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -CE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1( - EQUIVALENCE (INREAD4,INREAD)D - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL' - - FIRST_MESSAGE = BULL_POINT) - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time6 - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there isL - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletinso - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input0 - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case) - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN) - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)')E - ELSE IF (INREAD.EQ.'E') THENE - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO_ - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DOT - CALL EXIT - ELSE' - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit0 - ! Include QUIT to be consistent with next questionT - ELSE - CALL LIB$ERASE_PAGE(1,1)E - END IF - END IF, - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')')E - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1' - END IF - END IFS - - READ_COUNT = 0 ! Initialize display pointerP - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletinC - BULL_POINT_READ = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it.I - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IFr - - GO TO 12a - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IFT - - BULL_POINT = BULL_POINT_SAVE - LENGTH = LENGTH_SAVES - BLOCK = BLOCK_SAVEt - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030)E - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper caseh - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)')e - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory! - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE.O - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN - ! If F then copy bulletin to fileL - WRITE (6,'(''+ '')') ! Move cursor from end of prompt liney - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]'( - LEN_FILE_DEF = ILEN + 5 - ELSEU - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IFT - END IF - - LEN_FOLDER = TRIM(FOLDER)E - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,a - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS'S - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THENI - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//E - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IFE - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P)E - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)O - CALL FILE(0,.TRUE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THEN_ - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR.I - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD)D - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THENS - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THENU - WRITE (6,'(''+B'',$)')c - INCMD = 'RESPOND/LIST'9 - ELSE - GO TO 11i - END IFn - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPONDt - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')') - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLYp - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THENh - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletinB - CALL CLOSE_BULLDIR ! Exito - WRITE(6,1010) - RETURNH - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THENu - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010). - RETURN - END IFt - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message',I - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.')m -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),',/ - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$)( -1040 FORMAT(' Type P to post reply, U to reply to user,', - & ' B to do both, or other to quit: ',$)T - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -CP -C SUBROUTINE SET_DEFAULT_EXPIRE -CI -C FUNCTION: Sets default expiration date. -CP - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLUSER.INC'P - - CHARACTER EXPIRE*3P - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN)E - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER). - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THENP - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THENS - WRITE (6,'('' ERROR: Expiration must be > -1.'')')C - ELSE - FOLDER_BBEXPIRE = TEMPO - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER)N - CALL CLOSE_BULLFOLDER_ - ELSEL - WRITE (6,'('' You are not authorized to set expiration.'')') - END IFF - - RETURNN - END - - - - - LOGICAL FUNCTION NEWS_FEED()( - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN. - I = SLIST + 1g - FLEN = TRIM(FOLDER_DESCRIP)W - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN - I = FLEN + 1 - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND. - & FOLDER_DESCRIP(I:I).NE.'@'.AND.u - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSEN - I = FLEN + 2' - END IFM - END DO - IF (I.EQ.FLEN+1) NEWS_FEED = .TRUE.) - END IF( - - RETURNN - END diff --git a/decus/vms94b/bulletin/bulletin10.for b/decus/vms94b/bulletin/bulletin10.for deleted file mode 100644 index fa22dad..0000000 --- a/decus/vms94b/bulletin/bulletin10.for +++ /dev/null @@ -1,3209 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:58:50.10 -To: EVERHART -CC: -Subj: BULLETIN10.FOR - -Date: Fri, 19 Aug 1994 17:26:02 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172602.21438991@PFC.MIT.EDU> -Subject: BULLETIN10.FOR - -C -C BULLETIN10.FOR, Version 8/10/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - IF (END_LINE.GT.257.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - END IF - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - 2 - IF (BUFFER(EB+2:EB+2).NE.LF) EB = EB + 2 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE(:MIN(LEN(WRITE),256)) - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - NEWS_WRITE = NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - - LOGICAL FUNCTION NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - NEWS_RECONNECT = .FALSE. - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - NEWS_RECONNECT = .TRUE. - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER()) THEN - CALL NEWS_POST('cancel',0,IER,'Delete news item.') - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = SETPRV_PRIV().OR.FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - BACKSEARCH = END - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN" - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1)))F - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURNc - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1I - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ')s - NUMBER = ' '//NUMBER(1:)a - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1a - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ')m - NUMBER1 = NUMBER1(2:) - END DOI - END IF - END IF - END IF/ - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURNE - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURNE - IF (BUFFER(:2).EQ.'22') THEND - QXHDR = QXHDR1E - IF (.NOT.NEWS_READ()) RETURNA - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1N - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP)N - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB)E - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THENN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURNE - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4:E - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THENT - BUFFER(:3) = '500'C - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22')M - START = START + 1_ - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DOR - IF (BUFFER(:2).NE.'22') THENE - IER = 0O - END = START - 1 - RETURN - END IFI - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURNN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))L - END = START + NUMDIR - 1_ - END IF - IER = 0F - END IFI - - IF (IER.EQ.0) THENI - I = START_ - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1))I - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1))U - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURNO - END IFL - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THENW - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1N - IER = 0N - RETURN - END IFE - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURNO - IER = 0 - END IFM - END DO - END IF1 - - IF (REMOTE_SET.EQ.3) THEN - IER = 1I - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURNS - END IF - IER = 0L - END IFT - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z)D - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTEDG - LOGICAL NEWS_CONNECTED /.FALSE./( - - COMMON /XHDR/ XHDRE - LOGICAL XHDR /.FALSE./e - - COMMON /BUFFER/ BUFFER,SB,EBR - CHARACTER BUFFER*1280 - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT()N - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURNU - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN2 - IF (.NOT.NEWS_READ()) RETURNR - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN. - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - END IFO - - NEWS_LOGIN = .TRUE. - - RETURNE - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTHS - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8I - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONEC - CHARACTER*4 ZONEF - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/I - - CHARACTER*8 TIMES(1)A - DATA TIMES /'-5:30'/. - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THENN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN* - IF (INDEX(ZONES,ZONE).LT.5) THENE - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4)C - END IF - ELSED - HOUR = '00:00' - END IF1 - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -CI -C Following computes DST based on US formulaS -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_L_TI(DATE,TIME(:2),,,)T - CALL LIB$DAY_OF_WEEK(BTIM,DAY)L - M = (INDEX(MONTH,TIME(4:6))+2)/3T - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE)U - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEND - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF, - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,)O - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IFE - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IFR - - TO_GMT = .FALSE. - - RETURNS - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z)B - - INTEGER TIMADR(2) ! Buffer containing timeR - ! in desired system format.& - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30': - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN, - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1))N - IF (IER.AND.I.GT.0) THEN) - IF (TRIM(SEC).EQ.1) THENS - TIMBUF(9:10) = '0'//SEC(:1)B - ELSER - TIMBUF(9:10) = SEC - END IF1 - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURNR - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURNW - END - - - SUBROUTINE KILL_NEWS_CONNECT()1 - - IMPLICIT INTEGER (A-Z)O - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURNT - - NLUN = NEWS_GET_CHAN()I - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT()N - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z)W - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREFR - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS_ - CHARACTER*256 NEWSGROUPSS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINEE - CHARACTER*12 MSGNUM - - CHARACTER*256 TEMP_FROM_LINE( - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0. - - DESCRIP = ' ' - FROM = ' '1 - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - NEWSGROUPS = ' ' - LREF = 0N - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4)D - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.') - IER = NEWS_READ()B - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126)/ - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB). - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM)M - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THENI - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE.( - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND.( - & EB.GT.SB+11) THENU - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB)U - ELSE - REFERENCES = REFERENCES(:LREF)//' '//O - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THENT - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF). - END IF - LREF = TRIM(REFERENCES)R - LAST_FROM = .FALSE. - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN+ - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - TEMP_FROM_LINE = FROM_LINE - CALL GET_FROM(TEMP_FROM_LINE(7:),TRIM(FROM_LINE)) - LAST_FROM = .TRUE.U - ELSE - LAST_FROM = .FALSE. - END IFH - END IF - END DOE - - IER = 0 - - RETURN) - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DOO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN' - END DOD - - RETURNS - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'+ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB( - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCHI - ELSET - IER = 2D - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START. - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0N - END IF. - - RETURNA - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z)H - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLUSER.INC'$ - - COMMON /READIT/ READIT, - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EBE - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2)D - - CHARACTER TIME*20,FIRST*80I - - CHARACTER*8 NUMBERG - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN* - I = NEWS_FIND_SUBSCRIBE()D - START = (LAST_NEWS_READ2(2,I).AND.'1FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I))E - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSEE - START = -1 - IER = SYS$ASCTIM(,TIME,IN_BTIM,) - CALL DATE_TIME(TIME) - SKIP = 0 - DO WHILE (SKIP.GE.0) - IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM(0 - & FOLDER_NAME))//' '//TIME)) RETURNR - IF (.NOT.NEWS_READ()) RETURNG - IF (BUFFER(:2).EQ.'23') THEN - IF (.NOT.NEWS_READ()) CALL EXIT - DO I=1,SKIP - IF (.NOT.NEWS_READ()) CALL EXITT - END DO - FIRST = BUFFER(SB:EB) - IF (FIRST.EQ.'.') RETURNZ - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL EXIT - END DO - IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST))))E - & CALL EXIT - IF (.NOT.NEWS_READ()) CALL EXIT - IF (BUFFER(:2).EQ.'22') THENI - IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN - I = F_NBULL + 1 - DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. - & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>'))* - & .OR.I.GT.F_NBULL)) - I = I - 1 - IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN/ - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURNE - IF (.NOT.NEWS_READ()) RETURNN - END DOD - IF (I.GE.F_START) START = I - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))( - END IF - RETURN - END IF - END IFN - SKIP = SKIP + 1 - END DO - END IF - - RETURNn - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER), - - IMPLICIT INTEGER (A-Z)T - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2. - IER = IER1 - END IFR - - RETURNE - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSET - END IF - - RETURNS - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER)( -C -C SUBROUTINE GET_REMOTE_MESSAGE -C= -C FUNCTION: -C Gets remote message. -CI - - IMPLICIT INTEGER (A-Z)H - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES_ - - COMMON /NEWSGROUPS/ NEWSGROUPSF - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINEo - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - CHARACTER*256 TEMP - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty?O - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to headE - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointerE - END IFA - - ILEN = 128I - IER = 0 - LENGTH = 0) - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THENS - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IFL - END IFN - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN( - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUTW - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN_ - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILENI - END IF( - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IFA - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)E - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THENE - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IFM - LTEMP = LSUB - LSUB = 0 - IER = 0_ - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1S - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE9 - IER = NEWS_READ()O - IF (IER.AND.BUFFER(SB:EB).NE.'.') THEN - IER = 0( - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THENM - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF (INDEX(TEMP,': ').EQ.0.AND.T - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR(R - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255) THENL - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1)E - LTEMP = LTEMP + 1 - END IFE - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IF1 - IF (LOCAL_UPDATE1.NE.0) THENF - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF N - ELSE - HEADER_SEEN = .TRUE.. - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1( - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)R - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0E - INPUT = INPUT(:ILEN)//CHAR(0): - ILEN = -128G - ELSE - ILEN = 128 - END IF - END IF - ELSE( - TEMP = TEMP(129:) - END IF. - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)F - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this errorF - IER = 0 - ILEN = 0 - ELSEC - CALL SYS_GETMSG(IER1) - LENGTH = 0= - IER1 = IERS - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IFF - ELSE IF (ABS(ILEN).EQ.128) THEN) - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DOL - - RETURNT - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER)R - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C( -C SUBROUTINE CONNECT_REMOTE_FOLDER -C, -C FUNCTION: Connects to folder that is located on other DECNET node.O -C - IMPLICIT INTEGER (A-Z)U - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHG - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATET - - COMMON /READIT/ READIT, - - COMMON /NEWS_INIT/ END_READ - - INCLUDE 'BULLUSER.INC'I - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - - DIMENSION DUMMY(4)U - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - END_READ = 0 - IF (.NOT.NEWS_LOGIN()) THEN) - IER = 2 - RETURN. - END IF - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IFZ - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different, - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 10 - END IFI - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THENR - IF (.NOT.SAME) THENS - FOLDER1_FILE = FOLDER_FILEF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER12 - REMOTE_SET_SAVE = REMOTE_SETS - REMOTE_SET = .FALSE.. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR( - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILED - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THENE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THENB - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+'X - SYSLOG = .TRUE. - END IFN - END IF - IF (.NOT.SYSLOG) THENF - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER_ - FOLDER_BBOARD_SAVE = FOLDER1_BBOARDO - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER) - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN( - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY,F - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE1 - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY,T - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF, - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE) - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVER - END IFT - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND.B - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE). - IF (IER.EQ.0) REWRITE (4) USER_ENTRYE - CALL CLOSE_BULLUSER - END IF_ - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -CO -C If remote folder has returned a last read time for the folder,1 -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1)r - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY)* - IF (SYSLOG) THENO - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3))E - END IFD - END IF - IER = 0M - END IF - - RETURNL - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUPC - - CHARACTER*8 NUMBERA - - DIMENSION IN_BTIM(2)t - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THENN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY= - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADERI - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF2 - RETURN - ELSE( - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IFN - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBINF - END IF - ELSE IF (REMOTE_SET.EQ.3) THENP - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1L - RETURN - ELSE IF (ICOUNT.EQ.-1) THEN: - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXITS - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXITT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXITI - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSEA - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IFT - IF (BUFFER(:2).NE.'22') THEN. - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START)D - ICOUNT = ICOUNT - 12 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURNT - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER))1 - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT' - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF( - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITM - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THENE - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITC - END IFI - END IF - IF (BUFFER(:2).NE.'22') RETURNe - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1))= - IF (.NOT.IER) RETURNC - START = ICOUNT= - BULLETIN_NUM = STARTS - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0C - CALL NEWS_HEADER(IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBINR - END IF - BLOCK = START - MSG_NUM = STARTR - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IFC - - RETURNL - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM)e - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I)D - END DO/ - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURNE - END - - - - SUBROUTINE NEWS_GROUP(IER)D - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /BUFFER/ BUFFER,SB,EBC - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN - IER = 1I - RETURN - END IF' - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1))N - IF (.NOT.IER) RETURNF - - IER = NEWS_READ() - IF (.NOT.IER) RETURNN - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1))S - IF (.NOT.IER) RETURNO - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1))E - IF (.NOT.IER) RETURNF - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURNR - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT')E - IF (.NOT.IER) RETURNI - - IER = NEWS_READ() - IF (.NOT.IER) RETURNL - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURNR - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z)C - - CHARACTER*(*) INTIME - - CHARACTER*20 TIME - - I = 1 - LTIME = TRIM(INTIME)V - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR.E - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1Q - END DOR - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM)F - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:))A - - DO J = 1,2M - I = 1R - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-') - END DO1 - - IF (I.EQ.LEN(TIME)) RETURN - - IF (TIME(I+3:I+3).EQ.' ') THENT - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IFR - - I = 1 - DO J = 1,2N - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1E - END DON - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) RETURNU - - CALL SYS_BINTIM(TIME(:I-2),BTIM)R - - IF (INDEX(INTIME,'GMT').GT.0) CALL CONVERT_FROM_GMT(BTIM) - - RETURN - END - - - - SUBROUTINE NEWS_LISTA - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - COMMON /NEWSLIST/ NEWSLIST - - CHARACTER TODAY*24N - - DIMENSION EXPIRED(2)F - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN_ - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR. - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - RECOUNT = SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED') - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER)) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - NEWS_FOLDER1_BBOARD = '::'h - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)e - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14. - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)B - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMO - END IF - NEWS_FLAG_DEFAULT = NEWS_F1_FLAGR - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNT - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1)E - IF (IER1.EQ.0) THENC - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER)O - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2E - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1))( - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0L - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1 - IF (IER.NE.0.OR.IER1.NE.0) THEN - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLENA - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN R - NEWS_FOLDER = NEWS_FOLDER1(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COME - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)//. - & BUFFER(SP:EB) - ELSEF - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB)R - END IF - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER))N - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DOQ - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DOI - NEWS_FOLDER1_NUMBER = NEWS_F_COUNTI - IF (IER2.EQ.0) THEN . - NEWS_F1_FLAG = NEWS_F_FLAG - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN. - NEWS_F1_EXPIRE = NEWS_F_EXPIREE - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSE) - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IFI - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE)_ - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)_ - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1)U - IF (BTEST(NEWS_F1_FLAG,8)) THEN - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0E - NEWS_F1_LAST = 0 - END IFN - IF (FLEN.GT.44.AND.FLEN-44+EB-SP+1.LT. - & LEN(NEWS_FOLDER1_DESCRIP)) THENR - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM) - IF (IER.EQ.0) THEN E - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEND - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,A - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IFI - END IF. - END IFN - ELSE IF (BTEST(NEWS_F1_FLAG,8).AND.R - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN( - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN. - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF( - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IFE - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE.3 - IF (FLEN.GT.44) THEN( - IF (NEWS_FOLDER1_DESCRIP.NE.C - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)E - UPDATE = .TRUE.E - END IF - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THENR - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB)R - UPDATE = .TRUE. - END IFL - IF (SPECIAL) THEN - IF (UPDATE) THEN= - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF - ELSE IF (.NOT.UPDATE) THEN - UPDATE = F1_START.NE.NEWS_F1_START.OR._ - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)C - NEWS_F1_COUNT = NEWS_F_COUNTM - REWRITE (7) NEWS_FOLDER1_COMS - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)L - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0)B - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7)E - CALL READ_FOLDER_FILE_TEMP(IER) - END DOO - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEND - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_STARTQ - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THENO - IF (NEWS_F1_FIRST.GT.F1_START.AND.) - & NEWS_F1_FIRST.GT.F1_NBULL) THEN) - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM, - END IFI - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),: - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER))D - END IF - END IFF - ELSE IF (((F1_START.NE.NEWS_F1_START.OR.R - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND.(.NOT.BTEST(NEWS_F1_FLAG,8).OR. - & NEWS_F1_NBULL.LT.NEWS_F1_START. - & .OR.NEWS_F1_START.EQ.0)) THEN - DELETE (UNIT=7) - IER = 0P - END IFN - END IFD - END DO - END IFR - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - NEWSLIST = .FALSE.D - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN: - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a'))) - END IF - END DOR - - RETURN - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC'2 - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB, - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREFD - CHARACTER*256 REFERENCESS - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME_ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID_ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPSR - CHARACTER*256 NEWSGROUPSM - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4. - - COMMON /LOCALPOST/ LOCAL_POSTS - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /TEMP_INPUT/ GROUP_TEMPt - CHARACTER GROUP_TEMP*256( - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER TODAY*24,UNAME*132E - DATA UNAME /'()'/ - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THENo - IF (.NOT.FILEOPEN) THENB - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1)e - IF (IER1.NE.0) RETURN - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 9000 - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3)D - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:)F - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900B - IF (BUFFER(:3).NE.'340') THENE - WRITE (6,'('' ERROR: Posting not allowed.'')')E - GO TO 900 - END IF - ELSE= - I = INDEX(NEWS_MSGID,'.')E - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & NEWS_MSGID(:I-1)//B - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER,S - & STATUS='NEW',DISPOSE='DELETE',RECL=256) - IF (IER.NE.0) RETURNB - LOCAL_POST = .TRUE.B - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1N - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIPS - ELSE IF (.NOT.BTEST(FOLDER_FLAG,8).AND. - & TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEND - INPUT = 'Newsgroups: '//NEWSGROUPS_ - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER)D - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0_ - DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP)) - IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP) - DO WHILE (TRIM(GROUP_TEMP).GT.0) - COMMA = INDEX(GROUP_TEMP,',') - IF (COMMA.GT.0) THENS - FOLDER1_NAME = GROUP_TEMP(1:COMMA-1) - GROUP_TEMP = GROUP_TEMP(COMMA+1:) - ELSE - FOLDER1_NAME = GROUP_TEMP - GROUP_TEMP = ' ' - END IF - CALL LOWERCASE(FOLDER1_NAME)E - FLEN = TRIM(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP0 - & (FOLDER1_NAME(:FLEN),IER1)T - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9)C - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND. - & INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND.N - & INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN - INPUT = INPUT(:TRIM(INPUT))//E - & ','//FOLDER1_NAME(:FLEN) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),N - & GROUP_LIST,FOLDER1) - NGROUPS = NGROUPS + 1 - END IF. - END IF - END DO - END DO - CALL CLOSE_BULLNEWS - END IFA - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900R - END IF) - ATSIGN = INDEX(PATHNAME,'@')I - PCSIGN = INDEX(PATHNAME,'%') - CALL LOWERCASE(USERNAME)R - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'D - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900. - ELSE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'A - & //USERNAME(:TRIM(USERNAME)))) GO TO 900B - END IFN - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME)D - - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - CALL STR$UPCASE(FROM_LINE,FROM_LINE)L - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME)N - _ - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'// - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECTI - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF)))T - & GO TO 900 - END IF1 - - IF (NGROUPS.GT.0) THEN - FROM = USERNAME - DESCRIP = SUBJECTU - END IFE - - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//'>')) GO TO 900 - - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:)I - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION)0 - END IF - LORGAN = TRIM(ORGANIZATION) - END IFH - - IF (LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN)))M - & GO TO 900D - END IF - - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//W - & ZONE(:LZONE))) GO TO 900 - - IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel')) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE( - & FIRST_ALPHA(EXDATE):2)( - & //' '//EXDATE(4:6)//' '//EXDATE(10:TRIM(EXDATE))_ - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900B - ELSE IF (REMOTE_SET.EQ.4) THENG - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT) - END IF - EXTIME = '00:00:00.00' - END IF - END IF - - IF (CREATE) THENV - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURNN - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel <'F - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN1 - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURNO - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_READ()) RETURN. - IF (BUFFER(:3).EQ.'240') IER = 0A - ELSE - CLOSE (UNIT=8,STATUS='SAVE')E - IER = 0 - END IF - LOCAL_POST = .FALSE. - RETURN - END IFU - - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - - IER1 = 0 - DO WHILE (IER1.EQ.0)S - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2N - END IF - IF (IER1.EQ.0) THEN) - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DO) - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 900E - IF (.NOT.NEWS_READ()) GO TO 900O - IF (BUFFER(:3).EQ.'240') THENC - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:EB)/ - IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN - WRITE (6,'('' Use /INDENT to change indentation'',$)') - WRITE (6,'(''+ character. See Manager for permanent'',$)') - WRITE (6,'(''+ change.'')') - END IF - END IF - ELSEA - LENGTH = (LENGTH+127)/128R - GROUP_LIST = GROUP_LIST1N - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - DO I=NGROUPS,1,-1O - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1)/ - FOLDER_NUMBER = -1T - CALL SELECT_FOLDER(.FALSE.,IER)I - IF (IER) THEN E - CALL ADD_LOCAL_NEWS(8) - END IF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVEL - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - IF (.NOT.NEWS_WRITE('.')) GO TO 900R - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IFN - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - - LOCAL_POST = .FALSE.T - - RETURNS - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLUSER.INC') - - COMMON /PATH/ PATHNAME,LPATH1 - CHARACTER*132 PATHNAME. - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME)R - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME)N - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')')( - RETURNM - END IF - END IFF - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME)) - LPATH = TRIM(PATHNAME)N - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NAME' - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME)' - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE.& - END DOG - - TEST_NEWS = MAYBE_NEWS. - - RETURNT - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC'R - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1E - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM)U - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM)P - IF (NUM.EQ.0) RETURNQ - E - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULLC - FIRST = F1_STARTP - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - CALL OTS$CVT_L_TI(F_LAST+1,NUMBER,,,) - REMOTE_SET = 3 - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNT - NEW_NEWS_F_END = NEWS_F_ENDS - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM)_ - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF( - F_LAST = LAST - NEWS_F_FIRST = FIRST( - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - END DO1 - - RETURN - END - - - - - SUBROUTINE NEWS2BULL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BUFFER/ BUFFER,SB,EBI - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBERT - - DIMENSION NOW(2) - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV& - - CALL NEWS_LIST: - - CALL UPDATE_LOCAL_NEWS. - - CALL SEND_POST - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder fileN - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - ELIST = INDEX(FOLDER_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN - IF ((FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR. - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))).AND.Q - & INDEX(FOLDER_DESCRIP(SLIST+2:),'@').EQ.0) THEN/ - NUM_FOLDERS = NUM_FOLDERS + 1I - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF/ - END IFS - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXITf - - FOLDER_Q = FOLDER_Q1R - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)) - POINT_FOLDER = POINT_FOLDER + 1C - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)I - CALL SELECT_FOLDER(.FALSE.,IER)) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARD& - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:)T - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1)( - IF (IER) THEN. - SAVE_LAST = F_LASTL - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER). - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIPO - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)/ - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN) - SAVE_LAST = F_NBULLP - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LAST( - FOLDER_BBOARD = 'NONEFEED'1 - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER0 - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - REMOTE_SET = 3D - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.)/ - CALL OPEN_BULLFOLDERI - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1)F - END IF_ - CALL CLOSE_BULLFOLDER - END IF. - END IF - END DON - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME)E - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - CHARACTER*(*) TIMEI - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+N - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)// - & TIME(16:17)//TIME(19:20)O - - RETURNE - END - - - - SUBROUTINE ALLPRIVN - - IMPLICIT INTEGER (A-Z)T - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1O - PROCPRIV(2) = -1N - NEEDPRIV(1) = -1T - NEEDPRIV(2) = -1F - - RETURN2 - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z)v - - INCLUDE 'BULLFOLDER.INC') - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COMX - - NEWS_FOLDER1 = FOLDER1G - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1' - END DO - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)O - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_COUNT = NEWS_F_COUNT_ - REWRITE (7) NEWS_FOLDER1_COM - - RETURNU - END - - - - SUBROUTINE SUBSCRIBEC - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')')L - RETURN - END IF - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1. - END DO - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')')M - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')')R - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSET - WRITE (6,'('' You are now subscribed to '',A,''.'')')Y - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(F - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER)' - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1))N - END IFI - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THENE - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1))' - LAST_NEWS_READ(2,J) = F_START - 1 - ELSEM - LAST_NEWS_READ2(2,J) = 0 - LAST_NEWS_READ(2,J) = F_NBULL - END IFM - CALL CLOSE_BULLNEWS - RETURNL - END IF - END DO - - END - - - - - - SUBROUTINE UNSUBSCRIBED - - IMPLICIT INTEGER (A-Z)6 - - INCLUDE 'BULLUSER.INC'O - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IFM - - CALL OPEN_BULLINF_SHAREDL - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DOE - IF (IER.NE.0) THEN_ - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DOQ - - IF (I.LE.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Folder is permanent and cannot not be'',) - & '' unsubscribed.'')') - RETURN - END IFF - - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - I = NEWS_FIND_SUBSCRIBE() - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1))Q - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0_ - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - - CALL FREE_TAGS(I) - - RETURN, - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (IER.EQ.0) IER = 1 ! None read yet. - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0_ - RETURN - END IFD - - RETURNF - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'F - - I = NEWS_FIND_SUBSCRIBE1() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0O - RETURN - END IF - - RETURN0 - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLUSER.INC'O - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR. - & (LAST_NEWS_READ(2,I).GT.F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER)4 - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X)N - END IF2 - - RETURN= - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'E - - IF (SUBNUM.EQ.0) THEN - COUNT = 0O - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1R - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THEN - COUNT = COUNT + 1S - END IFT - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT)S - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSEQ - SUBNUM = 0 - END IFE - - RETURNL - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES) -C -C SUBROUTINE NEWS_NEW_NOTIFICATION, -CD - - IMPLICIT INTEGER (A-Z)/ - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'L - - COMMON /READIT/ READITl - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)F - - MESSAGES = .FALSE.P - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1O - - FOLDER_DESCRIP = ' 'C - REORDER = 0 - DO WHILE (SUBNUM.GT.0) - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)D - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)' - FOLDER1_DESCRIP = FOLDER_DESCRIPI - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER)L - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUM - UNLOCK 7= - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1D - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - ELSE IF (IER.NE.0) THEN - SUBNUM = -1L - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR. - & F_START.GT.F_NBULL) THENC - IER = 1I - END IF. - END IF' - IF (IER.EQ.0.AND.SUBNUM.GT.0) THENP - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND.1 - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THENA - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR.E - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR.. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)_ - IF (DIFF.GT.0) IER = 1 - END IF - END IFS - END IF_ - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THENT - WRITE (6,'('' There are new messages in folder '',N - & A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)' - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)1 - ELSE_ - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1)D - IF (IER1) THENE - CALL LOGIN_FOLDERE - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBERT - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THENR - SAVE_BULL_POINT = BULL_POINTH - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF) - END IF - END IFE - CALL OPEN_BULLNEWS_SHARED - END IFI - END IF - END DOC - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE - - CALL CLOSE_BULLNEWS - - RETURN- - END - - - SUBROUTINE REORDER_SUBSCRIBEF - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0), - I = I + 1D - END DOF - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1O - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1)_ - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2( - TEMP = LAST_NEWS_READ(L,J)7 - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K)C - LAST_NEWS_READ(L,K) = TEMP - END DOR - END IFR - END DO - END DOO - - RETURNR - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)I - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLUSER.INC'O - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IFe - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14)E - - RETURN- - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER)H - - IMPLICIT INTEGER (A-Z): - - INCLUDE 'BULLUSER.INC'e - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IFN - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15)) - - RETURNN - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLUSER.INC'E - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE._ - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE(). - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC'2 - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER( - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1= - END DO- - - NEWS_FIND_SUBSCRIBE = I - - RETURNJ - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1I - END DOI - - NEWS_FIND_SUBSCRIBE1 = IO - - RETURN - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLUSER.INC'N - - INCLUDE 'BULLFOLDER.INC'I - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_RECL - END DOU - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DOI - END IF - CALL CLOSE_BULLINF' - - IP = 1F - DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER - & .AND.IP.LE.FOLDER_MAX-1) - IP = IP + 1F - END DOE - - IER = .TRUE.n - - IF (IP.EQ.FOLDER_MAX) THEN, - PERM = .FALSE. - IP = 1 - ELSEL - PERM = .TRUE.N - END IFS - - IF (NOTIFY.EQ.0) THEN - IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')')L - RETURN, - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) - END IF - ELSE IF (NOTIFY.EQ.1) THENP - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13)E - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.(.NOT.PERM.OR. - & (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15)))) THENO - IER = .FALSE.T - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.(.NOT.PERM.OR. - & (BTEST(INF_REC2(2,IP),14).OR.N - & .NOT.BTEST(INF_REC2(2,IP),15)))) THEN - IER = .FALSE.S - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.(.NOT.PERM.OR. - & (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15)))) THEN - IER = .FALSE.O - END IFU - - IF (IER) THEN - IF (READNEW.GE.0)B - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.GE.0) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15)B - ELSE) - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')')L - - IF (BTEST(INF_REC2(2,IP),14)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - END IF - - IF (BTEST(INF_REC2(2,IP),15)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - END IF - END IFF - - CALL UPDATE_USERINFO - - RETURNF - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT)A - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT- - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE1 - CHARACTER*12 MSGNUM - - REWIND UNIT - U - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM)S - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '//T - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK)' - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6, - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK)S - END IFF - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THEND - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1B - SYSTEM = 0 - CALL ADD_ENTRYO - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - ENDE - - - - SUBROUTINE UPDATE_NEWS_FOLDER -C -C SUBROUTINE UPDATE_NEWS_FOLDER -CM -C FUNCTION: Updates folder info due to new message. -CC - - IMPLICIT INTEGER (A-Z)P - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THENG - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWS_F_NEWEST_BTIM) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_ENDN - F_COUNT = NEW_F_COUNT - END IFQ - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1R - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM))A - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_NEWEST_EX_BTIM_KEY(5:)A - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURND - END - - - - SUBROUTINE SEND_POSTF - - IMPLICIT INTEGER (A-Z) T - - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - I - CHARACTER FILE*132 - - C = 0 - - IF (.NOT.NEWS_LOGIN()) RETURNU - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST',FILE,C)) _ - IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURN' - IF (BUFFER(:3).NE.'340') RETURN - - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (INPUT(:5).EQ.'From:') - & BULL_PARAMETER = INPUT(7:INDEX(INPUT,'@')-1)F - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IF - END DO - IF (INPUT.NE.'.') THEN E - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - IF (BUFFER(:3).NE.'240') THEN - CLOSE (UNIT=3) - CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER))I - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER)U - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD')T - END IF - CLOSE (UNIT=3,STATUS='DELETE') - END DOE - -100 CLOSE (UNIT=3) - - RETURNU - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) D - - INCLUDE '($MAILDEF)' - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVS+ - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST) - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0)P - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVSR - - IF (UNAME.EQ.'()') THEN - UNAME = ' 'A - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IFA - - RETURNE - END diff --git a/decus/vms94b/bulletin/bulletin11.for b/decus/vms94b/bulletin/bulletin11.for deleted file mode 100644 index 38c437b..0000000 --- a/decus/vms94b/bulletin/bulletin11.for +++ /dev/null @@ -1,2967 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:56:46.56 -To: EVERHART -CC: -Subj: BULLETIN11.FOR - -Date: Fri, 19 Aug 1994 17:26:04 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172604.21438991@PFC.MIT.EDU> -Subject: BULLETIN11.FOR - -C -C BULLETIN11.FOR, Version 5/11/94 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DOU - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURNu - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36T - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 03 - - DO I=1,2E - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM,n - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THENs - IER = 0e - TAG_TYPE = IBSET(TAG_TYPE,I) - END IFa - END IF - END DOt - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND.e - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36U - END IF - END IFE - - RETURNR - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36N - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURNT - - HEADER = .FALSE._ - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0E - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM)E - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)),P - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DOI - IF (IER.EQ.0) THENR - IF (J.EQ.1) THEN - MESSAGE = MNUMI - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUMH - I = 2 - END IF - END IFL - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM)B - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I)( - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND.A - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)),( - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF: - END IFe - RETURN' - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THENd - RETURN - END IF - END DO( - - RETURNT - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC'O - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT)R - CLOSE_IT = .NOT.CLOSE_ITO - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36M - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM)A - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM))T - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM))E - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THENF - IER = 0 - MESSNUM = IR - ELSEp - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUMN - NEXT = .FALSE.N - CALL READDIR(MESSNUM,IER1)A - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE.E - CALL READDIR(MESSNUM,IER1) - END IFL - IF (IER1.NE.MESSNUM+1) THEN - IER = 36( - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSEL - NEXT = OLD_NEXT1 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF( - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN1 - IER = 36n - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF_ - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1E - MSG_NUM = MESSNUM' - END IFM - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z)G - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'. - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE()B - IF (SUBNUM.GT.FOLDER_MAX-1) RETURNU - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THENE - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0s - END IFf - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1,L - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)))S - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)-S - & NEWS_TAG(1,I,SUBNUM))/8+1,) - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP))E - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)-L - & NEWS_TAG(1,I,SUBNUM))/8+1,R - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMPB - END IF( - END DO - END IFP - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - R - RETURNT - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START)G - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32E - J = NUM - START - I*32_ - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURNI - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START)L - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32( - J = NUM - START - I*32_ - - TAGS(I+1) = IBCLR(TAGS(I+1),J)A - - RETURNY - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32' - J = NUM - START - I*32M - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURNI - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE)E - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF) - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE),N - & IOSTAT=IER1)E - END DOE - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1)2 - - RETURNE - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM)M - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC'G - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAGT - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))0 - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSEO - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1D - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),I - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IFR - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z)H - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLUSER.INC'B - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARKH - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECI - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))S - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)T - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)_ - - CHARACTER*12 BULL_MARK_DIR_ - CHARACTER*12 TAG_KEY,INPUT_KEYT - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)T - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSEL - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0( - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,N - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER))E - NTRIES = NTRIES + 1 - END DOa - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1))R - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,)U - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) ( - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DOE - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP',- - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,Z - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER))2 - NTRIES = NTRIES + 1 - END DO, - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1)L - ELSE - UNLOCK 13 - END IF - END IF - - NTRIES = 0H - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)I - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD',E - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER))1 - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE.E - END IF - - DO WHILE (REC_LOCK(IER1))H - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),)N - IF (IER1.NE.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR//L - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128,DISPOSE='DELETE',, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER))A - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1)E - NEWS_MARK2(1) = NEWS_MARK2(2)E - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0S - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE')W - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR//L - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,U - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DOM - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) N - IER1 = 1T - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE(L - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO( - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS()B - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP',B - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR//E - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,_ - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DOJ - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DON - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IFT - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)S - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IERB - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IFU - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0R - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBERI - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0)I - DO WHILE (REC_LOCK(IER))_ - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DOL - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN1 - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23)M - ELSE - UNLOCK 23 - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - SUBNUM = 0S - ELSET - DO I=1,2& - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0T - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1,( - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DON - END IFI - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN. - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23)T - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1L - ELSEM - TAG_TYPE = 2T - END IFT - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM,( - & TAG_TYPE)V - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF1 - END IF - END IFI - END IF( - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVER - CALL CLOSE_BULLNEWSS - END IFU - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE)_ - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC'E - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THENU - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),a - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURNE - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1),( - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM)O - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IFT - - RETURNN - END - - - - SUBROUTINE OPEN_NEW_TAG(IER)F - - IMPLICIT INTEGER (A-Z)1 - - INCLUDE 'BULLUSER.INC'. - - INCLUDE 'BULLFOLDER.INC'Y - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARKE - DIMENSION NEWS_MARK(128)C - - CHARACTER*12 BULL_MARK_DIR - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER)M - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IFP - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW',I - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSEI - MARKUNIT = 233 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW',D - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)), - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0L - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVSE - IF (IER.NE.0) THEN. - WRITE (6,'('' Cannot create mark file.'')')E - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THENN - WRITE (6,'('' IOSTAT error = '',I)') IERM - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1D - END IF - ELSE' - IF (.NOT.IER1) THENF - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)')E - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1R - END IF - - RETURN, - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY))E - ELSEE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF' - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:))I - - RETURNT - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z)( - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEYH - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THENK - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IF( - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0I - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY)N - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADERR - END IF - RETURN - END IF - - MSG_KEY = BULLDIR_HEADERF - - HEADER = .TRUE. - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DOO - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I)R - - RETURNS - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)T - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - TAG_TYPE = 0D - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER))' - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DOA - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I)U - END IF - END DOT - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR.V - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN - IF (IER.EQ.0) UNLOCK 13 - IER = 0M - MESSAGE = MSG_NUM( - ELSEE - IER = 36 - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEYA - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)_ - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF, - - IER = 36 - - HEADER = .FALSE.R - - TAG_TYPE = 0, - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - RETURN - END IFG - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),K - & IOSTAT=IER) INPUT_KEYW - END DO - IF (IER.EQ.0) THEN - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IFE - IF (IER.EQ.0) THENG - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:) - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THEN_ - I = 2 - END IF - END IFI - END IFL - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER))U - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I)= - IER = 0 - RETURND - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THENL - MSG_KEY = NEXT_MSG_KEYI - RETURN - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DO - - RETURN, - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE)U - - IMPLICIT INTEGER (A-Z)( - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT)_ - CLOSE_IT = .NOT.CLOSE_IT& - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHAREDD - - DO MESSAGE = MSG_NUM+1,F_NBULLF - CALL READDIR(MESSAGE,IER)R - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE)U - IF (IER.EQ.0) THEN - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IFE - END IF - END DO - - IER = 36E - IF (CLOSE_IT) CALL CLOSE_BULLDIR. - - RETURN6 - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z)N - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2)U - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURN - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J)L - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEYN - - DO WHILE (REC_LOCK(IER))L - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER)I - & INPUT_KEY - END DOM - - CLOSE_IT = .FALSE.N - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY)% - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)G - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR) - RETURNE - ELSE - CALL DECREMENT_MSG_KEYN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THENY - CALL OPEN_BULLDIR_SHAREDE - CLOSE_IT = .TRUE. - END IFP - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:))T - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THENB - MESSAGE = MESSAGE - 1I - MSG_NUM = MESSAGEK - MSG_KEY = BULLDIR_HEADER - END IFL - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIRI - RETURN - ELSEI - DELETE (UNIT=13)E - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF1 - DO WHILE (REC_LOCK(IER))M - READ (13,IOSTAT=IER) INPUT_KEYP - END DO - END IF_ - END IF - - END DO - - END - - - - SUBROUTINE CLOSE_TAGA - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'D - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECS - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))R - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)K - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)F - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE.T - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1 - DO M=1,2D - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN& - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1L - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1 - LIMIT = 256/(NEWS_FORMAT+1)' - NEWS_NUMBER = LAST_NEWS_READ2(1,I)N - K = 5-NEWS_FORMAT*21 - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THENQ - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1 - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN. - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IFC - SET_LIST = .FALSE. - END IFY - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0)_ - END DO - K = LIMIT + 1 - END IFB - IF (K.GT.LIMIT) THENM - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2G - NEWS_REC = NEWS_REC + 1L - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER)I - IF (IER.EQ.0) THENH - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IF - END DO - END IF - END DO - END DO - CLOSE (UNIT=23)L - END IFE - - RETURNE - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_MARK/ NEWS_MARKM - DIMENSION NEWS_MARK(128)R - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECE - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))H - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)G - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)E - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = JR - ELSE( - NEWS_MARK(I) = J - END IFT - - RETURNE - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG)P - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUME - NEWS_TAG(I) = 0D - END DOI - - RETURNE - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLUSER.INC'2 - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))G - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)1 - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)T - - DO I=1,2D - IF (NEWS_TAG(3,I,ISUB).GT.0) THEN - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB))I - NEWS_TAG(3,I,ISUB) = 0N - NEWS_NUMBER = NEWS_FOLDER_NUMBERL - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER)W - END IF - END DO - END IF - - DO J=I,FOLDER_MAX-2S - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J)) - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0K - END DO - END DO - - RETURNJ - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE)N - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEYE - - IER = 36_ - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE)L - IF (IER.EQ.0) THEN - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THEN - IF (.NOT.BTEST(READ_TAG,3)) THEN3 - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM)T - END IF - IER = 36 - END IF - END IF - END DO - BULL_READ = MSG_NUMN - IF (CLOSE_IT) CALL CLOSE_BULLDIR R - ELSE - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0E - MSG_KEY = BULLDIR_HEADER - IER = 0' - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THENT - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IFS - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)R - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEYR - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36D - END IF - END IF - - RETURNC - END - - - SUBROUTINE DECREMENT_MSG_KEY - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1)I - I = 9 - ELSE - I = I + 1 - END IF - END DOC - - RETURN( - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERICE -CE -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying' -C general bulletins continually for a certain amount of days.R -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IFE - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THENF - IF (GENERIC) THEN_ - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7'L - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')')Y - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -CL -C SUBROUTINE SET_BRIEF_CONTINUOUS -CK -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -CG - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC'L - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSEE - NEW_FLAG(2) = 0E - END IFA - - IF (IER.EQ.0) REWRITE (4) USER_ENTRYS - - CALL CLOSE_BULLUSER - - RETURNU - END - - - SUBROUTINE SET_LOGIN(LOGIN) -CM -C SUBROUTINE SET_LOGINO -CT -C FUNCTION: Enables or disables bulletin display at login.E -CD - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*24U - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THENB - WRITE (6,'(U - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IFM - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)B - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)- - IF (IER.EQ.0) THENF - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THENT - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z)W - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2). - - CALL INIT_ITMLST( - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT))H - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST)( - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4)K - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1E - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1)) - - CALL DISABLE_PRIVS - - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))// - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:)) - END DO - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR)F - - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100. - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO))D - I = INDEX(SENDTO(J:),',') - 1 - IF (I.EQ.-1) I = TRIM(SENDTO(J:))T - CALL INIT_ITMLSTE - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - J = J + IL - IF (SENDTO(J:J).EQ.',') J = J + 1E - END DOS - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT))8 - IF (SETPRV_PRIV()) THEN - CALL ENABLE_PRIVSE - CALL ADD_2_ITMLSTM - & (TRIM(USERNAME),MAIL$_SEND_FROM_LINE,%LOC(USERNAME)) - END IFN - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO)) - CALL END_ITMLST(ATTRIBUTE_ITMLST)2 - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVSE - CALL LIB$REVERT - - RETURN - END2 - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,). - - RETURN - END - - - - - SUBROUTINE SET_NEWS, - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_PA - CHARACTER*64 BULL_PARAMETER - F - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /KEEPLOCK/ KEEPLOCKN - - COMMON /NEXT/ NEXT - - DIMENSION EXPIRED(2)L - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN, - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IFT - - ENTRY SHOW_NEWS - - LIMIT = -2A - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1))D - IF (.NOT.IER.OR.LIMIT.LT.-1) THENT - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')')S - RETURN= - END IF M - END IF - - EXPIRE = -1U - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1))O - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURNE - END IF N - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR._ - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')')F - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder fileU - - IF (CLI$PRESENT('DEFAULT')) THEND - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)A - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1. - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')')S - CALL CLOSE_BULLNEWS - RETURN, - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE')R - END IF - RETURNE - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)d - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER))o - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DOP - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULTt - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULTL - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)C - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE)R - FOLDER1_NUMBER = NEWS_F1_COUNTN - FOLDER1 = BULL_PARAMETERI - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10)F - CALL WRITE_FOLDER_FILE_TEMP(IER)3 - IF (IER.NE.0) THEN' - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURNE - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMPl - REWRITE (7) NEWS_FOLDER1_COMi - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER)e - END IF v - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDERC - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURN_ - END IF - END IFS - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS')U - DEFAULT = CLI$PRESENT('DEFAULT')D - ALL = CLI$PRESENT('ALL')N - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE')B - ENABLE = CLI$PRESENT('ENABLE')R - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - L - STORED = 0E - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0R - F1_START = 0O - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IFE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,: - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ')T - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN - WRITE (6,'('' Stored setting was not removed.'')')' - CALL CLOSE_BULLNEWS - RETURNN - END IFD - IF (DEFAULT) THEN, - CALL LIB$DELETE_FILE(BULLNEWSDIR_FILE(A - & :TRIM(BULLNEWSDIR_FILE))//';*') L - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))= - & //'[.BULLNEWS*]*.*;*')I - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*')O - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THENK - CALL CLOSE_BULLNEWSK - FOLDER_SAVE = FOLDERB - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBERE - CALL SELECT_FOLDER(.FALSE.,IER) - END IFE - FOLDER = FOLDER_SAVEC - CALL OPEN_BULLDIR_SHARED - KEEPLOCK = .TRUE. - NEXT = .TRUE. - BULL_DELETE = 1 - F_START = 0 - F_NBULL = 999999) - CALL READDIR(BULL_DELETE,IER) - DO WHILE (IER.EQ.BULL_DELETE+1) - DELETE (2) - CALL READDIR(BULL_DELETE,IER)L - END DO - NEXT = .FALSE.U - KEEPLOCK = .FALSE./ - CALL CLOSE_BULLDIR - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0 - F1_NBULL = 0H - F1_COUNT = 0 - F1_LAST = 0) - END IF( - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8)N - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)M - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN_ - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),D - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THENA - CALL SET_PROTECTIONE - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP),I - & STATUS='OLD',IOSTAT=IER)L - CLOSE (UNIT=3) - IF (IER.NE.0) THEN ( - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER)S - CLOSE (UNIT=3)N - END IF - CALL RESET_PROTECTIONS - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IFA - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)( - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN F - NEWS_FLAG_DEFAULT = NEWS_F1_FLAGM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE) - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IFS - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THENG - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') G - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')')F - ELSE - WRITE (6,'('' Default is not stored.'')')B - END IFA - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)W - ELSE IF (CLASS) THENE - WRITE (6,'('' Expiration is DEFAULT value.'')')O - ELSEa - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')')I - END IF, - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,), - IF (F1_EXPIRE_LIMIT.GT.0) THEN) - WRITE (6,'('' Default expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')')O - ELSER - WRITE (6,'('' There is no default expiration limit.'')') - END IFu - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IFI - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)Y - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')')' - ELSE' - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)F - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)S - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE: - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,)( - IF (F1_EXPIRE_LIMIT.GT.0) THENE - WRITE (6,'('' Expiration limit is '',A,''.'')')I - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE. - WRITE (6,'('' There is no expiration limit.'')') - END IF= - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IFE - NOTIFY_FLAG_NEWS = .FALSE. - SET_FLAG_NEWS = .FALSE. - BRIEF_FLAG_NEWS = .FALSE.B - CALL OPEN_BULLINF_SHAREDE - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC0 - END DO) - IF (IER1.EQ.0) THENM - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1= - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a default news group.'')')K - ELSE - IER1 = 2 - END IF - END IF_ - NOTIFY_PERM_FLAG_NEWS = .FALSE. - SET_PERM_FLAG_NEWS = .FALSE.L - BRIEF_PERM_FLAG_NEWS = .FALSE. - DO WHILE (REC_LOCK(IER2)) - READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC - END DO - IF (IER2.EQ.0) THENE - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1L - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13)R - SET_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a permanent news group.'')')T - END IF= - END IFL - PERM = .FALSE. - IF (SET_FLAG_NEWS) THEN - IF (BRIEF_FLAG_NEWS) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSEN - WRITE (6,'('' Default is BRIEF.'')') - END IF0 - ELSEO - IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THENF - PERM = .TRUE.D - WRITE (6,'('' Default is READNEW, which is permanent.'')')) - ELSE - WRITE (6,'('' Default is READNEW.'')')D - END IF - END IF2 - ELSE IF (BRIEF_FLAG_NEWS) THEN - IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE.' - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')'). - ELSEM - WRITE (6,'('' Default is SHOWNEW.'')')' - END IF - END IF - IF (.NOT.PERM) THEN_ - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (BRIEF_PERM_FLAG_NEWS.AND..NOT.SET_PERM_FLAG_NEWS) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IFS - END IF - IF (NOTIFY_FLAG_NEWS) THEN - IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE IF (IER1.EQ.0) THENB - WRITE (6,'('' Default is NOTIFY.'')') - END IF( - ELSE IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' NOTIFY is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NONOTIFY.'')')1 - END IF - CALL CLOSE_BULLINF - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSEA - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS)R - END IFF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IFI - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWS - RETURN - END IFP - - IF (CLASS.AND.(ALL.OR.FLAG)) THENR - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER)A - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN( - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER)L - END IF - FOUND = .FALSE.N - MODALL = INDEX(GROUP,'.').NE.LG3 - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR.T - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.')) - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN F - CALL CLOSE_BULLNEWSE - FOLDER_NUMBER = FOLDER1_NUMBERW - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THENP - CALL OPEN_BULLDIR_SHARED - KEEPLOCK = .TRUE. - NEXT = .TRUE.F - BULL_DELETE = 1 - F_START = 0E - F_NBULL = 999999 - CALL READDIR(BULL_DELETE,IER)W - DO WHILE (IER.EQ.BULL_DELETE+1) - DELETE (2)D - CALL READDIR(BULL_DELETE,IER) - END DO S - NEXT = .FALSE. - KEEPLOCK = .FALSE. - CALL CLOSE_BULLDIR - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 06 - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) D - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)R - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0' - F1_COUNT = 0e - F1_START = 0 - F1_NBULL = 0' - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)e - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER)r - END DOi - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP)1 - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER)( - DELETE (7) ' - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER)E - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER)L - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER))s - END IF - RETURN - END IFT - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0S - DO WHILE (IER.EQ.0)6 - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0T - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0T - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0I - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)E - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)v - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER)S - END DO - END IFG - - FOLDER_NUMBER = -1C - FOLDER1 = FOLDERA - CALL SELECT_FOLDER(.FALSE.,IER)) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0= - CALL SELECT_FOLDER(.FALSE.,IER)E - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER))D - END IFR - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'N - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFERI - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMF - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'H - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)N - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN_ - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IF - - FULL = CLI$PRESENT('FULL')F - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P)) THENe - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURNR - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file' - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)I - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN. - IF (CLI$PRESENT('SUBJECT')) THENG - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)' - ELSEH - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IFP - ELSE - INPUT = FROMA - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:)E - ELSER - INPUT = DESCRIP - END IFt - END IF - - CALL CLOSE_BULLFIL - END IFE - - IF (CLI$PRESENT('SUBJECT')) THEN - INPUT = 'SUBJECT:'//INPUTp - ELSEt - INPUT = 'FROM:'//INPUT - END IF - - IF (EXCLUDE) THEN - INPUT = ':EXCLUDE:'//INPUT - ELSEA - INPUT = ':INCLUDE:'//INPUT - END IF - - FLEN = TRIM(FOLDER_NAME)) - INPUT = FOLDER_NAME(:FLEN)//INPUT - - ILEN = TRIM(INPUT)i - ALL = CLI$PRESENT('ALL')I - DISABLE = CLI$PRESENT('DISABLE')E - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) - & WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)e - CLOSE (UNIT=4,DISPOSE='SAVE')F - RETURN - END IFI - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERC - IF (IER.EQ.0) THEN I - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THENW - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5) - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill' - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF (STREQ(OLD_BUFFER(:OLEN),INPUT(:ILEN))) THEN - IF (.NOT.DISABLE) THEN - WRITE (6,'('' ERROR: Entry already present.'')') g - CLOSE (UNIT=4) - CLOSE (UNIT=3) - RETURN - END IF - ELSE IF (.NOT.(ALL.AND.INPUT(:FLEN+8).EQ.U - & OLD_BUFFER(:MIN(FLEN+8,OLEN)))) THEN - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN)M - END IFR - END IF - END DOO - - IF (.NOT.DISABLE) THEN= - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - IF (FULL) WRITE (4,'(A)',IOSTAT=IER) - & FOLDER_NAME(:FLEN)//':defaults:kill'E - END IF) - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE SET_CUSTOM(PARAM)M -CW -C SUBROUTINE SET_CUSTOM -CT - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*(*) PARAM - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'O - - CALL DISABLE_PRIVSE - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)1 - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IFR - - LENP = LEN(PARAM) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0.AND.PARAM(:LENP).NE.INPUT(2:LENP+1)) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)R - END IF - END DO - - IF (CLI$GET_VALUE('SET_PARAM2',INPUT,ILEN)) THEND - WRITE (4,'(A)',IOSTAT=IER) ':'//PARAM(:LENP)//':'//INPUT(:ILEN)N - END IF - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOML - DATA BULL_USER_CUSTOM/.FALSE./R - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEG - DATA SCRATCH_B1/0/, - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORYR - CHARACTER*64 FILE_DIRECTORY - - FILE_DIRECTORY = ' ' - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THENa - BULL_USER_CUSTOM = .FALSE. - ELSER - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IFE - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'L - - OPEN(UNIT=17,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)),L - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURNE - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?T - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headE - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER)E - SCRATCH_B1 = SCRATCH_B ! Init header pointerL - END IFR - - NINCLUDE = 0 - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ.R - & OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+1,OLEN))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1)u - CALL LOWERCASE(OLD_BUFFER) - IF (INDEX(OLD_BUFFER(TRIM(FOLDER_NAME)+2:),'defaults') - & .EQ.1) THENE - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1 - END IFN - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THENE - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - IF (INDEX(OLD_BUFFER,':file_directory').GT.0) - & FILE_DIRECTORY = OLD_BUFFER(17:) - END IF - END DOR - - CLOSE (UNIT=17) - - RETURN - END - - - - R - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1)R - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'i - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./L - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEU - DATA SCRATCH_B1/0/ - - CHARACTER*(*) STRING,STRING1E - - INCLUDE_MSG = .TRUE.M - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURNP - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME)C - - INC = .FALSE. - - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)) - OLEN = TRIM(OLD_BUFFER)E - IF (STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THENS - IF (.NOT.INC) INCLUDE_MSG = .FALSE. - INC = .TRUE.R - END IFL - IF ((STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:').AND.L - & (STRFIND(STRING(:TRIM(STRING)),OLD_BUFFER= - & (FLEN+15:OLEN)).OR.P - & STREQ(STRING(:TRIM(STRING)),OLD_BUFFER - & (FLEN+15:FLEN+14+TRIM(STRING))))).OR.N - & (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND.A - & STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER - & (FLEN+18:OLEN)))) THEN - INCLUDE_MSG = STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')' - IF (.NOT.INCLUDE_MSG) RETURNn - END IF - END IF - END DO_ - - RETURN - END - - - - FUNCTION STRFIND(STRING,STRING1)p - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) STRING,STRING1! - - L = LEN(STRING1) - DO I=0,LEN(STRING)-LO - J = 1d - DO WHILE (J.LE.L)' - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J))) - IF (DIFF.NE.0.AND.DIFF.NE.32) THENL - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = .TRUE. - RETURNT - ELSEO - J = J + 1I - END IFG - END DO - END DO' - - STRFIND = .FALSE. - - RETURNE - END - - - - - SUBROUTINE SET_NEWNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)P - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX)T - - CHARACTER*12 NEW,OLD. - - IF (.NOT.SETPRV_PRIV()) THENH - WRITE (6,'('' ERROR: No privs to set a new name.'')')D - RETURN - END IFt - - CALL CLI$GET_VALUE('OLDNAME',OLD,LENO)D - CALL CLI$GET_VALUE('NEWNAME',NEW,LENN) - - CALL OPEN_BULLUSER_SHARED - - TEMP_USER = USERNAMEF - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY - END DO - - IF (IER.EQ.0) THENP - USERNAME = NEW - DO WHILE (REC_LOCK(IER))E - READ (4,IOSTAT=IER,KEYEQ=NEW) - END DO A - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) USER_ENTRY - ELSE - REWRITE (4,IOSTAT=IER) USER_ENTRY - END IF & - END IF - - USERNAME = TEMP_USER: - DO WHILE (REC_LOCK(IER1))S - READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY - END DO - - CALL CLOSE_BULLUSER - - IF (IER.NE.0) THENE - WRITE (6,'('' ERROR: Old name not found.'')') - RETURN - END IF' - - CALL OPEN_BULLINF_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER). - END DO - IF (IER.NE.0) THENE - WRITE (9,IOSTAT=IER) NEW,LAST5 - ELSE - REWRITE (9,IOSTAT=IER) NEW,LASTU - END IF - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER))U - READ (9,KEY=NEW,IOSTAT=IER) - END DO N - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF E - ELSE - DO WHILE (REC_LOCK(IER)): - READ (9,KEY=NEW,IOSTAT=IER) - END DO ) - IF (IER.EQ.0) DELETE (9) - END IF) - OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO)))N - NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN)))4 - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - IF (LENO.GT.1) THEN - OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1)))( - ELSED - OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2)))E - END IFL - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - IF (LENN.GT.1) THEN - NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1))) - ELSE - NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))) - END IFM - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THENL - DO WHILE (REC_LOCK(IER))A - READ (9,KEY=NEW,IOSTAT=IER) - END DO _ - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF G - ELSE - DO WHILE (REC_LOCK(IER))M - READ (9,KEY=NEW,IOSTAT=IER) - END DO A - IF (IER.EQ.0) DELETE (9) - END IF - - CALL CLOSE_BULLINFR - - RETURN - ENDN diff --git a/decus/vms94b/bulletin/bulletin2.for b/decus/vms94b/bulletin/bulletin2.for deleted file mode 100644 index 0f41c51..0000000 --- a/decus/vms94b/bulletin/bulletin2.for +++ /dev/null @@ -1,2387 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:51:00.77 -To: EVERHART -CC: -Subj: BULLETIN2.FOR - -Date: Fri, 19 Aug 1994 17:25:42 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172542.21438991@PFC.MIT.EDU> -Subject: BULLETIN2.FOR - -C -C BULLETIN2.FOR, Version 8/10/94 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::'.OR.NEWS_FEED()) THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1)N - SHUTDOWN_BTIM(2) = UP_BTIM(2). - END IF - - CALL GET_UPTIME(UPDATE,UPTIME)P - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM)L - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THENt - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1f - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IFE - - IF (IER.NE.0) THENI - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG, - ELSE4 - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION,o - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGD - END IFI - - CALL READ_PERME - - IF (.NOT.FILE_OPENED) THEN) - CALL CLOSE_BULLUSERU - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAMEN - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSERS - RETURN - END IF - END IF - END IFA - - RETURN - END - - - I - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z)B - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listL - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlistl - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command.S -CF -C NODE_AREA is set to 0 after shutdown messages are deleted.e -C If node is not part of cluster, NODE_AREA will be 0,7 -C so set it to 1 as a dummy value to cause messages to be deleted. -CL - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURND - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -CE -C SUBROUTINE SET_NODE -C. -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLUSER.INC') - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT. - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name& - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileE - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')')E - IER = 1 - END IFi - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER)C - CALL CLOSE_BULLFOLDER - RETURNP - END IF - CALL CLOSE_BULLFOLDERA - END IF - - IF (FOLDER_NUMBER.EQ.0) THENF - WRITE (6,'('' Cannot set remote node for the default folder.'')')O - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THENE - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THENR - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET? - REMOTE_SET = .FALSE.R - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//H - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVEb - END IFC - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE.) - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,i - & 'Are you sure you want to make folder '//T - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURNN - END IF6 - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THENy - FOLDER1 = FOLDER - END IFL - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THENE - WRITE (6,'(E - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSEE - WRITE (6,'('' Folder has been converted to remote.'')')L - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE.B - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin fileT - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file.: - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IFD - REMOTE_SET = REMOTE_SET_SAVE( - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)_ - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,S - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0N - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULLM - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1)N - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2)T - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMITU - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER) - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')')N - END IFR - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileI - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//M - & FOLDER - END IFS - - RETURNS - END - - - - - SUBROUTINE RESPONDN -CN -C SUBROUTINE RESPOND' -C) -C FUNCTION: Sends a mail message in reply to a posted message.M -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands., -CT - IMPLICIT INTEGER (A - Z)D - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTA - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP2 - CHARACTER*(INPUT_LENGTH) INDESCRIPE - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THENA - BULL_PARAMETER = 'news group.' - ELSEe - BULL_PARAMETER = 'mailing list.' - END IFD - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.'L - ELSE - BULL_PARAMETER = 'message owner and mailing list.'D - END IF - MSG_OWN = .TRUE.. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.'I - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE) - BULL_PARAMETER = 'message owner and mailing list.'A - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE! - BULL_PARAMETER = 'mailing list.' - END IFO - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IFM - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THENM - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURNE - END IF_ - - WRITE (6,'('' Sending message to '',A)')A - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found?R - WRITE(6,'('' ERROR: Bulletin was not found.'')')M - CALL CLOSE_BULLDIR ! If not, then error outE - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENB - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'RE:'//INDESCRIP(4:)L - ELSE - INDESCRIP = 'RE: '//INDESCRIP - END IF - END IFO - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THENt - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURNP - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THENE - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES)R - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THENo - WRITE(6,'('' Enter subject of message:'')')E - CALL GET_LINE(INDESCRIP,LENDES)l - IF (LENDES.LE.0) THENL - WRITE(6,'('' ERROR: No subject specified.'')')I - RETURNA - END IF - ELSEE - WRITE (6,'('' Message will have the subject:'')')p - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IFI - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THENE - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSEO - EDIT = .FALSE. - END IFI - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0d - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY,A - & SHARED,IOSTAT=IER,FORM='FORMATTED') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Specified file cannot be opened.'')') - RETURN - END IF - END IFD - - FOUNDFILE = FILESPECE - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)W - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900N - END IFT - - LENFRO = 0i - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) E - CALL ADD_PROTOCOL(INPUT,ILEN)e - IF (LENFRO.EQ.0) THEN' - INFROM = INPUT(:ILEN)//','A - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO6 - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - ILEN = TRIM(INPUT) - IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(INPUT(7:),ILEN) - INFROM = INFROM(:LENFRO)//INPUT(7:) - LENFRO = LENFRO + ILEN - 6 - END IFt - IF (EDIT.AND.TEXT) THEN - IF (INPUT(ILEN:ILEN).EQ.'"') ILEN = ILEN - 1C - INPUT = INPUT(7:ILEN) - ILEN = ILEN - 6 - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:)v - ILEN = TRIM(INPUT) - END IFL - WRITE (3,'(A)') 'In a previous article, '//I - & INPUT(:ILEN)//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM! - LENFRO = TRIM(FROM) + LENFROR - END IF - - IF (EDIT.AND.TEXT) THENR - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)V - END IF. - LEN_P = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',BULL_PARAMETER,LEN_P)O - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LEN_P.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN)O - ELSE - WRITE (3,'(A)') BULL_PARAMETER(:LEN_P)//INPUT(:ILEN): - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - END DOI - - IF (FILESPEC) THENN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DON - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF_ - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 01 - ICOUNT = 0 - DO WHILE (IER.EQ.0)= - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUTR - IF (IER.EQ.0) THENE - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IFN - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THENO - CLOSE (UNIT=3,STATUS='DELETE')F - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THENR - SLIST = INDEX(FOLDER_DESCRIP,'<')R - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THENN - INPUT = FOLDER_DESCRIP(SLIST+1:)T - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)M - INPUT = INPUT(:ILEN)e - CALL ADD_PROTOCOL(INPUT,ILEN)o - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1N - END IFZ - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSEO - FOLDER1_DESCRIP = T - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1)E - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900N - END IFO - END IFE - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')')T - GO TO 900 - END IF - END IFL - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO)N - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')B - CONTEXT = 0m - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THENo - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSER - IER = 0w - END IF( - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME)L - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP)g - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')')t - END IF - END IF0 - IF (IER.EQ.0.AND.LENFRO.GT.0) THENr - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS)A - END IFE - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,c - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')n - IF (.NOT.FILESPEC) THEN - WRITE (6,'('' Enter message: End with ctrl-z,'',D - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input lineI - ICOUNT = 0 ! Character count counter' - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too longN - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch fileN - END IF - END DO. - ELSE - IER = 0 - ICOUNT = 0_ - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUTN - IF (IER.EQ.0) THENE - ICOUNT = ICOUNT + 1T - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DOA - CLOSE (UNIT=4) - FILESPEC = .FALSE.F - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3)D - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,) - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSEI - IER = 0 - END IFG - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THENx - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM,( - & INDESCRIP,STATUS) - END IFt - END IF - END IF: - IF (IER.NE.0) THENL - WRITE (6,'('' ERROR: No message added.'')')L - IF (.NOT.STATUS) THEN: - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): '): - IF (STREQ(INPUT(:1),'Y')) THENP - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV')L - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF_ - END IF - END IF - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')= - - RETURNE - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C -C SUBROUTINE ADD_SIGNATUREL -CE -C FUNCTION: Adds signature to message being mailed/posted.S -C) - IMPLICIT INTEGER (A-Z)P - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATUREA - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/L - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURNS - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THENX - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY,, - & SHARED,IOSTAT=IER,FORM='FORMATTED')N - END IFA - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY,C - & SHARED,IOSTAT=IER,FORM='FORMATTED')F - END IFF - - IF (IER.NE.0) RETURNN - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED')V - END IF, - - ICOUNT = 0 - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUTF - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME))) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THEN( - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUTE - ILEN = TRIM(INPUT)F - END DO. - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IF - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE.= - ELSEN - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' '= - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN)N - END IFD - END IF - END DOT - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURN( - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1)r - - IMPLICIT INTEGER (A-Z)& - - CHARACTER*(*) INPUT,INPUT1 - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.DIFF.NE.32) RETURN - END DOO - - STREQ = .TRUE.N - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -CH -C SUBROUTINE RESPOND_MAIL -CE -C FUNCTION: Sends mail to address.D -C. - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'N - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,INDESCRIP*(LINE_LENGTH)u - - INDESCRIP = SUBJECT - LENDES = TRIM(INDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES)( - IF (INDESCRIP(I:I).EQ.'"') THENT - IF (LENDES.EQ.LINE_LENGTH) THEN - INDESCRIP(I:I) = '`'N - ELSEN - INDESCRIP = INDESCRIP(:I)//'"'L - & //INDESCRIP(I+1:)) - I = I + 1 - LENDES = LENDES + 1 - END IFD - END IF - I = I + 1N - END DO - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0D - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0A - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD)n - - IF (LISTSERV) THENN - IF (SYS_TRNLNM('MX_NODE_NAME',MAILER)) THENE - REPLY_TO = .NOT.SYS_TRNLNM('MX_REPLY_TO',MAILER)C - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - REPLY_TO = .NOT.SYS_TRNLNM('PMDF_REPLY_TO',MAILER)+ - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - END IF - END IFN - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THENI - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))//) - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)U - & //'""" """'//INDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IF - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//INDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSEO - I = INDEX(SENDTO,'%""') + 3 - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THENP - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THENg - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THENt - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THENI - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & INDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS)X -C -C Use the following if you do not have VMS V5.3 or greater.T -C' -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//INDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IFN - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV) THENN - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('PMDF_REPLY_TO')F - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('MX_REPLY_TO')W - END IFY - - RETURNL - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C. -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C' - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAMER - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURNI - END - - - - - - SUBROUTINE REPLACEF -CE -C SUBROUTINE REPLACEI -C' -C FUNCTION: CHANGE command subroutine. -CL - IMPLICIT INTEGER (A - Z)A - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTi - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC'p - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWERN - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IFr - -C -C Get the bulletin number to be replaced. -Cr - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN' - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error) - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are readingN - EBULL = SBULL. - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entryI - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURNU - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')')x - RETURNN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THENC - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1). - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE.t - ELSE IF (CLI$PRESENT('ALL')) THEN) - SBULL = 1 - EBULL = NBULL - END IF - END IF& - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')')U - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THENB - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURNA - END IF - END IFa - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')')T - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THENO - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURNI - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE.S - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')'), - RETURN - END IF - END IFA - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'(E - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IFT -CR -C Check to see if specified bulletin is present, and if the userQ -C is permitted to replace the bulletin. -CT - - CALL OPEN_BULLDIR_SHAREDE - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL4 - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. S - END DOT - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR, - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner?L - WRITE(6,1090) ! If not, then error out. - RETURN( - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IFA - -C -C If no switches were given, replace the full bulletin -CN - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND.O - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND.L - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THENC - DOALL = .TRUE. - END IFC - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THENL - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')')f - RETURN - END IF. - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1)I - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23)L - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THENL - WRITE(6,1050) ! Request header for bulletinS - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF( - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIPY - LENDES = MIN(LENDES+6,LEN(INDESCRIP))R - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIRL - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')')M - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')')" - RETURN: - END IF - END IF - - REC1 = 0 - - LENFROM = 0M - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')" - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)O - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN). - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN/ - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN1 - INDESCRIP = INPUT(:ILEN)F - LENDES = ILEN - END IF& - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file2 - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal./ -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data) - REC1 = 1A - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)E - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specifiedT - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN_ - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specifiedt - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specifiedK - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST')- - CALL OPEN_BULLFIL_SHARED ! Prepare to copy messageM - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)O - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENL - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENT - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into fileR - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')% - END IF) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1')f - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',r - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THENe - CALL DISABLE_PRIVSe - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges? - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950R - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THENL - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with. - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1' - END IF - END IFS - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long.t - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTHO - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character countu - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THENR - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -CN -C Add bulletin to bulletin file and directory entry for to directory file. -CD - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR.p - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THENS - ! If message disappeared, try to find it.L - IF (IER.NE.NUMBER_PARAM+1) DATE = ' 's - NUMBER_PARAM = 0 - IER = 1A - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER)E - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find messageL - CALL CLOSE_BULLDIRA - CLOSE (UNIT=3,STATUS='SAVE')r - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')')E - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')')T - END IF, - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK)& - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.'T - CALL CLOSE_BULLFILO - CALL CLOSE_BULLDIRr - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER)I - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THENI - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entryI - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE: - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description headerS - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT,I - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THENN - SYSTEM = IBSET(SYSTEM,0)L - ELSE IF (CLI$PRESENT('GENERAL')) THENE - SYSTEM = IBCLR(SYSTEM,0)E - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR.W - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN& - MSGTYPE = IBSET(MSGTYPE,0)' - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THENT - MSGTYPE = IBSET(MSGTYPE,1)1 - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2)I - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THENA - MSGTYPE = IBSET(MSGTYPE,3)E - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIPO - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER)N - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COMF - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I)I - END IF - ELSE - CALL DISCONNECT_REMOTEL - END IF - END IF - END DOP - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3)2 - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN_ - -910 WRITE(6,1010)H - CLOSE (UNIT=3,ERR=100) - GOTO 100C - -920 WRITE(6,1020)F - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100. - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)o - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')/ -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')T -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.')C -1100 FORMAT(' Message(s) is not owned by you.',I - & ' Are you sure you want to replace it? ',$)$ -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME)( - - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THENN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER)N - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THENF - SYSTEM = IBCLR(SYSTEM,2)! - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER)O - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000'L - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000': - NODE_AREA = 0L - IF (INCMD(:4).EQ.'REPL') THEN= - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'',L - & '' Invalid node name specified.'')')R - END IFn - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)N - WRITE (EXTIME,'(I4)') NODE_NUMBERR - WRITE (EXTIME(7:),'(I4)') NODE_AREA0 - DO I=1,11o - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//S - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present timee - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IFf - - RETURNi - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C: -C SUBROUTINE SEARCH -C& -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z)) - - INCLUDE 'BULLFOLDER.INC't - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10) - - EXTERNAL CLI$_ABSENTL - - NFOLDER = 1 - - IF (CLI$PRESENT('SELECT_FOLDER')) THENI - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0. - END IF! - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAMEE - NFOLDER = NFOLDER + 1T - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DOe - - IF (CLI$PRESENT('SELECT_FOLDER')) SCRATCH_F = SCRATCH_F1 - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IFo - - IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:'S - SEARCH_LEN(1) = 3E - SEARCH_NUM = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' 'n - SEARCH_NUM = 1 - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1. - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM)D - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1. - ELSEV - SEARCH_STRING = ' '. - END IFE - - MATCH_MODE = 0M - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF6 - - IF (NFOLDER.GT.0) FOUND = 0 - - DO WHILE (NFOLDER.GT.0.AND.FOUND.LE.0)E - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR.( - & SCRATCH_F.NE.SCRATCH_F1) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL, - & CLI$PRESENT('REVERSE'),CLI$PRESENT('SUBJECT')F - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'), - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),MATCH_MODE)E - IF (FOUND.EQ.-1) THENL - NFOLDER = 0 - ELSE IF (FOUND.LE.0) THEN - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1) NFOLDER = NFOLDER - 1 - IF (NFOLDER.GT.0) THEN_ - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME)H - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0)O - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME))_ - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1F - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,( - & FOLDER1_NAME)E - END IFL - END IF - END DOD - END IF - END IF - END DOa - - IF (FOUND.GT.0) THENL - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletinE - ELSE IF (FOUND.EQ.0) THEN - WRITE (6,'('' No messages found with given search string.'')') - ELSE IF (FOUND.EQ.-2) THEN - WRITE (6,'('' ERROR: No more messages.'')')E - END IFA - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN, - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE)R -CN -C SUBROUTINE GET_SEARCH -CM -C FUNCTION: Search for bulletin with specified string -C( - IMPLICIT INTEGER (A - Z)T - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'C - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAGD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEXT/ NEXT - LOGICAL NEXT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*4 SAVECMD E - - CHARACTER*56 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_ASTR - - IF (TRIM(SEARCH_STRING).EQ.0) THENO - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - N - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')')C - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL0 - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THENo - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - - END IFn - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THENR - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3n - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4( - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THENS - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(START_BULL,IER) - IF (START_BULL+1.NE.IER) THEN) - WRITE (6,'('' ERROR: No message being read.'')')S - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLM - RETURNE - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2l - END IF - END IFE - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper caseL - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.( - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN T - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last0 - END IF - IF (REVERSE) THENT - START_BULL = MIN(START_BULL,NBULL-1)S - END_BULL = 1= - STEP_BULL = -1X - ELSE - END_BULL = NBULL - STEP_BULL = 1 - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIRN - CALL CANCEL_CTRLC_ASTE - CALL ENABLE_CTRL - RETURN - END IFu - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0R - BULL_SEARCH = START_BULL+1 - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR.4 - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY)Y - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY)L - END IF, - ELSEf - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,A - & BULL_SEARCH,DUMMY)E - END IFN - IF (IER.EQ.0) THENw - IER = BULL_SEARCH + 1 - ELSEE - GO TO 800 - END IFL - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THENA - IF (SEARCH_MODE.EQ.4) THENS - CALL STR$UPCASE(DESCRIP1,FROM) - ELSE1 - CALL STR$UPCASE(DESCRIP1,DESCRIP) - END IFU - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1.AND. - & DESCRIP1(:4).EQ.'RE: ')))) THEN - IF (.NOT.NEGATED) THEN% - FOUND = BULL_SEARCHL - GO TO 900D - END IF T - ELSE IF (FLAG.EQ.1) THENR - WRITE (6,'('' Search aborted.'')') - GO TO 900 - ELSE IF (NEGATED) THEN p - FOUND = BULL_SEARCH - GO TO 900 - END IF' - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THENL - IF (REMOTE_SET) THEN- - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTER - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900$ - END IF - END IF - ILEN = LINE_LENGTH + 1 - MATCHES = 0S - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE.( - END DO. - DO WHILE (ILEN.GT.0)= - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)H - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THEN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I)B - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR.N - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THEN - FOUND = BULL_SEARCHT - IF (.NOT.NEGATED) GO TO 900E - ELSE IF (FLAG.EQ.1) THENC - WRITE (6,'('' Search aborted.'')') - GO TO 900R - END IFH - END DOL - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THENJ - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCHE - GO TO 900 - ELSEE - FOUND = -1 - END IF - END IF - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULLN - END DO_ - -800 FOUND = 0 - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTEA - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - END IF - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - NEXT = .FALSE.N - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMDR - - RETURNW - END - ( - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE)O - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRINGF - L - OLD_MATCH = .FALSE.N - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURNN - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE.C - RETURN+ - END IFe - J = J + SEARCH_LEN(I) - END DO - - RETURN' - END - - - - SUBROUTINE UNDELETE -Cc -C SUBROUTINE UNDELETE -CO -C FUNCTION: Undeletes deleted message.: -C - IMPLICIT INTEGER (A - Z)I - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENTu - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')')U - RETURN - END IF -CC -C Get the bulletin number to be undeleted.L -CA - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?C - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I)V - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSEO - BULL_DELETE = BULL_POINT ! Delete the file we are readingV - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the userS -C is permitted to delete the bulletin.E -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?n - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IFi - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,r - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner?R - WRITE(6,1040) ! Then error out.E - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error outO - GOTO 100 - END IF - END IF - END IFI - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:)R - END IF - END IFA - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration dateE - WRITE (6,'('' Message was undeleted.'')')_ - ELSEM - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)A - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM' - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I)L - ELSEM - WRITE (6,'('' Message was undeleted.'')') - END IFI - ELSE - CALL DISCONNECT_REMOTE( - END IF - END IFI - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010)E - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.')I -1020 FORMAT(' ERROR: Specified message number has incorrect format.')E -1030 FORMAT(' ERROR: Specified message was not found.')S -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.')n - - END - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC'F - - CHARACTER*20 MAIL_PROTOCOLB - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - IF (INDEX(INPUT,'<').GT.0.AND. ! Name may be of form. - & INDEX(INPUT,'@').GT.INDEX(INPUT,'<')) THEN - INPUT = INPUT(INDEX(INPUT,'<'):)! personal-name - END IFE - - IF (LMAIL.EQ.0) THENA - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THENH - MAIL_PROTOCOL = MAILERX - END IF - LMAIL = TRIM(MAIL_PROTOCOL) - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%'. - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1. - RETURN) - END IF - END IFL - - AT = INDEX(INPUT,'@') - IF (AT.GT.0) INPUT = INPUT(:INDEX(INPUT(AT:),' ')+AT-2) - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"'E - - IF (ILEN.NE.0) ILEN = ILEN + LMAIL + 2 - - RETURNE - END diff --git a/decus/vms94b/bulletin/bulletin3.for b/decus/vms94b/bulletin/bulletin3.for deleted file mode 100644 index cf4cbf7..0000000 --- a/decus/vms94b/bulletin/bulletin3.for +++ /dev/null @@ -1,2298 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:43:31.65 -To: EVERHART -CC: -Subj: BULLETIN3.FOR - -Date: Fri, 19 Aug 1994 17:25:44 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172544.21438991@PFC.MIT.EDU> -Subject: BULLETIN3.FOR - -C -C BULLETIN3.FOR, Version 8/10/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'1 - - INTEGER DIR_BTIM(2) - -CT -C Now see if bulletins have been added since the user's previous0 -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in.o -Ci - BULL_POINT = -1 ! Init bulletin pointera - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THENh - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = STARTs - CALL CLOSE_BULLDIR - RETURNo - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THENC - START = START + 1 - CALL READDIR(START,IER)D - ELSE ! SYSTEM bulletin was not seenW - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSEE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF) - - CALL CLOSE_BULLDIR - - RETURNC - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER)L - - IMPLICIT INTEGER (A-Z)P - - INCLUDE 'BULLUSER.INC'- - - INCLUDE 'BULLFOLDER.INC't - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2)_ - - EXTERNAL CLI$_ABSENTo - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date0 - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN)Y - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0)b - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE.N - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIREB - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0)E - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THENH - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF0 - IF (BTEST(FOLDER_FLAG,3).OR.' - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was setU - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanentE - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4)E - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIREY - END IF) - WRITE (6,1035)e - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE)t - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT)) - END IF - END IFD - END IF - ELSE - RETURN - END IFM - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND.= - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specifiedE - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IFP - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return valueM - GO TO 5 ! Re-request date (if prompting) - END IFF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THENE - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,)t - END IFN - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT_ - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today'st - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND.I - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limitE - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting)t - END IFt - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not futureE - WRITE(6,1045) ! tell userU - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting)) - END IFS - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT))C - END IF - END IFI - - IER = 1 - - RETURNR - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.')h -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.')G -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ',) - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.')B -1045 FORMAT(' ERROR: Specified time has already passed.')R -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.')_ - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE '($SSDEF)'s - - INCLUDE 'BULLUSER.INC') - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUTE - DATA MAIL_EDIT /' '/Y - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THENE - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')')n - RETURN - END IF( - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THENS - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)F - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER))1 - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THENT - INPUT = INPUT(32:)B - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IFi - END DO - END IF - END IF - END IF. - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT)S - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THENw - OUT = INFILE - END IF - - CALL DISABLE_PRIVSa - CALL DECLARE_CTRLC_ASTi - IF (TRIM(MAIL_EDIT).GT.0e - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:)I - IF (OUT.EQ.INFILE) THENO - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT))O - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT))r - END IF - CALL LIB$SPAWN(SPAWN_COMMAND)r - ELSEb - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_EDT' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THENR - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THENO - CALL EDT$EDIT('NL:',OUT)) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT)I - ELSEF - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IFL - END IFu - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT= - ELSE - WRITE(6,'('' Could not activate editor.'')')S - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURNS - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE)U - - RETURN - ENDL - - - - SUBROUTINE CREATE_BULLCPR - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)'D - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2)T - - CHARACTER IMAGENAME*132,ANSWER*4I - - IF (.NOT.SETPRV_PRIV()) THEN= - WRITE (6,'('' ERROR: You do not have the privileges '',C - & ''to execute the command.'')')p - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THENR - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')')I - CALL EXITI - ELSE IF (.NOT.JUST_STOP.AND.X - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV)M - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'',G - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IFH - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT0 - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER)o - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXITT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY)! - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)T - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -CP -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed thatt -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.)l -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')) - IF (IER.NE.0) RETURNf - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:'. - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR '' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00'T - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11)I - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1)E - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))E - END DOM - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1)I - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1)o - END IFI - - IF (.NOT.IER) THENA - CALL SYS_GETMSG(IER) - ELSE& - IF (CONFIRM_USER('DECNET').NE.0) THENG - WRITE (6,'('' WARNING: Account with username DECNET'',i - & '' does not exist.'')')S - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IFR - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP( - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP)I - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1T - - RETURNa - END - - - - - LOGICAL FUNCTION TEST_BULLCPl - - IMPLICIT INTEGER (A-Z)L - - COMMON /BCP/ BULLCP - LOGICAL BULLCPw - - TEST_BULLCP = BULLCP - - RETURN: - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z)0 - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'e - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSx - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP' - - CHARACTER*24 OLD_TIME,NEW_TIME: - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORYi - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)l - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME)I - - BULLCP = 2 ! Enable process to do BULLCP functionsU - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP')T - IF (.NOT.IER) THEN ! Can't create mailbox, so exit.A - CALL SYS_GETMSG(IER) - CALL EXIT - END IF, - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM2 - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER)M - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER)E - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THENE - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER)I - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connectionsP - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - NOW = INDEX(NEW_TIME,' 03:').NE.0.AND.T - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1( - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0L - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)' - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folderT - IF (IER) THENF - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m.A - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IFf - END IF - END IF - END IFe - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)M - END IF - CALL SYS$SETAST(%VAL(1))R - END DOL - CALL SYS$SETAST(%VAL(0)), - CALL DELETE_EXPIRED_NEWS(NOW) - CALL SYS$SETAST(%VAL(1))I - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IFT - CALL SYS$SETAST(%VAL(0)) - CALL REGISTER_BULLCPI - IER1 = 1N - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY)L - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DOE - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1))I - - BBOARD_LOOP = BBOARD_LOOP + 1 - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & NEWS_LOOP.EQ.0) CALL CREATE_PROCESS('BULLCP NEWS')I - CALL SYS$SETAST(%VAL(1)) - - NEWS_LOOP = NEWS_LOOP + 1F - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIMEM - CALL HIBER('15') ! Wait for 15 minutesR -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -Ci - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))$ - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IFL - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER)i - CALL SYS$SETAST(%VAL(1)) - END DOo - - RETURNe - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLFOLDER.INC'S - - INCLUDE 'BULLUSER.INC'( - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - DIMENSION NEW_SYSTEM_FLAG(FLONG)( - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)N - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2))a - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THENI - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER)O - CALL SELECT_FOLDER(.FALSE.,IER1)A - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,G - & BTEST(FOLDER_FLAG,2),NODENAME - END IFT - CALL SETUSER(USERNAME)N - CALL OPEN_BULLFOLDER_SHAREDe - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DOM - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAGC - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2)' - CALL MODIFY_SYSTEM_LIST(0)) - END IF - END DOR - FOLDER_FLAG = FOLDER1_FLAGO - FOLDER_NUMBER = 0 - - RETURNM - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z)/ - - INCLUDE 'BULLUSER.INC'B - - INTEGER SHUTDOWN_BTIM(FLONG)F - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)C - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSERL - - DO WHILE (REC_LOCK(IER))) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG,. - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGO - END DOO - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)L - - IF (IER.NE.0) THENC - DO I=1,FLONG - SYSTEM_FLAG(I) = 0I - SHUTDOWN_FLAG(I) = 0E - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,E - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGF - CALL CLOSE_BULLUSERT - ELSE - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGc - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURNO - END IF - TEMP_USER = ':'N - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER)I - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DOA - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THENT - CALL CLOSE_BULLUSER - RETURNE - END IFB - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,. - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"')I - - IF (IER.NE.0) THENM - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THENM - DELETE (4) - END IF - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IFR - CLOSE (UNIT=REMOTE_UNIT)E - END DO - END IFU - - RETURN_ - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC'g - - INTEGER SHUTDOWN_BTIM(FLONG)( - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)s - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG0 - END DOH - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER)m - - SEEN_FLAG = 0 - DO I=1,FLONG0 - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DOO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEND - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,. - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG, - END IF> - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE HIBER(MIN) -CT -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes. -CL - IMPLICIT INTEGER (A-Z)x - INTEGER TIMADR(2) ! Buffer containing timeI - ! in desired system format.L - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM)D -C! -C SUBROUTINE WAIT_SECe -C -C FUNCTION: Waits for specified time period in seconds.e -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/D - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF)I - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURNW - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -CN -C SUBROUTINE DELETE_EXPIRED_NEWSE -CP -C FUNCTION: -Cu -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLFOLDER.INC'N - - INCLUDE 'BULLDIR.INC'D - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXTC - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - INTEGER TODAY(2),DAY(2),NEXT_EX_BTIM(2) - - CHARACTER*8 TODAY_KEY - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - FOLDER_NUMBER = 1000T - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - - IF (IER.NE.0) THEND - CALL CLOSE_BULLNEWS - RETURN - END IFE - - CALL SYS_BINTIM('-',TODAY)& - - CALL GET_MSGKEY(TODAY,TODAY_KEY)( - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END DO - CALL NEWS_TO_FOLDER - - UNLOCK 7 - - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - GO TO 1000A - ELSE IF (REMOTE_SET.NE.4) THEN - REMOTE_SET = 4( - CALL OPEN_BULLDIR_SHAREDR - END IFA - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0N - NDEL = -1C - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM)P - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. a - IF (NDEL.GT.NEWS_F_END) THENe - CALL READ_NEXT_EXPIRED(NDEL)c - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1N - CALL READ_NEXT_EXPIRED(NDEL). - ELSE IF (EXDATE(8:9).EQ.'18'.OR. ! Deleted manually? - & INDEX(EXDATE,'1900').GT.0) THEN - IF (LENGTH.GT.0) CALL DUMP_MESSAGE()F - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) D - EXTIME = ASCTIME(13:23)A - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0e - CALL READ_FIRST_EXPIRED(NDEL) - ELSEI - CALL READ_NEXT_EXPIRED(NDEL) T - END IF - ELSEN - CALL COPY2(NEXT_EX_BTIM,EX_BTIM)E - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM)M - END IF_ - NDEL = 0E - UNLOCK 2A - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER)X - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_START_ - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0D - END DO - F_START = I - NEXT = .FALSE.D - END IF - CALL READDIR(F_NBULL,IER) - IF (DN.OR.F_NBULL.EQ.IER) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I) - I = I - 1 - CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = IA - END DOD - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13)M - CALL REWRITE_FOLDER_FILE(IER)Y - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL)B - END DOI - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER)G - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DOS - - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS_ - -1000 IF (NOW) THEN - CONTEXT = 0E - IER = LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT)N - IF (IER) IER = CONV$RECLAIM(BULLNEWSDIR_FILE)( - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - DO I=1,31E - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFILE - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;') - END DO G - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IFR - - RETURNA - END - - - - SUBROUTINE DELETE_EXPIRED -CE -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -CH -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files,B -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and= -C was replaced with a 128 byte record compressed format). -CI - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC'M - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC': - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLDIR_SHARED ! Open directory file2 - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFILI - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present?. - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls?J - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')O - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.T - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked?G - SHUTDOWN = 0G - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN_ - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1U - END IF - IF (IER.LE.0.OR.IER1.LE.0) THENF - CALL CLOSE_BULLDIRE - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update, - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc.D - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENI - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)& - END IFD - END IFE - CALL CLOSE_BULLDIR_ - - RETURN - END - - - - - SUBROUTINE BBOARD -CN -C SUBROUTINE BBOARD -CT -C FUNCTION: Converts mail to BBOARD into non-system bulletins.A -CW - - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'I - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSo - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOPM - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64i - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/,HEADER_Q1/0/ - - CALL SYS$SETAST(%VAL(0))_ - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF)r - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(HEADER_Q1,INPUT)M - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1t - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from fileT - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)S - END IF - END DOR - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900 - - CALL SYS$SETAST(%VAL(0))U - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1))' - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0M - -1 POINT_FOLDER = POINT_FOLDER + 1Y - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900D - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_QL - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1A -CC -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C( - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present accountA - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uicW - END IFM - - LEN_B = TRIM(BBOARD_DIRECTORY)= - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)//R - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errorsI - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)_ - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)( - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)//O - & '''F$GETJPI("","USERNAME")'''T - WRITE(11,'(A)') '$ MAIL'E - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'READ/NEW'F - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW'A - CLOSE(UNIT=11)+ - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection. - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1))I - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)). - END IF - ELSE1 - CONTEXT = 0( - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1))E - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0))) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//A - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0))S - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1))F - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM)L - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THENE - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THENu - INTO = INPUT(5:) ! Store addressE - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DOr - - INTO = INTO(:TRIM(INTO))s - CALL STR$TRIM(INTO,INTO)o - CALL STR$UPCASE(INTO,INTO)d - FLEN = TRIM(FOLDER_BBOARD)e - HEADER_Q = 0 - NHEAD = 0 - IF (.NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - HEADER_Q = HEADER_Q1 - IER = 0h - CALL STRIP_HEADER(' ',0,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP)p - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.EQ.0) THEN - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP)I - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - NHEAD = NHEAD + 1 - END IF - END DO - - FOUND = .FALSE. - J = 0B - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM)b - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THEN. - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP)n - END IF - IF (J.EQ.1.OR.F_BBOARD.NE.FOLDER1_BBOARD) THEN - FLEN = TRIM(F_BBOARD) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND)L - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DOe - END IFm - END IF - END IFF - END DO. - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COMi - END IFa - - IF (NHEAD.EQ.0) THENL - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - ELSE2 - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT)D - NHEAD = NHEAD - 1_ - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0)D - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5N - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM)F - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the dateT - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" lineN - I = I - 1T - END DOR - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0W - NBLANK = 0M - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IFH - ELSE - ISTART = 1T - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DOL - NBLANK = 0e - CALL WRITE_MESSAGE_LINE(INPUT)R - END IF - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT) - ELSE - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)P - & .AND.IER.EQ.0)E - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTL - END DOW - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSEi - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1))C - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input fileO - CALL SYS$SETAST(%VAL(1))) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRLo - FOLDER_SET = .FALSE.r - - IF (NBBOARD_FOLDERS.EQ.0) THENn - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER)e - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM)a - REWRITE (4) USER_HEADER ! Rewrite headerc - CALL CLOSE_BULLUSERP - END IFR - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0))) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THENR - CALL SYS$SETAST(%VAL(1)) - IF (.NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) CALL NEWS2BULL - END IFe - CALL SYS$SETAST(%VAL(1))O - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.')B - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD)T - - IMPLICIT INTEGER (A-Z)D - - CHARACTER*(*) INPUT,BBOARD/ - - DETECT_BBOARD = .TRUE.d - - LEN_BBOARD = LEN(BBOARD) - 1 - - DO I=1,TRIM(INPUT)-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND. - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND.O - & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR. - & (INDEX(' .@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0F - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE.T - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND.S - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURNO - END - - - - LOGICAL FUNCTION ALPHA(IN)( - - CHARACTER*(*) INI - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURNT - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIPR - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN( - - BBOARD_NAME = FOLDER_DESCRIP(I+1:)' - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!') - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:)E - I = INDEX(BBOARD_NAME,'!') - END DO/ - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%')p - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN( - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND), - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY)R - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE')) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)S - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')$ - IF (IER.NE.0) RETURN( - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT'/ - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()'''I - WRITE(11,'(A)') '$EXIT:'A - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionE - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0)S - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',,s - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND))R - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))_ - IF (.NOT.IER.AND..NOT.DEL) THEN) - CALL DELPRC('BULLCP NEWS',DEL)I - IER = .NOT.DEL - ELSE - IER = .TRUE. - END IF - END DO0 - - RETURN - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI)M -C -C SUBROUTINE GETQUOTA -C) - IMPLICIT INTEGER (A-Z)r - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistE - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2))L - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF - END IF - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) D - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2))F - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2))R - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2))E - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2))E - - RETURN - END - D - - - - SUBROUTINE GETUIC(GRP,MEM)P -C -C SUBROUTINE GETUIC(UIC)Q -CO -C FUNCTION: -C To get UIC of process submitting the job.B -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UICO -C. - - IMPLICIT INTEGER (A-Z)H - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listU - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURNO - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)' -CA -C SUBROUTINE GET_UPTIME -CT -C FUNCTION: Gets time of last reboot. -CH - - IMPLICIT INTEGER (A-Z)U - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLSTU - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,)g - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'G - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointere - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)A - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO. - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IFE - END DO - END IFS - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THENL - NEW_MAIL(I) = .TRUE.f - ELSEY - NEW_MAIL(I) = .FALSE. - END IFS - ELSE - NEW_MAIL(I) = .TRUE.0 - END IF - END DOE - - CLOSE (10) - - RETURN_ - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -CB -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -CB -C FUNCTION: -C To get image name of process.R -C OUTPUT: -C IMAGNAME - Image name of processB -C ILEN - Length of imagenameO -C_ - - IMPLICIT INTEGER (A-Z)R - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAMEP - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN))_ - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURNF - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START)e - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2)R - - IF (REMOTE_SET) THENR - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START)= - ELSEI - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IFL - - RETURN- - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2)U - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY)S - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURNE - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1( - CALL READDIR(START,IER). - END DO' - - CALL CLOSE_BULLDIRH - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY. - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLUSER.INC'( - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER))B - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DOA - - IF (IER.NE.0) THEN: - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0) - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTED - END IFI - - CALL CLOSE_BULLDIR - - RETURNM - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAME - - DATA OBIO/0/,OCPU/0/,ODIO/0/' - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAMX - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - B - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU))( - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IFB - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1' - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM)e - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - END IFS - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND.R - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIOH - ODIO = DIOI - OCPU = CPUE - IER = 0 - RETURN, - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IFY - RETURNO - END diff --git a/decus/vms94b/bulletin/bulletin4.for b/decus/vms94b/bulletin/bulletin4.for deleted file mode 100644 index c937d20..0000000 --- a/decus/vms94b/bulletin/bulletin4.for +++ /dev/null @@ -1,2208 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:27:51.32 -To: EVERHART -CC: -Subj: BULLETIN4.FOR - -Date: Fri, 19 Aug 1994 17:25:46 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172546.21438991@PFC.MIT.EDU> -Subject: BULLETIN4.FOR - -C -C BULLETIN4.FOR, Version 8/10/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE9 - ELSE: - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IFu - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME)M - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THENo - USERNAME(LU-1:LU-1) = e - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2)))e - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9)n - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINFt - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURNM - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -CO -C SUBROUTINE COPY_BULLo -Cs -C FUNCTION: To copy data to the bulletin file.i -Cc -C INPUT:l -C INLUN - Input logical unit numberr -C IBLOCK - Input block number in input file to start atc -C OBLOCK - Output block number in output file to start ats -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -CI -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. TheA -C bulletin file is assumed to be opened on logical unit 1. -CI - - IMPLICIT INTEGER (A - Z)i - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THENT - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXITT - END IFI - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)')T - END DOv - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0s - LENGTH = 0e - DO WHILE (LENGTH.GE.0)L - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT_ - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH)S - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file._ - ILEN = ILEN - 2 - END IFl - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THENc - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM't - END IF - END IFA - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IFr - END DO - IF (NBLANK.GT.0) THENe - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DON - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0T - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DOC - -100 LENGTH = (LENGTH+127)/128, - IF (LENGTH.EQ.0) THEN - IER = 1e - ELSEt - IER = 0M - END IFN - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT)F - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'i - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/r - - CHARACTER INPUT*(*),OUTPUT*255f - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT)T - END IFN - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN)L - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE) - CALL STORE_BULL1(ILEN,INPUT,OCOUNT)M - END IFN - - RETURN1 - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256o - - COMMON /STORE_POINT/ POINTA - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUTI - POINT = ILEN + 13 - ELSE IF (POINT.EQ.BRECLEN-1) THENL - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUTI - POINT = ILENS - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:)C - POINT = ILEN - (BRECLEN-1-POINT)P - END IF - OCOUNT = OCOUNT + 1T - DO WHILE (POINT.GE.BRECLEN)E - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSEI - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN)U - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT)_ - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1I - - RETURNm - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT( - - IF (REMOTE_SET) THENS - CALL REMOTE_WRITE_BULL_FILE(OUTPUT)$ - ELSE, - WRITE (1'OCOUNT) OUTPUTi - END IF - - RETURNT - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN)R - - IMPLICIT INTEGER (A-Z)K - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER_ - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREFE - CHARACTER*256 REFERENCES - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read?o - CALL STRIP_HEADER(BUFFER,0,IER)E - STRIP = .NOT.HEADERI - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE.I - SEEN_SUBJ = .FALSE.M - CALL GET_BULL(IBLOCK,BUFFER,ILEN)) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF) - - IF (MSG_SENT) THEN9 - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IFL - - DO WHILE (ILEN.GE.0)E - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record.R - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records.T - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THENA - SEEN_FROM = .TRUE.N - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE.M - RETURN - ELSER - BULL_HEADER = .FALSE.Y - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IFi - END IFI - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND.L - & (BUFFER(1:11).EQ.'References:'.OR.D - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE.t - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSEA - REFERENCES = REFERENCES(:LREF)//' '//S - & BUFFER(13:ILEN) - END IFS - LREF = TRIM(REFERENCES) - END IFe - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' 'E - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' ') THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE.B - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0= - ELSEF - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 R - END IF - RETURN - END IF - ELSE - RETURN= - END IF - END DOL - - RETURN2 - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCKF - - RETURNT - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C1 -C SUBROUTINE GET_BULL -CU -C FUNCTION: Outputs line from folder file. -C( -C INPUT:R -C IBLOCK - Input block number in input file to read from.I -CA -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file,_ -C but message lines are variable, message lines may span one orE -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter.T -CI - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH)( - - DATA POINT /1/, LEFT_LEN /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read?E - POINT = 1 ! Initialize pointers.I - LEFT_LEN = 0 - DTYPE = 0L - END IFN - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from fileT - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder?p - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read linesc - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queuer - ELSE ! Local folderw - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMPl - END DOh - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THENl - DTYPE = 1 - POINT = POINT + 1 - END IFO - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of lineI - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine.E - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1N - LEFT_LEN = 0 - RETURN - END IFe - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read.U - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record.E - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line.N - ELSE! - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0' - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover bufferI - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message.N - ELSE ! Else message line fully readO - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSEL - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IFB - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IFM - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record.N - ! Returns length of next line.R - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line.Q - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length.P - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -CA -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z)( - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN( - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2)N - - NEMPTY = NEMPTY + LENGTHR - - CALL WRITEDIR(0,IER)U - - RETURN) - END - - - SUBROUTINE DUMP_MESSAGE() -CU -C SUBROUTINE DUMP_MESSAGE -CP -C FUNCTION: -C To delete a directory entry. -CU - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)'( - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256R - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THENI - DUMP_FILE = FOLDER_FILEM - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)L - DO I=1,TRIM(DUMP_FILE)$ - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILEU - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,I - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')A - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THENT - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,E - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,)= - END IF - ELSE - WRITE (3,'(A)') CHAR(12)W - END IF - - CALL OPEN_BULLFILc - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)I - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8). - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENE - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3))U - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IFF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C= -C SUBROUTINE GET_EXDATE -CH -C FUNCTION: Computes expiration date giving number of days to expire.R -CE - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12)R - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present dateL - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DOI - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable, - - DO WHILE (NUM_DAYS.GT.0)L - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in montht - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year?i - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27t - END IF - END IF - ELSE ! If expiration date is within the monthl - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exitn - END IF - END DOT - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date_ - - RETURNE - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT)E -CN -C SUBROUTINE GET_LINE -C* -C FUNCTION: -C Gets line of input from terminal.N -C1 -C OUTPUTS:0 -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -CE -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST.O -C. - - IMPLICIT INTEGER (A-Z)N - - LOGICAL*1 DESCRIP(8),DTYPE,CLASSR - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE)_ - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/E - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGO - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPTL - - USE_PROMPT = .FALSE.. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT)1 - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -Ci -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE andr -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1o -Cn - - CALL DECLARE_CTRLC_AST- - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line.v -Cs - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTe - IF (IER.NE.0) LEN_INPUT = -2 N - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt& - ELSET - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no promptR - END IFn - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER)r - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT)T - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input?H - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of lineE - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DOL - CALL CONVERT_TABS(INPUT,LEN_INPUT)h - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURNs - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THENT - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DOT - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DOi - LEN_INPUT = LIMIT+1 - END IF - END DOt - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH)S - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10)))I - & INCHAR(I:I) = '.' - END DO) - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logicalD - CHARACTER*(*) OUTPUT ! byte to character valueE - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURNL - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routineS - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG. - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...')' - CALL SYS$CANEXH()' - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXITN - END IF - FLAG = 1 ! to set flag - RETURNT - END - - - - SUBROUTINE DECLARE_CTRLC_ASTD -CF -C SUBROUTINE DECLARE_CTRLC_ASTQ -C -C FUNCTION: -C Declares a CTRLC ast.( -C NOTES:E -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -CI - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINEE - COMMON /TERM_CHAN/ TERM_CHANR - - COMMON /CTRLC_FLAG/ FLAGL - - FLAG = 0 ! Init CTRL-C flagE - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOS - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURNP - - ENTRY CANCEL_CTRLC_ASTL - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOT - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURNR - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -CG - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGL - - COMMON /READIT/ READITC - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/L - - DATA PURGE/.TRUE./U - - DO I=1,LEN(DATA)N - DATA(I:I) = ' 'Q - END DO) - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.1 - ELSEO - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),N - & TRM$M_TM_NOECHO) - END IF - - RETURN1 - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT)E - - DO I=1,LEN(DATA)) - DATA(I:I) = ' 'I - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.T - ELSEA - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),i - & TRM$M_TM_NOECHO) - END IFB - - RETURND - - ENTRY GET_INPUT_NUM(DATA,NLEN)) - - DO I=1,LEN(DATA): - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),X - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,,X - & TERMSET,NLEN,TERM) - END IFM - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN' - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM)0 - END IF, - - RETURN, - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminalD - - CALL DECLARE_CTRLC_ASTC - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID), - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPADE - ELSE IF (READIT.EQ.0) THENM - CALL SET_NOKEYPADb - END IFs - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9'). - MASK(2) = IBCLR(MASK(2),I-32)r - END DOe - - RETURNd - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -Cd -C FUNCTION: -C Gets page size of the terminal. -Cf -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -Co - IMPLICIT INTEGER (A-Z)1 - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4)r - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1)))T - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,)l - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURNp - END - - - - - - LOGICAL FUNCTION SLOW_TERMINALE -CT -C FUNCTION SLOW_TERMINALe -Ca -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less).= -CN -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not.S -CO - - IMPLICIT INTEGER (A-Z)P - - EXTERNAL IO$_SENSEMODE_ - - COMMON /TERM_CHAN/ TERM_CHANn - - COMMON CHAR_BUF(2)l - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)'o - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THENH - SLOW_TERMINAL = .TRUE. - ELSEC - SLOW_TERMINAL = .FALSE.E - END IF - - RETURN1 - END - - - - - SUBROUTINE SHOW_PRIVL -CT -C SUBROUTINE SHOW_PRIV -CU -C FUNCTION: -C To show privileges necessary for managing bulletin board.C -CS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'0 - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)'C - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT filel - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRVr - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')')o - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR.d - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THENC - WRITE (6,'(1X,A)') PRIVS(I) - END IFU - END DO - ELSEE - WRITE (6,'('' ERROR: Cannot show privileges.'')')M - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSERI - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER)h - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IFf - - RETURNl - - END - - - - - SUBROUTINE SET_PRIV -CE -C SUBROUTINE SET_PRIV -C) -C FUNCTION: -C To set privileges necessary for managing bulletin board. -CQ - - IMPLICIT INTEGER (A-Z)a - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'L - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVSt - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA',N - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/P - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2)R - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THENI - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IFD - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN_ - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN)( - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDsP - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSED - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IFN - - OFFPRIV(1) = 0I - OFFPRIV(2) = 0A - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges0 - PRIV_FOUND = -1A - I = 0' - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = IT - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURNM - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN/ - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')')X - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSEE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)R - END IF - ELSE - IF (PRIV_FOUND.LT.32) THENT - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSER - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32)e - END IFi - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1))) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2))U - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSET - WRITE (6,'('' ERROR: Cannot modify privileges.'')')u - END IFt - - CALL CLOSE_BULLUSER ! All finished with BULLUSERo - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -CT -C SUBROUTINE ADD_ACLB -CT -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.I -C IER - Return error from attempting to set ACL. -CC -C NOTE: The ID must be in the RIGHTS data base. -CD - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLFOLDER.INC'O - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256G - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)'I - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS='R - & //ACCESS//')',ACLENT,,)T - IF (.NOT.IER) THENM - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THENE - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER)T - RETURN - END IFD - IDENT = USER + ISHFT(GROUP,16)M - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,)M - END IF - END IF - END IF - IF (.NOT.IER) RETURND - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(L - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)r - RETURN - END IFN - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP)T - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILEc - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF= - - RETURN_ - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -CO -C SUBROUTINE DEL_ACLI -CC -C FUNCTION: Adds ACL to bulletin files. -CA -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -CE - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLFOLDER.INC': - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256a - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT))V - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist, - ELSEA - CALL INIT_ITMLST ! Initialize item list( - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT))R - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistT - END IFT - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(s - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)i - RETURN - END IFt - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILEE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,)C - END IF0 - - RETURN) - END - - - - - SUBROUTINE CREATE_FOLDER -CS -C SUBROUTINE CREATE_FOLDERE -C -C FUNCTION: Creates a new bulletin folder.N -CH - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'a - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDERN - RETURN - END IFe - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THENp - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IFs - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')')V - RETURN - END IFT - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')')D - RETURN - END IF3 - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name' - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B)n - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDERD - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '',E - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAXo - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURNI - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'',' - & '' is not SYSTEM folder.'')') - RETURN' - END IF - END IFS - - LENDES = 0' - DO WHILE (LENDES.EQ.0), - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES)B - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN, - WRITE (6,'('' Aborting folder creation.'')')o - RETURNS - ELSE IF (LENDES.GT.80) THEN ! If too many charactersE - WRITE(6,'('' ERROR: folder must be < 80 characters.'')')T - LENDES = 0( - END IF - END DOE - - CALL OPEN_BULLFOLDER ! Open folder fileC - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder existsC - - IF (IER.EQ.0) THEN: - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IFI - - IF (CLI$PRESENT('OWNER')) THENE - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURNE - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'',T - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDERO - RETURN - ELSE IF (CLI$PRESENT('ID')) THENE - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IFT - ELSEE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN- - END IF - END IFL - FOLDER_OWNER = FOLDER1_OWNERT - END IF - ELSES - FOLDER_OWNER = USERNAME ! Get present username= - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)D - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)s - -Ce -C Folder file is placed in the directory FOLDER_DIRECTORY.R -C The file prefix is the name of the folder.V -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')')T - GO TO 910v - ELSEs - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER' - END IFC - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))_ - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,_ - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THENt - WRITE(6,'('' ERROR: Cannot create folder directory file.'')')n - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910R - END IFa - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,A - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN' - WRITE(6,'('' ERROR: Cannot create folder message file.'')')I - CALL ERRSNS(IDUMMY,IER)C - CALL SYS_GETMSG(IER) - GO TO 910M - END IF( - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACLn - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))' - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1)C - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))O - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1)e - IF (.NOT.IER) THEN - WRITE(6,1 - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER)X - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IFC - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1)0 - LAST_NUMBER = LAST_NUMBER + 1, - END DOE - - IF (IER.EQ.0) THENS - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')')Y - & FOLDER_MAXI - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910A - ELSET - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IFS - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0- - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSEE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name?, - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file( - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*'2 - FOLDER1 = FOLDER, - END IF - REMOTE_SET = .TRUE.A - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0)A - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL_ - END IF - - FOLDER_OWNER = FOLDER1_OWNERT - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11)L - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0)E - - CLOSE (UNIT=1) - CLOSE (UNIT=2)B - - NOTIFY = 0F - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1L - READNEW = 1C - END IFL - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)')O - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000E - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE.P - CLOSE (UNIT=1,STATUS='DELETE')T - CLOSE (UNIT=2,STATUS='DELETE')R - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionT - - RETURNA - - END - - - - INTEGER FUNCTION CHKPRO(INPUT)I -CL -C Description: -C Parse given identify into binary ACL format.c -C Call SYS$CHKPRO to check if present process has readV -C access to an object if the object's protection is the ACL.( -CT - IMPLICIT INTEGER (A-Z)D - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))//. - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary formatR - IF (.NOT.CHKPRO) RETURN ! Exit if can'tA - - FLAGS = CHP$M_READ ! Specify read access checkingO - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has then - ! rights-id assigned to it - RETURNR - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -CO -C SUBROUTINE CREATE_NEWS_FOLDER -C0 -C FUNCTION: Creates a new newsgroup.r -Ct - - IMPLICIT INTEGER (A-Z)' - - INCLUDE 'BULLFOLDER.INC'I - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTt - DATA EDIT_DEFAULT/.FALSE./t - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME) - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED')I - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF -C -C If file specified in command, read file.a -C Else, read from the terminal.: -Cl - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',) - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')e - LEN_P = 1 - ELSE - CLOSE (UNIT=3)C - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')$ - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',i - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line enterede - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch fileT -2010 FORMAT(A)E - ICOUNT = ICOUNT + ILEN - END IFT - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER,o - & 'Adding newsgroup.')s - CLOSE (UNIT=3) - - RETURNc - -920 WRITE(6,1020)O -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURNM - -910 WRITE(6,1010)I -1010 FORMAT (' No news group was added.'): - CLOSE (UNIT=3)r - RETURNb - - END - - - - - SUBROUTINE INIT_COMPRESS - - IMPLICIT INTEGER (A-Z)O - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127)) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127, - DO J=0,127 - A(J,I) = ' ' - END DO - END DOR - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DOT - S - J = 1 - DO I=1,8C - J = J + 1T - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)I - END DO1 - DO I=10,31N - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)s - END DO - DO I=127,254E - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)I - END DOL - - RETURN= - - ENTRY COMPRESS(IN,OUT,O)A - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.126) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.126) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:)))b - IF (T(O:O).NE.' ') THENF - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND. - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1))T - C = C + 1 - K = K + 1 - END DO= - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1) - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0)0 - O = O + 1 - ELSE - T(O:O) = IN(K:K)= - K = K + 1 - O = O + 1 - END IF - END DO - IF (K.EQ.L) THENE - T(O:O) = IN(K:K) - ELSES - O = O - 1 - END IFR - - OUT = T - - RETURNf - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1N - T(O:O) = IN(I+2:I+2) - END DO - I = I + 3 - ELSEE - B = UNMAP(J)F - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1T - T(O:O) = IN(I:I)I - ELSEL - O = O + 2L - T(O-1:O) = B - END IF - I = I + 1 - END IF - END DO1 - - OUT = T(:O) - - RETURN - END diff --git a/decus/vms94b/bulletin/bulletin5.for b/decus/vms94b/bulletin/bulletin5.for deleted file mode 100644 index 359cff4..0000000 --- a/decus/vms94b/bulletin/bulletin5.for +++ /dev/null @@ -1,2432 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:54:40.64 -To: EVERHART -CC: -Subj: BULLETIN5.FOR - -Date: Fri, 19 Aug 1994 17:25:49 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172549.21438991@PFC.MIT.EDU> -Subject: BULLETIN5.FOR - -C -C BULLETIN5.FOR, Version 8/10/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3) THEN - CALL SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - RETURN - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - NODEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (NODEFAULT) THEN - IF (NOTIFY.NE.-1) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) THEN - CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - END IF - REWRITE(4) USER_HEADER - ELSE IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN" - WRITE (6,'('' ERROR: No folder specified.'')')R - RETURNj - ELSE - FOLDER1 = FOLDERu - END IF - ELSE IF (LEN_T.GT.44) THENT - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')1 - RETURN - END IFT - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IFa - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHAREDn - ELSEr - CALL OPEN_BULLFOLDER - END IFi - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder existsS - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN) - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & (FOLDER1_NUMBER.EQ.0.AND.FOLDER1_BBOARD(:2).NE.'::')) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IFL - - TEMP = FOLDER_FILE. - FOLDER_FILE = FOLDER1_FILER - - REMOTE_SET_SAVE = REMOTE_SETf - REMOTE_SET = .FALSE.N - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THENI - FLEN = TRIM(FOLDER1_BBOARD)( - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"')A - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folderN - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THENF - CALL OPEN_BULLDIRH - CALL READDIR(0,IER), - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIRI - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folderC - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF_ - - TEMPSET = FOLDER_SETF - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)E - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin fileE - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionF - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSETS - - DELETE (7)F - - IF (FOLDER1_NUMBER.NE.0.OR.FOLDER1_BBOARD(:2).NE.'::') THEN - ! Test is due to bug which changes folder number to zero - TEMP_NUMBER = FOLDER_NUMBERU - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG. - IF (BTEST(FOLDER1_FLAG,2)) THENA - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0). - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAGF - FOLDER_NUMBER = TEMP_NUMBERI - END IFC - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSER - REMOTE_SET = REMOTE_SET_SAVE - END IFC - -1000 CALL CLOSE_BULLFOLDER - - RETURND - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDERP -CI -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted.M -CA -C NOTES:R -C FOLDER_NUMBER is used for selecting the folder.N -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote.) -C If the specified folder is on a remote node and does not haveE -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then. -C FOLDER_NUMBER is set to -1. -CS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'M - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)'f - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)L - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READITE - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMS - DATA BULL_USER_CUSTOM/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIPE - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder hasR - DATA FIRST_TIME /FLONG*0/ ! been selected before this.U - - DIMENSION OLD_NEWEST_BTIM(2)L - - DATA LAST_NEWS_GROUP/0/ - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAMEl - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THENt - FOLDER1 = FOLDER1(:FLEN)//'GENERAL'_ - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IFM - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0M - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder infoL - FOLDER1_COM = FOLDER_COM - IER = 0T - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')O - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT))A - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT)F - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THENT - WRITE (6,'('' Fetching NEWS groups from remote node.''F - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have''_ - & ,'' to be done.'')'). - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1R - CALL NEWS_LISTs - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVEo - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THENR - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DOU - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000_ - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSET - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1l - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) D - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) r - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IFT - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEND - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THENT - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1( - IER = 0I - ELSE IF (INCMD(:2).EQ.'SE') THEND - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER)D - ELSER - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)a - END IFh - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER)A - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THENO - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!!O - FOLDER1_FLAG = FOLDER1_FLAG.AND.3' - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IFL - END IF - - CALL CLOSE_BULLFOLDERA - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4I - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IFU - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2' - RETURN - END IFO - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAGL - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP, - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN) - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD)S - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1P - WRITE (6,'('' Cannot connect to node '',A,''.'')')M - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN0 - WRITE (6,'('' Cannot connect to remote NEWS node.'')')a - END IF - END IFE - RETURND - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::"A - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'//C - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1A - ELSE IF (NEWS) THEN, - REMOTE_SET_NEW = 3F - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDERE - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & F1_START.GT.0) THENI - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM)R - F_NBULL = F1_NBULL - F_START = F1_START - CALL REWRITE_FOLDER_FILE(IER)U - END IFT - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IFo - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag infoe - REMOTE_SET_NEW = 1, - END IF - END IFO - - IF (IER.EQ.0) THEN ! Folder founde - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THENO - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSEI - CALL CHKACLC - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAMET - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP),O - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS)C - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THENQ - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THENU - WRITE(6,'('' You are not allowed to access news group.'')')T - ELSE IF (NEWS) THEN* - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IFl - ELSE IF (OUTPUT) THENI - WRITE(6,'('' You are not allowed to access folder.'')')W - WRITE(6,'('' See '',A,'' if you wish to access folder.'')')' - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR.& - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER)G - CALL CLR2(SET_FLAG,FOLDER1_NUMBER)E - IF (IER.EQ.0) REWRITE (4) USER_ENTRYE - CALL CLOSE_BULLUSER - END IF - IER = 0O - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR.h - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THENN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDERO - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0)U - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IFC - ELSE ! Folder not protectedL - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) W - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THENR - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set soE - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE= - FOLDER_SET = .FALSE.E - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1), - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COMt - END IFi - - IF (REMOTE_SET.EQ.1.AND.FOLDER_NUMBER.GE.0) THENA - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER1) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1)E - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2)E - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDERF - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.IER1.EQ.0) THENE - CALL READ_NOTIFYL - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN, - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IFD - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10)1 - & .AND..NOT.BTEST(FOLDER_FLAG,11)) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THENU - WRITE (6,'('' Use the POST command to send a '',D - & ''message to this folder''''s news group.'')')O - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '',F - & ''message to this folder''''s mailing list.'')')P - END IF - END IF - END IFI - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IFP - - IF (OUTPUT) THENf - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')')R - WRITE (6,'(1X,A)') FOLDER_DESCRIP(F - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSEE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THENE - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THENR - WRITE (6,'('' Folder only accessible for reading.'')') - END IFL - READ_ONLY = .TRUE.( - ELSE - READ_ONLY = .FALSE. - END IFC - ELSEE - READ_ONLY = .FALSE. - END IFA - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THEN - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THENs - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.= - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2))C - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0R - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENB - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IFB - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to updateE - END IF - ELSE0 - NBULL = 0I - END IFC - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IFN - - IF (OUTPUT) THENT - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1)R - BULL_PARAMETER = 'MARKED'C - ELSE IF (CLI$PRESENT('SEEN')) THENE - READ_TAG = 1 + IBSET(0,2)A - BULL_PARAMETER = 'SEEN' - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENTU - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THENL - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED' - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THENL - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN' - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IFE - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THENr - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)P - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THENM - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))0 - ELSE - WRITE(6,'('' WARNING: No '',A, - & '' messages found.'')')S - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IFL - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN$ - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)( - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it= - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0t - DO WHILE (NEW_COUNT.GT.0)' - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1) - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletinse - ELSE - BULL_POINT = 0 - END IF - END IF( - END IF - END IF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE.. - ELSE IF (OUTPUT) THENL - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER)E - END IF - ELSE ! Folder not foundO - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0W - END IFU - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -CO -C SUBROUTINE UPDATE_FOLDERF -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'R - - IF (FOLDER_NUMBER.LT.0) RETURNN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileL - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)F - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message?R - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IFt - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURNt - END - - - - SUBROUTINE SHOW_FOLDERN -CN -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder.R -CT - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC'F - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG)E - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)'. - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IFi - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IFE - - IF (INDEX(FOLDER1,'::').NE.0) THENI - WRITE (6,'('' ERROR: invalid command for remote folder.'')')W - RETURN - END IF - - IF (TEST_NEWS(FOLDER1)) THEN I - INCMD = 'SET NEWS ' - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL 'B - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDERL - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEND - WRITE (6,1000) FOLDER1,FOLDER1_OWNER,U - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSEE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER,I - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACLG - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THENf - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private?T - WRITE (6,'('' Access is limited.'')')' - END IFn - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSET - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS)' - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THENr - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '',& - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - CALL SET_FOLDER_FILE(1)R - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIRN - CALL READDIR(0,IER)O - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0)I - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') = - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IFA - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IFi - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THENC - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')F - IF (BTEST(GROUPB1,31)) THENs - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')')n - END IF - END IFH - ELSEN - WRITE (6,'('' No BBOARD has been defined.'')') - END IF, - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSER - WRITE (6,'('' No default expiration set.'')') - END IFF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IFT - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')')P - END IF) - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF( - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,10)) THEN) - WRITE (6,'('' POST_ONLY has been set.'')') - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THEN - WRITE (6,'('' COMPRESS has been set.'')') - END IFS - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')')U - END IFr - IF (F1_EXPIRE_LIMIT.GT.0) THENM - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN( - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE.N - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND.U - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE.E - WRITE (6,'('' Default is READNEW, which is permanent.'')')I - ELSE - WRITE (6,'('' Default is READNEW.'')')E - END IF - END IF - ELSEE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.N - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE.S - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')')n - ELSE - WRITE (6,'('' Default is SHOWNEW.'')')e - END IF - END IF - END IFN - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.O - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THENI - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')')L - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')'). - END IFT - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THENe - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSES - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - SLIST = INDEX(FOLDER1_DESCRIP,'<') - ELIST = INDEX(FOLDER1_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THENR - IF ((FOLDER1_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR.o - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))).AND.L - & INDEX(FOLDER_DESCRIP(SLIST+2:),'@').EQ.0) THEN - WRITE (6,'('' Last message fed by news group was: '',I)') - & F_LAST - END IFT - END IF - END IF! - - CALL CLOSE_BULLFOLDER - - RETURNT - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/, - & ' Description: ',A)F -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/,T - & ' Description: ',A)L - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT)W -CL -C SUBROUTINE DIRECTORY_FOLDERSE -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z)N - - INCLUDE '($SSDEF)'E - - INCLUDE 'BULLFOLDER.INC'' - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGI - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/G - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' 'M - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURNL - END IF - ELSEL - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IFO - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE.D - ACTIVE = .FALSE. I - STORED = .FALSE. ) - CLASS = .FALSE., - NEW = .FALSE. - PERM = .FALSE. - DEFA = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counter - NLINE = 1N - START = .FALSE. - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE.L - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THENM - WRITE (6,'('' Fetching NEWS groups from remote node.''R - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have''R - & ,'' to be done.'')')L - CALL CLOSE_BULLFOLDERL - CALL NEWS_LISTF - CALL OPEN_BULLNEWS_SHARED6 - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER)P - END IFD - COUNT = CLI$PRESENT('COUNT')T - IF (COUNT) TOTAL_COUNT = 0_ - STORED = CLI$PRESENT('STORED')O - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE')E - NEW = CLI$PRESENT('NEWGROUPS')_ - CLASS = CLI$PRESENT('CLASS')I - PERM = CLI$PRESENT('PERMANENT') - DEFA = CLI$PRESENT('DEFAULT')L - IF (CLASS) THEN - CALL CLOSE_BULLFOLDERe - CALL OPEN_BULLNEWS_SHARED - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THEN_ - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1. - ELSE IF (PERM) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEND - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO1 - END IF - CALL CLOSE_BULLINF) - INUM = 1 - ELSE IF (DEFA) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_RECR - END DO - IF (IER.NE.0) THENO - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINFT - INUM = 1_ - ELSER - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IFA - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THENE - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER)O - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')')F - CALL CLOSE_BULLFOLDER - FOLDER_COUNT = -1 - RETURN< - ELSE) - START = .TRUE._ - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN)E - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN' - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0f - FOLDER_COUNT = -13 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN( - SUBNUM = -2E - ELSEH - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)' - END IF - -CS -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memoryH -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -CA - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1I - - CALL DECLARE_CTRLC_AST1 - - NUM_FOLDER = 0W - IER = 0 - IER1 = 0a - MORE = .FALSE. - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1F - END IF, - END DOW - IF (SUBNUM.EQ.0) IER = 1t - ELSE IF (PERM.OR.DEFA) THEN - IER = 1 - DO WHILE (INUM.LE.FOLDER_MAX.AND.IER.NE.0) - IF (INF_REC2(1,INUM).NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (ZEXT(INF_REC2(1,INUM)),IER) - END IFF - INUM = INUM + 1 - END DO - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 22 - NEW_NEWS = FOLDER1_NUMBER - END IF - END DOO - IF (IER.EQ.0) THEN - NEW_NEWS = FOLDER1_NUMBERD - ELSEE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP)M - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THENN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP)W - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)),G - & USERNAME,READ_ACCESS,-1)_ - ELSEE - READ_ACCESS = 1n - END IF - END IFA - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSEF - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:)I - ELSEN - FSTATUS1 = ' ') - END IF - IF (.NOT.NEWS_TEST) THEND - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100 - END IF - END IFL - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THENw - IER1 = 1' - MORE = .TRUE. - END IFE - END IF - IF (FLAG.EQ.1) IER1 = 1S - END DOD - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymored - - IF (FLAG.EQ.1) THEN: - WRITE (6,'('' Folder search aborted.'')') - FOLDER_COUNT = -1R - RETURN - END IFT - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1I - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IF - -CU -C Folder entries are now in queue. Output queue entries to screen. -CH - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THEN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))') - ELSE IF (CLASS) THEN( - WRITE (6,'(1X,''Class'',/,1X,(''-''))')T - ELSE IF (SUBSCRIBE) THEN - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))')= - ELSE. - WRITE (6,'(1X,''News group'',X,''Status'',7X, - & ''First Last'',/,1X,(''-''))')1 - END IF - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1F - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THENT - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSEs - DATETIME = ' NONE'e - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSEL - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IFC - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42)E - J = INDEX(FOLDER1_DESCRIP,' ')' - IF (J.GT.0) THENL - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1)U - END IFD - ELSEI - FSTATUS1 = ' ' - END IF_ - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNT - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0E - END IF - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW)R - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1),D - & F1_START,F1_NBULL,NEWS_NEW-1( - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - END IF - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IFR - ELSE IF (SUBSCRIBE) THENC - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE( - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0T - END IFd - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER= - IF (NEWS_TEST.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - FOUND = .FALSE. - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND)A - CALL READ_FOLDER_FILE_TEMP(IER) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:)T - ELSEA - FSTATUS1 = ' 'T - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND.- - & .NOT.BTEST(FOLDER1_FLAG,9))).AND.E - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THENh - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2)u - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN= - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1)M - ELSE - FOUND1 = .TRUE. - END IF - END IFI - FOUND = FOUND1 - ELSE - FOUND = .TRUE.B - END IF - END IF - END DOE - MORE = MORE.AND.FOUND - IF (MORE) THEN= - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND) FLAG = 1E - END IF - END DO - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_ASTL - CALL CLOSE_BULLFOLDERE - END IF& - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNTS - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSEI - WRITE(6,1100) ! Else say there are more - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IFF - - RETURND - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10)L -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10)C -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -CA -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID.O -CR -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny accessV -C - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLFOLDER.INC'N - - INCLUDE 'BULLUSER.INC'E - - INCLUDE '($SSDEF)'1 - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENTR - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132R - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THENE - ALL = .TRUE. - ELSE - ALL = .FALSE.E - END IFD - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF_ - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER_ - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS) THENH - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.' - END IF - CALL OPEN_BULLNEWS - ELSEA - CALL OPEN_BULLFOLDER ! Open folder file - END IF: - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it existsT - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THENT - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN, - WRITE (6,& - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE. - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),R - & STATUS='NEW',IOSTAT=IER)F - CLOSE (UNIT=3) - CALL RESET_PROTECTIONl - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')') - RETURN - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL) - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0), - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN6 - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN6 - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN. - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER)P - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')')' - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN' - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN7 - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILEM - REMOTE_SET_SAVE = REMOTE_SETD - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE - CALL SET_FOLDER_FILE(0) - END IF - END IF' - ELSEI - CALL DEL_ACL('*','R',IER) - END IF1 - IF (.NOT.IER) THENH - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER)L - END IFN - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN)T - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER)F - IF (IER.NE.0) THEN_ - WRITE (6,'('' ERROR: Cannot find file '',A)')R - & INPUT(2:ILEN) - RETURN - END IF0 - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN( - CLOSE (UNIT=3) - INPUT = ' 'N - ELSE( - FILE_OPEN = .TRUE. - END IF6 - ELSEO - FILE_OPEN = .FALSE. - END IF_ - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1T - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ELSE - ID = INPUT - INPUT = ' 'I - END IF - ILEN = TRIM(ID)' - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THENM - WRITE (6,'('' ERROR: Cannot modify access'',L - & '' for owner of folder.'')') - ELSE - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER)D - ELSEN - CALL ADD_ACL(ID,'R+W',IER)P - END IF - ELSEE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IFS - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN)E - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')')N - & ID(:ILEN)_ - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUTL - IF (IER.NE.0) THEN - CLOSE (UNIT=3)S - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IFO - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - IF (NEWS) THEN_ - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IF - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file.E -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)'S - - CHARACTER*256 ACLENTL - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THENM - IERACL = SS$_NORMAL.OR.IERACL, - END IF - - RETURNe - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C2 -C FUNCTION: Checks ACL of given file. -C> -C PARAMETERS: -C FILENAME - Name of file to check.0 -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C_ - - IMPLICIT INTEGER (A-Z)t - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))T - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THENO - READ_ACCESS = 0e - END IFE - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then ofE - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF( - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))L - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF( - - RETURN_ - END - - - - - SUBROUTINE SHOWACL(FILENAME)T -C, -C SUBROUTINE SHOWACL& -C' -C FUNCTION: Shows users who are allowed to read private bulletin. -CF -C PARAMETERS: -C FILENAME - Name of file to check.) -CE - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)), - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)A - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH)S - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAMER - - INCLUDE 'BULLFOLDER.INC'e - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER)O - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWSR - - DO WHILE (REC_LOCK(IER))s - IF (NEWS_OPEN) THENS - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COMI - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DOT - - RETURNO - - ENTRY WRITE_FOLDER_FILE_TEMP(IER)L - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM( - ELSEP - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IFA - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER)R - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWSN - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSEE - REWRITE (7,IOSTAT=IER) FOLDER_COM - END IF. - - RETURNt - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) P - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM) - ELSE - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IFS - - RETURNF - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER))D - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COM - END IF - END DOD - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNf - - ENTRY READ_FOLDER_FILE_TEMP(IER)( - - DO WHILE (REC_LOCK(IER))m - IF (NEWS_OPEN) THEN0 - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO, - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN, - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER))M - IF (NEWS_OPEN) THENC - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER_ - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER)_ - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COME - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DON - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)R - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN) - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COMF - END IF - END DOT - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1R - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER))' - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1( - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))M - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1( - - RETURNN - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))' - IF (NEWS_OPEN) THENr - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1I - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DOM - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1d - - RETURN' - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))M - IF (NEWS_OPEN) THENN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM0 - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)'L - - CHARACTER*(*) KEY_NAMED - - INCLUDE 'BULLUSER.INC'A - - CHARACTER*12 SAVE_USERNAMEE - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAMEA - - DO WHILE (REC_LOCK(IER))C - READ (4,IOSTAT=IER) USER_ENTRY - END DOL - - TEMP_USER = USERNAMEN - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER)S - - SAVE_USERNAME = USERNAMET - - DO WHILE (REC_LOCK(IER)). - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRYo - END DO - - USERNAME = SAVE_USERNAMEo - TEMP_USER = KEY_NAMEE - - RETURNP - - ENTRY READ_USER_FILE_HEADER(IER)) - - DO WHILE (REC_LOCK(IER))D - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM,) - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DOI - - RETURND - - ENTRY WRITE_USER_FILE_NEW(IER)O - - DO I=1,FLONGS - SET_FLAG(I) = SET_FLAG_DEF(I)E - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)S - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I)l - END DO - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER))E - WRITE (4,IOSTAT=IER) USER_ENTRY - END DOC - - RETURN - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - _ - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_'E - END DO2 - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)n - - NEW_NEWS_ACCESS = L - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS'C - - RETURNT - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - L - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - h - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_'M - END DOE - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1), - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C))E - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' 'U - ELSE - FILE = FILE(:L) - END IF - END DOs - - RETURN - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z)A - - CHARACTER*(*) INPUT,FINDf - - F = LEN(FIND)W - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURNE - END DO0 - - RETURN - END diff --git a/decus/vms94b/bulletin/bulletin6.for b/decus/vms94b/bulletin/bulletin6.for deleted file mode 100644 index bb638f7..0000000 --- a/decus/vms94b/bulletin/bulletin6.for +++ /dev/null @@ -1,2536 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:52:51.90 -To: EVERHART -CC: -Subj: BULLETIN6.FOR - -Date: Fri, 19 Aug 1994 17:25:51 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172551.21438991@PFC.MIT.EDU> -Subject: BULLETIN6.FOR - -C -C BULLETIN6.FOR, Version 8/10/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSLIST/ NEWSLIST - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',R - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2,o - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00',R - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folders - CLOSE (UNIT=7)n - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE)L - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE.E - END IFE - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',L - & RECORDSIZE=NEWS_FOLDER_RECORD/4,R - & BUFFERCOUNT=127, - & ORGANIZATION='INDEXED',IOSTAT=IER) - ELSE0 - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',I - & RECORDSIZE=NEWS_FOLDER_RECORD/4,D - & ORGANIZATION='INDEXED',IOSTAT=IER)C - END IF - IF (IER.EQ.FOR$IOS_FILNOTFOU) THENN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2,N - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER,C - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7)' - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop_ - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE)W - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IFN - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN',+ - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))L - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)W - END DO - END IF - - IF (IER.NE.0) THENN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)R - IF (IER1.EQ.0) THENY - WRITE (6,'('' IOSTAT error = '',I)') IER2 - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXITN - END IFE - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT)T - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14)R - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/: - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)'D - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -CI -C The following 2 files were used prior to V1.1.O -CI - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/Y - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/S - - COMMON /NEWSLIST/ NEWSLISTN - DATA NEWSLIST/0/S - - CHARACTER*44 SAVE_FOLDERS - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/S - - ENTRY OPEN_BULLNEWS_SHAREDY - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHAREDR - LUN = LUN + 3 ! Unit = 7U - - ENTRY OPEN_BULLUSER_SHARED. - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 24 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1O - - IER = 0 - - NTRIES = 0E - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THENI - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,I - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')O - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL')L - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THENI - CLOSE (UNIT=2)U - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loopG - CALL CONVERT_BULLFILESE - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRSD - NTRIES = 0 - END IF8 - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF) - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCKF - SAVE_FOLDER = FOLDERH - CALL GET_REMOTE_MESSAGE(IER)) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1I - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))_ - & //'.BULLFIL',STATUS='OLD',E - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY)I - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCKe - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN, - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILEI - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IFI - - IF (LUN.EQ.4) THEN0 - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THENN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IFC - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IFS - - IF (LUN.EQ.7) THENC - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED',. - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THENL - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IFL - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & BUFFERCOUNT=127, - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED)O - ELSE) - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD',U - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED)' - END IF - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN8 - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE)O - NTRIES = 0 - END IFE - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THENU - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED,C - & USEROPEN=LNM_MODE_EXEC)B - END DO - END IFN - - IF (LUN.EQ.9) THENC - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',E - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1i - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXITE - END DO - END IFI - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN)' - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)')L - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THENT - WRITE (6,'('' IOSTAT error = '',I)') IERL - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF0 - - LUN = 0 - - RETURN: - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z)r - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN' - - ENTRY SET_PROTECTIONr - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)L - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURNC - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLFOLDER.INC'. - - NEWS_FOLDER = FOLDERU - NEWS_FOLDER_NUMBER = FOLDER_NUMBERE - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):)N - NEWS_F_NBULL = F_NBULLI - NEWS_F_COUNT = F_COUNTN - NEWS_F_START = F_STARTX - NEWS_F_LAST = F_LASTg - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1)A - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2)A - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBERr - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL1 - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_STARTY - NEWS_F1_LAST = F1_LASTL - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1)L - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2)E - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT! - - RETURN - - ENTRY NEWS_TO_FOLDERA - - FOLDER = NEWS_FOLDERU - FOLDER_NUMBER = NEWS_FOLDER_NUMBERD - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNTE - F_START = NEWS_F_STARTW - F_LAST = NEWS_F_LAST1 - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1)L - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2)T - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT3 - - RETURNE - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1H - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER, - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1)))T - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNTE - F1_NBULL = NEWS_F1_NBULLE - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LASTE - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1)B - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE'T - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMITR - - RETURNE - - END - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z)& - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'N - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116E - - WRITE (6,'('' Converting data files to new format. Please wait.'')')D - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',A - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN0 - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))V - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,U - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')( - END IF( - - IF (IER1.NE.0) GO TO 8001 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM)T - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2) - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115)= - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1F - DESCRIP = BUFFER(:) - FROM = BUFFER(54:)) - BULLDIR_ENTRY(81:84) = BUFFER(85:)) - BULLDIR_ENTRY(93:100) = BUFFER(108:)L - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM)T - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY= - ICOUNT = ICOUNT + 1 - END IF - END DOC - -800 CLOSE (UNIT=9,DISPOSE='KEEP')S - CLOSE (UNIT=2) - -900 CALL RESET_PROTECTIONI - - RETURN' - - END - - - - SUBROUTINE CONVERT_BULLFILES -CI -C SUBROUTINE CONVERT_BULLFILESN -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs).C -C - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')')N - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',I - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',T - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',) - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD',N - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)F - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,O - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')C - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8)S - NEMPTY = 0D - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00'= - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCKL - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFERX - END DO - CALL WRITEDIR(ICOUNT-1,IER1)' - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9)S - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1)) - - CALL RESET_PROTECTION - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)= -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -CL -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -CL -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'O - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE) - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200)O - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER))' - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL'E - & ,STATUS='OLD',t - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER,D - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,_ - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE)E - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THENX - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER)E - NBLOCK = NBLOCK + 1T - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1_ - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK)_ - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IFW - - CLOSE (UNIT=10) - CLOSE (UNIT=1)_ - - CALL CLOSE_BULLDIR - GOTO 100X - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURNN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -CN -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format.L -C_ - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'N - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'1 - - INCLUDE '($FORIOSDEF)'F - - CHARACTER*(*) FILENAME_ - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1L - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1))T - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DOB - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',I - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE')I - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THENI - F_NUMBER = 0 - DO WHILE (IER.EQ.0)) - IF (ASK_SIZE.EQ.184) THENT - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)',F - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)T - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)',C - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)4 - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPE - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIME - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN T - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST)G - ELSET - F_LAST = 0 - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER)F - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBY - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LASTI - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0)T - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)R - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPR - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER))T - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)L - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IFO - DO WHILE (FILE_LOCK(IER,IER1))V - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',e - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1)n - CALL CONVERT_BULLDIRS - END IF - END DOE - IF (IER.EQ.FOR$IOS_FILNOTFOU) THENE - F_NEWEST_BTIM(1) = 0D - F_NEWEST_BTIM(2) = 0& - ELSET - CALL READDIR(0,IER)S - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE. - NEWEST_TIME = TIMEo - CALL WRITEDIR(0,IER)= - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IFR - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE)I - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE, - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0= - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IFT - - CLOSE (UNIT=7)T - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)E - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE), - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURND - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -CD -C SUBROUTINE CONVERT_BULLNEWS -CN -C FUNCTION: Converts bulletin NEWS file to new format.N -C, - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)', - - INCLUDE '($FORIOSDEF)'( - - CHARACTER*(*) FILENAMET - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55R - - WRITE (6,'('' Converting '',A,'' to new format. ''F - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')), - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 14 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1))U - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED',L - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',E - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600, - & ORGANIZATION='INDEXED',IOSTAT=IER,C - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER,& - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0_ - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE)L - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE)E - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0E - NEWS_F_END = 0I - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108)_ - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:)O - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1B - IF (LMOVE.LE.0) THENR - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP1 - ELSE - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE))B - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) - END IF( - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7)_ - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)N - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE)D - - CALL RESET_PROTECTION - - RETURNR - END - - - - SUBROUTINE CONVERT_USERFILE -Ct -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -CI - - IMPLICIT INTEGER (A-Z). - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'N - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME' - - WRITE (6,'('' Converting data files to new format. Please wait.'')')R - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))I - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'I - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',E - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,R - & KEY=(1:12:CHARACTER))I - INQUIRE (UNIT=9,RECORDSIZE=RECL)o - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')D - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)I - ELSE - CALL ENABLE_CTRLC - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF_ - - IF (IER.EQ.0) THEN_ - CALL SET_PROTECTIONE - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',A - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IFE - - IF (IER.NE.0) THEN, - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)E - CALL SYS_GETMSG(IER1)) - CALL RESET_PROTECTION1 - CALL ENABLE_CTRL_EXITT - END IF, - - DO I=1,FLONG8 - NEW_FLAG(I) = 'FFFFFFFF'XE - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0M - SET_FLAG(I) = 0E - END DOE - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0N - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFERR - IF (IER.EQ.0) THEN- - TEMP_USER = BUFFER(:12)M - LOGIN_DATE = BUFFER(13:23)S - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))T - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM)E - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,B - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFA - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM,F - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flagI - DO WHILE (IER.EQ.0)S - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN' - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF1 - - IER = 0 - - CLOSE (UNIT=9)= - CLOSE (UNIT=4) - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -CL -C SUBROUTINE READDIRN -CF -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.- -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z)F - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'M - - COMMON /PROMPT/ COMMAND_PROMPTU - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXTT - - COMMON /KEEPLOCK/ KEEPLOCKE - DATA KEEPLOCK/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULLFIL/ BULLFILC - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMR - - CHARACTER*4 CFOLDER_NUMBERR - - CHARACTER*8 NEWS_KEYS - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THENI - DO WHILE (REC_LOCK(IER))B - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DOI - IF (IER.EQ.0) THENL - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSET - DIR_NUM = 0 - END IF - END IF) - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURNR - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR' - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER$ - END IFC - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0E -C5 -C Check to see if cleanup of empty file space is necessary, which isF -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -CM - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP')D - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IFD - END IF - ELSE) - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER))I - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEYGE=NEWS_KEY(ICOUNT,FOLDER_NUMBER) - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRYE - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THENG - READ(2,IOSTAT=IER) NEWSDIR_ENTRYA - ELSEB - READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER) - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRYA - END IFT - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START)E - ICOUNT = ICOUNT - 1T - READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER)D - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF - END IF - IF (IER.EQ.0) THEN - NUM = GET_INTEGER(%REF(NEWS_MSG_KEY)) - IF (NUM.NE.FOLDER_NUMBER) THEN - IER = 36V - UNLOCK 2( - ELSEU - MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:))) - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 P - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND. - & MSG_NUM.GT.F_START) THENC - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAMED - & (FOLDER,IER2) - F_START = MSG_NUM - CALL REWRITE_FOLDER_FILE(IER2)O - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IFR - END IFE - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THENN - ICOUNT = MSG_NUM - BULLETIN_NUM = ICOUNT - END IFT - END IF - ELSE - IF (DIR_NUM.EQ.ICOUNT-1) THENc - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97)C - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) E - & BULLDIR_ENTRY - END IFf - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 E - END IF] - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97)S - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) O - & BULLDIR_ENTRY - END IF - END IF - END IFI - END DOT - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBINm - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSEp - DIR_NUM = -1F - END IFD - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IFN - - IF (IER.EQ.0) THENC - IF (.NOT.REMOTE_SET) THENB - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THENN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1, - END IFR - END IFI - END IFN - - RETURNA - - END - - - - CHARACTER*8 FUNCTION NEWS_KEY(ICOUNT,FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z)a - - CHARACTER*4 INTEGER_KEY - - NEWS_KEY = INTEGER_KEY(FOLDER_NUMBER)//INTEGER_KEY(ICOUNT)T - - RETURN - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM)R - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURNR - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z)H - - INTEGER TEMP - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM. - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I) - END DO - - RETURNT - END - - - SUBROUTINE READDIR_KEYGE(IER) -CG -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified.& -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS:L -C IER - If 0, no entry found. Else contains message number. -C7 - - IMPLICIT INTEGER (A - Z)8 - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'I - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/2/R - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFILF - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMN - - CHARACTER*4 INTEGER_KEY - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.4.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRY - ELSES - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THENO - NUM = GET_INTEGER(%REF(NEWS_MSG_KEY))I - IF (NUM.NE.FOLDER_NUMBER) THEN - IER = 36) - UNLOCK 2 - ELSE - MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:))) - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.4.AND.MSG_NUM.NE.0) THEN ) - IF (MSG_NUM.GT.NEWS_F_END) THEN - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36G - UNLOCK 2 - END IF - END IF - END IF - END IF - ELSE - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '//i - & BULLDIR_ENTRY(66:97)i - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBINT - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFILM - ELSE - IER = 0 - DIR_NUM = -1R - END IF - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THENT - IF (BTEST(BULL_USER_CUSTOM,3)) THENE - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10A - END IF - END IF - - RETURNU - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'N - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF_ - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,)T - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURNc - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBINB - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIMER - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY(5:)),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY(5:)),%DESCR(EX_BTIM)) - IF (POSTTIME) CALL COPY2(MSG_BTIM,NEWS_POST_BTIM) - DESCRIP = NEWS_DESCRIPU - FROM = NEWS_FROM F - BLOCK = NEWS_BLOCKB - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IF: - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11)U - EXTIME = DATETIME(13:23)Y - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME(:11) - TIME = DATETIME(13:23)T - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the, -C directory file._ -CR -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.Y -C If 0, write the header of the directory file. -C OUTPUTS:_ -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z)F - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'L - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*8 NEWS_KEY - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE.& - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBINC - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THENE - IF (REMOTE_SET.EQ.4) THEN - IER = 0I - ELSET - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0G - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN ( - REWRITE (2,IOSTAT=IER) BULLDIR_HEADERM - END IF - END IFG - END IF) - IF (IER.NE.0) THEN - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IFG - END IF) - END IF - ELSEU - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN2 - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRYE - END IF_ - END IF_ - IF (IER.NE.0) THENS - IF (REMOTE_SET.EQ.4) THEN - DO WHILE (REC_LOCK(IER).AND. - & BULLETIN_NUM.NE.NEWS_F_END+1) - READ (2,KEYID=1,KEY=NEWS_KEY(I - & BULLETIN_NUM,FOLDER_NUMBER),IOSTAT=IER)C - END DO - ELSEE - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER)6 - END IF - IF (REMOTE_SET.EQ.4.AND., - & BULLETIN_NUM.EQ.NEWS_F_END+1) THENE - CALL SPECIAL_NEWSDIR_ENTRY(IER)T - ELSE IF (IER.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN] - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEN/ - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IFE - END IF - END IFT - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXITY - - DIR_NUM = -1) - - RETURNO - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER)O - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC'R - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - DIMENSION BTIM(2) - - CHARACTER*8 NEWS_KEYE - - READ (2,KEYID=3,KEY=NEWS_MSGID,IOSTAT=IER) INPUT(:84) - DO WHILE (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).NE.FOLDER_NUMBER) - READ (2,IOSTAT=IER) INPUT(:84) - IF (NEWS_MSGID.NE.INPUT(21:84)) IER = 2R - END DO - - IF (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).EQ.FOLDER_NUMBER) THEN - IER = 2D - RETURN - END IFI - -10 IER1 = 0 - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=1,KEYGT=NEWS_KEY(NEWS_F_END,FOLDER_NUMBER),N - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO E - DO WHILE (IER1.EQ.0)E - FNUM = GET_INTEGER(%REF(INPUT)) - IF (FNUM.NE.FOLDER_NUMBER) THEN - IER1 = 2T - ELSE - CALL GET_MSGKEY(%REF(INPUT(85:)),%DESCR(BTIM))G - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND.E - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IFT - F_COUNT = F_COUNT + 1 - NEWS_F_END = GET_INTEGER(%REF(INPUT(5:))) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO ) - END IF - END DOE - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IFn - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY d - - IF (IER.NE.0) THENS - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSE- - F_COUNT = F_COUNT + 1s - END IF - - RETURNm - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLFOLDER.INC' T - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNITD - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE)K - END IF_ - - RETURNG - END - - - - SUBROUTINE CONVERT_ENTRY_TOBINI - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST) - - CHARACTER*4 INTEGER_KEY - - CHARACTER*8 NEWS_KEY - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THENS - CALL COPY2(NEWS_POST_BTIM,MSG_BTIM)_ - END IF - - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - IF (LOCAL_POST) THENN - CALL COPY2(NEWS_POST_BTIM,MSG_BTIM)E - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP - NEWS_FROM = FROM - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)Y - NEWS_MSG_KEY = NEWS_KEY(MSG_NUM,FOLDER_NUMBER) - NEWS_MSG_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY) - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - NEWS_EX_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY - ELSE& - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)E - END IF - - RETURN - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC'_ - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KEYID/ NEWS_KEYID - - COMMON /KEEPLOCK/ KEEPLOCKF - G - EX_BTIM(1) = 0L - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 4T - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY)S - CALL READDIR_KEYGE(NDEL)T - KEEPLOCK = .FALSE.U - NEWS_KEYID = 2E - - RETURNI - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -CD -C FUNCTION: Reads the ACL of a file.B -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information.T -CN - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*)N - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)S - - BIG = .NOT.IERS - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENTE - CTXT = 0 - END IFU - - DO ACC_TYPE=1,2 - POINT = 1D - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)O - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+I - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST)B - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))),S - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE.O - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THENO - START_ID = INDEX(ACLSTR,'=') + 1S - END_ID = INDEX(ACLSTR,',ACCESS') - 1h - IF (ACLSTR(END_ID:END_ID).EQ.']') THENi - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND._ - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII))- - IF (ACLSTR(START_ID:START_ID).NE.','.AND.O - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE.8 - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF0 - END DOI - IF (ASCII) THEN - START_ID = START_ID + 1_ - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1- - END_ID = INDEX(ACLSTR,'ACCESS') - 2. - END IF - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THENI - IF (ACC_TYPE.EQ.1) THENN - WRITE (6,'(R - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(. - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IFG - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THENV - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)E - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2_ - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)4 - OUTLEN = 1 - ELSET - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IFE - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)N - END DO+ - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))N - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THENE - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')')R - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')E - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL2 - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFI - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW',D - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX)D - END DOI - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURNR - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z)) - E - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)( - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another fileE -CN - IMPLICIT INTEGER (A-Z)N - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE. - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))T - ! Get length needed to store acl output( - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl) - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of stringN - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -CL -C SUBROUTINE COPY_ACL1D -Cn -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routinesE -C since must convert location of string into a character string. -C- - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,)C - ! Read input file acl/ - - IF (.NOT.IER) THEN_ - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENTC - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT))_ - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST)L - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IFF - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output fileK - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT,E - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DOY - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLFILES.INC'L - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./ - - IF (CHECKED) RETURN - - CHECKED = .TRUE. - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C)S - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORY - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE)a - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSEC - CALL ADD_DIRECTORY(BULLNEWS_FILE)6 - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - END IFe - - CALL CHECK_DIR(FOLDER_DIRECTORY)A - CALL CHECK_DIR(NEWS_DIRECTORY) - - CALL ADD_DIRECTORIESG - - RETURN - END= - S - - - SUBROUTINE ADD_DIRECTORIES% - - INCLUDE 'BULLFILES.INC'. - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE) - - RETURN0 - END - - - - SUBROUTINE CHECK_DIR(DIRECTORY) - - IMPLICIT INTEGER (A-Z)P - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - IF (.NOT.SYS_TRNLNM_SYSTEM(DIRECTORY,TEST)) RETURN& - - CALL SYS_TRNLNM(DIRECTORY,TEST1)A - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST)H - END DOD - - IF (TEST.NE.TEST1) THEN - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER)A - CLOSE(UNIT=3,STATUS='DELETE')A - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)') - & TEST1(:TRIM(TEST1))C - CALL EXIT - END IF - DIRECTORY = TEST1' - ELSE. - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - END IF - - RETURNR - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:)T - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:)T - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY I - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':'D - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURNS - ENDT diff --git a/decus/vms94b/bulletin/bulletin7.for b/decus/vms94b/bulletin/bulletin7.for deleted file mode 100644 index e74f5b7..0000000 --- a/decus/vms94b/bulletin/bulletin7.for +++ /dev/null @@ -1,2318 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:43:39.89 -To: EVERHART -CC: -Subj: BULLETIN7.FOR - -Date: Fri, 19 Aug 1994 17:25:54 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172554.21438991@PFC.MIT.EDU> -Subject: BULLETIN7.FOR - -C -C BULLETIN7.FOR, Version 8/10/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER1_NAME.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,): - NEWEST_DATE = TODAY_TIME(:11)T - NEWEST_TIME = TODAY_TIME(13:23)g - NBULL = F1_NBULL - CALL UPDATE_FOLDER: - ELSER - WRITE (6,'(1X,A)') FOLDER1_COM(:I)9 - END IF - ELSE - CALL DISCONNECT_REMOTEl - IF (INCMD(:4).EQ.'MOVE') CALL EXITP - END IF - CALL UPDATE_LOGIN(.TRUE.)t - RETURN - END IFt - - CALL READDIR(0,IER) - - IF (IER.NE.1) THENb - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00'a - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0o - IF (REMOTE_SET.NE.4) NBLOCK = 0T - SHUTDOWN = 0 - NEMPTY = 0 - END IFN - - CALL SYS$ASCTIM(,TODAY_TIME,,)p - DATE = TODAY_TIME(:11) - TIME = TODAY_TIME(13:23) - - NEWEST_DATE = DATEI - NEWEST_TIME = TIME - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THENL - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE)C - IF (DIFF.GT.0) THENO - NEWEST_EXDATE = EXDATET - NEWEST_EXTIME = EXTIME_ - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1M - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTHu - CALL WRITEDIR(NEWS_F_END+1,IER)e - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IFl - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1b - NBULL = NEWS_F_ENDc - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1g - NBLOCK = NBLOCK + LENGTH, - END IF - - CALL WRITEDIR(0,IER)l - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL)T - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND.E - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE()A - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHAREDE - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13)A - CALL REWRITE_FOLDER_FILE(IER)E - CALL CLOSE_BULLNEWSd - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIRD - - RETURNE - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2)T -C( -C FUNCTION COMPARE_BTIM -Cr -C FUCTION: Compares times in binary format to see which is farther in future. -CI -C INPUTS: -C BTIM1 - First time in binary formatA -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal timeI -C - IMPLICIT INTEGER (A - Z)0 - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1A - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1B - END IF2 - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -CU -C FUNCTION MINUTE_DIFFS -CO -C FUNCTION: Finds difference in minutes between 2 binary times. -C -Cn - IMPLICIT INTEGER (A-Z)I - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1). - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000R - - RETURN - END - - - - - - * - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2)M -CS -C FUNCTION COMPARE_DATE -CN -C FUCTION: Compares dates to see which is farther in future. -CR -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date)T -C OUTPUT: -C Returns the difference in days between the two dates.L -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z)R - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2)_ - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -CS -C LIB$DAY crashes if date invalid, which happened once due to an unknownD -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME)F - - IF (DATE2.NE.' ') THEN' - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME)a - ELSEC - CALL SYS$GETTIM(USER_TIME) - END IFR - - CALL LIB$DAY(DAY2,USER_TIME)1 - - COMPARE_DATE = DAY1 - DAY2. - - RETURNA - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z). - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1)T - BTIM(2) = TEMP(2) - END IFM - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1)% - BTIM(2) = TEMP(2)E - END IF - - RETURN_ - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2)C -C -C FUNCTION COMPARE_TIME -C_ -C FUCTION: Compares times to see which is farther in future.N -CQ -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second timeM -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C) - - IMPLICIT INTEGER (A-Z)P - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2_ - - IF (TIME2.EQ.' ') THENE - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23)M - ELSE) - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1)))P - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10)))T - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1C - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IFE - - RETURN - END - -C------------------------------------------------------------------------- -CL -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to beR -C outputted to the terminal. This is done so as to be able to close_ -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second containsN -C the address. The address is simply the address of the 3rd word ofA -C the record. The last word in the record contains the address of theR -C next record. Every time a record is written, if that record has aS -C zero link, it adds a new record for the next write operation. _ -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA)T - CHARACTER*(*) DATAe - INTEGER HEADERe - IF (HEADER.NE.0) RETURN ! Queue already initializedI - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN6 - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATAR - LENGTH = RECORD(1)F - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD)))I - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4)U - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT) - RETURN& - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATAA - INTEGER RECORD(1) - LENGTH = RECORD(1)R - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURNE - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHARB - OUTCHAR = INCHAR(:LENGTH) - RETURN: - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEND - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0O - RETURN. - END - - - - SUBROUTINE DISABLE_PRIVSI -C, -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges.M -C - - IMPLICIT INTEGER (A-Z)D - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/T - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURNE - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privilegesD - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1)R - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURNI - END - - - - SUBROUTINE ENABLE_PRIVS -CD -C SUBROUTINE ENABLE_PRIVS -CT -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z)E - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURNT - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privsN - - RETURNE - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -CC -C SUBROUTINE CHECK_PRIV_IOL -CI -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -Cl - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV D - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE')L - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1L - ELSEN - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0_ - END IFS - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')O - - RETURNS - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG)E -CF -C SUBROUTINE CHANGE_FLAG -CB -C FUNCTION: Sets flags for specified folder.I -CI -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. E -C If FALSE, clear flag.E -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -CO - IMPLICIT INTEGER (A - Z)( - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC't - - INCLUDE 'BULLFOLDER.INC'w - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4)y - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))n - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./n - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1)I - IF (IER) THEN0 - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')')A - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR.s - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')')A - RETURN - END IF$ - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IFR - -CR -C Find user entry in BULLUSER.DAT to update information.D -C1 - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entrya - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's todayt - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entryA - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN2 - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)L - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)i - END IF - NEW_FLAG(1) = 143a - NEW_FLAG(2) = 0r - CALL WRITE_USER_FILE_NEW(IER) - ELSEr - IF (CMD) THEN. - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)T - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143S - REWRITE (4,IOSTAT=IER) USER_ENTRYD - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IFE - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONGn - NOTIFY_REMOTE(I) = 0 - END DOE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER)5 - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER)1 - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IFO - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE.N - END IFI - - RETURNI - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -Cp -C FUNCTION: Sets version number., -C - IMPLICIT INTEGER (A - Z)f - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'A - - DIMENSION FLAGS(FLONG,4)A - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))_ - - DIMENSION READ_BTIM_SAVE(2) - -CL -C Find user entry in BULLUSER.DAT to update information. -CS - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1)E - READ_BTIM_SAVE(2) = READ_BTIM(2)( - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entryC - - IF (IER.EQ.0) THENE - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF: - - CALL CLOSE_FILE (4) - RETURNM - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C1 -C SUBROUTINE CHECK_NEWUSER -CC -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was.L -CI -C INPUTS: -C USERNAME - UsernameM -C OUTPUTS:1 -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -Cn - - IMPLICIT INTEGER (A-Z)q - - CHARACTER*(*) USERNAMEf - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST)n - - DISMAIL = 0 ! Set return falseu - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET?y - DISMAIL = 1 ! Yepo - END IF - END IFh - - RETURN ! Return - END ! Ende - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z)a - - CHARACTER*(*) INPUT,OUTPUTe - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist- - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),,E - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN- - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT)L - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IFH - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN ( - CALL INIT_ITMLST ! Initialize item listR - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IFD - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX))= - CALL ADD_2_ITMLST_WITH_RETE - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))P - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlistA - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1h - - RETURNg - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT)C - - IMPLICIT INTEGER (A-Z)P - - CHARACTER*(*) INPUT,OUTPUTT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlistR - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IFH - - RETURNH - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1)P - - IMPLICIT INTEGER (A-Z)l - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./T - - IF (INIT) THENR - FILE_LOCK = 1T - INIT = .FALSE. - ELSEF - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)e - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSEY - FILE_LOCK = 0I - INIT = .TRUE.R - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0, - INIT = .TRUE. - END IF - END IF - - RETURN. - END - - - - SUBROUTINE ENABLE_CTRL. - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /CTRLY/ CTRLYS - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE1 - - QUIT = 1$ - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1N - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THENH - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IFo - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -Cl - END IFE - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1)N - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0R - CALL SET_FOLDER_FILE(0)Y - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXITC - END IFM - QUIT = 0 ! Reinitialize - - RETURNE - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLYF - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/B - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURNL - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C. -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z)N - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'H - - CHARACTER BUFFER*128' - - CALL OPEN_BULLDIR_SHAREDr - -Ce -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -CN - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADERD - END DOE - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THENT - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for''i - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1)1 - END IF_ - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURNN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER)E - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFERT - END DOY - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100I - END IF_ - WRITE(11) BUFFERI - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFILO - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1E - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR',_ - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETET - IER = 1i - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IFE - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))U - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',M - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',E - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THENt - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,A - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER))H - CALL ERRSNS(IDUMMY,IER)T - IF (IER1.EQ.0) THENS - WRITE (6,'('' IOSTAT error = '',I)') IERE - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11)G - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IFt - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR',T - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULLT - CALL READDIR(I,IER)M - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)L - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for''$ - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER))T - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSEO - CALL SYS_GETMSG(IER1)U - END IFI - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR$ - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURNL - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0)M - END DOL - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing. - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory headerM - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER)S - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//_ - & '.BULLFIL;-1') - END DOY - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER)E - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//P - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*',' - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURNS - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)I -CX -C SUBROUTINE CLEANUP_DIRFILE -CI -C FUNCTION: Reorder directory file after deletions.P -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting processH -C was abnormally terminated. -C% - IMPLICIT INTEGER (A - Z)C - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE0 - - CHARACTER*12 DATE_SAVE,EXDATE_SAVEY - CHARACTER*12 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY) - DATE_SAVE = DATE_ - TIME_SAVE = TIMEE - EXDATE_SAVE = EXDATEU - EXTIME_SAVE = EXTIMEE - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry?S - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entriesM - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER)/ - RETURNP - END IFI - LENGTH = -LENGTH ! Indicate starting point by writingc - CALL WRITEDIR(I,IER) ! next entry into deleted entryN - FIRST_DELETE = I ! with negative lengthT - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletionF - FIRST_DELETE = I ! was previously in progressA - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULLL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY)C - END IF - END DOe - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_QL - BLOCK_SAVE = BLOCKL - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST)U - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THENU - MOVE_TO = MSG_NUM_SAVE + 1' - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for anyt - END DO ! of the other entries - END IF - I = I + 1( - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessaryE - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER)E - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1) - END IF( - END DOL - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of fileT - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF1 - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN' - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IFR - - CALL WRITEDIR(0,IER)= - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVES - DATE = DATE_SAVE - TIME = TIME_SAVEL - EXDATE = EXDATE_SAVEC - EXTIME = EXTIME_SAVEE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -CC -C SUBROUTINE SHOW_FLAGS -CL -C FUNCTION: Show user flags. -CL - IMPLICIT INTEGER (A - Z)) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'l - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THENT - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF) - -C -C Find user entry in BULLUSER.DAT to obtain flags.D -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURNB - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))L - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THENE - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.A - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.) - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THENI - WRITE (6,'('' SHOWNEW is set.'')') - END IF - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')')O - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THENT - WRITE (6,'('' No flags are set.'')') - END IFD - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSERO - - RETURN, - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z)A - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1))E - - RETURNN - END - - - SUBROUTINE CLR2(FLAG,NUMBER)I - - IMPLICIT INTEGER (A-Z)I - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURNO - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z)T - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))p - - RETURNf - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -CR -C FUNCTION: -C To get names of all users that are logged in.A -Cr - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF ***F - PARAMETER PSCAN$_BEGIN = '00000000'XL - PARAMETER PSCAN$_ACCOUNT = '00000001'XT - PARAMETER PSCAN$_AUTHPRI = '00000002'XD - PARAMETER PSCAN$_CURPRIV = '00000003'XI - PARAMETER PSCAN$_GRP = '00000004'X - PARAMETER PSCAN$_HW_MODEL = '00000005'X - PARAMETER PSCAN$_HW_NAME = '00000006'X( - PARAMETER PSCAN$_JOBPRCCNT = '00000007'Xt - PARAMETER PSCAN$_JOBTYPE = '00000008'Xt - PARAMETER PSCAN$_MASTER_PID = '00000009'X - PARAMETER PSCAN$_MEM = '0000000A'X+ - PARAMETER PSCAN$_MODE = '0000000B'X - PARAMETER PSCAN$_NODE_CSID = '0000000C'XR - PARAMETER PSCAN$_NODENAME = '0000000D'X , - PARAMETER PSCAN$_OWNER = '0000000E'X' - PARAMETER PSCAN$_PRCCNT = '0000000F'X - PARAMETER PSCAN$_PRCNAM = '00000010'X - PARAMETER PSCAN$_PRI = '00000011'XN - PARAMETER PSCAN$_PRIB = '00000012'X - PARAMETER PSCAN$_STATE = '00000013'X - PARAMETER PSCAN$_STS = '00000014'XI - PARAMETER PSCAN$_TERMINAL = '00000015'X - PARAMETER PSCAN$_UIC = '00000016'X - PARAMETER PSCAN$_USERNAME = '00000017'X - PARAMETER PSCAN$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER PSCAN$_END = '00000019'X1 - PARAMETER PSCAN$k_type = '00000081'XS - PARAMETER PSCAN$M_OR = '00000001'XL - PARAMETER PSCAN$M_BIT_ALL = '00000002'X - PARAMETER PSCAN$M_BIT_ANY = '00000004'X - PARAMETER PSCAN$M_GEQ = '00000008'X - PARAMETER PSCAN$M_GTR = '00000010'X - PARAMETER PSCAN$M_LEQ = '00000020'X - PARAMETER PSCAN$M_LSS = '00000040'X - PARAMETER PSCAN$M_PREFIX_MATCH = '00000080'XL - PARAMETER PSCAN$M_WILDCARD = '00000100'XF - PARAMETER PSCAN$M_CASE_BLIND = '00000200'XI - PARAMETER PSCAN$M_EQL = '00000400'X - PARAMETER PSCAN$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER PSCAN$S_OR = 1R - PARAMETER PSCAN$V_OR = 0 - PARAMETER PSCAN$S_BIT_ALL = 1 - PARAMETER PSCAN$V_BIT_ALL = 1 - PARAMETER PSCAN$S_BIT_ANY = 1 - PARAMETER PSCAN$V_BIT_ANY = 2 - PARAMETER PSCAN$S_GEQ = 1 - PARAMETER PSCAN$V_GEQ = 3 - PARAMETER PSCAN$S_GTR = 1 - PARAMETER PSCAN$V_GTR = 4 - PARAMETER PSCAN$S_LEQ = 1 - PARAMETER PSCAN$V_LEQ = 5 - PARAMETER PSCAN$S_LSS = 1 - PARAMETER PSCAN$V_LSS = 6 - PARAMETER PSCAN$S_PREFIX_MATCH = 1 - PARAMETER PSCAN$V_PREFIX_MATCH = 7e - PARAMETER PSCAN$S_WILDCARD = 1e - PARAMETER PSCAN$V_WILDCARD = 8r - PARAMETER PSCAN$S_CASE_BLIND = 1e - PARAMETER PSCAN$V_CASE_BLIND = 9I - PARAMETER PSCAN$S_EQL = 1 - PARAMETER PSCAN$V_EQL = 10I - PARAMETER PSCAN$S_NEQ = 1 - PARAMETER PSCAN$V_NEQ = 11X - BYTE %FILL (2)A - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -CL -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -CN -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME))i -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL))l -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE))U -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1d -C UJPIMODE = -1S -C TERMINAL(1:1) = CHAR(0)o -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process( -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item listI - ! Now add items to listI - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlistS - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IFe - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listo - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0)( - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.T - END DON - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER_ - - RETURN_ - END - - - - - - SUBROUTINE OPEN_USERINFON -C_ -C SUBROUTINE OPEN_USERINFO -CN -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -CR - IMPLICIT INTEGER (A - Z)Y - - INCLUDE 'BULLUSER.INC'r - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)I - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)= - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./o - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DOF - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAXs - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IFT - END DO - END IFN - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET'L - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAXs - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DOR - END DO0 - END IF - - IF (IER.NE.0) THENR - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2)E - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT fileE - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER)R - END IFO - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THENR - DO I=1,FOLDER_MAX' - LAST_READ_BTIM(1,I) = READ_BTIM(1)R - LAST_READ_BTIM(2,I) = READ_BTIM(2)F - END DO - END IFO - END IF - DO I=1,FOLDER_MAXE - DO J=1,2' - LAST(J,I) = LAST_READ_BTIM(J,I)I - END DON - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - DO WHILE (REC_LOCK(IER))E - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.EQ.0) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) =S - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSEN - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2)))f - END IF) - WRITE (9,IOSTAT=IER) USERNAME,INF_REC - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU)))R - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) =I - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1)))O - ELSE2 - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IFI - END IF - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIML - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX1 - LAST_SYS_BTIM(1,I) = 0N - LAST_SYS_BTIM(2,I) = 0R - END DO - END IFT - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINFE - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ)O - - USERINFO_READ = .TRUE.T - - RETURNU - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -C0 -C SUBROUTINE READ_NEWS_USERINFO -C0 - IMPLICIT INTEGER (A - Z)M - - INCLUDE 'BULLUSER.INC'T - - CHARACTER*(*) NAME0 - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1)))P - ELSEE - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2)))0 - END IFP - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READR - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU)))N - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSEM - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IFR - IF (IER.NE.0) THEN' - DO I=1,FOLDER_MAXP - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IFE - - RETURN0 - END - - - - - SUBROUTINE UPDATE_USERINFO' -C -C SUBROUTINE UPDATE_USERINFO0 -C0 -C FUNCTION: Updates the latest message read times for each folder. -CN - IMPLICIT INTEGER (A - Z)M - - INCLUDE 'BULLUSER.INC'8 - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)L - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)R - COMMON /USERINFO/ LAST(2,FOLDER_MAX)P - - IF (.NOT.USERINFO_READ) RETURNR - - DIFF = .FALSE.0 - FNUM = 1R - - DO WHILE (.NOT.DIFF.AND.FNUM.LE.FOLDER_MAX) - DIFF = LAST_READ_BTIM(1,FNUM).NE.OLD_LAST_READ_BTIM(1,FNUM)L - IF (.NOT.DIFF) THENM - DIFF = LAST_READ_BTIM(2,FNUM).NE.OLD_LAST_READ_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1/ - END DOR - - DIFF1 = .FALSE. - FNUM = 1R - - DO WHILE (.NOT.DIFF1.AND.FNUM.LE.FOLDER_MAX)T - DIFF1 = LAST_SYS_BTIM(1,FNUM).NE.OLD_LAST_SYS_BTIM(1,FNUM) - IF (.NOT.DIFF1) THEN - DIFF1 = LAST_SYS_BTIM(2,FNUM).NE.OLD_LAST_SYS_BTIM(2,FNUM)R - END IF - FNUM = FNUM + 1M - END DON - - DIFF2 = .FALSE. - FNUM = 1N - - DO WHILE (.NOT.DIFF2.AND.FNUM.LE.FOLDER_MAX)P - DIFF2 = LAST_NEWS_READ(1,FNUM).NE.OLD_LAST_NEWS_READ(1,FNUM) - IF (.NOT.DIFF2) THEN - DIFF2 = LAST_NEWS_READ(2,FNUM).NE.OLD_LAST_NEWS_READ(2,FNUM)_ - END IF - FNUM = FNUM + 1S - END DO - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHAREDN - - IF (DIFF) THENT - READ (9,KEY=USERNAME,IOSTAT=IER) - DO I=1,FOLDER_MAX - DO J=1,2V - LAST(J,I) = LAST_READ_BTIM(J,I) - END DOP - END DO - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF, - - IF (DIFF1) THEN - LU = TRIM(USERNAME)t - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))2 - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IFS - - IF (DIFF2) THEN - LU = TRIM(USERNAME)M - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THENN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READF - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ/ - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1)))E - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2)))E - END IF - END IFT - - CALL CLOSE_BULLINFl - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z)S - - INTEGER BTIM(2) - - CHARACTER*(*) TIMEm - - CHARACTER*24 TIME1_ - - TIME1 = TIME(FIRST_ALPHA(TIME):)O - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:)C - END DOT - - IF (TIME1.EQ.'-') TIME1 = '-- :'i - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE( - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM)I - END IFT - - RETURNP - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -CE -C FUNCTION: -CE -C Update user's last read bulletin date. If new bulletins have beenF -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit.X -C - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLFOLDER.INC'O - - INCLUDE 'BULLUSER.INC'R - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH, - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)E - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATEO - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)T - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder info= - ELSE IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time) - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER)1 - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder infoE - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn'tN - END IF ! think it's called via LOGINT - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUME - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flagB - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1N - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENH - CALL SET2(NEW_MSG,FOLDER_NUMBER)L - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.C - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND.D - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM)R - ELSEI - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)( - IF (IER.LE.15) DIFF = -1T - END IF - END IF - END IFI - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND.M - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messagesH - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF1 - END IF - END DON - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)( - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),N - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM)T - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages?_ - IF (DIFF.GT.0) THEN ! No, update last read time._ - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF2 - END IF - IF (DIFF.LT.0) THENL - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IFB - END IFW - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS)' - IF (INCMD(:4).EQ.'SHOW') THENM - SAVE_FOLDER_Q1 = 0 - RETURNC - END IF - IF (NEW_MESS.OR.NEWS_MESS) THENN - WRITE (6,'('' Type SELECT followed by foldername to'',E - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0L - CALL SELECT_FOLDER(.FALSE.,IER)2 - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0T - DO WHILE (NEW_COUNT.GT.0)F - NEW_COUNT = NEW_COUNT / 10a - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletinsO - ELSEC - BULL_POINT = 0_ - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1), - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)O - END IF) - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THENT - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM)A - ELSE( - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)T - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1 - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER)S - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THENR - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERN - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - ELSER - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0. - END IF - END IF) - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THENA - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINTO - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORYE - BULL_POINT = SAVE_BULL_POINTF - END DO= - END IFM - END IF - END IFR - END IFA - END IFU - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS)) - CALL EXITI - END IFN - - RETURN- - END - - - - - SUBROUTINE READ_IN_FOLDERS( - - IMPLICIT INTEGER (A-Z)) - - INCLUDE 'BULLFOLDER.INC'= - - INCLUDE 'BULLUSER.INC'F - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUML - DATA SAVE_FOLDER_Q1/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)1 - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - I - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find foldersT - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1N - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1E - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.U - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSIONr - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR.x - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -CU - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THENI - FOLDER_FLAG = IBSET(FOLDER_FLAG,2)M - CALL REWRITE_FOLDER_FILE(IER)2 - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER)G - END IFT - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO= - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'D - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - - RETURNt - END diff --git a/decus/vms94b/bulletin/bulletin8.for b/decus/vms94b/bulletin/bulletin8.for deleted file mode 100644 index 7fcc5ee..0000000 --- a/decus/vms94b/bulletin/bulletin8.for +++ /dev/null @@ -1,2146 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:36:30.94 -To: EVERHART -CC: -Subj: BULLETIN8.FOR - -Date: Fri, 19 Aug 1994 17:25:57 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172557.21438991@PFC.MIT.EDU> -Subject: BULLETIN8.FOR - -C -C BULLETIN8.FOR, Version 5/2/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0O - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/')V - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)): - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAMEl - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR.i - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM))t - ELSEr - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2)g - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2)B - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF1 - - RETURN - ENDT - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z)X - - PARAMETER MAXLINK = 20E - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)1 - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFI - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,)' - - RETURNN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM)A - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20M - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)E - INTEGER*2 WRITE_IOSBI - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)F - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)2 - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX)F - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THENS - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1S - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THENY - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE3 - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)),F - & OUT_SAVE(UNIT_INDEX),INPUT)Y - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).GT.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST,) - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX)F - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IFP - - RETURNT - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z)T - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)I - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF0 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK)( - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLKM - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURNB - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1_ - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND._ - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN2 - CALL DISCONNECT(UNIT_INDEX)O - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THENC - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0,I - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX,I - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX)E - ELSEH - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IFC - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z)I - - PARAMETER MAXLINK = 20S - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)( - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSBH - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF_ - - CALL DISCONNECT(UNIT_INDEX) - - RETURNA - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM)4 - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20C - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSBN - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THENS - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER)O - IF (IER) RETURNS - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER)D - - IMPLICIT INTEGER (A-Z)_ - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)_ - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFV - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)R - INTEGER*2 WRITE_IOSBT - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUTn - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX))M - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER)C - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURND - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM)s - - IMPLICIT INTEGER (A-Z)$ - - PARAMETER MAXLINK = 20L - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)E - INTEGER*2 WRITE_IOSBF - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFX - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1S - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - I - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1_ - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX)P - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF( - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IFO - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURNr - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)E - INTEGER*2 WRITE_IOSBM - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST' - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN_ - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0,= - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX)N - IF (IER) RETURN+ - END IFN - - CALL DISCONNECT(UNIT_INDEX) - - RETURN( - END - - - . - SUBROUTINE NEWS_CREATE_AST(ASTPRM)R - - IMPLICIT INTEGER (A-Z)= - - PARAMETER MAXLINK = 20( - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)1 - INTEGER*2 WRITE_IOSBU - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)O - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF( - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN. - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSEL - CALL DISCONNECT(UNIT_INDEX) - END IFI - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z)L - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area forH - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20P - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)F - INTEGER*2 WRITE_IOSBR - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)2 - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFO - DATA COUNT /0/R - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)R - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)R - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12K - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1M - - EXTERNAL IO$_ACCESS,IO$M_ABORTO - - CHARACTER*(*) USERNAME,FROMNAME,NODENAMEE - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5)L - - LEN_NCB = MBX_BUF(START_NCB-1)S - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC))T - - IF (COUNT.GT.MAXLINK) THENR - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUMT - ELSEI - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX')O - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER)S - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1H - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DOU - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THENU - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT)A - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNITL - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAMET - FROM_SAVE(UNIT_INDEX) = FROMNAME0 - NODE_SAVE(UNIT_INDEX) = NODENAMEI - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IFT - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,)R - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1M - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0O - END IFN - - RETURNA - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER)T -CL -C SUBROUTINE GETDEVUNIT -CR -C FUNCTION: -C To get device unit numberT -C INPUT:O -C CHAN - Channel numberD -C OUTPUT: -C DEV_UNIT - Device unit number_ -CE - - IMPLICIT INTEGER (A-Z)Y - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listN - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlistI - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURNI - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -CI -C SUBROUTINE GETDEVMAME -C) -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel numberO -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -CX - - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAMEI - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listS - CALL ADD_2_ITMLST_WITH_RETI - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN))F - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlistA - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURNL - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -CI -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists.N -CA - - IMPLICIT INTEGER (A-Z)C - - PARAMETER MAXLINK = 201 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)X - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFE - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area forM - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX)R - END IFF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0U - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IFL - - RETURNU - END - - - - SUBROUTINE SET_TIMER(MIN) -CX -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -CB - IMPLICIT INTEGER (A-Z)4 - INTEGER TIMADR(2) ! Buffer containing timeW - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONSO - - CALL LIB$GET_EF(WAITEFN)F - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURNA - END - - - - - SUBROUTINE CHECK_CONNECTIONSU - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20, - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK)_ - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)C - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFK - - IF (COUNT.GT.0) THENF - DO UNIT_INDEX=1,MAXLINK_ - IF (DEVS(UNIT_INDEX).NE.0.AND.S - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THENS - CALL DISCONNECT(UNIT_INDEX)C - END IF - END DO - END IFA - - CALL RESET_TIMERR - - RETURNB - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z)S - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*)T - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2)/ - - CALL INIT_ITMLSTT - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST)S - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THENE - USERNAME = 'DECNET'L - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)_ - END IFN - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME)I - - IMPLICIT INTEGER (A-Z)A - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12R - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM)) - NUM = NUM + 1I - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF)I - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IFC - IF (NETUAF(65:65).NE.'*') THENT - USERTEMP = NETUAF(65:)U - ELSEL - USERTEMP = USERNAME, - END IFE - END IF - END DO_ - - USERNAME = USERTEMP - - RETURNE - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z)S - - CHARACTER NETUAF*656E - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/E - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100))R - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)I - - FORMAT = 0R - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT',_ - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)T - FORMAT = 1 - END IFH - - NETUAF_NUM = 0, - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAFS - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:)E - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64)I - SKIP = 4 + ICHAR(NETUAF(65:65))l - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DOT - IF (NLEN.GT.64) THENU - ULEN = ICHAR(NETUAF(65:65))I - NETUAF(65:) = NETUAF(69:)M - DO I=65+ULEN,76( - NETUAF(I:I) = ' ' - END DO - ELSEF - NETUAF(65:) = 'DECNET' - END IFT - END IFB - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO) - - CLOSE (UNIT=7) - - RETURNN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX)M - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLFOLDER.INC'N - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'A - - INCLUDE 'BULLFILES.INC'U - - PARAMETER MAXLINK = 20V - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)S - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFA - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)E - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)C - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)C - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12_ - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK). - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE)T - - INTEGER BULLCP_PRIV(2)E - - CALL COPY2(BULLCP_PRIV,PROCPRIV)_ - - ILEN = READ_IOSB(2,UNIT_INDEX)U - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE.= - REC_SAVE(UNIT_INDEX) = 0_ - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)_ - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THENA - ! Do we need priv info?T - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THENt - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX))n - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND.O - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THENd - CALL CHECK_BULLETIN_PRIV(USERNAME)W - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV)I - END IFS - END IF - END IFC - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND.e - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IFI - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN( - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THENi - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:)))C - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE M - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:)))T - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folderR - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE D - SYSLOG = .FALSE.m - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER)R - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFOX - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real.2 - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSES - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),0 - & %REF(BUFFER(9:)))E - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1)D - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IFN - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:)))C - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24I - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THENI - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),M - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))I - END IFV - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COMi - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1)I - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSEC - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IFX - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER. - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1B - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP))G - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P$ - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM)I - P = 4 + PN - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)1 - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000N - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND.T - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)E - END IF' - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit presentS - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0E - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)E - WRITE (EXTIME,'(I4)') NODE_NUMBERM - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11N - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0'R - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//. - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IFN - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + PT - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THENQ - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + P. - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0)A - CALL OPEN_BULLDIR. - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFILE - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTHN - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)S - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL)Y - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletinC - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file' - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodesX - TEMP_USER = ':'E - DO WHILE (TEMP_USER(:1).EQ.':')A - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER)M - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAMEC - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node thatP - END IF ! originated the messageT - END DO - IF (TEMP_USER(:1).NE.':') THENT - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF/ - CALL SETUSER(USERNAME) ! Reset to original username0 - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN/ - CALL ERRSNS(IDUMMY,IDUMMY,INODE)E - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR.D - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THENE - DELETE (4) - END IFR - ELSEU - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH)P - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER)I - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127))X - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entryM - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)V - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEND - CALL READDIR(ICOUNT,IER)M - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:)))Y - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THENN - BUFFER(5:) = BULLDIR_ENTRYI - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER)V - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0)E - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)? - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX)O - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY)H - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1L - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)N - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0)D - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THENA - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER)H - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THENE - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)R - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER)V - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIRA - BUFFER = 'ERROR: Cannot find message to delete.'E - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000B - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN+ - CALL CLOSE_BULLDIRS - BUFFER = 'ERROR: Insufficient privileges to delete message.'R - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000E - END IF - CALL REMOVE_ENTRYM - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE)A - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read messageO - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT). - CALL SET_FOLDER_FILE(0)S - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX)_ - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)S - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX)) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTHa - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY_ - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)) - CALL SET_FOLDER_FILE(0)( - CALL OPEN_BULLDIRL - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5, - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT)I - P = 4 + PA - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIRS - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000R - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP))T - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + PS - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV()I - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR.( - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR.& - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX)N - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH4 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)E - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin/ - IF (NEW_LENGTH.GT.0) THEN' - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1) - END IF - CALL WRITEDIR(ICOUNT,IER)T - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME)P - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER)( - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)A - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER)F - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENd - CALL CLOSE_BULLDIRD - BUFFER = 'ERROR: Cannot find message to undelete.'B - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000R - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIRA - BUFFER = 'ERROR: Insufficient privileges to undelete message.': - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P_ - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P. - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG)e - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)C - CALL OPEN_BULLUSER_SHAREDO - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) R - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAGI - END DO - IF (IER.NE.0) THEN - DO I=1,FLONGS - NEW_FLAG (I) = 0= - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER,, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSERO - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THENG - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IFN - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:)))L - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THENF - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER)_ - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER)E - END IFY - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0H - DO WHILE (IER.EQ.0)_ - CALL READ_FOLDER_FILE(IER)Y - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER)E - END IFE - END DO - CALL CLOSE_BULLFOLDER - END IFB - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV)A - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IFD - - RETURNC - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 20R - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)T - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK). - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX)I - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)N - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURNL - - CALL OPEN_USERINFOF - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),R - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX)& - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX)E - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND._ - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND.g - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THENI - DIFF1 = -1L - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND.D - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THENK - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSEI - DIFF1 = 0N - END IF - - IF (DIFF1.LT.0) THENA - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IFE - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURNR - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM)R - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM)l - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)L - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)T - - RETURNE - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX)B - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)E - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)A - - RETURNI - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME)P - - IMPLICIT INTEGER (A-Z)U - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN( - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV)% - END IFE - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT)R -CB -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS:O -C ACCOUNT - ACCOUNT owner of present process.B -CT - - IMPLICIT INTEGER (A-Z)T - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT))I - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlista - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info_ - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS)R -CD -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS:E -C STS - Status word of present process.L -CT - - IMPLICIT INTEGER (A-Z)% - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURNL - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUSL - - END - - - - INTEGER FUNCTION REC_LOCK(IER)W - - INCLUDE '($FORIOSDEF)'A - - DATA INIT /.TRUE./A - - IF (INIT) THENO - REC_LOCK = 1 - INIT = .FALSE. - ELSEF - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - INIT = INIT + 2 - IF (INIT.GT.60) THENV - WRITE (6,'('' Bulletin aborting due to record lock'', - & '' problem. Alert system administrator.'')') - CALL EXIT - END IFA - ELSE - REC_LOCK = 0I - INIT = .TRUE. - END IF - END IF - - RETURNB - END - - INTEGER FUNCTION TRIM(INPUT)T - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURNI - END DO, - RETURNI - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z)N - - CHARACTER*80 MESSAGEE - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURNE - END - - - - SUBROUTINE HELP(LIBRARY)B - - IMPLICIT INTEGER (A-Z)t - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' 'X - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFOI -CU -C SUBROUTINE GET_NODE_INFOE -CL -C FUNCTION: Gets local node name and obtains node names from, -C command line.M -CY - - IMPLICIT INTEGER (A-Z)s - - EXTERNAL CLI$_ABSENTF - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODES - - COMMON /TEMP_INPUT/ NODE_TEMP - CHARACTER NODE_TEMP*256 - - CHARACTER*32 NODES(10)R - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,PASSWORD*32,TEMP_USER*12 - - NODE_ERROR = .FALSE.F - - LOCAL_NODE_FOUND = .FALSE.O - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THENN - LOCAL_NODE = LOCAL_NODE(2:)E - L_NODE = L_NODE - 1R - END IFY - - NODE_NUM = 0 ! Initialize number of nodes_ - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',')& - IF (COMMA.GT.0) THENF - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSET - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IFN - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THENL - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)F - POINT_NODE = NODE_NUMR - IER = 1A - DO WHILE (IER.NE.0)I - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD)O - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0)R - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 13 - END DO: - NODE_ERROR = .TRUE. - RETURN4 - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"',N - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')'). - END IF - END DO - END IFU - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUMR - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)//L - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED',E - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM)R - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE.I - RETURN - END IF - END IFK - END DOM - END DO - ELSEC - LOCAL_NODE_FOUND = .TRUE.K - END IFV - RETURNN - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C_ -C SUBROUTINE SET_FOLDER_FILET -CA -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE,L -C if = 1, set FOLDER1_FILES -C( - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLFOLDER.INC'V - - IF (NUM.EQ.0) THEND - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE)L - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE)L - END IF - - RETURNF - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C, -C SUBROUTINE SET_FILE -C0 - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILEM - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - ELSEY - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//E - & '.]' - END IF. - - RETURN - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12T - - DATA UPDATE/.FALSE./ - - UPDATE = .TRUE. - - ENTRY SET_BULLFIL_UPDATE - - UPDATE = .NOT.UPDATEI - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) , - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATEE - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):)T - - M = INDEX(FILDATE,'-')E - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3)S - A - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN R - FOLDER_FILE = FOLDER1_FILE - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THEN - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHAREDH - END IF - END IFR - E - IF (UPDATE) THEN Z - READ (1'1) NBLOCKE - REWRITE (1) NBLOCK + LENGTHC - UPDATE = .FALSE. - END IFS - - RETURN) - END - - - - INTEGER FUNCTION MINGT0(I,J). - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THENE - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE - MINGT0 = MIN(I,J)S - END IF - - RETURN( - END diff --git a/decus/vms94b/bulletin/bulletin9.for b/decus/vms94b/bulletin/bulletin9.for deleted file mode 100644 index bdea05f..0000000 --- a/decus/vms94b/bulletin/bulletin9.for +++ /dev/null @@ -1,2368 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:48:58.81 -To: EVERHART -CC: -Subj: BULLETIN9.FOR - -Date: Fri, 19 Aug 1994 17:26:00 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172600.21438991@PFC.MIT.EDU> -Subject: BULLETIN9.FOR - -C -C BULLETIN9.FOR, Version 8/14/94 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',)A - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',)T - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',)1 - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',)n - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',)E - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',)n - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',)Z - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',)_ - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',)N - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',)O - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',)o - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',)n - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',)9 - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',)i - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1)T - - RETURN9 - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z)D - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT5 - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEYF - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20P - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THENC - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURNF - END IF - OUT = 8T - END IF : - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J))V - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST)( - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST))F - END IFD - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THENT - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN, - C = 0e - IER = 1r - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1, - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST)R - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"'F - IF (TRIM(ST).GT.0) THENi - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST))I - END IFC - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)): - END IFe - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THENF - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ')L - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase displayM - END IFA - END IFE - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE')r - RETURN - END IF' - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD') - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSEE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD'' - & ,LIBRARY,HLP$M_HELP) - END IFL - - RETURND - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z)I - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1U - RETURND - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C/ -C SUBROUTINE OUTPUT_HELPN -CE -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library.R -C - IMPLICIT INTEGER (A-Z)1 - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACTE - CHARACTER*20 KEY(10) - DIMENSION KEYL(10)D - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THENG - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library readT - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name_ - - DO I=1,10 ! Initialize key lengths_ - KEYL(I) = 0I - END DOT - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keysM - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen( - - OLD_NKEY = NKEY ! Save old key countW - EXACT = .TRUE. ! Exact key matchT - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counterR - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO) - - NEXT_KEY = 2E - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next keyB - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length4 - HELP_INPUT_LEN = 0N - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1S - END IF, - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)),A - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10)))O - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1K - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact matchS - DO I=OLD_NKEY+1,NKEY ! then don't updateD - KEYL(I) = 0 ! new keys - END DO= - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topicR - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN)E - ELSE ! If not top level, prompt for subtopicS - LPROMPT = 0 ! Create subtopic prompt lineS - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1= - END DOY - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10B - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF, - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IFK - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DOE - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL)E -C, -C FUNCTION PUT_OUTPUT -CR -C FUNCTION: -C Output routine for input from LBR$GET_HELP. DisplaysI -C help text on terminal with full screen prompting.) -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits., -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C) - IMPLICIT INTEGER (A-Z)K - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACTI - CHARACTER*20 KEY(10)I - DIMENSION KEYL(10)A - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFOR - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be foundE - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys thatG - KEYL(I) = 0 ! were inputted, as they are$ - END DO ! not valid, as no matchI - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND.R - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key lengthI - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowingU - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic.E - NEED_ERASE = .FALSE. - END IFT - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter$ - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screenT - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input?F - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent outputr - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2_ - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to outputE - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IFI - HELP_PAGE = 1 ! Increment page counter.= - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT)t - END IF - END IF - - RETURNe - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE)L - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE))X - - RETURNA - - ENTRY SHOW_NEW_VERSIONN - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM)T - IF (.NOT.IER) RETURNE - - IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN - WRITE (6,'(A)') ' A new BULLETIN executable has been '// - & 'installed since your last use.' - WRITE (6,'(A)') - & ' Type HELP NEW_FEATURES for help on any new features.'_ - END IFI - - RETURNR - END - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT), -CR -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC'- - INCLUDE 'BULLUSER.INC'M - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING0 - - DATA FOLDER_Q1/0/ - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - BULL_POINT = 0k - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART')e - & .AND.INDEX_COUNT.EQ.1) THENN - INDEX_COUNT = 2E - DIR_COUNT = 0 - END IFN - - IF (INDEX_COUNT.EQ.1) THENE - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM)P - - FOLDER_Q = FOLDER_Q1f - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW')H - INEW = NEWE - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THENb - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THENn - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3)_ - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3)) - END IF - - NEW = NEW.AND..NOT.IREAD_TAGP - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE')K - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED= - ELSEE - CALL OPEN_BULLFOLDER_SHARED, - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from fileE - IF (SUBSCRIBE) THEN - IER = 1( - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THENN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER)g - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1e - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSEE - FOUND = .FALSE.t - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THENT - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IFr - END IF - END DO - END IFo - IF (IER.EQ.0) THEN= - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THENR - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))I - & //FOLDER1 - IF (SUBSCRIBE) THENb - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSEr - READ_ACCESS = 1 - END IFo - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1( - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)C - END IFP - END IFi - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymoreT - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE, - WRITE (6,1000) - END IF_ - IF (.NOT.SUBSCRIBE) THENu - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))')y - END IFE - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - DO I = 1,NUM_FOLDERSC - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THENY - J = INDEX(FOLDER1_DESCRIP,' ')_ - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THENE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBERO - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1e - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IFm - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSEa - DATETIME = ' NONE'u - END IF - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL,. - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1' - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THENa - NUM_FOLDER = 0E - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1),E - & 'HIT any key for next page....')W - END IF - END DOT - IF (NUM_FOLDERS.EQ.0) THENK - WRITE (6,1050) - INDEX_COUNT = 0) - RETURN - END IFS - WRITE (6,1060)A - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURNl - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0i - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1d - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THENA - FOLDER_NUMBER = -1H - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0P - END IF - END DON - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0A - RETURN - END IFS - END IF - p - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT), - ELSE IF (INEW) THENr - NEW = INEWt - IF (REMOTE_SET.GE.3) THENR - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSEt - CALL FIND_NEWEST_BULL - END IFn - END IF - - CALL DIRECTORY(DIR_COUNT)p - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IFl - - RETURN - -1000 FORMAT (' The following folders are present'/)B -1010 FORMAT (' The following folders with new messages are present'/)o -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10)S -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12)a -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...')E -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USERU -CN -C SUBROUTINE SHOW_USER -CH -C FUNCTION: Shows information for specified users. -CS - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'! - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX)C - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2)I - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL')W - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USERA - - IF (.NOT.ALL) THENT - IER = CLI$GET_VALUE('USERNAME',TEMP_USER)H - IF (.NOT.IER) TEMP_USER = USERNAME - END IFR - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN( - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IFa - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - FOLDER_PRESENT = CLI$PRESENT('FOLDER')_ - - IF (FOLDER_PRESENT) THENf - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z')' - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME), - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER)P - CALL CLOSE_BULLFOLDER, - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURN - END IF - END IFI - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THENI - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid date specified.'')') - RETURNP - END IF - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURN - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),R - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THENE - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURN$ - END IF' - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN - END IF - ELSE IF (SINCE) THENF - IF (BULL_POINT.EQ.0) THEN_ - WRITE (6,'('' ERROR: No current message.'')') - RETURNH - ELSE IF (NEWS) THENU - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THEN0 - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSEf - STARTMSG = 1 - END IFH - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_ASTN - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LASTF - END DO - ELSER - IF (NEWS) THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) =E - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))D - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IFT - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THENE - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1E - END DOI - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND.P - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THENF - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0 - NEWSMSG = 1R - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBERC - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DOA - IF (NEWSMSG.LE.FOLDER_MAX) THENE - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0 - ELSEL - FOUND = .FALSE.W - END IFd - IF (FOUND.AND.NEWS) THEN - WRITE (6,'(1X,A,'' latest message read '', - & I,''.'')')1 - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN2 - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')')E - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'',E - & '' to specified folder.'')')D - END IF - END IFA - IF (.NOT.ALL) THENE - IF (IER.NE.0) THENF - WRITE (6,'('' User info does not exist.'')') - END IF - IER = 2 - END IFE - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THENS - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE) - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IFL - ELSE - WRITE (6,'('' Entry for specified user not found.'')')1 - END IF - CALL CLOSE_BULLUSER - ELSEI - CALL OPEN_BULLUSER_SHAREDI - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND.E - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM)_ - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')')A - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF= - END DO - CALL CLOSE_BULLUSERS - END IFE - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURNO - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C. -C SUBROUTINE INIT_MESSAGE_ADD -CR -C FUNCTION: Opens specified folder in order to add message.E -C, -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROMT -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS:D -C IER - Error status. True if properly connected to folder. -C False if folder not found.e -C/ - IMPLICIT INTEGER (A - Z)o - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC'O - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP0 - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO5 - CHARACTER*12 PROTOCOL - DATA LPRO/0/p - - COMMON /DIGEST/ LDESCR,FIRST_BREAK. - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP0 - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPE - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXTi - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPEG - DATA SCRTYPE/-1/I - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocessE - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESS. - - FOLDER1_DIRECTORY = FOLDER_DIRECTORYR - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDERS - - IF (IER.NE.0) THEN - IER1 = 1' - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',E - & FOLDER_DIRECTORY)A - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IFL - END DOB - IF (IER2) THENC - CALL ADD_DIRECTORIESE - ELSEF - CALL ERRSNS(IDUMMY,IER) - RETURN - END IFN - END IF - END DOE - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE.' - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder' - FOLDER_SET = .FALSE. ! indicate itF - ELSE ! Else it's another folderB - FOLDER_SET = .TRUE. ! indicate it - END IF. - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCKN - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - - LEN_FROM = TRIM(IN_FROM)r - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1T - LEN_FROM = 0 - END IF( - - IF (LEN_FROM.EQ.0.OR. - & (BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0) - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0S - IF (IER1.NE.0) THEN0 - OPEN (UNIT=3,DISPOSE='DELETE',FILE='BULL_DIR:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW')S - SCRTYPE = 1 - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN_ - CALL STORE_FROM(INFROM,LEN_FROM)R - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol( - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THENR - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IFO - ELSE - DESCRIP = ' ' - END IF - END IFE - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURNT - END - - - - SUBROUTINE WRITEOUT_STOREDH - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER*256 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO: - - IF (BTEST(FOLDER_FLAG,5)) RETURNE - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3) - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -CG -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder.= -CS -C INPUTS: -C BUFFER - Character string containing line to be put into message.E -C - - IMPLICIT INTEGER (A-Z)H - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'S - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPA - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAKL - DATA FIRST_BREAK/.TRUE./( - - COMMON /TEXT_PRESENT/ TEXTC - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFERT - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINEA - - CHARACTER*24 TODAYT - - DATA STORED /.FALSE./ F - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THEN - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN) - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR.' - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = y - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFERE - RETURNE - ELSE IF (BUFFER(:5).EQ.'From:') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:)I - OLD_BUFFER_FROM = .TRUE.. - OLD_BUFFER_SUBJ = .FALSE. - RETURN1 - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE.( - OLD_BUFFER_FROM = .FALSE. - RETURN_ - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:)I - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURNW - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1d - PROTOCOL = INFROM(:LPRO) - END IF: - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCRa - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)e - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THENn - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IFe - STORED = .TRUE.n - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STOREDN - STORED = .FALSE. - END IFs - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE.c - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THENu - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DOE - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN. - IF (.NOT.FIRST_BREAK) THENC - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3)_ - END IF0 - LFROM = 0 - LDESCR = 0, - RETURNR - ELSE IF (.NOT.FIRST_BREAK) THENI - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THENR - LDESCR = LEN_BUFFER - 9N - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROMF - CALL STORE_FROM(INFROM,LFROM)U - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSEL - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IFE - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1E - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM)C - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM)C - END IF - END IF - RETURN - END IFN - ELSE - IF (LEN_BUFFER.GT.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - ELSE - WRITE (3,'(A)') ' ' - END IF( - TEXT = .TRUE. - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty lineR - CALL STORE_BULL(1,' ',NBLOCK) ! just store one space - ELSEF - IF (LEN_DESCRP.EQ.0) THENC - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:)E - LEN_DESCRP = LEN_BUFFER - END IF_ - END IF - IF (.NOT.INEXDATE) THENS - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE._ - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO) - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER)= - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THENR - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN_ - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSEN - EXDATE(1:2) = BUFFER(I:I+1)E - I = I + 2t - END IF - NODATE = .FALSE.! - ELSEB - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-')_ - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSEO - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4L - END IF< - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DOW - INEXDATE = .TRUE. - END IF. - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - IF (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11)) THENS - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH))S - END IF - TEXT = .TRUE.E - END IF - - RETURNO - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -CB -C SUBROUTINE FINISH_MESSAGE_ADD -CL -C FUNCTION: Writes message entry into directory file and closes folder -CS -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -CO - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLUSER.INC'D - - COMMON /DIGEST/ LDESCR,FIRST_BREAKT - - COMMON /SCRTYPE/ SCRTYPE - - COMMON /TEXT_PRESENT/ TEXTI - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAYU - - CHARACTER USER_SAVE*12A - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THENF - CALL STORE_FROM(INFROM,LEN_FROM)G - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THENF - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1 - FIRST_BREAK = .FALSE. - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THENs - CALL GETUSER(FROM) - INFROM = FROMR - LEN_FROM = TRIM(INFROM)g - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THENU - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)E - END IFO - ELSE - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IFT - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg_ - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entryE - RETURN - END IFU - - EXTIME = '00:00:00.00'R - IF (INEXDATE) THENU - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date formatT - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future' - INEXDATE = .FALSE. ! Don't use it - END IF_ - ELSE - INEXDATE = .FALSE. ! Don't use itR - END IF - END IFL - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time?( - EXDATE = '5-NOV-2000' ! no, so set date far in future( - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration dateD - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0) - END IF - END IFS - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with addR - - CALL UPDATE_FOLDER_ - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.GE.0) THEN9 - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:)U - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)F - INPUT = INPUT(:ILEN)V - CALL ADD_PROTOCOL(INPUT,ILEN). - CLOSE (UNIT=3,STATUS='SAVE') - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME). - END IFT - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN) - IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICALE - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARDE - END IF - IF (SCRTYPE.EQ.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')_ - ELSEn - CALL RESPOND_MAIL('BULL.SCR',INPUT,P - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('BULL.SCR;*')E - END IF - CALL SETUSER(USER_SAVE) - USERNAME = USER_SAVE - ELSE - CLOSE (UNIT=3) - END IF - SCRTYPE = -1 - END IFc - - RETURNN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z). - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1N - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THENO - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IFR - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:)) - LEN_INFROM = LEN_INFROM - 1 - END DOT - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:)( - LEN_INFROM = LEN_INFROM - 1E - TWO_SPACE = INDEX(INFROM,' ') - END DO - - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK)R - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(INFROM,LEN_INFROM) - - RETURNl - END - - - SUBROUTINE GET_FROM(INFROM,LEN_INFROM)e - - IMPLICIT INTEGER (A-Z)( - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INFROMu - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards.R - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@'))F - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - DO WHILE (INDEX(INFROM,'<').GT.0.AND. ! Name may be of form - & INDEX(INFROM,'@').GT.INDEX(INFROM,'<')) - INFROM = INFROM(INDEX(INFROM,'<')+1:)! personal-name F - END DO= - - DO WHILE (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name)B - & INDEX(INFROM,'@').GT.INDEX(INFROM,'('))E - INFROM = INFROM(INDEX(INFROM,'(')+1:): - END DO - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR.INFROM(I:I).LE.' '.OR. - & INFROM(I:I).GE.CHAR(127).OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')). - I = I + 1& - END DON - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1 - - I = 1 ! Trim username to end at a alpha charactere - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND.INFROM(I:I).GT.' '.AND. - & INFROM(I:I).LT.CHAR(127).AND.. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''')E - I = I + 1 - END DO+ - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THENW - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DOE - - RETURNR - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.126) - & INDESCRIP(I:I) = ' 'U - END DOS - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:)O - LEN_DESCRP = LEN_DESCRP - 1 - END DOD - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THENS - ! Is length > allowable subject length?C - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//C - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IFA - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP)))C - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER)( -C -C SUBROUTINE STRIP_HEADER -CA -C FUNCTION: Indicates whether line is part of mail message header. -CR -C INPUTS: -C BUFFER - Character string containing input line of message.O -C BLEN - Length of character string. If = 0, initialize subroutine. -CG -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header.S -C - IMPLICIT INTEGER (A - Z)L - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'S - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINEF - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE.A - CONT_LINE = .FALSE.L - RETURN - END IFI - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - END IFA - - IER = .TRUE.D - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuationd - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header line - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation0 - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEND - DATE_LINE(TRIM(DATE_LINE)+1:) = '.'A - END IF - END IFa - RETURNd - ELSE - I = I + 1 - END IF - END DOI - - IER = .FALSE. - CONT_LINE = .FALSE. - - RETURN - END - - - - - SUBROUTINE SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF)o -C -C SUBROUTINE SET_NEWS_FOLDER_DEFAULT -CE -C FUNCTION: Sets flag defaults for specified news group -C Note: If NOTIFY READNEW and BRIEF = 0, it is either news -C group removal or SET SUBSCRIBE command.T -C - IMPLICIT INTEGER (A-Z)t - - INCLUDE 'BULLFOLDER.INC'S - - INCLUDE 'BULLUSER.INC'a - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - ALL = .FALSE. - DEFAULT = 1 - NODEFAULT = 0e - SUB = ABS(BRIEF)+ABS(NOTIFY)+ABS(READNEW).EQ.0d - - IF (NOTIFY.EQ.1.AND.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: /NOTIFY is invalid with non-stored'', - & '' news group.'')')T - RETURNN - END IFR - - IF (INCMD(:3).EQ.'SET') THEN0 - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN= - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - IF (CLI$PRESENT('PERMANENT').OR.(SUB.AND.S - & (NODEFAULT.OR.CLI$PRESENT('NOPERMANENT')))) THEN' - DO WHILE (REC_LOCK(IER1))_ - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO' - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (SUB) DEFAULT = 1( - ELSE IF (CLI$PRESENT('NOPERMANENT').OR.NODEFAULT) THEN - IF (NOTIFY.GE.0) CALL SET_NEWS_FLAG(IER,0,-1,-1). - IF (READNEW.GE.0.OR.BRIEF.GE.0) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - IF (SUB)R - & CALL SET_NEWS_FLAG(IER,-1,-1,-1) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINFV - RETURNR - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_RECN - ELSE - WRITE (9,IOSTAT=IER) '*PERM ',INF_REC - END IF - END IF - ELSEC - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED_ - END IFN - - DO WHILE (REC_LOCK(IER1)). - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DOa - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0/ - INF_REC(2,I) = 0 - END DO - END IFN - IF (NODEFAULT.AND.SUB) THENR - NOTIFY = -1F - READNEW = -1 - BRIEF = -1 - END IF - IF (DEFAULT.OR.NODEFAULT) THENO - IF (NODEFAULT.AND..NOT.SUB) THEN - IF (NOTIFY.NE.-1) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - ELSE - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF): - END IF - IF (.NOT.IER) THEN_ - CALL CLOSE_BULLNEWSD - CALL CLOSE_BULLINF - RETURN - END IFv - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_RECD - ELSE - WRITE (9,IOSTAT=IER) '*DEFAULT ',INF_REC - END IF - END IF - IF ((ALL.OR.(SUB.AND.INCMD(:3).NE.'SET')).AND.IER.EQ.0) THENX - CALL OPEN_BULLUSER_SHAREDS - CALL READ_USER_FILE_HEADER(IER)) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0)( - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN0 - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))I - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - DO WHILE (REC_LOCK(IER1)), - READ (9,KEY=TEMP_USER,IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO' - END IF - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - END IFM - END IF( - CALL READ_USER_FILE(IER)e - END DOD - CALL CLOSE_BULLUSERI - END IF) - - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF& - - RETURNR - END - - - - - SUBROUTINE READ_INF_REC - - IMPLICIT INTEGER (A-Z)' - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLUSER.INC'r - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1))I - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_RECO - END DO& - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO) - END IF - CALL CLOSE_BULLINF - - RETURN) - - ENTRY SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER.AND.I - & INF_REC2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1)F - I = I + 1. - END DO - - IF (I.GT.FOLDER_MAX-1.AND.TEMP_USER(:1).EQ.'*') THEN& - WRITE (6,'('' ERROR: You have '',. - & '' reached the news folder limit of '',I,''.'')')M - & FOLDER_MAX-1 - IER = 0 - RETURN - END IFD - - IF (INF_REC2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14)E - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14)a - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15)T - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15)A - IF (NOTIFY+READNEW+BRIEF.EQ.-3) THEN - DO J=I,FOLDER_MAX-2 - CALL COPY2(INF_REC(1,J),INF_REC(1,J+1))P - END DO - END IF - IER = 1I - RETURN - END IFR - - IF (NOTIFY+READNEW+BRIEF.EQ.-3) RETURNP - - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(INF_REC2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(INF_REC(1,J),INF_REC(1,J-1))j - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THENR - INF_REC2(1,J) = NEWS_FOLDER_NUMBERP - IF (F_START.LE.F_NBULL) THENR - INF_REC2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - INF_REC(2,J) = F_START - 1T - ELSED - INF_REC2(2,J) = 0 - INF_REC(2,J) = F_NBULLa - END IFa - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13)g - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13)f - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IER = 1 - RETURNR - END IF - END DON - - RETURNA - END diff --git a/decus/vms94b/bulletin/mx.com b/decus/vms94b/bulletin/mx.com deleted file mode 100644 index 94a2399..0000000 --- a/decus/vms94b/bulletin/mx.com +++ /dev/null @@ -1,969 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:30:47.43 -To: EVERHART -CC: -Subj: MX.COM - -Date: Fri, 19 Aug 1994 17:26:24 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172624.21438991@PFC.MIT.EDU> -Subject: MX.COM - -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers forM - * a "Reply-to:" or "From:" line - * - * Inputs:0 - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folderr - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADDS - * - */i -unsigned long ints -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from)U -{. - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */l - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */v - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status);U - }t - - /* Loop reading message lines until end-of-file. For each line read,2 - create a string descriptor for it and call the BULLETIN routine to* - add the line. */e - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */o - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */e - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - }e - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -}2 - - e -/* - * - * Function: scan_for_from_line - * - * Functional description:. - * - * The routine scans the message's RFC822 headers for the "From:" line.e - * It parses out the address by extracting the
.e - * - * This routine was necessary because letting BULLETIN find the "From:"e - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating:* - * - * From: MX%"Hunter Goatley, WKU "* - * - * but MX needsl - * - * From: MX%"" - * - * Inputs:R - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects:P - * - * The message file is rewound so that subsequent GETs start at thes - * beginning of the message. - * - */i -unsigned long intm -scan_for_from_line(struct RAB *filerab, char *final_from)v -{d - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */e - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */n - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */l - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */) - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines._ - In such cases, the remaining lines are indented by 6 spaces.c - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is( - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */u - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */i - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */R - }r - - /* Now have the whole "From:" line in whole_from_line. Sincef - the real address is enclosed in "<>", look for it bya - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */S - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */t - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */e - i = &whole_from_line + 6; /* in string length */h - }m - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */N - }A - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - }t - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -}S - - U -/* - * - * Function: forward_to_postmaster - * - * Functional description:N - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs:n - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the foldere - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects:i - * - * The message file is rewound so that subsequent calls to this routinef - * can be made (in case the message is to be written to several folders).c - * - */; -unsigned long inte -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{= - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len;M - char status_msg_buf[256]; int status_msg_len;f - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = {r - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255;i - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster....");c - subject.dsc$w_length = 255;g - subject.dsc$a_pointer = &subject_buf;r - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */i - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */n - attribute_itmlst[0].buffer_address = &postmaster; /* To: */n - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */d - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist));s - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist));r - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x];i - vms_errchk(mail$send_add_bodypart(&send_context,f - &bodypart_itmlst, &nulllist)); - if (x == 1){n - status_msg.dsc$w_length = 256;f - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status);b - elses - status_msg_buf[status_msg.dsc$w_length] = '\0';r - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf);e - bodypart_itmlst[0].buffer_address = &status_msg_buf;i - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - }f - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */i - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz;( - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - }/ - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist));e - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -}i - - d -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs:T - * - * folder - Address of a string descriptor for the name of the foldern - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS statusB - * - */ -unsigned long int* -log_accounting(void *folder, void *from, int bull_status)u -{t - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf};i - - int status;r - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log....");n - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */n - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */l - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */) - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */y - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */b - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */h - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file");t - traceerr(status);& - SYS$CLOSE (&accfab); /* Close the file */' - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status);R - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - s -/* - * f - * Main routine - * - */ -main(int argc, char *argv[]) -{r - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */Y - }I - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1)u - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file....");I - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){g - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf);s - } - else { - tracemsg("Opening sender address file....");n - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab);l - } /* End of "if (argc == 2)"... */t - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) {r - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%");n - } - else{a - - /* Now add the MX% prefix and the double quotes */s - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */e - - /* Make the string repliable through MX by adding MX%"" to it */i - strcpy(from_line,"MX%\042");s - strcat(from_line,frombuf);E - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */O - }a - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder....");t - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */r - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace)T - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n",l - folder_name); - tracemsg("Adding message to BULLETIN folder....");$ - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user);. - if (!(bull_status & 1)){ - traceerr(bull_status);f - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user,c - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - }d - rms_get(&rcptrab); /* Read next recipient */& - }i - - - /* Close the RMS files */x - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab);n - - tracemsg("BULLETIN message processed");a - exit(SS$_NORMAL); /* Always return success */ - -}y -$eod e -$copy/log sys$input MX_BULL.TXT -$decks - MX_BULLg - An MX SITE transport_ - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution:e - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN?p ------------------r -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a messagee -need be sent to a site.t - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the* -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands:d - - SEND ALL Sends all bulletin files.i - SEND filename Sends the specified file.t - BUGS Sends a list of the latest bug fixes.L - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM.C - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. Thec -build procedure for MX_BULL expects the logical BULL_SOURCE to point to the_ -BULLETIN library. You must define this logical (or edit the .COM file), -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct):l - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>"n - -3. If you don't have a SITE transport already defined, simply copyf - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL= - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN./ - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail toR -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETINr -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL_ - MAIL> SENDh - To: MX%"GENERAL@BULLETIN" - Subj: This is a test....o - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path.a - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN"""b - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded tot -BULLETIN via MX_BULL.r - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST ...." - -(Alternatively, you could create a dummy account named MX-LIST (or whateverh -the list name is) that exists only long enough to send the request via MAIL.)/ - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder.s - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwardinga -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the messagec -to the Local agent, which discovers that the mail is forwarded to. -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, whiche -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. Ther -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file:/ - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logicaln -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the* -callable VMS Mail interface) to GOATHUNTER.g - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address/ -for BULLETIN messages will look something like the following:t - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM:b - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayedl -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet; - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1.r -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"?t -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it upn -$ close tmp !...L -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:"D -$ endifM -$ exit 1 !Always return successo -$eod - diff --git a/decus/vms94b/bulletin/news.com b/decus/vms94b/bulletin/news.com deleted file mode 100644 index dd3ec8a..0000000 --- a/decus/vms94b/bulletin/news.com +++ /dev/null @@ -1,690 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:29:51.67 -To: EVERHART -CC: -Subj: NEWS.COM - -Date: Fri, 19 Aug 1994 17:26:26 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172626.21438991@PFC.MIT.EDU> -Subject: NEWS.COM - -$set nover -$copy/log sys$input NEWS.ALT -$deck - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get. - any alt groups, so if you are proposing a serious group, itb - is worth the effort to try to get it into a mainstream - hierarchy. - a - 2) See what the alt.net.opinion of the new group is. Wait a1 - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3.b - n - (these first two steps are often ignored, which usually- - leads to unpleasantness in step 4 below) - f - 3) Post a "newgroup" control message. If you don't knowo - how to do this, check with your news administrator. If youn - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE thatw - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group.r - It may take a couple of days for the control message too - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post thee - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into thei - newsgroups file. - u - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators,o - and reduce the overall acceptance (and distribution) of thed - "alt" hierarchy. This is the reason that steps 1 and 2) - above are important. - o - o -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - i -Don't take this all too seriously, though. The "alt" net is the lastn -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstreamh -newsgroup guidelines.e - t -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - F -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - c --- o - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES4 - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Walesh -$eod g -$copy/log sys$input NEWS.CREATE -$deck -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29c -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATIONa - a -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to aa -successful result should be honored, and any request which fails tou -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. Thee -reason these are called guidelines and not absolute rules is that it isl -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or nota -to create a newsgroup on a given machine rests with the administrator of thatr -machine. These guidelines are intended merely as an aid in making thoses -decisions. - t - j -The Discussion - e -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, andg - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroupsa - to announce-newgroups@uunet.uu.net. - a - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note thate - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handlep - that for you. - s -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should beo - determined during the discussion period. If there is no general agreement onw - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead ofe - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made,g - going back to step 1) above. p - s -3) Group advocates seeking help in choosing a name to suit the proposedl - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group isu - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups andr - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to castn - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitlyp - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, ore - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article hown - to cast a vote. If two addresses are used for a vote, the replye - address must process and accept both yes and no votes OR reject - them both.t - t -2) The voting period should last for at least 21 days and no more than 31l - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - r -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific newa - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - n -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - o -5) Votes may not be transferred to other, similar proposals. A vote shalls - count only for the EXACT proposal that it is a response to. In particular,r - a vote for or against a newsgroup under one name shall NOT be counted asa - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a differentg - moderator or set of moderators. - t -6) Votes MUST be explicit; they should be of the form "I vote for thek - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and nota - counted as votes. - a -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - o -The Result - , -1) At the completion of the voting period, the vote taker must post theg - vote tally and the E-mail addresses and (if available) names of the voterse - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can bed - verified. - r -2) AFTER the vote result is posted, there will be a 5 day waiting period,c - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - d -3) AFTER the waiting period, and if there were no serious objections that mightt - invalidate the vote, and if 100 more valid YES/create votes are receivedt - than NO/don't create AND at least 2/3 of the total number of valid votese - received are in favor of creation, a newgroup control message may be sent t - out. If the 100 vote margin or 2/3 percentage is not met, the group should e - not be created. - k -4) The newgroup message will be sent by the news.announce.newgroups moderatore - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address.a - r -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from thep - close of the vote. This limitation does not apply to proposals which never - went to vote. - U -$eod e -$copy/log sys$input NEWS.MODERATORSd -$deck -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net, -comp.binaries.atari.st atari-binaries@hyperion.comt -comp.binaries.ibm.pc cbip@cs.ulowell.eduA -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edue -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edun -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edut -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.come -comp.laser-printers laser-lovers@brillig.umd.eduo -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edus -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edui -comp.research.japan japan@cs.arizona.eduF -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edun -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edul -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nza -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edun -comp.sources.atari.st atari-sources@hyperion.comy -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.cao -comp.sources.sun sun-sources@topaz.rutgers.edue -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.comd -comp.std.unix std-unix@uunet.uu.nete -comp.sys.acorn.announce announce@acorn.co.ukn -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edub -comp.sys.concurrent concurrent@bdcsys.suvl.ca.use -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.eduo -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.comh -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edur -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.comc -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.orgs -news.announce.conferences nac@tekbspa.tss.comd -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edut -news.lists news-lists-request@cs.purdue.edut -news.lists.ps-maps reid@decwrl.dec.comg -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.cat -rec.arts.movies.reviews movies@mtgzy.att.coma -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edut -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edue -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edun -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edud -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.eduh -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.eduO -sci.military military@att.att.come -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.govn -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edui -soc.politics poli-sci@rutgers.eduy -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.comh -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edue -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uka -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/nulln -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.orgr -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.orgi -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.comn -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.nett -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.neth -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.netr -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDUu -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edue -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDUn -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com) -biz.sco.announce scoannmod@xenitec.on.cae -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.orge -ddn.mgt-bulletin nic@nic.ddn.milt -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.deb -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.orgk -de.comp.sources.os9 fkk@stasys.sta.sub.orge -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de( -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jpU -fj.binaries fj-binaries@junet.ad.jpR -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jpo -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edut -gnu.bash.bug bug-bash@prep.ai.mit.edud -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.eduu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edue -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edul -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.eduh -gnu.gdb.bug bug-gdb@prep.ai.mit.edu. -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edui -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.educ -houston.weather weather-monitor@tmc.edug -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org@ -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.educ -info.firearms firearms@cs.cmu.edup -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.educ -info.ietf.hosts ietf-hosts@nnsc.nsf.net. -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.eduy -info.ietf.smtp ietf-smtp@dimacs.rutgers.educ -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edur -info.labmgr labmgr@ukcc.uky.edu@ -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.govc -info.nsfnet.cert nsfnet-cert@merit.eduu -info.nysersnmp nysersnmp@nisc.nyser.netn -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edut -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.netc -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edup -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.milt -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.nets -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.netm -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.netr -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.netu -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fix -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FIo -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.neto -sura.noc.status sura-noc-status@darwin.sura.nett -sura.security sura-security@darwin.sura.neto -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edui -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edus -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.neto -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net. -uunet.tech postman@uunet.uu.net. -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com -$eod d diff --git a/decus/vms94b/bulletin/pmdf.com b/decus/vms94b/bulletin/pmdf.com deleted file mode 100644 index f2add48..0000000 --- a/decus/vms94b/bulletin/pmdf.com +++ /dev/null @@ -1,1042 +0,0 @@ -From: SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:31:55.17 -To: EVERHART -CC: -Subj: PMDF.COM - -Date: Fri, 19 Aug 1994 17:26:23 -0400 (EDT) -From: BULLETIN@PFC.MIT.EDU -To: EVERHART@arisia.gce.com -Message-Id: <940819172623.21438991@PFC.MIT.EDU> -Subject: PMDF.COM - -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf));P - catchar (line, chr (chr_lf));9 - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill');0 - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized;R - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return');R -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *)N - - PROCEDURE dosubmit;* - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGINi - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGINP - WHILE rp_isgood (qu_rtxt (line)) DO BEGINz - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD;P - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' +V - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - ENDm - ELSE warn_master ('Can''t open queue file ' +C - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *)D - - BEGIN (* bulletin_master *)S - init;N - dosubmit;' - mm_end (true); - qu_end;C - END. (* bulletin_master *) -$eod * -$copy/log sys$input BULLETIN_MASTER.PAS_V32 -$deckd -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound);r - -(*******************************************************************)t -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *)I -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *)p -(* *)r -(*******************************************************************) - - CONST; - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - t - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC'l - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC'( - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC'r - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC'l - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char;N - - VARa -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *)h -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - m - outbound : text;a - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC'c - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC'z - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC's - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC'H - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC'a - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - a - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char;u - var ier : boolean); extern;t - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern;* - m - procedure FINISH_MESSAGE_ADD; extern;e - - PROCEDURE warn_master (message : varying [len1] of char);n - n - BEGIN (* warn_master *)i - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - h - (* initialize outbound, mm_ and qu_ *) - e - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true);i - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL',' - rslbuf := protocol_name.body, - rsllen := protocol_name.length);P - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0;i - IF NOT os_open_file (outbound, fnam, exclusive_read) THENl - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL( - 100; - - VARo - line, errorsto : vstring;x - bigline : bigvstring; result : rp_bufstruct; - header : he_header;m - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string);' - - BEGIN (* try_something *)_ - IF rp_isbad (rp_error) THEN BEGIN' - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *)e - end; (* try_something *) - - BEGIN (* return_bad_messages *)d - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit');, - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt');i - try_something (he_read_header (header, qu_rtxt), 'he_read_header');- - errorsto.length := 0;n - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DOm - IF ltext.length <= ALFA_SIZE THEN BEGIN_ - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i];( - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto),d - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - ENDn - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr);T - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *); - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGINI - initstring (line,o - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return');N - END; (* if *)E - try_something (mm_waend, 'mm_waend');) - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf));_ - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf));u - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6);e - os_catdatetime (line); - catchar (line, chr (chr_lf));1 - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf));n - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf));h - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf));. - catchar (line, chr (chr_lf));L - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend');N - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring;* - retval : rp_replyval;* - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - O - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGINL - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN] - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox,] - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length),A - protocol_name, ' ', ier);* - IF ier THEN BEGINP - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN* - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true;; - ENDt - ELSE BEGIN - warn_master ('Error opening folder ' +I - substr (tombox.body, 1, tombox.length));F - return_bad_messages (tombox); - done := true;O - END; - ENDR - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - ENDr - ELSE warn_master ('Can''t open queue file ' +a - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *)l - p - BEGIN (* bulletin_master *)o - init; - dosubmit;l - mm_end (true); - qu_end;r - END. (* bulletin_master *) -$eod c -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file.I -$ !w -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ !t -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. -g - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properlye -$ !a -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue]i -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE")o -$ !_ -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto oute -$ ! -$ ! Create listing of messages queued on this channel. -$ !t -$ if p3 .eqs. "" then p3 = "1-JAN-1970"c -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp"o -$ define/process outbound 'dirlst_file'l -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ !n -$ ! Determine whether or not connection should really be madee -$ !) -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel: -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channelh -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channelN -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ !a -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read.d -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then -u -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then -' - goto list_loop -$ ! Found at least one to try., -$ cnt = cnt + 1i -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TTc -$ !l -$ ! Define other logical names -$ !n -$ define/user script pmdf_root:[table.'channel_name']'name'_script.l -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. -t - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ !d -$ run pmdf_root:[exe]masterc -$ exit_stat = $status_ -$ !h -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then -) - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT1 -$ deassign TT: -$ deassign PMDF_DEVICE -$ !e -$ ! If master does not exit normally, then try a different connection.- -$ !- -$ if exit_stat .ne. 1 then goto list_loopn -$ eof_list:f -$ close pmdf_datal -$ !c -$ ! If we found at least one connection type for this channel, then skipe -$ ! the attempt to use the conventional mechanism.e -$ !e -$ if cnt .gt. 0 then goto out_phonenet -$ !h -$ regular_master:r -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT( -$ !n -$ ! Define logical names -$ !i -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]mastere -$ exit_stat = $statusI -$ !d -$ ! Activate optional cleanup script to reset terminal/modeme -$ !r -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TTo -$ deassign TTa -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1i -$ !( -$ ! Directory channelh -$ !m -$ dir_channel: -$ !s -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ !T -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ !( -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1r -$ !e -$ ! This is a BITNET channel; use BN_MASTERs -$ ! -$ BITNET_channel:m -$ !e -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ !' -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gatewayi -$ goto out1) -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel:w -$ !a -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ !N -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_masterE -$ goto out1i -$ !t -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ !e -$ CTCP_channel: -$ !t -$ run pmdf_root:[exe]ctcp_master -$ goto out1R -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTERq -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ !f -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ !o -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ !j -$ MTCP_channel: -$ !e -$ run pmdf_root:[exe]mtcp_master -$ goto out1o -$ !s -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ !A -$ ETCP_channel:f -$ !t -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ !f -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ !' -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1p -$ !l -$ CN_channel:e -$ !c -$ ! Define other logical names -$ !e -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277q -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_mastera -$ goto out1 -$ !g -$ KER_channel: -$ !n -$ ! kermit protocol is slave only. If we get here there has been a mistake.o -$ ! however we will just exit and no harm done. -$ goto out1" -$ !D -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ !o -$ PX25_channel:c -$ != -$ ! Define other logical names -$ !- -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ !c -$ run pmdf_root:[exe]PX25_master -$ goto out1n -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTERN -$ !a -$ UUCP_channel:a -$ !4 -$ ! Define other logical names -$ !t -$ uucp_to_host = channel_name - "uucp_"n -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmpc -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfilen -$ !. -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll". -$ uupoll 'uucp_to_host'_ -$ goto out1f -$ !t -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ !f -$ XSMTP_channel: -$ !m -$ run pmdf_root:[exe]xsmtp_mastera -$ goto out1e -$ !t -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ !a -$ DSMTP_channel: -$ !q -$ run pmdf_root:[exe]dsmtp_master -$ goto out1t -$ !c -$ ! Handle delivery on the local channel, MAIL_ channels, anda -$ ! the DECnet compatibility channel -$ !t -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel:g -$ open/read queue_file 'dirlst_file' -$ local_loop:q -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list)) -$ goto local_loopn -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1n -$ !t -$ ! This is a SMTP test channel, use TEST_SMTP_MASTERo -$ !i -$ TEST_channel:s -$ !e -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1l -$ ! -$ out1: -$ delete 'dirlst_file';* -$ !t -$ ! Common exit point - clean up things first -$ !f -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_datan -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT. -$ deassign TTt -$ deassign PMDF_DEVICE -$ restore: -$ !_ -$ ! Restore saved stufft -$ !a -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ !s -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel] -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87e -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988e -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminatel -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988l -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988_ -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DATe -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT tot -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters:a -$ !c -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed./ -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTERT -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod : -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You mustl -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, butn -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are ' -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETINe -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I usei -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it ase -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable.r - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT) - -For V3.2:h - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check yourt -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. l - -You then need a channel definition like the following in your configurations -file PMDF.CNF: - - bull_local single loggingo - BULLETIN-DAEMONi - -And a rewrite rule of the form:M - - BULLETIN $U%BULLETIN@BULLETIN-DAEMONr - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following:e - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletinn - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletino - jnet-l: jnet-l@bulletint - policy-l: policy-l@bulletin - future-l: future-l@bulletine - mon-l: mon-l@bulletin - ug-l: ug-l@bulletinc - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vms95a/bulletin/aaareadme b/decus/vms95a/bulletin/aaareadme deleted file mode 100644 index ee7f983..0000000 --- a/decus/vms95a/bulletin/aaareadme +++ /dev/null @@ -1,78 +0,0 @@ -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -If you are running a version of BULLETIN older than 2.11, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. NOTE: -Problems can occur if the old version of BULLETIN is run after the -data files have been modified. Such a situation is possible on a -cluster where each node has installed the executable separately. To -help installation, a new command procedure UPGRADE.COM has been -included. Read the comments in the file for information on how to use -it. - -As of V2.0, BULLETIN is able to read USENET NEWS via TCP/IP using either -CMU, MULTINET, UCX, TWG, or via DECNET. It can also serve as a NEWS -gateway for DECNET nodes without direct access to the NEWS server, i.e. a -DECNET node without Internet access will be able to read NEWS. - -NOTE: The following commands can be sent to BULLETIN@PFC.MIT.EDU: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. (This does not describe the NEWS reader -feature, however.) - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -You will be receiving 22 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) BULLETIN10.FOR - 13) BULLETIN11.FOR - 14) ALLMACS.MAR - 15) BULLCOMS1.HLP - 16) BULLCOMS2.HLP - 17) BULLET1.COM - 18) BULLET2.COM - 19) PMDF.COM - 20) MX.COM - 21) NEWS.COM - 22) ALLMACS_AXP.MAR - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. However, this only applies -to PMDF V3.2 or earlier, as later versions of PMDF have the necessary -interface code for BULLETIN included in it. In that case, or in case -you don't have PMDF, you can delete it. The same applies to MX. Then, -read AAAREADME.TXT for BULLETN installation instructions. If you are -using the news feature, NEWS.COM contains files which pertain to news. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@NERUS.PFC.MIT.EDU diff --git a/decus/vms95a/bulletin/aaareadme.first b/decus/vms95a/bulletin/aaareadme.first deleted file mode 100644 index fb97c8c..0000000 --- a/decus/vms95a/bulletin/aaareadme.first +++ /dev/null @@ -1,201 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vms95a/bulletin/allmacs.mar b/decus/vms95a/bulletin/allmacs.mar deleted file mode 100644 index b7498eb..0000000 --- a/decus/vms95a/bulletin/allmacs.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vms95a/bulletin/allmacs_axp.mar b/decus/vms95a/bulletin/allmacs_axp.mar deleted file mode 100644 index efb71ec..0000000 --- a/decus/vms95a/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vms95a/bulletin/board_digest.com b/decus/vms95a/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vms95a/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vms95a/bulletin/board_special.com b/decus/vms95a/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vms95a/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vms95a/bulletin/bull_news.c b/decus/vms95a/bulletin/bull_news.c deleted file mode 100644 index 4f09cd3..0000000 --- a/decus/vms95a/bulletin/bull_news.c +++ /dev/null @@ -1,705 +0,0 @@ -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} diff --git a/decus/vms95a/bulletin/bull_newsdummy.for b/decus/vms95a/bulletin/bull_newsdummy.for deleted file mode 100644 index a17d3ec..0000000 --- a/decus/vms95a/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,99 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END diff --git a/decus/vms95a/bulletin/bullcom.cld b/decus/vms95a/bulletin/bullcom.cld deleted file mode 100644 index 37505bd..0000000 --- a/decus/vms95a/bulletin/bullcom.cld +++ /dev/null @@ -1,724 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 11/7/94 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER FROM - QUALIFIER SUBJECT - QUALIFIER NEGATED - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW SEARCH_STRING AND REPLY - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vms95a/bulletin/bullcoms1.hlp b/decus/vms95a/bulletin/bullcoms1.hlp deleted file mode 100644 index 608c0ca..0000000 --- a/decus/vms95a/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1184 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with -> at the beginning of each line. This can be -suppressed or the indentation character changed with /[NO]INDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers so -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file can -be specified which contains the text. If the editor is used for changing -the text, the old message text will be extracted. This can be suppressed -by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST - -If a mailer protocol is needs to be added to the network address in -order for it to be sent by VMS MAIL, i.e. protocol%"address", the -appropriate protocol can be specified by either hardcoding it into the -file BULLNEWS.INC before compiling BULLETIN, or by defining the system -logical name BULL_NEWS_MAILER (it is the same protocol used by the NEWS -feature in order to respond to NEWS messages). The default protocol is -IN%. If desired, you can specify the protocol with the address, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. The -identifier can not be any longer than 12 characters. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, the -folder will then be modified to point to that folder. For example if -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be shared -between more than one node. This capability is only present if the BULLCP -process is running on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message.h -It can be a substring of the subject. This is in case you have forgottent -the exact subject that was specified. Case is not critical either.m -You will be notified if the deletion was successful. -See also /NEGATED. -2 /USERNAMEi -Specifies username to be used at remote DECNET nodes when deleting messagesm -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORYt -Lists a summary of the messages. The message number, submitter's name,t -date, and subject of each message is displayed.l - - Format:e - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message.e -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description ofn -folder. -2 /EXPIRATIONN -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the -DIRECTORY command are to be written into the specified file. All. -qualifiers which are valid for the EXTRACT command are valid in -conjunction with /EXTRACT except for /NEW which conflicts with the m -DIRECTORY /NEW qualifier. The listof messages to be printed will be -displayed on the terminal (in nopaging format). -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS.E -2 /FROMF - /FROM=[string]( - -Specifies that only messages whose username contains the specified stringb -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.h -See also /NEGATED. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don'tP -match the specified search command are displayed. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. e -2 /UNMARKEDn -Lists messages that have not been marked (marked messages are indicatedE -by an asterisk). Using /UNMARKED is equivalent to selecting the folderr -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlye -seen messages will be shown and be able to be read. To see alle -messages, use either /ALL, or reselect the folder. e -2 /UNSEENs -Lists messages that have not been seen (seen message are indicated by ae -greater than sign). Using /UNSEEN is equivalent to selecting the folder/ -with /UNSEEN, i.e. only unseen messages will be shown and be able to beE -read. To see all messages, use either /ALL, or reselect the folder. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWSt -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (ind -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current messagee -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED.d -2 /SEARCH - /SEARCH=[string]n - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.n -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.s -2 /START - /START=message_number - -Indicates the first message number you want to display. For example,f -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDE -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings.h - - Format:i - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. o - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE. -2 /FROMc -Specifies to exclude the message based on the message owner. This isi -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULLt -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROMe -and /SUBJECT cannot be specified at the same time. -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):stringI - -In order for /FULL to be the default for a folder, the following lineA -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program.> -1 EXTRACTs -Synonym for FILE command.s -1 FILE -Copies the current message to the named file. If the file exists, the -message is appended to the file, unless the /NEW qualifier is specified. w - - Format:s - FILE [filename] [message_number][-message_number1],[...] - -If the filename is omitted, a file will be created based on the name of -the folder. - -A range of messages to be copied can optionally be specified, i.e. FILE -2-5. The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. i - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. -2 /ALL -Copies all the messages in the current folder. -2 /FFe -Specifies that a form feed is placed between messages in the file. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the r -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file.i -1 FIRSTo -Specifies that the first message in the folder is to be read.c -1 Folderss -All messages are divided into separate folders. New folders can bea -created by any user. As an example, the following creates a folder forl -GAMES related messages: - o -BULLETIN> CREATE GAMES -Enter a one line description of folder.l -GAMESe - -To see the list of available folders, use DIRECTORY/FOLDERS. To selecti -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, thata -user will be alerted of topics of new messages at login time, and will s -then be given the option of reading them. Similar to READNEW is SHOWNEW,e -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option,i -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command.d - -A folder can be restricted to only certain users, if desired. This is e -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE -rather than /PRIVATE is specified, all users can read the messages in thes -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SETe -NODE. A remote folder is one which points to a folder on a remote DECNETm -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)l -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, ande -giving access to that UIC group. Only users in that UIC group will see -the messages in that folder when they log in. -1 FORWARDR -Synonym for MAIL command.m -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INCLUDEs -Specifies to include reading messages based on the message owner or the -subject. If it is determined that a message is to be included, then the -message is read when a user tries to read a message by typing NEXT or -BACK, or by hitting the return key. Otherwise, it is skipped. Specify -the qualifier /FULL to make all EXCLUDEs and INCLUDEs for the specified -folder apply to all other BULLETIN commands, including directory -listings. - - Format:t - INCLUDE [string] - -If a string is specified, then the message is included if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one INCLUDE may be -specified per folder. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all INCLUDEs. -2 /DISABLE -Specifies to permanently disable the INCLUDE.O -2 /FROMR -Specifies to include the message based on the message owner. This isi -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULLc -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. -2 /SUBJECT -Specifies to include the message based on the message subject. /FROMi -and /SUBJECT cannot be specified at the same time. A -2 Storing_INCLUDEs -INCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):stringe - -In order for /FULL to be the default for a folder, the following lineu -must be present: - -folder_name:defaults:killa - -excluding the folder_name causes it to apply to all folders. -1 INDEXo -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for . -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after onei -has read a message. /RESTART must be specified to start from the firste -folder if a scan is in progress. All other qualifiers are ignored while a -a scan is in progress. - - Format: - INDEX - -When a directory is displayed, you can read the first message in the -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for oldern -versions of BULLETIN.i -2 /MARKEDf -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED,b -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicatedn -by an asterisk). Using /UNMARKED is equivalent to selecting the folderu -with /UNMARKED, i.e. only unmarked messages will be shown and be ablet -to be read.a -2 /SEEN_ -Lists messages that have been seen (indicated by a greater than sign). e -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlyr -seen messages will be shown and be able to be read.n -2 /UNSEEN, -Lists messages that have not been seen (seen message are indicated by ao -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to bef -read. -2 /NEW - /[NO]NEWs - -Specifies to list only those folders or groups that have new unread) -messages, and to start the listing with the first unread message.i -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified.d -2 /RESTART -If specified, causes the listing to be reinitialized and start from theo -first folder.h -2 /SET - /[NO]SETL - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format:f - LASTl -2 /EDITi -Specifies that the editor is to be used to read the message. This isd -useful for scanning a long message. -2 /HEADERl - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command, -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEs -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying ane -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" musto -be specified as xxx%"""address""". -2 /EDITd -Specifies that the editor is to be used to edit the message before -mailing it.L -2 /HEADERn - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the i -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of morei -than one word, enclose the text in quotation marks (").f - -If you omit this qualifier, the description of the message will be usedt -as the subject.i -1 MARK -Sets the current or message-id message as marked. Marked messages aree -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of importantI -information. The UNMARK command sets the current or message-id messagef -as unmarked. - - Format: - - MARK [message-number or numbers]t - UNMARK [message-number or numbers]s - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to byt -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGINe -will be used. -1 MODIFY -Modifies the database information for the current folder. Only ther -owner of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted fort -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing liste -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTe -commands, the address of the mailing list should be included in theA -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST r -2 /IDa -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presentlye -assigned to it. Any process which has that identifier assigned to ita -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAME - /NAME=foldernamet - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not havep -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,L -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPSd - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied.d -The default is /NOHEADER.b -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.t -2 /ORIGINALe -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by. -the person moving the message. -1 NEWS -Displays the list of available news groups. - -Format:e - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed.t - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL willa -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /DEFAULT -If specified, will show news groups that have be defined as default -groups using the SET SUBSCRIBE command.n -2 /NEWGROUPe -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /PERMANENT -If specified, will show news groups that have be defined as permanentf -groups using the SET SUBSCRIBE command.l -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B.e -2 /STOREDd -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 New_features -Here is a list of new features which may be of interest to the general e -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - --------------------------------------------------------------------------t -V 2.21 - -Added /CANCEL to PRINT command which cancels previous print commands.b -10/28/94 - -Added /FOLLOWUP to POST command when used with news groups. It specifies -which news group you want replies to your message to be sent to. 10/28/94 - -V 2.20 - -Logical names can be specified in POST/GROUPS=. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/11/94 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93t - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group byN -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92a - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over.p -2 /EDITt -Specifies that the editor is to be used to read the message. This isO -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commande -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEr -Specifies to decode the message using ROT-13 coding. diff --git a/decus/vms95a/bulletin/bullcoms2.hlp b/decus/vms95a/bulletin/bullcoms2.hlp deleted file mode 100644 index 8501750..0000000 --- a/decus/vms95a/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1366 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with -> at the -beginning of each line. This can be suppressed or the indentation -character changed with /[NO]INDENT. -2 /FOLLOWUP - /FOLLOWUP=string - -Specifies that any replies generated by people reading the message -should be sent to the specified newsgroup. This is useful if you want -to post to more than one group, but don't want reply messages posted on -all the groups. To specify more than one newsgroup, surround the list -with quotes, i.e. FOLLOWUP="newsgroup1,newsgroup2". If replies should -only be sent to the message owner and not a newsgroup, the string -"poster" should be specified. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message -to the specified NEWS group(s) in addition to the selected NEWS group. -Logical names are allowed. -2 /HEADER -Allows customized headers line to be added to the message header. When -specified, header lines can be added by inserting them at the top of the -message, with the header lines and the text of the message separated by -a blank line. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. -In order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply -surround the exclusive text starting with the line "START " -and ending with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The file created by the PRINT command is not -released to the print queue until you exit, unless you add the qualifier -/NOW or change one of the print job's qualifiers. Multiple messages are -concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /CANCEL -Cancels any messages waiting to be printed. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL level -to find out the name of the mounted form and the default form for a -particular queue. If you specify a form whose stock is different from -the stock of the form mounted on the queue, your job is placed in a -pending state until the stock of the mounted form of the queue is set -equal to the stock of the form associated with the job. (In order to -have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the file -or files have been printed. If /NONOTIFY is specified, there is no -notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 QUIT -Exits the BULLETIN program. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. If you -specify a number greater than the number of messages in the folder, the -last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -/HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /INDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read them. -(Note: Reading the last message does the same thing, but RESET does it -without having to read it.) -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. - -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected and /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text strings. - - Format: - - SEARCH search-string[,...] - -The search starts from the first message in the current folder. You can -specify the message to start at using the qualifier /START. If you use -this qualifier without a parameter, it starts with the current message. -The search includes both the text of the message, and the description -header. If a "search-string" is not specified, a search is made using -the previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for a -match. If, during a search, no more matches or messages are found, the -next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /MATCH - /MATCH[=option] - -Interprets and matches multiple search strings in one of the following -ways: - - AND A match occurs only if all of the strings are found. - - OR A match occurs if any of the strings are found. - - XOR A match occurs if only one of the strings is found. - -If you specify none of these options, the default is /MATCH=OR. If you -specify the /NEGATED qualifier, you will get the negated operation. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the last -message. -2 /START - /START=message_number - -Specifies the message number to start the search at. If you omit the -message number, it starts with the current message. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUS -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name. - - Format: - - SET [NO]ANONYMOUS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read.r - - Format:o - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If -ADD_ONLY is set and a mailing address is present (see /DESCRIPTION), -when a message is added to the folder, it will also be mailed to the -address (in addition to being stored in the folder). This also applies -to a message which is added via the BBOARD feature . If ADD_ONLY is set -and a user uses the POST command, the ADD command will be used instead. -One use for this is to mail messages in a folder to users who do not -have access to BULLETIN. e - - Format:i - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2.t - - Format:d - - SET BBOARD [username]E - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages.E - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30" -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The form -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY.b -The time will always be 00:00, even if the time is specified on the line.] -3 /EXPIRATIOND - /EXPIRATION=dayss - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be:R - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account. - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV.n -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION.s -2 BRIEFE -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa).u - - Format:e - - SET [NO]BRIEFI -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newt -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERn - /FOLDER=foldernameh - -Specifies the folder for which the option is to modified. If noty -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENTh - -Specifies that BRIEF is a permanent flag and cannot be changed by ther -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier. -2 COMPRESS -Specifies that messages added to the folder will be in compressed format.y -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires a -very little cpu overhead. - - Format:e - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. p -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed everyN -time when logging in, until the new messages are read. Normally, thei -BRIEF setting causes notification only at the first time that new messages -are detected.o - - Format: - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - - Format: - - SET DEFAULT_EXPIRE daysq - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages.t - - Format:d - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR).r - - Format:n - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it.f -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format:n - - SET [NO]EXPIRE_LIMIT [days]l - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) l -2 EXCLUDEO -Specifies to ignore any EXCLUDEs or INCLUDEs that are present. - - Format:e - - SET [NO]EXCLUDEN - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or INCLUDEs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 FILE_DIRECTORY -Select the directory where messages are written to when using the -EXTRACT or file COMMAND. By default, the message is written into the -current directory. a - - Format:u - - SET FILE_DIRECTORY [directory] - -If directory is omitted, the setting is removed. Note: This information -is stored in the customization file (SYS$LOGIN:BULL.CUSTOM). -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information.i - - Format:t - - SET FOLDER [node-name::][folder-name]c -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected.h -2 GENERICi -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -3 /DAYS - /DAYS=number_of_dayso - -Specifies the number days that new messages will be displayed for upon -logging in. -2 KEYPAD . -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format:s - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to byf -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI.e -2 LIBRARYt -Specifies a library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command to see if there are other libraries. -2 LOGINs -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command.R - - Format:e - - SET [NO]LOGIN username -2 NAME -Copies all stored settings from one user to another. Used when a user's -account name is changed. - - Format:e - - SET NAME old-username new-username -2 NEWS -Changes attributes of the specified news group or class of news groups.o -This command requires privileges.f - - Format: - - SET NEWS [news-group] - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALLy - /NOALLk - -If specified with /CLASS or /DEFAULT, all groups that are presentlys -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of anye -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the defaulto -attributes (using /DEFAULT) with /NOALL, the attributes for misc.testd -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. b -3 /CLASS - /CLASS=classnames - -Specifies to modify attributes for a class of news groups rather than ao -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes of -existing groups which are in the class are modified, and any groupsr -created in the future will automatically have those attributes.E -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETEu -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLEt -Specifies that the news group is enabled and can be accessed. This iss -the default. -3 /EXPIRATION - /EXPIRATION=dayso - -Specifies the default expiration time for messages if none is specified. -The default is 7.n -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified isn --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default.o -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is posted -every month with an expiration date of one month in the future.l -3 /PRIVATE - /PRIVATEt - /NOPRIVATEL - -Specifies that the news group or class can have it's access modified byn -the SET ACCESS command. To accomplish this, a file is created ins -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access y -to news groups in that class is to set /NOPRIVATE, as then time won't be -wasted checking a file for ACLs. -3 /STORED - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessedf -via the network from the server node. This results in faster access,t -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED.k -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node.i - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder.r - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node,o -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated. -3 /FOLDER - /FOLDER=foldernames - -Specifies the folder for which the node information is to modified.o -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format:b - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are loggedT -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared.s -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users fort -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specifiedw -folder. This is a privileged qualifier. It will only affect brand newo -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernames - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY.a -3 /PERMANENT - /[NO]PERMANENTl - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier.e -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN.a - - Format:s - - SET [NO]PAGE -2 POST_ONLYS -Specifies that the selected folder has the POST_ONLY attribute. Thisp -causes the ADD command to mail the message to the mailing address if its -is present (see /DESCRIPTION), rather than add to the folder. l - - Format: - - SET [NO]POST_ONLYl -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format:I - - SET PRIVILEGES parameterse - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers. -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.e -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEWl -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command.e - - Format:r - - SET [NO]READNEWj - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersn -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newa -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERy - /FOLDER=foldernamew - -Specifies the folder for which the option is to modified. If nott -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENTS - -Specifies that READNEW is a permanent flag and cannot be changed by thep -individual. This is a privileged qualifier. -2 SHOWNEW, -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN.D - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format:L - - SET [NO]SHOWNEWi -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new userse -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all -users. i -3 /FOLDERP - /FOLDER=foldernamed - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. e -3 /PERMANENT - /[NO]PERMANENTs - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged -qualifier. e -2 STRIPf -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If STRIP -is set, the header of the mail message will be stripped off before it is -stored as a BULLETIN message. - - Format:a - - SET [NO]STRIPf - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SUBSCRIBEs -Can be used to force users to be subscribed to the selected news group. -This is a privileged command. - - Format: - - SET SUBSCRIBEa - -Note: If you execute the commands SET SHOWNEW, READNEW, BRIEF, or -NOTIFY, and add /DEFAULT or /PERMAMENT, it is equivalent to doing a SET -SUBSCRIBE command with the addition that the specified feature will be -the default and/or permanent setting. -3 /ALL -Specifies that all present and future users will be subscribed to the -news group. -3 /DEFAULT - /[NO]DEFAULT - -Specifies that new users will automatically be subscribed to the news -group. v -3 /PERMANENT - /[NO]PERMANENTn - -Specifies that new users will automatically be subscribed to the news -group and that users cannot unsubscribe the news group. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format:G - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.w -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGSe -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. I -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected -via the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name]o -3 /FULLn -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 KEYPAD -Displays the keypad command definitions. - - Format:e - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either SET KEYPAD, or if /KEYPAD is -specified on the command line, the keypad keys will be defined as -commands. The default settings for the keypad are shown via SHOW KEYPAD -or HELP KEYPAD. Settings can be changed by using an initialization file -with DEFINE/KEY commands. BULLETIN looks first for the file pointed to -by the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT).c -3 /STATE - /STATE=(state,state,...), - -Specifies the name of a state for which the specified key definitions -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when a -key name has been specified. F -2 LIBRARYp -Shows the library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the /ALL -qualifier to see if there are other libraries. t -3 /ALL -Specifies to show all available libraries. -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format:F - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this.o -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command.a -3 /LOGIN - /[NO]LOGINg - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDER - /FOLDER=[foldername]R - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups.f -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSIONO -Shows the version of BULLETIN and the date that the executable was -linked.o -1 SPAWNf -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format:p - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBEc -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of them -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. n -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format:T - UNDELETE [message-number]E -1 UNSUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See theu -SUBSCRIBE command for further info. -1 Usenet_newse -BULLETIN can also read USENET NEWS if your system has network access tos -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of r -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group ine -order to keep track of which messages you have read in that group. Most -of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read news groups with new messages, use INDEX/SUBSCRIBE. O diff --git a/decus/vms95a/bulletin/bulldir.inc b/decus/vms95a/bulletin/bulldir.inc deleted file mode 100644 index f66cc78..0000000 --- a/decus/vms95a/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vms95a/bulletin/bulletin.cld b/decus/vms95a/bulletin/bulletin.cld deleted file mode 100644 index deb3c36..0000000 --- a/decus/vms95a/bulletin/bulletin.cld +++ /dev/null @@ -1,44 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vms95a/bulletin/bulletin.for b/decus/vms95a/bulletin/bulletin.for deleted file mode 100644 index a719ac2..0000000 --- a/decus/vms95a/bulletin/bulletin.for +++ /dev/null @@ -1,2031 +0,0 @@ -C -C BULLETIN.FOR, Version 2/14/95 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - CALL INIT_BULLETIN(.TRUE.) - -C -C The MAIN loop for processing bulletin commands. -C - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - CALL DO_COMMAND(INCMD) - -100 CONTINUE - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) - - END - - - - - SUBROUTINE DO_COMMAND(INCMD) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - CHARACTER*(*) INCMD - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (HLEN.EQ.0) THEN - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - END IF - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (NEWS_FEED().OR.REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - WRITE (6,'('' ERROR: /FOLDER not valid when posting'', - & '' a message to a news group.'')') - ELSE - INCMD = 'POST '//INCMD(4:) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - END IF - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,'('' ERROR: There are no more preceding messages.'')') - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'INCL') THEN ! INCLUDE? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'FI') THEN ! SET FILE_DIRECTORY? - CALL SET_CUSTOM('file_directory') - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SH') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SU') THEN ! SET SUBSCRIBE? - IF (REMOTE_SET.GE.3) THEN - D1 = 0 - D2 = 0 - D3 = 0 - CALL SET_FOLDER_DEFAULT(D1,D2,D3) - ELSE - WRITE (6,'('' ERROR: Command invalid for folder.'')') - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LIB') THEN ! SET LIBRARY? - CALL SET_LIBRARY - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS? - CALL SET_NEWS - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE? - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE? - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:4).EQ.'NAME') THEN ! SET NAME? - CALL SET_NEWNAME - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SHOW LIBRARY - CALL SHOW_LIBRARY - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATION - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1) - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN? - CALL TAG(.FALSE.,2) - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - - RETURN - END - - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - CHARACTER INEXDATE*12,INEXTIME*12,INDENT*4 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT') - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - LENI = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',INDENT,LENI) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LENI.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') INDENT(:LENI)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IFl - END DOi - CLOSE (UNIT=4)n - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER)L - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privilegest - END IFu - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set anda - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present?T - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910L - END IFP - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privilegesO - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSEb - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?, - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort0 - ELSE IF (CLI$PRESENT('CLUSTER')) THENC - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?M - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083)H - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00' - END IF - END IF_ - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present?C - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE)S - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name ifR - WRITE (6,1090) ! remote folder, as no codeR - GO TO 910 ! present to send the name. - END IFN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSEC - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)S - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bitI - INEXDATE = '5-NOV-2000' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60)i - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60)p - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO_ - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IFt - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940h - SELECT_NODES = .TRUE.N - END IF - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown o - IF (.NOT.IER) GO TO 910L - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23)M - END IFR - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSEU - WRITE(6,1050) ! Request header for bulletinU - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: "! - -Cl -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal./ -CD - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specifiedO - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',B - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')A - LEN_P = 1 - ELSE - CLOSE (UNIT=3)S - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')A - IF (CLI$PRESENT('EXTRACT')) THEND - CONTEXT = 0' - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THENE - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')P - END IF - END IFH - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'H - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35' - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record countO - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80)s - BLENGTH = BLENGTH + ILEN - 1 + 2O - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line withQ - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'' - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count countero - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTHN - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredN - ICOUNT = ICOUNT + ILEN ! Update counterL - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IFM - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error oute - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE.) - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting.'', - & '' A truncated message will be broadcast.'')') - CALL GET_INPUT_PROMPT(INPUT,ILEN,g - & 'Type C to continue, A to only ADD message, or Q to Quit: ')( - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THENM - BRDCST = .TRUE. - END IF - END IF( - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THENd - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST)l - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST'l - IF (CLI$PRESENT('PERMANENT'))s - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1U - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE)X - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1)R - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH)( - IF (IER.EQ.0) THENE - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN)N - END IF' - END DOL - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSEA - WRITE (6,'('' Error while sending message to node '',A)')D - & NODES(POINT_NODE)4 - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF( - REWIND (UNIT=3) - END DO - END IFD - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IFS - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -CL -C Add bulletin to bulletin file and directory entry for to directory file.E -CN - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1E - FOLDER1 = NODES(I)E - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entryE - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! UsernameD - END IFN - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK& - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THEN - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '//R - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK) - END IF - IF (LENDES.GT.LEN(DESCRIP)) THEN( - CALL STORE_BULL(LENDES+6,L - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK)H - END IF - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletin' - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletinT - LENGTH = OCOUNT - (NBLOCK+1) + 1 - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IFI - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLFIL ! Finished adding bulletinT - - IF (FOLDER_NUMBER.GE.0) THEN. - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C( -C If user is adding message, an no new messages, update last read time forB -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THENe - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2). - END IF - END IFE - - CALL CLOSE_BULLDIR ! Totally finished with add -CR -C Broadcast the bulletin if requested.' -CY - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN( - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'),D - & CLI$PRESENT('CLUSTER')) - END IFQ -CU -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP,E -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same clusterD -C as that of the BULLCP node. -CE - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET)L - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER'))D - END IFL - ELSE IF (.NOT.IER) THEN' - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR. - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THENL - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THENO - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT,5 - & FOLDER(:TRIM(FOLDER))//' folder message: '//R - & INDESCRIP(:LENDES),STATUS) - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',L - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')_ - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',S - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IF( - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DOQ - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THENE - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IFC - - IF (CLI$PRESENT('EXTRACT')) THEN' - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURNN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100C - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GOTO 100S - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFILA - CALL CLOSE_BULLDIR - CLOSE (UNIT=3)E - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3). - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')a -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A)E -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')( -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for systemC - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast( - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.')L -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER)R - - IMPLICIT INTEGER (A-Z)P - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURNE - - BTIM(1) = -BTIM(1) ! Convert to negative delta timeE - BTIM(2) = -BTIM(2)-1P - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURNH - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'H - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2' - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8N - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*41 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURNE - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE.E - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG_ - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURNL - END IFA - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DOE - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"')) - - IF (IER.EQ.0) THENC - IER = 0R - I = 1, - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128E - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDERT - ELSEL - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN,B - & 'Want to try again? (Y/N with Y as default): ')I - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')')T - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN. - END - - - - SUBROUTINE REPLYA - - IMPLICIT INTEGER (A - Z)C - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - COMMON /INDESCRIP/ INDESCRIPI - CHARACTER*(INPUT_LENGTH) INDESCRIPO - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been readH - WRITE(6,'('' ERROR: You have not read any message.'')')E - RETURN ! And return' - END IFN - - CALL OPEN_BULLDIR_SHAREDL - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinH - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF' - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)A - END IF. - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:)3 - ELSET - INDESCRIP = DESCRIPB - END IFE - - CALL CLOSE_BULLFIL! - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'RE:'//INDESCRIP(4:) - ELSE' - INDESCRIP = 'RE: '//INDESCRIPB - END IFC - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP))B - - CALL ADD( - - RETURNX - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z)4 - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUTE - - CALL INIT_ITMLSTF - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST)A - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIVQ -CO -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS:' -C PROCPRIV - Returned privileges -CH - - IMPLICIT INTEGER (A-Z)L - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistI - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info= - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURNL - END - - - - - LOGICAL FUNCTION SETPRV_PRIVS - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/C - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER)Q - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1)B - NEEDPRIV(2) = USERPRIV(2)' - END IFE - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR.N - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THENS - SETPRV_PRIV = .TRUE. - ELSEN - SETPRV_PRIV = .FALSE.A - END IFA - - RETURNE - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - A - SUBROUTINE GETUSER(USERNAME)I -CD -C SUBROUTINE GETUSERM -C -C FUNCTION: -C To get username of present process.U -C OUTPUTS:D -C USERNAME - Username owner of present process.S -CO - - IMPLICIT INTEGER (A-Z)N - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 charactersE - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistP - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoN - - RETURNR - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG)L - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC' - - DATA READ_UAI/.FALSE./C - - COMMON /BULL_CUSTOM/ BULL_CUSTOMR - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE.I - RETURN - END IFU - - TYPE = 1N - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))A - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE.T - END IFT - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURNT - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z)N - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')')I - RETURN - END IFI - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODEE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THENC - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN)U - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN()T - END IF' - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPADR - - CALL ENABLE_PRIVS - - RETURNE - ENDU - - - SUBROUTINE ATTACHP - - IMPLICIT INTEGER (A - Z)L - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHANO - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS - - IF (CLI$PRESENT('PROCESS')) THENE - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item listG - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,)F - ELSEG - CALL INIT_ITMLST ! Initialize item listC - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)D - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER)P - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPADL - - RETURNE - ENDE - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on systemD -C and user quotas. The following limit is 12 lines of ( 80 characters +_ -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -CO - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7)' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2O - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTHS - - IF (RING_BELL) THEN ! Include BELL in message?M - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROMU - BLENGTH = 37 ! Start adding next line here - ELSE( - BROAD(:34) = ! Say who the bulletin is fromT - & CR//LF//LF//'NEW BULLETIN FROM: '//FROMD - BLENGTH = 35 ! Start adding next line here - END IFG - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1E - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUTE - IF (IER.NE.0) RETURNc - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN)r - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be/ - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long?N - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURNT - - ENTRY BROADCAST(ALL,CLUSTER)i - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL?G - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN0 - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,,p - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,)T - END IF - END IFp - - CALL SYS$SETRWM(%VAL(0))( - - RETURNL - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -CR -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line.E -CT - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC'N - - EXTERNAL CLI$_ABSENTI - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODEI - CHARACTER*32 NODES(10)W - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodesT - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP)a - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0)) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THENR - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF( - NLEN = TRIM(NODES(NODE_NUM))R - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IFE - FOLDER_NUMBER = -1A - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THENI - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM)' - RETURNE - ELSE IF (READ_ONLY) THENS - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM)F - IER = 0 - RETURNh - END IFD - END DO - END DO - - IER = 1 - - RETURN. - END - ( - - - - SUBROUTINE INIT_BULLETIN(NOX) - - IMPLICIT INTEGER (A - Z)R - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'p - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READITR - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - DATA PAGE_LENGTH/24/,PAGE_WIDTH/80/ - - COMMON /CTRLY/ CTRLYL - - COMMON /PROMPT/ COMMAND_PROMPTL - CHARACTER*40 COMMAND_PROMPT - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITA - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'Xa - PARAMETER LIB$M_CLI_CTRLY = '2000000'Xf - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./! - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHO - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)$ - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATEM - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOMC - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /COUNT/_ - & DIR_COUNT, ! # directory entry to continue bulletin read from) - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT' - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/= - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"'a - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP)_ - IF (LENP.GT.0) THENT - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IFe - - READIT = 01 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THENn - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')')S - END IF - CALL EXIT - END IFt - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT)! - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -CD -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done!m -Ca - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges( - IF (NOX) CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ESTABLISH(ERROR_TRAP)E - IF (CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P)) THEN' - FOLDER_DIRECTORY = BULL_PARAMETER(:LEN_P)I - CALL CHECK_DIR(BULL_PARAMETER,.FALSE.) - FOLDER_DIRECTORY = BULL_PARAMETER& - CALL ADD_DIRECTORIES - END IF - CALL LIB$REVERT - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit( - - CALL GETUSER(USERNAME) ! Get the process's usernameT - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privilegesT - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN)E - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1I - ELSE IF (COMMAND_PROMPT(I:I).EQ.'/') THEN0 - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1o - ELSE - I = I + 1 - END IF - END DOD - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0)' - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')). - IF (ILEN.GT.0) THEN, - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:)N - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1P - IF (COMMAND_PROMPT(I:I).LT.'A'.OR.N - & COMMAND_PROMPT(I:I).GT.'Z') THEN( - COMMAND_PROMPT = COMMAND_PROMPT(:I-1)R - END IFN - END DO= - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS& - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch testO - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder #D - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select foldere - CALL CLEANUP_BULLFILE ! Cleanup empty blocksE - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch= - CALL BBOARD ! look for BBOARD mailE - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL(.FALSE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS1') THEN1 - CALL NEWS2BULL(.TRUE.)R - END IF - END IF - - CALL GETSTS(STS) ! Get process status word) - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - IF (NOX) CALL CRELNM('SYS$INPUT','TT') ! Input from terminal - END IFI - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE.L - ERROR_UNIT = 6 - - IF (NOX) CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file.O - CALL LIB$REVERTR - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS)E - ELSER - CALL LIB$REVERTC - END IFS - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selectedS - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit_ - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -Cf -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -Cn - - CALL OPEN_USERINFO - - CALL OPEN_OLD_TAGF - - IF (.NOT.NOX) THEN - CALL NEW_MESSAGE_NOTIFICATION - RETURNT - END IF - -C -C Get page size for the terminal. -CF - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P)h - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTHC - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE.) - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THENs - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')')t - CALL EXITt - END IFt - END IFm - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERSh - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUME - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN& - CALL SHOW_SYSTEMR - END IF - END DO - END IF - END IF - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins.( -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit.' -CE - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATIONT - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IFS - - RETURN - END diff --git a/decus/vms95a/bulletin/bulletin.hlp b/decus/vms95a/bulletin/bulletin.hlp deleted file mode 100644 index cf279b3..0000000 --- a/decus/vms95a/bulletin/bulletin.hlp +++ /dev/null @@ -1,151 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vms95a/bulletin/bulletin.lnk b/decus/vms95a/bulletin/bulletin.lnk deleted file mode 100644 index f19194f..0000000 --- a/decus/vms95a/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.21" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.21" diff --git a/decus/vms95a/bulletin/bulletin0.for b/decus/vms95a/bulletin/bulletin0.for deleted file mode 100644 index b7bc5c2..0000000 --- a/decus/vms95a/bulletin/bulletin0.for +++ /dev/null @@ -1,2082 +0,0 @@ -C -C BULLETIN0.FOR, Version 12/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - CALL REMOTE_DELETE(SBULL,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN ! If not owner of message - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.EQ.FROM - END IF - IF (ASK) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.TEST_NEWS_OWNER()) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2),EX(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX,EX) - IER = SYS$ASCTIM(,INPUT,EX,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - EXTRACTING = CLI$PRESENT('EXTRACT') - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - ELSE - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - IF (INCMD(:3).EQ.'IND') THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - REPLY_FIRST = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - END IF - END IF - OUTPUT = EXTRACTING.OR.PRINTING - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - START = .FALSE. - SINCE = .FALSE. - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - SINCE = .TRUE. - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - GO TO 9999 - END IF - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - NEGATED = CLI$PRESENT('NEGATED') - IF (CLI$PRESENT('SEARCH')) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('FROM')) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3 - NEGATED = .TRUE. - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) NUM = NUM + 1 - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - END IF - I = I - 1 - END DO - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - END IF - IF (NUM.GT.0) I = I - 1 - END DO - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) NUM = NUM + 1 - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) J = J + 1 - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULLe - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I1 = SBULLn - I = SBULL - DO WHILE (I.LE.EBULL) - CALL READDIR(I1,IER) ! Into the queue - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1 - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY)D - I = I + 1L - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1 - END IF - I1 = I1 + 1 - END DOE - ELSE IF (READ_TAG) THENI - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - EBULL = EBULL - SBULL + DIR_COUNTN - SBULL = DIR_COUNT_ - I = SBULLH - END IF - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28)+ - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)N - I = I + 1 - END DOb - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSEE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0' - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY)L - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,R - & TAG_TYPE) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVED - IER1 = 1( - ELSE - EBULL = EBULL_SAVEE - END IF - END IFN - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN( - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTER - GO TO 99991 - END IF - END IF - ELSEB - NBULL = 0 - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THENE - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THENI - DIR_TYPE = 'seen' - END IF - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME))L - ELSE - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IFA - -C6 -C Directory entries are now in queue. Output queue entries to screen.C -CO - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULLA - ELSEA - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IFU - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ')N - OUTLINE(I+1:) = OUTLINE(I+2:)A - END DOX - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ') - OUTLINE(I+1:) = OUTLINE(I+2:)T - END DO - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ')Y - OUTLINE(I:) = OUTLINE(I+1:) - END DOL - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINE - BULL_PARAMETER = ' '1 - IF (READ_TAG) THEN_ - IF (BTEST(READ_TAG,1)) THEN - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THENN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IF) - IF (PRINTING) THEN - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - END IFS - WRITE (6,'(1X,A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN= - WRITE(6,1005)S - ELSE - WRITE(6,1000) - END IF - - TAG = (BULL_TAG.AND.REMOTE_SET.EQ.0).OR. - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header) - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)E - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE)N - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D( - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)R - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IFE - END DO - END IFR - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THEN - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THENi - START_SEARCH = BULL_POINTf - END IFb - IF (ANY_SEARCH.OR.OUTPUT) THENT - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED_FILES = .FALSE. - END IF - DO WHILE (I.LE.EBULL) - IF (.NOT.ANY_SEARCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)e - ELSE - IF (CLOSED_FILES) THEN - CLOSED_FILES = .FALSE.R - CALL OPEN_BULLDIR_SHAREDq - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHAREDN - END IFD - CALL GET_SEARCH(FOUND,SEARCH_STRING,1,SLEN,0,c - & START_SEARCH,.FALSE.,SUBJECT,REPLY_FIRST,.FALSE.,i - & .TRUE.,FROM_SEARCH,NEGATED,MATCH_MODE) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE)$ - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE.t - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IFL - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THENE - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THENR - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE.C - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - TAG_TYPE = DUMMY - END IF - ELSET - I = EBULL + 1 - END IFT - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.LE.EBULL) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THENM - OUTLINE = '>' - ELSEK - OUTLINE = ' ') - END IF - IF (BTEST(SYSTEM,29)) THENS - OUTLINE(2:) = '*'N - ELSE - OUTLINE(2:) = ' 'T - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3)_ - IF ((EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0)0 - & .AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin?D - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin?( - EXPIRES = 'Permanent' - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown'g - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11) - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9)2 - ELSEo - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11): - END IF - WRITE(6,'(1X,A)') OUTLINE - IF (OUTPUT) THENI - FOUND_MSG = .TRUE. - CALL SYS$SETAST(%VAL(0)) - NEXT = .FALSE.o - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES) - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES) - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0e - ELSE - MSG_NUM = -MSG_NUMI - END IF - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1))L - END IFR - END IF - I = I + 1O - IF (ANY_SEARCH) IER = SYS$CANTIM(,)_ - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counterL - - IF (ANY_SEARCH.OR.OUTPUT) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THENC - DIR_COUNT = FOUND + 1 - ELSER - DIR_COUNT = NBULL + 1R - END IF - END IF - END IF* - - IF (DIR_COUNT.GT.NBULL.OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THENI - ! Outputted all entries? - DIR_COUNT = -1 ! Yes. Set counter to -1. - IF (PRINTING) THEN ' - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THEN - INCMD = 'PRINT/NOW'I - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IFT - ELSE IF (EXTRACTING.AND.FOUND_MSG) THEN - CALL FILE(0,CLOSED_FILES) - END IF - ELSEL - WRITE(6,1010) ! Else say there are moreL - END IF - -9999 POSTTIME = .FALSE.E - NEXT = .FALSE.E - RETURN - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/)P -1010 FORMAT(1X,/,' Press RETURN for more...',/)N - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9)U - - END - - - SUBROUTINE CLOSE_FILESA - - IMPLICIT INTEGER (A-Z)L - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILESU - - INQUIRE(UNIT=1,OPENED=IER)E - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURNo - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8E - MSG_KEY(I:I) = INPUT(9-I:9-I)E - END DO - - RETURNt - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT) -CL -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORYE - CHARACTER*64 FILE_DIRECTORY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'F - - EXTERNAL CLI$_ABSENTO - - CHARACTER*128 FILENAME - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THENs - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')')n - RETURN - END IF - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THEN - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IFT - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)f - IF (EBULL.GT.F_NBULL) EBULL = F_NBULLu - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1I - EBULL = F_NBULLL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSES - SBULL = BULL_POINT - EBULL = SBULL1 - IER = 0 - END IFT - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THENA - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFILI - CALL CLOSE_BULLDIRE - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P)B - RETURN - END IF1 - ELSEH - SBULL = FILE_NUM - EBULL = SBULLT - END IFD - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F)L - - IF (.NOT.IER) THEN - FILENAME = FOLDER - DO I=1,LEN(FILENAME)l - IF (FILENAME(I:I).EQ.'.') FILENAME(I:I) = '_' - END DOE - FILENAME = FILENAME(:TRIM(FILENAME))//'.TXT'. - LEN_F = TRIM(FILENAME)S - END IF - - IF (TRIM(FILE_DIRECTORY).GT.0.AND.INDEX(FILENAME,':').EQ.0 - & .AND.INDEX(FILENAME,'[').EQ.0) THEN - FILENAME = FILE_DIRECTORY(:TRIM(FILE_DIRECTORY))//FILENAME - LEN_F = TRIM(FILENAME)I - END IF - - CALL STR$UPCASE(FILENAME,FILENAME) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900,S - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THENO - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THENC - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges6 - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE.e - FIRST = .TRUE. - END IFA - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletinN - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENTD - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THENu - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1t - IF (FBULL1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - OPENED = .FALSE.D - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURNT - ELSE IF (REMOTE_SET) THENE - CALL REMOTE_READ_MESSAGE(FBULL,IER1)T - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSEE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100S - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)( - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENF - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THENn - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into filel - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DO - -100 IF (FILE_NUM.GT.0) THEN - FILE_NUM = -FILE_NUM - RETURN - END IFc - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created.0 - WRITE(6,1040)t - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F)r - ELSEm - WRITE(6,1045)h - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,)I - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F)a - END IF - - GO TO 10F - -900 WRITE(6,1000) FILENAME(:LEN_F) - CALL ENABLE_PRIVS ! Reset BYPASS privileges/ - RETURNA - -1000 FORMAT(' ERROR: Error in opening file ',A,'.')) -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I)D -1040 FORMAT(' Message ',A,' written to ',A)N -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A)I -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN)T - - CALL LIB$MOVC3(8,IN,OUT)L - - RETURN( - END - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN( -CB -C FUNCTION: Alerts user of new messages upon logging in.N -CL - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC') - - INCLUDE 'BULLFOLDER.INC'( - - COMMON /READIT/ READITT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPTA - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHF - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/d - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header= - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/W - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)I - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2)U - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - FOLDER_NAME = FOLDERF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -CE -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entryS - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entryE - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THENM - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THENR - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSE= - RETURN ! Don't notify - END IF - END IF( - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM)L - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRYN - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR.U - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DOU - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead usersM - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONGA - SET_FLAG(I) = SET_FLAG_DEF(I). - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THENI - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSE - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing.I - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL setI - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED. - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM) - END DOB - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF( - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM)E - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER1 - CALL EXIT ! If no header, no messages - END IF. - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry1 -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility.= -CR - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM)= - ! then use read date to compare with latest bulletin dateL - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN) - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM)- - END IF - END IF - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THENL - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER)1 - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1_ - IF (READIT.EQ.1) THENN - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSERI - RETURN - END IFD - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1)U - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDERT - - ENTRY LOGIN_FOLDERI - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IFG - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login timeL - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THENB - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0F - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0A - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,L - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - ELSED - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM)U - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM)A - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time0 - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IFX - END IFN - END IF - END IFU - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages. - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THENE - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - END IFC - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgsF - END IF( - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN3 - ! Can folder have SYSTEM messages and /SYSTEM specified?E - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login timee - ! for system messages. - END IF - - IF (LOGIN_SWITCH) THENF - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSER - END IFH - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN1 - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,V - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))E - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1))N - END IF - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1),T - & LOGIN_BTIM_NEW)D - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)G - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THENN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IFN - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSEL - NBULL = F_NBULLI - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT))( - GEN_DIR = GEN_DIR1M - SYS_DIR = SYS_DIR1I - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR.. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THENU - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IFE - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY)T - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIRV - CALL DISCONNECT_REMOTE - GO TO 9999L - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF, - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1E - ELSE - ICOUNT = ICOUNT1E - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100L - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1G - ELSE - CALL READDIR(ICOUNT,IER)E - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user?T - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IFD - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1D - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)e - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM). - ELSE IF (.NOT.SYSTEM_SWITCH) THENL - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM)N - END IF - IF (DIFF.LT.0) THEN: - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THENO - BULL_POINT = ICOUNT - 1Y - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100F - END IF1 - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IFU - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THENR - NSYS = NSYS + 1, - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)), - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for displayT - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN. - BULL_POINT = ICOUNT - 13 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100E - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF_ - END IF - END DO -100 CALL CLOSE_BULLDIR -CA -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -CF - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THENO - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiese - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2_ - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep...U - PAGE = PAGE + 1E - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT). - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0L - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)E - IF (REMOTE_SET) THENE - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))D - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER)I - END IF - IF (IER.GT.0) THENT - CALL CLOSE_BULLFIL - GO TO 9999 - END IFM - END IFG - INPUT = ' 'Y - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)_ - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF. - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO= - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999( - END IFN - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATEE - END DOI - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2T - END IF_ - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages' - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT)E - I = I + 1 - END IFE - IF (SYS_BUL.NE.0) THENe - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next pagen - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....') - WRITE (6,'(1X)'), - CALL LIB$ERASE_PAGE(1,1) ! Clear the screeno - PAGE = 1 - INREAD = '+', - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' 'O - END IF - IF (LEFT) THENI - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN)A - LEFT = .FALSE. - ILEN = 0N - INREAD = '+'L - ELSE IF (ILEN.LE.WIDTH) THEN - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN)L - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSEU - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ') - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH)$ - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0) - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DOR - IF (INPUT(ILEN:ILEN).EQ.' ') THENL - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEND - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE. - ELSE - WIDTH = PAGE_WIDTH - END IF - END IFP - END IFN - END DO - IF (NGEN.EQ.0) THEN - WRITE (6,'(A)') ! Write delimiting blank lineT - END IF - PAGE = PAGE + 1P - END IFN - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1T - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2r - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page# - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....')< - WRITE (6,'(1X)')9 - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_GS - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1F - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen.I - END IF - WRITE (6,'(''+'',A,$)') CTRL_GG - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020)R - WRITE(6,1025) - PAGE = PAGE + 2_ - I = 0) - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screenS - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....')R - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1N - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')')I - ELSE= - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IFC - ! Bulletin number is stored in SYSTEM - ELSEG - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEMB - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0)S - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated.I - END IFT -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.L - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030). - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN( - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.'P - PAGE = PAGE + 1I - ELSES - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1P - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)//E - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN) - & //' '//FOLDER_NAME(:FLEN)//. - & ' to read these messages.' - END IF - PAGE = PAGE + 1) - END IF - -9999 IF (LOGIN_SWITCH) THEN: - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW)N - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IFI - RETURNL - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'))I -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.')A -1080 FORMAT(' ',/) - - END - - - ( - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z)A - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listB - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist1 - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)),s - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THENR - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IFE - - RETURNB - END - diff --git a/decus/vms95a/bulletin/bulletin1.for b/decus/vms95a/bulletin/bulletin1.for deleted file mode 100644 index 5abcc8a..0000000 --- a/decus/vms95a/bulletin/bulletin1.for +++ /dev/null @@ -1,2258 +0,0 @@ -C -C BULLETIN1.FOR, Version 1/23/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_P = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_P = LEN_P + I + 1 - BULL_PARAMETER(LEN_P:LEN_P) = ',' - END DO - LEN_P = LEN_P - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:I)//'""'// - & BULL_PARAMETER(I+1:) - I = I + 2 - LEN_P = LEN_P + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',BULL_PARAMETER(:LEN_P) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*32 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256,TODAY*24 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - IF (IER1.EQ.0) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THEN - I = IER - ELSE - NUM_COPY = NUM_COPY + 1 - END IF - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (.NOT.ORIGINAL.AND.REMOTE_SET.EQ.4).OR.REMOTE_SET.EQ.3 - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0.AND.NEWS_FEED()) THEN - IF (.NOT.ORIGINAL) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - IER1 = .FALSE. - ELSE - REMOTE_SET = 3 - END IF - END IF - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - ELSE - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF (TO_NEWS.AND.ORIGINAL) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2000' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (REMOTE_SET.GE.3.AND..NOT.ORIGINAL) THEN - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT) - ELSE - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - IF (.NOT.ORIGINAL) SYSTEM = IBSET(SYSTEM,3) - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (POST_NEWS) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE.F - END IFo - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWSI - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder infoi -Cr -C If user is adding message, an no new messages, update last read time fort -C folder, so user is not alerted of new message which is owned by user. -CS - IF (DIFF.GE.0) THENB - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with addB - - IF (IER.EQ.0) THENL - WRITE (6,'('' Successful copy to folder '',A)')_ - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THENF - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//E - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THENE - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE6 - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')')E - & BULL_POINT - START_BULL_POINT - END IFe - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADERo - IF (ORIGINAL.AND.(NEWS_FEED().OR.REMOTE_SET.EQ.4)) RETURN - - FOLDER_NUMBER = SAVE_FOLDER_NUMBERE - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1)d - - BULL_POINT = SAVE_BULL_POINTI - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN( - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')')L - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IFL - - RETURNH - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C) -C SUBROUTINE PRINT( -CE -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z)I - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'. - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./w - - OPENED = .FALSE.T - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND.t - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')')E - GO TO 200= - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0E - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN)F - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0)R - IF (CHANGED) THENL - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IFI - - IF (INCMD(:4).EQ.'PRIN') THENE - IF (CLI$PRESENT('CANCEL')) THEN - WRITE (6,'('' Cancelling all previously queued messages.'')') - CLOSE (UNIT=24,DISPOSE='DELETE')0 - FIRST = .TRUE. - RETURNI - END IF - END IF - -50 IF (PRINT_NUM.EQ.0) THEN0 - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)F - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THENI - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIRu - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THENU - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURNE - ELSE - SBULL = BULL_POINTa - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015)I - IF (OPENED) THENS - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIRT - END IF_ - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURND - END IF - ELSE - SBULL = PRINT_NUM - EBULL = SBULLL - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue nameN - IF (QLEN.EQ.0) THENm - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE)P - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')L - - CALL ENABLE_PRIVS - END IF - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER')$ - - DO I=SBULL,EBULL, - I1 = I - CALL READDIR(I,IER) ! Get info for specified messageS - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENTG - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THENe - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100$ - CLOSE (UNIT=24,DISPOSE='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFILA - CALL CLOSE_BULLDIRL - END IFR - RETURN - ELSE IF (REMOTE_SET) THENE - CALL REMOTE_READ_MESSAGE(I,IER1)( - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTEI - ELSE$ - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100) - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)O - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENL - IF (HEAD) THEN' - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8)U - END IFN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENR - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN)e - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP' - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN)( - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file' - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DO' - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,)R - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)T - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)' - END IF - -1040 FORMAT(' Message ',A,' sent to printer.')S -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IFF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE.W - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS'))h - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE))E - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM))T - END IFN - - CALL DISABLE_PRIVSE - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)' - IF (IER.AND.(.NOT.JBC_ERROR)) THENO - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSER - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A,. - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IFS - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE.R - GO TO 50 - END IF( - - RETURNR - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:')Y -1030 FORMAT(' ERROR: Following bulletin was not found: ',I)N -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -CC -C SUBROUTINE READ_MSG -CE -C FUNCTION: Reads a specified bulletin. -C( -C PARAMETER: -C READ_COUNT - Variable to store the record in the message fileD -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -CF - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'E - - COMMON /READIT/ READITE - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGINGH - LOGICAL PAGINGL - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./N - - COMMON /POST/ POSTTIMEL - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_IDT - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./I - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATEr - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH)E - CHARACTER HEADLINE*132L - - LOGICAL SINCE,PAGED - - EXTERNAL CLI$_NEGATED - - KILL = BTEST(BULL_USER_CUSTOM,3)E - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3)) - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screenS - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this isW - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE.A - END IF - ROTC = CLI$PRESENT('ROTATE') - END IF_ - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - IF (CLI$PRESENT('MARKED')) THENW - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3)E - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THENN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3): - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSE - BULL_READ = 1 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THENA - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)y - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified?T - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY)E - ELSEL - CALL SYS_BINTIM(DATETIME,MSG_BTIM)0 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IFQ - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified?F - NEW = .TRUE.B - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),L - & F_NEWEST_BTIM)L - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')')O - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY)P - END IF - CALL OPEN_BULLDIR_SHAREDB - IER = 0 - DO WHILE (IER.EQ.0) - CALL READDIR_KEYGE(IER)L - IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_BTIM) - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY)L - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN' - CALL CLOSE_BULLDIRB - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - END IF - END DO - CALL CLOSE_BULLDIRN - ELSEU - IER = 0 - DO WHILE (IER.EQ.0) - CALL NEWS_GET_NEWEST_MESSAGE(IER)_ - IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - MSG_NUM = IER - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(IER)E - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN' - WRITE (6,'('' No new messages are present.'')') - GO TO 9999D - END IFZ - END DO - END IFT - BULL_READ = IER - IER = IER + 1 - END IF - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN. - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999= - ELSE - BULL_READ = IER - IER = IER + 1 - END IFS - SINCE = .TRUE.- - END IF - END IF - - NEXT = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THENC - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - IF (.NOT.SINCE.AND..NOT.NEWM - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THENS - IER = 0 - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR.N - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THENT - MSG_NUM = F_NBULL+1 - ELSEI - MSG_NUM = BULL_NOW - END IF_ - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1) - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED: - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1W - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED. - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE - CALL GET_THIS_OR_NEXT_TAGY - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0 - END IF1 - END IFE - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)l - IF (IER1.EQ.0) IER = BULL_READ + 1 - END IF) - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1_ - END DO - CALL CLOSE_BULLDIRD - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)F - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1I - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN_ - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READi - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSEo - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THENL - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSE) - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0 - END IF. - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IFO - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSET - IER = 0 - END IF& - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND.: - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THENl - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED) - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entryT - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3E - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE.E - CALL READDIR(BULL_READ,IER)L - END IF. - END IFF - IF (REMOTE_SET.LT.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN' - READ_COUNT = 0, - IF (IER.NE.BULL_READ+1) THENb - CALL READDIR(0,IER)t - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THENO - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0I - END IF$ - CALL CLOSE_BULLDIRI - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THENT - WRITE(6,1030) ! If not, then error outN - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFILR - GO TO 9999 - END IF( - - BULL_POINT = BULL_READ ! Update bulletin counterF - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHAREDS - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(NEW.OR.NEXT.OR.INCMD(:4).EQ.'BACK'.OR.C - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THENi - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENL - INFROM = INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENT - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - - IF (.NOT.OK) THEN - BULL_NOW = MSG_NUMT - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN( - BULL_READ = MSG_NUM - 1 - ELSE) - BULL_READ = MSG_NUM + 1L - END IFF - IF (REMOTE_SET) CALL CLOSE_BULLFIL - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THENN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)_ - END IF - ELSEE - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - GO TO 50 - END IF - - BLOCK = BLOCK_SAVE - END IFL - - NEXT = .FALSE.' - IF (REMOTE_SET.LT.3) THEN - IF (INCMD(:4).NE.'SEAR') THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IFE - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2)O - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THENI - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL)A - END IF - IF (INCMD(:4).NE.'SEAR') THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.BULL_READ) CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ)R - END IF - END IFa - - EDIT = .FALSE.B - - PAGE_WIDTH = REAL_PAGE_WIDTH= - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN& - IF (CLI$PRESENT('EDIT')) THENR - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')E - IF (IER.NE.0) THEND - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)$ - GO TO 9999, - END IF= - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTHe - PAGE = .FALSE.I - END IF - END IF. - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ')L - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSE - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULLO - END IFE - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:)) - END DOE - I = TRIM(HEADLINE)R - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME)( - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN)F - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)), - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE) - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE))/ - END IFU - - END = 1 ! Outputted 1 line to screenL - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN2 - IF (REMOTE_SET.NE.3) THEN) - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)E - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)I - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?W - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5)E - END IFW - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IFP - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT))( - ELSEL - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF' - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1M - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ' - & .AND..NOT.BTEST(SYSTEM,3)) THEN - INPUT = 'From: '//INPUT(7:)I - DO WHILE (TRIM(INPUT).GT.0)T - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THENC - WRITE(3,'(A)') INPUT(:I)I - ELSEa - WRITE(6,'(1X,A)') INPUT(:I) - END IF_ - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1$ - ELSE% - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROM - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 12 - END IFL - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)L - END IF_ - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0)E - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THENS - WRITE(3,'(A)') INPUT(:I)F - ELSEH - WRITE(6,'(1X,A)') INPUT(:I) - END IFE - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1( - IF (EDIT) WRITE(3,'(1X)')e - ELSE, - END = END + 1 - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP)R - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP))E - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTHc - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IFH - END IF - END IF) - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1o - CALL CLOSE_BULLFIL ! End of bulletin file read, - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)')S - END = END + 1 -CE -C Each page of the bulletin is buffered into temporary memory storage beforeI -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory) -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -CE - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?L - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSEt - READ_COUNT = BLOCK ! Init bulletin record counterI - END IF' - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE.E - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN4 - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THENT - CHAR_OFFSET = 1I - BUFFER = INPUT(:PAGE_WIDTH)E - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSEF - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IFI - ELSED - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH/ - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0E - ELSED - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IFL - END IFE - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IFT - END IF - END DOM - - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) THEN - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counterG - GO TO 9999 - END IF1 - -CT -C Bulletin page is now in temporary memory, so output to terminal.A -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at theT -C end of the previous page. The output gets confused and thinks it mustE -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -CE - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DOT - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter_ - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still moreP - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IFS - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IFm - -9999 POSTTIME = .FALSE.P - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3)L - RETURN0 - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/)G - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z)L - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A')X - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a')b - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO - - RETURNB - END - - - - - - - SUBROUTINE READNEW(REDO)X -CE -C SUBROUTINE READNEW -Cx -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC'' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'( - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGO - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1 - EQUIVALENCE (INREAD4,INREAD)( - - DATA LEN_FILE_DEF /0/, INREAD/0/I - - LOGICAL SLOW,SLOW_TERMINAL: - - FIRST_MESSAGE = BULL_POINT( - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first timeP - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there isE - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletinsE - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input. - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN, - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THENT - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)')T - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO2 - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN. - END DO - CALL EXIT - ELSEL - WRITE (6,'(''+o'',$)')S - END IFN - RETURN ! If NO, exitY - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IFN - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')'). - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 11 - END IF - END IF2 - - READ_COUNT = 0 ! Initialize display pointerU - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulleting - BULL_POINT_READ = BULL_POINTH - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it.a - BULL_POINT = BULL_POINT + 1 - GO TO 10e - END IF - CALL CLOSE_BULLDIR - END IF( - - GO TO 12o - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IFe - - BULL_POINT = BULL_POINT_SAVEt - LENGTH = LENGTH_SAVE. - BLOCK = BLOCK_SAVE - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSEg - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - BLOCK_SAVE = BLOCKM - LENGTH_SAVE = LENGTH - BULL_POINT_SAVE = BULL_POINTC - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directoryM - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN_ - ! If F then copy bulletin to file_ - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THENC - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE( - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IFT - END IF - - LEN_FOLDER = TRIM(FOLDER)E - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,D - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS'c - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN. - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//R - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEFE - END IFE - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P)A - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)P - CALL FILE(0,.TRUE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THEND - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR.$ - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD)P - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)'). - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THEN) - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THEN. - WRITE (6,'(''+B'',$)')N - INCMD = 'RESPOND/LIST'E - ELSET - GO TO 11L - END IFE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPONDT - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')')T - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLYl - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN, - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletinT - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletinsS - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THENA - WRITE (6,'(''+Read'')')G - WRITE (6,'('' Enter message number: '',$)')C - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12E - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010)R - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message',_ - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.')I -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),',_ - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) -1040 FORMAT(' Type P to post reply, U to reply to user,',s - & ' B to do both, or other to quit: ',$) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -CL -C SUBROUTINE SET_DEFAULT_EXPIRE -CI -C FUNCTION: Sets default expiration date. -C_ - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'U - - INCLUDE 'BULLUSER.INC'G - - CHARACTER EXPIRE*3L - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)E - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN9 - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN$ - WRITE (6,'('' ERROR: Expiration must be > -1.'')')E - ELSE - FOLDER_BBEXPIRE = TEMP' - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER)= - CALL CLOSE_BULLFOLDERI - ELSEN - WRITE (6,'('' You are not authorized to set expiration.'')') - END IFR - - RETURN - END - - - - - LOGICAL FUNCTION NEWS_FEED()S - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'T - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN_ - I = SLIST + 1 - FLEN = TRIM(FOLDER_DESCRIP)E - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THENN - I = FLEN + 1I - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND.E - & FOLDER_DESCRIP(I:I).NE.'@'.AND._ - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE - I = FLEN + 2 - END IF - END DO - IF (I.EQ.FLEN+1) NEWS_FEED = .TRUE.C - END IFB - - RETURNE - END diff --git a/decus/vms95a/bulletin/bulletin10.for b/decus/vms95a/bulletin/bulletin10.for deleted file mode 100644 index 1f51cf2..0000000 --- a/decus/vms95a/bulletin/bulletin10.for +++ /dev/null @@ -1,3436 +0,0 @@ -C -C BULLETIN10.FOR, Version 12/23/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - COMMON /HEADER_SEEN/ HEADER_SEEN - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - LAST_LF_SEEN = LF_SEEN - LAST_REAL_LF_SEEN = REAL_LF_SEEN - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - CR_SEEN = INDEX(BUFFER(START_READ:END_READ),CR) - IF ((END_LINE.EQ.0.AND.CR_SEEN+START_READ-1.LT.END_READ) - & .OR.CR_SEEN.LT.END_LINE-1) THEN - END_LINE = CR_SEEN - CR_SEEN = 1 - ELSE - CR_SEEN = 0 - END IF - LF_SEEN = END_LINE.GT.0 - IF (END_LINE.GT.257-CR_SEEN.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - IF (.NOT.HEADER_SEEN) END_LINE = 254 - END IF - REAL_LF_SEEN = INDEX(BUFFER(START_READ:END_READ),LF).LE.END_LINE - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - IF (BUFFER(EB:EB).EQ.LF) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - IF (EB.GT.0.OR.LAST_LF_SEEN) RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE(:MIN(LEN(WRITE),256)) - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - NEWS_WRITE = NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - - LOGICAL FUNCTION NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - NEWS_RECONNECT = .FALSE. - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - NEWS_RECONNECT = .TRUE. - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /HEADER/ HEADER - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER()) THEN - IF (REMOTE_SET.EQ.4) THEN - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (INPUT(:11).EQ.'Message-ID:') THEN - MESSAGE_ID = INPUT(14:ILEN-1) - ILEN = 0 - END IF - END DO - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - CALL NEWS_POST('cancel',0,IER,'Delete news item.') - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = SETPRV_PRIV().OR.FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - BACKSEARCH = END - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - DO WHILE (BUFFER(SB:EB).NE.'.'.AND. - & .NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX( - & BUFFER(SB:EB),' ')+SB-2),J,,%VAL(1))) - IF (.NOT.NEWS_READ()) RETURN - END DO - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - HEADER_SEEN = .FALSE. - LF_SEEN = .FALSE. - LAST_LF_SEEN = .FALSE. - REAL_LF_SEEN = .FALSE. - LAST_REAL_LF_SEEN = .FALSE. - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8 - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONE - CHARACTER*4 ZONE - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/ - - CHARACTER*8 TIMES(1) - DATA TIMES /'-5:30'/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - IF (INDEX(ZONES,ZONE)/4.LT.4) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) - END IF - ELSE - HOUR = '00:00' - END IF - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_TI_L(TIME(:2),DATE,,%VAL(1)) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - CHARACTER*256 TEMP_FROM_LINE - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - NEWSGROUPS = ' ' - FOLLOWUP = ' ' - LREF = 0 - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.'.OR..NOT.LAST_REAL_LF_SEEN) - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126) - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+11).EQ.'Followup-To:'.AND. - & EB.GT.SB+12) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+13:EB))+SB+12 - FOLLOWUP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - TEMP_FROM_LINE = FROM_LINE - CALL GET_FROM(TEMP_FROM_LINE(7:),TRIM(FROM_LINE)) - LAST_FROM = .TRUE. - ELSE - LAST_FROM = .FALSE. - END IF - END IF - END DO - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'1FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - START = -1 - IER = SYS$ASCTIM(,TIME,IN_BTIM,) - CALL DATE_TIME(TIME) - SKIP = 0 - DO WHILE (SKIP.GE.0) - IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( - & FOLDER_NAME))//' '//TIME)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'23') THEN - IF (.NOT.NEWS_READ()) CALL EXIT - DO I=1,SKIP - IF (.NOT.NEWS_READ()) CALL EXIT - END DO - FIRST = BUFFER(SB:EB) - IF (FIRST.EQ.'.') RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL EXIT - END DO - IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) - & CALL EXIT - IF (.NOT.NEWS_READ()) CALL EXIT - IF (BUFFER(:2).EQ.'22') THEN - IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN - I = F_NBULL + 1 - DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. - & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) - & .OR.I.GT.F_NBULL)) - I = I - 1 - IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (I.GE.F_START) START = I - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END IF - RETURN - END IF - END IF - SKIP = SKIP + 1 - END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2O - IER = IER1 - END IFP - - RETURNt - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z)o - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUTh - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IFe - - RETURNr - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER)p -Cv -C SUBROUTINE GET_REMOTE_MESSAGE -Cn -C FUNCTION: -C Gets remote message. -C( - - IMPLICIT INTEGER (A-Z)Z - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EBR - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREFD - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINEE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /HEADER_SEEN/ HEADER_SEENL - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - CHARACTER*256 TEMPL - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty?D - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to headR - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128= - IER = 0 - LENGTH = 0_ - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN5 - LSUB = TRIM(SUBJECT_LINE)E - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IFL - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THENN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUTN - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN. - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILENE - END IFR - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINEA - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)T - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THENG - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IFN - LTEMP = LSUB - LSUB = 0 - IER = 0/ - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1S - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)L - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE - IER = NEWS_READ()I - IF (IER.AND.(BUFFER(SB:EB).NE.'.'M - & .OR..NOT.LAST_REAL_LF_SEEN)) THEN - IER = 0E - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THENW - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF ((INDEX(TEMP,': ').EQ.0.AND. - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR(E - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255).OR. - & (LTEMP.EQ.254.AND..NOT.LAST_LF_SEEN)) THEN - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IF - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IFL - IF (LOCAL_UPDATE1.NE.0) THENR - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF E - ELSE - HEADER_SEEN = .TRUE. - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1N - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)S - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0)W - ILEN = -128L - ELSE - ILEN = 128 - END IF - END IFR - ELSE - TEMP = TEMP(129:) - END IF, - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)R - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this errorD - IER = 0 - ILEN = 0T - ELSEM - CALL SYS_GETMSG(IER1) - LENGTH = 0I - IER1 = IERH - CALL DISCONNECT_REMOTER - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IFE - ELSE IF (ABS(ILEN).EQ.128) THEN, - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - HEADER_SEEN = .TRUE.E - - RETURNT - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER)M - - IMPLICIT INTEGER (A-Z)E - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURNL - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C( -C SUBROUTINE CONNECT_REMOTE_FOLDERB -CK -C FUNCTION: Connects to folder that is located on other DECNET node.: -CT - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)P - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATEN - - COMMON /READIT/ READITR - - COMMON /NEWS_INIT/ END_READ - - INCLUDE 'BULLUSER.INC'D - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVET - - DIMENSION DUMMY(4)A - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - END_READ = 0 - IF (.NOT.NEWS_LOGIN()) THEN - IER = 2 - RETURN - END IF - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNITE - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1A - END IF) - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,N - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILEN - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1Z - REMOTE_SET_SAVE = REMOTE_SETU - REMOTE_SET = .FALSE.O - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIRE - REMOTE_SET = REMOTE_SET_SAVED - FOLDER_FILE = FOLDER1_FILEM - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THENR - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THENR - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF1 - END IF - IF (.NOT.SYSLOG) THENW - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNERS - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBERT - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY,S - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IFI - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVEE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVET - END IFE - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND.E - & TEST_BULLCP().NE.2) THEN ! Not BULLCP processU - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE). - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)1 - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE)( - IF (IER.EQ.0) REWRITE (4) USER_ENTRYI - CALL CLOSE_BULLUSER - END IF1 - END IF - IER = 2S - ELSE - CLOSE (UNIT=31-REMOTE_UNIT)H -C, -C If remote folder has returned a last read time for the folder,E -C and if in /LOGIN mode, or last selected folder was a differentN -C folder, or folder specified with "::", then update last read time.D -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY)) - IF (SYSLOG) THEN( - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3)) - END IF - END IF - IER = 0E - END IF - - RETURNE - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID_ - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./R - - COMMON /NEWGROUP/ NEWGROUPE - - CHARACTER*8 NUMBER - - DIMENSION IN_BTIM(2): - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THENR - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNTM - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEYN - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER, - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT' - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURNT - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN. - END IF - ELSE IF (REMOTE_SET.EQ.3) THENR - IF (ICOUNT.EQ.0) THENU - NBULL = F_NBULL - ICOUNT = 1( - RETURNE - ELSE IF (ICOUNT.EQ.-1) THEN_ - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXITF - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN( - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT) - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXITR - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF. - IF (BUFFER(:2).NE.'22') THENE - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START)R - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN, - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER))/ - & CALL ERROR_AND_EXITN - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT. - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IFR - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITH - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITP - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT' - END IF - END IFT - IF (BUFFER(:2).NE.'22') RETURN: - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1))B - IF (.NOT.IER) RETURNU - START = ICOUNTE - BULLETIN_NUM = START. - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0I - CALL NEWS_HEADER(IER). - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN2 - END IF - BLOCK = START - MSG_NUM = STARTE - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURND - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM)F - - IMPLICIT INTEGER (A-Z)O - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8U - INPUT(9-I:9-I) = MSG_KEY(I:I)S - END DOR - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN - END - - - - SUBROUTINE NEWS_GROUP(IER)N - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'N - - COMMON /BUFFER/ BUFFER,SB,EBN - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN - IER = 1F - RETURN - END IFH - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)). - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURNI - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1))F - IF (.NOT.IER) RETURN' - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1))N - IF (.NOT.IER) RETURN_ - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1))F - IF (.NOT.IER) RETURNF - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT')A - IF (.NOT.IER) RETURNE - - IER = NEWS_READ() - IF (.NOT.IER) RETURNR - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURNM - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z)A - - CHARACTER*(*) INTIMED - - CHARACTER*28 TIME - - DIMENSION DIFF(2) - - I = 1 - LTIME = TRIM(INTIME)5 - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR.T - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1T - END DOT - - IF (I.GT.LTIME) THEN) - CALL SYS_BINTIM('-',BTIM)Y - RETURN - END IFN - - CALL STR$UPCASE(TIME,INTIME(I:))M - - DO J = 1,2I - I = 1E - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-') - END DO: - - IF (I.EQ.LEN(TIME)) RETURNR - - IF (TIME(I+3:I+3).EQ.' ') THEN - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IFI - - I = 1 - DO J = 1,2) - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1n - END DOl - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) THEN) - CALL SYS_BINTIM('-',BTIM)E - RETURN - END IF - - IF (INDEX(TIME(:I-2),'.').GT.0) THEN - CALL SYS_BINTIM(TIME(:INDEX(TIME(:I-2),'.'))//'00',BTIM). - ELSE IF (TIME(I-4:I-4).EQ.':'.AND.TIME(I-7:I-7).EQ.':') THENY - CALL SYS_BINTIM(TIME(:I-2)//'.00',BTIM) - ELSE_ - CALL SYS_BINTIM(TIME(:I-2)//':00.00',BTIM)I - END IFF - - IF (TIME(I:I).EQ.'+'.OR.TIME(I:I).EQ.'-') THENU - IER = SYS_BINTIM('0 '//TIME(I+1:I+2)//':'//TIME(I+3:I+4),DIFF) - IF (IER) THEND - IF (TIME(I:I).EQ.'-') THENH - IER = LIB$SUBX(BTIM,DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,DIFF,BTIM) - END IFL - END IF - END IFL - - RETURNN - END - - - - SUBROUTINE NEWS_LISTE - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EBR - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - COMMON /NEWSLIST/ NEWSLIST - - CHARACTER TODAY*24F - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURNd - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR.O - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER))C - - LOCAL_UPDATE = LOCAL_UPDATE1 - - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED ! Open folder fileI - - NEWS_FOLDER1_BBOARD = '::'F - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)1 - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14I - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)N - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMW - END IFE - NEWS_FLAG_DEFAULT = NEWS_F1_FLAGN - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE( - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMITD - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNTN - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1E - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1)T - IF (IER1.EQ.0) THENM - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER)C - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1))_ - SP = EP + 2 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1))R - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1 - IF (IER.NE.0.OR.IER1.NE.0) THENE - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLENB - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN R - NEWS_FOLDER = NEWS_FOLDER1(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM) - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - IF (FLEN.GT.44) THENH - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)// - & BUFFER(SP:EB) - ELSE/ - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB)B - END IFM - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DON - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT) - IF (IER2.EQ.0) THEN - NEWS_F1_FLAG = NEWS_F_FLAG - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THENP - NEWS_F1_EXPIRE = NEWS_F_EXPIREm - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMITS - END IF - ELSE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF1 - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE)Q - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)E - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)E - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1). - IF (BTEST(NEWS_F1_FLAG,8)) THEN N - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0+ - NEWS_F1_LAST = 0 - END IF_ - IF (FLEN.LE.44.OR.FLEN-44+EB-SP+1.LT. - & LEN(NEWS_FOLDER1_DESCRIP)) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMB - IF (IER.EQ.0) THEN O - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THENB - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,: - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IFR - END IF - END IF - ELSE IF (BTEST(NEWS_F1_FLAG,8).AND.= - & .NOT.BTEST(NEWS_F1_FLAG,9)) THENA - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN( - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMR - END IFT - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF( - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE.D - IF (FLEN.GT.44) THEN - IF (NEWS_FOLDER1_DESCRIP.NE.( - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THENU - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)F - UPDATE = .TRUE.A - END IFE - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - IF (SPECIAL) THEN - IF (UPDATE) THEN - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF( - ELSE IF (.NOT.UPDATE) THEN) - UPDATE = F1_START.LT.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL - END IFD - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)I - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)E - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7)O - CALL READ_FOLDER_FILE_TEMP(IER) - END DO0 - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN. - NEWS_F1_NBULL = F1_NBULLU - NEWS_F1_START = F1_START_ - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THENR - IF (NEWS_F1_FIRST.GT.F1_START.AND. - & NEWS_F1_FIRST.GT.F1_NBULL) THENP - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF) - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE), - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF) - ELSE IF (((F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND.(.NOT.BTEST(NEWS_F1_FLAG,8).OR. - & NEWS_F1_NBULL.LT.NEWS_F1_STARTT - & .OR.NEWS_F1_START.EQ.0)) THEN - DELETE (UNIT=7), - IER = 0E - END IF - END IF. - END DO - END IF= - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - NEWSLIST = .FALSE. - - IF (SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED')) CALL RECOUNT - - RETURNT - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THENF - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DOR - - RETURND - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EBL - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREFM - CHARACTER*256 REFERENCEST - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAMEH - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_IDE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPSs - CHARACTER*256 NEWSGROUPSP - - COMMON /FOLLOWUP/ FOLLOWUPE - CHARACTER*128 FOLLOWUPE - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4T - - COMMON /LOCALPOST/ LOCAL_POST - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINEA - CHARACTER*12 MSGNUM - - COMMON /TEMP_INPUT/ GROUP_TEMP - CHARACTER GROUP_TEMP*256 - - CHARACTER*(*) FILENAME,SUBJECTU - - CHARACTER RESPONSE*4 - - CHARACTER TODAY*24,UNAME*132L - DATA UNAME /'()'/ - - DIMENSION NOW(2)C - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THENS - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1)e - IF (IER1.NE.0) RETURN - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900_ - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3) - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW)( - IER = SYS$ASCTIM(,TODAY,NOW,) - - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:)E - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THENE - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900I - IF (BUFFER(:3).NE.'340') THENP - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSE - I = INDEX(NEWS_MSGID,'.')H - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & NEWS_MSGID(:I-1)// - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256)1 - IF (IER.NE.0) RETURNE - LOCAL_POST = .TRUE.L - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1( - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THENC - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP - ELSE IF (.NOT.BTEST(FOLDER_FLAG,8).AND.N - & TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THENT - IF (TRIM(FOLLOWUP).EQ.0) THEN - INPUT = 'Newsgroups: '//NEWSGROUPS - ELSE. - INPUT = 'Newsgroups: '//FOLLOWUP - END IF_ - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE.AND.( - & .NOT.NEWS_FEED()) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER)) - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0P - DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP)) - IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP) - DO WHILE (TRIM(GROUP_TEMP).GT.0) - COMMA = INDEX(GROUP_TEMP,',') - IF (COMMA.GT.0) THENF - FOLDER1_NAME = GROUP_TEMP(1:COMMA-1) - GROUP_TEMP = GROUP_TEMP(COMMA+1:) - ELSE1 - FOLDER1_NAME = GROUP_TEMP - GROUP_TEMP = ' 'T - END IFT - CALL LOWERCASE(FOLDER1_NAME)) - FLEN = TRIM(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMPT - & (FOLDER1_NAME(:FLEN),IER1)1 - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9)M - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND. - & INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND. - & INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST), - & GROUP_LIST,FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - ELSE - WRITE (6,'(1X,A,'' is not a valid news group.'')')R - & FOLDER1_NAME(:FLEN)M - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still which to specify it? (default = Y) ')C - IF (RESPONSE(:1).NE.'n'.AND. - & RESPONSE(:1).NE.'N') THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - END IFD - END IF - END DO - END DOR - CALL CLOSE_BULLNEWS - END IF - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900) - END IFS - ATSIGN = INDEX(PATHNAME,'@')B - PCSIGN = INDEX(PATHNAME,'%')f - CALL LOWERCASE(USERNAME)h - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'T - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900D - ELSEE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'C - & //USERNAME(:TRIM(USERNAME)))) GO TO 900R - END IF - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME)U - - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900V - CALL STR$UPCASE(FROM_LINE,FROM_LINE)E - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME)R - 2 - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'// - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE IF (TRIM(SUBJECT).EQ.0) THEN - IF (.NOT.NEWS_WRITE('Subject: (none)'))F - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECTA - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF)))L - & GO TO 900 - END IFS - - IF (NGROUPS.GT.0) THENE - FROM = USERNAMEN - DESCRIP = SUBJECTF - END IFL - - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//'>')) GO TO 900 - - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION) - END IF - LORGAN = TRIM(ORGANIZATION)S - END IFF - - IF (LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN)))E - & GO TO 900T - END IFE - - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//A - & ZONE(:LZONE))) GO TO 900 - - HEADER = .FALSE.I - - IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel').AND..NOT.NEWS_FEED()) THENA - IF (CLI$PRESENT('EXPIRATION')) THEN - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE( - & FIRST_ALPHA(EXDATE):2)E - & //' '//EXDATE(4:6)//' '//EXDATE(10:TRIM(EXDATE))S - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900_ - ELSE IF (REMOTE_SET.EQ.4) THEN3 - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT)N - END IF - EXTIME = '00:00:00.00'F - END IF - IF (CLI$GET_VALUE('FOLLOWUP',GROUP_TEMP)) THEN - CALL LOWERCASE(GROUP_TEMP)T - IF (.NOT.NEWS_WRITE('Followup-To: ' - & //GROUP_TEMP(:TRIM(GROUP_TEMP)))) GO TO 900_ - END IF - HEADER = CLI$PRESENT('HEADER') - END IF - - IF (CREATE) THENL - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURN_ - END IF - - IF (FILENAME.EQ.'cancel') THENU - IF (.NOT.NEWS_WRITE('Control: cancel <'D - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURNL - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_READ()) RETURNl - IF (BUFFER(:3).EQ.'240') IER = 0 - ELSE - CLOSE (UNIT=8,STATUS='SAVE')e - IER = 0 - END IF - LOCAL_POST = .FALSE. - RETURN - END IFn - - IF (.NOT.HEADER) THEN - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - END IFQ - - IER1 = 0 - DO WHILE (IER1.EQ.0)D - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2 - END IF - IF (IER1.EQ.0) THENA - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DO - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THENS - IF (.NOT.NEWS_WRITE('.')) GO TO 900N - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') THEN' - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:MIN(79+SB,EB)) - IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN - WRITE (6,'('' Use /INDENT to change indentation'',$)') - WRITE (6,'(''+ character. See Manager for permanent'',$)') - WRITE (6,'(''+ change.'')') - END IF - END IF - ELSE( - LENGTH = (LENGTH+127)/128E - GROUP_LIST = GROUP_LIST1O - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - DO I=NGROUPS,1,-1- - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1)O - FOLDER_NUMBER = -1M - CALL SELECT_FOLDER(.FALSE.,IER)E - IF (IER) THEN - CALL ADD_LOCAL_NEWS(8) - END IFT - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - IF (.NOT.NEWS_WRITE('.')) GO TO 900) - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0I - END IFN - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - - LOCAL_POST = .FALSE. - - RETURNO - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLUSER.INC'O - - COMMON /PATH/ PATHNAME,LPATHT - CHARACTER*132 PATHNAMEL - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURNN - END IF - END IF - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME)_ - LPATH = TRIM(PATHNAME)3 - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME)R - - IMPLICIT INTEGER (A-Z)E - - CHARACTER*(*) NAMEN - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME)I - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE.U - END DO - - TEST_NEWS = MAYBE_NEWSI - - RETURN. - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC'N - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1W - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM)E - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) RETURNE - D - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER)N - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULLC - FIRST = F1_START - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - CALL OTS$CVT_L_TI(F_LAST+1,NUMBER,,,) - REMOTE_SET = 3N - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNTI - NEW_NEWS_F_END = NEWS_F_END - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM)' - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1D - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THENF - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IFR - F_LAST = LAST - NEWS_F_FIRST = FIRST - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS K - RETURNU - END IF - END DO= - - RETURNI - END - - - - - SUBROUTINE NEWS2BULL(RECLAIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'I - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BUFFER/ BUFFER,SB,EBE - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBER' - - DIMENSION NOW(2)_ - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIVI - - CALL DELETE_EXPIRED_NEWS(RECLAIM) - - IF (RECLAIM) CALL EXITI - - CALL NEWS_LIST - - CALL UPDATE_LOCAL_NEWSN - - CALL SEND_POST - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1F - - CALL OPEN_BULLFOLDER_SHARED ! Get folder fileR - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - ELIST = INDEX(FOLDER_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN - IF ((FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR. - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))).AND. - & INDEX(FOLDER_DESCRIP(SLIST+2:),'@').EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1+ - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IFQ - END IF - END DOI - - CALL CLOSE_BULLFOLDER ! We don't need file anymoreI - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXITT - - FOLDER_Q = FOLDER_Q1E - POINT_FOLDER = 0( - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1: - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)H - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARD - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1)) - IF (IER) THEN - SAVE_LAST = F_LAST - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER)1 - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIPE - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER). - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THENE - SAVE_LAST = F_NBULLM - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1)Y - F_LAST = SAVE_LASTM - FOLDER_BBOARD = 'NONEFEED'4 - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDERM - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - REMOTE_SET = 3T - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.)C - CALL OPEN_BULLFOLDERF - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1)/ - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1) - END IFN - CALL CLOSE_BULLFOLDER - END IF) - END IF - END DOG - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME)I - - IMPLICIT INTEGER (A-Z)d - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH= - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/O - - CHARACTER*(*) TIME' - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+T - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)//e - & TIME(16:17)//TIME(19:20)A - - RETURN - END - - - - SUBROUTINE ALLPRIVE - - IMPLICIT INTEGER (A-Z)E - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1 - PROCPRIV(2) = -11 - NEEDPRIV(1) = -1E - NEEDPRIV(2) = -1_ - - RETURNT - END - - - - SUBROUTINE NEWS_NEW_FOLDERB - - IMPLICIT INTEGER (A-Z)0 - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COMA - - NEWS_FOLDER1 = FOLDER1E - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1O - END DO1 - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNTH - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COMT - - RETURNL - END - - - - SUBROUTINE SUBSCRIBEE - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC'= - - INCLUDE 'BULLFOLDER.INC'E - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')')F - RETURN - END IF - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1E - END DOD - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSEE - WRITE (6,'('' You are now subscribed to '',A,''.'')')I - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IFP - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER)) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1))W - LAST_NEWS_READ(2,J) = F_START - 1 - ELSE - LAST_NEWS_READ2(2,J) = 0 - LAST_NEWS_READ(2,J) = F_NBULL - END IFS - CALL CLOSE_BULLNEWS - RETURNM - END IF - END DO1 - - END - - - - - - SUBROUTINE UNSUBSCRIBEE - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC'B - - INCLUDE 'BULLFOLDER.INC'' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IF1 - - CALL OPEN_BULLINF_SHARED= - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THENE - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 19 - END DO - - IF (I.LE.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Folder is permanent and cannot not be'', - & '' unsubscribed.'')') - RETURN - END IFD - - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - I = NEWS_FIND_SUBSCRIBE() - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1))I - END DO1 - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0E - - CALL FREE_TAGS(I) - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC'T - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (IER.EQ.0) IER = 1 ! None read yet. - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0L - RETURN - END IFS - - RETURN) - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER)) - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLUSER.INC'B - - INCLUDE 'BULLFOLDER.INC'R - - I = NEWS_FIND_SUBSCRIBE1()E - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0. - RETURN - END IF - - RETURNF - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR. - & (LAST_NEWS_READ(2,I).GT.F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER), - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - - RETURN_ - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG)R - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0R - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THENT - COUNT = COUNT + 1) - END IF - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT)_ - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE - SUBNUM = 0 - END IFE - - RETURNF - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES)) -CE -C SUBROUTINE NEWS_NEW_NOTIFICATION1 -CS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'L - - INCLUDE 'BULLUSER.INC'N - - COMMON /READIT/ READITD - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)_ - - MESSAGES = .FALSE.T - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1L - - FOLDER_DESCRIP = ' 'U - REORDER = 0 - DO WHILE (SUBNUM.GT.0) - IER = 1% - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)F - FOLDER1_DESCRIP = FOLDER_DESCRIP& - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER)T - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUMT - UNLOCK 7E - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1 - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - ELSE IF (IER.NE.0) THEN - SUBNUM = -17 - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR. - & F_START.GT.F_NBULL) THEN( - IER = 1T - END IFD - END IF - IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THENT - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR.' - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)F - IF (DIFF.GT.0) IER = 1 - END IF - END IFE - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THENR - WRITE (6,'('' There are new messages in folder '',F - & A,''.'')') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)M - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A,''.'')') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - ELSE( - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1)= - IF (IER1) THENR - CALL LOGIN_FOLDERA - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBERI - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THENQ - SAVE_BULL_POINT = BULL_POINTR - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DON - END IF - END IF - END IFE - CALL OPEN_BULLNEWS_SHARED - END IF( - END IF - END DO - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBEF - - CALL CLOSE_BULLNEWS - - RETURN= - END - - - SUBROUTINE REORDER_SUBSCRIBE - - IMPLICIT INTEGER (A-Z)g - - INCLUDE 'BULLFOLDER.INC'A - - INCLUDE 'BULLUSER.INC') - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0)) - I = I + 1 - END DO6 - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1 - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1) - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2U - TEMP = LAST_NEWS_READ(L,J)U - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K)R - LAST_NEWS_READ(L,K) = TEMP - END DOS - END IF - END DO - END DO - - RETURND - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)D - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLUSER.INC'U - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN( - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER)I - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLUSER.INC'O - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IFN - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15)& - - RETURN_ - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLUSER.INC'a - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENI - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IFC - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURN_ - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE()( - - IMPLICIT INTEGER (A-Z)G - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'. - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER_ - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1T - END DOE - - NEWS_FIND_SUBSCRIBE = I - - RETURNR - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1_ - END DOD - - NEWS_FIND_SUBSCRIBE1 = IB - - RETURNV - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLUSER.INC'R - - INCLUDE 'BULLFOLDER.INC'L - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IFN - - CALL OPEN_BULLINF_SHAREDH - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_RECA - END DOB - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DOI - END IF - CALL CLOSE_BULLINF - - IP = 1 - DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER - & .AND.IP.LE.FOLDER_MAX-1)/ - IP = IP + 1 - END DO - - IER = .TRUE.C - - IF (IP.EQ.FOLDER_MAX) THENN - PERM = .FALSE. - IP = 1 - ELSE. - PERM = .TRUE.L - END IFR - - IF (NOTIFY.EQ.0) THEN - IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')')E - RETURN - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) - END IF - ELSE IF (NOTIFY.EQ.1) THEN' - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13)D - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE.C - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).AND. - & .NOT.BTEST(INF_REC2(2,IP),15))) THENL - IER = .FALSE.N - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.PERM.AND.C - & (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - END IFE - - IF (IER) THEN - IF (READNEW.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14)I - IF (READNEW.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14)I - IF (BRIEF.EQ.1)I - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0)D - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - ELSET - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')')P - - IF (BTEST(INF_REC2(2,IP),14)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - END IF - - IF (BTEST(INF_REC2(2,IP),15)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - END IF - END IFI - - CALL UPDATE_USERINFO, - - RETURN - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT)G - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNTL - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - REWIND UNIT - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM)E - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '//. - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK) - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THENT - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6,= - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK)_ - END IFC - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THENV - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1I - SYSTEM = 0E - CALL ADD_ENTRY) - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - ENDI - - - - SUBROUTINE UPDATE_NEWS_FOLDER -CD -C SUBROUTINE UPDATE_NEWS_FOLDER -C_ -C FUNCTION: Updates folder info due to new message. -CU - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'C - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THENM - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_ENDF - F_COUNT = NEW_F_COUNT - END IF - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1E - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_EX_BTIM_KEY N - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLNEWS - - RETURNF - END - - - - SUBROUTINE SEND_POSTL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280C - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - P - CHARACTER FILE*132 - A - C = 0 - C - IF (.NOT.NEWS_LOGIN()) RETURNG - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST',FILE,C)) - IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURNU - IF (BUFFER(:3).NE.'340') RETURN - / - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN E - IF (INPUT(:5).EQ.'From:') - & BULL_PARAMETER = INPUT(7:INDEX(INPUT,'@')-1)/ - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IFJ - END DOR - IF (INPUT.NE.'.') THEN Y - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - IF (BUFFER(:3).NE.'240') THENl - CLOSE (UNIT=3)F - CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER))S - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER) - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD')= - END IF - CLOSE (UNIT=3,STATUS='DELETE') - END DOI - -100 CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) _ - - INCLUDE '($MAILDEF)'A - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVS - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100/ - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST) - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0)F - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVSt - - IF (UNAME.EQ.'()') THEN - UNAME = ' ' - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IFE - - RETURNY - END - - - - SUBROUTINE RECOUNT& -C -C SUBROUTINE RECOUNT -C -C FUNCTION: -CI -C Fixes the message count of stored news groups. This may become wrong E -C if old copies of some of the database files are used with newer versions. -C - - IMPLICIT INTEGER (A-Z)P - - INCLUDE 'BULLFOLDER.INC'O - - INCLUDE 'BULLDIR.INC'N - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT( - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - FOLDER_NUMBER = 1000p - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER))T - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN/ - CALL CLOSE_BULLNEWS - RETURN - END IFw - - REMOTE_SET = 4P - - DO WHILE (IER.EQ.0) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - END DO - - IF (BTEST(NEWS_F_FLAG,8).AND.IER.EQ.0) THEN - CALL NEWS_TO_FOLDER - - CALL OPEN_BULLDIR_SHARED - - NUM = F_START - F_COUNT = 0 - - IF (F_START.GT.0) THENN - CALL READDIR(NUM,IER) - NEXT = .TRUE.R - F_START = NUMN - DO WHILE (NUM+1.EQ.IER)D - F_COUNT = F_COUNT + 1 - NUM = NUM + 1 - IF (NUM.LE.F_NBULL) CALL READDIR(NUM,IER) - END DO - NEXT = .FALSE. - - F_NBULL = NUM - 1 - END IFA - - CALL CLOSE_BULLDIRR - - CALL REWRITE_FOLDER_FILE(IER) - END IFP - END DO) - - CALL DELLNM('BULL_NEWS_RECOUNT') - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE DELLNM(LOG)C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$SYSTEM',LOG,PSL$C_SUPER) - - RETURN1 - END diff --git a/decus/vms95a/bulletin/bulletin11.for b/decus/vms95a/bulletin/bulletin11.for deleted file mode 100644 index 67764ce..0000000 --- a/decus/vms95a/bulletin/bulletin11.for +++ /dev/null @@ -1,2944 +0,0 @@ -C -C BULLETIN11.FOR, Version 5/12/95 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('CURRENT')) THEN - MESSAGE_NUMBER = BULL_POINT - ELSE IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*12 BULL_MARK_DIR - CHARACTER*12 TAG_KEY,INPUT_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,) - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1) - ELSE - UNLOCK 13 - END IF - END IF - - NTRIES = 0 - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),) - IF (IER1.NE.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128,DISPOSE='DELETE', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1) - NEWS_MARK2(1) = NEWS_MARK2(2) - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF- - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE)O - - IMPLICIT INTEGER (A-Z)& - - INCLUDE 'BULLUSER.INC'N - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURND - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1),( - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IFR - - RETURNS - END - - - - SUBROUTINE OPEN_NEW_TAG(IER)U - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'G - - INCLUDE 'BULLFOLDER.INC'N - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARKU - DIMENSION NEWS_MARK(128)E - - CHARACTER*12 BULL_MARK_DIRU - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IFD - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13N - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSER - MARKUNIT = 23O - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW',N - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)), - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0E - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IFR - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN. - WRITE (6,'('' Cannot create mark file.'')')E - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEND - WRITE (6,'('' IOSTAT error = '',I)') IERT - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1I - END IF - ELSE) - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)')I - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))S - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 11 - END IF - - RETURNT - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY))S - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:))D - - RETURN_ - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEYN - - CHARACTER*8 NEXT_MSG_KEY. - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IFO - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IFC - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY)= - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADERG - END IF - RETURN - END IFE - - MSG_KEY = BULLDIR_HEADERN - - HEADER = .TRUE. - - DO J=1,2Y - IF (BTEST(READ_TAG,J)) I = J - END DO_ - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURNT - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)_ - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IFT - - TAG_TYPE = 0N - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DOT - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO, - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR.N - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND.( - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THENW - IF (IER.EQ.0) UNLOCK 13 - IER = 0E - MESSAGE = MSG_NUML - ELSE - IER = 36 - END IFE - - RETURNT - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY) - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)E - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF_ - - IER = 36= - - HEADER = .FALSE.E - - TAG_TYPE = 0T - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)T - RETURN - END IFS - - DO WHILE (IER.NE.0) - I = 0T - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEY= - END DO( - IF (IER.EQ.0) THENE - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)I - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IFE - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:)' - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THENR - I = 2 - END IF - END IFI - END IF - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER))N - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEYU - END DOI - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I) - IER = 0 - RETURN2 - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THENT - MSG_KEY = NEXT_MSG_KEY - RETURN_ - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DOV - - RETURN( - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE)H - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHAREDI - - DO MESSAGE = MSG_NUM+1,F_NBULLI - CALL READDIR(MESSAGE,IER)I - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE)S - IF (IER.EQ.0) THEN) - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIRG - RETURN - END IFP - END IF - END DOA - - IER = 36P - IF (CLOSE_IT) CALL CLOSE_BULLDIRS - - RETURNM - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z)M - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2)O - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURNE - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J)H - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - DO WHILE (REC_LOCK(IER))a - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER)o - & INPUT_KEY - END DO - - CLOSE_IT = .FALSE.s - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR.C - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIRM - RETURNO - ELSE - CALL DECREMENT_MSG_KEY3 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THENo - CALL OPEN_BULLDIR_SHAREDT - CLOSE_IT = .TRUE. - END IFI - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:))' - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THENE - MESSAGE = MESSAGE - 1E - MSG_NUM = MESSAGEE - MSG_KEY = BULLDIR_HEADER - END IFf - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - DELETE (UNIT=13)S - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER))F - READ (13,IOSTAT=IER) INPUT_KEYA - END DO - END IFR - END IF - - END DOE - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC'_ - - COMMON /NEWS_MARK/ NEWS_MARKL - DIMENSION NEWS_MARK(128). - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECF - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)_ - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)O - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE.D - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1' - DO M=1,2 - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THENG - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1L - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1T - LIMIT = 256/(NEWS_FORMAT+1)E - NEWS_NUMBER = LAST_NEWS_READ2(1,I)( - K = 5-NEWS_FORMAT*2T - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN. - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1' - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IFE - SET_LIST = .FALSE. - END IF$ - IF (J.EQ.NEWS_TAG(2,M,I)) THENA - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0)S - END DO - K = LIMIT + 1T - END IFe - IF (K.GT.LIMIT) THENW - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2M - NEWS_REC = NEWS_REC + 1 - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER))L - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER)R - IF (IER.EQ.0) THENL - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IFN - END DO - END IF - END DOR - END DO - CLOSE (UNIT=23)i - END IFf - - RETURN - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z), - - COMMON /NEWS_MARK/ NEWS_MARKE - DIMENSION NEWS_MARK(128)I - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)A - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = JN - ELSEG - NEWS_MARK(I) = J - END IFF - - RETURNT - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG)S - - IMPLICIT INTEGER (A-Z)A - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUMD - NEWS_TAG(I) = 0L - END DOB - - RETURN& - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'M - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARKL - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECE - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)s - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)s - - DO I=1,2, - IF (NEWS_TAG(3,I,ISUB).GT.0) THENE - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB))I - NEWS_TAG(3,I,ISUB) = 0M - NEWS_NUMBER = NEWS_FOLDER_NUMBERT - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER))A - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARKY - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER) - END IF - END DO - IF (IER.EQ.0) UNLOCK 23 - END IF - - DO J=I,FOLDER_MAX-2A - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J))E - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0 - END DO - END DOO - - RETURNo - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE)T - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY - - IER = 36E - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE)V - IF (IER.EQ.0) THENN - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THENB - IF (.NOT.BTEST(READ_TAG,3)) THENN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM)B - END IF - IER = 36 - END IF - END IF - END DO - BULL_READ = MSG_NUM - IF (CLOSE_IT) CALL CLOSE_BULLDIR U - ELSEI - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0 - MSG_KEY = BULLDIR_HEADER - IER = 0= - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM). - IF (MSG_NUM.GT.0) THEN - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)D - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEYW - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)( - ELSE - IER = 36N - END IF - END IFT - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEYN - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I))E - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DOR - - RETURNY - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C3 -C SUBROUTINE SET_GENERICU -CR -C FUNCTION: Enables or disables "GENERIC" display, i.e. displayingI -C general bulletins continually for a certain amount of days.. -C3 - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THENR - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IFT - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN( - IF (GENERIC) THENT - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSEI - NEW_FLAG(2) = ' 7'P - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE. - WRITE (6,'('' ERROR: Specified username not found.'')')Y - END IF, - - CALL CLOSE_BULLUSER - - RETURNE - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C1 -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -CT - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLUSER.INC'N - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THENM - NEW_FLAG(2) = -1 - ELSEA - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY) - - CALL CLOSE_BULLUSER - - RETURNV - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C) -C SUBROUTINE SET_LOGINF -C( -C FUNCTION: Enables or disables bulletin display at login.K -C - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC') - - CHARACTER TODAY*24 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THENI - WRITE (6,'(( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF/ - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)N - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)R - IF (IER.EQ.0) THENM - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSES - WRITE (6,'('' ERROR: Specified username not found.'')')1 - END IFL - - CALL CLOSE_BULLUSER - - RETURNE - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z), - - CHARACTER USERNAME*(*),ACCOUNT*(*)N - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2)E - - CALL INIT_ITMLST) - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT))= - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST)N - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2)_ - - RETURNE - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z)K - - INTEGER*4 EXBLK(4)2 - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1O - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURNE - END - - - - SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)'' - - INCLUDE 'BULLUSER.INC'S - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1)) - - CALL DISABLE_PRIVSA - - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))//R - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:)S - END DO - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR)_ - - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO)) - I = INDEX(SENDTO(J:),',') - 1A - IF (I.EQ.-1) I = TRIM(SENDTO(J:))' - CALL INIT_ITMLSTP - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0)D - IF (.NOT.STATUS) GO TO 100C - J = J + I, - IF (SENDTO(J:J).EQ.',') J = J + 1M - END DOG - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) - IF (SETPRV_PRIV()) THEN - CALL ENABLE_PRIVS - CALL ADD_2_ITMLST - & (TRIM(USERNAME),MAIL$_SEND_FROM_LINE,%LOC(USERNAME)) - CALL DISABLE_PRIVS - END IF - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO))E - CALL END_ITMLST(ATTRIBUTE_ITMLST)O - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0)N - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0)( - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS_ - CALL LIB$REVERT - - RETURN - ENDN - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,)3 - - RETURNM - END - - - - - SUBROUTINE SET_NEWSM - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC'I - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_PN - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEXT/ NEXTY - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE( - CHARACTER*80 BULLNEWSDIR_FILE - - DIMENSION EXPIRED(2)R - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THENS - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IF - - ENTRY SHOW_NEWS - - LIMIT = -2L - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1))R - IF (.NOT.IER.OR.LIMIT.LT.-1) THEN_ - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')')E - RETURN - END IF R - END IF - - EXPIRE = -1= - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1))T - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN3 - END IF - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR.L - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')') - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder fileU - - IF (CLI$PRESENT('DEFAULT')) THEN_ - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)_ - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THENM - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1I - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')') - CALL CLOSE_BULLNEWS - RETURN3 - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THENs - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THENN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER)I - CLOSE (UNIT=3,DISPOSE='DELETE')F - END IF - RETURNL - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)I - DO WHILE (IER.EQ.0)' - DO WHILE (REC_LOCK(IER))T - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DOA - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULTM - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULTS - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULTU - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED)S - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE)R - FOLDER1_NUMBER = NEWS_F1_COUNTW - FOLDER1 = BULL_PARAMETERA - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10)U - CALL WRITE_FOLDER_FILE_TEMP(IER), - IF (IER.NE.0) THENC - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMPI - REWRITE (7) NEWS_FOLDER1_COMT - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER) - END IF I - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDERA - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURN/ - END IF - END IFN - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT' - - CLASS = CLI$PRESENT('CLASS')C - DEFAULT = CLI$PRESENT('DEFAULT')F - ALL = CLI$PRESENT('ALL')E - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE')_ - ENABLE = CLI$PRESENT('ENABLE')Y - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - T - STORED = 0E - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN O - F1_LAST = 0 - F1_COUNT = 0C - F1_START = 0 - F1_NBULL = 0T - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IFE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN' - WRITE (6,'('' Stored setting was not removed.'')') - CALL CLOSE_BULLNEWS - RETURNI - END IF) - IF (DEFAULT) THENE - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))E - & //'[.BULLNEWS*]*.*;*')' - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*')1 - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_SAVE = FOLDERG - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBERT - CALL SELECT_FOLDER(.FALSE.,IER) - END IFE - FOLDER = FOLDER_SAVEV - CALL OPEN_BULLDIRK - CALL CLOSE_BULLDIR_DELETE - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0 - F1_NBULL = 0U - F1_COUNT = 0 - F1_LAST = 0L - END IFO - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8)A - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)N - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),T - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF( - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN_ - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP),A - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3) - IF (IER.NE.0) THEN M - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER)R - CLOSE (UNIT=3)T - END IF - CALL RESET_PROTECTIONT - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IFD - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)T - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN D - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THENE - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') E - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')')A - ELSEE - WRITE (6,'('' Default is not stored.'')')E - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS) THENH - WRITE (6,'('' Expiration is DEFAULT value.'')')T - ELSED - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')') - END IF_ - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,)_ - IF (F1_EXPIRE_LIMIT.GT.0) THEN_ - WRITE (6,'('' Default expiration limit is '',A,''.'')'), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN U - WRITE (6,'('' Expiration limit is DEFAULT value.'')')I - ELSE - WRITE (6,'('' There is no default expiration limit.'')') - END IFE - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)T - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')')E - ELSEK - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)V - IF (FOLDER1_BBEXPIRE.GT.0) THENU - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSEN - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,)S - IF (F1_EXPIRE_LIMIT.GT.0) THENR - WRITE (6,'('' Expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no expiration limit.'')') - END IF( - IF (BTEST(FOLDER1_FLAG,1)) THENS - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - NOTIFY_FLAG_NEWS = .FALSE.M - SET_FLAG_NEWS = .FALSE. - BRIEF_FLAG_NEWS = .FALSE., - CALL OPEN_BULLINF_SHAREDC - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DOE - IF (IER1.EQ.0) THENU - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1D - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14)R - BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15)E - WRITE (6,'('' This is a default news group.'')') - ELSE - IER1 = 2 - END IF - END IFE - NOTIFY_PERM_FLAG_NEWS = .FALSE. - SET_PERM_FLAG_NEWS = .FALSE.E - BRIEF_PERM_FLAG_NEWS = .FALSE. - DO WHILE (REC_LOCK(IER2)) - READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC - END DOY - IF (IER2.EQ.0) THENT - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a permanent news group.'')')S - END IFE - END IFU - PERM = .FALSE. - IF (SET_FLAG_NEWS) THEN - IF (BRIEF_FLAG_NEWS) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEND - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSEW - WRITE (6,'('' Default is BRIEF.'')') - END IFR - ELSE( - IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE.2 - WRITE (6,'('' Default is READNEW, which is permanent.'')')N - ELSE - WRITE (6,'('' Default is READNEW.'')')_ - END IF - END IFG - ELSE IF (BRIEF_FLAG_NEWS) THEN - IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THENN - PERM = .TRUE.' - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')')_ - ELSE. - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - IF (.NOT.PERM) THENT - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (BRIEF_PERM_FLAG_NEWS.AND..NOT.SET_PERM_FLAG_NEWS) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF, - END IF - IF (NOTIFY_FLAG_NEWS) THEN - IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE IF (IER1.EQ.0) THENA - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' NOTIFY is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLINF - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1W - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS)K - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IFA - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWSW - RETURN - END IF - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP)E - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER)( - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) - END IF - FOUND = .FALSE.S - MODALL = INDEX(GROUP,'.').NE.LGE - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR. - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.'))1 - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN ) - CALL CLOSE_BULLNEWS( - FOLDER_NUMBER = FOLDER1_NUMBERR - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THENM - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETER - END IF - CALL OPEN_BULLNEWS_SHAREDI - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER) - F1_LAST = 0 - F1_COUNT = 0N - F1_START = 0 - F1_NBULL = 0C - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)E - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0T - F1_COUNT = 0B - F1_START = 0U - F1_NBULL = 0R - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0I - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRES - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)( - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER)A - END DOO - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP)I - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER)U - DELETE (7) R - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER)= - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER). - IF (.NOT.IER) THEN - FOLDER_NUMBER = 01 - CALL SELECT_FOLDER(.FALSE.,IER)A - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IFN - RETURNE - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0A - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0N - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)I - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)B - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - END DO - END IFA - - FOLDER_NUMBER = -1F - FOLDER1 = FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER))i - END IFE - - CALL CLOSE_BULLNEWS - - RETURN - ENDo - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLUSER.INC'I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFERS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMD - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'P - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH)S - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)i - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THENL - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IFN - - ALL = CLI$PRESENT('ALL')E - FULL = CLI$PRESENT('FULL')N - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURNS - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENs - IF (CLI$PRESENT('SUBJECT')) THENI - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)L - ELSEE - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IFR - ELSE - INPUT = FROM. - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:)L - ELSE= - INPUT = DESCRIP - END IFE - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (CLI$PRESENT('SUBJECT')) THENn - INPUT = 'SUBJECT:'//INPUT - ELSE - INPUT = 'FROM:'//INPUT - END IF - - IF (EXCLUDE) THEN - INPUT = ':EXCLUDE:'//INPUT - ELSEE - INPUT = ':INCLUDE:'//INPUT - END IFT - - FLEN = TRIM(FOLDER_NAME) - INPUT = FOLDER_NAME(:FLEN)//INPUT - - ILEN = TRIM(INPUT)S - DISABLE = CLI$PRESENT('DISABLE'), - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) - & WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)U - CLOSE (UNIT=4,DISPOSE='SAVE')T - RETURN - END IFA - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERE - IF (IER.EQ.0) THEN H - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THENS - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5)E - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill'( - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF (STREQ(OLD_BUFFER(:OLEN),INPUT(:ILEN))) THEN - IF (.NOT.DISABLE) THEN - WRITE (6,'('' ERROR: Entry already present.'')') - CLOSE (UNIT=4) " - CLOSE (UNIT=3) C - RETURN - END IFS - ELSE IF (.NOT.(ALL.AND.INPUT(:FLEN+8).EQ. - & OLD_BUFFER(:MIN(FLEN+8,OLEN)))) THEN - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN) - END IFI - END IF - END DO - - IF (.NOT.DISABLE) THENP - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)S - IF (FULL) WRITE (4,'(A)',IOSTAT=IER) - & FOLDER_NAME(:FLEN)//':defaults:kill' - END IFN - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL CHECK_CUSTOM - - RETURN - END' - - - - - SUBROUTINE SET_CUSTOM(PARAM)L -CI -C SUBROUTINE SET_CUSTOM -CI - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER*(*) PARAM - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'M - - CALL DISABLE_PRIVSS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH)T - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)E - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THENY - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IF) - - LENP = LEN(PARAM) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0.AND.PARAM(:LENP).NE.INPUT(2:LENP+1)) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)_ - END IF - END DOE - - IF (CLI$GET_VALUE('SET_PARAM2',INPUT,ILEN)) THENA - WRITE (4,'(A)',IOSTAT=IER) ':'//PARAM(:LENP)//':'//INPUT(:ILEN)G - END IF, - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL CHECK_CUSTOM - - RETURN - END' - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEW - DATA SCRATCH_B1/0/R - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORYE - CHARACTER*64 FILE_DIRECTORY - - FILE_DIRECTORY = ' 'P - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THENv - BULL_USER_CUSTOM = .FALSE. - ELSED - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IF - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - OPEN(UNIT=17,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURNE - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER)E - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IFT - - NINCLUDE = 0 - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ.T - & OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+1,OLEN))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1)N - CALL LOWERCASE(OLD_BUFFER)! - IF (INDEX(OLD_BUFFER(TRIM(FOLDER_NAME)+2:),'defaults')A - & .EQ.1) THENE - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1) - END IF - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THENA - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - IF (INDEX(OLD_BUFFER,':file_directory').GT.0) - & FILE_DIRECTORY = OLD_BUFFER(17:) - END IF - END DOE - - CLOSE (UNIT=17) - - RETURN - END - - - - - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1) - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./S - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEE - DATA SCRATCH_B1/0/ - - CHARACTER*(*) STRING,STRING1N - - INCLUDE_MSG = .TRUE. - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURNS - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME)L - - INC = .FALSE. - - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)I - OLEN = TRIM(OLD_BUFFER)I - IF (STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THEN - IF (.NOT.INC) INCLUDE_MSG = .FALSE. - INC = .TRUE.F - END IFU - C - MATCH = .FALSE. - IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:')) THEN - LS = TRIM(STRING) - IF (TRIM(OLD_BUFFER)-FLEN-14.GE.LS.AND. - & STREQ(STRING(:LS),OLD_BUFFER(FLEN+15:FLEN+14+LS)).AND.E - & (TRIM(OLD_BUFFER)-FLEN-14.EQ.LS.OR. - & INDEX('%@',OLD_BUFFER(FLEN+15+LS:FLEN+15+LS)).NE.0)) - & MATCH = .TRUE. - ELSE IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND. - & STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER - & (FLEN+18:OLEN))) THEN. - MATCH = .TRUE.C - END IF - IF (MATCH) THEN _ - INCLUDE_MSG = STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE') - IF (.NOT.INCLUDE_MSG) RETURNs - END IF - END IF - END DOE - - RETURNR - END - - - - FUNCTION STRFIND(STRING,STRING1). - - IMPLICIT INTEGER (A-Z)E - - CHARACTER*(*) STRING,STRING1I - - L = LEN(STRING1)= - DO I=0,LEN(STRING)-L - J = 1C - DO WHILE (J.LE.L) - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J)))' - IF (DIFF.NE.0.AND.DIFF.NE.32) THENE - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = .TRUE.V - RETURNR - ELSEE - J = J + 1 - END IFI - END DO - END DOE - - STRFIND = .FALSE. - - RETURNI - END - - - - - SUBROUTINE SET_NEWNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)I - COMMON /USERINFO/ LAST(2,FOLDER_MAX)S - - CHARACTER*12 NEW,OLD$ - - IF (.NOT.SETPRV_PRIV()) THEN2 - WRITE (6,'('' ERROR: No privs to set a new name.'')') - RETURN - END IF - - CALL CLI$GET_VALUE('OLDNAME',OLD,LENO) - CALL CLI$GET_VALUE('NEWNAME',NEW,LENN)( - - CALL OPEN_BULLUSER_SHARED - - TEMP_USER = USERNAME) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY - END DO - - IF (IER.EQ.0) THEN - USERNAME = NEW - DO WHILE (REC_LOCK(IER))$ - READ (4,IOSTAT=IER,KEYEQ=NEW) - END DO - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) USER_ENTRY - ELSE - REWRITE (4,IOSTAT=IER) USER_ENTRY - END IF ' - END IF - - USERNAME = TEMP_USERS - DO WHILE (REC_LOCK(IER1)) - READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY - END DO - - CALL CLOSE_BULLUSER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Old name not found.'')') - RETURN - END IFT - - CALL OPEN_BULLINF_SHAREDE - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER)L - END DO - IF (IER.NE.0) THENN - WRITE (9,IOSTAT=IER) NEW,LASTT - ELSE - REWRITE (9,IOSTAT=IER) NEW,LASTN - END IF - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THENL - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO U - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF T - ELSE - DO WHILE (REC_LOCK(IER))T - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IFU - OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO)))I - NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN)))N - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - IF (LENO.GT.1) THEN - OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1)))A - ELSEL - OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2)))B - END IFR - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - IF (LENN.GT.1) THEN - NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1)))E - ELSE - NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))): - END IFR - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER))E - READ (9,KEY=NEW,IOSTAT=IER) - END DO W - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER))T - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IFA - - CALL CLOSE_BULLINFa - - RETURN - ENDI diff --git a/decus/vms95a/bulletin/bulletin2.for b/decus/vms95a/bulletin/bulletin2.for deleted file mode 100644 index 3b17a9e..0000000 --- a/decus/vms95a/bulletin/bulletin2.for +++ /dev/null @@ -1,2388 +0,0 @@ -C -C BULLETIN2.FOR, Version 4/20/95 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::'.OR.NEWS_FEED()) THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'('' WARNING: Account used by other folder.'', - & '' If you specify the same account,'')') - WRITE (6,'('' you must specify the address'', - & '' of the mailing list in the folder description.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to make this change? ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) THEN - CALL CLOSE_BULLUSER - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'RE:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'RE: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Specified file cannot be opened.'')') - RETURN - END IF - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.EQ.0) THEN - INFROM = INPUT(:ILEN)//',' - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (MSG_OWN) THEN - ILEN = TRIM(INPUT) - 6 - INFROM = INFROM(:LENFRO)//INPUT(7:) - CALL ADD_PROTOCOL(INFROM(LENFRO+1:),ILEN) - LENFRO = LENFRO + ILEN - END IF - IF (EDIT.AND.TEXT) THEN - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:TRIM(INPUT)-1) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:TRIM(INPUT))//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_P = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LEN_P.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') BULL_PARAMETER(:LEN_P)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:)t - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THENn - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')p - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THENn - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSEE - IER = 0 - END IF - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME)I - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP)O - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')')i - END IF - END IFE - IF (IER.EQ.0.AND.LENFRO.GT.0) THENR - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS)_ - END IFN - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')o - IF (.NOT.FILESPEC) THEN - WRITE (6,'('' Enter message: End with ctrl-z,'',B - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input lineN - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too longE - WRITE(6,'('' ERROR: Input line length > '',I,U - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredH - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DON - ELSE - IER = 0 - ICOUNT = 0E - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUTE - IF (IER.EQ.0) THENB - ICOUNT = ICOUNT + 1L - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DOB - CLOSE (UNIT=4)N - FILESPEC = .FALSE.U - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,E - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IFD - CLOSE (UNIT=3)( - IF (IER.EQ.0.AND.LENFRO.GT.0) THENR - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS)E - END IF - END IF - END IF, - IF (IER.NE.0) THENU - WRITE (6,'('' ERROR: No message added.'')')( - IF (.NOT.STATUS) THENT - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ')Y - IF (STREQ(INPUT(:1),'Y')) THENE - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV') - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IFk - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')] - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -CC -C SUBROUTINE ADD_SIGNATUREF -CE -C FUNCTION: Adds signature to message being mailed/posted. -CC - IMPLICIT INTEGER (A-Z)D - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATUREO - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/H - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURNU - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED')h - END IFI - - IF (IER.NE.0) THEND - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED')A - END IF - - IF (IER.NE.0) RETURN - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IF - - ICOUNT = 0R - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUTI - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME)))E - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THENt - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUTN - ILEN = TRIM(INPUT) - END DO6 - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IFE - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE.L - ELSE= - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' 'I - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - END DOi - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURNz - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1)D - - IMPLICIT INTEGER (A-Z)E - - CHARACTER*(*) INPUT,INPUT1B - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.DIFF.NE.32) RETURN - END DOB - - STREQ = .TRUE.U - - RETURN0 - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -CS -C SUBROUTINE RESPOND_MAIL -C -C FUNCTION: Sends mail to address.i -C - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLUSER.INC'F - - INCLUDE 'BULLFOLDER.INC'L - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,INDESCRIP*(LINE_LENGTH)L - - PRIVS = FILE.NE.'SYS$LOGIN:BULL.SCR'W - - INDESCRIP = SUBJECT - LENDES = TRIM(INDESCRIP)) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES)S - IF (INDESCRIP(I:I).EQ.'"') THEN - IF (LENDES.EQ.LINE_LENGTH) THEN - INDESCRIP(I:I) = '`'o - ELSEh - INDESCRIP = INDESCRIP(:I)//'"'D - & //INDESCRIP(I+1:) - I = I + 1 - LENDES = LENDES + 1 - END IFI - END IF - I = I + 1U - END DOO - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0M - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0S - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD)N - IF (PRIVS) CALL DISABLE_PRIVS - - IF (LISTSERV) THENM - IF (SYS_TRNLNM('MX_NODE_NAME',MAILER)) THENS - REPLY_TO = .NOT.SYS_TRNLNM('MX_REPLY_TO',MAILER)2 - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - REPLY_TO = .NOT.SYS_TRNLNM('PMDF_REPLY_TO',MAILER)U - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - END IF - END IF. - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))//D - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)T - & //'""" """'//INDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IFT - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//INDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE - I = INDEX(SENDTO,'%""') + 3R - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THENO - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THEN1 - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THEN - SENDTO(I+1:) = '\'//SENDTO(I+1:)E - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN) - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IFM - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & INDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS)C -C -C Use the following if you do not have VMS V5.3 or greater.. -CT -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//1 -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//INDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IFN - - IF (PRIVS) CALL ENABLE_PRIVS - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV) THEN - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('PMDF_REPLY_TO') - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('MX_REPLY_TO') - END IF - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -CO -C FUNCTION CONFIRM_USER -CW -C FUNCTION: Confirms that username is valid user. -CN - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME) - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURNY - END - - - - - - SUBROUTINE REPLACE -CE -C SUBROUTINE REPLACES -C= -C FUNCTION: CHANGE command subroutine.B -CN - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'E - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWERR - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')')l - RETURN - END IFL - -CS -C Get the bulletin number to be replaced. -CL - - ALL = CLI$PRESENT('ALL')D - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN_ - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the errore - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are readinge - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entryS - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURNI - END IF - ELSEC - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN( - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IFi - ALL = .TRUE.' - ELSE IF (CLI$PRESENT('ALL')) THENL - SBULL = 1 - EBULL = NBULL - END IF - END IF) - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')')A - RETURNF - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')')R - RETURN0 - END IF - END IF6 - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')')X - RETURND - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THENF - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'',D - & '' permitted for remote folder.'')')( - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'(e - & '' ERROR: Not enough privileges to change to permanent.'')')t - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the userW -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL' - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. B - END DO) - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIRL - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner?m - WRITE(6,1090) ! If not, then error out.F - RETURN( - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IFE - -C -C If no switches were given, replace the full bulletinr -Cm - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND.D - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IFA - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN. - WRITE (6,'('' ERROR: Cannot change text when replacing'',N - & '' more than one messsage.'')')O - RETURN - END IFA - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THENA - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER)E - PERMANENT = BTEST(SYSTEM,1)O - IF (.NOT.IER) GO TO 910( - INEXDATE = INPUT(:11)U - INEXTIME = INPUT(13:23)S - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THENT - WRITE(6,1050) ! Request header for bulletinO - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES)R - END IFA - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIPh - LENDES = MIN(LENDES+6,LEN(INDESCRIP))I - END IFE - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBERD - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')')P - & NUMBER_PARAMS - WRITE(6,'('' All messages up to that message were modified.'')')h - RETURNa - END IF - END IF - - REC1 = 0 - - LENFROM = 0l - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,n - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')U - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)L - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)O - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(:ILEN) - LENFROM = ILENS - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEND - IF (LENDES.EQ.0.AND..NOT.DOALL) THENC - INDESCRIP = INPUT(:ILEN)F - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into fileI - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THENr -Cd -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C_ - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1_ - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN= - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specifiedl - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW',A - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST')a - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)h - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN_ - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file' - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IFB - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF. - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1')I - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN) - CALL DISABLE_PRIVS' - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',S - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THENR - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1p - END IF' - END IFR - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input lineI - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long.F - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANKY - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outD - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file.I -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entryE - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it.- - IF (IER.NE.NUMBER_PARAM+1) DATE = ' '' - NUMBER_PARAM = 0 - IER = 1_ - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER)) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find messageO - CALL CLOSE_BULLDIRN - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')')" - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')')v - END IF/ - GO TO 100 - END IF - END IF: - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced_ - - CALL OPEN_BULLFIL ! Prepare to add bulletinO - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK), - END IF - IF (LENDES.GT.0) THEN0 - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3)E - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.'N - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIRA - CLOSE (UNIT=3): - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER)I - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THENT - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry( - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE. - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THENN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description headerN - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT,I - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THENT - SYSTEM = IBCLR(SYSTEM,0)O - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0T - IF (CLI$PRESENT('SYSTEM').OR.S - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0)N - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THENO - MSGTYPE = IBSET(MSGTYPE,1)' - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2)E - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL)I - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP1 - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COMl - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I)" - END IFt - ELSE - CALL DISCONNECT_REMOTEO - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3)L - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURNF - -910 WRITE(6,1010)U - CLOSE (UNIT=3,ERR=100) - GOTO 100O - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100R - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)T - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.'), -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.',E - & ' Are you sure you want to replace it? ',$)L -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME)I - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENTR - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12- - - IF (EXPIRE) THENc - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header inR - NEWEST_EXTIME = EXTIME ! the directory file0 - CALL WRITEDIR(0,IER)n - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THENa - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER)O - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000'I - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN3 - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000'E - NODE_AREA = 0N - IF (INCMD(:4).EQ.'REPL') THENE - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THENC - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'',U - & '' Invalid node name specified.'')'). - END IF - END IF0 - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11A - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//N - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1T - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time, - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF) - - RETURNE - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -CN -C FUNCTION: Search for bulletin with specified string -CI - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10) - - EXTERNAL CLI$_ABSENTg - - NFOLDER = 1 - - IF (CLI$PRESENT('SELECT_FOLDER')) THENR - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0I - END IFX - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAMEI - NFOLDER = NFOLDER + 1N - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DOR - - IF (CLI$PRESENT('SELECT_FOLDER')) SCRATCH_F = SCRATCH_F1T - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified= - IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULLA - END IF - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IFN - - IF (CLI$PRESENT('NOREPLIES')) THENR - SEARCH_STRING = 'RE:'O - SEARCH_LEN(1) = 3L - SEARCH_NUM = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' '. - SEARCH_NUM = 1 - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1S - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM)O - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1 - ELSET - SEARCH_STRING = ' 'E - END IF - - MATCH_MODE = 00 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IFA - - IF (NFOLDER.GT.0) FOUND = 0 - - DO WHILE (NFOLDER.GT.0.AND.FOUND.LE.0)4 - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR.R - & SCRATCH_F.NE.SCRATCH_F1) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL,I - & CLI$PRESENT('REVERSE'),CLI$PRESENT('SUBJECT')U - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'),D - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),MATCH_MODE)S - IF (FOUND.EQ.-1) THENL - NFOLDER = 0 - ELSE IF (FOUND.LE.0) THENP - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1) NFOLDER = NFOLDER - 1C - IF (NFOLDER.GT.0) THENT - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME). - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0)T - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1I - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,Y - & FOLDER1_NAME)E - END IFT - END IF - END DOE - END IF2 - END IF - END DO) - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin( - ELSE IF (FOUND.EQ.0) THEN - WRITE (6,'('' No messages found with given search string.'')') - ELSE IF (FOUND.EQ.-2) THEN - WRITE (6,'('' ERROR: No more messages.'')')I - END IFN - - RETURNA - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN,M - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE)I -CI -C SUBROUTINE GET_SEARCH -CD -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z)M - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG/ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUP= - - COMMON /NEXT/ NEXT( - LOGICAL NEXTQ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*4 SAVECMD - - CHARACTER*56 DESCRIP1 - - FOUND = -1N - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_ASTT - - IF (TRIM(SEARCH_STRING).EQ.0) THEN: - IER1 = .FALSE. - ELSEL - IER1 = .TRUE.D - END IF - = - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THENI - ! If no search string enteredE - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')')L - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLL - RETURN( - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THENb - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - - END IFO - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THENI - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3$ - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THENR - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(START_BULL,IER) - IF (START_BULL+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLm - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (STREQ(DESCRIP(:4),'RE: ')) SEARCH_STRING = DESCRIP(5:)E - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2g - END IF - END IF - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.3 - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THENI - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN S - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last$ - END IF - IF (REVERSE) THENU - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1E - STEP_BULL = -1M - ELSE - END_BULL = NBULLT - STEP_BULL = 1 - END IF - END IFE - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IFR - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0 - BULL_SEARCH = START_BULL+1g - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR.m - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY) - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY)U - END IF= - ELSE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,T - & BULL_SEARCH,DUMMY)' - END IFh - IF (IER.EQ.0) THEN - IER = BULL_SEARCH + 1 - ELSEt - GO TO 800 - END IFN - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THENH - IF (SEARCH_MODE.EQ.4) THEN' - CALL STR$UPCASE(DESCRIP1,FROM) - ELSEt - CALL STR$UPCASE(DESCRIP1,DESCRIP). - END IFo - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1.AND. - & STREQ(DESCRIP1(:4),'RE: '))))) THEN - IF (.NOT.NEGATED) THENa - FOUND = BULL_SEARCH - GO TO 900b - END IF O - ELSE IF (FLAG.EQ.1) THEN! - WRITE (6,'('' Search aborted.'')')T - GO TO 900 - ELSE IF (NEGATED) THEN o - FOUND = BULL_SEARCH - GO TO 900 - END IFi - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTEI - GO TO 900R - ELSE - CALL GET_REMOTE_MESSAGE(IER). - IF (IER.GT.0) GO TO 900 - END IF - END IF. - ILEN = LINE_LENGTH + 1e - MATCHES = 0t - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE.B - END DO - DO WHILE (ILEN.GT.0). - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)R - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THENN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I)' - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR. - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THENL - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - GO TO 900G - END IF - END DOe - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THENo - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH, - GO TO 900 - ELSEF - FOUND = -1 - END IF - END IF, - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULLT - END DO - -800 FOUND = 0R - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - NEXT = .FALSE. - CALL READDIR(BULL_POINT,IER) - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTEU - ELSE - CALL GET_REMOTE_MESSAGE(IER)0 - END IF - END IFE - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file readS - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLL - - NEXT = .FALSE.T - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMDR - - RETURN - END - e - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE)e - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRINGE - T - OLD_MATCH = .FALSE.R - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURN' - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE.S - RETURN - END IF( - J = J + SEARCH_LEN(I)I - END DO' - - RETURNT - END - - - - SUBROUTINE UNDELETE -CO -C SUBROUTINE UNDELETE -CE -C FUNCTION: Undeletes deleted message.P -C - IMPLICIT INTEGER (A - Z)S - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'G - - INCLUDE 'BULLFOLDER.INC'E - - EXTERNAL CLI$_ABSENT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')') - RETURN - END IF) -CE -C Get the bulletin number to be undeleted.N -CF - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I)T - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error.E - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are readingl - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -CN -C Check to see if specified bulletin is present, and if the userN -C is permitted to delete the bulletin.) -CE - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?L - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IFI - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,S - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out., - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?E - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:)C - END IF - END IFR - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration dateo - WRITE (6,'('' Message was undeleted.'')')Z - ELSEC - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)R - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COMT - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I)D - ELSEC - WRITE (6,'('' Message was undeleted.'')')P - END IF, - ELSE - CALL DISCONNECT_REMOTEE - END IF - END IF_ - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020). - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.')' -1020 FORMAT(' ERROR: Specified message number has incorrect format.')e -1030 FORMAT(' ERROR: Specified message was not found.')A -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.')D - - END - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOLR - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - I = INDEX(INPUT,'<')D - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of formR - INPUT = INPUT(INDEX(INPUT,'<')+1:) ! personal-name E - END IFR - - IF (LMAIL.EQ.0) THENs - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THENE - MAIL_PROTOCOL = MAILERD - END IF - LMAIL = TRIM(MAIL_PROTOCOL) - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%'o - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1 - RETURN_ - END IF - END IF, - - I = INDEX(INPUT,'@') - IF (I.GT.0) INPUT = INPUT(:INDEX(INPUT(I:),' ')+I-2)T - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"'o - - IF (ILEN.NE.0) ILEN = TRIM(INPUT) - - RETURN - END diff --git a/decus/vms95a/bulletin/bulletin3.for b/decus/vms95a/bulletin/bulletin3.for deleted file mode 100644 index 56b6f79..0000000 --- a/decus/vms95a/bulletin/bulletin3.for +++ /dev/null @@ -1,2469 +0,0 @@ -C -C BULLETIN3.FOR, Version 5/8/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_EDT' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THEN - CALL EDT$EDIT('NL:',OUT) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT) - ELSE - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IF - END IF - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT - ELSE - WRITE(6,'('' Could not activate editor.'')') - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE) - - RETURN - END - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - NOW = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - IF (.NOT.NOW) NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m.E - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IFE - END IFM - END IF - END IF. - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)g - END IF - CALL SYS$SETAST(%VAL(1))o - END DOn - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IFb - CALL SYS$SETAST(%VAL(0))l - CALL REGISTER_BULLCPu - IER1 = 1e - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IFS - END DOG - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1))T - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - - BBOARD_LOOP = BBOARD_LOOP + 1O - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND.0 - & (NEWS_LOOP.EQ.0.OR.NOW)) THEN - IF (NOW) THEN - CALL CREATE_PROCESS('BULLCP NEWS1') - ELSE - CALL CREATE_PROCESS('BULLCP NEWS') - END IF- - END IFe - CALL SYS$SETAST(%VAL(1)) - - NOW = .FALSE.! - - NEWS_LOOP = NEWS_LOOP + 1 - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIMEO - CALL HIBER('15') ! Wait for 15 minutes -Ce -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folderO -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IFn - CALL SYS$SETAST(%VAL(1))H - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folderM - CALL SELECT_FOLDER(.FALSE.,IER)_ - CALL SYS$SETAST(%VAL(1)) - END DO) - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEMA - - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'E - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8T - - DIMENSION NEW_SYSTEM_FLAG(FLONG) - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)s - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2)) - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER) - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN) - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,e - & BTEST(FOLDER_FLAG,2),NODENAME - END IFx - CALL SETUSER(USERNAME)e - CALL OPEN_BULLFOLDER_SHAREDE - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DOO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAGa - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2)T - CALL MODIFY_SYSTEM_LIST(0)T - END IF - END DO - FOLDER_FLAG = FOLDER1_FLAG - FOLDER_NUMBER = 0 - - RETURNT - END - - - - - SUBROUTINE REGISTER_BULLCPO - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'T - - INTEGER SHUTDOWN_BTIM(FLONG)I - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)T - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSERM - - DO WHILE (REC_LOCK(IER))E - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG,I - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG_ - END DOL - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)O - - IF (IER.NE.0) THEN= - DO I=1,FLONG - SYSTEM_FLAG(I) = 0E - SHUTDOWN_FLAG(I) = 0a - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,t - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG! - CALL CLOSE_BULLUSER - ELSE - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGL - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURNS - END IF - TEMP_USER = ':'P - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DON - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURNM - END IFG - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"') - - IF (IER.NE.0) THENE - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR.. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN_ - DELETE (4) - END IF - ELSES - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IF - CLOSE (UNIT=REMOTE_UNIT)a - END DO - END IF - - RETURNE - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)L - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSERE - - DO WHILE (REC_LOCK(IER)), - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG_ - END DO( - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER)O - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGI - ELSE2 - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGI - END IF_ - - CALL CLOSE_BULLUSER - - RETURNM - END - - - - - - SUBROUTINE HIBER(MIN) -CD -C SUBROUTINE HIBER -CI -C FUNCTION: Waits for specified time period in minutes.w -C - IMPLICIT INTEGER (A-Z)T - INTEGER TIMADR(2) ! Buffer containing timeO - ! in desired system format.O - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURNe - END - - - - SUBROUTINE WAIT_SEC(PARAM)I -C -C SUBROUTINE WAIT_SECi -Ct -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z)T - INTEGER TIMADR(2) ! Buffer containing timeI - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/e - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF)p - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer.o - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set.d - - RETURNh - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -Ct -C SUBROUTINE DELETE_EXPIRED_NEWSL -CR -C FUNCTION: -Co -C Delete any expired message in local news folders. -Ce - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC'S - - INCLUDE 'BULLDIR.INC'E - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - CHARACTER*4 GET_VMS_VERSION - - INTEGER TODAY(2),NEXT_EX_BTIM(2),NO_EXPIRE(2) - - CHARACTER*8 TODAY_KEY,TEMPN - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - IF (.NOT.NOW) THEN - IER = SYS$SETPRN('BULL NEWS1')t - IF (.NOT.IER) CALL EXIT! - IER = SYS$SETPRN('BULL NEWS')N - IF (.NOT.IER) CALL EXIT - END IF - - FOLDER_NUMBER = 1000L - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER))I - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DOR - - IF (IER.NE.0) THENB - CALL CLOSE_BULLNEWST - RETURN - END IFN - - CALL SYS_BINTIM('-',TODAY)S - I - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - REMOTE_SET = 4. - ' - INPUT = GET_VMS_VERSION() - IF (INPUT(:2).EQ.'V5'.OR.INPUT(:2).EQ.'V4') VMSOLD = .TRUE..AND.NOW - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER).OR.(VMSOLD.AND.IER.EQ.0.AND. - & (.NOT.BTEST(NEWS_F_FLAG,8).OR. - & COMPARE_BTIM(TODAY,NEWEST_EXBTIM).LT.0))) - IF (VMSOLD) THEN0 - READ (7,IOSTAT=IER) NEWS_FOLDER_COMD - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM))e - ELSEO - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END IFE - END DO - CALL NEWS_TO_FOLDER - - UNLOCK 7 - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - GO TO 1000. - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,8)) GO TO 900 - - CALL OPEN_BULLDIR_SHARED - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0 - NDEL = -1F - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM) - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. e - IF (NDEL.GT.NEWS_F_END) THENT - CALL READ_NEXT_EXPIRED(NDEL)T - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1H - CALL READ_NEXT_EXPIRED(NDEL)E - ELSE IF (EXDATE(8:9).EQ.'18'.OR. ! Deleted manually? - & INDEX(EXDATE,'1900').GT.0) THEN - IF (LENGTH.GT.0) CALL DUMP_MESSAGE()I - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) - EXTIME = ASCTIME(13:23) - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0R - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) S - END IF - ELSEa - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM)L - END IFX - NDEL = 0D - UNLOCK 2N - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER)e - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_STARTE - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - IF (I.LE.F_NBULL) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0D - END DO - F_START = IG - NEXT = .FALSE.? - END IF - CALL READDIR(F_NBULL,IER) - IF (F_START.LT.F_NBULL.AND.(DN.OR.F_NBULL.EQ.IER)) THENI - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I)P - I = I - 1 - IF (I.GE.F_START) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = II - END DO. - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM)e - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13)M - CALL REWRITE_FOLDER_FILE(IER)I - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2)G - CALL READ_FIRST_EXPIRED(NDEL) - END DOO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLDIR= - END DOT - -900 CALL CLOSE_BULLNEWS - -1000 IF (NOW.OR.IER.EQ.0) THEN - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.*]'//'*.' - INPUT = GET_VMS_VERSION()I - CALL LIB$DAY_OF_WEEK(TODAY,DAY)M - IF (DAY.NE.7) THEN - IER = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - IF (IER) THEN - DAY = 7 - CALL DELLNM('BULL_NEWS_CLEANUP') - END IFR - END IF - IF (INPUT(:2).NE.'V5'.AND.INPUT(:2).NE.'V4') THENF - CONTEXT = 0 - DO WHILE (LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT))i - IER = CONV$RECLAIM(INPUT(:TRIM(INPUT)))r - END DO - ELSE IF (DAY.EQ.7) THENy - REMOTE_SET = 4, - DIRLIST = .TRUE.I - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(1000,IER)d - CALL READ_FOLDER_FILE(IER)I - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NO_EXPIRE) - DO WHILE (IER.EQ.0) - UNLOCK 7 - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - IF (BTEST(FOLDER_FLAG,8)) THENF - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - C = 0) - IF (LIB$FIND_FILE(BULLNEWSDIR_FILED - & (:TRIM(BULLNEWSDIR_FILE))//';1',INPUT,C)) THENS - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';2')A - ELSE - IER = LIB$RENAME_FILE(A - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1')T - END IF - CALL OPEN_BULLDIR_SHARED - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE,SHARED, - & BUFFERCOUNT=127, - & INITIALSIZE=(NEWSDIR_RECORD_LENGTH*F_COUNT)/512,V - & STATUS='NEW',FORM='UNFORMATTED',DISPOSE='DELETE',A - & RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,IOSTAT=IER, - & ORGANIZATION='INDEXED',RECORDTYPE='FIXED', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIRE - CALL CLOSE_BULLNEWS - RETURNN - END IF - DO WHILE (IER.EQ.0)Q - DO WHILE (REC_LOCK(IER))L - READ (2,IOSTAT=IER) NEWSDIR_ENTRYI - END DO - IF (IER.EQ.0) THENI - WRITE (9,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWSI - RETURND - ELSET - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY), - & %DESCR(EX_BTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & CALL COPY2(NEWEST_EXBTIM,EX_BTIM) - END IF - END IFL - END DO - CLOSE (UNIT=9,DISPOSE='KEEP') - CALL CLOSE_BULLDIR_DELETEI - CALL GET_MSGKEY(NEWEST_EXBTIM,TEMP)/ - IF (TEMP.NE.NEWS_F_EXPIRED_DATE) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - NEWS_F_EXPIRED_DATE = TEMPF - CALL REWRITE_FOLDER_FILE(IER) - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - END IF - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1')o - ELSEe - IF (NO_EXPIRE(1).NE.NEWEST_EXBTIM(1).OR. - & NO_EXPIRE(2).NE.NEWEST_EXBTIM(2)) THEN - CALL GET_MSGKEY(NO_EXPIRE,NEWS_F_EXPIRED_DATE)& - CALL REWRITE_FOLDER_FILE(IER)D - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - ELSE E - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER)_ - END IF - IER = 1T - DO WHILE (IER) - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';') - END DO - END IF - CALL READ_FOLDER_FILE(IER) - END DOE - CALL CLOSE_BULLNEWS - END IF - DIRLIST = .FALSE. - NEWSLIST = .TRUE.E - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - DO I=1,31 - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;')N - END DO - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IFE - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED -CX -C SUBROUTINE DELETE_EXPIRED -CI -C FUNCTION: -CE -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record sizeL -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and' -C was replaced with a 128 byte record compressed format). -CE - - IMPLICIT INTEGER (A-Z)P - - INCLUDE 'BULLUSER.INC'_ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)E - - CALL OPEN_BULLDIR_SHARED ! Open directory fileE - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present?n - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls?S - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')B - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.i - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked?B - SHUTDOWN = 0F - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENS - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IFe - IER1 = 1' - END IF - IF (IER.LE.0.OR.IER1.LE.0) THENS - CALL CLOSE_BULLDIR' - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to updateA - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc.L - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENi - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)s - END IFs - END IFu - CALL CLOSE_BULLDIRa - - RETURNi - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -Ce -C FUNCTION: Converts mail to BBOARD into non-system bulletins.S -CE - - IMPLICIT INTEGER (A-Z)i - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'& - - INCLUDE 'BULLFOLDER.INC'R - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS' - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP( - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76, - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX)O - - DATA SPAWN_EF/0/,HEADER_Q1/0/ - - CALL SYS$SETAST(%VAL(0))E - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF)0 - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(HEADER_Q1,INPUT)o - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1f - - CALL OPEN_BULLFOLDER_SHARED ! Get folder fileR - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from fileO - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO1 - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 9001 - - CALL SYS$SETAST(%VAL(0))) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1))R - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1E - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900u - - CALL SYS$SETAST(%VAL(0))T - - FOLDER_Q_SAVE = FOLDER_Qd - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1E -C -C The process is set to the BBOARD uic and username in order to createL -C a spawned process that is able to read the BBOARD mail (a real kludge). -CP - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD accountR - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uicM - END IFF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)//W - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errorsU - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF), - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)E - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT'< - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV'P - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)//E - & '''F$GETJPI("","USERNAME")''', - WRITE(11,'(A)') '$ MAIL'N - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ'A - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL'5 - WRITE(11,'(A)') 'READ/NEW'I - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL'I - WRITE(11,'(A)') 'SELECT/NEW'S - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection& - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)E - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1))O - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))P - CALL SYS$SETAST(%VAL(0)) - END IF - ELSEM - CONTEXT = 0I - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARDL - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN: - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//f - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0))m - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//T - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))L - CALL SYS$SETAST(%VAL(0))A - END IF - END IF) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM)L - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original accountY - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD= - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1))A - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store usernameR - ELSE IF (INPUT(:5).EQ.'Subj:') THEN) - INDESCRIP = INPUT(7:) ! Store subjectD - ELSE IF (INPUT(:3).EQ.'To:') THENO - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DOS - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO)S - CALL STR$UPCASE(INTO,INTO)E - FLEN = TRIM(FOLDER_BBOARD)O - HEADER_Q = 0( - NHEAD = 0 - -CT -C If more than one folder has same BBOARD account, don't use the -C To: line to determine which folder to put the mail message in.e -Cc - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - DUP = .FALSE. - DO WHILE (.NOT.DUP.AND.POINT_FOLDER1.LT.NUM_FOLDERS)i - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1O - DUP = FOLDER.NE.FOLDER1.AND.FOLDER_BBOARD.EQ.FOLDER1_BBOARD1 - END DOC - IF (DUP.OR..NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THENO - HEADER_Q = HEADER_Q1 - IER = 0B - CALL STRIP_HEADER(' ',0,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP)$ - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTL - IF (IER.EQ.0) THEN - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP)_ - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - NHEAD = NHEAD + 1 - END IF - END DO - - FOUND = .FALSE.I - J = 0E - IF (DUP) J = 1 - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS)S - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM)M - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THENA - IF (J.EQ.2) THEN - F_BBOARD = FOLDER1_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP). - END IF - FLEN = TRIM(F_BBOARD) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN))F - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN) - HEADER_Q = HEADER_Q1( - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN))L - I = I + 1 - END DO - END IF - END IF - END DOR - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COMC - END IFT - - IF (NHEAD.EQ.0) THENF - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - ELSE( - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT)E - NHEAD = NHEAD - 1L - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0)= - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5O - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the dateN - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" lineW - I = I - 1G - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER)E - - ISTART = 0T - NBLANK = 0R - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IFD - ELSE - ISTART = 12 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ')O - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT)N - END IF - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT* - ELSE - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)Y - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)P - & .AND.IER.EQ.0)R - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTN - END DOF - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO( - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1))P - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file: - CALL SYS$SETAST(%VAL(1))D - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL6 - FOLDER_SET = .FALSE.S - - IF (NBBOARD_FOLDERS.EQ.0) THENE - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER), - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM). - REWRITE (4) USER_HEADER ! Rewrite header. - CALL CLOSE_BULLUSER - END IF( - CALL SYS$SETAST(%VAL(1))S - - CALL SYS$SETAST(%VAL(0))' - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEND - CALL SYS$SETAST(%VAL(1)) - IF (.NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) - & CALL NEWS2BULL(.FALSE.)W - END IFN - CALL SYS$SETAST(%VAL(1)) - - RETURNI - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.')O - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD)N - - IMPLICIT INTEGER (A-Z)/ - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE.O - - LEN_BBOARD = LEN(BBOARD) - 1D - - DO I=1,TRIM(INPUT)-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND.P - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND.D - & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR.B - & (INDEX('@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0N - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE.E - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND. - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURNN - END - - - - LOGICAL FUNCTION ALPHA(IN)) - - CHARACTER*(*) INO - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURN - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP)p - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURNe - - BBOARD_NAME = FOLDER_DESCRIP(I+1:)S - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!')R - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:)U - I = INDEX(BBOARD_NAME,'!') - END DO - - I = INDEX(BBOARD_NAME,'>')s - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@')t - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%')E - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND)I - - IMPLICIT INTEGER (A-Z), - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY)n - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)E - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')R - IF (IER.NE.0) RETURNA - IF (INDEX(IMAGENAME,';').GT.0) ILEN = INDEX(IMAGENAME,';')O - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT'M - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT'B - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:'N - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionI - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0)D - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',,E - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - IF (.NOT.IER.AND..NOT.DEL) THENI - CALL DELPRC('BULLCP NEWS',DEL)V - IER = .NOT.DEL - ELSE - IER = .TRUE.L - END IF - END DO5 - - RETURN0 - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI). -C( -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z)F - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL ADD_2_ITMLST(4,JPI$_ENQLM,%LOC(ENQLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistR - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2))_ - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENTD - END IF - END IFP - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2))l - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2))D - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2))1 - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_ENQLM - CALL LIB$MOVC3(4,ENQLM,QUOTA((I-1)*5+2))U - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2)) - - RETURN - END - _ - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC)( -CT -C FUNCTION: -C To get UIC of process submitting the job.D -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UICM -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listE - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN1 - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)I -CX -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z)? - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST)_ - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - CHARACTER*4 FUNCTION GET_VMS_VERSION_ -CN -C FUNCTION GET_VMS_VERSION) -C -C FUNCTION: Gets VMS version -CR - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER VERSION*4 - - CALL INIT_ITMLSTE - CALL ADD_2_ITMLST(4,SYI$_NODE_SWVERS,%LOC(VERSION)) - CALL END_ITMLST(GETSYI_ITMLST)N - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - GET_VMS_VERSION = VERSION - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURNA - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLFOLDER.INC'F - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSE - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERST - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)N - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO) - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IFO - END DO - END IF. - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THENP - NEW_MAIL(I) = .TRUE.% - ELSEE - NEW_MAIL(I) = .FALSE. - END IFE - ELSE - NEW_MAIL(I) = .TRUE.D - END IF - END DO - - CLOSE (10) - - RETURNN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN)S -C_ -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process.N -C OUTPUT: -C IMAGNAME - Image name of processL -C ILEN - Length of imagenameE -C - - IMPLICIT INTEGER (A-Z)T - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listE - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN))) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist, - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN= - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START)P - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2)Y - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START)L - ELSE_ - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURNR - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DOS - - CALL CLOSE_BULLDIR' - - RETURNA - END - - - - - - SUBROUTINE READ_NOTIFYM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'R - - INCLUDE 'BULLUSER.INC'L - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER))R - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE( - END DOM - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0D - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTEE - END IFN - - CALL CLOSE_BULLDIR - - RETURNO - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAMI - - DATA OBIO/0/,OCPU/0/,ODIO/0/L - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAML - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - O - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU))U - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IFE - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1 - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM)E - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.D - END DO - END IF - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND.R - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIO - ODIO = DIOE - OCPU = CPUi - IER = 0 - RETURNw - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IFv - RETURN. - END diff --git a/decus/vms95a/bulletin/bulletin4.for b/decus/vms95a/bulletin/bulletin4.for deleted file mode 100644 index f75e6ae..0000000 --- a/decus/vms95a/bulletin/bulletin4.for +++ /dev/null @@ -1,2205 +0,0 @@ -C -C BULLETIN4.FOR, Version 4/19/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(BUFFER,0,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' ') THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - ELSE - IF (.NOT.HEADER) THEN - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - STRIP = .FALSE. - END IF - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN( - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -Ch -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal.n -Cy -C OUTPUTS:- -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -Ci - - IMPLICIT INTEGER (A-Z)t - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTHs - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/z - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITE - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE.J - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT)T - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE andl -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1e -Ca - - CALL DECLARE_CTRLC_ASTM - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -CA - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTR - IF (IER.NE.0) LEN_INPUT = -2 E - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with promptm - ELSEw - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no promptn - END IFt - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER)i - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input?f - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DOI - CALL CONVERT_TABS(INPUT,LEN_INPUT)I - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so1 - END IF - ELSEt - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURNr - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT), - - IMPLICIT INTEGER (A-Z)& - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT)A - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THENM - INPUT(MOVE:) = INPUT(TAB_POINT+1:)y - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DOo - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMITM - INPUT(I:I) = ' ' - END DOA - LEN_INPUT = LIMIT+1 - END IF - END DOV - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN, - END - - - SUBROUTINE FILTER (INCHAR, LENGTH), - - IMPLICIT INTEGER (A-Z)M - - CHARACTER*(*) INCHARi - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURNS - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logicalN - CHARACTER*(*) OUTPUT ! byte to character valueD - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT)S - RETURNI - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routineO - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLYR - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...')g - CALL SYS$CANEXH()e - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IFT - FLAG = 1 ! to set flag - RETURN( - END - - - - SUBROUTINE DECLARE_CTRLC_AST, -CF -C SUBROUTINE DECLARE_CTRLC_AST, -C -C FUNCTION: -C Declares a CTRLC ast.M -C NOTES:Y -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/.A -C4 - IMPLICIT INTEGER (A-Z)M - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINEM - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAGE - - FLAG = 0 ! Init CTRL-C flagP - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIOr - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURNy - - ENTRY CANCEL_CTRLC_AST_ - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURNR - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C' -C SUBROUTINE GET_INPUT_NOECHO -CA -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -CI - IMPLICIT INTEGER (A-Z)9 - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGT - - COMMON /READIT/ READIT. - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2)R - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/R - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA)L - DATA(I:I) = ' 'D - END DOC - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),L - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.T - ELSEm - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),x - & TRM$M_TM_NOECHO) - END IF - - RETURN' - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT)R - - DO I=1,LEN(DATA)A - DATA(I:I) = ' 'M - END DOD - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),M - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.N - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),L - & TRM$M_TM_NOECHO) - END IFI - - RETURND - - ENTRY GET_INPUT_NUM(DATA,NLEN)L - - DO I=1,LEN(DATA)( - DATA(I:I) = ' 'T - END DOF - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),. - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE.e - ELSEs - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,,= - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THENo - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM)I - END IFT - - RETURN) - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST9 - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20)) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID)= - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)E - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPADE - ELSE IF (READIT.EQ.0) THEN) - CALL SET_NOKEYPADM - END IF- - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32)R - END DO( - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH). -C0 -C SUBROUTINE GETPAGSIZD -C -C FUNCTION: -C Gets page size of the terminal.1 -C -C OUTPUTS:( -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -CI - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4)R - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH))E - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,)I - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132)I - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL) -CN -C FUNCTION SLOW_TERMINALE -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less).) -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not.) -C - - IMPLICIT INTEGER (A-Z)E - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2)S - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)'L - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,)U - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THEN - SLOW_TERMINAL = .TRUE. - ELSEe - SLOW_TERMINAL = .FALSE. - END IFn - - RETURN - END - - - - - SUBROUTINE SHOW_PRIVn -Ce -C SUBROUTINE SHOW_PRIVa -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -CE - - IMPLICIT INTEGER (A-Z)b - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not presentN - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT fileA - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRVI - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR.. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THENI - WRITE (6,'(1X,A)') PRIVS(I) - END IFI - END DO - ELSEH - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IFI - - CALL CLOSE_BULLUSER ! All finished with BULLUSER) - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER)I - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)))B - END IFN - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z)N - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'S - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVSN - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA',D - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/0 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2)S - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THENI - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IFO - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THENT - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN)+ - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSEI - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER)/ - END DO - RETURN - END IFU - - OFFPRIV(1) = 0I - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privilegesI - PRIV_FOUND = -11 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1)I - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = IU - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THENT - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN( - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSED - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)U - END IFT - ELSE - IF (PRIV_FOUND.LT.32) THEN( - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32)( - END IFB - END IF - END DOI - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1))A - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2))H - REWRITE (4) USER_HEADERS - WRITE (6,'('' Privileges successfully modified.'')') - ELSE= - WRITE (6,'('' ERROR: Cannot modify privileges.'')'). - END IFN - - CALL CLOSE_BULLUSER ! All finished with BULLUSERT - - RETURNK - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C1 -C SUBROUTINE ADD_ACL. -C -C FUNCTION: Adds ACL to bulletin files. -CE -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.E -C IER - Return error from attempting to set ACL. -C. -C NOTE: The ID must be in the RIGHTS data base. -Cc - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256I - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)'F - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS='. - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THENR - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THENe - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')')E - CALL SYS_GETMSG(IER) - RETURN - END IFI - IDENT = USER + ISHFT(GROUP,16)N - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,)= - END IF - END IF - END IF - IF (.NOT.IER) RETURN3 - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(N - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)L - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP)R - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE, - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,)B - END IF. - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -CR -C SUBROUTINE DEL_ACL -CN -C FUNCTION: Adds ACL to bulletin files. -CL -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.T -C IER - Return error from attempting to set ACL. -CE -C NOTE: The ID must be in the RIGHTS data base. -Cp - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLFOLDER.INC'I - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT))e - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistr - ELSEr - CALL INIT_ITMLST ! Initialize item listt - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistA - END IFI - - IF (INDEX(ACCESS,'C').GT.0) THENA - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(D - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)D - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE! - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IFT - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDERM -C4 -C SUBROUTINE CREATE_FOLDERC -C' -C FUNCTION: Creates a new bulletin folder.a -Cr - - IMPLICIT INTEGER (A-Z)1 - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'M - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER! - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THENN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IFT - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - CALL STR$UPCASE(FOLDER,FOLDER) - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')')D - RETURN - END IF) - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR.N - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')')F - RETURN - END IF) - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified?Q - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node nameM - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDERF - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '',h - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAXE - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)a - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURNL - ELSE IF (CLI$PRESENT('SYSTEM').AND.l - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'',r - & '' is not SYSTEM folder.'')') - RETURNR - END IF - END IFl - - LENDES = 0 - DO WHILE (LENDES.EQ.0)e - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES)= - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THENP - WRITE (6,'('' Aborting folder creation.'')') - RETURNI - ELSE IF (LENDES.GT.80) THEN ! If too many charactersR - WRITE(6,'('' ERROR: folder must be < 80 characters.'')')e - LENDES = 0r - END IF - END DOe - - CALL OPEN_BULLFOLDER ! Open folder filee - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder existsl - - IF (IER.EQ.0) THENe - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IFE - - IF (CLI$PRESENT('OWNER')) THENT - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THENO - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDERE - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF' - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER)R - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSEL - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF' - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)E - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder._ -CG - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910T - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDERO - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))E - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THENI - WRITE(6,'('' ERROR: Cannot create folder directory file.'')')F - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910, - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,I - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THENQ - WRITE(6,'('' ERROR: Cannot create folder message file.'')')I - CALL ERRSNS(IDUMMY,IER)L - CALL SYS_GETMSG(IER) - GO TO 910 - END IFE - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THENj - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACL) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)3 - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))E - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1)( - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))S - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1)N - IF (.NOT.IER) THEN - WRITE(6,e - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER)E - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF' - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1)L - LAST_NUMBER = LAST_NUMBER + 1p - END DOt - - IF (IER.EQ.0) THENE - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')')r - & FOLDER_MAXH - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSED - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IFF - - IF (.NOT.CLI$PRESENT('NODE')) THENi - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0D - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSEt - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name?3 - REMOTE_SET = .FALSE.r - CALL OPEN_BULLDIR ! If so, store name in directory filem - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR( - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0)+ - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULLT - END IFY - - FOLDER_NAME = FOLDER - FOLDER_OWNER = FOLDER1_OWNERY - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12)t - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0)t - - CLOSE (UNIT=1) - CLOSE (UNIT=2)E - - NOTIFY = 0G - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1L - READNEW = 1, - END IFP - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)')R - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000M - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE')T - CLOSE (UNIT=2,STATUS='DELETE')M - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection' - - RETURNa - - END - - - - INTEGER FUNCTION CHKPRO(INPUT)A -Cw -C Description:T -C Parse given identify into binary ACL format.R -C Call SYS$CHKPRO to check if present process has readS -C access to an object if the object's protection is the ACL.T -CP - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))//, - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can'tH - - FLAGS = CHP$M_READ ! Specify read access checkingB - - CALL INIT_ITMLST ! Initialize item listr - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has theI - ! rights-id assigned to it - RETURNI - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -Ca -C SUBROUTINE CREATE_NEWS_FOLDER -C -C FUNCTION: Creates a new newsgroup.O -CM - - IMPLICIT INTEGER (A-Z)t - - INCLUDE 'BULLFOLDER.INC'M - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT, - DATA EDIT_DEFAULT/.FALSE./D - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME)T - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED')s - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesO - END IFP -CT -C If file specified in command, read file.T -C Else, read from the terminal. -CD - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specifiedD - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',= - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3)N - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')R - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',. - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')I - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTHe - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredl - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch fileF -2010 FORMAT(A)T - ICOUNT = ICOUNT + ILEN - END IFR - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error outE - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER,A - & 'Adding newsgroup.')P - CLOSE (UNIT=3)C - - RETURNE - -920 WRITE(6,1020) -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURN - -910 WRITE(6,1010), -1010 FORMAT (' No news group was added.')C - CLOSE (UNIT=3) - RETURNS - - END - - - - - SUBROUTINE INIT_COMPRESSI - - IMPLICIT INTEGER (A-Z)c - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127A - DO J=0,127 - A(J,I) = ' ' - END DO - END DO - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DOE - A - J = 1 - DO I=1,8 - J = J + 1F - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO$ - DO I=10,31E - J = J + 1) - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)D - END DO - DO I=127,254, - J = J + 1D - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)o - END DOh - - RETURNe - - ENTRY COMPRESS(IN,OUT,O)A - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.126) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.126) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:)))u - IF (T(O:O).NE.' ') THENT - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND.R - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1)) - C = C + 1 - K = K + 1 - END DO1 - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1)) - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0) - O = O + 1 - ELSE - T(O:O) = IN(K:K) - IF (ICHAR(T(O:O)).LT.9.OR.(ICHAR(T(O:O)).GT.9.AND.n - & ICHAR(T(O:O)).LT.32)) T(O:O) = ' 'e - K = K + 1 - O = O + 1 - END IF - END DOt - IF (K.EQ.L) THENI - T(O:O) = IN(K:K) - ELSEC - O = O - 1' - END IFC - - OUT = T - - RETURNC - - ENTRY UNCOMPRESS(IN,OUT,O)e - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1! - T(O:O) = IN(I+2:I+2) - END DO, - I = I + 3 - ELSEP - B = UNMAP(J)D - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1D - T(O:O) = IN(I:I)T - ELSE - O = O + 2I - T(O-1:O) = B - END IFt - I = I + 1 - END IF - END DOr - - OUT = T(:O) - - RETURN - END diff --git a/decus/vms95a/bulletin/bulletin5.for b/decus/vms95a/bulletin/bulletin5.for deleted file mode 100644 index b15027b..0000000 --- a/decus/vms95a/bulletin/bulletin5.for +++ /dev/null @@ -1,2434 +0,0 @@ -C -C BULLETIN5.FOR, Version 11/28/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3) THEN - CALL SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - RETURN - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - NODEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (NODEFAULT) THEN - IF (NOTIFY.NE.-1) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) THEN - CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - END IF - REWRITE(4) USER_HEADER - ELSE IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & (FOLDER1_NUMBER.EQ.0.AND.FOLDER1_BBOARD(:2).NE.'::')) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - IF (FOLDER1_NUMBER.NE.0.OR.FOLDER1_BBOARD(:2).NE.'::') THEN - ! Test is due to bug which changes folder number to zero - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG - IF (BTEST(FOLDER1_FLAG,2)) THEN - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAG - FOLDER_NUMBER = TEMP_NUMBER - END IF - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & (F1_START.GT.0.OR.F_START.LE.F_NBULL)) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_COUNT = F1_COUNT - IF (F1_START.GT.0) THEN - IF (F1_NBULL.LT.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER-1.GE.F1_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - ELSE - F_NBULL = F1_NBULL - END IF - F_START = F1_START - ELSE - F_START = F_NBULL + 1 - END IF - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - REMOTE_SET_NEW = 1 - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - IF (COMMAND.AND.INCMD(:3).NE.'REP'.AND. - & INCMD(:3).NE.'DEL') HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER1) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.IER1.EQ.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11)) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<')B - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '',( - & ''message to this folder''''s news group.'')')g - ELSE IF (SLIST.GT.0) THENn - WRITE (6,'('' Use the POST command to send a '',i - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IFN - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THENI - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:)A - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')')i - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'',I - & '' active. It has been replaced by:'')')H - WRITE (6,'(1X,A)') FOLDER_DESCRIP(R - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THENR - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THENI - WRITE (6,'('' Folder only accessible for reading.'')') - END IF. - READ_ONLY = .TRUE. - ELSEF - READ_ONLY = .FALSE. - END IFE - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THENA - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THENE - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DATL - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.E - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2))( - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEND - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IFE - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THENY - CALL UPDATE ! Need to updateB - END IF - ELSEI - NBULL = 02 - END IFG - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IFE - - IF (OUTPUT) THENL - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1)L - BULL_PARAMETER = 'MARKED'. - ELSE IF (CLI$PRESENT('SEEN')) THENR - READ_TAG = 1 + IBSET(0,2)R - BULL_PARAMETER = 'SEEN'I - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THENO - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED'C - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT, - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN_ - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN'L - ELSEC - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IFO - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THENE - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)E - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2)_ - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THENR - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))N - ELSE - WRITE(6,'('' WARNING: No '',A,F - & '' messages found.'')')H - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IF) - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THENG - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND.Y - & REMOTE_SET.LT.3) THENC - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find itL - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0U - DO WHILE (NEW_COUNT.GT.0)2 - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins. - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE.' - ELSE IF (OUTPUT) THENt - WRITE (6,'('' Cannot access specified folder.'')')H - CALL SYS_GETMSG(IER)A - END IF - ELSE ! Folder not foundE - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IFW - - RETURNF - - END - - - - - - SUBROUTINE UPDATE_FOLDERI -C -C SUBROUTINE UPDATE_FOLDER -CD -C FUNCTION: Updates folder info due to new message. -CI - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURNE - - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileM - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)R - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message?0 - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURNE - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDERG -CL -C FUNCTION: Shows the information on any folder.R -C. - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'L - - INCLUDE 'BULLFOLDER.INC'& - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG)R - DIMENSION BRIEF_PERM_FLAG(FLONG)' - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)'t - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN( - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IFC - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT))N - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THENd - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IFI - - IF (TEST_NEWS(FOLDER1)) THEN T - INCMD = 'SET NEWS 'T - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL '* - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THENS - WRITE (6,'('' ERROR: Specified folder was not found.'')')u - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THENT - WRITE (6,1000) FOLDER1,FOLDER1_OWNER,w - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE/ - WRITE (6,1010) FOLDER1,FOLDER1_OWNER,S - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF' - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1)D - CALL CHKACLT - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEND - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remoteI - & BTEST(FOLDER1_FLAG,0)) THEN ! and private?f - WRITE (6,'('' Access is limited.'')')E - END IFG - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1T - WRITE_ACCESS = 1I - ELSER - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',F - & USERNAME,READ_ACCESS,WRITE_ACCESS)' - END IFa - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THENO - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN_ - WRITE (6,'('' Folder is located on node '',1 - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSED - CALL SET_FOLDER_FILE(1): - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR) - CALL READDIR(0,IER)_ - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0)) - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '',7 - & A,''. Remote folder name is '',A,''.'')') I - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF1 - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN)R - END IFn - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THENR - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')f - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')')) - END IF - END IFt - ELSE_ - WRITE (6,'('' No BBOARD has been defined.'')') - END IFE - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRER - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IFE - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IFR - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF1 - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IFE - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')')) - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF0 - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IFO - IF (BTEST(FOLDER1_FLAG,10)) THENl - WRITE (6,'('' POST_ONLY has been set.'')')U - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IFt - IF (BTEST(FOLDER1_FLAG,12)) THEN, - WRITE (6,'('' COMPRESS has been set.'')') - END IF, - IF (BTEST(FOLDER1_FLAG,14)) THENu - WRITE (6,'('' ANONYMOUS has been set.'')') - END IFi - IF (F1_EXPIRE_LIMIT.GT.0) THENn - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IFt - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THENM - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.T - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THENT - PERM = .TRUE./ - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')')P - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND.A - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE.O - WRITE (6,'('' Default is READNEW, which is permanent.'')')O - ELSE - WRITE (6,'('' Default is READNEW.'')')C - END IF - END IF - ELSE_ - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.E - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE.T - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')')I - ELSE - WRITE (6,'('' Default is SHOWNEW.'')')N - END IF - END IF - END IFW - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN& - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')')N - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')')1 - END IF' - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEND - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE. - WRITE (6,'('' Default is NONOTIFY.'')') - END IF0 - CALL CLOSE_BULLUSER - END IF - SLIST = INDEX(FOLDER1_DESCRIP,'<') - ELIST = INDEX(FOLDER1_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN - IF ((FOLDER1_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR.. - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))).AND.' - & INDEX(FOLDER_DESCRIP(SLIST+2:),'@').EQ.0) THEN= - WRITE (6,'('' Last message fed by news group was: '',I)') - & F_LAST - END IF1 - END IF - END IFR - - CALL CLOSE_BULLFOLDER - - RETURNO - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/,A - & ' Description: ',A)L -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/,W - & ' Description: ',A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT)1 -CM -C SUBROUTINE DIRECTORY_FOLDERSL -C -C FUNCTION: Display all FOLDER entries. -CI - IMPLICIT INTEGER (A - Z)L - - INCLUDE '($SSDEF)'. - - INCLUDE 'BULLFOLDER.INC't - - INCLUDE 'BULLUSER.INC't - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGe - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/C - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' 'T - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURNA - END IF - ELSEE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. ) - STORED = .FALSE. . - CLASS = .FALSE.G - NEW = .FALSE. - PERM = .FALSE. - DEFA = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counterX - NLINE = 1 - START = .FALSE.H - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE. - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'': - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have''_ - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDERN - CALL NEWS_LIST - CALL OPEN_BULLNEWS_SHARED1 - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER)O - END IF - COUNT = CLI$PRESENT('COUNT')D - IF (COUNT) TOTAL_COUNT = 0L - STORED = CLI$PRESENT('STORED')N - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE'). - NEW = CLI$PRESENT('NEWGROUPS')O - CLASS = CLI$PRESENT('CLASS')R - PERM = CLI$PRESENT('PERMANENT') - DEFA = CLI$PRESENT('DEFAULT') - IF (CLASS) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHAREDF - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THENO - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 11 - ELSE IF (PERM) THEN - CALL OPEN_BULLINF_SHARED_ - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DOI - IF (IER.NE.0) THENU - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DOi - END IF - CALL CLOSE_BULLINF= - INUM = 1. - ELSE IF (DEFA) THEN - CALL OPEN_BULLINF_SHAREDF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_RECE - END DOF - IF (IER.NE.0) THENE - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF( - INUM = 1e - ELSEb - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IFE - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER)E - IF (IER.NE.0) THENR - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDERD - FOLDER_COUNT = -1 - RETURNM - ELSEA - START = .TRUE.F - END IFE - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN)l - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*'E - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0E - FOLDER_COUNT = -1 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THENF - SUBNUM = -20 - ELSE! - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)1 - END IF: - -CF -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memoryE -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -C. - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1L - - CALL DECLARE_CTRLC_ASTW - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE.T - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THENI - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DOL - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (PERM.OR.DEFA) THENO - IER = 1 - DO WHILE (INUM.LE.FOLDER_MAX.AND.IER.NE.0)C - IF (INF_REC2(1,INUM).NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (ZEXT(INF_REC2(1,INUM)),IER) - END IFA - INUM = INUM + 1 - END DO - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2O - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THEND - NEW_NEWS = FOLDER1_NUMBER - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IFT - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP) - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND.& - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THENF - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP)A - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)),l - & USERNAME,READ_ACCESS,-1) - ELSEI - READ_ACCESS = 1 - END IF) - END IFL - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE1 - READ_ACCESS = 1 - END IFL - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:)K - ELSEE - FSTATUS1 = ' 'I - END IF - IF (.NOT.NEWS_TEST) THENA - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100E - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN( - IER1 = 1L - MORE = .TRUE. - END IFF - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DO - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (FLAG.EQ.1) THENd - WRITE (6,'('' Folder search aborted.'')'). - FOLDER_COUNT = -1 - RETURN - END IFO - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1S - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IFy - -Cs -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to headerS - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THENN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'',L - & /,1X,(''-''))')E - ELSE IF (CLASS) THEND - WRITE (6,'(1X,''Class'',/,1X,(''-''))')R - ELSE IF (SUBSCRIBE) THENU - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))')E - ELSE1 - WRITE (6,'(1X,''News group'',X,''Status'',7X, - & ''First Last'',/,1X,(''-''))')R - END IFL - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1 - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM)D - I = I + 1 - END IF - IF (.NOT.NEWS) THENU - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE& - DATETIME = ' NONE') - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IFe - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - J = INDEX(FOLDER1_DESCRIP,' ')l - IF (J.GT.0) THEN' - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1)l - END IF' - ELSE - FSTATUS1 = ' ' - END IF - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNTU - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0t - END IF' - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1),I - & F1_START,F1_NBULL,NEWS_NEW-1E - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),T - & F1_START,F1_NBULL,NEWS_NEW-1I - END IF - ELSEI - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THENS - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0( - END IFT - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER_ - IF (NEWS_TEST.AND.FLAG.NE.1) THENe - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - FOUND = .FALSE. - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND), - CALL READ_FOLDER_FILE_TEMP(IER)N - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:), - ELSEM - FSTATUS1 = ' 'w - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND. - & .NOT.BTEST(FOLDER1_FLAG,9))).AND.D - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2)G - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENF - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1)C - ELSE - FOUND1 = .TRUE. - END IFD - END IF, - FOUND = FOUND1 - ELSE - FOUND = .TRUE.T - END IFS - END IF& - END DO' - MORE = MORE.AND.FOUND - IF (MORE) THENI - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND) FLAG = 1H - END IF - END DOF - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_ASTA - CALL CLOSE_BULLFOLDERI - END IF - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNT - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSE - WRITE(6,1100) ! Else say there are moree - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF: - - RETURNA - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12)' -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10) -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10)A -1100 FORMAT(1X,/,' Press RETURN for more...',/)) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID.) -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny accessE -CE - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFOLDER.INC'I - - INCLUDE 'BULLUSER.INC'C - - INCLUDE '($SSDEF)'T - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENTA - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THENR - ALL = .TRUE. - ELSE' - ALL = .FALSE.N - END IFL - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE.0 - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE) - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS) THEN) - IF (.NOT.CLI$PRESENT('CLASS')) THENT - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.'_ - END IF - CALL OPEN_BULLNEWS - ELSEe - CALL OPEN_BULLFOLDER ! Open folder file - END IFe - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THENT - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THENI - WRITE (6,L - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THENM - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSEI - CALL SET_FOLDER_FILE(1)_ - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION_ - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),D - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - CALL RESET_PROTECTIONs - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')') - RETURNO - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFILE - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0)) - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENr - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN$ - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THENS - CALL ADD_ACL('*','NONE',IER)C - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN1 - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THENC - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SETL - REMOTE_SET = .FALSE.I - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVEE - CALL SET_FOLDER_FILE(0) - END IF - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN& - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER)N - END IF, - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THENO - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)E - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THENd - WRITE (6,'('' ERROR: Cannot find file '',A)')) - & INPUT(2:ILEN) - RETURN - END IFO - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THENT - CLOSE (UNIT=3) - INPUT = ' 'O - ELSEI - FILE_OPEN = .TRUE. - END IF - ELSEL - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1s - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1)D - INPUT = INPUT(COMMA+1:)B - ELSE - ID = INPUT - INPUT = ' 'R - END IF - ILEN = TRIM(ID) - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THEN& - WRITE (6,'('' ERROR: Cannot modify access'',. - & '' for owner of folder.'')') - ELSEE - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER)B - ELSEf - CALL ADD_ACL(ID,'R+W',IER)t - END IF - ELSE' - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IFr - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN)' - CALL SYS_GETMSG(IER)t - ELSE - WRITE(6,'('' Access modified for '',A,''.'')')) - & ID(:ILEN) - END IF - END IF, - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUTE - IF (IER.NE.0) THEN - CLOSE (UNIT=3)t - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF( - END DOI - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN, - IF (NEWS) THEN( - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IFI - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER)F - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL)I -C( -C SUBROUTINE CHKACL -Cs -C FUNCTION: Checks ACL of given file. -CF -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file.1 -CA - - IMPLICIT INTEGER (A-Z)( - - CHARACTER*(*) FILENAME' - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)'M - - CHARACTER*256 ACLENT( - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN) - IERACL = SS$_NORMAL.OR.IERACLG - END IFE - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C_ -C SUBROUTINE CHECK_ACCESS -CT -C FUNCTION: Checks ACL of given file. -C' -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access.w -Ch - - IMPLICIT INTEGER (A-Z)E - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))A - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN( - READ_ACCESS = 0m - END IFt - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))D - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF< - - RETURNS - END - - - - - SUBROUTINE SHOWACL(FILENAME). -C0 -C SUBROUTINE SHOWACLE -C -C FUNCTION: Shows users who are allowed to read private bulletin. -CT -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z)( - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAMEe - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))L - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)0 - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURNN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z)I - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC'U - - COMMON /NEWS_OPEN/ NEWS_OPEN' - - ENTRY WRITE_FOLDER_FILE(IER)I - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWSG - - DO WHILE (REC_LOCK(IER))N - IF (NEWS_OPEN) THEN/ - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COMC - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DOR - - RETURNC - - ENTRY WRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSEW - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IFT - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER)e - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER_COME - END IFE - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSET - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENC - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COMM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNm - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENe - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1A - - RETURNL - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENS - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM= - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DOP - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBERC - - RETURNL - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER)D - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN_ - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COME - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DOL - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNR - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)D - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENR - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COMI - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURNW - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER))E - IF (NEWS_OPEN) THENN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COMN - END IF - END DOU - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1= - - RETURNR - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))N - IF (NEWS_OPEN) THEN) - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COMT - END IF - END DO' - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1N - - RETURNR - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))$ - IF (NEWS_OPEN) THENF - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM_ - END IF - END DOA - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURNE - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))' - IF (NEWS_OPEN) THEN_ - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COMR - END IF - END DOL - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1t - - RETURNn - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER)u - - DO WHILE (REC_LOCK(IER))s - IF (NEWS_OPEN) THENo - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COMh - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DOE - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNn - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z)D - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)'_ - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC'M - - CHARACTER*12 SAVE_USERNAMET - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DOI - - TEMP_USER = USERNAMEN - USERNAME = SAVE_USERNAMEG - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER)E - - SAVE_USERNAME = USERNAME) - - DO WHILE (REC_LOCK(IER))= - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRYU - END DOE - - USERNAME = SAVE_USERNAMED - TEMP_USER = KEY_NAME= - - RETURND - - ENTRY READ_USER_FILE_HEADER(IER)E - - DO WHILE (REC_LOCK(IER)). - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DOE - - RETURNS - - ENTRY WRITE_USER_FILE_NEW(IER) - - DO I=1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)R - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I)1 - END DO - - ENTRY WRITE_USER_FILE(IER)A - - DO WHILE (REC_LOCK(IER))' - WRITE (4,IOSTAT=IER) USER_ENTRYC - END DO - - RETURN - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - S - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - I - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_'O - END DOA - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)O - - NEW_NEWS_ACCESS = - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS' - - RETURN_ - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - O - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DOE - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C))S - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' '1 - ELSE - FILE = FILE(:L) - END IF - END DO - - RETURN( - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z)R - - CHARACTER*(*) INPUT,FIND - - F = LEN(FIND)I - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURN= - END DOD - - RETURN) - END diff --git a/decus/vms95a/bulletin/bulletin6.for b/decus/vms95a/bulletin/bulletin6.for deleted file mode 100644 index b4a7b91..0000000 --- a/decus/vms95a/bulletin/bulletin6.for +++ /dev/null @@ -1,2805 +0,0 @@ -C -C BULLETIN6.FOR, Version 12/15/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - TRY = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.TRY.EQ.0) THEN - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - TRY = 1 - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR]') - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL_NAME - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & BUFFERCOUNT=127, - & ORGANIZATION='INDEXED',IOSTAT=IER) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open file: '',A)') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - IF (UNIT.EQ.14) THEN - WRITE (6,'('' Database conversion in progress. Try later.'')') - ELSE - WRITE (6,'('' Please try again later.'')') - END IF - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - COMMON /NEWSLIST/ NEWSLIST - DATA NEWSLIST/0/ - - COMMON /DIRLIST/ DIRLIST - DATA DIRLIST/0/ - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - LUN = 2 - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL_NAME - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & BUFFERCOUNT=127, - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - END IF - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBERP - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1))). - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULLt - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LASTT - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1)n - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2)i - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE'S - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMITt - - RETURNd - - END - - - - - SUBROUTINE CONVERT_BULLNEWSDIRG - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($FORIOSDEF)'Y - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILEF - - CHARACTER*180 TEMP! - - CHARACTER BUFFER*12,DATETIME*24 - - WRITE (6,'('' Converting data files to new format. Please wait.'')')! - - CALL SET_PROTECTION - - CALL OPEN_BULLNEWS+ - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED',B - & RECORDTYPE='FIXED',RECORDSIZE=180/4,R - & ORGANIZATION='INDEXED',IOSTAT=IER,P - & BUFFERCOUNT=127,KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED')T - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - IER1 = LIB$CREATE_DIR(= - & FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR]')O - IF (.NOT.IER1) GO TO 900I - - NEW_FOLDER_NUMBER = 0 - - DO WHILE (IER.EQ.0) - READ (2,IOSTAT=IER) TEMP - IF (GET_INTEGER(%REF(TEMP)).NE.NEW_FOLDER_NUMBER) THEN - IF (NEW_FOLDER_NUMBER.NE.0) CLOSE (UNIT=9,DISPOSE='KEEP') - NEW_FOLDER_NUMBER = GET_INTEGER(%REF(TEMP)) - CALL SET_BULLNEWSDIR_FILE(NEW_FOLDER_NUMBER)N - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE,B - & STATUS='UNKNOWN',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,R - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & BUFFERCOUNT=127,O - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED')U - IF (IER.NE.0) GO TO 900 - END IF - NEWS_MSG_NUM = GET_INTEGER(%REF(TEMP(5:))) - NEWS_MSG_BTIM_KEY = TEMP(13:) - NEWS_EX_BTIM_KEY = TEMP(89:) - NEWS_MSGID = TEMP(21:) - CALL COPY2(MSG_BTIM,%REF(TEMP(97:)))+ - CALL CONVERT_TO_GMT(MSG_BTIM)R - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL LIB$MOVC3(76,%REF(TEMP(105:)),NEWS_BLOCK) - - WRITE (9,IOSTAT=IER1) NEWSDIR_ENTRY - END DOA - - CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2)E - - CALL RESET_PROTECTION - - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT'T - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - - IER = LIB$RENAME_FILE(BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - & ,'BULLNEWSDIR.OLD')G - - WRITE (6,'('' BULLNEWSDIR.DAT has been renamed to '', - & '' BULLNEWSDIR.OLD and may now be deleted.'')'): - - RETURN: - -900 CALL RESET_PROTECTION - - CALL CLOSE_BULLNEWS - - WRITE(6,'('' ERROR: Cannot convert BULLNEWSDIR.DAT'')') - IF (IER.EQ.0) CALL ERRSNS(IDUMMY,IER1)= - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSED - CALL SYS_GETMSG(IER1)& - END IFG - CALL ENABLE_CTRL_EXIT - - END - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z)A - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116. - - WRITE (6,'('' Converting data files to new format. Please wait.'')')L - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,( - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',f - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))L - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,I - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')E - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM)T - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM)O - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2D - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:)E - BULLDIR_ENTRY(81:84) = BUFFER(85:)T - BULLDIR_ENTRY(93:100) = BUFFER(108:)T - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM)F - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DOE - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2)N - -900 CALL RESET_PROTECTION - - RETURNS - - END - - - - SUBROUTINE CONVERT_BULLFILES -CC -C SUBROUTINE CONVERT_BULLFILES -CI -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletinS -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs).n -Cu - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')'). - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',I - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',N - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,_ - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED'). - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8)' - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00'E - ICOUNT = 2N - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCKE - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER= - END DO - CALL WRITEDIR(ICOUNT-1,IER1)R - ICOUNT = ICOUNT + 1 - END IF - END DOF - - CLOSE (UNIT=9)T - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1)Y - - CALL RESET_PROTECTION - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)' -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C) -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'S - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE. - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR( - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDERE - -100 READ (7,FMT=FOLDER_FMT,ERR=200)E - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER))M - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL'4 - & ,STATUS='OLD',E - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)S - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE)D - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THENO - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER)B - NBLOCK = NBLOCK + 1N - SBLOCK = NBLOCKN - DO J=BLOCK,LENGTH+BLOCK-1T - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK)H - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1)L - - CALL CLOSE_BULLDIRN - GOTO 100F - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -C -C SUBROUTINE CONVERT_BULLFOLDER -CE -C FUNCTION: Converts bulletin folder file to new format.D -CE - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)', - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAMEL - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']'))N - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1E - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',E - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE')L - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN' - F_NUMBER = 0 - DO WHILE (IER.EQ.0)P - IF (ASK_SIZE.EQ.184) THEN* - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)E - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPI - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)',P - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER). - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIMI - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE). - IF (NEWS_FEED()) THEN - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST)D - ELSE0 - F_LAST = 0 - END IF_ - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER)t - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBE - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LASTg - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSEX - F_NUMBER = 0 - DO WHILE (IER.EQ.0)D - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPC - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER))A - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)t - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0)L - END IFA - DO WHILE (FILE_LOCK(IER,IER1))D - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))S - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THENM - IDUMMY = FILE_LOCK(IER,IER1)0 - CALL CONVERT_BULLDIRS - END IF - END DOL - IF (IER.EQ.FOR$IOS_FILNOTFOU) THENU - F_NEWEST_BTIM(1) = 0+ - F_NEWEST_BTIM(2) = 0Y - ELSES - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATEO - NEWEST_TIME = TIMEN - CALL WRITEDIR(0,IER)E - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE)S - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBE - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0S - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IFE - - CLOSE (UNIT=7)A - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)W - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE)D - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURNO - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -CN -C SUBROUTINE CONVERT_BULLNEWS -CR -C FUNCTION: Converts bulletin NEWS file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'B - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)'N - - CHARACTER*(*) FILENAMEY - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. ''B - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME)), - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']'))T - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1))( - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED',T - & ORGANIZATION='INDEXED',IOSTAT=IER,T - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DOG - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',U - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600,= - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE')k - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0_ - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE)E - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE)I - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0f - NEWS_F_END = 0 - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108)S - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:)R - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT)C - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1D - IF (LMOVE.LE.0) THENA - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP - ELSE( - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE))O - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) - END IFR - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7)E - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - RETURNI - END - - - - SUBROUTINE CONVERT_USERFILE -CL -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C_ - - IMPLICIT INTEGER (A-Z)k - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'D - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIMEN - - WRITE (6,'('' Converting data files to new format. Please wait.'')')B - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))I - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD': - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',) - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,3 - & KEY=(1:12:CHARACTER))O - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')')O - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')E - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE)E - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)B - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFE - - IF (IER.EQ.0) THENR - CALL SET_PROTECTIONF - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',L - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IFP - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)G - CALL SYS_GETMSG(IER1) - CALL RESET_PROTECTION( - CALL ENABLE_CTRL_EXITT - END IF' - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'XD - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0/ - SET_FLAG(I) = 0T - END DOG - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR.E - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0_ - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN. - TEMP_USER = BUFFER(:12)T - LOGIN_DATE = BUFFER(13:23)O - LOGIN_TIME = BUFFER(24:31). - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))T - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM)' - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IFA - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flagI - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,W - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF/ - - IER = 0 - - CLOSE (UNIT=9)1 - CLOSE (UNIT=4). - - CALL RESET_PROTECTION - - RETURNU - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -CP -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -CS -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.O -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS:_ -C ICOUNT - The last record read by this routine. -CF - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXT - - COMMON /KEEPLOCK/ KEEPLOCKW - DATA KEEPLOCK/.FALSE./I - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM= - - CHARACTER*4 CFOLDER_NUMBER_ - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THENN - DO WHILE (REC_LOCK(IER))1 - IF (REMOTE_SET.EQ.4) THENS - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DOM - IF (IER.EQ.0) THENN - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSEE - DIR_NUM = 0 - END IFW - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURNE - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN_ - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDERW - END IFE - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0_ -CA -C Check to see if cleanup of empty file space is necessary, which isF -C defined here as being 50 blocks (200 128byte records). Also check_ -C to see if cleanup was in progress but didn't properly finish. -CN - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THENE - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP')T - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IFF - END IF - ELSED - IF (.NOT.REMOTE_SET) THENB - DO WHILE (REC_LOCK(IER))I - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRYN - ELSE - READ(2,KEYGE=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRYS - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRYI - ELSE - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0.AND.ICOUNT.EQ.F_START) THEN0 - READ(2,KEYGT=ICOUNT, - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY: - IF (IER.EQ.0) ICOUNT = NEWS_MSG_NUM: - END IF8 - END IF - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START)d - ICOUNT = ICOUNT - 1D - READ(2,KEY=ICOUNTR - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IFU - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUMF - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND.L - & MSG_NUM.GT.F_START) THEN - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAMEA - & (FOLDER,IER2) - F_START = MSG_NUMD - CALL REWRITE_FOLDER_FILE(IER2)O - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IFE - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THEN4 - ICOUNT = MSG_NUME - BULLETIN_NUM = ICOUNT - END IF - END IF - ELSEG - IF (DIR_NUM.EQ.ICOUNT-1) THEN= - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97)Y - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) 0 - & BULLDIR_ENTRY - END IF1 - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 C - END IFI - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97)h - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) n - & BULLDIR_ENTRY - END IFL - END IF - END IFL - END DOS - IF (IER.EQ.0) THENn - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE& - DIR_NUM = -1 - END IFT - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IFU - - IF (IER.EQ.0) THEN' - IF (.NOT.REMOTE_SET) THENU - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THENI - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1T - END IF - END IFD - END IF' - - RETURN - - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM)S - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN9 - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z)/ - - INTEGER TEMPS - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP)T - - TEMP = NUMO - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I)= - END DO, - - RETURND - END - - - SUBROUTINE READDIR_KEYGE(IER) -CG -C SUBROUTINE READDIR_KEYGEE -Cf -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified.O -CR -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS:T -C IER - If 0, no entry found. Else contains message number. -CT - - IMPLICIT INTEGER (A - Z)O - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/1/ - - COMMON /KEEPLOCK/ KEEPLOCKB - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM_ - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.2.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRYF - ELSE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THENL - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN0 - IF (NEWS_KEYID.EQ.2.AND.MSG_NUM.NE.0) THEN F - IF (MSG_NUM.GT.NEWS_F_END) THENI - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36 - UNLOCK 2 - END IF - END IF - END IF - ELSEE - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97)O - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IFd - END IFb - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBINI - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFILe - ELSE - IER = 0 - DIR_NUM = -1' - END IF - ELSE, - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THENF - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10M - END IF - END IF - - RETURND - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'& - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF& - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,)E - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURND - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBINK - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIMED - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY),%DESCR(EX_BTIM)) - IF (POSTTIME) THEN - CALL GET_MSGKEY(%REF(NEWS_POST_KEY),%DESCR(MSG_BTIM)) - CALL CONVERT_FROM_GMT(MSG_BTIM) ! Assume stored is GMT - END IF - DESCRIP = NEWS_DESCRIPE - FROM = NEWS_FROM - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IFF - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11)F - EXTIME = DATETIME(13:23)E - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,)T - - DATE = DATETIME(:11)C - TIME = DATETIME(13:23)R - - RETURN, - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -CA -C SUBROUTINE WRITEDIR -CO -C FUNCTION: Writes the entry for the specified bulletin in theO -C directory file.n -Ct -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.t -C If 0, write the header of the directory file. -C OUTPUTS:h -C IER - Error status from WRITE. -CP - - IMPLICIT INTEGER (A - Z)U - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'U - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CONV = .TRUE. - - GO TO 10w - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE.C - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBINF - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADERO - ELSE - IER = -1E - IF (DIR_NUM.EQ.0) THENR - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSEL - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IFR - END IFD - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0T - ELSED - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN T - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER_ - END IF - END IFO - END IFE - IF (IER.NE.0) THENI - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IFE - END IFS - END IF - ELSE - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1U - IF (DIR_NUM.EQ.MSG_NUM) THENO - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRYA - ELSEA - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRYI - END IFL - END IFC - IF (IER.NE.0) THENN - IF (REMOTE_SET.EQ.4) THEN - IF (BULLETIN_NUM.NE.NEWS_F_END+1) THEN - DO WHILE (REC_LOCK(IER))L - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER)) - END DOO - END IF - ELSEN - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER)_ - END IFR - IF (REMOTE_SET.EQ.4.AND. - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN_ - CALL SPECIAL_NEWSDIR_ENTRY(IER)O - ELSE IF (IER.EQ.0) THENl - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THENF - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IFI - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT) - - DIR_NUM = -1E - - RETURNE - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER)' - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC'E - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*140 TEMPF - - DIMENSION BTIM(2) - - READ (2,KEYID=3,KEY=NEWS_POST_KEY,IOSTAT=IER) TEMP - DO WHILE (IER.EQ.0.AND.NEWS_POST_KEY.EQ.TEMP(57:64))O - IF (NEWS_MSGID.EQ.TEMP(21:56)) THEN = - IER = 2 - RETURN - END IF - READ (2,IOSTAT=IER) TEMP - END DO= - -10 IER1 = 0Y - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=0,KEYGT=NEWS_F_END, - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH), - END DO - DO WHILE (IER1.EQ.0)R - CALL LIB$MOVC3(4,%REF(INPUT),FNUM) - CALL GET_MSGKEY(%REF(INPUT(13:)),%DESCR(BTIM)) - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM)8 - END IF - F_COUNT = F_COUNT + 11 - CALL LIB$MOVC3(4,%REF(INPUT),NEWS_F_END) - DO WHILE (REC_LOCK(IER1))& - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - END DOB - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IFY - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - - IF (IER.NE.0) THEN1 - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSEF - F_COUNT = F_COUNT + 1. - END IF - - RETURNF - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNITI - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM)I - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE)9 - END IFE - - RETURNT - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN_ - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'O - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POSTD - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THENN - CALL CONVERT_TO_GMT(MSG_BTIM)= - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY)( - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,MSG_BTIM) - ELSE - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - END IF - - IF (LOCAL_POST) THENE - CALL SYS_BINTIM(DATE//' '//TIMEQ - & (:TRIM(TIME)-2)//'00',MSG_BTIM)F - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY), - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP - NEWS_FROM = FROM) - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH/ - NEWS_MSG_NUM = MSG_NUM. - CALL GET_MSGKEY(MSG_BTIM,NEWS_MSG_BTIM_KEY)L - CALL GET_MSGKEY(EX_BTIM,NEWS_EX_BTIM_KEY)A - ELSE - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IFN - - RETURNO - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - D - COMMON /KEYID/ NEWS_KEYIDA - - COMMON /KEEPLOCK/ KEEPLOCK - - EX_BTIM(1) = 0: - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 2 - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY)R - CALL READDIR_KEYGE(NDEL) - KEEPLOCK = .FALSE.I - NEWS_KEYID = 1N - - RETURNU - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -CS -C SUBROUTINE READACLD -C0 -C FUNCTION: Reads the ACL of a file.- -C- -C PARAMETERS: -C FILENAME - Name of file to check.L -C ACLENT - String which will be large enough to hold ACL information.E -CT - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*)I - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)R - - BIG = .NOT.IERF - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENTD - CTXT = 0 - END IF, - - DO ACC_TYPE=1,2 - POINT = 1R - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)O - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+F - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST)i - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))),F - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE.I - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR.E - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THENM - START_ID = INDEX(ACLSTR,'=') + 1A - END_ID = INDEX(ACLSTR,',ACCESS') - 1t - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND.A - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII))N - IF (ACLSTR(START_ID:START_ID).NE.','.AND. - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE.Y - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF9 - END DOI - IF (ASCII) THEN - START_ID = START_ID + 1O - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1, - END_ID = INDEX(ACLSTR,'ACCESS') - 28 - END IF - END IF - END IF: - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN_ - IF (ACC_TYPE.EQ.1) THENO - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(_ - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THENI - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 22 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE( - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IFL - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DOF - - RETURN_ - END - - - - - SUBROUTINE CONVERT_INFFILE_ - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'D - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THENN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)r - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFL - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW',* - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)( - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX)B - END DOI - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9)' - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z)E - O - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)E - CALL ENABLE_CTRL_EXIT - - RETURNT - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -CN -C SUBROUTINE COPY_ACL -CO -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z)N - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE_ - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl outputC - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,)O - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of stringR - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURN' - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -CU -C SUBROUTINE COPY_ACL1G -CS -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C= - IMPLICIT INTEGER (A-Z)/ - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,)U - ! Read input file acl - - IF (.NOT.IER) THEN: - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,( - & %LOC(ACLENT)) - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlistF - IER = SYS$CHANGE_ACL - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,)N - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied firstR - END DO - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:)))( - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DOT - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURNI - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFILES.INC'M - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./, - - IF (CHECKED) RETURN - - CHECKED = .TRUE.O - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C) - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORY - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE)S - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSEn - CALL ADD_DIRECTORY(BULLNEWS_FILE) - END IF' - - CALL CHECK_DIR(FOLDER_DIRECTORY,.FALSE.) - CALL CHECK_DIR(NEWS_DIRECTORY,.FALSE.)T - - CALL ADD_DIRECTORIESC - - RETURN - ENDT - M - - - SUBROUTINE ADD_DIRECTORIES/ - - INCLUDE 'BULLFILES.INC' - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE) - - RETURNL - END - - - - LOGICAL FUNCTION CHECK_DIR(DIRECTORY,LIBRARY) - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - CHECK_DIR = PRESENT(BULLUSER_FILE,DIRECTORY,TEST).AND.E - & PRESENT(BULLFOLDER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLINF_FILE,DIRECTORY,TEST) - - IF (CHECK_DIR) THEN - IF (SYS_TRNLNM(DIRECTORY,TEST)) DIRECTORY = TEST - RETURN - END IF - - TEST = ' ' - - IF (INDEX(DIRECTORY,']').EQ.0) THEN - CALL SYS_TRNLNM(DIRECTORY,TEST1) - ELSE - TEST1 = DIRECTORYT - END IFO - - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER)E - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST)L - END DO - - IF (.NOT.LIBRARY.AND.TEST.EQ.' ') THENw - IER = SYS_TRNLNM_SYSTEM(DIRECTORY,TEST)L - IF (.NOT.IER.AND.TEST1.EQ.DIRECTORY) RETURNL - END IFF - - IF (TEST.NE.TEST1) THEN - IF (LIBRARY) THEN. - WRITE (6,'('' ERROR: Not a valid library. '')') - RETURN - END IF - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER) - CLOSE(UNIT=3,STATUS='DELETE')S - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)')N - & TEST1(:TRIM(TEST1))O - CALL EXIT - END IF - DIRECTORY = TEST1 - ELSE - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - CHECK_DIR = .TRUE. - END IF - - RETURN - END - - - - - LOGICAL FUNCTION PRESENT(FILE,DIR,TEST) - - IMPLICIT INTEGER (A-Z)O - - CHARACTER*(*) FILE,DIR,TEST - - FILE = FILE(INDEX(FILE,':')+1:) - FILE = FILE(INDEX(FILE,']')+1:) - IF (INDEX(DIR,':').EQ.0.AND.INDEX(DIR,'[').EQ.0) - & DIR = DIR(:TRIM(DIR))//':'F - C = 0 - PRESENT = LIB$FIND_FILE(DIR(:TRIM(DIR))//FILE,TEST,C) - - RETURN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:)R - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:). - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY & - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':'F - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURN) - ENDH - - - - SUBROUTINE SET_LIBRARYE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - N - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CALL CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P) - - IF (CHECK_DIR(BULL_PARAMETER,.TRUE.)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER))O - CALL UPDATE_USERINFO - CALL OPEN_USERINFO - INCMD = 'SHOW' - CALL UPDATE_READ(0) - END IFO - - RETURNE - END - - - - SUBROUTINE SHOW_LIBRARY - - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (CLI$PRESENT('ALL')) THEN - IER = 1C - N = 1 - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',BULL_PARAMETER) - IF (IER) THEN - IF (N.EQ.1) THEN - WRITE (6,'('' The following are valid libraries:'')') - N = 0 - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER, - END IFU - END DO - IF (N.EQ.1) WRITE (6,'('' No libraries are present.'')') - ELSEM - WRITE (6,'('' Present library is: '',A)') - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - END IF - - RETURND - END - - - - SUBROUTINE SET_BULLNEWSDIR_FILE(FN) - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLFOLDER.INC'I - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILEA - - BULLNEWSDIR_FILE = ' 'A - - ENCODE(6,'(I6)',BULLNEWSDIR_FILE) FN - BULLNEWSDIR_FILE = BULLNEWSDIR_FILE(FIRST_ALPHA(BULLNEWSDIR_FILE):) - L = TRIM(BULLNEWSDIR_FILE)S - - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.'// - & BULLNEWSDIR_FILE(:L-3)//']'//M - & BULLNEWSDIR_FILE(L-2:TRIM(BULLNEWSDIR_FILE))//'.'A - - RETURNN - END diff --git a/decus/vms95a/bulletin/bulletin7.for b/decus/vms95a/bulletin/bulletin7.for deleted file mode 100644 index 6ad3dd0..0000000 --- a/decus/vms95a/bulletin/bulletin7.for +++ /dev/null @@ -1,2315 +0,0 @@ -C -C BULLETIN7.FOR, Version 10/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER1_NAME.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCALPOST/ LOCAL_POST - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - IF (.NOT.LOCAL_POST) THEN - DATE = NEWEST_DATE - TIME = NEWEST_TIME - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIR - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - CALL DISABLE_PRIVS ! Disable SYSPRV - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - IF (INDEX(INPUT,']').GT.0) THEN - SYS_TRNLNM = .FALSE. - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX))m - CALL ADD_2_ITMLST_WITH_RETC - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))o - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlistb - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1 - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT)l - - IMPLICIT INTEGER (A-Z)r - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))V - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist0 - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IFn - - RETURNo - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1)n - - IMPLICIT INTEGER (A-Z)b - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./e - - IF (INIT) THENf - FILE_LOCK = 1 - INIT = .FALSE. - ELSEi - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)i - IF (IER1.EQ.RMS$_FLK) THENa - FILE_LOCK = 1d - CALL WAIT_SEC('01') - ELSEo - FILE_LOCK = 0 - INIT = .TRUE.T - END IF_ - ELSE - FILE_LOCK = 0 - IER1 = 0A - INIT = .TRUE. - END IF - END IFN - - RETURN2 - END - - - - SUBROUTINE ENABLE_CTRLE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /CTRLY/ CTRLYA - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1G - - ENTRY ENABLE_CTRL_EXITN - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0N - IF (QUIT.EQ.1) LEVEL = LEVEL - 1D - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THENR - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -Ce - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,)$ - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1)E - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0L - CALL SET_FOLDER_FILE(0) - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXITE - END IFI - QUIT = 0 ! Reinitialize - - RETURNp - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z)M - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/S - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -Ct -C SUBROUTINE CLEANUP_BULLFILE -Cw -C FUNCTION: Searches for empty space in bulletin file and deletes it. -CI - IMPLICIT INTEGER (A - Z)C - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - CHARACTER BUFFER*128R - - CALL OPEN_BULLDIR_SHARED4 - -CA -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C2 - - DO WHILE (REC_LOCK(IER))= - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADERD - END DOE - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THENE - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for''' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER))f - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSEF - CALL SYS_GETMSG(IER1)N - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURNE - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTHC - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100E - END IFE - WRITE(11) BUFFERD - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFILE - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',E - & '*.BULLFIL') - IER = 1& - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR',E - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1_ - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))D - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',L - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,O - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',I - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THENI - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,( - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN_ - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER))E - CALL ERRSNS(IDUMMY,IER)E - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11)) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,)O - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR',M - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0, - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)E - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for''C - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE3 - CALL SYS_GETMSG(IER1)L - END IF( - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIRR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN( - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0), - END DOT - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory headerE - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER)1 - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//L - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER)A - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//U - & '.BULLDIR;-1') - END DO) - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*',E - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURNT - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)T -C. -C SUBROUTINE CLEANUP_DIRFILE0 -C -C FUNCTION: Reorder directory file after deletions., -C Is called either directly after a deletion, or is= -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process( -C was abnormally terminated. -CA - IMPLICIT INTEGER (A - Z)E - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVED - - CHARACTER*12 DATE_SAVE,EXDATE_SAVEI - CHARACTER*12 TIME_SAVE,EXTIME_SAVED - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRYN - DATE_SAVE = DATEI - TIME_SAVE = TIMEQ - EXDATE_SAVE = EXDATE= - EXTIME_SAVE = EXTIMET - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry?D - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in fileI - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)_ - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DOP - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries0 - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER)D - RETURN - END IFL - LENGTH = -LENGTH ! Indicate starting point by writingF - CALL WRITEDIR(I,IER) ! next entry into deleted entryL - FIRST_DELETE = I ! with negative lengthW - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletionP - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1a - DO K=J,NBULL- - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY)t - END IFh - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q2 - BLOCK_SAVE = BLOCKR - MSG_NUM_SAVE = MSG_NUMR - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST)E - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1) - MOVE_FROM = MSG_NUM + 1 - END IF - END DO, - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DON - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULLa - CALL READDIR(J,IER)o - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IFD - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of fileI - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IFR - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THENc - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IF( - - CALL WRITEDIR(0,IER)L - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVEA - DATE = DATE_SAVET - TIME = TIME_SAVEC - EXDATE = EXDATE_SAVEI - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -CI -C FUNCTION: Show user flags.B -C( - IMPLICIT INTEGER (A - Z)T - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'B - - INCLUDE 'BULLFOLDER.INC'. - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IFI - -CR -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user fileR - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))t - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THENR - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.T - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.E - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THENC - WRITE (6,'('' SHOWNEW is set.'')') - END IFI - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN) - WRITE (6,'('' No flags are set.'')') - END IF= - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER)P - - IMPLICIT INTEGER (A-Z)_ - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURNE - END - - - SUBROUTINE CLR2(FLAG,NUMBER)- - - IMPLICIT INTEGER (A-Z)- - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURNb - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z)m - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))i - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL)o -Cr -C FUNCTION GETUSERS -Cl -C FUNCTION: -C To get names of all users that are logged in.i -Ce - - IMPLICIT INTEGER (A-Z)t - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER PSCAN$_BEGIN = '00000000'Xw - PARAMETER PSCAN$_ACCOUNT = '00000001'X - PARAMETER PSCAN$_AUTHPRI = '00000002'Xd - PARAMETER PSCAN$_CURPRIV = '00000003'Xr - PARAMETER PSCAN$_GRP = '00000004'Xn - PARAMETER PSCAN$_HW_MODEL = '00000005'X - PARAMETER PSCAN$_HW_NAME = '00000006'Xu - PARAMETER PSCAN$_JOBPRCCNT = '00000007'X, - PARAMETER PSCAN$_JOBTYPE = '00000008'Xi - PARAMETER PSCAN$_MASTER_PID = '00000009'X - PARAMETER PSCAN$_MEM = '0000000A'X- - PARAMETER PSCAN$_MODE = '0000000B'X - PARAMETER PSCAN$_NODE_CSID = '0000000C'X( - PARAMETER PSCAN$_NODENAME = '0000000D'X 0 - PARAMETER PSCAN$_OWNER = '0000000E'X - PARAMETER PSCAN$_PRCCNT = '0000000F'X - PARAMETER PSCAN$_PRCNAM = '00000010'X - PARAMETER PSCAN$_PRI = '00000011'X) - PARAMETER PSCAN$_PRIB = '00000012'X - PARAMETER PSCAN$_STATE = '00000013'XT - PARAMETER PSCAN$_STS = '00000014'XI - PARAMETER PSCAN$_TERMINAL = '00000015'X - PARAMETER PSCAN$_UIC = '00000016'XE - PARAMETER PSCAN$_USERNAME = '00000017'X - PARAMETER PSCAN$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER PSCAN$_END = '00000019'XN - PARAMETER PSCAN$k_type = '00000081'XT - PARAMETER PSCAN$M_OR = '00000001'X) - PARAMETER PSCAN$M_BIT_ALL = '00000002'X - PARAMETER PSCAN$M_BIT_ANY = '00000004'X - PARAMETER PSCAN$M_GEQ = '00000008'X - PARAMETER PSCAN$M_GTR = '00000010'X - PARAMETER PSCAN$M_LEQ = '00000020'X - PARAMETER PSCAN$M_LSS = '00000040'X - PARAMETER PSCAN$M_PREFIX_MATCH = '00000080'X, - PARAMETER PSCAN$M_WILDCARD = '00000100'X - PARAMETER PSCAN$M_CASE_BLIND = '00000200'X, - PARAMETER PSCAN$M_EQL = '00000400'X - PARAMETER PSCAN$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER PSCAN$S_OR = 1P - PARAMETER PSCAN$V_OR = 0N - PARAMETER PSCAN$S_BIT_ALL = 1 - PARAMETER PSCAN$V_BIT_ALL = 1 - PARAMETER PSCAN$S_BIT_ANY = 1 - PARAMETER PSCAN$V_BIT_ANY = 2 - PARAMETER PSCAN$S_GEQ = 1 - PARAMETER PSCAN$V_GEQ = 3 - PARAMETER PSCAN$S_GTR = 1 - PARAMETER PSCAN$V_GTR = 4 - PARAMETER PSCAN$S_LEQ = 1 - PARAMETER PSCAN$V_LEQ = 5 - PARAMETER PSCAN$S_LSS = 1 - PARAMETER PSCAN$V_LSS = 6 - PARAMETER PSCAN$S_PREFIX_MATCH = 1P - PARAMETER PSCAN$V_PREFIX_MATCH = 7V - PARAMETER PSCAN$S_WILDCARD = 1 - PARAMETER PSCAN$V_WILDCARD = 8L - PARAMETER PSCAN$S_CASE_BLIND = 1) - PARAMETER PSCAN$V_CASE_BLIND = 9 - PARAMETER PSCAN$S_EQL = 1 - PARAMETER PSCAN$V_EQL = 10 - PARAMETER PSCAN$S_NEQ = 1 - PARAMETER PSCAN$V_NEQ = 11 - BYTE %FILL (2)E - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -CT -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -C, -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item listH -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME))S -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL))P -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE))i -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1W -C UJPIMODE = -16 -C TERMINAL(1:1) = CHAR(0) -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process6 -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,)E -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list' - ! Now add items to listB - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF, - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0)) - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0))V - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DOT - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFOL -C_ -C SUBROUTINE OPEN_USERINFO) -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z). - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)' - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX)F - DATA USERINFO_READ /.FALSE./U - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHAREDn - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DOR - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAXI - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IFR - END DO - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,21 - LAST_READ_BTIM(J,I) = LAST(J,I)L - END DOF - END DO - END IF - - IF (IER.NE.0) THEN4 - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD',R - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2)E - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT fileD - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THENN - DO I=1,FOLDER_MAXO - LAST_READ_BTIM(1,I) = READ_BTIM(1)A - LAST_READ_BTIM(2,I) = READ_BTIM(2)L - END DO - END IFR - END IF - DO I=1,FOLDER_MAX - DO J=1,2_ - LAST(J,I) = LAST_READ_BTIM(J,I)M - END DO - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - DO WHILE (REC_LOCK(IER))e - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.EQ.0) THENE - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSES - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IFT - WRITE (9,IOSTAT=IER) USERNAME,INF_REC - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU)))g - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) =p - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IFe - END IF - END IFs - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIMA - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU)))L - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAXL - LAST_SYS_BTIM(1,I) = 0% - LAST_SYS_BTIM(2,I) = 0L - END DO - END IF - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINFE - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM)L - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ)D - - USERINFO_READ = .TRUE.R - - RETURNY - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -CA -C SUBROUTINE READ_NEWS_USERINFO -CA - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC'0 - - CHARACTER*(*) NAME= - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1)))L - ELSEI - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2)))T - END IFL - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READN - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU)))U - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSET - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF - IF (IER.NE.0) THENR - DO I=1,FOLDER_MAXI - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF - - RETURN( - END - - - - - SUBROUTINE UPDATE_USERINFOS -CN -C SUBROUTINE UPDATE_USERINFO -C1 -C FUNCTION: Updates the latest message read times for each folder. -CX - IMPLICIT INTEGER (A - Z)X - - INCLUDE 'BULLUSER.INC'_ - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)I - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)l - COMMON /USERINFO/ LAST(2,FOLDER_MAX)I - - IF (.NOT.USERINFO_READ) RETURND - - DIFF = .FALSE.S - FNUM = 1d - - DO WHILE (.NOT.DIFF.AND.FNUM.LE.FOLDER_MAX) - DIFF = LAST_READ_BTIM(1,FNUM).NE.OLD_LAST_READ_BTIM(1,FNUM)T - IF (.NOT.DIFF) THENT - DIFF = LAST_READ_BTIM(2,FNUM).NE.OLD_LAST_READ_BTIM(2,FNUM) - END IF - FNUM = FNUM + 14 - END DOE - - DIFF1 = .FALSE. - FNUM = 1T - - DO WHILE (.NOT.DIFF1.AND.FNUM.LE.FOLDER_MAX)% - DIFF1 = LAST_SYS_BTIM(1,FNUM).NE.OLD_LAST_SYS_BTIM(1,FNUM) - IF (.NOT.DIFF1) THEN - DIFF1 = LAST_SYS_BTIM(2,FNUM).NE.OLD_LAST_SYS_BTIM(2,FNUM)E - END IF - FNUM = FNUM + 1I - END DON - - DIFF2 = .FALSE. - FNUM = 1U - - DO WHILE (.NOT.DIFF2.AND.FNUM.LE.FOLDER_MAX)D - DIFF2 = LAST_NEWS_READ(1,FNUM).NE.OLD_LAST_NEWS_READ(1,FNUM) - IF (.NOT.DIFF2) THEN - DIFF2 = LAST_NEWS_READ(2,FNUM).NE.OLD_LAST_NEWS_READ(2,FNUM) - END IF - FNUM = FNUM + 1i - END DO - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHAREDL - - IF (DIFF) THENP - READ (9,KEY=USERNAME,IOSTAT=IER) - DO I=1,FOLDER_MAX - DO J=1,2E - LAST(J,I) = LAST_READ_BTIM(J,I)E - END DOI - END DO - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IFN - - IF (DIFF1) THEN - LU = TRIM(USERNAME)_ - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))O - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IFL - - IF (DIFF2) THEN - LU = TRIM(USERNAME)S - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))1 - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READC - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READD - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THENL - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1)))I - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2)))E - END IF - END IF - - CALL CLOSE_BULLINF) - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM)B - - IMPLICIT INTEGER (A-Z)l - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - CHARACTER*24 TIME1D - - TIME1 = TIME(FIRST_ALPHA(TIME):)_ - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:)D - END DO - - IF (TIME1.EQ.'-') TIME1 = '-- :'R - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM)D - END IFI - - RETURNe - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -CT -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -CC -C FUNCTION: -CC -C Update user's last read bulletin date. If new bulletins have been$ -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -CI - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)L - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHS - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2). - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATEF - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUMD - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)D - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder infoE - ELSE IF (.NOT.LOGIN_SWITCH) THENX - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time1 - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSET - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn'tL - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)O - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flagE - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1e - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENs - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.E - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THENh - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND.N - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM)O - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)n - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN& - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1I - END IF - END IFE - END IFL - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND.$ - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages* - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF) - END IF - END DOT - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)D - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),E - & F_NEWEST_BTIM)& - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM)= - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM)) - ! No. Unread system messages?o - IF (DIFF.GT.0) THEN ! No, update last read time.O - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IFE - END IFI - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS)L - IF (INCMD(:4).EQ.'SHOW') THEN - SAVE_FOLDER_Q1 = 0B - RETURN - END IF - IF (NEW_MESS.OR.NEWS_MESS) THENi - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0_ - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0Y - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10O - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins! - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)T - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)B - END IFL - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN; - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM)R - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)) - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1Y - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER)B - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - ELSEE - WRITE (6,'('' There are new messages in folder ''A - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0V - END IF - END IF, - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERT - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINTV - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORYr - BULL_POINT = SAVE_BULL_POINT_ - END DON - END IFL - END IF - END IFE - END IFH - END IFu - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXITt - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLFOLDER.INC', - - INCLUDE 'BULLUSER.INC'V - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM_ - DATA SAVE_FOLDER_Q1/0/r - - COMMON /READIT/ READITL - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)r - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATEo - CHARACTER*4 SEPARATE - V - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1_ - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN) - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSIONS - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.d - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR._ - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C_ -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed.f -Ce - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THENN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE(IER)O - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER)E - END IFT - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DOE - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTED - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLFOLDER.INC'E - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - - RETURNT - END diff --git a/decus/vms95a/bulletin/bulletin8.for b/decus/vms95a/bulletin/bulletin8.for deleted file mode 100644 index 65cb3d9..0000000 --- a/decus/vms95a/bulletin/bulletin8.for +++ /dev/null @@ -1,2147 +0,0 @@ -C -C BULLETIN8.FOR, Version 10/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND. - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0, - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - END IF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)I - - FORMAT = 0a - - IF (IER.NE.0) THEN/ - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT',P - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)y - FORMAT = 1 - END IFe - - NETUAF_NUM = 0r - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:)( - NLEN = NLEN - 12f - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64)l - SKIP = 4 + ICHAR(NETUAF(65:65))X - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THENM - ULEN = ICHAR(NETUAF(65:65))G - NETUAF(65:) = NETUAF(69:)U - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSET - NETUAF(65:) = 'DECNET' - END IF - END IFH - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DOO - - CLOSE (UNIT=7)M - - RETURNB - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX)N - - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLFOLDER.INC'R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 20D - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)Y - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFB - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK). - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)L - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK)B - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV)L - - ILEN = READ_IOSB(2,UNIT_INDEX)I - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE.A - REC_SAVE(UNIT_INDEX) = 0A - USERNAME = USER_SAVE(UNIT_INDEX)I - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX))K - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THENP - ! Do we need priv info?R - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THENC - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX))B - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX))2 - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND.E - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV)I - END IFN - END IF - END IF_ - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND.O - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IFH - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN( - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE X - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))). - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folderI - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE C - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER)L - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFOO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real.C - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSEC - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),F - & %REF(BUFFER(9:)))F - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1)U - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1)D - END IF) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:)))R - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24N - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1),L - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1),C - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),( - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IFi - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM' - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1)S - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSET - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF_ - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER_ - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX)M - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message lineM - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP))H - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + PX - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P) - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM)Y - P = 4 + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)N - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)A - END IF, - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THENT - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THENO - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF+ - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)E - WRITE (EXTIME,'(I4)') NODE_NUMBERO - WRITE (EXTIME(7:),'(I4)') NODE_AREAM - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0'U - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//E - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF. - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P( - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THENL - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL)D - P = 4 + PN - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + PD - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0)) - CALL OPEN_BULLDIRO - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX)M - LENGTH = LEN_SAVE(UNIT_INDEX)R - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTHX - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)G - WRITE (1'NBLOCK+I) INQUEUEA - END DO - IF (BROAD) THENI - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin2 - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder fileT - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodesV - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':')U - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER)M - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAMEL - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node thatT - END IF ! originated the message) - END DO - IF (TEMP_USER(:1).NE.':') THENI - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE.I - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000= - END IF - CALL SETUSER(USERNAME) ! Reset to original usernameA - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN_ - CALL ERRSNS(IDUMMY,IDUMMY,INODE)_ - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR.C - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN_ - DELETE (4) - END IF& - ELSEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH)) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER). - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128( - END DOA - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IFE - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry( - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)A - CALL SET_FOLDER_FILE(0)L - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER)_ - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:)))W - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THENN - BUFFER(5:) = BULLDIR_ENTRY, - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER)1 - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0)X - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX). - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL)N - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)R - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY)P - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)I - OUT_SAVE(UNIT_INDEX) = OENTRYK - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)1 - CALL SET_FOLDER_FILE(0)N - CALL OPEN_BULLDIRU - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER)I - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THENP - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)T - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER)X - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENI - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000E - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROMS - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENU - CALL CLOSE_BULLDIRT - BUFFER = 'ERROR: Insufficient privileges to delete message.'L - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000A - END IF - CALL REMOVE_ENTRYU - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE), - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read messageV - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)) - CALL SET_FOLDER_FILE(0)I - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX)N - DO I=BLOCK,BLOCK+LENGTH-1, - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)O - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTHA - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)_ - OUT_SAVE(UNIT_INDEX) = OENTRYO - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)S - CALL SET_FOLDER_FILE(0)O - CALL OPEN_BULLDIRN - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT) - P = 4 + P_ - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIRS - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000A - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP))O - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + PF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV()4 - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR.F - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR.I - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000E - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFILI - NEW_LENGTH = LEN_SAVE(UNIT_INDEX)K - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX)M - DO I=1,NEW_LENGTHI - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)E - WRITE (1'NBLOCK+I) INQUEUEX - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletinT - IF (NEW_LENGTH.GT.0) THENA - NEMPTY = NEMPTY + LENGTHR - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1I - END IF - CALL WRITEDIR(ICOUNT,IER)N - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1),N - & BTEST(MSGTYPE,2),EXDATE,EXTIME)& - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General?o - END IF - CALL WRITEDIR(ICOUNT,IER)a - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + PA - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + PG - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)F - CALL OPEN_BULLDIRN - CALL READDIR(BULL_DELETE,IER)U - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENS - CALL CLOSE_BULLDIRR - BUFFER = 'ERROR: Cannot find message to undelete.'I - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000L - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM( - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENE - CALL CLOSE_BULLDIRB - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000A - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + PU - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P( - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0)N - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER)N - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG)1 - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED. - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) C - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONGN - NEW_FLAG (I) = 0 - END DOI - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER,_ - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER,% - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSERO - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THENI - IF (SCRATCH(UNIT_INDEX).EQ.0) THENF - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IFn - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:)))_ - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX))R - IF (ILEN.GT.20) THENN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER)V - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0i - DO WHILE (IER.EQ.0)t - CALL READ_FOLDER_FILE(IER)T - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER)S - END IFN - END DO - CALL CLOSE_BULLFOLDERC - END IF - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV)m - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IFN - - RETURN( - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)_ - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)Y - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12A - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)R - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURNd - - CALL OPEN_USERINFOP - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),i - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX)E - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX)R - END IFR - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND.E - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THENT - DIFF1 = -1) - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND.( - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THENF - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0E - END IFN - - IF (DIFF1.LT.0) THENI - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IFI - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN_ - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM)U - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)L - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)S - - RETURNS - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX)O - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)I - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)E - - RETURNR - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME)T - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THENM - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS)N - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV) - END IF - - RETURN( - END - - - - SUBROUTINE GETACC(ACCOUNT) -CE -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS:( -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistI - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info/ - - RETURNU - END - - - - - - SUBROUTINE GETSTS(STS)C -C -C SUBROUTINE GETSTS -CE -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS:A -C STS - Status word of present process.I -CX - - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistD - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoU - - RETURND - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z)Q - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB)N - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS6 - - END - - - - INTEGER FUNCTION REC_LOCK(IER)+ - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./6 - - IF (INIT) THENN - REC_LOCK = 1 - INIT = .FALSE. - ELSE) - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - INIT = INIT + 2 - IF (INIT.GT.60) THEN) - WRITE (6,'('' Bulletin aborting due to record lock'', - & '' problem. Alert system administrator.'')') - CALL EXIT - END IF( - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURNN - END - - INTEGER FUNCTION TRIM(INPUT)I - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURND - END DOL - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z)N - - CHARACTER*80 MESSAGEY - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURNB - END - - - - SUBROUTINE HELP(LIBRARY)E - - IMPLICIT INTEGER (A-Z)N - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' 'K - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURNL - END - - - - - SUBROUTINE GET_NODE_INFO/ -CS -C SUBROUTINE GET_NODE_INFOV -C, -C FUNCTION: Gets local node name and obtains node names fromD -C command line.M -C - - IMPLICIT INTEGER (A-Z)L - - EXTERNAL CLI$_ABSENTI - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - - COMMON /TEMP_INPUT/ NODE_TEMP - CHARACTER NODE_TEMP*256 - - CHARACTER*32 NODES(10)_ - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,PASSWORD*32,TEMP_USER*12E - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE.R - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THENO - LOCAL_NODE = LOCAL_NODE(2:)S - L_NODE = L_NODE - 1J - END IFA - - NODE_NUM = 0 ! Initialize number of nodesC - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',')N - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1)U - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF1 - NLEN = TRIM(NODES(NODE_NUM))T - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THENT - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)w - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1S - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)I - POINT_NODE = NODE_NUMR - IER = 1 - DO WHILE (IER.NE.0)L - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD). - IF (TRIM(PASSWORD).EQ.0) THEN( - DO WHILE (NODE_NUM.GT.0)( - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 12 - END DOE - NODE_ERROR = .TRUE. - RETURND - END IF& - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"',R - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IFF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1S - LOCAL_NODE_FOUND = .TRUE.1 - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUME - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)//L - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED',A - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER)D - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM)l - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE.E - RETURN - END IF - END IF( - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE.B - END IFD - RETURN+ - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -CV -C SUBROUTINE SET_FOLDER_FILEM -CF -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE,2 -C if = 1, set FOLDER1_FILED -C) - - IMPLICIT INTEGER (A-Z)$ - - INCLUDE 'BULLFOLDER.INC' - - IF (NUM.EQ.0) THEN, - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE) - END IFT - - RETURN, - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C -C SUBROUTINE SET_FILE -CI - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILED - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE =) - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER/ - ELSE_ - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//N - & '.]' - END IF. - - RETURNH - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'N - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12D - - DATA UPDATE/.FALSE./, JUST_NAME/.FALSE./ - - UPDATE = .TRUE. - JUST_NAME = .TRUE._ - - ENTRY SET_BULLFIL_UPDATEe - - UPDATE = .NOT.UPDATE) - JUST_NAME = .TRUE.I - - ENTRY SET_BULLFIL_NAMED - - JUST_NAME = .NOT.JUST_NAMET - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) I - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATER - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):)A - - M = INDEX(FILDATE,'-')= - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3) - - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN R - FOLDER_FILE = FOLDER1_FILE - IF (JUST_NAME) THEN - JUST_NAME = .FALSE. - RETURNY - END IF - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THEND - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHAREDu - END IF - END IFo - - JUST_NAME = .FALSE. - - IF (UPDATE) THEN F - READ (1'1) NBLOCK - REWRITE (1) NBLOCK + LENGTHT - UPDATE = .FALSE. - END IF - - RETURNB - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THENo - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSEE - MINGT0 = MIN(I,J) - END IF - - RETURN - END diff --git a/decus/vms95a/bulletin/bulletin9.for b/decus/vms95a/bulletin/bulletin9.for deleted file mode 100644 index 32c34fd..0000000 --- a/decus/vms95a/bulletin/bulletin9.for +++ /dev/null @@ -1,2432 +0,0 @@ -C -C BULLETIN9.FOR, Version 1/13/95 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - - IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN - WRITE (6,'(A)') ' A new BULLETIN executable has been '// - & 'installed since your last use.' - WRITE (6,'(A)') - & ' Type HELP NEW_FEATURES for help on any new features.' - END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - EXTERNAL BULLETIN_SUBCOMMANDS - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.09 - END IFo - END IFe - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN. - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))s - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSEP - READ_ACCESS = 1 - END IFU - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1A - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)T - END IF - END IFC - END DON - - CALL CLOSE_BULLFOLDER ! We don't need file anymoreI - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE: - WRITE (6,1000) - END IF - IF (.NOT.SUBSCRIBE) THENI - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSEO - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))')= - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42)D - DO I = 1,NUM_FOLDERS, - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - J = INDEX(FOLDER1_DESCRIP,' ')i - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THENO - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1A - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IFc - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE'M - END IFD - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1T - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH7 - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THENo - NUM_FOLDER = 0( - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1),L - & 'HIT any key for next page....') - END IF - END DOH - IF (NUM_FOLDERS.EQ.0) THENA - WRITE (6,1050) - INDEX_COUNT = 0( - RETURN - END IFL - WRITE (6,1060)L - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURNE - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1A - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1E - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DOE - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - _ - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)f - ELSE IF (INEW) THEN - NEW = INEWH - IF (REMOTE_SET.GE.3) THENp - CALL NEWS_GET_NEWEST_MESSAGE(IER)O - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSE_ - CALL FIND_NEWEST_BULLN - END IF! - END IF - - IF (INCMD(:4).NE.'INDE') THEN - IER = CLI$DCL_PARSE('INDEX',BULLETIN_SUBCOMMANDS) - END IF - - CALL DIRECTORY(DIR_COUNT)M - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF' - - RETURN - -1000 FORMAT (' The following folders are present'/)' -1010 FORMAT (' The following folders with new messages are present'/)I -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10)' -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12)R -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...')R -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USERE -CD -C SUBROUTINE SHOW_USERI -CI -C FUNCTION: Shows information for specified users.E -C9 - IMPLICIT INTEGER (A-Z)) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'N - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAGA - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX)V - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2)N - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL')L - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USERL - - IF (.NOT.ALL) THENE - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IFE - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THENL - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IFE - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)_ - - FOLDER_PRESENT = CLI$PRESENT('FOLDER')_ - - IF (FOLDER_PRESENT) THEN0 - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z')Y - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME)U - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER)E - CALL CLOSE_BULLFOLDERA - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURNA - END IF - END IF - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START')= - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THENI - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THENO - WRITE (6,'('' ERROR: Invalid date specified.'')')F - RETURN) - END IF. - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURN - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THENU - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),A - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THENT - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURN( - END IFT - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN - END IF - ELSE IF (SINCE) THEN - IF (BULL_POINT.EQ.0) THENE - WRITE (6,'('' ERROR: No current message.'')') - RETURNI - ELSE IF (NEWS) THENK - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THENE - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSEY - STARTMSG = 1 - END IF - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_ASTF - IF (FOLDER_PRESENT) THENT - CALL OPEN_BULLINF_SHARED - IER = 0T - DO WHILE (IER.EQ.0.AND.FLAG.NE.1)S - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LASTR - END DO - ELSE, - IF (NEWS) THENS - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU)))Y - IF (LU.GT.1) THENG - TEMP_USER(LU-1:LU-1) =K - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))G - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IFA - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LASTG - END DO - END IF - UNLOCK 9Y - IF (IER.EQ.0) THEN' - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1I - END DOD - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND.P - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THENK - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0I - NEWSMSG = 1F - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER= - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DOK - IF (NEWSMSG.LE.FOLDER_MAX) THENR - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.08 - ELSER - FOUND = .FALSE.D - END IFY - IF (FOUND.AND.NEWS) THENR - WRITE (6,'(1X,A,'' latest message read '',9 - & I,''.'')'), - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN, - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')')C - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'',' - & '' to specified folder.'')')T - END IF - END IFE - IF (.NOT.ALL) THENY - IF (IER.NE.0) THENR - WRITE (6,'('' User info does not exist.'')') - END IFK - IER = 2 - END IF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE, - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IFW - ELSE - WRITE (6,'('' Entry for specified user not found.'')')H - END IF - CALL CLOSE_BULLUSERO - ELSEF - CALL OPEN_BULLUSER_SHAREDT - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1)' - CALL READ_USER_FILE(IER)I - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND.E - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEND - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,)' - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')')I - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF_ - END IF - END DO - CALL CLOSE_BULLUSER' - END IF' - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLI - - RETURN - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C( -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS:D -C IER - Error status. True if properly connected to folder. -C False if folder not found., -CE - IMPLICIT INTEGER (A - Z)P - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCPY - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK( - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP: - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATEI - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXTa - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPE - DATA SCRTYPE/-1/E - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocessT - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESSA - - FOLDER1_DIRECTORY = FOLDER_DIRECTORYL - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - IER1 = 1k - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',P - & FOLDER_DIRECTORY)r - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN = - IER1 = 1 - ELSE - IER1 = 0 - END IFc - END DOO - IF (IER2) THENH - CALL ADD_DIRECTORIES - ELSE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IF - END IF - END DO - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE.E - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF) - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - IF (.NOT.NEWS_FEED()) THENN - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data filen - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1= - LENGTH = NBLOCK ! Initialize line countI - ELSEX - CALL STRIP_HEADER(' ',0,IER) - END IFT - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IFY - - IF (NEWS_FEED().OR.LEN_FROM.EQ.0.OR. - & (BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0) - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0r - IF (IER1.NE.0) THEN( - OPEN (UNIT=3,DISPOSE='DELETE',FILE='BULL_DIR:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW')0 - SCRTYPE = 1 - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF. - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM)W - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol. - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO)C - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THENP - INDESCRIP = IN_DESCRIPt - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)Y - END IFi - ELSE - DESCRIP = ' ' - END IF - END IFI - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE.b - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPU - COMMON /MAIN_HEADER_INFO/ INEXDATEI - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - CHARACTER*256 BUFFERY - - REWIND (UNIT=3) - - IF (.NOT.NEWS_FEED()) THEN1 - IER = 0 - DO WHILE (IER.EQ.0)I - READ (3,'(A)',IOSTAT=IER) BUFFERo - IF (IER.EQ.0) THENU - CALL WRITE_MESSAGE_LINE(BUFFER)$ - END IF! - END DO - ELSE, - FOLDER1_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,'>')-1) - CALL SYS$SETAST(%VAL(1)) - CALL NEWS_POST('ignore',.TRUE.,IER,INDESCRIP)P - IF (TEST_BULLCP().EQ.2) CALL SYS$SETAST(%VAL(0)) - END IF - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3)n - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -CP -C SUBROUTINE WRITE_MESSAGE_LINE -CL -C FUNCTION: Writes one line of message into folder. -CC -C INPUTS: -C BUFFER - Character string containing line to be put into message., -CP - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROG - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAKE - DATA FIRST_BREAK/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFERt - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINEK - - CHARACTER*24 TODAYN - - DATA STORED /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THENr - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURNP - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR.E - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER= - RETURNt - ELSE IF (BUFFER(:5).EQ.'From:') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:)E - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURNp - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE. - OLD_BUFFER_FROM = .FALSE. - RETURNt - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:)K - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURNN - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THENm - LPRO = INDEX(INFROM,'%"') + 1E - PROTOCOL = INFROM(:LPRO) - END IF= - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCRS - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSEN - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIPS - IF (.NOT.BTEST(FOLDER_FLAG,5)) THENT - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSEU - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - END IFn - STORED = .TRUE.F - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STOREDJ - STORED = .FALSE. - END IF$ - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - END IF_ - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DOI - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THENR - IF (.NOT.FIRST_BREAK) THENO - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3)S - END IFE - LFROM = 0 - LDESCR = 0S - RETURNR - ELSE IF (.NOT.FIRST_BREAK) THENR - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THENe - LDESCR = LEN_BUFFER - 9' - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROMr - CALL STORE_FROM(INFROM,LFROM)R - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM)E - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSED - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IFT - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1C - CALL STORE_FROM(PROTOCOL(:LPRO)//D - & BUFFER(7:LEN_BUFFER)//'"',LFROM)A - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM)N - END IF - END IF - RETURNL - END IFN - ELSE - IF (LEN_BUFFER.GT.0) THEN - IF (.NOT.TEXT) THEN - IF (.NOT.NEWS_FEED()) THENE - TEXT = .TRUE. - ELSE - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - END IFN - IF (TEXT) THENE - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH))I - END IFE - ELSE - IF (TEXT) WRITE (3,'(A)') ' ' - END IFF - RETURNS - END IF - END IFR - - IF (LEN_BUFFER.EQ.0) THEN ! If empty lineN - IF ((TEXT.AND.NEWS_FEED()).OR. - & (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') ' ' - END IF - IF (.NOT.NEWS_FEED()) CALL STORE_BULL(1,' ',NBLOCK)E - ELSE% - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN_ - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER)M - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THENG - IF (INDEX(BUFFER(I:),' ').EQ.2) THENQ - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSEN - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2) - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-')I - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2_ - ELSE& - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO_ - INEXDATE = .TRUE. - END IF - END IF - IF (.NOT.NEWS_FEED()) THEN - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK)& - TEXT = .TRUE. - ELSE - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF) - IF ((TEXT.AND.NEWS_FEED()).OR. - & (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11))) THENC - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - END IF_ - - RETURNA - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -CR -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -Cr -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z)1 - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAKe - - COMMON /SCRTYPE/ SCRTYPE - - COMMON /TEXT_PRESENT/ TEXT) - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPX - COMMON /MAIN_HEADER_INFO/ INEXDATEa - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAYU - - CHARACTER USER_SAVE*12O - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN+ - CALL STORE_FROM(INFROM,LEN_FROM)L - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THENR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1T - FIRST_BREAK = .FALSE.C - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROMI - LEN_FROM = TRIM(INFROM)I - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN( - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)E - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IFD - - IF (NEWS_FEED()) THEN - CALL WRITEOUT_STORED A - CLOSE (UNIT=3) - CALL STRIP_HEADER(' ',0,IER) - TEXT = .FALSE. - RETURN - END IF - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entryN - RETURN - END IF - - TEXT = .TRUE. - - EXTIME = '00:00:00.00'L - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date formatO - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great?L - & .OR.IER.LE.0) THEN ! or expiration date not future1 - INEXDATE = .FALSE. ! Don't use it - END IFE - ELSE - INEXDATE = .FALSE. ! Don't use itL - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time?E - EXDATE = '5-NOV-2000' ! no, so set date far in futureC - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0T - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDERR - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.GE.0) THEND - SLIST = INDEX(FOLDER_DESCRIP,'<')T - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)e - INPUT = INPUT(:ILEN)t - CALL ADD_PROTOCOL(INPUT,ILEN)t - CLOSE (UNIT=3,STATUS='SAVE') - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME)F - END IFe - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN' - IER = LIB$SET_LOGICALR - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICALN - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARDC - END IF' - IF (SCRTYPE.EQ.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INPUT,N - & FOLDER(:TRIM(FOLDER))//' folder message: '//U - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSEL - CALL RESPOND_MAIL('BULL.SCR',INPUT,A - & FOLDER(:TRIM(FOLDER))//' folder message: '//' - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('BULL.SCR;*')r - END IFE - CALL SETUSER(USER_SAVE) - USERNAME = USER_SAVE' - ELSE - CLOSE (UNIT=3)E - END IF - SCRTYPE = -1 - END IFO - - RETURND - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z)m - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"'1 - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1F - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THENO - INFROM(I:I) = ''''F - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:)_ - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IFE - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' 'E - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ')F - INFROM = INFROM(2:)I - LEN_INFROM = LEN_INFROM - 1' - END DOS - - TWO_SPACE = INDEX(INFROM,' ')) - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1R - TWO_SPACE = INDEX(INFROM,' ') - END DOL - - IF (.NOT.NEWS_FEED()) THENT - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - END IF - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(INFROM,LEN_INFROM) - - RETURN - END - - - SUBROUTINE GET_FROM(INFROM,LEN_INFROM)) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INFROMN - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - I = INDEX(INFROM,'<') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<')+1:) ! personal-name - END IFI - - I = INDEX(INFROM,'(') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'(')+1:) ! personal-name (net-name) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR.INFROM(I:I).LE.' '.OR. - & INFROM(I:I).GE.CHAR(127).OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) - I = I + 1J - END DO. - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1L - - I = 1 ! Trim username to end at a alpha characterE - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND.L - & INFROM(I:I).NE.'%'.AND.. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND.INFROM(I:I).GT.' '.AND. - & INFROM(I:I).LT.CHAR(127).AND.R - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''')I - I = I + 1E - END DO1 - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEND - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a'))( - END IF - END DOP - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.126) - & INDESCRIP(I:I) = ' 'T - END DO_ - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:)f - LEN_DESCRP = LEN_DESCRP - 1P - END DOU - - IF (LEN_DESCRP.GT.LEN(DESCRIP).AND..NOT.NEWS_FEED()) THEN - ! Is length > allowable subject length?E - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IFT - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP)))E - - RETURNR - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER)A -CR -C SUBROUTINE STRIP_HEADER -CP -C FUNCTION: Indicates whether line is part of mail message header. -CC -C INPUTS: -C BUFFER - Character string containing input line of message.M -C BLEN - Length of character string. If = 0, initialize subroutine. -C) -C OUTPUTS:C -C IER - If true, line should be stripped. Else, end of header.F -C - IMPLICIT INTEGER (A - Z)B - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINED - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS( - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE.E - CONT_LINE = .FALSE.L - LAST_NEWSGROUPS = .FALSE.Q - RETURN - END IFF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE.N - END IFB - - IER = .TRUE.) - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuationE - & BUFFER(:1).EQ.CHAR(9))) THEN ! of previous header lineI - IF (LAST_NEWSGROUPS) THEN( - NEWSGROUPS = NEWSGROUPS(:TRIM(NEWSGROUPS))//BUFFER(2:)+ - END IF - RETURN - END IF - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuationT - LAST_NEWSGROUPS = .FALSE. - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN). - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THENR - DATE_LINE(TRIM(DATE_LINE)+1:) = '.'o - END IF - ELSE IF (BUFFER(:11).EQ.'Newsgroups:') THEN - NEWSGROUPS = BUFFER(13:)O - LAST_NEWSGROUPS = .TRUE. - END IFU - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - - RETURNR - END - - - - - SUBROUTINE SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF)A -C. -C SUBROUTINE SET_NEWS_FOLDER_DEFAULT. -CS -C FUNCTION: Sets flag defaults for specified news group -C Note: If NOTIFY READNEW and BRIEF = 0, it is either news = -C group removal or SET SUBSCRIBE command.I -CO - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - ALL = .FALSE. - DEFAULT = 1 - NODEFAULT = 0C - SUB = ABS(BRIEF)+ABS(NOTIFY)+ABS(READNEW).EQ.05 - - IF (NOTIFY.EQ.1.AND.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: /NOTIFY is invalid with non-stored'', - & '' news group.'')') - RETURN' - END IFN - - IF (INCMD(:3).EQ.'SET') THEND - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURNF - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLNEWS_SHAREDH - CALL OPEN_BULLINF_SHARED - IF (CLI$PRESENT('NOPERMANENT').OR.CLI$PRESENT('PERMANENT').OR. - & (SUB.AND.(NODEFAULT.OR.CLI$PRESENT('NOPERMANENT')))) THEN - DO WHILE (REC_LOCK(IER1))T - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_RECE - END DOC - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (SUB) DEFAULT = 1C - ELSE IF (CLI$PRESENT('NOPERMANENT').OR.NODEFAULT) THEN - IF (NOTIFY.GE.0) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - IF (SUB) - & CALL SET_NEWS_FLAG(IER,-1,-1,-1) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINFI - RETURN - END IF - IF (IER1.EQ.0) THEN, - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*PERM ',INF_REC - END IF - END IF - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - END IFF - - DO WHILE (REC_LOCK(IER1))I - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0E - INF_REC(2,I) = 0R - END DO - END IF( - IF (NODEFAULT.AND.SUB) THENR - NOTIFY = -1 - READNEW = -1 - BRIEF = -1 - END IFW - IF (DEFAULT.OR.NODEFAULT) THENE - IF (NODEFAULT.AND..NOT.SUB) THEN - IF (NOTIFY.NE.-1) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - ELSE - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF)D - END IF - IF (.NOT.IER) THENW - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IFE - IF (IER1.EQ.0) THENI - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_RECB - ELSE - WRITE (9,IOSTAT=IER) '*DEFAULT ',INF_REC - END IF - END IFF - IF ((ALL.OR.(SUB.AND.INCMD(:3).NE.'SET')).AND.IER.EQ.0) THENe - CALL OPEN_BULLUSER_SHARED. - CALL READ_USER_FILE_HEADER(IER)B - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0)R - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEND - TEMP_USER(LU-1:LU-1) =' - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))R - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY=TEMP_USER,IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DOQ - END IF - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE: - WRITE (9,IOSTAT=IER) TEMP_USER,INF_REC& - END IF_ - END IF) - CALL READ_USER_FILE(IER)O - END DOI - CALL CLOSE_BULLUSER - END IFR - - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - - RETURNL - END - - - - - SUBROUTINE READ_INF_REC - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'. - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL OPEN_BULLINF_SHAREDP - DO WHILE (REC_LOCK(IER1)): - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC( - END DO( - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO. - END IF - CALL CLOSE_BULLINFW - - RETURN - - ENTRY SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER.AND.L - & INF_REC2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1N - END DO - - IF (I.GT.FOLDER_MAX-1.AND.TEMP_USER(:1).EQ.'*') THENS - WRITE (6,'('' ERROR: You have '', - & '' reached the news folder limit of '',I,''.'')')R - & FOLDER_MAX-1 - IER = 0t - RETURN - END IF - - IF (INF_REC2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14)e - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14)E - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15)U - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15)i - IF (NOTIFY+READNEW+BRIEF.EQ.-3) THEN - DO J=I,FOLDER_MAX-2 - CALL COPY2(INF_REC(1,J),INF_REC(1,J+1))' - END DO - END IF - IER = 1 - RETURN - END IFI - - IF (NOTIFY+READNEW+BRIEF.EQ.-3) RETURNS - - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(N - & ZEXT(INF_REC2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(INF_REC(1,J),INF_REC(1,J-1))p - END IF) - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - INF_REC2(1,J) = NEWS_FOLDER_NUMBER' - IF (F_START.LE.F_NBULL) THEN - INF_REC2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - INF_REC(2,J) = F_START - 1' - ELSE - INF_REC2(2,J) = 0 - INF_REC(2,J) = F_NBULLE - END IFE - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13). - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13). - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IER = 1 - RETURNE - END IF - END DOE - - RETURN. - END diff --git a/decus/vms95a/bulletin/bullfiles.inc b/decus/vms95a/bulletin/bullfiles.inc deleted file mode 100644 index af8ee2e..0000000 --- a/decus/vms95a/bulletin/bullfiles.inc +++ /dev/null @@ -1,39 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vms95a/bulletin/bullfolder.inc b/decus/vms95a/bulletin/bullfolder.inc deleted file mode 100644 index 117f8fc..0000000 --- a/decus/vms95a/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vms95a/bulletin/bullmain.cld b/decus/vms95a/bulletin/bullmain.cld deleted file mode 100644 index 32c0642..0000000 --- a/decus/vms95a/bulletin/bullmain.cld +++ /dev/null @@ -1,34 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vms95a/bulletin/bullnews.inc b/decus/vms95a/bulletin/bullnews.inc deleted file mode 100644 index 251895d..0000000 --- a/decus/vms95a/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vms95a/bulletin/bullstart.com b/decus/vms95a/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vms95a/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vms95a/bulletin/bulluser.inc b/decus/vms95a/bulletin/bulluser.inc deleted file mode 100644 index 215a667..0000000 --- a/decus/vms95a/bulletin/bulluser.inc +++ /dev/null @@ -1,53 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vms95a/bulletin/changes.txt b/decus/vms95a/bulletin/changes.txt deleted file mode 100644 index 81c8117..0000000 --- a/decus/vms95a/bulletin/changes.txt +++ /dev/null @@ -1,611 +0,0 @@ -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages.. - -A major bug was fixed which was introduced in previous mods to speed upa -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vms95a/bulletin/cmds.mai b/decus/vms95a/bulletin/cmds.mai deleted file mode 100644 index 1340739..0000000 --- a/decus/vms95a/bulletin/cmds.mai +++ /dev/null @@ -1,22 +0,0 @@ -The address for getting BULLETIN is BULLETIN@PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file - (only one file per command). - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - -BULLETIN is also available via ANONYMOUS FTP from PFC.MIT.EDU, but the account -is set at low priority, so I suggest using it during non-prime hours. - - Mark diff --git a/decus/vms95a/bulletin/copyright.txt b/decus/vms95a/bulletin/copyright.txt deleted file mode 100644 index ee33a7e..0000000 --- a/decus/vms95a/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vms95a/bulletin/create.com b/decus/vms95a/bulletin/create.com deleted file mode 100644 index 5e90fde..0000000 --- a/decus/vms95a/bulletin/create.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vms95a/bulletin/handout.txt b/decus/vms95a/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vms95a/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vms95a/bulletin/install.com b/decus/vms95a/bulletin/install.com deleted file mode 100644 index 758acd4..0000000 --- a/decus/vms95a/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vms95a/bulletin/instruct.com b/decus/vms95a/bulletin/instruct.com deleted file mode 100644 index a9cf299..0000000 --- a/decus/vms95a/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vms95a/bulletin/instruct.txt b/decus/vms95a/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vms95a/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vms95a/bulletin/login.com b/decus/vms95a/bulletin/login.com deleted file mode 100644 index e4302af..0000000 --- a/decus/vms95a/bulletin/login.com +++ /dev/null @@ -1,28 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vms95a/bulletin/makefile b/decus/vms95a/bulletin/makefile deleted file mode 100644 index 0eb648a..0000000 --- a/decus/vms95a/bulletin/makefile +++ /dev/null @@ -1,82 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.21" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vms95a/bulletin/master.com b/decus/vms95a/bulletin/master.com deleted file mode 100644 index f1c5834..0000000 --- a/decus/vms95a/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel:C -$ !I -$ run pmdf_root:[exe]ftcp_master -$ goto out1l -$ ! -$ CN_channel:i -$ !s -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277M -$ !L -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master( -$ goto out1_ -$ !+ -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vms95a/bulletin/mx.com b/decus/vms95a/bulletin/mx.com deleted file mode 100644 index 7d87c28..0000000 --- a/decus/vms95a/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */L - - } - } - } - rms_get(&rcptrab); /* Read next recipient */e - }u - - - /* Close the RMS files */r - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab);f - - tracemsg("BULLETIN message processed");y - exit(SS$_NORMAL); /* Always return success */ - -}L -$eod t -$copy/log sys$input MX_BULL.TXTm -$deckM - MX_BULL_ - An MX SITE transport. - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution:- - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN?h ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site.t - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including theS -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands:n - - SEND ALL Sends all bulletin files.. - SEND filename Sends the specified file.e - BUGS Sends a list of the latest bug fixes.D - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. Thei -build procedure for MX_BULL expects the logical BULL_SOURCE to point to theo -BULLETIN library. You must define this logical (or edit the .COM file)m -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct):L - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>"* - -3. If you don't have a SITE transport already defined, simply copyu - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULLe - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin deliveringc -messages to BULLETIN.t - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail tod -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETINm -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL) - MAIL> SENDU - To: MX%"GENERAL@BULLETIN" - Subj: This is a test....a - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITEu -agent, since the @BULLETIN path was defined as a SITE path.f - -To facilitate the automatic delivery of messages to BULLETIN folders, youi -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN"""/ - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN"""t - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to/ -BULLETIN via MX_BULL.d - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST ..../ - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.)u - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder.M - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwardingm -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When maild -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the messagee -to the Local agent, which discovers that the mail is forwarded tos -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUEf - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The; -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logicalf -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return addressr -for BULLETIN messages will look something like the following:t - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM:s - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayedW -to death, leaving a bad address on the "From:" line. This frequently happensa -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by:b - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnety - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226s - Western Kentucky University - Bowling Green, KY 42101 -$eod t -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$decka -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headersb -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1.u -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3i -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"?( -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file/ -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it upn -$ close tmp !...t -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr;s -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:"b -$ endifb -$ exit 1 !Always return success -$eod N diff --git a/decus/vms95a/bulletin/mx.mai b/decus/vms95a/bulletin/mx.mai deleted file mode 100644 index ec864aa..0000000 --- a/decus/vms95a/bulletin/mx.mai +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_LIBRARY") .eqs. "" -$ then say "BULL_LIBRARY logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_library/LIB,SYS$SYSTEM:SYS.STB/SEL,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_LIBRARY to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P4 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P4 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P4 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p4 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p2' 'p3' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p2' 'p3' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vms95a/bulletin/news.alt b/decus/vms95a/bulletin/news.alt deleted file mode 100644 index e33d065..0000000 --- a/decus/vms95a/bulletin/news.alt +++ /dev/null @@ -1,254 +0,0 @@ - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales diff --git a/decus/vms95a/bulletin/news.com b/decus/vms95a/bulletin/news.com deleted file mode 100644 index fb7775e..0000000 --- a/decus/vms95a/bulletin/news.com +++ /dev/null @@ -1,679 +0,0 @@ -$set nover -$copy/log sys$input NEWS.ALT -$deck - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales -$eod -$copy/log sys$input NEWS.CREATE -$deck -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - -$eod -$copy/log sys$input NEWS.MODERATORS -$deck -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com -$eod diff --git a/decus/vms95a/bulletin/news.create b/decus/vms95a/bulletin/news.create deleted file mode 100644 index dc1c840..0000000 --- a/decus/vms95a/bulletin/news.create +++ /dev/null @@ -1,155 +0,0 @@ -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - diff --git a/decus/vms95a/bulletin/news.moderators b/decus/vms95a/bulletin/news.moderators deleted file mode 100644 index b53780f..0000000 --- a/decus/vms95a/bulletin/news.moderators +++ /dev/null @@ -1,260 +0,0 @@ -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com diff --git a/decus/vms95a/bulletin/news.txt b/decus/vms95a/bulletin/news.txt deleted file mode 100644 index c942cf0..0000000 --- a/decus/vms95a/bulletin/news.txt +++ /dev/null @@ -1,160 +0,0 @@ -BULLETIN has the capability to read and post messages to USENET NEWS in a -client mode. News groups can also be stored on disk. Selected groups or set -of groups which are commonly read can be selected to be stored, thus making -reading of such groups much faster than having to access them over a network. -Note that since the number of groups is well over 2000 makes it unreasonable -at most sites to store them all. - -BULLETIN (actually BULLCP) can act as as a gateway between decnet and tcp for -NEWS, which allows decnet nodes without tcp access to be able to access a tcp -news server. This method does not require spawning any processes, since the -detached process BULLCP is always present, so the access is very fast. - -Since BULLETIN uses a shared database to store info on the NEWS groups and -periodically updates it, there is no need for that to be done when a user -accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. - -It is also possible to feed NEWS groups into a "real" BULLETIN folder. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. - -The instructions for installation are as follows. Define BULL_NEWS_SERVER to -be a system logical name pointing to either your internet or decnet NEWS node. -If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -If you have a cluster where one node is an internet node, and the rest -non-internet nodes, you'll have to create a startup procedure that defines -BULL_NEWS_SERVER to be the internet news server address only on the node (or -nodes) on the cluster that have actually internet access. The other nodes -will have BULL_NEWS_SERVER defined as the decnet node name that BULLCP is -running on in the cluster. (Of course, BULLCP will have to be running on a -node with internet access.) - -NOTE: If you want to disable the DECNET gateway feature, then before starting -BULLCP, define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -If you want to enable the TCP gateway, you must define BULL_TCP_NEWS_GATEWAY -(NOTE: This presently only works with MULTINET, and you must have UCX -emulation enabled, i.e. enable UCXQIO from the SCU and do a SET -LOAD-UCX-DRIVER TRUE from the NCU.) Where this feature is useful is to allow -an ip node access to a news server which it does not have permission to do so -directly. - - $ DEFINE/SYSTEM BULL_TCP_NEWS_GATEWAY "TRUE" - -BULL_TCP_NEWS_GATEWAY can be defined to point to a file name which contains ip -names that are allowed access. The file should contain real ip names. Blank -lines and comments (preceded by #) are allowed. If you want a whole domain to -be allowed, specify the domain preceded by a ., i.e. .pfc.mit.edu . - -You can also specify that BULLCP is ONLY to act as a NEWS gateway. This is to -allow adding the news gateway to an site that you have DECNET access to, but -which does not want to make use of any of the other BULLETIN features. You -would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of the -local host. This is done automatically for nodes running MULTINET. For other -nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This can -be hardcoded into the source by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, -it will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. BULLCP will update NEWS every hour. If you -want to change this frequency, define the logical name BULL_NEWS_UPDATE to the -number of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" -for 30 minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does -the update. You can watch how long it takes for this to run in order to -determine if you want to change the update period). If you ever want to force -NEWS to be updated, simply restart BULLCP. - -It is suggested that you run OPTIMIZE_RMS.COM on BULLNEWS.DAT, as it will cause -the file to be compressed and will allow updates to run much faster (factor of -5 or more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -News groups can be specified as being stored on disk via the SET NEWS command. -See the online help for more info. After converting such groups, when BULLCP -wakes up, it will start the storing process. This can take a long time if you -have a lot of groups. This process will create sub-directories under the main -directory BULL_DIR to store the news groups. The sub-directories will be -named starting with BULLNEWS. - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description -surrounded by <>, i.e. . It must be in lower case. (Other text is -allowed in the description, i.e. "THIS IS A TEST FOLDER ".) - -BULLETIN is set up so that when a person replies to a message and extract the -original message into the reply message, it uses the idention string "->" for -the extracted text. The reason for this rather than ">" is that some news -servers won't allow messages which have more extracted text than new text and -test for ">". If you want to change that, then change the default strings for -all the INDENT qualifier line in the file BULLCOM.CLD before compiling. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages -which are passed between nodes. Originally it was limited to USENET, but that -is no longer the case. Unlike internet mailing lists which use MAIL to send -the messages to individuals, NEWS messages are not sent via MAIL. They are -passed between nodes using a special protocol, NNTP. Users must use a NEWS -reader package to read them. However, it is possible to read NEWS remotely -over a network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to FTP.UU.NET -via ANONYMOUS FTP and look through the directory uumap or uunet-sites to find -a USENET node near you to contact. diff --git a/decus/vms95a/bulletin/nonsystem.txt b/decus/vms95a/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vms95a/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vms95a/bulletin/optimize_rms.com b/decus/vms95a/bulletin/optimize_rms.com deleted file mode 100644 index 4f42e3e..0000000 --- a/decus/vms95a/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vms95a/bulletin/pmdf.com b/decus/vms95a/bulletin/pmdf.com deleted file mode 100644 index 85c77b1..0000000 --- a/decus/vms95a/bulletin/pmdf.com +++ /dev/null @@ -1,1031 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input BULLETIN_MASTER.PAS_V32i -$deck' -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound);; - -(*******************************************************************)a -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *) -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - - outbound : text; - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL - 100; - - VAR - line, errorsto : vstring; - bigline : bigvstring; result : rp_bufstruct; - header : he_header; - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string); - - BEGIN (* try_something *) - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *) - end; (* try_something *) - - BEGIN (* return_bad_messages *) - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt'); - try_something (he_read_header (header, qu_rtxt), 'he_read_header'); - errorsto.length := 0; - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i]; - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto), - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr); - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *) - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages (tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable. - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT - -For V3.2: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check your -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vms95a/bulletin/restart.com b/decus/vms95a/bulletin/restart.com deleted file mode 100644 index 502bfa8..0000000 --- a/decus/vms95a/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vms95a/bulletin/setuser.mar b/decus/vms95a/bulletin/setuser.mar deleted file mode 100644 index 153cb7b..0000000 --- a/decus/vms95a/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vms95a/bulletin/update.fil b/decus/vms95a/bulletin/update.fil deleted file mode 100644 index 97fb572..0000000 --- a/decus/vms95a/bulletin/update.fil +++ /dev/null @@ -1,11 +0,0 @@ -$ if p1 .nes. "" then FS 'P1' -$ COPY 'FM' [.SEND]/LOG -$ COPY 'FM' CMODA::IR:[BULLETIN] -$ TAB2SP 'FM' -$ RENAME 'FM' [-.NET] -$ PUR [.SEND]'FM' -$ PUR [-.NET]'FM' -$ IF FM .EQS. "CHMAIL.MAI" THEN P3 = "AAAREADME." -$ IF P2 .EQS. "" THEN COPY 'FM' [ANONYMOUS.BULLETIN]'P3' -$ IF P3 .EQS. "" THEN PUR [ANONYMOUS.BULLETIN]'FM' -$ IF P3 .NES. "" THEN PUR [ANONYMOUS.BULLETIN]'p3' diff --git a/decus/vms95a/bulletin/upgrade.com b/decus/vms95a/bulletin/upgrade.com deleted file mode 100644 index a2d77c4..0000000 --- a/decus/vms95a/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vms95a/bulletin/writemsg.txt b/decus/vms95a/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vms95a/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vms95b/bulletin/aaareadme.txt b/decus/vms95b/bulletin/aaareadme.txt deleted file mode 100644 index fb97c8c..0000000 --- a/decus/vms95b/bulletin/aaareadme.txt +++ /dev/null @@ -1,201 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vms95b/bulletin/allmacs.mar b/decus/vms95b/bulletin/allmacs.mar deleted file mode 100644 index b7498eb..0000000 --- a/decus/vms95b/bulletin/allmacs.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vms95b/bulletin/allmacs_axp.mar b/decus/vms95b/bulletin/allmacs_axp.mar deleted file mode 100644 index efb71ec..0000000 --- a/decus/vms95b/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vms95b/bulletin/board_digest.com b/decus/vms95b/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vms95b/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vms95b/bulletin/board_special.com b/decus/vms95b/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vms95b/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vms95b/bulletin/bull_news.c b/decus/vms95b/bulletin/bull_news.c deleted file mode 100644 index 4f09cd3..0000000 --- a/decus/vms95b/bulletin/bull_news.c +++ /dev/null @@ -1,705 +0,0 @@ -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} diff --git a/decus/vms95b/bulletin/bull_newsdummy.for b/decus/vms95b/bulletin/bull_newsdummy.for deleted file mode 100644 index a17d3ec..0000000 --- a/decus/vms95b/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,99 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END diff --git a/decus/vms95b/bulletin/bullcom.cld b/decus/vms95b/bulletin/bullcom.cld deleted file mode 100644 index f3ec7e6..0000000 --- a/decus/vms95b/bulletin/bullcom.cld +++ /dev/null @@ -1,742 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 5/30/95 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vms95b/bulletin/bullcoms1.hlp b/decus/vms95b/bulletin/bullcoms1.hlp deleted file mode 100644 index d5542b9..0000000 --- a/decus/vms95b/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1236 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with -> at the beginning of each line. This can be -suppressed or the indentation character changed with /[NO]INDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message will -be deleted after the node on which the message was submitted from is -rebooted. If you wish the message to be deleted after a different node -reboots, you have the option of specifying that node name. The message -deletion is keyed by BULLETIN running on the node that reboots. It -writes into the database info that the node has rebooted, and when -BULLCP wakes up and sees this info, it will delete any shutdown messages -for that node. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers so -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file can -be specified which contains the text. If the editor is used for changing -the text, the old message text will be extracted. This can be suppressed -by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST - -If a mailer protocol is needs to be added to the network address in -order for it to be sent by VMS MAIL, i.e. protocol%"address", the -appropriate protocol can be specified by either hardcoding it into the -file BULLNEWS.INC before compiling BULLETIN, or by defining the system -logical name BULL_NEWS_MAILER (it is the same protocol used by the NEWS -feature in order to respond to NEWS messages). The default protocol is -IN%. If desired, you can specify the protocol with the address, i.e. - - INFOVAX MAILING LIST -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. The -identifier can not be any longer than 12 characters. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually stored -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, the -folder will then be modified to point to that folder. For example if -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be shared -between more than one node. This capability is only present if the BULLCP -process is running on the remote node via the BULL/STARTUP command. -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specify -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message.R -It can be a substring of the subject. This is in case you have forgottene -the exact subject that was specified. Case is not critical either.s -You will be notified if the deletion was successful. -See also /NEGATED. -2 /USERNAME. -Specifies username to be used at remote DECNET nodes when deleting messagesc -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name,r -date, and subject of each message is displayed.I - - Format:i - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message.t -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /CONTINUEh -Used with /GROUP. Allows you to continue a search after you have broken -the search by entering a command, i.e. READ, SEARCH, etc. Note: If you -enter a SEARCH command which specifies a string, and then continue the -directory search using /CONTINUE, the new search pattern will be used -when continuing the search. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description ofo -folder. -2 /EXPIRATIONb -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the DIRECTORY -command are to be written into the specified file. All qualifiers which -are valid for the EXTRACT command are valid in conjunction with /EXTRACT -except for /NEW which conflicts with the DIRECTORY /NEW qualifier. The -listof messages to be printed will be displayed on the terminal (in -nopaging format). - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /FEEDBACKl -Used only in conjunction with /GROUP. Specifies to show when new news -groups are selected. l -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS.c -2 /FROMa - /FROM=[string]n - -Specifies that only messages whose username contains the specified string, -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.p -See also /NEGATED. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Used with the search -qualifiers /SEARCH, /SUBJECT, or /FROM. Wildcards are permitted in the -specified string. Use /FEEDBACK to see when groups are selected. At -any time during the search you may enter other commands, i.e. you may -read a message, see a full directory listing, etc. You may then restart -the search listing by typing DIR/CONTINUE. For more info, see help on -the /CONTINUOUS qualifier. r -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don't -match the specified search command are displayed. -2 /MARKEDb -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see alli -messages, use either /ALL, or reselect the folder. I -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicatedo -by an asterisk). Using /UNMARKED is equivalent to selecting the folderi -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEENi -Lists messages that have been seen (indicated by a greater than sign). s -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. To see allr -messages, use either /ALL, or reselect the folder. -2 /UNSEENl -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folderE -with /UNSEEN, i.e. only unseen messages will be shown and be able to bea -read. To see all messages, use either /ALL, or reselect the folder. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWSt -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED.o -2 /SEARCHo - /SEARCH=[string] - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.a -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.p -2 /START - /START=message_number - -Indicates the first message number you want to display. For example,l -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDEy -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings. - - Format:y - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. A - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE.s -2 /FROMA -Specifies to exclude the message based on the message owner. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. When /FULL is specified, the EXCLUDE command will -not add an exclude, so it can't be used with any other qualifier except -for /DISABLE.e -2 /LIMIT - /LIMIT=days - -Specifies that the exclude will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. k -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROMz -and /SUBJECT cannot be specified at the same time. -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):stringl - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:killn - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program.t -1 EXTRACT -Synonym for FILE command.s -1 FILE -Copies the current message to the named file. If the file exists, the -message is appended to the file, unless the /NEW qualifier is specified. - - Format:e - FILE [filename] [message_number][-message_number1],[...] - -If the filename is omitted, a file will be created based on the name of -the folder. - -A range of messages to be copied can optionally be specified, i.e. FILE -2-5. The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. e - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /ALL -Copies all the messages in the current folder. -2 /FFh -Specifies that a form feed is placed between messages in the file. -2 /HEADERl - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file.s -1 FIRSTa -Specifies that the first message in the folder is to be read. -1 Folders -All messages are divided into separate folders. New folders can beb -created by any user. As an example, the following creates a folder forc -GAMES related messages: - r -BULLETIN> CREATE GAMES -Enter a one line description of folder.e -GAMESe - -To see the list of available folders, use DIRECTORY/FOLDERS. To selecta -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, thatp -user will be alerted of topics of new messages at login time, and will m -then be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option,n -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command.T - -A folder can be restricted to only certain users, if desired. This is t -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATEl -rather than /PRIVATE is specified, all users can read the messages in thet -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SETr -NODE. A remote folder is one which points to a folder on a remote DECNET -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)c -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/, -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, andb -giving access to that UIC group. Only users in that UIC group will seeD -the messages in that folder when they log in.e -1 FORWARDf -Synonym for MAIL command.a -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INCLUDEw -Specifies to include reading messages based on the message owner or the -subject. If it is determined that a message is to be included, then the -message is read when a user tries to read a message by typing NEXT or -BACK, or by hitting the return key. Otherwise, it is skipped. Specify -the qualifier /FULL to make all EXCLUDEs and INCLUDEs for the specified -folder apply to all other BULLETIN commands, including directory -listings. - - Format:a - INCLUDE [string] - -If a string is specified, then the message is included if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one INCLUDE may be -specified per folder. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all INCLUDEs. -2 /DISABLE -Specifies to permanently disable the INCLUDE.r -2 /FROMh -Specifies to include the message based on the message owner. This iso -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. When /FULL is specified, the INCLUDE command will -not add an include, so it can't be used with any other qualifier except -for /DISABLE. -2 /SUBJECT -Specifies to include the message based on the message subject. /FROM -and /SUBJECT cannot be specified at the same time. p -2 Storing_INCLUDEs -INCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):stringv - -In order for /FULL to be the default for a folder, the following linee -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 INDEX -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for E -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after ones -has read a message. /RESTART must be specified to start from the first -folder if a scan is in progress. All other qualifiers are ignored while c -a scan is in progress. - - Format:h - INDEX - -When a directory is displayed, you can read the first message in the -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for oldert -versions of BULLETIN. -2 /MARKEDe -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED,e -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKEDi -Lists messages that have not been marked (marked messages are indicatedN -by an asterisk). Using /UNMARKED is equivalent to selecting the folderf -with /UNMARKED, i.e. only unmarked messages will be shown and be ableE -to be read.S -2 /SEENX -Lists messages that have been seen (indicated by a greater than sign). r -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read.e -2 /UNSEENE -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the foldert -with /UNSEEN, i.e. only unseen messages will be shown and be able to bew -read.i -2 /NEW - /[NO]NEWc - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message.r -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified.. -2 /RESTART -If specified, causes the listing to be reinitialized and start from they -first folder.t -2 /SET - /[NO]SET - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format: - LASTl -2 /EDIT -Specifies that the editor is to be used to read the message. This isC -useful for scanning a long message.c -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command* -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEa -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format:, - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying anu -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" mustt -be specified as xxx%"""address""". -2 /EDITo -Specifies that the editor is to be used to edit the message before -mailing it. -2 /HEADERn - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the N -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of morei -than one word, enclose the text in quotation marks (").i - -If you omit this qualifier, the description of the message will be useda -as the subject.l -1 MARK -Sets the current or message-id message as marked. Marked messages aree -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of importantU -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers]e - UNMARK [message-number or numbers]o - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to byl -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGINe -will be used. -1 MODIFY -Modifies the database information for the current folder. Only the -owner of the folder or a user with privileges can use this command. - - Format:N - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted forh -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing listi -via the BBOARD feature, and you wish to use the POST and RESPOND/LISTd -commands, the address of the mailing list should be included in thei -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST o -2 /IDr -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presentlyR -assigned to it. Any process which has that identifier assigned to its -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID.d -1 MOVE -Moves a message to another folder and deletes it from the current -folder.s - - Format:r - - MOVE folder-name [message_number][-message_number1]e - -The folder-name is the name of the folder to which the message is to bee -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,3 -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPSs - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADERL - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER.t -2 /MERGE -Specifies that the original date and time of the moved messages aret -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.d -2 /ORIGINALE -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned byo -the person moving the message. -1 NEWS -Displays the list of available news groups.a - -Format:t - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed.h - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL wille -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /DEFAULT -If specified, will show news groups that have be defined as default -groups using the SET SUBSCRIBE command.e -2 /NEWGROUPu -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /PERMANENT -If specified, will show news groups that have be defined as permanentL -groups using the SET SUBSCRIBE command.n -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B.o -2 /STOREDi -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 New_features -Here is a list of new features which may be of interest to the general o -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - --------------------------------------------------------------------------u -V 2.23 -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95e - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95t - -V 2.22 - -SHOW EXCLUDE and INCLUDE commands added. 5/16/95 - -V 2.21 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -Added /FOLLOWUP to POST command when used with news groups. It specifiesn -which news group you want replies to your message to be sent to. 10/28/94 - -V 2.20 - -Logical names can be specified in POST/GROUPS=. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/11/94 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93s - -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93l - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group byN -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92W - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92d - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over.c -2 /EDITa -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message.E -2 /HEADER. - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commandl -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATEs -Specifies to decode the message using ROT-13 coding. diff --git a/decus/vms95b/bulletin/bullcoms2.hlp b/decus/vms95b/bulletin/bullcoms2.hlp deleted file mode 100644 index ca634f2..0000000 --- a/decus/vms95b/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1399 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with -> at the -beginning of each line. This can be suppressed or the indentation -character changed with /[NO]INDENT. -2 /FOLLOWUP - /FOLLOWUP=string - -Specifies that any replies generated by people reading the message -should be sent to the specified newsgroup. This is useful if you want -to post to more than one group, but don't want reply messages posted on -all the groups. To specify more than one newsgroup, surround the list -with quotes, i.e. FOLLOWUP="newsgroup1,newsgroup2". If replies should -only be sent to the message owner and not a newsgroup, the string -"poster" should be specified. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message -to the specified NEWS group(s) in addition to the selected NEWS group. -Logical names are allowed. -2 /HEADER -Allows customized headers line to be added to the message header. When -specified, header lines can be added by inserting them at the top of the -message, with the header lines and the text of the message separated by -a blank line. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. -In order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply -surround the exclusive text starting with the line "START " -and ending with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The file created by the PRINT command is not -released to the print queue until you exit, unless you add the qualifier -/NOW or change one of the print job's qualifiers. Multiple messages are -concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /CANCEL -Cancels any messages waiting to be printed. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL level -to find out the name of the mounted form and the default form for a -particular queue. If you specify a form whose stock is different from -the stock of the form mounted on the queue, your job is placed in a -pending state until the stock of the mounted form of the queue is set -equal to the stock of the form associated with the job. (In order to -have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the file -or files have been printed. If /NONOTIFY is specified, there is no -notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 QUIT -Exits the BULLETIN program. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. If you -specify a number greater than the number of messages in the folder, the -last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -/HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /INDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read -them. (Note: Reading the last message does the same thing, but RESET -does it without having to read it.) -2 /CURRENT -Resets the new message counter to the current message. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using the -qualifer /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected or /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text strings. - - Format: - - SEARCH [search-string[,...]] - -The search starts from the first message in the current folder. You can -specify the message to start at using the qualifier /START. If you use -this qualifier without a parameter, it starts with the current message. -The search includes both the text of the message, and the description -header. If a "search-string" is not specified, a search is made using -the previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, a -search can be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FEEDBACK -Used only in conjunction with /FOLDER and /GROUP. Specifies to show -when new folders or news groups are selected. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for a -match. If, during a search, no more matches or messages are found, the -next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. Use /FEEDBACK to see when folders are -selected. News groups can be specified here. However, to search news -group with wild cards, use /GROUP. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Wildcards are permitted in -the specified string. If the string does not contain an * and does not -specify a news group, * is automatically placed at the beginning and end -of the string. I.e. if the string is "comp", then all news groups -containing the word "comp" will be searched. Use /FEEDBACK to see when -groups are selected. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /MATCH - /MATCH[=option] - -Interprets and matches multiple search strings in one of the following -ways: - - AND A match occurs only if all of the strings are found. - - OR A match occurs if any of the strings are found. - - XOR A match occurs if only one of the strings is found. - -If you specify none of these options, the default is /MATCH=OR. If you -specify the /NEGATED qualifier, you will get the negated operation. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If no -starting message is specified, the search is started from the last -message. /REVERSE must be specified with a search string. -2 /START - /START=message_number - -Specifies the message number to start the search at. If you omit the -message number, it starts with the current message. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUSm -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name.h - - Format:E - - SET [NO]ANONYMOUSS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read.r - - Format:i - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If -ADD_ONLY is set and a mailing address is present (see /DESCRIPTION), -when a message is added to the folder, it will also be mailed to the -address (in addition to being stored in the folder). This also applies -to a message which is added via the BBOARD feature . If ADD_ONLY is set -and a user uses the POST command, the ADD command will be used instead. -One use for this is to mail messages in a folder to users who do not -have access to BULLETIN. U - - Format:, - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2.o - - Format:i - - SET BBOARD [username]h - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages.h - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30", -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The formi -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY.i -The time will always be 00:00, even if the time is specified on the line.w -3 /EXPIRATIONT - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature.f -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be:W - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account.e - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV.s -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION.l -2 BRIEFl -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa).e - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERS - /FOLDER=foldernamep - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENTa - -Specifies that BRIEF is a permanent flag and cannot be changed by the -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier.h -2 COMPRESS -Specifies that messages added to the folder will be in compressed format. -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires s -very little cpu overhead.t - - Format:l - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. / -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed every -time when logging in, until the new messages are read. Normally, the -BRIEF setting causes notification only at the first time that new messages -are detected.m - - Format:] - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for theg -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges.l - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used.c - - Format:p - - SET DEFAULT_EXPIRE daysi - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages. - - Format:t - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format:o - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it. -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format:, - - SET [NO]EXPIRE_LIMIT [days]s - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) h -2 EXCLUDEe -Specifies to ignore any EXCLUDEs or INCLUDEs that are present. - - Format:h - - SET [NO]EXCLUDEs - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or INCLUDEs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 EXLIMITh -Specifies the default limit for the EXCLUDE command. - - Format:e - - SET EXLIMIT days - -If no match is found for an exclude after the specified number of days, -the exclude will automatically be deleted. The default is no limit, -which is specified by specifying 0 days. This default can be overriden -by the /LIMIT switch on the EXCLUDE command. -2 FILE_DIRECTORY -Select the directory where messages are written to when using the -EXTRACT or file COMMAND. By default, the message is written into the -current directory. g - - Format:e - - SET FILE_DIRECTORY [directory] - -If directory is omitted, the setting is removed. Note: This information -is stored in the customization file (SYS$LOGIN:BULL.CUSTOM). -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format:c - - SET FOLDER [node-name::][folder-name]e -3 /MARKEDc -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will haveu -to be reselected. -2 GENERICv -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for thee -same user. -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new messages will be displayed for upon -logging in. -2 KEYPAD h -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format:h - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to by. -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI.w -2 LIBRARYt -Specifies a library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command to see if there are other libraries. -2 LOGINm -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command.e - - Format:s - - SET [NO]LOGIN username -2 NAME -Copies all stored settings from one user to another. Used when a user's -account name is changed. - - Format:a - - SET NAME old-username new-username -2 NEWS -Changes attributes of the specified news group or class of news groups. -This command requires privileges.n - - Format:e - - SET NEWS [news-group]n - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALL. - /NOALLt - -If specified with /CLASS or /DEFAULT, all groups that are presently -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of anyE -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the defaulte -attributes (using /DEFAULT) with /NOALL, the attributes for misc.testn -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. e -3 /CLASS - /CLASS=classnamem - -Specifies to modify attributes for a class of news groups rather than ae -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes ofK -existing groups which are in the class are modified, and any groups -created in the future will automatically have those attributes. -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETE. -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLE -Specifies that the news group is enabled and can be accessed. This isl -the default. -3 /EXPIRATIONd - /EXPIRATION=daysy - -Specifies the default expiration time for messages if none is specified. -The default is 7.e -3 /FULLl -Control whether all information of the news groups is displayed, i.e. -the access list if the news group is private. This information is only -those who have access to that folder. -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified isb --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default.e -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is postede -every month with an expiration date of one month in the future.a -3 /PRIVATE - /PRIVATEe - /NOPRIVATEn - -Specifies that the news group or class can have it's access modified by -the SET ACCESS command. To accomplish this, a file is created ine -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access M -to news groups in that class is to set /NOPRIVATE, as then time won't be d -wasted checking a file for ACLs. -3 /STOREDa - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessedi -via the network from the server node. This results in faster access, -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED.h -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node.r - - Format:s - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder.s - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node,s -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated. -3 /FOLDERD - /FOLDER=foldernamet - -Specifies the folder for which the node information is to modified.e -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format:m - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are loggede -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specifiedh -folder. This is a privileged qualifier. It will only affect brand newc -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernamet - -Specifies the folder for which the option is to modified. If nott -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENTt - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN.o - - Format:l - - SET [NO]PAGE -2 POST_ONLYp -Specifies that the selected folder has the POST_ONLY attribute. This -causes the ADD command to mail the message to the mailing address if it -is present (see /DESCRIPTION), rather than add to the folder. L - - Format:e - - SET [NO]POST_ONLYh -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format:n - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers.y -3 /IDt - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.e -2 PROMPT_EXPIREr -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format:S - - SET [NO]PROMPT_EXPIRE -2 READNEWe -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command.e - - Format:i - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersp -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newp -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER0 - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If nots -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENTo - -Specifies that READNEW is a permanent flag and cannot be changed by the -individual. This is a privileged qualifier. -2 SHOWNEWA -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN.s - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format: - - SET [NO]SHOWNEWO -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new userse -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all -users. t -3 /FOLDERh - /FOLDER=foldernames - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENTs - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged -qualifier. t -2 STRIPi -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If STRIP -is set, the header of the mail message will be stripped off before it is -stored as a BULLETIN message. - - Format:T - - SET [NO]STRIPl - -The command SHOW FOLDER/FULL will show if STRIP has been set.s -2 SUBSCRIBEo -Can be used to force users to be subscribed to the selected news group. -This is a privileged command. - - Format:b - - SET SUBSCRIBEp - -Note: If you execute the commands SET SHOWNEW, READNEW, BRIEF, or -NOTIFY, and add /DEFAULT or /PERMAMENT, it is equivalent to doing a SET -SUBSCRIBE command with the addition that the specified feature will be -the default and/or permanent setting. -3 /ALL -Specifies that all present and future users will be subscribed to the -news group. -3 /DEFAULT - /[NO]DEFAULTP - -Specifies that new users will automatically be subscribed to the news -group. -3 /PERMANENT - /[NO]PERMANENTl - -Specifies that new users will automatically be subscribed to the news -group and that users cannot unsubscribe the news group. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 EXCLUDEl -Displays the list of excludes which are present for the current folder. -The right hand side of the display shows the date of the last time a -match for the exclude was found, and also the number of days from the -time of the last match after which the excludes expires. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. u -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected -via the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name]f -3 /FULLB -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 INCLUDEe -Displays the list of includes which are present for the current folder.i -2 KEYPAD -Displays the keypad command definitions. - - Format: - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either SET KEYPAD, or if /KEYPAD is -specified on the command line, the keypad keys will be defined as -commands. The default settings for the keypad are shown via SHOW KEYPAD -or HELP KEYPAD. Settings can be changed by using an initialization file -with DEFINE/KEY commands. BULLETIN looks first for the file pointed to -by the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -3 /STATE - /STATE=(state,state,...) - -Specifies the name of a state for which the specified key definitions -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when a -key name has been specified. -2 LIBRARY -Shows the library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the /ALL -qualifier to see if there are other libraries. o -3 /ALL -Specifies to show all available libraries. -2 NEWo -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format:a - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this.T -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command.e -3 /LOGIN - /[NO]LOGINe - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDERf - /FOLDER=[foldername]h - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups.m -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSIONi -Shows the version of BULLETIN and the date that the executable was -linked.n -1 SPAWNi -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format:e - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBEL -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of thex -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. n -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format:l - UNDELETE [message-number]t -1 UNSUBSCRIBEs -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See the -SUBSCRIBE command for further info. -1 Usenet_newss -BULLETIN can also read USENET NEWS if your system has network access tos -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of b -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group in -order to keep track of which messages you have read in that group. Most -of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read news groups with new messages, use INDEX/SUBSCRIBE. diff --git a/decus/vms95b/bulletin/bulldir.inc b/decus/vms95b/bulletin/bulldir.inc deleted file mode 100644 index f66cc78..0000000 --- a/decus/vms95b/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vms95b/bulletin/bullet1.com b/decus/vms95b/bulletin/bullet1.com deleted file mode 100644 index 44e1788..0000000 --- a/decus/vms95b/bulletin/bullet1.com +++ /dev/null @@ -1,2474 +0,0 @@ -$set nover -$copy/log sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. -$eod -$copy/log sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) -$eod -$copy/log sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. -$eod -$copy/log sys$input BULLETIN.LNK -$deck -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.23" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.23" -$eod -$copy/log sys$input BULLFILES.INC -$deck -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ -$eod -$copy/log sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) -$eod -$copy/log sys$input BULLNEWS.INC -$deck - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ -$eod -$copy/log sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy/log sys$input BULL_NEWS.C -$deck -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} -$eod -$copy/log sys$input CHANGES.TXT -$deck -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. -$eod -$copy/log sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy/log sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy/log sys$input NEWS.TXT -$deck -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when a -user accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. It is also possible to -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) When the POST and -ADD commands are used with this folder, the messages will be posted to the news -group, rather than actually being added to the folder. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. -$eod -$copy/log sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod -$copy/log sys$input WRITEMSG.TXT -$deck -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/vms95b/bulletin/bullet2.com b/decus/vms95b/bulletin/bullet2.com deleted file mode 100644 index b77fd75..0000000 --- a/decus/vms95b/bulletin/bullet2.com +++ /dev/null @@ -1,1678 +0,0 @@ -$set nover -$copy/log sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy/log sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy/log sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 5/30/95 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE -$eod -$copy/log sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP -$eod -$copy/log sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP -$eod -$copy/log sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy/log sys$input BULL_NEWSDUMMY.FOR -$deck - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END -$eod -$copy/log sys$input CREATE.COM -$deck -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK -$eod -$copy/log sys$input INSTALL.COM -$deck -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy/log sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy/log sys$input LOGIN.COM -$deck -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! If you want to have more than one BULLETIN database, replace BULL_DIR -$! with the actual directory to allow redefining BULL_DIR. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! -$eod -$copy/log sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.23" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* -$eod -$copy/log sys$input OPTIMIZE_RMS.COM -$deck -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS -$eod -$copy/log sys$input RESTART.COMI -$deckR -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL_ -DO DEASSIGN BULL_DISABLE/SYSTEME -$ BULL/START -$eod E -$copy/log sys$input SETUSER.MARL -$deckE - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -;R - .LIBRARY /SYS$LIBRARY:LIB.MLB/t - $PCBDEF ;define PCB offsetsX - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program -$eod -$copy/log sys$input UPGRADE.COM -$deck -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE -$eod diff --git a/decus/vms95b/bulletin/bulletin.cld b/decus/vms95b/bulletin/bulletin.cld deleted file mode 100644 index deb3c36..0000000 --- a/decus/vms95b/bulletin/bulletin.cld +++ /dev/null @@ -1,44 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vms95b/bulletin/bulletin.com b/decus/vms95b/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vms95b/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vms95b/bulletin/bulletin.for b/decus/vms95b/bulletin/bulletin.for deleted file mode 100644 index e42418d..0000000 --- a/decus/vms95b/bulletin/bulletin.for +++ /dev/null @@ -1,2031 +0,0 @@ -C -C BULLETIN.FOR, Version 8/4/95 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - CALL INIT_BULLETIN(.TRUE.) - -C -C The MAIN loop for processing bulletin commands. -C - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - CALL DO_COMMAND(INCMD) - -100 CONTINUE - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) - - END - - - - - SUBROUTINE DO_COMMAND(INCMD) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - CHARACTER*(*) INCMD - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (HLEN.EQ.0) THEN - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - END IF - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL' - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (NEWS_FEED().OR.REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - WRITE (6,'('' ERROR: /FOLDER not valid when posting'', - & '' a message to a news group.'')') - ELSE - INCMD = 'POST '//INCMD(4:) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - END IF - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,'('' ERROR: There are no more preceding messages.'')') - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.,.FALSE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR - ELSE IF (INCMD(:4).EQ.'INCL') THEN ! INCLUDE? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'FI') THEN ! SET FILE_DIRECTORY? - CALL SET_CUSTOM('file_directory') - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SH') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SU') THEN ! SET SUBSCRIBE? - IF (REMOTE_SET.GE.3) THEN - D1 = 0 - D2 = 0 - D3 = 0 - CALL SET_FOLDER_DEFAULT(D1,D2,D3) - ELSE - WRITE (6,'('' ERROR: Command invalid for folder.'')') - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LIB') THEN ! SET LIBRARY? - CALL SET_LIBRARY - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS? - CALL SET_NEWS - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE? - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE? - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:3).EQ.'EXL') THEN ! SET EXLIMIT? - CALL SET_CUSTOM('exclude_limit') - ELSE IF (BULL_PARAMETER(:4).EQ.'NAME') THEN ! SET NAME? - CALL SET_NEWNAME - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'EX') THEN ! SHOW EXCLUDE? - CALL SHOW_EXCLUDE(0) - ELSE IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:2).EQ.'IN') THEN ! SHOW INCLUDE? - CALL SHOW_EXCLUDE(1) - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SHOW LIBRARY - CALL SHOW_LIBRARY - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATION - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1) - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN? - CALL TAG(.FALSE.,2) - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - - RETURN - END - - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - CHARACTER INEXDATE*12,INEXTIME*12,INDENT*4 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT') - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - LENI = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',INDENT,LENI) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LENI.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') INDENT(:LENI)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2100' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2100' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60) - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60) - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - IF (CLI$PRESENT('EXTRACT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35 - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - BLENGTH = BLENGTH + ILEN - 1 + 2 - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE. - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting.'', - & '' A truncated message will be broadcast.'')') - CALL GET_INPUT_PROMPT(INPUT,ILEN, - & 'Type C to continue, A to only ADD message, or Q to Quit: ') - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN - BRDCST = .TRUE. - END IF - END IF - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! Username - END IF - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THEN - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '// - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK) - END IF - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletin - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IF - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF (FOLDER_NUMBER.GE.0) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF -C -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP, -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same cluster -C as that of the BULLCP node. -C - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET) - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - ELSE IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR. - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LENDES),STATUS) - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IF - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (CLI$PRESENT('EXTRACT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*4 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP)) - - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG) - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC' - - DATA READ_UAI/.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE. - RETURN - END IF - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE. - END IF - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURN - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')') - RETURN - END IF - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN) - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN() - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - RETURN - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - SUBROUTINE INIT_BULLETIN(NOX) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - DATA PAGE_LENGTH/24/,PAGE_WIDTH/80/ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (NOX) CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER(:LEN_P) - CALL CHECK_DIR(BULL_PARAMETER,.FALSE.) - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - END IF - CALL LIB$REVERT - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE IF (COMMAND_PROMPT(I:I).EQ.'/') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL(.FALSE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS1') THEN - CALL NEWS2BULL(.TRUE.) - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - IF (NOX) CALL CRELNM('SYS$INPUT','TT') ! Input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - IF (NOX) CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - - CALL OPEN_OLD_TAG - - IF (.NOT.NOX) THEN - CALL NEW_MESSAGE_NOTIFICATION - RETURN - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IF - END IF - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - - RETURN - END diff --git a/decus/vms95b/bulletin/bulletin.hlp b/decus/vms95b/bulletin/bulletin.hlp deleted file mode 100644 index cf279b3..0000000 --- a/decus/vms95b/bulletin/bulletin.hlp +++ /dev/null @@ -1,151 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vms95b/bulletin/bulletin.lnk b/decus/vms95b/bulletin/bulletin.lnk deleted file mode 100644 index 7d7af23..0000000 --- a/decus/vms95b/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.23" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.23" diff --git a/decus/vms95b/bulletin/bulletin0.for b/decus/vms95b/bulletin/bulletin0.for deleted file mode 100644 index d7c7c08..0000000 --- a/decus/vms95b/bulletin/bulletin0.for +++ /dev/null @@ -1,2361 +0,0 @@ -C -C BULLETIN0.FOR, Version 7/17/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IER1 = SBULL + 1 - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER1) - IER2 = 0 - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.TEST_NEWS_OWNER().AND.SETPRV_PRIV()) THEN - WRITE (6,1055) - READ (5,'(A)',IOSTAT=IER2) DESCRIP - END IF - END IF - IF (IER2.EQ.0.AND.IER1.EQ.SBULL+1) CALL - & REMOTE_DELETE(SBULL,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.NE.USERNAME - END IF - IF (ASK) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,1055) - READ (5,'(A)',IOSTAT=IER) DESCRIP - IF (IER.NE.0) RETURN - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.(TEST_NEWS_OWNER().OR. - & SETPRV_PRIV())) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) -1055 FORMAT(' State reason for deleting message not owned by you.') - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2),EX(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:9).EQ.'19') EXDATE(8:9) = '18' - IF (EXDATE(8:9).EQ.'20') EXDATE(8:9) = '19' - IF (EXDATE(8:9).EQ.'18'.AND.EXDATE(10:10).LT.'6') - & EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX,EX) - IER = SYS$ASCTIM(,INPUT,EX,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /CTRLC_FLAG/ FLAG - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - CHARACTER GROUP*80,STAT*4 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - FOUND = 0 - - CONT = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - CONT = CLI$PRESENT('CONTINUE') - ELSE IF (INCMD(:3).EQ.' '.AND.NFOLDER.LT.0) THEN - CONT = .TRUE. - END IF - IF (CONT) THEN - SUBJECT = SUBJECT1 - REPLY = REPLY1 - SEARCH = SEARCH1 - FROM_SEARCH = FROM_SEARCH1 - SINCE = SINCE1 - NEW = NEW1 - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - IF (.NOT.ANY_SEARCH) THEN - WRITE (6,'('' ERROR: No previous search to continue.'')') - RETURN - END IF - INCMD = ' ' - LEN_P = 0 - DIR_COUNT = DIR_COUNT1 - NFOLDER = NFOLDER1 - I = DIR_COUNT - IF (DIR_COUNT.EQ.-1) THEN - I = SBULL - 1 - END IF - GO TO 200 - END IF - NFOLDER = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - EXTRACTING = CLI$PRESENT('EXTRACT') - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - NEGATED = CLI$PRESENT('NEGATED') - IF (SEARCH) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (SUBJECT) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (FROM_SEARCH) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (REPLY) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3 - NEGATED = .TRUE. - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - ELSE - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - IF (INCMD(:3).EQ.'IND') THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - REPLY_FIRST = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - ELSE - NEW = .FALSE. - END IF - END IF - OUTPUT = EXTRACTING.OR.PRINTING - - START = .FALSE. - SINCE = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - NFOLDER1 = -1000 - SUBJECT1 = SUBJECT - REPLY1 = REPLY - SEARCH1 = SEARCH - FROM_SEARCH1 = FROM_SEARCH - I = SBULL - 1 - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - SINCE1 = SINCE - NEW1 = NEW - GOTO 200 - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - IF (NEW.AND.IER.EQ.0) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - IF (READ_TAG) CALL DECREMENT_MSG_KEY - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) NUM = NUM + 1 - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - END IF - I = I - 1 - END DO - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - END IF - IF (NUM.GT.0) I = I - 1 - END DO - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) NUM = NUM + 1 - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) J = J + 1 - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I1 = SBULL - I = SBULL - DO WHILE (I.LE.EBULL) - CALL READDIR(I1,IER) ! Into the queue - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1 - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - I = I + 1 - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1 - END IF - I1 = I1 + 1 - END DO - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - EBULL = EBULL - SBULL + DIR_COUNT - SBULL = DIR_COUNT - I = SBULL - END IF - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY, - & TAG_TYPE) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVE - END IF - END IF - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - END IF - ELSE - NBULL = 0 - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN - DIR_TYPE = 'seen' - END IF - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - IF (INCMD(:3).EQ.'DIR'.AND.ANY_SEARCH) THEN - IF (.NOT.CLI$PRESENT('START').AND. - & .NOT.CLI$PRESENT('CONT')) THEN - WRITE (6,'('' No matches found starting search'', - & '' from message number '',I)') SBULL - DIR_COUNT = -1 - GO TO 9999 - END IF - END IF - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - IF (NFOLDER.EQ.0) - & CALL DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION) - - TAG = (BULL_TAG.AND.(REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1)).OR. - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THEN - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN - START_SEARCH = BULL_POINT - END IF -200 CLOSED = .FALSE. - IF (ANY_SEARCH.OR.OUTPUT) THEN - NUM = 0 - IF (NFOLDER.NE.-1000) THEN - CLOSED = .TRUE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - CLOSED_FILES = .FALSE. - SEARCH_NUM = 1 - REVERSE = .FALSE. - END IF - DO WHILE (I.LE.EBULL.AND.FOUND.GT.-3) - IF (.NOT.ANY_SEARCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (NFOLDER.NE.-1000.AND.I.GE.SBULL) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SLEN,0, - & START_SEARCH,REVERSE,SUBJECT,REPLY_FIRST,.FALSE., - & .TRUE.,FROM_SEARCH,NEGATED,.FALSE.) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - IF (NFOLDER.LT.0.AND.(I.EQ.F_START.OR.I.EQ.DIR_COUNT)) THEN - IF (FEEDBACK) CALL LIB$ERASE_PAGE(1,1) - CALL - & DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION) - DIR_COUNT = 0 - BULL_POINT = MSG_NUM - 1 - PRINT_HEADER = .TRUE. - END IF - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - TAG_TYPE = DUMMY - END IF - IF (NFOLDER.LT.0.AND..NOT.OUTPUT) THEN - NUM = NUM + 1 - IF (NUM.EQ.PAGE_LENGTH-6) I = EBULL + 1 - END IF - ELSE IF (NFOLDER.LT.0.AND.(OUTPUT.OR.I.LE.SBULL)) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSED = .FALSE. - END IF - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - CALL CLOSE_BULLFOLDER - IF (GFOUND) THEN - START_BULL = 0 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - IF (F1_START.GT.0.AND.F1_START.LE.F1_NBULL) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - START_SEARCH = F_START - 1 - IF (IER.AND.(NEW.OR.SINCE)) THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER1,DATETIME) - CALL CLOSE_BULLDIR - IF (IER1.NE.0) THEN - START_SEARCH = IER1 - 1 - ELSE - IER = 0 - END IF - END IF - END IF - IF (.NOT.IER.OR.F1_START.EQ.0.OR. - & F1_START.GT.F1_NBULL) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER, - & IER) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - GFOUND = .FALSE. - IF (FLAG.EQ.1) CALL CLOSE_BULLFOLDER - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - SBULL = F_START - I = SBULL - 1 - EBULL = F_NBULL - END IF - ELSE - NFOLDER = 0 - END IF - END DO - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - ELSE IF (NFOLDER.EQ.0) THEN - WRITE (6,'('' No messages found.'')') - END IF - IF (NFOLDER.EQ.0) I = EBULL + 1 - IF (NFOLDER.LT.-1000) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED = .TRUE. - END IF - NFOLDER1 = NFOLDER - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - I = EBULL + 1 - END IF - CALL CANCEL_CTRLC_AST - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.GE.SBULL.AND.I.LE.EBULL.AND.NFOLDER.NE.-1000) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN - OUTLINE = '>' - ELSE - OUTLINE = ' ' - END IF - IF (BTEST(SYSTEM,29)) THEN - OUTLINE(2:) = '*' - ELSE - OUTLINE(2:) = ' ' - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3) - IF (EXDATE(8:12).LT.'1994'.AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin? - EXPIRES = 'Permanent' - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11) - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9) - ELSE - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11) - END IF - NOTHING = .FALSE. - WRITE(6,'(1X,A)') OUTLINE - IF (OUTPUT) THEN - FOUND_MSG = .TRUE. - CALL SYS$SETAST(%VAL(0)) - NEXT = .FALSE. - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES) - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES,PRINT_HEADER) - PRINT_HEADER = .FALSE. - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0 - ELSE - MSG_NUM = -MSG_NUM - END IF - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1)) - END IF - END IF - I = I + 1 - IF (ANY_SEARCH) IER = SYS$CANTIM(,) - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.OUTPUT) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IF - END IF - - IF (DIR_COUNT.GT.NBULL - & .OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THEN - ! Outputted all entries? - IF (PRINTING) THEN - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THEN - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IF - ELSE IF (EXTRACTING.AND.FOUND_MSG) THEN - CALL FILE(0,CLOSED_FILES,.FALSE.) - END IF - IF (NFOLDER.LT.0) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE - DIR_COUNT = -1 ! Yes. Set counter to -1. - END IF - ELSE IF (NFOLDER.NE.0.OR.(-NFOLDER1.EQ.FOLDER_NUMBER.AND. - & INCMD(:1).EQ.' ')) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE IF (FLAG.NE.1) THEN - WRITE(6,1010) ! Else say there are more - END IF - -9999 POSTTIME = .FALSE. - NEXT = .FALSE. - IF (NFOLDER.NE.0.OR.-NFOLDER1.EQ.FOLDER_NUMBER) THEN - DIR_COUNT1 = DIR_COUNT - IF (DIR_COUNT1.GT.NBULL) DIR_COUNT1 = -1 - END IF - RETURN - -1010 FORMAT(1X,/,' Press RETURN for more...',/) -1020 FORMAT(1X,/,' Press RETURN for more, type SEARCH to read ', - & 'these messages.',/) - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER) - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT,PRINT_HEADER) -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER*128 FILENAME - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THEN - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IF - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THEN - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IF - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = FILE_NUM - EBULL = SBULL - END IF - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F) - - IF (.NOT.IER) THEN - FILENAME = FOLDER - DO I=1,LEN(FILENAME) - IF (FILENAME(I:I).EQ.'.') FILENAME(I:I) = '_' - END DO - FILENAME = FILENAME(:TRIM(FILENAME))//'.TXT' - LEN_F = TRIM(FILENAME) - END IF - - IF (TRIM(FILE_DIRECTORY).GT.0.AND.INDEX(FILENAME,':').EQ.0 - & .AND.INDEX(FILENAME,'[').EQ.0) THEN - FILENAME = FILE_DIRECTORY(:TRIM(FILE_DIRECTORY))//FILENAME - LEN_F = TRIM(FILENAME) - END IF - - CALL STR$UPCASE(FILENAME,FILENAME) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE. - FIRST = .TRUE. - END IF - - IF (PRINT_HEADER) THEN - WRITE (3,'(/,''Newsgroup: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1 - IF (FBULL1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - OPENED = .FALSE. - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(FBULL,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DO - -100 IF (FILE_NUM.GT.0) THEN - FILE_NUM = -FILE_NUM - RETURN - END IF - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created. - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - END IF - - GO TO 10 - -900 WRITE(6,1000) FILENAME(:LEN_F) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message ',A,' written to ',A) -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A) -1050 FORMAT('Subj: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN) - - CALL LIB$MOVC3(8,IN,OUT) - - RETURN - END - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - FOLDER_NAME = FOLDER - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSE - RETURN ! Don't notify - END IF - END IF - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSE - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM) - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time - ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSER - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LOGIN_BTIM_NEW) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF - - CALL GET_NODE_NUMBER(NODE_NUMBER1,NODE_AREA1) - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100 - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IGNORE = BTEST(SYSTEM,2).AND.(NODE_AREA.EQ.NODE_AREA1).AND. - & (NODE_NUMBER.AND.NODE_NUMBER1) - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF ((USERNAME.NE.FROM.OR.SYSTEM).AND..NOT.IGNORE) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - ELSE - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - END IF - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - INREAD = '+' - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' ' - END IF - IF (LEFT) THEN - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN) - LEFT = .FALSE. - ILEN = 0 - INREAD = '+' - ELSE IF (ILEN.LE.WIDTH) THEN - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN) - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSE - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ') - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH) - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0) - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DO - IF (INPUT(ILEN:ILEN).EQ.' ') THEN - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEN - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE. - ELSE - WIDTH = PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE (6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....')e - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1S - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')')P - ELSEE - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IFR - ! Bulletin number is stored in SYSTEM - ELSED - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEMC - END IFE - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0)R - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THENU - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated.L - END IF -C -C Instruct users how to read displayed messages if READNEW not selected.P -CE - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.) - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030). - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - PAGE = PAGE + 1T - ELSEC - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILENU - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)//I - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN) - & //' '//FOLDER_NAME(:FLEN)//L - & ' to read these messages.' - END IF - PAGE = PAGE + 1' - END IF - -9999 IF (LOGIN_SWITCH) THENo - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF - RETURNR - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'))L -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.')e -1080 FORMAT(' ',/) - - END - - - B - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlistE - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)),N - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0D - END IF - - RETURNt - END - - - - SUBROUTINE DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION) - - IMPLICIT INTEGER (A - Z)R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'R - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGI - - CHARACTER*(*) OUTLINE - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULLN - ELSEE - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IFE - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ')T - OUTLINE(I+1:) = OUTLINE(I+2:)R - END DOH - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ')E - OUTLINE(I+1:) = OUTLINE(I+2:) - END DOT - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ') - OUTLINE(I:) = OUTLINE(I+1:)O - END DO( - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINE - BULL_PARAMETER = ' 'M - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1)) THENL - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THEN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IFL - IF (PRINTING) THENf - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - END IFE - - WRITE (6,'(''+'',A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE))$ - IF (EXPIRATION) THEN, - WRITE(6,1005) - ELSEL - WRITE(6,1000)o - END IFr - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/) - - RETURNN - END - - - - SUBROUTINE GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - - IMPLICIT INTEGER (A - Z)_ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'( - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER TODAY(2) - - CHARACTER DATETIME*24 - - IF (SINCE) THEN ! Was /SINCE specified? - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY)C - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER)E - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),a - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - IER = 0 - RETURN - ELSE$ - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IFR - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - END IF - END IFf - - RETURN - END diff --git a/decus/vms95b/bulletin/bulletin1.for b/decus/vms95b/bulletin/bulletin1.for deleted file mode 100644 index cbb4ae0..0000000 --- a/decus/vms95b/bulletin/bulletin1.for +++ /dev/null @@ -1,2263 +0,0 @@ -C -C BULLETIN1.FOR, Version 9/14/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - CHARACTER*256 SENDTO - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_S = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',SENDTO(LEN_S+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_S = LEN_S + I + 1 - SENDTO(LEN_S:LEN_S) = ',' - END DO - LEN_S = LEN_S - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_S) - IF (SENDTO(I:I).EQ.'"') THEN - SENDTO = SENDTO(:I)//'""'//SENDTO(I+1:) - I = I + 2 - LEN_S = LEN_S + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',SENDTO(:LEN_S) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//SENDTO(:LEN_S) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*32 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256,TODAY*24 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - IF (IER1.EQ.0) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THEN - I = IER - ELSE - NUM_COPY = NUM_COPY + 1 - END IF - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (.NOT.ORIGINAL.AND.REMOTE_SET.EQ.4).OR.REMOTE_SET.EQ.3 - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0.AND.NEWS_FEED()) THEN - IF (.NOT.ORIGINAL) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - IER1 = .FALSE. - ELSE - REMOTE_SET = 3 - END IF - END IF - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - ELSE - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF (TO_NEWS.AND.ORIGINAL) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2100' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (REMOTE_SET.GE.3.AND..NOT.ORIGINAL) THEN - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT) - ELSE - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - IF (.NOT.ORIGINAL) SYSTEM = IBSET(SYSTEM,3) - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (POST_NEWS) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADER - IF (ORIGINAL.AND.(NEWS_FEED().OR.REMOTE_SET.EQ.4)) RETURN - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IF - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./ - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND. - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0 - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN) - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0) - IF (CHANGED) THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IF - - IF (INCMD(:4).EQ.'PRIN') THEN - IF (CLI$PRESENT('CANCEL')) THEN - WRITE (6,'('' Cancelling all previously queued messages.'')') - CLOSE (UNIT=24,DISPOSE='DELETE') - FIRST = .TRUE. - RETURN - END IF - END IF - -50 IF (PRINT_NUM.EQ.0) THEN - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = PRINT_NUM - EBULL = SBULL - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name - IF (QLEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - END IF - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100 - CLOSE (UNIT=24,DISPOSE='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - END IF - -1040 FORMAT(' Message ',A,' sent to printer.') -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE. - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) - END IF - - CALL DISABLE_PRIVS - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A, - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE. - GO TO 50 - END IF - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ_MSG -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /POST/ POSTTIME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH) - CHARACTER HEADLINE*132 - - LOGICAL SINCE,PAGE - - EXTERNAL CLI$_NEGATED - - FIRST = BULL_READ.LT.F_START - KILL = BTEST(BULL_USER_CUSTOM,3) - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3) - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE. - END IF - ROTC = CLI$PRESENT('ROTATE') - END IF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSE - BULL_READ = 1 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified? - NEW = .TRUE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READDIR_KEYGE(IER) - IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_BTIM) - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - CALL CLOSE_BULLDIR - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - END IF - END DO - CALL CLOSE_BULLDIR - ELSE - IER = 0 - DO WHILE (IER.EQ.0) - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - MSG_NUM = IER - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - END IF - END DO - END IF - BULL_READ = IER - IER = IER + 1 - END IF - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999 - ELSE - BULL_READ = IER - IER = IER + 1 - END IF - SINCE = .TRUE. - END IF - END IF - - NEXT = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - IF (.NOT.SINCE.AND..NOT.NEW - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THEN - IER = 0 - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR. - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN - MSG_NUM = F_NBULL+1 - ELSE - MSG_NUM = BULL_NOW - END IF - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE - CALL GET_THIS_OR_NEXT_TAG - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0 - END IF - END IF - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END IF - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END DO - CALL CLOSE_BULLDIR - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READ - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSE - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0 - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IF - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE. - CALL READDIR(BULL_READ,IER) - END IF - END IF - IF (REMOTE_SET.LT.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - IF (IER.NE.BULL_READ+1) THEN - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0 - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) ! If not, then error out - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - - SAVE_BULL_POINT = BULL_POINT - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(FIRST.OR.NEW.OR.NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEN - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - - IF (.NOT.OK) THEN - BULL_POINT = SAVE_BULL_POINT - BULL_NOW = MSG_NUM - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN - BULL_READ = MSG_NUM - 1 - ELSE - BULL_READ = MSG_NUM + 1 - IF (INCMD(:4).EQ.'FIRS'.OR.FIRST) NEXT = .TRUE. - END IF - IF (REMOTE_SET) CALL CLOSE_BULLFIL - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - IF (BULL_READ.GT.F_NBULL.OR.BULL_READ.LT.F_START) THEN - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - GO TO 50 - END IF - BLOCK = BLOCK_SAVE - END IF - - NEXT = .FALSE. - IF (REMOTE_SET.LT.3) THEN - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.BULL_READ) CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - END IF - - EDIT = .FALSE. - - PAGE_WIDTH = REAL_PAGE_WIDTH - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN - IF (CLI$PRESENT('EDIT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 9999 - END IF - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTH - PAGE = .FALSE. - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSE - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL - END IF - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:) - END DO - I = TRIM(HEADLINE) - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)) - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - ELSE - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ' - & .AND..NOT.BTEST(SYSTEM,3)) THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROM - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - IF (EDIT) WRITE(3,'(1X)') - ELSE - END = END + 1 - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IF - END IF - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) THEN - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter - GO TO 9999 - END IF - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - -9999 POSTTIME = .FALSE. - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - RETURN - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO - - RETURN - END - - - - - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1 - EQUIVALENCE (INREAD4,INREAD) - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - BULL_POINT_READ = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - - GO TO 12 - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - - BULL_POINT = BULL_POINT_SAVE - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN - ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL FILE(0,.TRUE.,.FALSE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THEN - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THEN - WRITE (6,'(''+B'',$)') - INCMD = 'RESPOND/LIST' - ELSE - GO TO 11 - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')') - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLY - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message', - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),', - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) -1040 FORMAT(' Type P to post reply, U to reply to user,', - & ' B to do both, or other to quit: ',$) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END - - - - - LOGICAL FUNCTION NEWS_FEED() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - I = SLIST + 1 - FLEN = TRIM(FOLDER_DESCRIP) - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN - I = FLEN + 1 - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND. - & FOLDER_DESCRIP(I:I).NE.'@'.AND. - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE - I = FLEN + 2 - END IF - END DO - IF (I.EQ.FLEN+1) NEWS_FEED = .TRUE. - END IF - - RETURN - END diff --git a/decus/vms95b/bulletin/bulletin10.for b/decus/vms95b/bulletin/bulletin10.for deleted file mode 100644 index 1afad2d..0000000 --- a/decus/vms95b/bulletin/bulletin10.for +++ /dev/null @@ -1,3628 +0,0 @@ -C -C BULLETIN10.FOR, Version 9/29/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - COMMON /HEADER_SEEN/ HEADER_SEEN - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - LAST_LF_SEEN = LF_SEEN - LAST_REAL_LF_SEEN = REAL_LF_SEEN - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - CR_SEEN = INDEX(BUFFER(START_READ:END_READ),CR) - IF ((END_LINE.EQ.0.AND.CR_SEEN+START_READ-1.LT.END_READ) - & .OR.CR_SEEN.LT.END_LINE-1) THEN - END_LINE = CR_SEEN - CR_SEEN = 1 - ELSE - CR_SEEN = 0 - END IF - LF_SEEN = END_LINE.GT.0 - IF (END_LINE.GT.257-CR_SEEN.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - IF (.NOT.HEADER_SEEN) END_LINE = 254 - END IF - REAL_LF_SEEN = INDEX(BUFFER(START_READ:END_READ),LF).LE.END_LINE - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - IF (BUFFER(EB:EB).EQ.LF) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - IF (EB.GT.0.OR.LAST_LF_SEEN) RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE(:MIN(LEN(WRITE),256)) - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - NEWS_WRITE = NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - - LOGICAL FUNCTION NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - NEWS_RECONNECT = .FALSE. - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - NEWS_RECONNECT = .TRUE. - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /HEADER/ HEADER - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER().OR.SETPRV_PRIV()) THEN - IF (REMOTE_SET.EQ.4) THEN - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (INPUT(:11).EQ.'Message-ID:') THEN - MESSAGE_ID = INPUT(14:ILEN-1) - ILEN = 0 - END IF - END DO - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - CALL NEWS_POST('cancel',0,IER,SUBJ) - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - DO WHILE (BUFFER(SB:EB).NE.'.'.AND. - & .NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX( - & BUFFER(SB:EB),' ')+SB-2),J,,%VAL(1))) - IF (.NOT.NEWS_READ()) RETURN - END DO - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - STAT = .TRUE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(FROM,TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - HEADER_SEEN = .FALSE. - LF_SEEN = .FALSE. - LAST_LF_SEEN = .FALSE. - REAL_LF_SEEN = .FALSE. - LAST_REAL_LF_SEEN = .FALSE. - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8 - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONE - CHARACTER*4 ZONE - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/ - - CHARACTER*8 TIMES(1) - DATA TIMES /'-5:30'/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - IF (INDEX(ZONES,ZONE)/4.LT.4) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) - END IF - ELSE - HOUR = '00:00' - END IF - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_TI_L(TIME(:2),DATE,,%VAL(1)) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - NEWSGROUPS = ' ' - FOLLOWUP = ' ' - LREF = 0 - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.'.OR..NOT.LAST_REAL_LF_SEEN) - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126) - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(FROM,BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+11).EQ.'Followup-To:'.AND. - & EB.GT.SB+12) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+13:EB))+SB+12 - FOLLOWUP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - CALL GET_FROM(FROM,FROM_LINE(7:),TRIM(FROM_LINE)) - LAST_FROM = .TRUE. - ELSE - LAST_FROM = .FALSE. - END IF - END IF - END DO - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'1FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - START = -1 - CALL NEWNEWS(IN_BTIM,IER) - IF (IER.NE.0) START = IER -C -C The following code makes use of the NNTP command NEWNEWS, but is -C known to be slow and buggy in many servers. -C -C IER = SYS$ASCTIM(,TIME,IN_BTIM,) -C CALL DATE_TIME(TIME) -C SKIP = 0 -C DO WHILE (SKIP.GE.0) -C IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( -C & FOLDER_NAME))//' '//TIME)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C IF (BUFFER(:2).EQ.'23') THEN -C IF (.NOT.NEWS_READ()) CALL EXIT -C DO I=1,SKIP -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (FIRST.EQ.'.') RETURN -C DO WHILE (BUFFER(SB:EB).NE.'.') -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) -C & CALL EXIT -C IF (.NOT.NEWS_READ()) CALL EXIT -C IF (BUFFER(:2).EQ.'22') THEN -C IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN -C I = F_NBULL + 1 -C DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. -C & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) -C & .OR.I.GT.F_NBULL)) -C I = I - 1 -C IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN -C IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C END DO -C IF (I.GE.F_START) START = I -C ELSE -C IER = OTS$CVT_TI_L(BUFFER(SB+4: -C & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) -C END IF -C RETURN -C END IF -C END IF -C SKIP = SKIP + 1 -C END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2 - IER = IER1 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - CHARACTER*256 TEMP - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IF - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0 - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE - IER = NEWS_READ() - IF (IER.AND.(BUFFER(SB:EB).NE.'.' - & .OR..NOT.LAST_REAL_LF_SEEN)) THEN - IER = 0 - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THEN - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF ((INDEX(TEMP,': ').EQ.0.AND. - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255).OR. - & (LTEMP.EQ.254.AND..NOT.LAST_LF_SEEN)) THEN - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IF - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IF - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF - ELSE - HEADER_SEEN = .TRUE. - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128 - ELSE - ILEN = 128 - END IF - END IF - ELSE - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ABS(ILEN).EQ.128) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - HEADER_SEEN = .TRUE. - - RETURN - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /READIT/ READIT - - COMMON /NEWS_INIT/ END_READ - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - - DIMENSION DUMMY(4) - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - END_READ = 0 - IF (.NOT.NEWS_LOGIN()) THEN - IER = 2 - RETURN - END IF - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY) - IF (SYSLOG) THEN - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3)) - END IF - END IF - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUP - - CHARACTER*8 NUMBER - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURN - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1 - RETURN - ELSE IF (ICOUNT.EQ.-1) THEN - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THEN - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURN - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - START = ICOUNT - BULLETIN_NUM = START - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0 - CALL NEWS_HEADER(IER) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - BLOCK = START - MSG_NUM = START - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN - END - - - - SUBROUTINE NEWS_GROUP(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN - IER = 1 - RETURN - END IF - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)) - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT') - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURN - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME - - CHARACTER*28 TIME - - DIMENSION DIFF(2) - - I = 1 - LTIME = TRIM(INTIME) - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:)) - - DO J = 1,2 - I = 1 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-' - END DO - - IF (I.EQ.LEN(TIME)) RETURN - - IF (TIME(I+3:I+3).EQ.' ') THEN - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IF - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DO - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - IF (INDEX(TIME(:I-2),'.').GT.0) THEN - CALL SYS_BINTIM(TIME(:INDEX(TIME(:I-2),'.'))//'00',BTIM) - ELSE IF (TIME(I-4:I-4).EQ.':'.AND.TIME(I-7:I-7).EQ.':') THEN - CALL SYS_BINTIM(TIME(:I-2)//'.00',BTIM) - ELSE - CALL SYS_BINTIM(TIME(:I-2)//':00.00',BTIM) - END IF - - IF (TIME(I:I).EQ.'+'.OR.TIME(I:I).EQ.'-') THEN - IER = SYS_BINTIM('0 '//TIME(I+1:I+2)//':'//TIME(I+3:I+4),DIFF) - IF (IER) THEN - IF (TIME(I:I).EQ.'-') THEN - IER = LIB$SUBX(BTIM,DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,DIFF,BTIM) - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE NEWS_LIST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - COMMON /NEWSLIST/ NEWSLIST - - CHARACTER TODAY*24 - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR. - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER)) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - NEWS_FOLDER1_BBOARD = '::' - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14 - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNT - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1 - IF (IER.EQ.0.AND.IER1.EQ.0) - & NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) ! Old bug caused this. - IF (IER.NE.0.OR.IER1.NE.0) THEN - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLEN - NEWS_F1_COUNT = NEWS_F_COUNT - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN - NEWS_FOLDER = NEWS_FOLDER(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - NEWS_F_COUNT = NEWS_F1_COUNT - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)// - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - END IF - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - IF (IER2.EQ.0) THEN - NEWS_F1_FLAG = NEWS_F_FLAG - NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN - NEWS_F1_EXPIRE = NEWS_F_EXPIRE - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1) - IF (BTEST(NEWS_F1_FLAG,8)) THEN - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_LAST = 0 - END IF - IF (FLEN.LE.44.OR.FLEN-44+EB-SP+1.LT. - & LEN(NEWS_FOLDER1_DESCRIP)) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - END IF - ELSE IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE. - IF (FLEN.GT.44) THEN - IF (NEWS_FOLDER1_DESCRIP.NE. - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - IF (SPECIAL) THEN - IF (UPDATE) THEN - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF - ELSE IF (.NOT.UPDATE) THEN - UPDATE = F1_START.LT.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.F1_START.AND. - & NEWS_F1_FIRST.GT.F1_NBULL) THEN - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE), - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (((F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND..NOT.BTEST(NEWS_F1_FLAG,8)) THEN - DELETE (UNIT=7) - IER = 0 - ELSE IF (IER.EQ.1) THEN - IF (NEWS_F1_NBULL.GE.NEWS_F1_START - & .AND.NEWS_F1_START.NE.0) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(NEWS_F1_START,IER1) - CALL CLOSE_BULLDIR - IER1 = NEWS_F1_START+1.EQ.IER1 - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - IF (.NOT.IER1) DELETE (UNIT=7) - END IF - END IF - END IF - END DO - END IF - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - NEWSLIST = .FALSE. - - IF (SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED')) CALL RECOUNT - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DO - - RETURN - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4 - - COMMON /LOCALPOST/ LOCAL_POST - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /TEMP_INPUT/ GROUP_TEMP - CHARACTER GROUP_TEMP*256 - - COMMON /HEADER/ HEADER - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER RESPONSE*4 - - CHARACTER TODAY*24,UNAME*132 - DATA UNAME /'()'/ - - COMMON /POINT/ BULL_POINT - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1) - IF (IER1.NE.0) RETURN - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900 - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3) - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSE - I = INDEX(NEWS_MSGID,'.') - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & NEWS_MSGID(:I-1)// - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256) - IF (IER.NE.0) RETURN - LOCAL_POST = .TRUE. - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1 - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP - ELSE IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - IF (TRIM(FOLLOWUP).EQ.0) THEN - INPUT = 'Newsgroups: '//NEWSGROUPS - ELSE - INPUT = 'Newsgroups: '//FOLLOWUP - END IF - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE.AND. - & .NOT.NEWS_FEED()) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER) - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0 - DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP)) - IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP) - DO WHILE (TRIM(GROUP_TEMP).GT.0) - COMMA = INDEX(GROUP_TEMP,',') - IF (COMMA.GT.0) THEN - FOLDER1_NAME = GROUP_TEMP(1:COMMA-1) - GROUP_TEMP = GROUP_TEMP(COMMA+1:) - ELSE - FOLDER1_NAME = GROUP_TEMP - GROUP_TEMP = ' ' - END IF - CALL LOWERCASE(FOLDER1_NAME) - FLEN = TRIM(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1) - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9) - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND. - & INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND. - & INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST), - & GROUP_LIST,FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - ELSE - WRITE (6,'(1X,A,'' is not a valid news group.'')') - & FOLDER1_NAME(:FLEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to specify it? (default = Y) ') - IF (RESPONSE(:1).NE.'n'.AND. - & RESPONSE(:1).NE.'N') THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - END IF - END IF - END DO - END DO - CALL CLOSE_BULLNEWS - END IF - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900 - END IF - ATSIGN = INDEX(PATHNAME,'@') - PCSIGN = INDEX(PATHNAME,'%') - CALL LOWERCASE(USERNAME) - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - END IF - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME) - - IF (FILENAME.NE.'cancel') THEN - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - CALL STR$UPCASE(FROM_LINE,FROM_LINE) - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME) - ELSE - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (INPUT(:5).EQ.'From:') THEN - IF (.NOT.NEWS_WRITE(INPUT(:ILEN))) THEN - CALL CLOSE_BULLFIL - GO TO 900 - END IF - ILEN = 0 - END IF - END DO - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - - IF (FILENAME.EQ.'cancel'.AND.TEST_NEWS_OWNER()) THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'// - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE IF (TRIM(SUBJECT).EQ.0) THEN - IF (.NOT.NEWS_WRITE('Subject: (none)')) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECT - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) - & GO TO 900 - END IF - - IF (NGROUPS.GT.0) THEN - FROM = USERNAME - DESCRIP = SUBJECT - END IF - - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//'>')) GO TO 900 - - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION) - END IF - LORGAN = TRIM(ORGANIZATION) - END IF - - IF (LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN))) - & GO TO 900 - END IF - - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & ZONE(:LZONE))) GO TO 900 - - INPUT_HEADER = .FALSE. - - IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel').AND..NOT.NEWS_FEED()) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE( - & FIRST_ALPHA(EXDATE):2) - & //' '//EXDATE(4:6)//' '//EXDATE(10:TRIM(EXDATE)) - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900 - ELSE IF (REMOTE_SET.EQ.4) THEN - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT) - END IF - EXTIME = '00:00:00.00' - END IF - IF (CLI$GET_VALUE('FOLLOWUP',GROUP_TEMP)) THEN - CALL LOWERCASE(GROUP_TEMP) - IF (.NOT.NEWS_WRITE('Followup-To: ' - & //GROUP_TEMP(:TRIM(GROUP_TEMP)))) GO TO 900 - END IF - INPUT_HEADER = CLI$PRESENT('HEADER') - END IF - - IF (CREATE) THEN - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURN - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).EQ.'240') IER = 0 - ELSE - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - LOCAL_POST = .FALSE. - RETURN - END IF - - IF (.NOT.INPUT_HEADER) THEN - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2 - END IF - IF (IER1.EQ.0) THEN - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DO - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') THEN - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:MIN(79+SB,EB)) - IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN - WRITE (6,'('' Use /INDENT to change indentation'',$)') - WRITE (6,'(''+ character. See Manager for permanent'',$)') - WRITE (6,'(''+ change.'')') - END IF - END IF - ELSE - LENGTH = (LENGTH+127)/128 - GROUP_LIST = GROUP_LIST1 - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - SAVE_BULL_POINT = BULL_POINT - DO I=NGROUPS,1,-1 - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1) - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL ADD_LOCAL_NEWS(8) - END IF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - BULL_POINT = SAVE_BULL_POINT - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - CALL STR$UPCASE(USERNAME,USERNAME) - - LOCAL_POST = .FALSE. - - RETURN - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURN - END IF - END IF - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME) - LPATH = TRIM(PATHNAME) - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NAME - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME) - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE. - END DO - - TEST_NEWS = MAYBE_NEWS - - RETURN - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) RETURN - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULL - FIRST = F1_START - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - REMOTE_SET = 3 - CALL OPEN_BULLDIR_SHARED - I = F_LAST + 1 - IER = I - 1 - DO WHILE (I.NE.IER.AND.I.LE.LAST) - CALL READDIR(I,IER) - I = I + 1 - END DO - CALL CLOSE_BULLDIR - CALL OTS$CVT_L_TI(I-1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNT - NEW_NEWS_F_END = NEWS_F_END - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - F_LAST = LAST - NEWS_F_FIRST = FIRST - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE NEWS2BULL(RECLAIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBER - - DIMENSION NOW(2) - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV - - CALL DELETE_EXPIRED_NEWS(RECLAIM) - - IF (RECLAIM) CALL EXIT - - CALL SEND_POST - - CALL NEWS_LIST - - CALL UPDATE_LOCAL_NEWS - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - ELIST = INDEX(FOLDER_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN - IF ((FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR. - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))).AND. - & INDEX(FOLDER_DESCRIP(SLIST+2:),'@').EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARD - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (IER) THEN - SAVE_LAST = F_LAST - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER) - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN - SAVE_LAST = F_NBULL - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LAST - FOLDER_BBOARD = 'NONEFEED' - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - REMOTE_SET = 3 - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM(9 - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.)R - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1) - END IFN - CALL CLOSE_BULLFOLDER - END IFE - END IF - END DO - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTHF - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/W - - CHARACTER*(*) TIMER - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+_ - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)//S - & TIME(16:17)//TIME(19:20)I - - RETURN( - END - - - - SUBROUTINE ALLPRIVS - - IMPLICIT INTEGER (A-Z)A - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1E - PROCPRIV(2) = -1. - NEEDPRIV(1) = -1I - NEEDPRIV(2) = -1E - - RETURNR - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COMN - - NEWS_FOLDER1 = FOLDER1E - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DOI - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM. - NEWS_F1_COUNT = NEWS_F_COUNTD - REWRITE (7) NEWS_FOLDER1_COMA - - RETURNN - END - - - - SUBROUTINE SUBSCRIBEA - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC'B - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)A - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX)E - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')')W - RETURN - END IFN - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1E - END DOR - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')')R - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')')= - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSEE - WRITE (6,'('' You are now subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IFR - - CALL UPDATE_USERINFO. - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(T - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THENN - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1))L - LAST_NEWS_READ(2,J) = F_START - 1 - ELSED - LAST_NEWS_READ2(2,J) = 0O - LAST_NEWS_READ(2,J) = F_NBULL - END IFR - CALL CLOSE_BULLNEWS - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ)N - CALL UPDATE_USERINFO_NEWS_ALWAYSR - RETURN( - END IF - END DO - - END - - - - - - SUBROUTINE UNSUBSCRIBE) - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLUSER.INC'R - - INCLUDE 'BULLFOLDER.INC'. - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_EXPIREDI - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)E - COMMON /USERINFO/ LAST(2,FOLDER_MAX)I - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IF - - CALL OPEN_BULLINF_SHAREDR - DO WHILE (REC_LOCK(IER))I - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_RECI - END DO) - IF (IER.NE.0) THENM - DO I=1,FOLDER_MAXE - INF_REC(1,I) = 0( - INF_REC(2,I) = 0T - END DO - END IF - CALL CLOSE_BULLINF( - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DOA - - IF (I.LE.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Folder is permanent and cannot not be'',H - & '' unsubscribed.'')')_ - RETURN - END IFU - - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - CALL UPDATE_USERINFOD - - I = NEWS_FIND_SUBSCRIBE() - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1))) - END DOE - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0E - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0' - - CALL FREE_TAGS(I) - - IF (NINCLUDE.GT.0) WRITE (6,'('' Note: Excludes and/or '', - & ''includes exist for this group.'')') - - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ)T - - CALL UPDATE_USERINFO_NEWS_ALWAYS - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'H - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (IER.EQ.0) IER = 1 ! None read yet. - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0E - RETURN - END IFM - - RETURNE - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER)R - - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'T - - I = NEWS_FIND_SUBSCRIBE1()D - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0E - RETURN - END IFI - - RETURN - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC'D - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR.(LAST_NEWS_READ(2,I) - & .GT.NEWS_F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER)M - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X)D - END IF - - RETURNT - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG)R - - IMPLICIT INTEGER (A-Z)p - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0T - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THEN - COUNT = COUNT + 1 - END IFD - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT)T - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSEF - SUBNUM = 0 - END IFU - - RETURNR - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES)( -CT -C SUBROUTINE NEWS_NEW_NOTIFICATIONN -C - - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLFOLDER.INC'W - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT) - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)I - - MESSAGES = .FALSE.R - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1I - - FOLDER_DESCRIP = ' ' - REORDER = 0 - DO WHILE (SUBNUM.GT.0)U - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - FOLDER1_DESCRIP = FOLDER_DESCRIPH - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUMI - UNLOCK 7L - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1T - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THENC - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - ELSE IF (IER.NE.0) THEN - SUBNUM = -1D - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR.E - & F_START.GT.F_NBULL) THEN_ - IER = 1 - END IFA - END IFL - IF (IER.EQ.0.AND.SUBNUM.GT.0) THENF - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND.O - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THENS - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR.U - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)M - IF (DIFF.GT.0) IER = 1R - END IF - END IFE - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THENT - WRITE (6,'('' There are new messages in folder '', - & A,''.'')') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1): - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A,''.'')') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1). - ELSEM - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1)Q - IF (IER1) THEN1 - CALL LOGIN_FOLDERE - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBERL - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINTO - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO' - END IFU - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IFF - END IF - END DO - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE) - - CALL CLOSE_BULLNEWS - - RETURNL - END - - - SUBROUTINE REORDER_SUBSCRIBEM - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLFOLDER.INC'( - - INCLUDE 'BULLUSER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0) - I = I + 1I - END DO( - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1, - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER)H - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1)F - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2E - TEMP = LAST_NEWS_READ(L,J) - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K) - LAST_NEWS_READ(L,K) = TEMP - END DOT - END IF= - END DO - END DOT - - RETURNT - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)A - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENS - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14)R - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER)U - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC'( - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN( - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15). - - RETURNI - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLUSER.INC'B - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN= - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IF. - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE.) - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURNS - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE()R - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC'L - - INCLUDE 'BULLFOLDER.INC'( - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1A - END DOJ - - NEWS_FIND_SUBSCRIBE = I - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'S - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DOD - - NEWS_FIND_SUBSCRIBE1 = I( - - RETURNR - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'U - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF. - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER))R - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DOT - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0$ - INF_REC(2,I) = 0R - END DO - END IFI - CALL CLOSE_BULLINFT - - IP = 1R - DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER - & .AND.IP.LE.FOLDER_MAX-1) - IP = IP + 1 - END DOG - - IER = .TRUE.L - - IF (IP.EQ.FOLDER_MAX) THEN - PERM = .FALSE. - IP = 1 - ELSEC - PERM = .TRUE._ - END IF - - IF (NOTIFY.EQ.0) THEN - IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THENF - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')')D - RETURNO - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) - END IF - ELSE IF (NOTIFY.EQ.1) THENA - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.PERM.AND.R - & (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15))) THENe - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).AND. - & .NOT.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE.) - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.PERM.AND.S - & (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE.. - END IFT - - IF (IER) THEN - IF (READNEW.EQ.1)W - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14)G - IF (READNEW.EQ.0)N - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1)) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15)N - IF (BRIEF.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15)N - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')')N - - IF (BTEST(INF_REC2(2,IP),14)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - END IF - - IF (BTEST(INF_REC2(2,IP),15)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - END IF - END IF4 - - CALL UPDATE_USERINFOE - - RETURNU - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT) - - IMPLICIT INTEGER (A-Z)' - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - REWIND UNIT - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM)T - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '//. - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK). - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THENI - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6,, - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) - END IF - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THEN) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF: - LENGTH = OCOUNT - (NBLOCK + 1) + 1R - NBLOCK = NBLOCK + LENGTH + 1, - SYSTEM = 0 - CALL ADD_ENTRY - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIRZ - - RETURNZ - END - - - - SUBROUTINE UPDATE_NEWS_FOLDER -CR -C SUBROUTINE UPDATE_NEWS_FOLDER -CA -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'D - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THENd - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_END( - F_COUNT = NEW_F_COUNTA - END IFT - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1_ - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM))T - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_EX_BTIM_KEY - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLNEWS - - RETURND - END - - - - SUBROUTINE SEND_POST - - IMPLICIT INTEGER (A-Z)1 - - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CHARACTER FILE*132_ - - C = 0 - - IF (.NOT.NEWS_LOGIN()) RETURN - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST',FILE,C)) - IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'340') RETURNE - - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD'). - DO WHILE (IER.EQ.0)B - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (INPUT(:5).EQ.'From:') - & BULL_PARAMETER = INPUT(7:INDEX(INPUT,'@')-1)O - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IF - END DO - IF (INPUT.NE.'.') THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - IF (BUFFER(:3).NE.'240') THEN - CLOSE (UNIT=3)E - CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER))S - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER)= - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - END IF - CLOSE (UNIT=3,STATUS='DELETE') - END DOR - -100 CLOSE (UNIT=3) - - RETURN( - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVSE - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100( - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME,I - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST)E - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)): - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVSR - - IF (UNAME.EQ.'()') THEN - UNAME = ' ' - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IFU - - RETURNB - END - - - - SUBROUTINE RECOUNT. -C -C SUBROUTINE RECOUNT: -C4 -C FUNCTION: -CE -C Fixes the message count of stored news groups. This may become wrong -C if old copies of some of the database files are used with newer versions. -CL - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC'M - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXTS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFILS - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - FOLDER_NUMBER = 1000R - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER))) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THENS - CALL CLOSE_BULLNEWSA - RETURN - END IF( - - REMOTE_SET = 4. - - DO WHILE (IER.EQ.0) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - END DO - - IF (BTEST(NEWS_F_FLAG,8).AND.IER.EQ.0) THEN - CALL NEWS_TO_FOLDER - - CALL OPEN_BULLDIR_SHARED - - NUM = F_START - F_COUNT = 0 - - IF (F_START.GT.0) THEN: - CALL READDIR(NUM,IER) - NEXT = .TRUE. - F_START = NUM - DO WHILE (NUM+1.EQ.IER) - F_COUNT = F_COUNT + 1F - NUM = NUM + 1M - IF (NUM.LE.F_NBULL) CALL READDIR(NUM,IER)S - END DO' - NEXT = .FALSE.E - - F_NBULL = NUM - 1 - END IF - - CALL CLOSE_BULLDIRH - - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DOR - - CALL DELLNM('BULL_NEWS_RECOUNT') - - CALL CLOSE_BULLNEWS - - RETURNS - END - - - - SUBROUTINE DELLNM(LOG)D - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$SYSTEM',LOG,PSL$C_SUPER) - - RETURNA - END - - - SUBROUTINE NEWNEWS(SINCE_BTIM,FOUND) - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC') - - COMMON /BUFFER/ BUFFER,SB,EBE - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDRU - LOGICAL XHDR /.FALSE./C - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1E - - DIMENSION SINCE_BTIM(2) - - START = F_START - END = F_NBULL - - FOUND = 0 - - IF (REMOTE_SET.EQ.3.AND.XHDR) THENT - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - IF (.NOT.NEWS_READ()) RETURNS - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (FOUND.EQ.0) THEND - L = INDEX(BUFFER(SB:EB),' ') - CALL OTS$CVT_TI_L(BUFFER(SB:SB+L-2),IER,,%VAL(1))E - CALL NEWS_TIME(BUFFER(SB+L:EB),MSG_BTIM) - CALL CONVERT_FROM_GMT(MSG_BTIM)N - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) - & FOUND = IER - END IF. - IF (.NOT.NEWS_READ()) RETURNT - END DOI - IF (FOUND.NE.0) THEN - IF (.NOT.OTS$CVT_L_TI(FOUND,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IFS - END IF - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500'I - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22')I - START = START + 1I - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THENH - IER = 0T - END = START - 1 - RETURN - END IF - END IFR - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURNS - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0( - I = START) - DO WHILE (IER.EQ.0.AND.I.LE.END.AND.FOUND.EQ.0) - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)). - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURNE - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) FOUND = MSG_NUM - I = I + 1 - IF (REMOTE_SET.EQ.3.AND.I.LE.END.AND.FOUND.EQ.0) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURNT - IF (BUFFER(:3).NE.'223') THEN - END = I - 1I - IER = 0 - RETURN - END IFR - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURNN - IER = 0 - END IF - END DO - IF (FOUND.EQ.0) THEN I - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURND - IF (.NOT.NEWS_READ()) RETURNM - END IF - END IF - - RETURNM - END diff --git a/decus/vms95b/bulletin/bulletin11.for b/decus/vms95b/bulletin/bulletin11.for deleted file mode 100644 index c42a8a7..0000000 --- a/decus/vms95b/bulletin/bulletin11.for +++ /dev/null @@ -1,3275 +0,0 @@ -C -C BULLETIN11.FOR, Version 8/4/95 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('CURRENT')) THEN - MESSAGE_NUMBER = BULL_POINT - ELSE IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*12 BULL_MARK_DIR - CHARACTER*12 TAG_KEY,INPUT_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,) - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1) - ELSE - UNLOCK 13 - END IF - END IF - - NTRIES = 0 - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),) - IF (IER1.NE.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128,DISPOSE='DELETE', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1) - NEWS_MARK2(1) = NEWS_MARK2(2) - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - CALL ERRSNS(IDUMMY,IER2) - IF (IER2.NE.RMS$_RNF) SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURN - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1), - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IF - - RETURN - END - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - - CHARACTER*12 BULL_MARK_DIR - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSE - MARKUNIT = 23 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1 - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEY - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IF - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY) - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURN - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - TAG_TYPE = 0 - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR. - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN - IF (IER.EQ.0) UNLOCK 13 - IER = 0 - MESSAGE = MSG_NUM - ELSE - IER = 36 - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - IER = 36 - - HEADER = .FALSE. - - TAG_TYPE = 0 - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) THEN - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:) - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THEN - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I) - IER = 0 - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - MSG_KEY = NEXT_MSG_KEY - RETURN - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DO - - RETURN - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - DO MESSAGE = MSG_NUM+1,F_NBULL - CALL READDIR(MESSAGE,IER) - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE) - IF (IER.EQ.0) THEN - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END DO - - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2) - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURN - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER) - & INPUT_KEY - END DO - - CLOSE_IT = .FALSE. - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - CALL DECREMENT_MSG_KEY - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR_SHARED - CLOSE_IT = .TRUE. - END IF - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - DELETE (UNIT=13) - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER)) - READ (13,IOSTAT=IER) INPUT_KEY - END DO - END IF - END IF - - END DO - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE. - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1 - DO M=1,2 - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1 - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1 - LIMIT = 256/(NEWS_FORMAT+1) - NEWS_NUMBER = LAST_NEWS_READ2(1,I) - K = 5-NEWS_FORMAT*2 - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1 - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IF - SET_LIST = .FALSE. - END IF - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0) - END DO - K = LIMIT + 1 - END IF - IF (K.GT.LIMIT) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2 - NEWS_REC = NEWS_REC + 1 - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - IF (IER.EQ.0) THEN - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IF - END DO - END IF - END DO - END DO - CLOSE (UNIT=23) - END IF - - RETURN - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = J - ELSE - NEWS_MARK(I) = J - END IF - - RETURN - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG) - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUM - NEWS_TAG(I) = 0 - END DO - - RETURN - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - DO I=1,2 - IF (NEWS_TAG(3,I,ISUB).GT.0) THEN - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB)) - NEWS_TAG(3,I,ISUB) = 0 - NEWS_NUMBER = NEWS_FOLDER_NUMBER - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER) - END IF - END DO - IF (IER.EQ.0) UNLOCK 23 - END IF - - DO J=I,FOLDER_MAX-2 - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J)) - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0 - END DO - END DO - - RETURN - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY - - IER = 36 - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE) - IF (IER.EQ.0) THEN - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THEN - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM) - END IF - IER = 36 - END IF - END IF - END DO - BULL_READ = MSG_NUM - IF (CLOSE_IT) CALL CLOSE_BULLDIR - ELSE - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0 - MSG_KEY = BULLDIR_HEADER - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THEN - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36 - END IF - END IF - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*24 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1)) - - CALL DISABLE_PRIVS - - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))// - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:) - END DO - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR) - - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO)) - I = INDEX(SENDTO(J:),',') - 1 - IF (I.EQ.-1) I = TRIM(SENDTO(J:)) - CALL INIT_ITMLST - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - J = J + I - IF (SENDTO(J:J).EQ.',') J = J + 1 - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) -C IF (SETPRV_PRIV()) THEN -C CALL ENABLE_PRIVS -C CALL ADD_2_ITMLST -C & (TRIM(USERNAME),MAIL$_SEND_FROM_LINE,%LOC(USERNAME)) -C CALL DISABLE_PRIVS -C END IF - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO)) - CALL END_ITMLST(ATTRIBUTE_ITMLST) - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - CALL LIB$REVERT - - RETURN - END - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,) - - RETURN - END - - - - - SUBROUTINE SET_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEXT/ NEXT - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DIMENSION EXPIRED(2) - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IF - - ENTRY SHOW_NEWS - - LIMIT = -2 - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1)) - IF (.NOT.IER.OR.LIMIT.LT.-1) THEN - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')') - RETURN - END IF - END IF - - EXPIRE = -1 - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1)) - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN - END IF - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR. - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')') - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - IF (CLI$PRESENT('DEFAULT')) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1 - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - RETURN - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE) - FOLDER1_NUMBER = NEWS_F1_COUNT - FOLDER1 = BULL_PARAMETER - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10) - CALL WRITE_FOLDER_FILE_TEMP(IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMP - REWRITE (7) NEWS_FOLDER1_COM - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER) - END IF - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - END IF - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS') - DEFAULT = CLI$PRESENT('DEFAULT') - ALL = CLI$PRESENT('ALL') - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE') - ENABLE = CLI$PRESENT('ENABLE') - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - - STORED = 0 - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN - WRITE (6,'('' Stored setting was not removed.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'[.BULLNEWS*]*.*;*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_SAVE = FOLDER - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - FOLDER = FOLDER_SAVE - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0 - F1_NBULL = 0 - F1_COUNT = 0 - F1_LAST = 0 - END IF - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3) - IF (IER.NE.0) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - END IF - CALL RESET_PROTECTION - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IF - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THEN - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')') - ELSE - WRITE (6,'('' Default is not stored.'')') - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS) THEN - WRITE (6,'('' Expiration is DEFAULT value.'')') - ELSE - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Default expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no default expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')') - ELSE - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - NOTIFY_FLAG_NEWS = .FALSE. - SET_FLAG_NEWS = .FALSE. - BRIEF_FLAG_NEWS = .FALSE. - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a default news group.'')') - ELSE - IER1 = 2 - END IF - END IF - NOTIFY_PERM_FLAG_NEWS = .FALSE. - SET_PERM_FLAG_NEWS = .FALSE. - BRIEF_PERM_FLAG_NEWS = .FALSE. - DO WHILE (REC_LOCK(IER2)) - READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC - END DO - IF (IER2.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a permanent news group.'')') - END IF - END IF - PERM = .FALSE. - IF (SET_FLAG_NEWS) THEN - IF (BRIEF_FLAG_NEWS) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE IF (BRIEF_FLAG_NEWS) THEN - IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - IF (.NOT.PERM) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (BRIEF_PERM_FLAG_NEWS.AND..NOT.SET_PERM_FLAG_NEWS) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (NOTIFY_FLAG_NEWS) THEN - IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' NOTIFY is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLINF - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IF - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER) - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) - END IF - FOUND = .FALSE. - MODALL = INDEX(GROUP,'.').NE.LG - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR. - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.')) - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER) - END DO - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER) - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - RETURN - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - END DO - END IF - - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC', - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFERT - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMU - - CHARACTER TODAY*24I - - DIMENSION BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - ALL = CLI$PRESENT('ALL')A - FULL = CLI$PRESENT('FULL')M - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN fileR - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)T - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENS - IF (CLI$PRESENT('SUBJECT')) THENA - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)I - ELSES - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IF0 - ELSE - INPUT = FROM - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:) - ELSE( - INPUT = DESCRIP - END IFa - END IF - LEN_P = TRIM(INPUT)w - CALL CLOSE_BULLFIL - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - INPUT = 'SUBJECT:'//INPUTI - LEN_P = LEN_P + 8 - ELSEU - INPUT = 'FROM:'//INPUT - LEN_P = LEN_P + 5C - END IFG - - IF (EXCLUDE) THEN - INPUT = ':EXCLUDE:'//INPUT - LEN_P = LEN_P + 9. - ELSEN - INPUT = ':INCLUDE:'//INPUT - LEN_P = LEN_P + 9M - END IFP - - FLEN = TRIM(FOLDER_NAME)A - INPUT = FOLDER_NAME(:FLEN)//INPUT - ILEN = FLEN + LEN_P - - DISABLE = CLI$PRESENT('DISABLE')/ - - EXC = -1A - IER = CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P) - IF (IER) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) EXC - IF (EXC.LT.0.OR.EXC.GT.999.OR.IER.NE.0) THEN T - WRITE(6,'('' ERROR: Valid limit is 0-999.'')')U - RETURN - END IF - END IF - - CHECK_ONLY = .FALSE.U - - GO TO 100 - - ENTRY CHECK_EXCLUDES - - CHECK_ONLY = .TRUE. - DISABLE = .TRUE.s - LEN_P = 0 - INPUT = ' ' - ILEN = 1 - -100 IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER)' - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'R - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH)= - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)I - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN( - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) THEN - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - CLOSE (UNIT=4,DISPOSE='SAVE') - RETURN - END IFt - - IER = 0 - CONVERT = .FALSE. - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERD - IF (IER.EQ.0) THEN E - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THENV - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5)f - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill'B - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF ((STREQ(OLD_BUFFER(:ILEN),INPUT(:ILEN)).AND.T - & OLD_BUFFER(ILEN+1:ILEN+1).EQ.':').OR.E - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:OLEN),INPUT(:OLEN)))) THEN - CONTINUE - ELSE IF (.NOT.(ALL.AND.INPUT(:FLEN+8).EQ.T - & OLD_BUFFER(:MIN(FLEN+8,OLEN)))) THEN - IER2 = OLD_BUFFER(:1).EQ.':'.OR.1 - & INDEX(OLD_BUFFER,':defaults:').GT.0 - IF (.NOT.IER2) THEN - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC1,BLIMIT,BDATE,IER1) - IF (IER1) IER2 = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1) - & ,' ').GT.-EXC1 - CONVERT = .NOT.IER1 - END IF - IF (.NOT.IER1.OR.EXC1.EQ.0.OR.IER2) - & WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN)T - END IFD - END IF - END DO - - IF (.NOT.DISABLE) THENR - IF (CLI$PRESENT('FULL')) THENh - WRITE (4,'(A)',IOSTAT=IER) FOLDER_NAME(:FLEN)//':defaults:kill' - ELSE - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IFI - - IF (CONVERT) THEN - WRITE (6,'('' NOTE: See help on the new SET EXLIMIT command.'')')_ - END IFC - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOMB - - RETURNB - END - - - - SUBROUTINE UPDATE_EXCLUDE - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'U - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMN - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - DATA SCRATCH_B1/0/,NINCLUDE/0/,EXC_CHANGED/.FALSE./ - - CHARACTER TODAY*24G - - DIMENSION BTIM(2) - - IF (.NOT.EXC_CHANGED) RETURNR - EXC_CHANGED = .FALSE. - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'F - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH)R - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)D - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THENE - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (.NOT.(IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ.E - & INPUT(:MIN(TRIM(FOLDER_NAME)+1,ILEN)).AND.INPUT(:1).NE.':' - & .AND.INDEX(INPUT,':defaults:').EQ.0)) THEN - IF (IER.EQ.0) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DOD - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOMU - - RETURNI - END - - - - - SUBROUTINE SET_CUSTOM(PARAM) -C_ -C SUBROUTINE SET_CUSTOM -CL - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMITT - DATA EXCLUDE_LIMIT /0/B - - CHARACTER*(*) PARAM - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'( - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)D - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN( - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IFS - - LENP = LEN(PARAM) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0.AND.PARAM(:LENP).NE.INPUT(2:LENP+1)) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)E - END IF - END DO - - IF (CLI$GET_VALUE('SET_PARAM2',INPUT,ILEN)) THENF - WRITE (4,'(A)',IOSTAT=IER) ':'//PARAM(:LENP)//':'//INPUT(:ILEN)J - END IF - - IF (PARAM.EQ.'exclude_limit') - & DECODE(ILEN,'(I)',INPUT(:ILEN)) EXCLUDE_LIMITT - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - CALL CHECK_CUSTOM - - RETURN - ENDN - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'( - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./M - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGEDE - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORYT - CHARACTER*64 FILE_DIRECTORY - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT. - DATA EXCLUDE_LIMIT /0/S - - DIMENSION BTIM(2) - - FILE_DIRECTORY = ' 'S - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THEN - BULL_USER_CUSTOM = .FALSE. - ELSEN - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IFT - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - OPEN(UNIT=17,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURNM - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?M - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head/ - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER)I - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IFN - - NINCLUDE = 0 - OLD_FORMAT = .FALSE.T - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ. - & OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+1,OLEN))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL LOWERCASE(OLD_BUFFER)T - IF (INDEX(OLD_BUFFER(TRIM(FOLDER_NAME)+2:),'defaults') - & .EQ.1) THENE - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - OLD_FORMAT = OLD_FORMAT.OR.(.NOT.IER1)E - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXCE - & .OR.EXC.EQ.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1 - ELSE - EXC_CHANGED = .TRUE. - END IF - END IFL - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - IF (INDEX(OLD_BUFFER,':file_directory').GT.0) - & FILE_DIRECTORY = OLD_BUFFER(17:) - IF (INDEX(OLD_BUFFER,':exclude_limit').GT.0) THEN U - DECODE(OLEN-15,'(I)',OLD_BUFFER(16:),IOSTAT=IER1) - & EXCLUDE_LIMIT - EXCLUDE_LIMIT = MIN(999,EXCLUDE_LIMIT) - END IF_ - END IF - END DOR - - CLOSE (UNIT=17) - F - IF (OLD_FORMAT) CALL CHECK_EXCLUDES - - RETURN - END - - - - B - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1)U - - IMPLICIT INTEGER (A-Z)P - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMT - DATA BULL_USER_CUSTOM/.FALSE./N - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - CHARACTER*(*) STRING,STRING1N - - CHARACTER*12 EXFROM - - INCLUDE_MSG = .TRUE. - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURNS - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME)B - - INC = .FALSE. - - DO I=1,NINCLUDE - OLD_SCRATCH_B = SCRATCH_B_ - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)) - OLEN = TRIM(OLD_BUFFER)E - IF (STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THENT - IF (.NOT.INC) INCLUDE_MSG = .FALSE. - INC = .TRUE. - END IF_ - - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - T - MATCH = .FALSE. - IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:')) THEN, - CALL GET_FROM(EXFROM,OLD_BUFFER(FLEN+15:), - & TRIM(OLD_BUFFER(FLEN+15:)))A - LS = TRIM(STRING) - IF ((TRIM(OLD_BUFFER)-FLEN-14.EQ.LS.AND.( - & STRING.EQ.OLD_BUFFER(FLEN+15:)).OR.STREQ(FROM,EXFROM)) - & MATCH = .TRUE. - ELSE IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND. - & STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER - & (FLEN+18:BLIMIT))) THENT - MATCH = .TRUE.- - END IF= - IF (MATCH.AND..NOT.INC) THENI - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXC.OR.E - & EXC.EQ.0) THENP - IF (OLD_BUFFER(BLIMIT+1:BLIMIT+1).EQ.':') EXC = -1 - CALL ADD_EXCL(OLD_BUFFER,BLIMIT,EXC) - CALL WRITE_QUEUE(%VAL(OLD_SCRATCH_B),OLD_SCRATCH_B, - & OLD_BUFFER)I - EXC_CHANGED = .TRUE. - INCLUDE_MSG = .FALSE.U - END IFD - RETURN - END IF_ - END IF - END DOM - - RETURN - END - - - - FUNCTION STRFIND(STRING,STRING1)T - - IMPLICIT INTEGER (A-Z)M - - CHARACTER*(*) STRING,STRING1L - - L = LEN(STRING1)E - DO I=0,LEN(STRING)-LE - J = 1I - DO WHILE (J.LE.L)C - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J)))T - IF (DIFF.NE.0.AND.DIFF.NE.32) THENI - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = .TRUE. - RETURN - ELSE - J = J + 1, - END IF - END DO - END DO - - STRFIND = .FALSE. - - RETURN - END - - - - - SUBROUTINE SHOW_EXCLUDE(TYPE) - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMT - DATA BULL_USER_CUSTOM/.FALSE./N - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGEDT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) THENT - IF (TYPE.EQ.0) WRITE (6,'('' There are no excludes.'')') - IF (TYPE.EQ.1) WRITE (6,'('' There are no includes.'')') - RETURN - END IFI - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME)T - - FOUND = .FALSE. - - L = 1 - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)L - OLEN = TRIM(OLD_BUFFER)M - IF (STREQ(FOLDER_NAME(:FLEN)//':',OLD_BUFFER(:MIN(FLEN+1,OLEN))) - & .AND.((TYPE.EQ.1.AND.STREQ(OLD_BUFFER(FLEN+2:FLEN+8), - & 'INCLUDE')).OR.(TYPE.EQ.0.AND.STREQ( - & OLD_BUFFER(FLEN+2:FLEN+8),'EXCLUDE')))) THEN - IF (.NOT.FOUND) THENT - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'Excludes for '_ - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'Includes for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - FOUND = .TRUE. - END IF - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1)N - IF (BLIMIT+5-FLEN.GT.PAGE_WIDTH.AND.L+2.GT.PAGE_LENGTH-1) THENA - L = L + 2' - ELSEA - IF (L.EQ.0) THEN - WRITE (6,'(''+'',A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - ELSE1 - WRITE (6,'(1X,A,$)') OLD_BUFFER(FLEN+10:I - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - END IF - IF (OLD_BUFFER(BDATE+1:BDATE+1).EQ.'-') - & OLD_BUFFER(BDATE:) = ' '//OLD_BUFFER(BDATE:) - OUTLEN = MIN(BLIMIT,PAGE_WIDTH+FLEN+9)-FLEN-9 - IF (OUTLEN.GT.PAGE_WIDTH-16) THEN - WRITE (6,'(1X,X,A,1X,I3)')O - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXCE - L = L + 2F - ELSE. - WRITE (6,'(''+'',X,A,1X,I3)')P - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC0 - L = L + 1 - END IF - END IF - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1) THENN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & INPUT(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF( - END IF - END DOI - - IF (.NOT.FOUND) THENE - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'No excludes found for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'No includes found for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - END IF - - RETURNI - END - - - - SUBROUTINE SET_NEWNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)( - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX)_ - - CHARACTER*12 NEW,OLDA - - IF (.NOT.SETPRV_PRIV()) THEN1 - WRITE (6,'('' ERROR: No privs to set a new name.'')') - RETURN - END IF1 - - CALL CLI$GET_VALUE('OLDNAME',OLD,LENO)R - CALL CLI$GET_VALUE('NEWNAME',NEW,LENN)= - - CALL OPEN_BULLUSER_SHARED - - TEMP_USER = USERNAMED - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY - END DO - - IF (IER.EQ.0) THENE - USERNAME = NEW - DO WHILE (REC_LOCK(IER))' - READ (4,IOSTAT=IER,KEYEQ=NEW) - END DO ) - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) USER_ENTRY - ELSE - REWRITE (4,IOSTAT=IER) USER_ENTRY - END IF I - END IF - - USERNAME = TEMP_USERT - DO WHILE (REC_LOCK(IER1))( - READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY - END DO - - CALL CLOSE_BULLUSER - - IF (IER.NE.0) THENE - WRITE (6,'('' ERROR: Old name not found.'')') - RETURN - END IF' - - CALL OPEN_BULLINF_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THENN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSEF - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN/ - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSEK - DO WHILE (REC_LOCK(IER))I - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO)))S - NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN))) - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - IF (LENO.GT.1) THEN - OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1)))I - ELSE' - OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2)))N - END IF - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - IF (LENN.GT.1) THEN - NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1))) - ELSEE - NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))) - END IFR - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEND - DO WHILE (REC_LOCK(IER))E - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE( - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO = - IF (IER.EQ.0) DELETE (9) - END IFD - - CALL CLOSE_BULLINFN - - RETURN - END. - - - SUBROUTINE CHECK_EXCL(BUFFER,L,EXC,BLIMIT,BDATE,IER)( - - IMPLICIT INTEGER (A-Z) - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - - CHARACTER*(*) BUFFER - - DIMENSION BTIM(2) - - BLIMIT = L - BDATE = L+3 - - IER = BUFFER(L:L).EQ.':'V - IF (IER) THEN - I = LAST_INDEX(BUFFER(:L-1),':') - IF (I.GT.0) THEN - J = LAST_INDEX(BUFFER(:I-1),':') - IF (J.GT.0) THEN( - IF (J.LT.I-1) THENS - DECODE(I-J-1,'(I)',BUFFER(J+1:I-1),IOSTAT=IER) EXCE - IER = IER.EQ.0 - ELSEA - EXC = EXCLUDE_LIMITL - END IFU - IF (IER) BLIMIT = J - 1 - CALL STR$UPCASE(BUFFER(I+1:L-1),BUFFER(I+1:L-1))A - IF (IER) IER = SYS_BINTIM(BUFFER(I+1:L-1),BTIM) - BDATE = I + 1 - END IFO - ELSE - IER = .FALSE. - END IF - END IF3 - - IF (.NOT.IER.AND.STRFIND(BUFFER,':exclude:')) - & CALL ADD_EXCL(BUFFER,L,-1)= - - RETURN - END - - - - SUBROUTINE ADD_EXCL(BUFFER,L,EXC) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2) - - CHARACTER*(*) BUFFER - - CHARACTER TODAY*24G - - IF (EXC.EQ.-1) THEN - BUFFER = BUFFER(:L)//':' - ELSEL - BUFFER = BUFFER(:L)//':' - WRITE (BUFFER(L+2:),'(I3)') EXCR - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - END IFI - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - BUFFER = BUFFER(:TRIM(BUFFER))//':'//TODAY(:INDEX(TODAY,' ')-1)//':' - - L = TRIM(BUFFER)A - - RETURN' - END E diff --git a/decus/vms95b/bulletin/bulletin2.for b/decus/vms95b/bulletin/bulletin2.for deleted file mode 100644 index 75bcdbc..0000000 --- a/decus/vms95b/bulletin/bulletin2.for +++ /dev/null @@ -1,2559 +0,0 @@ -C -C BULLETIN2.FOR, Version 7/20/95 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::'.OR.NEWS_FEED()) THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'('' WARNING: Account used by other folder.'', - & '' If you specify the same account,'')') - WRITE (6,'('' you must specify the address'', - & '' of the mailing list in the folder description.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to make this change? ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) THEN - CALL CLOSE_BULLUSER - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Specified file cannot be opened.'')') - RETURN - END IF - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.EQ.0) THEN - INFROM = INPUT(:ILEN)//',' - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (MSG_OWN) THEN - ILEN = TRIM(INPUT) - 6 - INFROM = INFROM(:LENFRO)//INPUT(7:) - CALL ADD_PROTOCOL(INFROM(LENFRO+1:),ILEN) - LENFRO = LENFRO + ILEN - END IF - IF (EDIT.AND.TEXT) THEN - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:TRIM(INPUT)-1) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:TRIM(INPUT))//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_P = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LEN_P.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') BULL_PARAMETER(:LEN_P)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THEN - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - IER = 0 - END IF - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')') - END IF - END IF - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IF - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (.NOT.FILESPEC) THEN - WRITE (6,'('' Enter message: End with ctrl-z,'', - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - ELSE - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IF - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IF - END IF - END IF - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No message added.'')') - IF (.NOT.STATUS) THEN - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ') - IF (STREQ(INPUT(:1),'Y')) THEN - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV') - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IF - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C -C SUBROUTINE ADD_SIGNATURE -C -C FUNCTION: Adds signature to message being mailed/posted. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATURE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/ - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURN - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) RETURN - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IF - - ICOUNT = 0 - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME))) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THEN - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END DO - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IF - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE. - ELSE - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' ' - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - END DO - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,INPUT1 - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.DIFF.NE.32) RETURN - END DO - - STREQ = .TRUE. - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -C -C SUBROUTINE RESPOND_MAIL -C -C FUNCTION: Sends mail to address. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,INDESCRIP*(LINE_LENGTH) - - PRIVS = FILE.NE.'SYS$LOGIN:BULL.SCR' - - INDESCRIP = SUBJECT - LENDES = TRIM(INDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES) - IF (INDESCRIP(I:I).EQ.'"') THEN - IF (LENDES.EQ.LINE_LENGTH) THEN - INDESCRIP(I:I) = '`' - ELSE - INDESCRIP = INDESCRIP(:I)//'"' - & //INDESCRIP(I+1:) - I = I + 1 - LENDES = LENDES + 1 - END IF - END IF - I = I + 1 - END DO - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0 - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD) - IF (PRIVS) CALL DISABLE_PRIVS - - IF (LISTSERV) THEN - IF (SYS_TRNLNM('MX_NODE_NAME',MAILER)) THEN - REPLY_TO = .NOT.SYS_TRNLNM('MX_REPLY_TO',MAILER) - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - REPLY_TO = .NOT.SYS_TRNLNM('PMDF_REPLY_TO',MAILER) - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - END IF - END IF - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO) - & //'""" """'//INDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IF - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//INDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE - I = INDEX(SENDTO,'%""') + 3 - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THEN - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THEN - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THEN - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & INDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) -C -C Use the following if you do not have VMS V5.3 or greater. -C -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//INDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IF - - IF (PRIVS) CALL ENABLE_PRIVS - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV) THEN - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('PMDF_REPLY_TO') - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('MX_REPLY_TO') - END IF - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: CHANGE command subroutine. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWER - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IF - -C -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')') - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')') - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - LENFROM = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description header - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT, - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2100' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2100' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10) - - CHARACTER GROUP*80,STAT*4 - - EXTERNAL CLI$_ABSENT - - IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SEARCH_LEN(1) = 3 - SEARCH_NUM = 1 - NFOLDER = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - SEARCH_NUM = 1 - NFOLDER = 1 - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1 - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM) - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1 - NFOLDER = 1 - ELSE - IF (NFOLDER.EQ.0) NFOLDER = 1 - SEARCH_STRING = ' ' - END IF - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - END IF - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME - NFOLDER = NFOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DO - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - SCRATCH_F = SCRATCH_F1 - NFOLDER = NFOLDER + 1 - END IF - - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - OLD_BUFFER = ' ' - END IF - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - END IF - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IF (NFOLDER.NE.0) FOUND = 0 - - CHANGE = .FALSE. - IF (CLI$PRESENT('REPLY').OR. - & TRIM(SEARCH_STRING).GT.0) THEN - REVERSE = CLI$PRESENT('REVERSE') - ELSE - REVERSE = .FALSE. - END IF - - DO WHILE (NFOLDER.NE.0.AND.FOUND.LE.0.AND.FOUND.GT.-3) - IF ((NFOLDER.GT.0.AND.(.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1)).OR. - & (NFOLDER.LT.0.AND.OLD_BUFFER.NE.' ')) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL, - & REVERSE,CLI$PRESENT('SUBJECT') - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'), - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),CHANGE) - IF (FOUND.LE.0.AND.FOUND.GE.-2) THEN - NFOLDER = NFOLDER - 1 - IF (NFOLDER.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F, - & FOLDER1_NAME) - END IF - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - END IF - END DO - ELSE IF (NFOLDER.LT.0) THEN - NFOLDER = NFOLDER + 1 - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - IF (GFOUND) THEN - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - GFOUND = .FALSE. - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - END IF - ELSE - NFOLDER = 0 - END IF - END DO - CALL CLOSE_BULLFOLDER - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - END IF - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - NFOLDER = 0 - END IF - CALL CANCEL_CTRLC_AST - END IF - END IF - END DO - - IF (FOUND.EQ.-3) FOUND = 0 - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - IF (CHANGE) THEN - WRITE (6,'('' No matches found in current folder: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' No matches found.'')') - END IF - ELSE IF (FOUND.EQ.-2) THEN - IF (CHANGE) THEN - WRITE (6,'('' ERROR: No more messages in current folder: '' - & ,A)') FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' ERROR: No more messages.'')') - END IF - END IF - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN, - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE,CHANGE) -C -C SUBROUTINE GET_SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEXT/ NEXT - LOGICAL NEXT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*4 SAVECMD - - CHARACTER*128 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - OLD_REVERSE = REVERSE - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THEN - OLD_REVERSE = REVERSE - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(BULL_POINT,IER) - IF (BULL_POINT+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (STREQ(DESCRIP(:4),'RE: ').AND.TRIM(DESCRIP).EQ. - & LEN(DESCRIP)) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - SEARCH_STRING = INPUT(11:) - SEARCH_STRING = SEARCH_STRING(:LEN(DESCRIP)) - ELSE - SEARCH_STRING = DESCRIP(5:) - END IF - ELSE IF (STREQ(DESCRIP(:4),'RE: ')) THEN - SEARCH_STRING = DESCRIP(5:) - END IF - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - ELSE - SEARCH_NUM = OLD_SEARCH_NUM - IF (SEARCH_LEN(1).EQ.0) SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (OLD_REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - OLD_SEARCH_NUM = SEARCH_NUM - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.CHANGE.OR. - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last - END IF - IF (REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - SEARCH_STRING = ' ' - RETURN - END IF - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0 - BULL_SEARCH = START_BULL+1 - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR. - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY) - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - ELSE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - IF (IER.EQ.0) THEN - IER = BULL_SEARCH + 1 - ELSE - GO TO 800 - END IF - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - IF (SEARCH_MODE.EQ.4) THEN - CALL STR$UPCASE(DESCRIP1,FROM) - ELSEo - IF (LEN(DESCRIP).EQ.TRIM(DESCRIP)) THEN - IF (REMOTE_SET) THENt - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTES - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER)I - IF (IER.GT.0) GO TO 900O - END IF - END IFC - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)T - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENI - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENI - DESCRIP1 = INPUT(7:)M - END IF - CALL STR$UPCASE(DESCRIP1,DESCRIP1) - ELSEl - CALL STR$UPCASE(DESCRIP1,DESCRIP) - END IF - END IFB - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (TRIM(SEARCH_STRING).EQ.LEN(DESCRIP).AND.' - & DESCRIP1(:LEN(DESCRIP)).EQ.SEARCH_STRING).OR. - & (INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1.AND. - & STREQ(DESCRIP1(:4),'RE: '))))) THEN - IF (.NOT.NEGATED) THEN1 - FOUND = BULL_SEARCH_ - GO TO 900D - END IF - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')')' - FOUND = -3I - GO TO 900 - ELSE IF (NEGATED) THEN E - FOUND = BULL_SEARCH - GO TO 900 - END IFt - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THENE - IF (REMOTE_SET) THENE - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTEM - GO TO 900B - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900B - END IF - END IF& - ILEN = LINE_LENGTH + 1R - MATCHES = 0 - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE. - END DOy - DO WHILE (ILEN.GT.0)' - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)' - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THEN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I)o - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR.I - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THENA - FOUND = BULL_SEARCHi - IF (.NOT.NEGATED) GO TO 900e - ELSE IF (FLAG.EQ.1) THENN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900e - END IFl - END DOr - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSEd - FOUND = -1 - END IF - END IF - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULL - END DO - -800 FOUND = 0C - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - NEXT = .FALSE. - CALL READDIR(BULL_POINT,IER) - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTEA - ELSE - CALL GET_REMOTE_MESSAGE(IER)_ - END IF - END IFC - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file readR - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLc - - IF (.NOT.IER1) SEARCH_STRING = ' ' - NEXT = .FALSE.S - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMDH - - RETURN - END - - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE) - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRINGB - D - OLD_MATCH = .FALSE.= - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURN, - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE. - RETURN - END IF_ - J = J + SEARCH_LEN(I)T - END DO_ - - RETURNN - END - - - - SUBROUTINE UNDELETE -C6 -C SUBROUTINE UNDELETE -Cn -C FUNCTION: Undeletes deleted message.B -CI - IMPLICIT INTEGER (A - Z)B - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'I - - INCLUDE 'BULLFOLDER.INC'P - - EXTERNAL CLI$_ABSENTN - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')')F - RETURN - END IFF -CE -C Get the bulletin number to be undeleted. -CT - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I)B - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IFU - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the userS -C is permitted to delete the bulletin._ -CL - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,E - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner?S - WRITE(6,1040) ! Then error out.z - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?C - WRITE(6,1030) ! If not, then error outO - GOTO 100 - END IFM - END IF - END IFS - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:11).LT.'1900') EXDATE(8:9) = '19' - IF (EXDATE(8:11).LT.'1995') EXDATE(8:9) = '20' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'21'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'21'//EXDATE(10:)* - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration dateO - WRITE (6,'('' Message was undeleted.'')')1 - ELSE8 - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)G - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSEA - WRITE (6,'('' Message was undeleted.'')')M - END IF* - ELSE - CALL DISCONNECT_REMOTE( - END IF - END IFO - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010)U - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.')O -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.')E - - END - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z)A - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL) - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - I = INDEX(INPUT,'<')R - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - INPUT = INPUT(INDEX(INPUT,'<')+1:) ! personal-name D - END IF - - IF (LMAIL.EQ.0) THENa - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN( - MAIL_PROTOCOL = MAILERC - END IF - LMAIL = TRIM(MAIL_PROTOCOL)I - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%' - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1 - RETURN - END IF - END IF_ - - I = INDEX(INPUT,'@')O - IF (I.GT.0) INPUT = INPUT(:INDEX(INPUT(I:),' ')+I-2)S - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"'L - - IF (ILEN.NE.0) ILEN = TRIM(INPUT) - - RETURN - END diff --git a/decus/vms95b/bulletin/bulletin3.for b/decus/vms95b/bulletin/bulletin3.for deleted file mode 100644 index e1813d6..0000000 --- a/decus/vms95b/bulletin/bulletin3.for +++ /dev/null @@ -1,2476 +0,0 @@ -C -C BULLETIN3.FOR, Version 6/6/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2100' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2100' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2100 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2100 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_EDT' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THEN - CALL EDT$EDIT('NL:',OUT) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT) - ELSE - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IF - END IF - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT - ELSE - WRITE(6,'('' Could not activate editor.'')') - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE) - - RETURN - END - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - NOW = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - IF (.NOT.NOW) NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - CALL SYS$SETAST(%VAL(0)) - CALL REGISTER_BULLCP - IER1 = 1 - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - - BBOARD_LOOP = BBOARD_LOOP + 1 - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & (NEWS_LOOP.EQ.0.OR.NOW)) THEN - IF (NOW) THEN - CALL CREATE_PROCESS('BULLCP NEWS1') - ELSE - CALL CREATE_PROCESS('BULLCP NEWS') - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - - NOW = .FALSE. - - NEWS_LOOP = NEWS_LOOP + 1 - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIME - CALL HIBER('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - DIMENSION NEW_SYSTEM_FLAG(FLONG) - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2)) - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER) - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - CALL SETUSER(USERNAME) - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAG - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - END DO - FOLDER_FLAG = FOLDER1_FLAG - FOLDER_NUMBER = 0 - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - CALL CLOSE_BULLUSER - ELSE - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DO - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IF - CLOSE (UNIT=REMOTE_UNIT) - END DO - END IF - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE HIBER(MIN) -C -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -C -C SUBROUTINE DELETE_EXPIRED_NEWS -C -C FUNCTION: -C -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - CHARACTER*4 GET_VMS_VERSION - - INTEGER TODAY(2),NEXT_EX_BTIM(2),NO_EXPIRE(2) - - CHARACTER*8 TODAY_KEY,TEMP - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - IF (.NOT.NOW) THEN - IER = SYS$SETPRN('BULL NEWS1') - IF (.NOT.IER) CALL EXIT - IER = SYS$SETPRN('BULL NEWS') - IF (.NOT.IER) CALL EXIT - END IF - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - CALL SYS_BINTIM('-',TODAY) - - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - REMOTE_SET = 4 - - INPUT = GET_VMS_VERSION() - IF (INPUT(:2).EQ.'V5'.OR.INPUT(:2).EQ.'V4') VMSOLD = .TRUE..AND.NOW - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER).OR.(VMSOLD.AND.IER.EQ.0.AND. - & (.NOT.BTEST(NEWS_F_FLAG,8).OR. - & COMPARE_BTIM(TODAY,NEWEST_EXBTIM).LT.0))) - IF (VMSOLD) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - ELSE - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END IF - END DO - CALL NEWS_TO_FOLDER - - UNLOCK 7 - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - GO TO 1000 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,8)) GO TO 900 - - CALL OPEN_BULLDIR_SHARED - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0 - NDEL = -1 - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM) - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. - IF (NDEL.GT.NEWS_F_END) THEN - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1 - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (EXDATE(8:11).LT.'1995') THEN ! Deleted manually? - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) - EXTIME = ASCTIME(13:23) - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0 - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0 - UNLOCK 2 - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER) - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_START - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - IF (I.LE.F_NBULL) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0 - END DO - F_START = I - NEXT = .FALSE. - END IF - CALL READDIR(F_NBULL,IER) - IF (F_START.LT.F_NBULL.AND.(DN.OR.F_NBULL.EQ.IER)) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I) - I = I - 1 - IF (I.GE.F_START) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = I - END DO - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLDIR - END DO - -900 CALL CLOSE_BULLNEWS - -1000 IF (NOW.OR.IER.EQ.0) THEN - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.*]'//'*.' - INPUT = GET_VMS_VERSION() - CALL LIB$DAY_OF_WEEK(TODAY,DAY) - IF (DAY.NE.7) THEN - IER = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - IF (IER) THEN - DAY = 7 - CALL DELLNM('BULL_NEWS_CLEANUP') - END IF - END IF - IF (INPUT(:2).NE.'V5'.AND.INPUT(:2).NE.'V4') THEN - CONTEXT = 0 - DO WHILE (LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT)) - IER = CONV$RECLAIM(INPUT(:TRIM(INPUT))) - END DO - ELSE IF (DAY.EQ.7) THEN - REMOTE_SET = 4 - DIRLIST = .TRUE. - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(1000,IER) - CALL READ_FOLDER_FILE(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NO_EXPIRE) - DO WHILE (IER.EQ.0) - UNLOCK 7 - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - C = 0 - IF (LIB$FIND_FILE(BULLNEWSDIR_FILE - & (:TRIM(BULLNEWSDIR_FILE))//';1',INPUT,C)) THEN - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';2') - ELSE - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - END IF - CALL OPEN_BULLDIR_SHARED - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE,SHARED, - & BUFFERCOUNT=127, - & INITIALSIZE=(NEWSDIR_RECORD_LENGTH*F_COUNT)/512, - & STATUS='NEW',FORM='UNFORMATTED',DISPOSE='DELETE', - & RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,IOSTAT=IER, - & ORGANIZATION='INDEXED',RECORDTYPE='FIXED', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - END IF - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (2,IOSTAT=IER) NEWSDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - WRITE (9,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - ELSE - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY), - & %DESCR(EX_BTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & CALL COPY2(NEWEST_EXBTIM,EX_BTIM) - END IF - END IF - END DO - CLOSE (UNIT=9,DISPOSE='KEEP') - CALL CLOSE_BULLDIR_DELETE - CALL GET_MSGKEY(NEWEST_EXBTIM,TEMP) - IF (TEMP.NE.NEWS_F_EXPIRED_DATE) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - NEWS_F_EXPIRED_DATE = TEMP - CALL REWRITE_FOLDER_FILE(IER) - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - END IF - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - ELSE - IF (NO_EXPIRE(1).NE.NEWEST_EXBTIM(1).OR. - & NO_EXPIRE(2).NE.NEWEST_EXBTIM(2)) THEN - CALL GET_MSGKEY(NO_EXPIRE,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - ELSE - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - END IF - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';') - END DO - END IF - CALL READ_FOLDER_FILE(IER) - END DO - CALL CLOSE_BULLNEWS - END IF - DIRLIST = .FALSE. - NEWSLIST = .TRUE. - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - IER = .TRUE. - DO WHILE (IER) - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;') - IER = INDEX(FOLDER_FILE,']1JAN').EQ.0 - END DO - J = INDEX(FOLDER_FILE,']') - DECODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) THEN - DO I=1,10 - YEAR = YEAR - 1 - IF (YEAR.EQ.-1) YEAR = 99 - ENCODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) IER = LIB$DELETE_FILE(FOLDER_FILE(:J) - & //'*.*;*') - END DO - END IF - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IF - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/,HEADER_Q1/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(HEADER_Q1,INPUT) - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'READ/NEW' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - - NHEAD = 0 - HEADER_Q = HEADER_Q1 - IER = 0 - CALL STRIP_HEADER(' ',0,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.EQ.0) THEN - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP) - IF (STRIP.AND.INPUT(:5).EQ.'From:') INFROM = ' ' - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - NHEAD = NHEAD + 1 - END IF - END DO - -C -C If more than one folder has same BBOARD account, don't use the -C To: line to determine which folder to put the mail message in. -C - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - DUP = .FALSE. - DO WHILE (.NOT.DUP.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - DUP = FOLDER.NE.FOLDER1.AND.FOLDER_BBOARD.EQ.FOLDER1_BBOARD - END DO - IF (DUP.OR..NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - FOUND = .FALSE. - J = 0 - IF (DUP) J = 1 - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THEN - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - FOUND = INTO.EQ.F_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - END IF - FLEN = TRIM(F_BBOARD) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DO - END IF - END IF - END DO - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COM - END IF - - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - ELSE - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - ELSE - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL SYS$SETAST(%VAL(1)) - IF (.NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) - & CALL NEWS2BULL(.FALSE.) - END IF - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE. - - LEN_BBOARD = LEN(BBOARD) - 1 - - DO I=1,TRIM(INPUT)-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND. - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND. - & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR. - & (INDEX('@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0 - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND. - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALPHA(IN) - - CHARACTER*(*) IN - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURN - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN - - BBOARD_NAME = FOLDER_DESCRIP(I+1:) - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!') - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DO - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - IF (INDEX(IMAGENAME,';').GT.0) ILEN = INDEX(IMAGENAME,';') - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0) - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - IF (.NOT.IER.AND..NOT.DEL) THEN - CALL DELPRC('BULLCP NEWS',DEL) - IER = .NOT.DEL - ELSE - IER = .TRUE. - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI) -C -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL ADD_2_ITMLST(4,JPI$_ENQLM,%LOC(ENQLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF - END IF - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_ENQLM - CALL LIB$MOVC3(4,ENQLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2)) - - RETURN - END - - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - CHARACTER*4 FUNCTION GET_VMS_VERSION -C -C FUNCTION GET_VMS_VERSION -C -C FUNCTION: Gets VMS version -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER VERSION*4 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,SYI$_NODE_SWVERS,%LOC(VERSION)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - GET_VMS_VERSION = VERSION - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DO - - CALL CLOSE_BULLDIR - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'F - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER))A - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DOB - - IF (IER.NE.0) THENF - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0r - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTEd - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAMM - - DATA OBIO/0/,OCPU/0/,ODIO/0/D - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAM - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list, - P - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU))n - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IFM - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1t - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM)6 - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.1 - END DO - END IFo - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND. - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIOO - ODIO = DIOw - OCPU = CPUe - IER = 0 - RETURNO - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IF - RETURN - END diff --git a/decus/vms95b/bulletin/bulletin4.for b/decus/vms95b/bulletin/bulletin4.for deleted file mode 100644 index a4a1582..0000000 --- a/decus/vms95b/bulletin/bulletin4.for +++ /dev/null @@ -1,2199 +0,0 @@ -C -C BULLETIN4.FOR, Version 4/19/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(BUFFER,0,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' ') THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - ELSE - IF (.NOT.HEADER) THEN - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - STRIP = .FALSE. - END IF - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - IER = 0 - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - CALL STR$UPCASE(FOLDER,FOLDER) - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '', - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAX - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - LENDES = 0 - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACL - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_NAME = FOLDER - FOLDER_OWNER = FOLDER1_OWNER - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -C -C Description: -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -C -C SUBROUTINE CREATE_NEWS_FOLDER -C -C FUNCTION: Creates a new newsgroup. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME) - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF -C -C If file specified in command, read file. -C Else, read from the terminal. -C - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file -2010 FORMAT(A) - ICOUNT = ICOUNT + ILEN - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER, - & 'Adding newsgroup.') - CLOSE (UNIT=3) - - RETURN - -920 WRITE(6,1020) -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURN - -910 WRITE(6,1010) -1010 FORMAT (' No news group was added.') - CLOSE (UNIT=3) - RETURN - - END - - - - - SUBROUTINE INIT_COMPRESS - - IMPLICIT INTEGER (A-Z) - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127 - DO J=0,127 - A(J,I) = ' ' - END DO - END DO - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DO - - J = 1 - DO I=1,8 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=10,31 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=127,254 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - - RETURN - - ENTRY COMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.126) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.126) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:))) - IF (T(O:O).NE.' ') THEN - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND. - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1)) - C = C + 1 - K = K + 1 - END DO - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1) - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0) - O = O + 1 - ELSE - T(O:O) = IN(K:K) - IF (ICHAR(T(O:O)).LT.9.OR.(ICHAR(T(O:O)).GT.9.AND. - & ICHAR(T(O:O)).LT.32)) T(O:O) = ' ' - K = K + 1 - O = O + 1 - END IF - END DO - IF (K.EQ.L) THEN - T(O:O) = IN(K:K) - ELSE - O = O - 1 - END IF - - OUT = T - - RETURN - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1 - T(O:O) = IN(I+2:I+2) - END DO - I = I + 3 - ELSE - B = UNMAP(J) - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1 - T(O:O) = IN(I:I) - ELSE - O = O + 2 - T(O-1:O) = B - END IF - I = I + 1 - END IF - END DO - - OUT = T(:O) - - RETURN - END diff --git a/decus/vms95b/bulletin/bulletin5.for b/decus/vms95b/bulletin/bulletin5.for deleted file mode 100644 index e762265..0000000 --- a/decus/vms95b/bulletin/bulletin5.for +++ /dev/null @@ -1,2503 +0,0 @@ -C -C BULLETIN5.FOR, Version 9/13/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3) THEN - CALL SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - RETURN - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - NODEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (NODEFAULT) THEN - IF (NOTIFY.NE.-1) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) THEN - CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - END IF - REWRITE(4) USER_HEADER - ELSE IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & (FOLDER1_NUMBER.EQ.0.AND.FOLDER1_BBOARD(:2).NE.'::')) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - IF (FOLDER1_NUMBER.NE.0.OR.FOLDER1_BBOARD(:2).NE.'::') THEN - ! Test is due to bug which changes folder number to zero - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG - IF (BTEST(FOLDER1_FLAG,2)) THEN - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAG - FOLDER_NUMBER = TEMP_NUMBER - END IF - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - CALL UPDATE_EXCLUDE - - CALL UPDATE_USERINFO - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET').OR.(INCMD(:3).EQ.'SEA') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & (F1_START.GT.0.OR.F_START.LE.F_NBULL)) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_COUNT = F1_COUNT - IF (F1_START.GT.0) THEN - IF (F1_NBULL.LT.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER-1.GE.F1_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - ELSE - F_NBULL = F1_NBULL - END IF - F_START = F1_START - ELSE - F_START = F_NBULL + 1 - END IF - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - REMOTE_SET_NEW = 1 - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - IF (COMMAND.AND.INCMD(:3).NE.'REP'.AND. - & INCMD(:3).NE.'DEL') HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER1) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.IER1.EQ.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11).AND.WRITE_ACCESS) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s news group.'')') - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP( - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE IF (REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - ELSE IF (REMOTE_SET.EQ.3.OR.REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN - WRITE (6,'('' Folder only accessible for reading.'')') - END IF - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THEN - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - BULL_PARAMETER = 'MARKED' - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - BULL_PARAMETER = 'SEEN' - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED' - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN' - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - WRITE(6,'('' WARNING: No '',A, - & '' messages found.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IF - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE. - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - LAST_FOLDER_NUMBER = FOLDER_NUMBER - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IF - - IF (TEST_NEWS(FOLDER1)) THEN - INCMD = 'SET NEWS ' - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL ' - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Access is limited.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0) - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,10)) THEN - WRITE (6,'('' POST_ONLY has been set.'')') - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THEN - WRITE (6,'('' COMPRESS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - SLIST = INDEX(FOLDER1_DESCRIP,'<') - ELIST = INDEX(FOLDER1_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN - IF ((FOLDER1_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR. - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))).AND. - & INDEX(FOLDER_DESCRIP(SLIST+2:),'@').EQ.0) THEN - WRITE (6,'('' Last message fed by news group was: '',I)') - & F_LAST - END IF - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/, - & ' Description: ',A) -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/, - & ' Description: ',A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/ - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' ' - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. - STORED = .FALSE. - CLASS = .FALSE. - NEW = .FALSE. - PERM = .FALSE. - DEFA = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counter - NLINE = 1 - START = .FALSE. - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE. - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - CALL NEWS_LIST - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - END IF - COUNT = CLI$PRESENT('COUNT') - IF (COUNT) TOTAL_COUNT = 0 - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - NEW = CLI$PRESENT('NEWGROUPS') - CLASS = CLI$PRESENT('CLASS') - PERM = CLI$PRESENT('PERMANENT') - DEFA = CLI$PRESENT('DEFAULT') - IF (CLASS) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - ELSE IF (PERM) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE IF (DEFA) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER) - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER - FOLDER_COUNT = -1 - RETURN - ELSE - START = .TRUE. - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN) - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0 - FOLDER_COUNT = -1 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN - SUBNUM = -2 - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DECLARE_CTRLC_AST - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE. - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (PERM.OR.DEFA) THEN - IER = 1 - DO WHILE (INUM.LE.FOLDER_MAX.AND.IER.NE.0) - IF (INF_REC2(1,INUM).NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (ZEXT(INF_REC2(1,INUM)),IER) - END IF - INUM = INUM + 1 - END DO - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2 - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THEN - NEW_NEWS = FOLDER1_NUMBER - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP) - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)), - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - END IF - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - FSTATUS1 = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (.NOT.NEWS_TEST) THEN - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN - IER1 = 1 - MORE = .TRUE. - END IF - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DO - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1 - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THEN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))') - ELSE IF (CLASS) THEN - WRITE (6,'(1X,''Class'',/,1X,(''-''))') - ELSE IF (SUBSCRIBE) THEN - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,''Status'',7X, - & ''First Last'',/,1X,(''-''))') - END IF - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1 - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1.AND. - & FLAG.NE.100) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - ELSE - FSTATUS1 = ' ' - END IF - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNT - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0 - END IF - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - END IF - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IF - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER - IF (NEWS_TEST.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - CALL GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & FSTATUS1,IER,ACTIVE) - MORE = MORE.AND.FOUND - IF (MORE) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND.AND.FLAG.NE.1) FLAG = 100 - END IF - END DO - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - END IF - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNT - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSE - WRITE(6,1100) ! Else say there are more - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10) -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS.OR.CLI$PRESENT('CLASS')) THEN - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.' - END IF - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER ! Open folder file - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - CALL RESET_PROTECTION - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')') - RETURN - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0) - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER) - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE - CALL SET_FOLDER_FILE(0) - END IF - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ELSE - ID = INPUT - INPUT = ' ' - END IF - ILEN = TRIM(ID) - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IF - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*256 ACLENT - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURN - - ENTRY WRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER_COM - END IF - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DOF - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNB - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)P - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEND - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COMN - END IF - END DOU - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1C - - RETURNA - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DOC - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENH - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COML - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1$ - - RETURND - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COMF - END IF - END DO- - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1A - - RETURNI - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))A - IF (NEWS_OPEN) THENO - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COMR - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1. - - RETURNE - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER)F - - DO WHILE (REC_LOCK(IER))I - IF (NEWS_OPEN) THEN_ - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COMG - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO( - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNR - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)'T - - CHARACTER*(*) KEY_NAME) - - INCLUDE 'BULLUSER.INC'F - - CHARACTER*12 SAVE_USERNAME0 - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME' - - DO WHILE (REC_LOCK(IER))E - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAMEC - USERNAME = SAVE_USERNAME_ - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER)L - - SAVE_USERNAME = USERNAMEE - - DO WHILE (REC_LOCK(IER))G - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRYC - END DO_ - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAMES - - RETURNL - - ENTRY READ_USER_FILE_HEADER(IER)( - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DOD - - RETURNI - - ENTRY WRITE_USER_FILE_NEW(IER)T - - DO I=1,FLONGN - SET_FLAG(I) = SET_FLAG_DEF(I)C - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)S - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I)) - END DOE - - ENTRY WRITE_USER_FILE(IER)E - - DO WHILE (REC_LOCK(IER))A - WRITE (4,IOSTAT=IER) USER_ENTRYE - END DO - - RETURN. - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - B - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - t - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)T - - NEW_NEWS_ACCESS = - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS'A - - RETURNR - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - ) - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_'F - END DOE - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)Y - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C))D - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' ' - ELSE - FILE = FILE(:L) - END IF - END DO - - RETURNN - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z)P - - CHARACTER*(*) INPUT,FIND - - F = LEN(FIND)I - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURN, - END DOR - - RETURN, - END - - - - - SUBROUTINE GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & STAT,IER,ACTIVE) - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'' - - INCLUDE '($SSDEF)'t - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG' - - CHARACTER*(*) STAT,FOLDER_MATCH - - CHARACTER NEWS_ACCESS*132 - - FOUND = .FALSE. - STAR = INDEX(FOLDER_MATCH,'*')N - ONE = STAR.EQ.0.AND.TRIM(FOLDER_MATCH).GT.0 - START = .FALSE. - IF (STAR.GT.1)R - & START = FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1)W - STARTNOW = STARTN - - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - IF (ONE) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP, - & (FOLDER_MATCH(:TRIM(FOLDER_MATCH)),IER)R - FOLDER_MATCH = ' 'L - ELSE IF (STARTNOW) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMPF - & (FOLDER_MATCH(:STAR-1),IER) - STARTNOW = .FALSE.e - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - END IF - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - STAT(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - STAT = ' 'A - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(STAT(:1).NE.'x'.AND. - & .NOT.BTEST(FOLDER1_FLAG,9))).AND.S - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND.T - & (ONE.OR..NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THENB - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP)N - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2)R - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFERB - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1)T - ELSEf - FOUND1 = .TRUE. - END IF - END IFb - FOUND = FOUND1a - ELSE. - FOUND = .TRUE.E - END IFA - ELSE IF (IER.EQ.0.AND.START) THEN - IF (FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1)) RETURN - END IF - IF (ONE) RETURNA - END DON - - RETURNN - END diff --git a/decus/vms95b/bulletin/bulletin6.for b/decus/vms95b/bulletin/bulletin6.for deleted file mode 100644 index 92a33ac..0000000 --- a/decus/vms95b/bulletin/bulletin6.for +++ /dev/null @@ -1,2800 +0,0 @@ -C -C BULLETIN6.FOR, Version 9/15/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - TRY = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.TRY.EQ.0) THEN - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - TRY = 1 - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL_NAME - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & BUFFERCOUNT=127, - & ORGANIZATION='INDEXED',IOSTAT=IER) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open file: '',A)') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - IF (UNIT.EQ.14) THEN - WRITE (6,'('' Database conversion in progress. Try later.'')') - ELSE - WRITE (6,'('' Please try again later.'')') - END IF - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - COMMON /NEWSLIST/ NEWSLIST - DATA NEWSLIST/0/ - - COMMON /DIRLIST/ DIRLIST - DATA DIRLIST/0/ - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - LUN = 2 - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL_NAME - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & BUFFERCOUNT=127, - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - END IF - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) WRITE(6,'(1X,A)') - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1))) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULL - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LAST - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMIT - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLNEWSDIR - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($FORIOSDEF)' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*180 TEMP - - CHARACTER BUFFER*12,DATETIME*24 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - CALL OPEN_BULLNEWS - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=180/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & BUFFERCOUNT=127,KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR]') - IF (.NOT.IER1) GO TO 900 - - NEW_FOLDER_NUMBER = 0 - - DO WHILE (IER.EQ.0) - READ (2,IOSTAT=IER) TEMP - IF (GET_INTEGER(%REF(TEMP)).NE.NEW_FOLDER_NUMBER) THEN - IF (NEW_FOLDER_NUMBER.NE.0) CLOSE (UNIT=9,DISPOSE='KEEP') - NEW_FOLDER_NUMBER = GET_INTEGER(%REF(TEMP)) - CALL SET_BULLNEWSDIR_FILE(NEW_FOLDER_NUMBER) - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE, - & STATUS='UNKNOWN',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) GO TO 900 - END IF - NEWS_MSG_NUM = GET_INTEGER(%REF(TEMP(5:))) - NEWS_MSG_BTIM_KEY = TEMP(13:) - NEWS_EX_BTIM_KEY = TEMP(89:) - NEWS_MSGID = TEMP(21:) - CALL COPY2(MSG_BTIM,%REF(TEMP(97:))) - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL LIB$MOVC3(76,%REF(TEMP(105:)),NEWS_BLOCK) - - WRITE (9,IOSTAT=IER1) NEWSDIR_ENTRY - END DO - - CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - - CALL RESET_PROTECTION - - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - - IER = LIB$RENAME_FILE(BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - & ,'BULLNEWSDIR.OLD') - - WRITE (6,'('' BULLNEWSDIR.DAT has been renamed to '', - & '' BULLNEWSDIR.OLD and may now be deleted.'')') - - RETURN - -900 CALL RESET_PROTECTION - - CALL CLOSE_BULLNEWS - - WRITE(6,'('' ERROR: Cannot convert BULLNEWSDIR.DAT'')') - IF (IER.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - - END - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(81:84) = BUFFER(85:) - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL RESET_PROTECTION - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - IF (ASK_SIZE.EQ.184) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST) - ELSE - F_LAST = 0 - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LAST - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER)) - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0 - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -C -C SUBROUTINE CONVERT_BULLNEWS -C -C FUNCTION: Converts bulletin NEWS file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. '' - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0 - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE) - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0 - NEWS_F_END = 0 - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108) - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:) - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1 - IF (LMOVE.LE.0) THEN - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP - ELSE - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE)) - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) - END IF - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SET_PROTECTION - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL RESET_PROTECTION - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXT - - COMMON /KEEPLOCK/ KEEPLOCK - DATA KEEPLOCK/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - CHARACTER*4 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSE - DIR_NUM = 0 - END IF - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURN - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEYGE=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0.AND.ICOUNT.EQ.F_START) THEN - READ(2,KEYGT=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.EQ.0) ICOUNT = NEWS_MSG_NUM - END IF - END IF - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND. - & MSG_NUM.GT.F_START) THEN - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER,IER2) - F_START = MSG_NUM - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IF - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THEN - ICOUNT = MSG_NUM - BULLETIN_NUM = ICOUNT - END IF - END IF - ELSE - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 - END IF - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END IF - END DO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IF - - IF (IER.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1 - END IF - END IF - END IF - - RETURN - - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM) - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z) - - INTEGER TEMP - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I) - END DO - - RETURN - END - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/1/ - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.2.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.2.AND.MSG_NUM.NE.0) THEN - IF (MSG_NUM.GT.NEWS_F_END) THEN - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36 - UNLOCK 2 - END IF - END IF - END IF - ELSE - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - IER = 0 - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10 - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY),%DESCR(EX_BTIM)) - IF (POSTTIME) THEN - CALL GET_MSGKEY(%REF(NEWS_POST_KEY),%DESCR(MSG_BTIM)) - CALL CONVERT_FROM_GMT(MSG_BTIM) ! Assume stored is GMT - END IF - DESCRIP = NEWS_DESCRIP - FROM = NEWS_FROM - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IF - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11) - EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME(:11) - TIME = DATETIME(13:23) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - ELSE - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IF (BULLETIN_NUM.NE.NEWS_F_END+1) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END DO - END IF - ELSE - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IF - IF (REMOTE_SET.EQ.4.AND. - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN - CALL SPECIAL_NEWSDIR_ENTRY(IER) - ELSE IF (IER.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEN - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*140 TEMP - - DIMENSION BTIM(2) - - READ (2,KEYID=3,KEY=NEWS_POST_KEY,IOSTAT=IER) TEMP - DO WHILE (IER.EQ.0.AND.NEWS_POST_KEY.EQ.TEMP(57:64)) - IF (NEWS_MSGID.EQ.TEMP(21:56)) THEN - IER = 2 - RETURN - END IF - READ (2,IOSTAT=IER) TEMP - END DO - -10 IER1 = 0 - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=0,KEYGT=NEWS_F_END, - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - DO WHILE (IER1.EQ.0) - CALL LIB$MOVC3(4,%REF(INPUT),FNUM) - CALL GET_MSGKEY(%REF(INPUT(13:)),%DESCR(BTIM)) - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IF - F_COUNT = F_COUNT + 1 - CALL LIB$MOVC3(4,%REF(INPUT),NEWS_F_END) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - END DO - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IF - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSE - F_COUNT = F_COUNT + 1 - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,MSG_BTIM) - ELSE - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - END IF - - IF (LOCAL_POST) THEN - CALL SYS_BINTIM(DATE//' '//TIME - & (:TRIM(TIME)-2)//'00',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP - NEWS_FROM = FROM - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH - NEWS_MSG_NUM = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,NEWS_MSG_BTIM_KEY) - CALL GET_MSGKEY(EX_BTIM,NEWS_EX_BTIM_KEY) - ELSE - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - - RETURN - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KEYID/ NEWS_KEYID - - COMMON /KEEPLOCK/ KEEPLOCK - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 2 - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - CALL READDIR_KEYGE(NDEL) - KEEPLOCK = .FALSE. - NEWS_KEYID = 1 - - RETURN - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII))/ - IF (ACLSTR(START_ID:START_ID).NE.','.AND.B - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE.E - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DOC - IF (ASCII) THEN - START_ID = START_ID + 1T - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1N - END_ID = INDEX(ACLSTR,'ACCESS') - 2C - END IF - END IFL - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THENY - IF (ACC_TYPE.EQ.1) THENU - WRITE (6,'(C - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(U - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IFN - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THENU - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)( - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2. - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)C - OUTLEN = 1 - ELSEU - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IFU - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DOM - - RETURNE - END - - - - - SUBROUTINE CONVERT_INFFILEL - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))5 - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THENY - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')= - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFh - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))I - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)N - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DOU - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9)1 - - RETURNT - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -CC -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another fileK -C( - IMPLICIT INTEGER (A-Z)R - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))_ - ! Get length needed to store acl outputR - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of stringO - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURNG - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C: -C SUBROUTINE COPY_ACL11 -C0 -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routinesF -C since must convert location of string into a character string. -CN - IMPLICIT INTEGER (A-Z)O - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - ! Read input file aclT - - IF (.NOT.IER) THEN: - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENTE - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,S - & %LOC(ACLENT))I - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlistF - IER = SYS$CHANGE_ACL' - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST)D - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IFR - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output fileU - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT,D - & %LOC(ACLENT(POINT:)))O - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DOv - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURNO - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./S - - IF (CHECKED) RETURN - - CHECKED = .TRUE.) - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C)' - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORYR - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE - CALL ADD_DIRECTORY(BULLNEWS_FILE)I - END IF - - CALL CHECK_DIR(FOLDER_DIRECTORY,.FALSE.) - CALL CHECK_DIR(NEWS_DIRECTORY,.FALSE.)K - - CALL ADD_DIRECTORIES - - RETURN - END - - - - SUBROUTINE ADD_DIRECTORIES - - INCLUDE 'BULLFILES.INC'E - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE)D - - RETURNE - END - - - - LOGICAL FUNCTION CHECK_DIR(DIRECTORY,LIBRARY) - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLFILES.INC'_ - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - CHECK_DIR = PRESENT(BULLUSER_FILE,DIRECTORY,TEST).AND.E - & PRESENT(BULLFOLDER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLINF_FILE,DIRECTORY,TEST) - - IF (CHECK_DIR) THEN - IF (SYS_TRNLNM(DIRECTORY,TEST)) DIRECTORY = TEST - RETURN - END IF - - TEST = ' 'M - - IF (INDEX(DIRECTORY,']').EQ.0) THEN - CALL SYS_TRNLNM(DIRECTORY,TEST1) - ELSE - TEST1 = DIRECTORY - END IF( - - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER)E - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST), - END DOU - - IF (.NOT.LIBRARY.AND.TEST.EQ.' ') THEN' - IER = SYS_TRNLNM_SYSTEM(DIRECTORY,TEST)4 - IF (.NOT.IER.AND.TEST1.EQ.DIRECTORY) RETURN, - END IF - - IF (TEST.NE.TEST1) THEN - IF (LIBRARY) THEN_ - WRITE (6,'('' ERROR: Not a valid library. '')') - RETURN' - END IF - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER)U - CLOSE(UNIT=3,STATUS='DELETE')M - CALL ENABLE_PRIVS_ - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)') - & TEST1(:TRIM(TEST1))M - CALL EXIT - END IF - DIRECTORY = TEST1S - ELSEL - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - CHECK_DIR = .TRUE. - END IFE - - RETURNW - END - - - - - LOGICAL FUNCTION PRESENT(FILE,DIR,TEST) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILE,DIR,TEST - - FILE = FILE(INDEX(FILE,':')+1:) - FILE = FILE(INDEX(FILE,']')+1:) - IF (INDEX(DIR,':').EQ.0.AND.INDEX(DIR,'[').EQ.0.AND. - & INDEX(DIR,'<').EQ.0) DIR = DIR(:TRIM(DIR))//':' - C = 0 - PRESENT = LIB$FIND_FILE(DIR(:TRIM(DIR))//FILE,TEST,C) - - RETURN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z)0 - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:)E - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:) - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':'A - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURNS - END - - - - SUBROUTINE SET_LIBRARYF - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - R - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CALL CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P) - - IF (CHECK_DIR(BULL_PARAMETER,.TRUE.)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - CALL UPDATE_USERINFO - CALL OPEN_USERINFO - INCMD = 'SHOW' - CALL UPDATE_READ(0)D - END IFI - - RETURN4 - END - - - - SUBROUTINE SHOW_LIBRARY - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (CLI$PRESENT('ALL')) THEN - IER = 1S - N = 1O - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',BULL_PARAMETER) - IF (IER) THEN - IF (N.EQ.1) THEN - WRITE (6,'('' The following are valid libraries:'')') - N = 0 - END IF - WRITE (6,'(1X,A)') BULL_PARAMETERT - END IFO - END DO - IF (N.EQ.1) WRITE (6,'('' No libraries are present.'')') - ELSEO - WRITE (6,'('' Present library is: '',A)'), - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - END IF - - RETURNR - END - - - - SUBROUTINE SET_BULLNEWSDIR_FILE(FN) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILEE - - BULLNEWSDIR_FILE = ' 'N - - ENCODE(6,'(I6)',BULLNEWSDIR_FILE) FN - BULLNEWSDIR_FILE = BULLNEWSDIR_FILE(FIRST_ALPHA(BULLNEWSDIR_FILE):) - L = TRIM(BULLNEWSDIR_FILE)E - - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.'// - & BULLNEWSDIR_FILE(:L-3)//']'// - & BULLNEWSDIR_FILE(L-2:TRIM(BULLNEWSDIR_FILE))//'.' - - RETURNE - END diff --git a/decus/vms95b/bulletin/bulletin7.for b/decus/vms95b/bulletin/bulletin7.for deleted file mode 100644 index 1c8d068..0000000 --- a/decus/vms95b/bulletin/bulletin7.for +++ /dev/null @@ -1,2341 +0,0 @@ -C -C BULLETIN7.FOR, Version 9/29/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER1_NAME.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCALPOST/ LOCAL_POST - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - IF (.NOT.LOCAL_POST) THEN - DATE = NEWEST_DATE - TIME = NEWEST_TIME - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIR - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /OUTPUT/ REASSIGNED - LOGICAL REASSIGNED - DATA REASSIGNED /.FALSE./ - - CALL DISABLE_PRIVS ! Disable SYSPRV - - IF (.NOT.REASSIGNED) THEN - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - END IF - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - IF (INDEX(INPUT,']').GT.0) THEN - SYS_TRNLNM = .FALSE. - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX)) - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1 - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IF - - RETURN - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - IER1 = 0 - ELSE - IF (IER.GT.0) THEN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0 - CALL SET_FOLDER_FILE(0) - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0) - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*12 DATE_SAVE,EXDATE_SAVE - CHARACTER*12 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - END IF - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER PSCAN$_BEGIN = '00000000'X - PARAMETER PSCAN$_ACCOUNT = '00000001'X - PARAMETER PSCAN$_AUTHPRI = '00000002'X - PARAMETER PSCAN$_CURPRIV = '00000003'X - PARAMETER PSCAN$_GRP = '00000004'X - PARAMETER PSCAN$_HW_MODEL = '00000005'X - PARAMETER PSCAN$_HW_NAME = '00000006'X - PARAMETER PSCAN$_JOBPRCCNT = '00000007'X - PARAMETER PSCAN$_JOBTYPE = '00000008'X - PARAMETER PSCAN$_MASTER_PID = '00000009'X - PARAMETER PSCAN$_MEM = '0000000A'X - PARAMETER PSCAN$_MODE = '0000000B'X - PARAMETER PSCAN$_NODE_CSID = '0000000C'X - PARAMETER PSCAN$_NODENAME = '0000000D'X - PARAMETER PSCAN$_OWNER = '0000000E'X - PARAMETER PSCAN$_PRCCNT = '0000000F'X - PARAMETER PSCAN$_PRCNAM = '00000010'X - PARAMETER PSCAN$_PRI = '00000011'X - PARAMETER PSCAN$_PRIB = '00000012'X - PARAMETER PSCAN$_STATE = '00000013'X - PARAMETER PSCAN$_STS = '00000014'X - PARAMETER PSCAN$_TERMINAL = '00000015'X - PARAMETER PSCAN$_UIC = '00000016'X - PARAMETER PSCAN$_USERNAME = '00000017'X - PARAMETER PSCAN$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER PSCAN$_END = '00000019'X - PARAMETER PSCAN$k_type = '00000081'X - PARAMETER PSCAN$M_OR = '00000001'X - PARAMETER PSCAN$M_BIT_ALL = '00000002'X - PARAMETER PSCAN$M_BIT_ANY = '00000004'X - PARAMETER PSCAN$M_GEQ = '00000008'X - PARAMETER PSCAN$M_GTR = '00000010'X - PARAMETER PSCAN$M_LEQ = '00000020'X - PARAMETER PSCAN$M_LSS = '00000040'X - PARAMETER PSCAN$M_PREFIX_MATCH = '00000080'X - PARAMETER PSCAN$M_WILDCARD = '00000100'X - PARAMETER PSCAN$M_CASE_BLIND = '00000200'X - PARAMETER PSCAN$M_EQL = '00000400'X - PARAMETER PSCAN$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER PSCAN$S_OR = 1 - PARAMETER PSCAN$V_OR = 0 - PARAMETER PSCAN$S_BIT_ALL = 1 - PARAMETER PSCAN$V_BIT_ALL = 1 - PARAMETER PSCAN$S_BIT_ANY = 1 - PARAMETER PSCAN$V_BIT_ANY = 2 - PARAMETER PSCAN$S_GEQ = 1 - PARAMETER PSCAN$V_GEQ = 3 - PARAMETER PSCAN$S_GTR = 1 - PARAMETER PSCAN$V_GTR = 4 - PARAMETER PSCAN$S_LEQ = 1 - PARAMETER PSCAN$V_LEQ = 5 - PARAMETER PSCAN$S_LSS = 1 - PARAMETER PSCAN$V_LSS = 6 - PARAMETER PSCAN$S_PREFIX_MATCH = 1 - PARAMETER PSCAN$V_PREFIX_MATCH = 7 - PARAMETER PSCAN$S_WILDCARD = 1 - PARAMETER PSCAN$V_WILDCARD = 8 - PARAMETER PSCAN$S_CASE_BLIND = 1 - PARAMETER PSCAN$V_CASE_BLIND = 9 - PARAMETER PSCAN$S_EQL = 1 - PARAMETER PSCAN$V_EQL = 10 - PARAMETER PSCAN$S_NEQ = 1 - PARAMETER PSCAN$V_NEQ = 11 - BYTE %FILL (2) - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -C -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -C -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE)) -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1 -C UJPIMODE = -1 -C TERMINAL(1:1) = CHAR(0) -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./ - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IF - END DO - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - DO I=1,FOLDER_MAX - DO J=1,2 - LAST(J,I) = LAST_READ_BTIM(J,I) - END DO - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.EQ.0) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - WRITE (9,IOSTAT=IER) USERNAME,INF_REC - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIM - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0 - LAST_SYS_BTIM(2,I) = 0 - END DO - END IF - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -C -C SUBROUTINE READ_NEWS_USERINFO -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) NAME - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2))) - END IF - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READ - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - EQUIVALENCE (OLD_LAST_NEWS_READ2(1,1),OLD_LAST_NEWS_READ(1,1)) - INTEGER*2 OLD_LAST_NEWS_READ2(4,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF = (LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF1 = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF1 = (LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF2 = .FALSE. - GO TO 10 - - ENTRY UPDATE_USERINFO_NEWS_ALWAYS - DIFF2 = .TRUE. - -10 IF (.NOT.DIFF2) THEN - DO I=1,FOLDER_MAX - DIFF2 = (LAST_NEWS_READ(1,I).NE. - & OLD_LAST_NEWS_READ(1,I)).OR. - & (LAST_NEWS_READ(2,I).NE. - & OLD_LAST_NEWS_READ(2,I)).OR.DIFF2 - END DO - END IF - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHARED - - IF (DIFF) THEN - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & LAST(J,I) = LAST_READ_BTIM(J,I) - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - END IF - - IF (DIFF1) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & OLD_LAST_SYS_BTIM(J,I) = LAST_SYS_BTIM(J,I) - LAST_SYS_BTIM(J,I) = OLD_LAST_SYS_BTIM(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF - - IF (DIFF2) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=2,1,-1 - IF (I.EQ.NEWS_FIND_SUBSCRIBE().OR. - & OLD_LAST_NEWS_READ2(1,I).NE.LAST_NEWS_READ2(1,I)) - & OLD_LAST_NEWS_READ(J,I) = LAST_NEWS_READ(J,I) - LAST_NEWS_READ(J,I) = OLD_LAST_NEWS_READ(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - CHARACTER*24 TIME1 - - TIME1 = TIME(FIRST_ALPHA(TIME):) - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:) - END DO - - IF (TIME1.EQ.'-') TIME1 = '-- :' - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder info - ELSE IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND. - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - IF (INCMD(:4).EQ.'SHOW') THEN - SAVE_FOLDER_Q1 = 0 - RETURN - END IF - IF (NEW_MESS.OR.NEWS_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1 - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0 - END IF - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE(IER) - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER) - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - - RETURN - END diff --git a/decus/vms95b/bulletin/bulletin8.for b/decus/vms95b/bulletin/bulletin8.for deleted file mode 100644 index 5b7ad54..0000000 --- a/decus/vms95b/bulletin/bulletin8.for +++ /dev/null @@ -1,2145 +0,0 @@ -C -C BULLETIN8.FOR, Version 10/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND. - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0, - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - END IF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE. - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THEN - ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX)) - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV) - END IF - END IF - END IF - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND. - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24 - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM) - P = 4 + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (BTEST(FOLDER_FLAG,14)) FROM = 'ANONYMOUS' - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT) - P = 4 + P - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER) - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - CALL CLOSE_BULLFOLDER - END IF - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = -1 - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV) - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - INIT = INIT + 2 - IF (INIT.GT.60) THEN - WRITE (6,'('' Bulletin aborting due to record lock'', - & '' problem. Alert system administrator.'')') - CALL EXIT - END IF - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /WINDOW/ WINDOW - - CHARACTER*80 MESSAGE - - WINDOW = 1 - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - - COMMON /TEMP_INPUT/ NODE_TEMP - CHARACTER NODE_TEMP*256 - - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,PASSWORD*32,TEMP_USER*12 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - RETURN - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C -C SUBROUTINE SET_FOLDER_FILE -C -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE, -C if = 1, set FOLDER1_FILE -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NUM.EQ.0) THEN - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE) - END IF - - RETURN - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C -C SUBROUTINE SET_FILE -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILE - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - ELSE - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)// - & '.]' - END IF - - RETURN - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12 - - DATA UPDATE/.FALSE./, JUST_NAME/.FALSE./ - - UPDATE = .TRUE. - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_UPDATE - - UPDATE = .NOT.UPDATE - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_NAME - - JUST_NAME = .NOT.JUST_NAME - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATE - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):) - - M = INDEX(FILDATE,'-') - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3) - - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN - FOLDER_FILE = FOLDER1_FILE - IF (JUST_NAME) THEN - JUST_NAME = .FALSE. - RETURN - END IF - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THEN - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHARED - END IF - END IF - - JUST_NAME = .FALSE. - - IF (UPDATE) THEN - READ (1'1) NBLOCK - REWRITE (1) NBLOCK + LENGTH - UPDATE = .FALSE. - END IF - - RETURN - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THEN - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE - MINGT0 = MIN(I,J) - END IF - - RETURN - END diff --git a/decus/vms95b/bulletin/bulletin9.for b/decus/vms95b/bulletin/bulletin9.for deleted file mode 100644 index cf419a8..0000000 --- a/decus/vms95b/bulletin/bulletin9.for +++ /dev/null @@ -1,2436 +0,0 @@ -C -C BULLETIN9.FOR, Version 6/7/95 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - - IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN - WRITE (6,'(A)') ' A new BULLETIN executable has been '// - & 'installed since your last use.' - WRITE (6,'(A)') - & ' Type HELP NEW_FEATURES for help on any new features.' - END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - EXTERNAL BULLETIN_SUBCOMMANDS - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IF - END IF - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE - WRITE (6,1000) - END IF - IF (.NOT.SUBSCRIBE) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - DO I = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IF - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1 - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THEN - NUM_FOLDER = 0 - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1), - & 'HIT any key for next page....') - END IF - END DO - IF (NUM_FOLDERS.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE IF (INEW) THEN - NEW = INEW - IF (REMOTE_SET.GE.3) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSE - CALL FIND_NEWEST_BULL - END IF - END IF - - IF (INCMD(:4).NE.'INDE') THEN - IER = CLI$DCL_PARSE('INDEX',BULLETIN_SUBCOMMANDS) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1010 FORMAT (' The following folders with new messages are present'/) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - FOLDER_PRESENT = CLI$PRESENT('FOLDER') - - IF (FOLDER_PRESENT) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z') - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME) - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURN - END IF - END IF - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid date specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURN - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN - END IF - ELSE IF (SINCE) THEN - IF (BULL_POINT.EQ.0) THEN - WRITE (6,'('' ERROR: No current message.'')') - RETURN - ELSE IF (NEWS) THEN - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THEN - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSE - STARTMSG = 1 - END IF - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - ELSE - IF (NEWS) THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1 - END DO - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND. - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0 - NEWSMSG = 1 - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THEN - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0 - ELSE - FOUND = .FALSE. - END IF - IF (FOUND.AND.NEWS) THEN - WRITE (6,'(1X,A,'' latest message read '', - & I,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'', - & '' to specified folder.'')') - END IF - END IF - IF (.NOT.ALL) THEN - IF (IER.NE.0) THEN - WRITE (6,'('' User info does not exist.'')') - END IF - IER = 2 - END IF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - CALL CLOSE_BULLUSER - ELSE - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - CALL CLOSE_BULLUSER - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPE - DATA SCRTYPE/-1/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESS - - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - IER1 = 1 - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER2) THEN - CALL ADD_DIRECTORIES - ELSE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IF - END IF - END DO - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - LDESCR = 0 - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - IF (.NOT.NEWS_FEED()) THEN - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - ELSE - CALL STRIP_HEADER(' ',0,IER) - END IF - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - IF (NEWS_FEED().OR.LEN_FROM.EQ.0.OR. - & (BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0) - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0 - IF (IER1.NE.0) THEN - OPEN (UNIT=3,DISPOSE='DELETE',FILE='BULL_DIR:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW') - SCRTYPE = 1 - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - CHARACTER*256 BUFFER - - REWIND (UNIT=3) - - IF (.NOT.NEWS_FEED()) THEN - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,'>')-1) - CALL SYS$SETAST(%VAL(1)) - CALL NEWS_POST('ignore',.TRUE.,IER,INDESCRIP) - IF (TEST_BULLCP().EQ.2) CALL SYS$SETAST(%VAL(0)) - END IF - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3) - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - CHARACTER*24 TODAY - - DATA STORED /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THEN - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER - RETURN - ELSE IF (BUFFER(:5).EQ.'From:') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE. - OLD_BUFFER_FROM = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - END IF - STORED = .TRUE. - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STORED - STORED = .FALSE. - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3) - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - IF (LEN_BUFFER.GT.0) THEN - IF (.NOT.TEXT) THEN - IF (.NOT.NEWS_FEED()) THEN - TEXT = .TRUE. - ELSE - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - END IF - IF (TEXT) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - ELSE - IF (TEXT) WRITE (3,'(A)') ' ' - END IF - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF ((TEXT.AND.NEWS_FEED()).OR. - & (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') ' ' - END IF - IF (.NOT.NEWS_FEED()) CALL STORE_BULL(1,' ',NBLOCK) - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2 - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-') - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO - INEXDATE = .TRUE. - END IF - END IF - IF (.NOT.NEWS_FEED()) THEN - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - TEXT = .TRUE. - ELSE - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - IF ((TEXT.AND.NEWS_FEED()).OR. - & (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /SCRTYPE/ SCRTYPE - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAY - - CHARACTER USER_SAVE*12 - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1 - FIRST_BREAK = .FALSE. - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - IF (NEWS_FEED()) THEN - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - CALL STRIP_HEADER(' ',0,IER) - TEXT = .FALSE. - RETURN - END IF - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - RETURN - END IF - - TEXT = .TRUE. - - EXTIME = '00:00:00.00' - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2100' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.GE.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME) - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARD - END IF - IF (SCRTYPE.EQ.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - CALL RESPOND_MAIL('BULL.SCR',INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('BULL.SCR;*') - END IF - CALL SETUSER(USER_SAVE) - USERNAME = USER_SAVE - ELSE - CLOSE (UNIT=3) - END IF - SCRTYPE = -1 - END IF - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - - IF (.NOT.NEWS_FEED()) THEN - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - END IF - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(FROM,INFROM,LEN_INFROM) - - RETURN - END - - - SUBROUTINE GET_FROM(FROM,INFROM1,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INFROM1,FROM - - CHARACTER*256 INFROM - - INFROM = INFROM1 - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - I = INDEX(INFROM,'<') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<')+1:) ! personal-name - END IF - - I = INDEX(INFROM,'(') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'(')+1:) ! personal-name (net-name) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR.INFROM(I:I).LE.' '.OR. - & INFROM(I:I).GE.CHAR(127).OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) - I = I + 1 - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1 - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND.INFROM(I:I).GT.' '.AND. - & INFROM(I:I).LT.CHAR(127).AND. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.126) - & INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP).AND..NOT.NEWS_FEED()) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - END IF - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) THEN ! of previous header line - IF (LAST_NEWSGROUPS) THEN - NEWSGROUPS = NEWSGROUPS(:TRIM(NEWSGROUPS))//BUFFER(2:) - END IF - RETURN - END IF - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - LAST_NEWSGROUPS = .FALSE. - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.' - END IF - ELSE IF (BUFFER(:11).EQ.'Newsgroups:') THEN - NEWSGROUPS = BUFFER(13:) - LAST_NEWSGROUPS = .TRUE. - END IF - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - - RETURN - END - - - - - SUBROUTINE SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_NEWS_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified news group -C Note: If NOTIFY READNEW and BRIEF = 0, it is either news -C group removal or SET SUBSCRIBE command. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - ALL = .FALSE. - DEFAULT = 1 - NODEFAULT = 0 - SUB = ABS(BRIEF)+ABS(NOTIFY)+ABS(READNEW).EQ.0 - - IF (NOTIFY.EQ.1.AND.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: /NOTIFY is invalid with non-stored'', - & '' news group.'')') - RETURN - END IF - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - IF (CLI$PRESENT('NOPERMANENT').OR.CLI$PRESENT('PERMANENT').OR. - & (SUB.AND.(NODEFAULT.OR.CLI$PRESENT('NOPERMANENT')))) THEN - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (SUB) DEFAULT = 1 - ELSE IF (CLI$PRESENT('NOPERMANENT').OR.NODEFAULT) THEN - IF (NOTIFY.GE.0) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - IF (SUB) - & CALL SET_NEWS_FLAG(IER,-1,-1,-1) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*PERM ',INF_REC - END IF - END IF - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - IF (NODEFAULT.AND.SUB) THEN - NOTIFY = -1 - READNEW = -1 - BRIEF = -1 - END IF - IF (DEFAULT.OR.NODEFAULT) THEN - IF (NODEFAULT.AND..NOT.SUB) THEN - IF (NOTIFY.NE.-1) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - ELSE - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*DEFAULT ',INF_REC - END IF - END IF - IF ((ALL.OR.(SUB.AND.INCMD(:3).NE.'SET')).AND.IER.EQ.0) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY=TEMP_USER,IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - END IF - END IFt - CALL READ_USER_FILE(IER)t - END DO - CALL CLOSE_BULLUSER - END IFn - - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF: - - RETURNn - END - - - - - SUBROUTINE READ_INF_REC - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC's - - INCLUDE 'BULLUSER.INC't - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL OPEN_BULLINF_SHAREDE - DO WHILE (REC_LOCK(IER1))O - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_RECN - END DOA - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DOT - END IF - CALL CLOSE_BULLINF_ - - RETURN - - ENTRY SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER.AND.' - & INF_REC2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1m - END DOd - - IF (I.GT.FOLDER_MAX-1.AND.TEMP_USER(:1).EQ.'*') THENa - WRITE (6,'('' ERROR: You have '',S - & '' reached the news folder limit of '',I,''.'')')L - & FOLDER_MAX-1 - IER = 09 - RETURN - END IF - - IF (INF_REC2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14)9 - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15)O - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15)_ - IF (NOTIFY+READNEW+BRIEF.EQ.-3) THEN - DO J=I,FOLDER_MAX-2 - CALL COPY2(INF_REC(1,J),INF_REC(1,J+1))F - END DO - END IF - IER = 1E - RETURN - END IF - - IF (NOTIFY+READNEW+BRIEF.EQ.-3) RETURNr - - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(' - & ZEXT(INF_REC2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(INF_REC(1,J),INF_REC(1,J-1)). - END IF4 - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THENl - INF_REC2(1,J) = NEWS_FOLDER_NUMBER. - IF (F_START.LE.F_NBULL) THEN - INF_REC2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - INF_REC(2,J) = F_START - 1R - ELSEA - INF_REC2(2,J) = 0 - INF_REC(2,J) = F_NBULL - END IF4 - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13)E - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13)O - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IER = 1 - RETURNe - END IF - END DOG - - RETURN - END diff --git a/decus/vms95b/bulletin/bullfiles.inc b/decus/vms95b/bulletin/bullfiles.inc deleted file mode 100644 index af8ee2e..0000000 --- a/decus/vms95b/bulletin/bullfiles.inc +++ /dev/null @@ -1,39 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vms95b/bulletin/bullfolder.inc b/decus/vms95b/bulletin/bullfolder.inc deleted file mode 100644 index 117f8fc..0000000 --- a/decus/vms95b/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vms95b/bulletin/bullmain.cld b/decus/vms95b/bulletin/bullmain.cld deleted file mode 100644 index 32c0642..0000000 --- a/decus/vms95b/bulletin/bullmain.cld +++ /dev/null @@ -1,34 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vms95b/bulletin/bullnews.inc b/decus/vms95b/bulletin/bullnews.inc deleted file mode 100644 index 251895d..0000000 --- a/decus/vms95b/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vms95b/bulletin/bullstart.com b/decus/vms95b/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vms95b/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vms95b/bulletin/bulluser.inc b/decus/vms95b/bulletin/bulluser.inc deleted file mode 100644 index 215a667..0000000 --- a/decus/vms95b/bulletin/bulluser.inc +++ /dev/null @@ -1,53 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vms95b/bulletin/changes.txt b/decus/vms95b/bulletin/changes.txt deleted file mode 100644 index b70d66a..0000000 --- a/decus/vms95b/bulletin/changes.txt +++ /dev/null @@ -1,634 +0,0 @@ -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executingu -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect iss -that users will not be allowed to change the setting. The main intent heren -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder.t - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF wasw -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show thatu -there are unread new messages every time BULLETIN/LOGIN is executed, ratherc -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages.. - -A major bug was fixed which was introduced in previous mods to speed upa -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vms95b/bulletin/cmds.mai b/decus/vms95b/bulletin/cmds.mai deleted file mode 100644 index 1340739..0000000 --- a/decus/vms95b/bulletin/cmds.mai +++ /dev/null @@ -1,22 +0,0 @@ -The address for getting BULLETIN is BULLETIN@PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file - (only one file per command). - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - -BULLETIN is also available via ANONYMOUS FTP from PFC.MIT.EDU, but the account -is set at low priority, so I suggest using it during non-prime hours. - - Mark diff --git a/decus/vms95b/bulletin/copyright.txt b/decus/vms95b/bulletin/copyright.txt deleted file mode 100644 index ee33a7e..0000000 --- a/decus/vms95b/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vms95b/bulletin/create.com b/decus/vms95b/bulletin/create.com deleted file mode 100644 index 5e90fde..0000000 --- a/decus/vms95b/bulletin/create.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vms95b/bulletin/handout.txt b/decus/vms95b/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vms95b/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vms95b/bulletin/install.com b/decus/vms95b/bulletin/install.com deleted file mode 100644 index 758acd4..0000000 --- a/decus/vms95b/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vms95b/bulletin/instruct.com b/decus/vms95b/bulletin/instruct.com deleted file mode 100644 index a9cf299..0000000 --- a/decus/vms95b/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vms95b/bulletin/instruct.txt b/decus/vms95b/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vms95b/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vms95b/bulletin/login.com b/decus/vms95b/bulletin/login.com deleted file mode 100644 index 5c0c2d5..0000000 --- a/decus/vms95b/bulletin/login.com +++ /dev/null @@ -1,31 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! If you want to have more than one BULLETIN database, replace BULL_DIR -$! with the actual directory to allow redefining BULL_DIR. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vms95b/bulletin/makefile b/decus/vms95b/bulletin/makefile deleted file mode 100644 index 830c3fb..0000000 --- a/decus/vms95b/bulletin/makefile +++ /dev/null @@ -1,82 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.23" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vms95b/bulletin/master.com b/decus/vms95b/bulletin/master.com deleted file mode 100644 index f1c5834..0000000 --- a/decus/vms95b/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel:C -$ !I -$ run pmdf_root:[exe]ftcp_master -$ goto out1l -$ ! -$ CN_channel:i -$ !s -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277M -$ !L -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master( -$ goto out1_ -$ !+ -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vms95b/bulletin/mx.com b/decus/vms95b/bulletin/mx.com deleted file mode 100644 index 7d87c28..0000000 --- a/decus/vms95b/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */L - - } - } - } - rms_get(&rcptrab); /* Read next recipient */e - }u - - - /* Close the RMS files */r - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab);f - - tracemsg("BULLETIN message processed");y - exit(SS$_NORMAL); /* Always return success */ - -}L -$eod t -$copy/log sys$input MX_BULL.TXTm -$deckM - MX_BULL_ - An MX SITE transport. - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution:- - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN?h ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site.t - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including theS -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands:n - - SEND ALL Sends all bulletin files.. - SEND filename Sends the specified file.e - BUGS Sends a list of the latest bug fixes.D - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. Thei -build procedure for MX_BULL expects the logical BULL_SOURCE to point to theo -BULLETIN library. You must define this logical (or edit the .COM file)m -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct):L - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>"* - -3. If you don't have a SITE transport already defined, simply copyu - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULLe - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin deliveringc -messages to BULLETIN.t - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail tod -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETINm -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL) - MAIL> SENDU - To: MX%"GENERAL@BULLETIN" - Subj: This is a test....a - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITEu -agent, since the @BULLETIN path was defined as a SITE path.f - -To facilitate the automatic delivery of messages to BULLETIN folders, youi -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN"""/ - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN"""t - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to/ -BULLETIN via MX_BULL.d - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST ..../ - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.)u - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder.M - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwardingm -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When maild -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the messagee -to the Local agent, which discovers that the mail is forwarded tos -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUEf - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The; -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logicalf -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return addressr -for BULLETIN messages will look something like the following:t - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM:s - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayedW -to death, leaving a bad address on the "From:" line. This frequently happensa -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by:b - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnety - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226s - Western Kentucky University - Bowling Green, KY 42101 -$eod t -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$decka -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headersb -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1.u -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3i -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"?( -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file/ -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it upn -$ close tmp !...t -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr;s -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:"b -$ endifb -$ exit 1 !Always return success -$eod N diff --git a/decus/vms95b/bulletin/mx.mai b/decus/vms95b/bulletin/mx.mai deleted file mode 100644 index ec864aa..0000000 --- a/decus/vms95b/bulletin/mx.mai +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_LIBRARY") .eqs. "" -$ then say "BULL_LIBRARY logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_library/LIB,SYS$SYSTEM:SYS.STB/SEL,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_LIBRARY to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P4 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P4 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P4 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p4 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p2' 'p3' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p2' 'p3' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vms95b/bulletin/news.alt b/decus/vms95b/bulletin/news.alt deleted file mode 100644 index e33d065..0000000 --- a/decus/vms95b/bulletin/news.alt +++ /dev/null @@ -1,254 +0,0 @@ - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales diff --git a/decus/vms95b/bulletin/news.com b/decus/vms95b/bulletin/news.com deleted file mode 100644 index fb7775e..0000000 --- a/decus/vms95b/bulletin/news.com +++ /dev/null @@ -1,679 +0,0 @@ -$set nover -$copy/log sys$input NEWS.ALT -$deck - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales -$eod -$copy/log sys$input NEWS.CREATE -$deck -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - -$eod -$copy/log sys$input NEWS.MODERATORS -$deck -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com -$eod diff --git a/decus/vms95b/bulletin/news.create b/decus/vms95b/bulletin/news.create deleted file mode 100644 index dc1c840..0000000 --- a/decus/vms95b/bulletin/news.create +++ /dev/null @@ -1,155 +0,0 @@ -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - diff --git a/decus/vms95b/bulletin/news.moderators b/decus/vms95b/bulletin/news.moderators deleted file mode 100644 index b53780f..0000000 --- a/decus/vms95b/bulletin/news.moderators +++ /dev/null @@ -1,260 +0,0 @@ -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com diff --git a/decus/vms95b/bulletin/news.txt b/decus/vms95b/bulletin/news.txt deleted file mode 100644 index f52d95e..0000000 --- a/decus/vms95b/bulletin/news.txt +++ /dev/null @@ -1,150 +0,0 @@ -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when a -user accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. It is also possible to -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) When the POST and -ADD commands are used with this folder, the messages will be posted to the news -group, rather than actually being added to the folder. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. diff --git a/decus/vms95b/bulletin/nonsystem.txt b/decus/vms95b/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vms95b/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vms95b/bulletin/optimize_rms.com b/decus/vms95b/bulletin/optimize_rms.com deleted file mode 100644 index 4f42e3e..0000000 --- a/decus/vms95b/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vms95b/bulletin/pmdf.com b/decus/vms95b/bulletin/pmdf.com deleted file mode 100644 index 85c77b1..0000000 --- a/decus/vms95b/bulletin/pmdf.com +++ /dev/null @@ -1,1031 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input BULLETIN_MASTER.PAS_V32i -$deck' -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound);; - -(*******************************************************************)a -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *) -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - - outbound : text; - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL - 100; - - VAR - line, errorsto : vstring; - bigline : bigvstring; result : rp_bufstruct; - header : he_header; - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string); - - BEGIN (* try_something *) - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *) - end; (* try_something *) - - BEGIN (* return_bad_messages *) - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt'); - try_something (he_read_header (header, qu_rtxt), 'he_read_header'); - errorsto.length := 0; - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i]; - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto), - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr); - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *) - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages (tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable. - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT - -For V3.2: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check your -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vms95b/bulletin/restart.com b/decus/vms95b/bulletin/restart.com deleted file mode 100644 index 502bfa8..0000000 --- a/decus/vms95b/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vms95b/bulletin/setuser.mar b/decus/vms95b/bulletin/setuser.mar deleted file mode 100644 index 153cb7b..0000000 --- a/decus/vms95b/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vms95b/bulletin/update.fil b/decus/vms95b/bulletin/update.fil deleted file mode 100644 index 97fb572..0000000 --- a/decus/vms95b/bulletin/update.fil +++ /dev/null @@ -1,11 +0,0 @@ -$ if p1 .nes. "" then FS 'P1' -$ COPY 'FM' [.SEND]/LOG -$ COPY 'FM' CMODA::IR:[BULLETIN] -$ TAB2SP 'FM' -$ RENAME 'FM' [-.NET] -$ PUR [.SEND]'FM' -$ PUR [-.NET]'FM' -$ IF FM .EQS. "CHMAIL.MAI" THEN P3 = "AAAREADME." -$ IF P2 .EQS. "" THEN COPY 'FM' [ANONYMOUS.BULLETIN]'P3' -$ IF P3 .EQS. "" THEN PUR [ANONYMOUS.BULLETIN]'FM' -$ IF P3 .NES. "" THEN PUR [ANONYMOUS.BULLETIN]'p3' diff --git a/decus/vms95b/bulletin/upgrade.com b/decus/vms95b/bulletin/upgrade.com deleted file mode 100644 index a2d77c4..0000000 --- a/decus/vms95b/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vms95b/bulletin/writemsg.txt b/decus/vms95b/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vms95b/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vmslt00a/bulletin/aaareadme b/decus/vmslt00a/bulletin/aaareadme deleted file mode 100644 index f4cc15c..0000000 --- a/decus/vmslt00a/bulletin/aaareadme +++ /dev/null @@ -1,68 +0,0 @@ -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -If you are running a version of BULLETIN older than 2.11, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. NOTE: -Problems can occur if the old version of BULLETIN is run after the -data files have been modified. Such a situation is possible on a -cluster where each node has installed the executable separately. To -help installation, a new command procedure UPGRADE.COM has been -included. Read the comments in the file for information on how to use -it. - -NOTE: The following commands can be sent to BULLETIN@PSFC.MIT.EDU: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -You will be receiving 22 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) BULLETIN10.FOR - 13) BULLETIN11.FOR - 14) ALLMACS.MAR - 15) BULLCOMS1.HLP - 16) BULLCOMS2.HLP - 17) BULLET1.COM - 18) BULLET2.COM - 19) PMDF.COM - 20) MX.COM - 21) NEWS.COM - 22) ALLMACS_AXP.MAR - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. However, this only applies -to PMDF V3.2 or earlier, as later versions of PMDF have the necessary -interface code for BULLETIN included in it. In that case, or in case -you don't have PMDF, you can delete it. The same applies to MX. Then, -read AAAREADME.TXT for BULLETN installation instructions. If you are -using the news feature, NEWS.COM contains files which pertain to news. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@PSFC.MIT.EDU diff --git a/decus/vmslt00a/bulletin/aaareadme.install b/decus/vmslt00a/bulletin/aaareadme.install deleted file mode 100644 index e670409..0000000 --- a/decus/vmslt00a/bulletin/aaareadme.install +++ /dev/null @@ -1,202 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -By default, BULLETIN uses the format IN%"email-address" when sending mail via -VMS MAIL. The IN% is hardcoded in BULLNEWS.INC. If you use a different -protocol, you should either change the reference in that file, or you can -define logical name BULL_NEWS_MAILER to point to the new protocol, i.e. -DEFINE/SYSTEM BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vmslt00a/bulletin/aaareadme.txt b/decus/vmslt00a/bulletin/aaareadme.txt deleted file mode 100644 index 8cbfefa..0000000 --- a/decus/vmslt00a/bulletin/aaareadme.txt +++ /dev/null @@ -1,19 +0,0 @@ - Introduction to BULLETIN on the Vax - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - -see HANDOUT.TXT for more complete documentation. diff --git a/decus/vmslt00a/bulletin/allmacs.mar b/decus/vmslt00a/bulletin/allmacs.mar deleted file mode 100644 index 3725b8a..0000000 --- a/decus/vmslt00a/bulletin/allmacs.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vmslt00a/bulletin/allmacs_axp.mar b/decus/vmslt00a/bulletin/allmacs_axp.mar deleted file mode 100644 index fb06e99..0000000 --- a/decus/vmslt00a/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vmslt00a/bulletin/board_digest.com b/decus/vmslt00a/bulletin/board_digest.com deleted file mode 100644 index dec53c1..0000000 --- a/decus/vmslt00a/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vmslt00a/bulletin/board_special.com b/decus/vmslt00a/bulletin/board_special.com deleted file mode 100644 index 93e16c3..0000000 --- a/decus/vmslt00a/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vmslt00a/bulletin/bull_news.c b/decus/vmslt00a/bulletin/bull_news.c deleted file mode 100644 index 177fef6..0000000 --- a/decus/vmslt00a/bulletin/bull_news.c +++ /dev/null @@ -1,934 +0,0 @@ -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s,s1; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} - - -smtp_assign() -{ - int n; - -#if MULTINET || TWG - /* - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()). - */ - - if (!hp1) { - int h[4],i; - if (sscanf(node1,"%d.%d.%d.%d",&h[0],&h[1],&h[2],&h[3]) == 4) { - for (i=0;i<4;i++) if (h[i] < 0 || h[i] > 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp1->h_addrtype; - memcpy(&sin.sin_addr, hp1->h_addr, hp1->h_length); - } -#if TWG - sin.sin_port = htons(25); -#else - sin.sin_port = htons1(25); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s1,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s1,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node1),DSC$K_CLASS_S,DSC$K_DTYPE_T,node1}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s1,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s1,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - - -smtp_create() -{ -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s1,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(25); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s1,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#else - if (!(sys$qiow(0,s1,IO$_CREATE,&iosb,0,0,node1,25,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#endif - - return(1); -} - -smtp_disconnect() -{ -#if UCX - sys$cancel(s1); - sys$qiow(0,s1,IO$_DEACCESS,0,0,0,0,0,0,0,0,0); -#endif - sys$dassgn(s1); -} - - -smtp_connect() -{ - if (!smtp_gethost()) return(0); - if (!smtp_assign()) return(0); - if (!smtp_socket()) return(0); - return(smtp_create()); -} - -char node2[132]; - -smtp_gethost() -{ - /* - * Get the IP address of the SMTP host. - * As of MULTINET 3.0, cannot be done at AST level - * so can't do in SMTP_ASSIGN(), as BULLCP calls it at - * AST level if the decnet gateway feature is used. - */ -#if TWG - struct hostent *gethostbyname(); -#else -#if MULTINET -#endif -#endif - - node1 = getenv("BULL_SMTP_SERVER"); - if (!node1) { -#if TWG - gethostname(node2,132); -#else -#if MULTINET - gethostname1(node2,132); -#endif -#endif - node1 = node2; - } - -#if TWG - hp1 = gethostbyname(node1); -#else -#if MULTINET - hp1 = gethostbyname1(node1); -#endif -#endif - return(1); -} - - - -smtp_write_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - - -smtp_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s1,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - - -smtp_socket() -{ - -#if MULTINET || TWG - if (!(sys$qiow(0,s1,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s1,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#endif - - return(1); -} diff --git a/decus/vmslt00a/bulletin/bull_newsdummy.for b/decus/vmslt00a/bulletin/bull_newsdummy.for deleted file mode 100644 index 90c0f81..0000000 --- a/decus/vmslt00a/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,137 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END - - - - SUBROUTINE SMTP_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION SMTP_CONNECT - - SMTP_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION SMTP_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION SMTP_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_READ_PACKET = 0 - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bullcom.cld b/decus/vmslt00a/bulletin/bullcom.cld deleted file mode 100644 index 7c2bf51..0000000 --- a/decus/vmslt00a/bulletin/bullcom.cld +++ /dev/null @@ -1,771 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 11/9/99 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER COPY, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FORCE - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER DELETE - QUALIFIER UNDELETE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER LOCAL - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER NOW - QUALIFIER OUTPUT,VALUE(REQUIRED,TYPE=$FILE) - QUALIFIER POST, DEFAULT - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW DELETE AND UNDELETE - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB THREAD - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE, NONNEGATABLE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER FORCE - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER THREADS - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - KEYWORD GATEWAY - KEYWORD NOGATEWAY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD THREAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vmslt00a/bulletin/bullcoms1.hlp b/decus/vmslt00a/bulletin/bullcoms1.hlp deleted file mode 100644 index c82f17a..0000000 --- a/decus/vmslt00a/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1276 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is -specified. A node which does not have BULLCP running cannot have a -message broadcasted to it, (even though it is able to create a remote -folder). A broadcasted message is limited to 1600 characters - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with -> at the beginning of each line. This can be -suppressed or the indentation character changed with /[NO]INDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message will -be deleted after the node on which the message was submitted from is -rebooted. If you wish the message to be deleted after a different node -reboots, you have the option of specifying that node name. The message -deletion is keyed by BULLETIN running on the node that reboots. It -writes into the database info that the node has rebooted, and when -BULLCP wakes up and sees this info, it will delete any shutdown messages -for that node. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current process -to another process in your job. - -The ATTACH command allows you to move quickly between processes that you -have created with the SPAWN command. For example, while you are editing -a file, you can SPAWN a subprocess to read a new message. Enter the -ATTACH command to get back to back to the editing session. If you want -to read another new message, you can use the ATTACH command to get back -to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers -so that either the message text, expiration date, or the header are to -be changed. If no qualifier is added, the default is that all these -parameters are to be changed. If the text of the message is to be -changed, a file can be specified which contains the text. If the editor -is used for changing the text, the old message text will be extracted. -This can be suppressed by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /OWNER - /OWNER=string - -Specifies a new owner name. Can only be changed if you own the folder -or have privileges. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. A -range of messages can be specified, i.e. /NUMBER=1-5. Only the -expiration date and message headers can be changed if a range is -specified. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be copied -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list via -the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to be mailed to the email address. This is common if you have -users that don't have access to BULLETIN. Note: When you specify an -email address, the folder automatically will have the ADD_ONLY flag set, -which causes both ADD and POST to both add a message and send mail the -message. Note that a message added to the folder via the BBOARD feature -will also be mailed to the specified email address. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. If you create a remote folder pointing to a folder -associated with an email address, you must specify the email address in -the description of the remote folder also. Please also read about the -SET GATEWAY command. - -It is also possible to use the description to specify a news group from -which messages are fed into the folder. See the file FOLDER_TO_NEWS.TXT -for more info. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. The -identifier can not be any longer than 12 characters. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The specified node is checked to see if -a folder of the same name is located on that node. If so, the folder -will then be modified to point to that folder. For example if there was -a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be -shared between more than one node. This capability is only present if -the BULLCP process is running on the remote node via the BULL/STARTUP -command. If the remote folder name is different from the local folder -name, the remote folder name is specified using the /REMOTENAME -qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data -Base. If the RDB does not exist on your system, a privileged user will -have to create it. If a user is not in the RDB, this program will -automatically enter the user into it (unless this feature was disabled -during the compilation of this program). NOTE: See HELP SET ACCESS for -more info. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW -for more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -either /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The -BULLETIN utility must be installed properly on the other nodes. You can -specify a different username to use at the other nodes by either using -the USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. The -specified subject need not be the exact subject of the message. It can -be a substring of the subject. This is in case you have forgotten the -exact subject that was specified. Case is not critical either. You -will be notified if the deletion was successful. See also /NEGATED. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting -messages on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message. -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /CONTINUE -Used with /GROUP. Allows you to continue a search after you have broken -the search by entering a command, i.e. READ, SEARCH, etc. Note: If you -enter a SEARCH command which specifies a string, and then continue the -directory search using /CONTINUE, the new search pattern will be used -when continuing the search. -2 /DELETE -Deletes all the messages which are displayed. Immediate deletes are not -available in this mode. Paging is turned off while deleting occurs. -2 /UNDELETE -Undeletes all the messages which are displayed. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of -folder. -2 /EXPIRATION -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the DIRECTORY -command are to be written into the specified file. All qualifiers which -are valid for the EXTRACT command are valid in conjunction with /EXTRACT -except for /NEW which conflicts with the DIRECTORY /NEW qualifier. The -listof messages to be printed will be displayed on the terminal (in -nopaging format). - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /FEEDBACK -Used only in conjunction with /GROUP. Specifies to show when new news -groups are selected. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS. -2 /FROM - /FROM=[string] - -Specifies that only messages whose username contains the specified string -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Used with the search -qualifiers /SEARCH, /SUBJECT, or /FROM. Wildcards are permitted in the -specified string. Use /FEEDBACK to see when groups are selected. At -any time during the search you may enter other commands, i.e. you may -read a message, see a full directory listing, etc. You may then restart -the search listing by typing DIR/CONTINUE. For more info, see help on -the /CONTINUOUS qualifier. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don't -match the specified search command are displayed. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWS -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /OUTPUT - /OUTPUT=filename - -Specifies to write the directory output to a file rather than the -terminal. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED. -2 /SEARCH - /SEARCH=[string] - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDE -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings. - - Format: - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. /FROM is the default. - -Note: EXCLUDEs based on FROM will take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE. -2 /FROM -Specifies to exclude the message based on the message owner. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. When /FULL is specified, the EXCLUDE command will -not add an exclude, so it can't be used with any other qualifier except -for /DISABLE. -2 /LIMIT - /LIMIT=days - -Specifies that the exclude will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROM -and /SUBJECT cannot be specified at the same time. -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. If the file exists, the -message is appended to the file, unless the /NEW qualifier is specified. - - Format: - FILE [filename] [message_number][-message_number1],[...] - -If the filename is omitted, a file will be created based on the name of -the folder. - -A range of messages to be copied can optionally be specified, i.e. FILE -2-5. The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /ALL -Copies all the messages in the current folder. -2 /FF -Specifies that a form feed is placed between messages in the file. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 FIRST -Specifies that the first message in the folder is to be read. -1 Folders -All messages are divided into separate folders. New folders can be -created by any user. As an example, the following creates a folder for -GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that user -will be alerted of topics of new messages at login time, and will then -be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If instead you -specify /SEMIPRIVATE, all users can read the messages in the folder, but -only those given access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote -DECNET node. Messages added to a remote node are actually stored on the -folder on the remote node. The BULLCP process (created by -BULLETIN/STARTUP) must be running on the remote node for this option to -be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another use -is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, -and giving access to that UIC group. Only users in that UIC group will -see the messages in that folder when they log in. -1 FORWARD -Synonym for MAIL command. -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INCLUDE -This command is a synonym for the THREAD command. -1 INDEX -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after one -has read a message. /RESTART must be specified to start from the first -folder if a scan is in progress. All other qualifiers are ignored while -a scan is in progress. - - Format: - INDEX - -When a directory is displayed, you can read the first message in the -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for older -versions of BULLETIN. -2 /MARKED -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED, -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. -2 /NEW - /[NO]NEW - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message. -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -2 /SET - /[NO]SET - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -2 Suggestions -Here are keypads settings that the author personally uses. Note that -the IND/SUBS commands are useful only for reading NEWS. - -DEFINE/KEY PERIOD "IND/SUBS"/TERM -DEFINE/KEY PERIOD "IND/SUBS/NONEW"/IF_STATE=GOLD/TERM -DEFINE/KEY MINUS "READ/THREAD"/IF_STATE=GOLD/TERM -DEFINE/KEY PF1 ""/IF_STATE=GOLD/SET=NOEDIT -DEFINE/KEY PF1 ""/IF_STATE=NOEDIT/SET=NOH -DEFINE/KEY PF3 "EXT"/TERM -DEFINE/KEY KP9 "MAIL/EDIT/NOHEAD"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP8 "REPLY/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP7 "SEND/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/H"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/NOH"/IF_STATE=NOH/TERM -DEFINE/KEY KP5 "RESPOND/NOEDIT "/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP5 "RESPOND/EXTRACT/LIST/EDIT "/TERM -DEFINE/KEY KP2 "SEARCH/REP "/TERM -DEFINE/KEY KP2 "SEARCH/REV/REP "/TERM/IF_STATE=GOLD -DEFINE/KEY KP2 "SEARCH/REV "/IF_STATE=NOEDIT -DEFINE/KEY COMMA "SPAWN"/TERM -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying an -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" must -be specified as xxx%"""address""". -2 /EDIT -Specifies that the editor is to be used to edit the message before -mailing it. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers] - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 MODIFY -Modifies the database information for the current folder. Only the -owner of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to automatically mailed to the email address. This is common if -you have users that don't have access to BULLETIN. In order to do this, -you should use the SET ADD_ONLY command. This causes all messages added -to the folder to also be sent to the email address. This also applies -to messages which are added via the BBOARD feature. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. Please also read about the SET GATEWAY command. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can -be specified following the folder name, i.e. COPY NEWFOLDER 2-5. -However, if the old folder is remote, they will be copied but not -deleted, as only one message can be delted from a remote folder at a -time. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be moved -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEWS -Displays the list of available news groups. - -Format: - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed. - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL will -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /DEFAULT -If specified, will show news groups that have be defined as default -groups using the SET SUBSCRIBE command. -2 /NEWGROUP -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /PERMANENT -If specified, will show news groups that have be defined as permanent -groups using the SET SUBSCRIBE command. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B. -2 /STORED -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 New_features -Here is a list of new features which may be of interest to the general -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - -------------------------------------------------------------------------- -V 2.24 -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -SHOW EXCLUDE and INCLUDE commands added. 5/16/95 - -V 2.21 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -Added /FOLLOWUP to POST command when used with news groups. It specifies -which news group you want replies to your message to be sent to. 10/28/94 - -V 2.20 - -Logical names can be specified in POST/GROUPS=. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/11/94 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group by -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92 - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 Personal_name -Any messages posted to news groups or sent as mail automatically will -include the personal name which is set in the VMS mail utility. If you -don't want this to happen, you can define the logical name -BULL_PERSONAL_NAME to be the personal name you want BULLETIN to use: - -$ DEFINE BULL_PERSONAL_NAME "John Doe" -$ BULLETIN - -If you don't want any personal name, define it to be " ". diff --git a/decus/vmslt00a/bulletin/bullcoms2.hlp b/decus/vmslt00a/bulletin/bullcoms2.hlp deleted file mode 100644 index 8971375..0000000 --- a/decus/vmslt00a/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1463 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with -> at the -beginning of each line. This can be suppressed or the indentation -character changed with /[NO]INDENT. -2 /FOLLOWUP - /FOLLOWUP=string - -Specifies that any replies generated by people reading the message -should be sent to the specified newsgroup. This is useful if you want -to post to more than one group, but don't want reply messages posted on -all the groups. To specify more than one newsgroup, surround the list -with quotes, i.e. FOLLOWUP="newsgroup1,newsgroup2". If replies should -only be sent to the message owner and not a newsgroup, the string -"poster" should be specified. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message -to the specified NEWS group(s) in addition to the selected NEWS group. -Logical names are allowed. -2 /HEADER -Allows customized headers line to be added to the message header. When -specified, header lines can be added by inserting them at the top of the -message, with the header lines and the text of the message separated by -a blank line. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. -In order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply -surround the exclusive text starting with the line "START " -and ending with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The file created by the PRINT command is not -released to the print queue until you exit, unless you add the qualifier -/NOW or change one of the print job's qualifiers. Multiple messages are -concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /CANCEL -Cancels any messages waiting to be printed. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL level -to find out the name of the mounted form and the default form for a -particular queue. If you specify a form whose stock is different from -the stock of the form mounted on the queue, your job is placed in a -pending state until the stock of the mounted form of the queue is set -equal to the stock of the form associated with the job. (In order to -have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the file -or files have been printed. If /NONOTIFY is specified, there is no -notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 QUIT -Exits the BULLETIN program. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. If you -specify a number greater than the number of messages in the folder, the -last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -/HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /THREADS -Reads all messages that have been included by the THREAD command. If -neither message number nor /SINCE is specified, the search starts with -the first new message. After the first READ/THREADS command, typing -READ/THREADS will continue the search from where it left off (as long as -you do not select a different folder or news group). Also, after a -message has been fully read, if the return key is hit without entering a -command, it is equivalent to typing the READ/THREADS command. Messages -which are parts of threads and under read will be displayed in the -directory listing by a preceeding #. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /INDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read -them. (Note: Reading the last message does the same thing, but RESET -does it without having to read it.) -2 /CURRENT -Resets the new message counter to the current message. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using the -qualifer /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected or /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text strings. - - Format: - - SEARCH [search-string[,...]] - -The search starts from the first message in the current folder. You can -specify the message to start at using the qualifier /START. If you use -this qualifier without a parameter, it starts with the current message. -The search includes both the text of the message, and the description -header. If a "search-string" is not specified, a search is made using -the previously specified string, starting with the message following the -one you are currently reading (or have just read). After fully reading -the message found by the search, if you hit the return key without -entering a command, it is equivlanent to typing SEARCH without a search -string and will search for the next message. Once started, a search can -be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FEEDBACK -Used only in conjunction with /FOLDER and /GROUP. Specifies to show -when new folders or news groups are selected. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for a -match. If, during a search, no more matches or messages are found, the -next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. Use /FEEDBACK to see when folders are -selected. News groups can be specified here. However, to search news -group with wild cards, use /GROUP. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Wildcards are permitted in -the specified string. If the string does not contain an * and does not -specify a news group, * is automatically placed at the beginning and end -of the string. I.e. if the string is "comp", then all news groups -containing the word "comp" will be searched. Use /FEEDBACK to see when -groups are selected. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /MATCH - /MATCH[=option] - -Interprets and matches multiple search strings in one of the following -ways: - - AND A match occurs only if all of the strings are found. - - OR A match occurs if any of the strings are found. - - XOR A match occurs if only one of the strings is found. - -If you specify none of these options, the default is /MATCH=OR. If you -specify the /NEGATED qualifier, you will get the negated operation. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If no -starting message is specified, the search is started from the last -message. /REVERSE must be specified with a search string. -2 /START - /START=message_number - -Specifies the message number to start the search at. If you omit the -message number, it starts with the current message. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. UICs can contain -wildcards, i.e. [130,*]. Note that by default, a process is given the -process rights id SYS$NODE_nodename, where nodename is the decnet -nodename. Thus, by specifing this id, a folder can be restricted to a -specific node, which is useful when the folder is shared among nodes in -a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUS -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name. - - Format: - - SET [NO]ANONYMOUS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. - - Format: - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If -ADD_ONLY is set and a mailing address is present (see /DESCRIPTION), -when a message is added to the folder, it will also be mailed to the -address (in addition to being stored in the folder). This also applies -to a message which is added via the BBOARD feature . If ADD_ONLY is set -and a user uses the POST command, the ADD command will be used instead. -One use for this is to mail messages in a folder to users who do not -have access to BULLETIN. - - Format: - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages. - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30" -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The form -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY. -The time will always be 00:00, even if the time is specified on the line. -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be: - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account. - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV. -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION. -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by the -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier. -2 COMPRESS -Specifies that messages added to the folder will be in compressed format. -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires -very little cpu overhead. - - Format: - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed every -time when logging in, until the new messages are read. Normally, the -BRIEF setting causes notification only at the first time that new messages -are detected. - - Format: - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - - Format: - - SET DEFAULT_EXPIRE days - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages. - - Format: - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it. -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format: - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) -2 EXCLUDE -Specifies to ignore any EXCLUDEs or THREADs that are present. - - Format: - - SET [NO]EXCLUDE - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or THREADs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 EXLIMIT -Specifies the default limit for the EXCLUDE command. - - Format: - - SET EXLIMIT days - -If no match is found for an exclude after the specified number of days, -the exclude will automatically be deleted. The default is no limit, -which is specified by specifying 0 days. This default can be overriden -by the /LIMIT switch on the EXCLUDE command. -2 FILE_DIRECTORY -Select the directory where messages are written to when using the -EXTRACT or file COMMAND. By default, the message is written into the -current directory. - - Format: - - SET FILE_DIRECTORY [directory] - -If directory is omitted, the setting is removed. Note: This information -is stored in the customization file (SYS$LOGIN:BULL.CUSTOM). -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new messages will be displayed for upon -logging in. -2 GATEWAY -Valid for folders that are associated with an email address. Messages -which are mailed to the email address are by default modified so that -the subject line starts with the folder name, followed by the phrase -"folder message: ", followed original subject line. If you specify -GATEWAY, the subject line is not modified this way. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to by -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. -2 LIBRARY -Specifies a library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command to see if there are other libraries. -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NAME -Copies all stored settings from one user to another. Used when a user's -account name is changed. - - Format: - - SET NAME old-username new-username -2 NEWS -Changes attributes of the specified news group or class of news groups. -This command requires privileges. - - Format: - - SET NEWS [news-group] - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALL - /NOALL - -If specified with /CLASS or /DEFAULT, all groups that are presently -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of any -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the default -attributes (using /DEFAULT) with /NOALL, the attributes for misc.test -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. -3 /CLASS - /CLASS=classname - -Specifies to modify attributes for a class of news groups rather than a -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes of -existing groups which are in the class are modified, and any groups -created in the future will automatically have those attributes. -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETE -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLE -Specifies that the news group is enabled and can be accessed. This is -the default. -3 /EXPIRATION - /EXPIRATION=days - -Specifies the default expiration time for messages if none is specified. -The default is 7. -3 /FULL -Control whether all information of the news groups is displayed, i.e. -the access list if the news group is private. This information is only -those who have access to that folder. -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified is --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default. -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is posted -every month with an expiration date of one month in the future. -3 /PRIVATE - /PRIVATE - /NOPRIVATE - -Specifies that the news group or class can have it's access modified by -the SET ACCESS command. To accomplish this, a file is created in -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access -to news groups in that class is to set /NOPRIVATE, as then time won't be -wasted checking a file for ACLs. -3 /STORED - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessed -via the network from the server node. This results in faster access, -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED. -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder. - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node, -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are logged -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 POST_ONLY -Specifies that the selected folder has the POST_ONLY attribute. This -causes the ADD command to mail the message to the mailing address if it -is present (see /DESCRIPTION), rather than add to the folder. - - Format: - - SET [NO]POST_ONLY -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format: - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers. -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed. -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that READNEW is a permanent flag and cannot be changed by the -individual. This is a privileged qualifier. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all -users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged -qualifier. -2 STRIP -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If STRIP -is set, the header of the mail message will be stripped off before it is -stored as a BULLETIN message. - - Format: - - SET [NO]STRIP - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SUBSCRIBE -Can be used to force users to be subscribed to the selected news group. -This is a privileged command. - - Format: - - SET SUBSCRIBE - -Note: If you execute the commands SET SHOWNEW, READNEW, BRIEF, or -NOTIFY, and add /DEFAULT or /PERMAMENT, it is equivalent to doing a SET -SUBSCRIBE command with the addition that the specified feature will be -the default and/or permanent setting. -3 /ALL -Specifies that all present and future users will be subscribed to the -news group. -3 /DEFAULT - /[NO]DEFAULT - -Specifies that new users will automatically be subscribed to the news -group. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that new users will automatically be subscribed to the news -group and that users cannot unsubscribe the news group. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 EXCLUDE -Displays the list of excludes which are present for the current folder. -The right hand side of the display shows the date of the last time a -match for the exclude was found, and also the number of days from the -time of the last match after which the excludes expires. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected -via the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 THREAD -Displays the list of includes which are present for the current folder. -2 KEYPAD -Displays the keypad command definitions. - - Format: - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either SET KEYPAD, or if /KEYPAD is -specified on the command line, the keypad keys will be defined as -commands. The default settings for the keypad are shown via SHOW KEYPAD -or HELP KEYPAD. Settings can be changed by using an initialization file -with DEFINE/KEY commands. BULLETIN looks first for the file pointed to -by the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -3 /STATE - /STATE=(state,state,...) - -Specifies the name of a state for which the specified key definitions -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when a -key name has been specified. -2 LIBRARY -Shows the library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the /ALL -qualifier to see if there are other libraries. -3 /ALL -Specifies to show all available libraries. -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGIN - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDER - /FOLDER=[foldername] - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups. -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSION -Shows the version of BULLETIN and the date that the executable was -linked. -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of the -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. -1 THREAD -Specifies that the current message is defined as a thread based on -either the subject or the message owner. Since threads are much more -commonly based on the subject, this is the default. Threads are read by -using the command READ/THREADS. - - Format: - THREAD [string] - -If a string is specified, then the message is a thread if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one THREAD may be -specified per folder. - -Note: EXCLUDEs based on FROM will take precedence over THREADs. -2 /ALL -Used with /DISABLE to specify to disable all THREADs. -2 /DISABLE -Specifies to permanently disable the THREAD. -2 /FROM -Specifies to include the message based on the message owner. /FROM -and /SUBJECT cannot be specified at the same time. -2 /LIMIT - /LIMIT=days - -Specifies that the thread will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to include the message based on the message subject. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 Storing_Threads -THREADs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] -1 UNSUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See the -SUBSCRIBE command for further info. -1 Usenet_news -BULLETIN can also read USENET NEWS if your system has network access to -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group -in order to keep track of which messages you have read in that group. -Most of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read all your subscribed news groups that have new -messages, use INDEX/SUBSCRIBE. diff --git a/decus/vmslt00a/bulletin/bulldir.inc b/decus/vmslt00a/bulletin/bulldir.inc deleted file mode 100644 index ab5027c..0000000 --- a/decus/vmslt00a/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vmslt00a/bulletin/bulletin.cld b/decus/vmslt00a/bulletin/bulletin.cld deleted file mode 100644 index 95c9f31..0000000 --- a/decus/vmslt00a/bulletin/bulletin.cld +++ /dev/null @@ -1,44 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vmslt00a/bulletin/bulletin.for b/decus/vmslt00a/bulletin/bulletin.for deleted file mode 100644 index 8b9ef63..0000000 --- a/decus/vmslt00a/bulletin/bulletin.for +++ /dev/null @@ -1,2129 +0,0 @@ -C -C BULLETIN.FOR, Version 2/27/98 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - DATA NEXT_COMMAND/' '/ - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - CALL INIT_BULLETIN(.TRUE.) - -C -C The MAIN loop for processing bulletin commands. -C - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IF (IER.GT.0) THEN - IF (INDEX(INCMD(:IER),' ').EQ.0.AND. - & INDEX(INCMD,'/').EQ.0.AND. - & INDEX(INCMD,'.').GT.0) INCMD = 'SELECT '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE IF (READ_COUNT.NE.0) THEN - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - ELSE IF (NEXT_COMMAND.NE.' ') THEN - INCMD = NEXT_COMMAND - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL DO_COMMAND(INCMD) - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - CALL DO_COMMAND(INCMD) - -100 CONTINUE - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) - - END - - - - - SUBROUTINE DO_COMMAND(INCMD) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - CHARACTER*(*) INCMD - - NEXT_COMMAND = ' ' - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (HLEN.EQ.0) THEN - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - END IF - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL'.OR. - & INCMD(:4).EQ.'POST'.OR. - & INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - WRITE (6,'('' ERROR: /FOLDER not valid when posting'', - & '' a message to a news group.'')') - ELSE - INCMD = 'POST '//INCMD(4:) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - END IF - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,'('' ERROR: There are no more preceding messages.'')') - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').AND.CLI$PRESENT('NEWS')) THEN - WRITE (6,'('' ERROR: /NEWS and /FOLDER cannot be '' - & ''specified at the same time.'')') - ELSE IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.,.FALSE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR - ELSE IF (INCMD(:4).EQ.'INCL'.OR. ! INCLUDE? - & INCMD(:4).EQ.'THRE') THEN ! THREAD? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IF (CLI$PRESENT('THREADS')) NEXT_COMMAND = 'READ/THREADS' - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - NEXT_COMMAND = 'SEARCH' - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'FI') THEN ! SET FILE_DIRECTORY? - CALL SET_CUSTOM('file_directory') - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SH') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SU') THEN ! SET SUBSCRIBE? - IF (REMOTE_SET.GE.3) THEN - D1 = 0 - D2 = 0 - D3 = 0 - CALL SET_FOLDER_DEFAULT(D1,D2,D3) - ELSE - WRITE (6,'('' ERROR: Command invalid for folder.'')') - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'GEN') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOGEN') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LIB') THEN ! SET LIBRARY? - CALL SET_LIBRARY - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS? - CALL SET_NEWS - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE? - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE? - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:3).EQ.'EXL') THEN ! SET EXLIMIT? - CALL SET_CUSTOM('exclude_limit') - ELSE IF (BULL_PARAMETER(:4).EQ.'NAME') THEN ! SET NAME? - CALL SET_NEWNAME - ELSE IF (BULL_PARAMETER(:3).EQ.'GAT') THEN ! SET GATEWAY? - CALL SET_FOLDER_FLAG(.TRUE.,15,'GATEWAY') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOGAT') THEN ! SET NOGATEWAY? - CALL SET_FOLDER_FLAG(.FALSE.,15,'GATEWAY') - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'EX') THEN ! SHOW EXCLUDE? - CALL SHOW_EXCLUDE(0) - ELSE IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:2).EQ.'IN'.OR. - & BULL_PARAMETER(:2).EQ.'TH') THEN ! SHOW INCLUDE? - CALL SHOW_EXCLUDE(1) - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SHOW LIBRARY - CALL SHOW_LIBRARY - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATION - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1) - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN? - CALL TAG(.FALSE.,2) - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - - RETURN - END - - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER INEXDATE*12,INEXTIME*12,INDENT*4 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,BULLETIN_SUBCOMMANDS - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT') - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - LENI = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',INDENT,LENI) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LENI.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') INDENT(:LENI)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2100' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2100' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60) - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60) - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - IF (CLI$PRESENT('EXTRACT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35 - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - BLENGTH = BLENGTH + ILEN - 1 + 2 - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE. - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting by '', - & I6,'' characters. Limit is '',I3,''.'')') - & BLENGTH - 82*12 - 2, 82*12 - 2 - CALL GET_INPUT_PROMPT(INPUT,ILEN, - & 'Type C to broadcast anyway, A to only ADD message,' - & //' or Q to Quit: ') - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN - BRDCST = .TRUE. - ELSE IF (.NOT.STREQ(INPUT(:1),'C')) THEN - GO TO 910 - END IF - END IF - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! Username - END IF - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THEN - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '// - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK) - END IF - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletin - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IF - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF (FOLDER_NUMBER.GE.0) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL ADD_TAG(IER1,2) - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF -C -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP, -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same cluster -C as that of the BULLCP node. -C - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET) - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - ELSE IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR. - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - IF (BTEST(FOLDER_FLAG,10).OR.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & INDESCRIP(:LENDES),STATUS) - ELSE - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LENDES),STATUS) - END IF - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & ERR=910,FORM='FORMATTED') - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IF - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INLINE,ILEN).NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INLINE,ILEN) - IF (LENFRO.EQ.0) THEN - INPUT = INLINE(:ILEN)//',' - ELSE - INPUT = INPUT(:LENFRO)//INLINE(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - - IF (LENFRO.GT.1) THEN - LENFRO = LENFRO - 1 - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INPUT(I:I).EQ.'"') THEN - INPUT = INPUT(:I)//'"'//INPUT(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & INDESCRIP(:LENDES),STATUS) - END IF - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:INDEX(FOLDER_DESCRIP,'>')-1) - CALL NEWS_POST(BULL_PARAMETER(:LEN_P),.FALSE.,IER, - & INDESCRIP) - END IF - -200 IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GO TO 200 - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GO TO 200 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 200 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 200 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 200 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds ',I,' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*4 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP)) - - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG) - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC' - - DATA READ_UAI/.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE. - RETURN - END IF - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE. - END IF - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURN - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')') - RETURN - END IF - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN) - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN() - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - RETURN - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - SUBROUTINE INIT_BULLETIN(NOX) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - DATA PAGE_LENGTH/24/,PAGE_WIDTH/80/ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (NOX) CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER(:LEN_P) - CALL CHECK_DIR(BULL_PARAMETER,.FALSE.) - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - END IF - CALL LIB$REVERT - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE IF (COMMAND_PROMPT(I:I).EQ.'/') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL(.FALSE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS1') THEN - CALL NEWS2BULL(.TRUE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'SMTP') THEN - CALL SEND_MAIL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - IF (NOX) CALL CRELNM('SYS$INPUT','TT') ! Input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - IF (NOX) CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - - CALL OPEN_OLD_TAG - - IF (.NOT.NOX) THEN - CALL NEW_MESSAGE_NOTIFICATION - RETURN - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IF - END IF - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bulletin.hlp b/decus/vmslt00a/bulletin/bulletin.hlp deleted file mode 100644 index 8479322..0000000 --- a/decus/vmslt00a/bulletin/bulletin.hlp +++ /dev/null @@ -1,151 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vmslt00a/bulletin/bulletin.lnk b/decus/vmslt00a/bulletin/bulletin.lnk deleted file mode 100644 index f0fed2c..0000000 --- a/decus/vmslt00a/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.3" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.5" diff --git a/decus/vmslt00a/bulletin/bulletin0.for b/decus/vmslt00a/bulletin/bulletin0.for deleted file mode 100644 index 39a50c4..0000000 --- a/decus/vmslt00a/bulletin/bulletin0.for +++ /dev/null @@ -1,2575 +0,0 @@ -C -C BULLETIN0.FOR, Version 11/9/99 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - IMMEDIATE = 0 - IF (INCMD(:3).EQ.'DIR') THEN - FORCE = .TRUE. - ELSE - FORCE = CLI$PRESENT('FORCE') - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IF (INCMD(:3).EQ.'DIR') THEN - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - ELSE - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET.EQ.1) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IER1 = SBULL + 1 - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER1) - SUBJECT = DESCRIP - IER2 = 0 - IF (IER2.EQ.0.AND.IER1.EQ.SBULL+1) CALL - & REMOTE_DELETE(SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - ELSE IF (REMOTE_SET.EQ.3) THEN - BULL_DELETE = SBULL - 1 - IER = 0 - IF (CLI$PRESENT('REASON')) THEN - CALL CLI$GET_VALUE('REASON',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) RETURN - IF (EBULL.EQ.SBULL) THEN - WRITE(6,1030) - RETURN - END IF - END IF - END DO - SUBJECT = DESCRIP - IF (.NOT.TEST_NEWS_OWNER().AND.SETPRV_PRIV().AND. - & .NOT.FORCE) THEN - SUBJECT = 'CanceL' - IF (CLI$PRESENT('REASON')) THEN - SUBJECT = SUBJECT(:6)//BULL_PARAMETER(:LEN_P) - END IF - END IF - CALL REMOTE_DELETE - & (SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - RETURN - END IF - END DO - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - SUBJECT = DESCRIP - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.NE.USERNAME - END IF - IF (ASK.AND..NOT.FORCE) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - IF (REMOTE_SET.EQ.4) THEN - SUBJECT = 'CanceL' - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.(TEST_NEWS_OWNER().OR. - & SETPRV_PRIV())) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2),EX(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:9).EQ.'19') EXDATE(8:9) = '18' - IF (EXDATE(8:9).EQ.'20') EXDATE(8:9) = '19' - IF (EXDATE(8:9).EQ.'18'.AND.EXDATE(10:10).LT.'6') - & EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX,EX) - IER = SYS$ASCTIM(,INPUT,EX,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - DATA EXCLUDE_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DIRMODE/ DIRMODE - DATA DIRMODE/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - CHARACTER GROUP*80,STAT*4 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - DIRMODE = .TRUE. - - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - FOUND = 0 - OUT = 6 - - CONT = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - CONT = CLI$PRESENT('CONTINUE') - ELSE IF (INCMD(:3).EQ.' '.AND.NFOLDER.LT.0) THEN - CONT = .TRUE. - END IF - IF (CONT) THEN - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - SUBJECT = SUBJECT1 - REPLY = REPLY1 - SEARCH = SEARCH1 - FROM_SEARCH = FROM_SEARCH1 - SINCE = SINCE1 - NEW = NEW1 - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - IF (.NOT.ANY_SEARCH) THEN - WRITE (6,'('' ERROR: No previous search to continue.'')') - RETURN - END IF - INCMD = ' ' - LEN_P = 0 - DIR_COUNT = DIR_COUNT1 - NFOLDER = NFOLDER1 - I = DIR_COUNT - IF (DIR_COUNT.EQ.-1) THEN - I = SBULL - 1 - END IF - GO TO 200 - END IF - NFOLDER = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('OUTPUT',BULL_PARAMETER,LEN_P)) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & DEFAULTFILE='.LIS', - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - WRITE(6,1000) BULL_PARAMETER(:LEN_P) - RETURN - END IF - OUT = 3 - INQUIRE (UNIT=3,NAME=BULL_PARAMETER) - WRITE (6,1040) BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - END IF - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - EXTRACTING = CLI$PRESENT('EXTRACT') - DELETING = CLI$PRESENT('DELETE') - UNDELETING = CLI$PRESENT('UNDELETE') - IF (DELETING.OR.UNDELETING) THEN - OLDPAGING = PAGING - PAGING = .FALSE. - END IF - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - NEGATED = CLI$PRESENT('NEGATED') - IF (SEARCH) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (SUBJECT) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (FROM_SEARCH) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (REPLY) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3 - NEGATED = .TRUE. - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - DELETING = .FALSE. - UNDELETING = .FALSE. - IF (INCMD(:3).EQ.'IND') THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - REPLY_FIRST = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - ELSE - NEW = .FALSE. - END IF - END IF - OUTPUT = EXTRACTING.OR.PRINTING - - START = .FALSE. - SINCE = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - NFOLDER1 = -1000 - SUBJECT1 = SUBJECT - REPLY1 = REPLY - SEARCH1 = SEARCH - FROM_SEARCH1 = FROM_SEARCH - I = SBULL - 1 - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - SINCE1 = SINCE - NEW1 = NEW - GOTO 200 - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - CALL INIT_QUEUE(EXCLUDE_D1,%DESCR(I)) - EXCLUDE_D = EXCLUDE_D1 - NEXCLUDE = 0 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - IF (NEW.AND.IER.EQ.0) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - IF (READ_TAG) CALL DECREMENT_MSG_KEY - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - I = I - 1 - END DO - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - IF (NUM.GT.0) I = I - 1 - END DO - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) THEN - J = J + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT.OR.OUT.EQ.3) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - EXCLUDE_D = EXCLUDE_D1 - SEXC = NBULL + 1 - LEXC = 0 - DO I=1,NEXCLUDE - CALL READ_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(J)) - IF (J.LT.SEXC) SEXC = J - IF (J.GT.LEXC) LEXC = J - END DO - I1 = SBULL - I = SBULL - DO WHILE (I.LE.EBULL) - EXCLUDE_D = EXCLUDE_D1 - J = 0 - IER = I1 - IF (I1.GE.SEXC.AND.I1.LE.LEXC) THEN - N = NEXCLUDE - DO WHILE (N.GT.0.AND.J.EQ.0) - CALL READ_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(J)) - N = N - 1 - IF (J.NE.I1.AND.J.NE.-I1) J = 0 - END DO - IF (J.LE.0) THEN - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(I1,IER) - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - IF (J.LT.0) SYSTEM = IBSET(SYSTEM,8) - END IF - ELSE - CALL READDIR(I1,IER) - END IF - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1 - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - I = I + 1 - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1 - END IF - I1 = I1 + 1 - END DO - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - EBULL = EBULL - SBULL + DIR_COUNT - SBULL = DIR_COUNT - I = SBULL - END IF - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY, - & TAG_TYPE) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVE - END IF - END IF - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - END IF - ELSE - NBULL = 0 - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN - DIR_TYPE = 'seen' - END IF - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - IF (INCMD(:3).EQ.'DIR'.AND.ANY_SEARCH) THEN - IF (.NOT.CLI$PRESENT('START').AND..NOT.CONT) THEN - WRITE (6,'('' No matches found starting search'', - & '' from message number '',I)') SBULL - DIR_COUNT = -1 - GO TO 9999 - END IF - END IF - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - IF (NFOLDER.EQ.0) CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT, - & DELETING,UNDELETING) - - TAG = (BULL_TAG.AND.(REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1)).OR. - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THEN - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN - START_SEARCH = BULL_POINT - END IF -200 CLOSED = .FALSE. - IF (ANY_SEARCH.OR.OUTPUT) THEN - NUM = 0 - IF (NFOLDER.NE.-1000) THEN - CLOSED = .TRUE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - CLOSED_FILES = .FALSE. - SEARCH_NUM = 1 - REVERSE = .FALSE. - END IF - DO WHILE (I.LE.EBULL.AND.FOUND.GT.-3) - IF (.NOT.ANY_SEARCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (NFOLDER.NE.-1000.AND.I.GE.SBULL) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SLEN,0, - & START_SEARCH,REVERSE,SUBJECT,REPLY_FIRST,.FALSE., - & .TRUE.,FROM_SEARCH,NEGATED,.FALSE.) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - IF (NFOLDER.LT.0.AND.(I.EQ.F_START.OR.I.EQ.DIR_COUNT)) THEN - IF (FEEDBACK) CALL LIB$ERASE_PAGE(1,1) - CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT, - & DELETING,UNDELETING) - DIR_COUNT = 0 - BULL_POINT = MSG_NUM - 1 - PRINT_HEADER = .TRUE. - END IF - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - TAG_TYPE = DUMMY - END IF - IF (NFOLDER.LT.0.AND..NOT.OUTPUT) THEN - NUM = NUM + 1 - IF (NUM.EQ.PAGE_LENGTH-6) I = EBULL + 1 - END IF - ELSE IF (NFOLDER.LT.0.AND.(OUTPUT.OR.I.LE.SBULL)) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSED = .FALSE. - END IF - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - CALL CLOSE_BULLFOLDER - IF (GFOUND) THEN - START_BULL = 0 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - IF (F1_START.GT.0.AND.F1_START.LE.F1_NBULL) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - START_SEARCH = F_START - 1 - IF (IER.AND.(NEW.OR.SINCE)) THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER1,DATETIME) - CALL CLOSE_BULLDIR - IF (IER1.NE.0) THEN - START_SEARCH = IER1 - 1 - ELSE - IER = 0 - END IF - END IF - END IF - IF (.NOT.IER.OR.F1_START.EQ.0.OR. - & F1_START.GT.F1_NBULL) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER, - & IER) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - GFOUND = .FALSE. - IF (FLAG.EQ.1) CALL CLOSE_BULLFOLDER - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - SBULL = F_START - I = SBULL - 1 - EBULL = F_NBULL - END IF - ELSE - NFOLDER = 0 - END IF - END DO - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - ELSE IF (NFOLDER.EQ.0) THEN - WRITE (6,'('' No messages found.'')') - END IF - IF (NFOLDER.EQ.0) I = EBULL + 1 - IF (NFOLDER.LT.-1000) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED = .TRUE. - END IF - NFOLDER1 = NFOLDER - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - I = EBULL + 1 - END IF - CALL CANCEL_CTRLC_AST - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.GE.SBULL.AND.I.LE.EBULL.AND.NFOLDER.NE.-1000) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN - OUTLINE = '>' - ELSE IF (BTEST(SYSTEM,8)) THEN - OUTLINE = '#' - ELSE - OUTLINE = ' ' - END IF - IF (BTEST(SYSTEM,29)) THEN - OUTLINE(2:) = '*' - ELSE - OUTLINE(2:) = ' ' - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3) - IF (EXDATE(8:12).LT.'1994'.AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin? - EXPIRES = 'Permanent' - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11) - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9) - ELSE - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11) - END IF - NOTHING = .FALSE. - IF (OUT.EQ.6) THEN - WRITE(OUT,'(1X,A)') OUTLINE - ELSE - WRITE(OUT,'(A)') OUTLINE - END IF - IF (OUTPUT) THEN - FOUND_MSG = .TRUE. - CALL SYS$SETAST(%VAL(0)) - NEXT = .FALSE. - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES) - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES,PRINT_HEADER) - PRINT_HEADER = .FALSE. - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0 - ELSE - MSG_NUM = -MSG_NUM - END IF - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1)) - END IF - IF (DELETING) THEN - BULL_SAVE = BULL_POINT - BULL_POINT = MSG_NUM - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - CALL DELETE_MSG - IF (CLOSED) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - BULL_POINT = BULL_SAVE - ELSE IF (UNDELETING) THEN - BULL_SAVE = BULL_POINT - BULL_POINT = MSG_NUM - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - CALL UNDELETE - IF (CLOSED) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - BULL_POINT = BULL_SAVE - END IF - END IF - I = I + 1 - IF (ANY_SEARCH) IER = SYS$CANTIM(,) - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.OUTPUT) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IF - END IF - - IF (DIR_COUNT.GT.NBULL - & .OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THEN - ! Outputted all entries? - IF (PRINTING) THEN - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THEN - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IF - ELSE IF (EXTRACTING.AND.FOUND_MSG) THEN - CALL FILE(0,CLOSED_FILES,.FALSE.) - END IF - IF (NFOLDER.LT.0) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE - DIR_COUNT = -1 ! Yes. Set counter to -1. - END IF - ELSE IF (NFOLDER.NE.0.OR.(-NFOLDER1.EQ.FOLDER_NUMBER.AND. - & INCMD(:1).EQ.' ')) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE IF (FLAG.NE.1) THEN - WRITE(6,1010) ! Else say there are more - END IF - -9999 POSTTIME = .FALSE. - NEXT = .FALSE. - DIRMODE = .FALSE. - IF (NFOLDER.NE.0.OR.-NFOLDER1.EQ.FOLDER_NUMBER) THEN - DIR_COUNT1 = DIR_COUNT - IF (DIR_COUNT1.GT.NBULL) DIR_COUNT1 = -1 - END IF - IF (OUT.EQ.3) CLOSE (UNIT=3) - IF (DELETING.OR.UNDELETING) PAGING = OLDPAGING - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(1X,/,' Press RETURN for more...',/) -1020 FORMAT(1X,/,' Press RETURN for more, type SEARCH to read ', - & 'these messages.',/) -1040 FORMAT(' Output being written to ',A,'.') - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER) - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT,PRINT_HEADER) -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER*128 FILENAME - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THEN - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IF - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THEN - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IF - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - END IF - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = FILE_NUM - EBULL = SBULL - END IF - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F) - - IF (.NOT.IER) THEN - FILENAME = FOLDER - DO I=1,LEN(FILENAME) - IF (FILENAME(I:I).EQ.'.') FILENAME(I:I) = '_' - END DO - FILENAME = FILENAME(:TRIM(FILENAME))//'.TXT' - LEN_F = TRIM(FILENAME) - END IF - - IF (TRIM(FILE_DIRECTORY).GT.0.AND.INDEX(FILENAME,':').EQ.0 - & .AND.INDEX(FILENAME,'[').EQ.0) THEN - FILENAME = FILE_DIRECTORY(:TRIM(FILE_DIRECTORY))//FILENAME - LEN_F = TRIM(FILENAME) - END IF - - CALL STR$UPCASE(FILENAME,FILENAME) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE. - FIRST = .TRUE. - END IF - - IF (PRINT_HEADER) THEN - WRITE (3,'(/,''Newsgroup: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1 - IF (FBULL1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - OPENED = .FALSE. - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(FBULL,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DO - -100 IF (FILE_NUM.GT.0) THEN - FILE_NUM = -FILE_NUM - RETURN - END IF - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created. - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - END IF - - GO TO 10 - -900 WRITE(6,1000) FILENAME(:LEN_F) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message ',A,' written to ',A) -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A) -1050 FORMAT('Subj: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN) - - CALL LIB$MOVC3(8,IN,OUT) - - RETURN - END - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - FOLDER_NAME = FOLDER - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSE - RETURN ! Don't notify - END IF - END IF - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSE - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM) - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time - ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSER - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LOGIN_BTIM_NEW) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF - - CALL GET_NODE_NUMBER(NODE_NUMBER1,NODE_AREA1) - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100 - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IGNORE = BTEST(SYSTEM,2).AND.(NODE_AREA.EQ.NODE_AREA1).AND. - & (NODE_NUMBER.AND.NODE_NUMBER1) - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF ((USERNAME.NE.FROM.OR.SYSTEM).AND..NOT.IGNORE) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - ELSE - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - END IF - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - INREAD = '+' - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' ' - END IF - IF (LEFT) THEN - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN) - LEFT = .FALSE. - ILEN = 0 - INREAD = '+' - ELSE IF (ILEN.LE.WIDTH) THEN - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN) - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSE - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ') - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH) - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0) - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DO - IF (INPUT(ILEN:ILEN).EQ.' ') THEN - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEN - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE. - ELSE - WIDTH = PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE (6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - PAGE = PAGE + 1 - ELSE - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)// - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN) - & //' '//FOLDER_NAME(:FLEN)// - & ' to read these messages.' - END IF - PAGE = PAGE + 1 - END IF - -9999 IF (LOGIN_SWITCH) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION, - & OUT,DELETING,UNDELETING) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - CHARACTER*(*) OUTLINE - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULL - ELSE - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IF - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ') - OUTLINE(I:) = OUTLINE(I+1:) - END DO - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINE - BULL_PARAMETER = ' ' - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1)) THEN - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THEN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IF - IF (PRINTING) THEN - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - ELSE IF (DELETING) THEN - BULL_PARAMETER = 'DELETING '//BULL_PARAMETER - ELSE IF (UNDELETING) THEN - BULL_PARAMETER = 'UNDELETING '//BULL_PARAMETER - END IF - - IF (OUT.EQ.6) THEN - WRITE (OUT,'(''+'',A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - ELSE - WRITE (OUT,'(A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - END IF - -1000 FORMAT(A,1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(A,1X,'Description',43X,'From',8X,'Expires',/) - - RETURN - END - - - - SUBROUTINE GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER TODAY(2) - - CHARACTER DATETIME*24 - - IF (SINCE) THEN ! Was /SINCE specified? - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - IER = 0 - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - END IF - END IF - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bulletin1.for b/decus/vmslt00a/bulletin/bulletin1.for deleted file mode 100644 index 66b637b..0000000 --- a/decus/vmslt00a/bulletin/bulletin1.for +++ /dev/null @@ -1,2500 +0,0 @@ -C -C BULLETIN1.FOR, Version 4/8/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_S = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',SENDTO(LEN_S+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_S = LEN_S + I + 1 - SENDTO(LEN_S:LEN_S) = ',' - END DO - LEN_S = LEN_S - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_S) - IF (SENDTO(I:I).EQ.'"') THEN - SENDTO = SENDTO(:I)//'""'//SENDTO(I+1:) - I = I + 2 - LEN_S = LEN_S + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',SENDTO(:LEN_S) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//SENDTO(:LEN_S) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*32 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - INIT_NEWSFEED = .FALSE. - - NEWSGROUP = .FALSE. - MAILTO = 0 - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - RETURN - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - I = INDEX(FOLDER1_DESCRIP,'<') - J = INDEX(FOLDER1_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'@').LT.1 - & .OR.INDEX(FOLDER1_DESCRIP(I:),'@').GT.J-I+1).AND. - & (INDEX(FOLDER1_DESCRIP(I:),'.') - & .LE.J-I+1.AND.INDEX(FOLDER1_DESCRIP(I:),'.').GT.0)) THEN - NEWSGROUP = .TRUE. - WRITE (6,'('' Init news feed counter to feed '', - & ''all messages in news group (Y),'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'or set to feed only new messages (N,default) ? ') - INIT_NEWSFEED = RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y' - I = INDEX(FOLDER1_DESCRIP,'[') - J = INDEX(FOLDER1_DESCRIP,']') - END IF - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER1_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER1_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'.') - & .GT.J-I+1.OR.INDEX(FOLDER1_DESCRIP(I:),'.').EQ.0) - & .AND.MAILTO.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(RESPONSE) - IF (TRIM(RESPONSE).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//RESPONSE(:TRIM(RESPONSE))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - IF (NEWSGROUP) FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - IF (MAILTO.EQ.2) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (MAILTO.EQ.3) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (INIT_NEWSFEED) THEN - F_LAST = 0 - ELSE IF (NEWSGROUP) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - I = INDEX(FOLDER_DESCRIP,'<') + 1 - J = INDEX(FOLDER_DESCRIP,'>') - 1 - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER_DESCRIP(I:J),IER) - CALL CLOSE_BULLNEWS - CALL OPEN_BULLFOLDER - F_LAST = F1_NBULL - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /FEED/ FEED - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256,TODAY*24 - CHARACTER SCRFILE*18 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - IF (.NOT.BULLCP_NEWS.AND.FOLDER.EQ.FOLDER1) THEN - WRITE (6,'('' ERROR: Destination cannot be same as'', - & '' current location.'')') - RETURN - END IF - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER1 = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - NEWS2BULL = NEWS2BULL.AND..NOT.TO_NEWS.AND.ORIGINAL - IF (IER1.EQ.0.AND..NOT.NEWS2BULL) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THEN - I = IER - ELSE IF (.NOT.NEWS2BULL) THEN - NUM_COPY = NUM_COPY + 1 - END IF - NEWS2BULL = .FALSE. - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - FROM_BULL_POINT = BULL_POINT - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (REMOTE_SET.EQ.4.AND..NOT.BULLCP_NEWS).OR.REMOTE_SET.EQ.3 - - POST_FEED = .FALSE. - SLIST = 0 - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST:INDEX(FOLDER_DESCRIP,'>')-1) - POST_FEED = .TRUE. - END IF - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') + 1 - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - END IF - IF (SLIST.GT.1) THEN - IF (NEWS_FEED()) THEN - ELIST = INDEX(FOLDER_DESCRIP,']') - 1 - ELSE - ELIST = INDEX(FOLDER_DESCRIP,'>') - 1 - END IF - END IF - IF (CLI$PRESENT('LOCAL').AND..NOT.BULLCP_NEWS) SLIST = 0 - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS.OR.(POST_FEED.AND.SLIST.LE.1)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - END IF - IF (.NOT.POST_NEWS) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=FROM_BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF ((FROM_REMOTE.OR.FROM_REMOTE.EQ.4).AND. - & (TO_NEWS.AND.ORIGINAL)) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2100' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (SLIST.GT.1.OR.POST_NEWS.OR.POST_FEED) THEN - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - IF (SLIST.GT.1) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE='BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'BULL.SCR' - END IF - ENDIF - ILEN = LINE_LENGTH + 1 - - INFROM = FROM - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - IF (POST_NEWS.OR.POST_FEED) THEN - USE_INFROM = ORIGINAL - IF (CLI$PRESENT('LOCAL')) NEWS2BULL = .TRUE. - CALL NEWS_POST - & (SCRFILE(:TRIM(SCRFILE)),.TRUE.,IER,POST_SUBJECT) - NEWS2BULL = .FALSE. - END IF - IF (SLIST.GT.1) THEN - CLOSE (UNIT=3) - USE_INFROM = ORIGINAL - IF (BTEST(FOLDER_FLAG,10).OR.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - ELSE - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - END IF - CALL LIB$DELETE_FILE(SCRFILE(:TRIM(SCRFILE))//';') - ELSE IF (POST_FEED.OR.POST_NEWS) THEN - REWIND (UNIT=3) - END IF - BLOCK = BLOCK_SAVE - LENGTH = LENGTH_SAVE - END IF - IF (.NOT.POST_NEWS) THEN - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - IF (.NOT.ORIGINAL) SYSTEM = IBSET(SYSTEM,4) - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (SLIST.LT.1.AND.POST_NEWS.OR.POST_FEED) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - IF (TEST_BULLCP().NE.2) - & WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADER - IF (BULLCP_NEWS) RETURN - - IF (INDEX(INCMD,' ').EQ.TRIM(INCMD)+1) - & INCMD = INCMD(:TRIM(INCMD))//' '//FOLDER1 - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IF - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./ - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND. - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0 - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN) - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0) - IF (CHANGED) THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IF - - IF (INCMD(:4).EQ.'PRIN') THEN - IF (CLI$PRESENT('CANCEL')) THEN - WRITE (6,'('' Cancelling all previously queued messages.'')') - CLOSE (UNIT=24,DISPOSE='DELETE') - FIRST = .TRUE. - RETURN - END IF - END IF - -50 IF (PRINT_NUM.EQ.0) THEN - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = PRINT_NUM - EBULL = SBULL - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name - IF (QLEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - END IF - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100 - CLOSE (UNIT=24,DISPOSE='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - END IF - -1040 FORMAT(' Message ',A,' sent to printer.') -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE. - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) - END IF - - CALL DISABLE_PRIVS - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A, - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE. - GO TO 50 - END IF - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ_MSG -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /POST/ POSTTIME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /THREAD/ THREAD - DATA THREAD /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/,LAST_THREAD/.FALSE./ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH) - CHARACTER HEADLINE*132 - - LOGICAL SINCE,PAGE - - EXTERNAL CLI$_NEGATED - - FIRST = BULL_READ.LT.F_START - KILL = BTEST(BULL_USER_CUSTOM,3) - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3) - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE. - END IF - ROTC = CLI$PRESENT('ROTATE') - END IF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - THREAD = .FALSE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - THREAD = CLI$PRESENT('THREADS') - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSE - BULL_READ = 1 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE').AND. - & .NOT.THREAD) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW').OR.(THREAD.AND..NOT. - & CLI$PRESENT('SINCE').AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND.(.NOT.LAST_THREAD - & .OR.LAST_THREAD_NUMBER.NE.FOLDER_NUMBER) - & .AND.CLI$PRESENT('NEW').NE.%LOC(CLI$_NEGATED))) THEN - NEW = .TRUE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READDIR_KEYGE(IER) - IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_BTIM) - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - CALL CLOSE_BULLDIR - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - IER = 0 - END IF - END DO - CALL CLOSE_BULLDIR - ELSE - IER = 0 - SKIPPED_THREAD = .FALSE. - IF (THREAD) CALL OPEN_BULLDIR_SHARED - DO WHILE (IER.EQ.0) - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - BULL_READ = IER - END IF - IF ((SKIPPED_THREAD.OR.(THREAD.AND.IER.NE.0)).AND. - & BULL_READ.LE.F_NBULL) THEN - CALL READDIR(BULL_READ,IER) - IER = IER - 1 - IF (IER.NE.BULL_READ) IER = 0 - END IF - IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - MSG_NUM = IER - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,DUMMY,DUMMY) - IF (IER1.EQ.0) THEN - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(IER) - ELSE - BULL_READ = BULL_READ + 1 - END IF - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - WRITE (6,'('' No more messages are present.'')') - IF (SKIPPED_THREAD) CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - SKIPPED_THREAD = .TRUE. - BULL_READ = IER + 1 - IER = 0 - END IF - END DO - END IF - IF (THREAD) CALL CLOSE_BULLDIR - BULL_READ = IER - IER = IER + 1 - ELSE IF (THREAD) THEN - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999 - ELSE - BULL_READ = IER - 1 - IER = IER + 1 - END IF - SINCE = .TRUE. - ELSE IF (CLI$PRESENT('BULLETIN_NUMBER')) THEN - BULL_READ = BULL_READ - 1 - ELSE IF (LAST_THREAD_NUMBER.EQ.FOLDER_NUMBER) THEN - BULL_READ = LAST_THREAD_READ - ELSE - BULL_READ = BULL_POINT - 1 - END IF - CALL OPEN_BULLDIR_SHARED - IER = BULL_READ + 1 - IER1 = .FALSE. - DO WHILE (.NOT.IER1.AND.IER.EQ.BULL_READ+1.AND. - & BULL_READ.LT.F_NBULL) - BULL_READ = BULL_READ + 1 - CALL READDIR(BULL_READ,IER) - IER1 = BTEST(SYSTEM,8) - IF (IER1.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER2,DUMMY,DUMMY) - IER1 = IER2.NE.0 - END IF - END DO - IF (.NOT.IER1) THEN - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - END IF - END IF - - NEXT = .FALSE. - LAST_THREAD = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - LAST_THREAD = THREAD - IF (THREAD) THEN - LAST_THREAD_READ = BULL_READ - LAST_THREAD_NUMBER = FOLDER_NUMBER - ELSE - IF (.NOT.SINCE.AND..NOT.NEW - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF - END IF - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THEN - IER = 0 - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR. - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN - MSG_NUM = F_NBULL+1 - ELSE - MSG_NUM = BULL_NOW - END IF - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE - CALL GET_THIS_OR_NEXT_TAG - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0 - END IF - END IF - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END IF - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END DO - CALL CLOSE_BULLDIR - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READ - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSE - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0 - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IF - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE. - CALL READDIR(BULL_READ,IER) - END IF - END IF - IF (REMOTE_SET.LT.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - IF (IER.NE.BULL_READ+1) THEN - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0 - END IF - CALL CLOSE_BULLDIR - ELSE - IER = -1 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) ! If not, then error out - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - - SAVE_BULL_POINT = BULL_POINT - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(FIRST.OR.NEW.OR.NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEN - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - OK = OK.AND.(.NOT.THREAD.OR.BTEST(SYSTEM,8)) - - IF (.NOT.OK) THEN - BULL_POINT = SAVE_BULL_POINT - BULL_NOW = MSG_NUM - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN - BULL_READ = MSG_NUM - 1 - ELSE - BULL_READ = MSG_NUM + 1 - IF (INCMD(:4).EQ.'FIRS'.OR.FIRST) NEXT = .TRUE. - END IF - IF (REMOTE_SET) CALL CLOSE_BULLFIL - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - ELSE IF (.NOT.THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_NOW) - END IF - IF (BULL_READ.GT.F_NBULL.OR.BULL_READ.LT.F_START) THEN - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - GO TO 50 - END IF - BLOCK = BLOCK_SAVE - END IF - - NEXT = .FALSE. - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (.NOT.THREAD.OR.INCMD(:4).NE.'READ') THEN - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.BULL_READ) - & CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - END IF - END IF - - EDIT = .FALSE. - - PAGE_WIDTH = REAL_PAGE_WIDTH - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN - IF (CLI$PRESENT('EDIT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 9999 - END IF - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTH - PAGE = .FALSE. - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSE - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL - END IF - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:) - END DO - I = TRIM(HEADLINE) - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)) - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - ELSE - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ' - & .AND..NOT.BTEST(SYSTEM,4)) THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROM - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - IF (EDIT) WRITE(3,'(1X)') - ELSE - END = END + 1 - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IF - END IF - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) THEN - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter - GO TO 9999 - END IF - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - -9999 POSTTIME = .FALSE. - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - RETURN - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO - - RETURN - END - - - - - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1 - EQUIVALENCE (INREAD4,INREAD) - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - BULL_POINT_READ = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - - GO TO 12 - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - - BULL_POINT = BULL_POINT_SAVE - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN - ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL FILE(0,.TRUE.,.FALSE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THEN - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THEN - WRITE (6,'(''+B'',$)') - INCMD = 'RESPOND/LIST' - ELSE - GO TO 11 - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')') - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLY - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message', - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),', - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) -1040 FORMAT(' Type P to post reply, U to reply to user,', - & ' B to do both, or other to quit: ',$) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END - - - - - LOGICAL FUNCTION NEWS_FEED() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - I = SLIST + 1 - FLEN = TRIM(FOLDER_DESCRIP) - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN -C IF (INDEX(FOLDER_DESCRIP(SLIST:I),'.').GT.0) -C & NEWS_FEED = .TRUE. - NEWS_FEED = .TRUE. - RETURN - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND. - & FOLDER_DESCRIP(I:I).NE.'@'.AND. - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE - I = FLEN + 2 - END IF - END DO - END IF - - RETURN - END - - - - - LOGICAL FUNCTION MAIL_POST() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NEWS_FEED()) THEN - MAIL_POST = INDEX(FOLDER_DESCRIP,'[').GT.0 - ELSE - MAIL_POST = INDEX(FOLDER_DESCRIP,'<').GT.0 - END IF - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bulletin10.for b/decus/vmslt00a/bulletin/bulletin10.for deleted file mode 100644 index 8413962..0000000 --- a/decus/vmslt00a/bulletin/bulletin10.for +++ /dev/null @@ -1,4124 +0,0 @@ -C -C BULLETIN10.FOR, Version 2/27/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - COMMON /HEADER_SEEN/ HEADER_SEEN - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - LAST_LF_SEEN = LF_SEEN - LAST_REAL_LF_SEEN = REAL_LF_SEEN - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - CR_SEEN = INDEX(BUFFER(START_READ:END_READ),CR) - IF (CR_SEEN.GT.0) THEN - IF (END_LINE.GT.0) THEN - IF (CR_SEEN.EQ.END_LINE-2.AND.BUFFER(START_READ+CR_SEEN: - & START_READ+CR_SEEN).EQ.CR) CR_SEEN = CR_SEEN + 1 - ELSE - IF (START_READ+CR_SEEN.EQ.END_READ.AND. - & BUFFER(END_READ:END_READ).EQ.CR) CR_SEEN = 0 - END IF - END IF - IF ((END_LINE.EQ.0.AND.CR_SEEN+START_READ-1.LT.END_READ.AND. - & CR_SEEN.GT.0).OR.CR_SEEN.LT.END_LINE-1) THEN - END_LINE = CR_SEEN - CR_SEEN = 1 - ELSE - CR_SEEN = 0 - END IF - LF_SEEN = END_LINE.GT.0 - IF (END_LINE.GT.257-CR_SEEN.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - IF (.NOT.HEADER_SEEN) END_LINE = 254 - END IF - REAL_LF_SEEN = INDEX(BUFFER(START_READ:END_READ),LF).LE.END_LINE - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - IF (BUFFER(EB:EB).EQ.LF) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - IF (EB.GT.0.OR.LAST_LF_SEEN) RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE(:MIN(LEN(WRITE),256)) - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - NEWS_WRITE = NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - - LOGICAL FUNCTION NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - NEWS_RECONNECT = .FALSE. - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - NEWS_RECONNECT = .TRUE. - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /HEADER/ HEADER - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER().OR.SETPRV_PRIV()) THEN - IF (REMOTE_SET.EQ.4) THEN - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (INPUT(:11).EQ.'Message-ID:') THEN - MESSAGE_ID = INPUT(14:ILEN-1) - ILEN = 0 - END IF - END DO - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - CALL NEWS_POST('cancel',0,IER,SUBJ) - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - DO WHILE (BUFFER(SB:EB).NE.'.'.AND. - & .NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX( - & BUFFER(SB:EB),' ')+SB-2),J,,%VAL(1))) - IF (.NOT.NEWS_READ()) RETURN - END DO - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - STAT = .TRUE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(FROM,TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - HEADER_SEEN = .FALSE. - LF_SEEN = .FALSE. - LAST_LF_SEEN = .FALSE. - REAL_LF_SEEN = .FALSE. - LAST_REAL_LF_SEEN = .FALSE. - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8 - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONE - CHARACTER*4 ZONE - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/ - - CHARACTER*8 TIMES(1) - DATA TIMES /'-5:30'/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - IF (INDEX(ZONES,ZONE)/4.LT.4) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) - END IF - ELSE - HOUR = '00:00' - END IF - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_TI_L(TIME(:2),DATE,,%VAL(1)) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - SENDER_LINE = ' ' - NEWSGROUPS = ' ' - FOLLOWUP = ' ' - LREF = 0 - NEWS2BULL = .FALSE. - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.'.OR..NOT.LAST_REAL_LF_SEEN) - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126) - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(FROM,BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+6).EQ.'Sender:'.AND.EB.GE.SB+8) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+8:EB))+SB+7 - SENDER_LINE = ': '//BUFFER(SB1:EB) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+11).EQ.'Followup-To:'.AND. - & EB.GT.SB+12) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+13:EB))+SB+12 - FOLLOWUP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (INDEX(BUFFER(SB:), - & 'X-Newsreader: News2bull').EQ.1) THEN - NEWS2BULL = .TRUE. - IF (LPATH.EQ.0) CALL GET_PATHNAME - I = INDEX(BUFFER(SB:),'@') - IF (I.GT.0) THEN - SAMEHOST = STREQ(PATHNAME(2:LPATH),BUFFER(SB+I:EB)) - END IF - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN - IF (SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = SENDER_LINE(:TRIM(SENDER_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - ELSE - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - CALL GET_FROM(FROM,FROM_LINE(7:),TRIM(FROM_LINE)) - END IF - LAST_FROM = .TRUE. - ELSE - LAST_FROM = .FALSE. - END IF - IF (.NOT.LAST_FROM.AND.SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = 'From'//SENDER_LINE - END IF - END IF - END DO - - NEWS2BULL = NEWS2BULL.AND.SAMEHOST - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'1FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - START = -1 - CALL NEWNEWS(IN_BTIM,IER) - IF (IER.NE.0) START = IER -C -C The following code makes use of the NNTP command NEWNEWS, but is -C known to be slow and buggy in many servers. -C -C IER = SYS$ASCTIM(,TIME,IN_BTIM,) -C CALL DATE_TIME(TIME) -C SKIP = 0 -C DO WHILE (SKIP.GE.0) -C IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( -C & FOLDER_NAME))//' '//TIME)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C IF (BUFFER(:2).EQ.'23') THEN -C IF (.NOT.NEWS_READ()) CALL EXIT -C DO I=1,SKIP -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (FIRST.EQ.'.') RETURN -C DO WHILE (BUFFER(SB:EB).NE.'.') -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) -C & CALL EXIT -C IF (.NOT.NEWS_READ()) CALL EXIT -C IF (BUFFER(:2).EQ.'22') THEN -C IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN -C I = F_NBULL + 1 -C DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. -C & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) -C & .OR.I.GT.F_NBULL)) -C I = I - 1 -C IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN -C IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C END DO -C IF (I.GE.F_START) START = I -C ELSE -C IER = OTS$CVT_TI_L(BUFFER(SB+4: -C & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) -C END IF -C RETURN -C END IF -C END IF -C SKIP = SKIP + 1 -C END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2 - IER = IER1 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - CHARACTER*256 TEMP - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IF - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0 - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE - IER = NEWS_READ() - IF (IER.AND.(BUFFER(SB:EB).NE.'.' - & .OR..NOT.LAST_REAL_LF_SEEN)) THEN - IER = 0 - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THEN - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF ((INDEX(TEMP,': ').EQ.0.AND. - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255).OR. - & (LTEMP.EQ.254.AND..NOT.LAST_LF_SEEN)) THEN - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IF - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IF - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF - ELSE - HEADER_SEEN = .TRUE. - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128 - ELSE - ILEN = 128 - END IF - END IF - ELSE - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ABS(ILEN).EQ.128) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - HEADER_SEEN = .TRUE. - - RETURN - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /READIT/ READIT - - COMMON /NEWS_INIT/ END_READ - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - CHARACTER*64 ALT_SAVE - - DIMENSION DUMMY(4) - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - ALT_SET_SAVE = ALT_SET() - IF (ALT_SET_SAVE) CALL UNSET_ALT - END_READ = 0 - IER = 0 - IF (.NOT.NEWS_LOGIN()) THEN - IER = 2 - IF (.NOT.TEST_ALT(FOLDER1)) RETURN - IER = 1 - END IF - IF (IER.NE.1) CALL NEWS_GROUP(IER) - IF (IER.EQ.1) THEN - IF (TEST_ALT(FOLDER1)) THEN - IER1 = SET_ALT(ALT_FOUND) - IF (IER1) CALL NEWS_GROUP(IER) - IF (.NOT.IER1.OR.IER.NE.0) THEN - CALL UNSET_ALT - IF (ALT_SET_SAVE) CALL SET_ALT(ALT_SAVE) - RETURN - END IF - ALT_SAVE = FOLDER1(INDEX(':',FOLDER1)+1:) - IER = 0 - ELSE IF (ALT_SET_SAVE) THEN - CALL SET_ALT(ALT_SAVE) - IER = 1 - END IF - RETURN - END IF - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY) - IF (SYSLOG) THEN - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3)) - END IF - END IF - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUP - - CHARACTER*8 NUMBER - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURN - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1 - RETURN - ELSE IF (ICOUNT.EQ.-1) THEN - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THEN - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURN - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - START = ICOUNT - BULLETIN_NUM = START - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0 - CALL NEWS_HEADER(IER) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - BLOCK = START - MSG_NUM = START - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN - END - - - - SUBROUTINE NEWS_GROUP(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN - IER = 1 - RETURN - END IF - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)) - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT') - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURN - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME - - CHARACTER*28 TIME - - DIMENSION DIFF(2) - - I = 1 - LTIME = TRIM(INTIME) - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:)) - - DO J = 1,2 - I = 1 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-' - END DO - - IF (I.EQ.LEN(TIME)) RETURN - - IF (TIME(I+3:I+3).EQ.' ') THEN - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IF - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DO - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - IF (INDEX(TIME(:I-2),'.').GT.0) THEN - CALL SYS_BINTIM(TIME(:INDEX(TIME(:I-2),'.'))//'00',BTIM) - ELSE IF (TIME(I-4:I-4).EQ.':'.AND.TIME(I-7:I-7).EQ.':') THEN - CALL SYS_BINTIM(TIME(:I-2)//'.00',BTIM) - ELSE - CALL SYS_BINTIM(TIME(:I-2)//':00.00',BTIM) - END IF - - IF (TIME(I:I).EQ.'+'.OR.TIME(I:I).EQ.'-') THEN - IER = SYS_BINTIM('0 '//TIME(I+1:I+2)//':'//TIME(I+3:I+4),DIFF) - IF (IER) THEN - IF (TIME(I:I).EQ.'-') THEN - IER = LIB$SUBX(BTIM,DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,DIFF,BTIM) - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE NEWS_LIST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - COMMON /NEWSLIST/ NEWSLIST - - CHARACTER TODAY*24 - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR. - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER)) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - NEWS_FOLDER1_BBOARD = '::' - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14 - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNT - DAMAGED = .FALSE. - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - IF (INDEX(BUFFER(SB:),' ').EQ.0) DAMAGED = .TRUE. - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IF (INDEX(BUFFER(SP:),' ').EQ.0) DAMAGED = .TRUE. - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IF (INDEX(BUFFER(SP:),' ').EQ.0) DAMAGED = .TRUE. - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1 - IF (IER.EQ.0.AND.IER1.EQ.0) - & NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) ! Old bug caused this. - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF ((FLEN.LE.44.OR.FLEN-44+EB-SP+1.LT. - & LEN(NEWS_FOLDER1_DESCRIP)).AND.DAMAGED) THEN - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)// - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - END IF - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - END IF - ELSE - CALL UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - END IF - IF (DAMAGED) THEN - IER = NEWS_READ() - DAMAGED = .FALSE. - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - OPEN (UNIT=33,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',READONLY) - - DO WHILE (IER.EQ.0) - READ (33,'(A)',IOSTAT=IER) INPUT - IF (IER.EQ.0) THEN - FLEN = INDEX(INPUT,':')-1 - NEWS_FOLDER1 = INPUT(:FLEN) - IF (SET_ALT(INPUT(FLEN+2:))) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER1) - IF (IER1.NE.0) THEN - FOLDER1_DESCRIP = NEWS_FOLDER1 - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = INPUT(45:FLEN) - ELSE - NEWS_FOLDER1_DESCRIP = ' ' - END IF - END IF - CALL NEWS_GROUP(IER) - IF (IER.EQ.0) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - IF (IER1.NE.0) THEN - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - ELSE - CALL UPDATE_NEWS_ENTRY(.FALSE.,LOCAL_UPDATE,FLEN,0) - END IF - END IF - END IF - END IF - IF (IER.NE.0) CLOSE (UNIT=33) - IF (ALT_SET()) THEN - CALL UNSET_ALT - IF (.NOT.NEWS_LOGIN()) RETURN - END IF - END DO - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.1.AND.TEST_ALT(NEWS_FOLDER1// - & NEWS_FOLDER1_DESCRIP)) THEN - IER = 0 - ELSE IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.F1_START.AND. - & NEWS_F1_FIRST.GT.F1_NBULL) THEN - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE), - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (((F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND..NOT.BTEST(NEWS_F1_FLAG,8)) THEN - DELETE (UNIT=7) - IER = 0 - ELSE IF (IER.EQ.1) THEN - IF (NEWS_F1_NBULL.LT.NEWS_F1_START - & .OR.NEWS_F1_START.EQ.0) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(NEWS_F1_START,IER1) - CALL CLOSE_BULLDIR - IER1 = NEWS_F1_START+1.EQ.IER1 - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - IF (.NOT.IER1) DELETE (UNIT=7) - END IF - IER = 0 - END IF - END IF - END DO - END IF - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - NEWSLIST = .FALSE. - - IF (SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED')) CALL RECOUNT - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DO - - RETURN - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4 - - COMMON /LOCALPOST/ LOCAL_POST - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /TEMP_INPUT/ GROUP_TEMP - CHARACTER GROUP_TEMP*256 - - COMMON /HEADER/ HEADER - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER RESPONSE*4 - - CHARACTER TODAY*24,UNAME*132 - DATA UNAME /'()'/ - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /NEWS2BULL/ NEWS2BULL - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1) - IF (IER1.NE.0) RETURN - ELSE - REWIND (UNIT=3) - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900 - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3) - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSE - I = INDEX(NEWS_MSGID,'.') - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & NEWS_MSGID(:I-1)// - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256) - IF (IER.NE.0) RETURN - LOCAL_POST = .TRUE. - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1 - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Newsgroups: junk')) GO TO 900 - ELSE IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP - ELSE IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - IF (TRIM(FOLLOWUP).EQ.0) THEN - INPUT = 'Newsgroups: '//NEWSGROUPS - IF (INDEX(NEWSGROUPS,',').GT.0) THEN - WRITE (6,'('' Warning: Original message was cross'', - & ''posted to the following news groups:'')') - DO I=1,TRIM(NEWSGROUPS),PAGE_WIDTH - WRITE (6,'(1X,A)') NEWSGROUPS(I: - & I-1+MIN(PAGE_WIDTH,TRIM(NEWSGROUPS(I:)))) - END DO - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Type Y if you want your reply crossposted also, '// - & 'N for no: (default = Y) ') - IF (RESPONSE(:1).EQ.'n'.OR.RESPONSE(:1).EQ.'N') THEN - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - END IF - ELSE - INPUT = 'Newsgroups: '//FOLLOWUP - END IF - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE.AND. - & .NOT.NEWS_FEED()) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER) - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0 - DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP)) - IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP) - DO WHILE (TRIM(GROUP_TEMP).GT.0) - COMMA = INDEX(GROUP_TEMP,',') - IF (COMMA.GT.0) THEN - FOLDER1_NAME = GROUP_TEMP(1:COMMA-1) - GROUP_TEMP = GROUP_TEMP(COMMA+1:) - ELSE - FOLDER1_NAME = GROUP_TEMP - GROUP_TEMP = ' ' - END IF - CALL LOWERCASE(FOLDER1_NAME) - FLEN = TRIM(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1) - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9) - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND. - & INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND. - & INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST), - & GROUP_LIST,FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - ELSE - WRITE (6,'(1X,A,'' is not a valid news group.'')') - & FOLDER1_NAME(:FLEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to specify it? (default = Y) ') - IF (RESPONSE(:1).NE.'n'.AND. - & RESPONSE(:1).NE.'N') THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - END IF - END IF - END DO - END DO - CALL CLOSE_BULLNEWS - END IF - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900 - END IF - ATSIGN = INDEX(PATHNAME,'@') - PCSIGN = INDEX(PATHNAME,'%') - CALL LOWERCASE(USERNAME) - IF (FILENAME.EQ.'cancel'.AND.SUBJECT(:6).EQ.'CanceL') THEN - IF (.NOT.NEWS_WRITE('Path: cyberspam!usenet')) GO TO 900 - ELSE - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - END IF - END IF - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME) - - IF (FILENAME.NE.'cancel') THEN - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - IF (INDEX(INFROM,' ').GT.0) - & INFROM = INFROM(:INDEX(INFROM,' ')-1) - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - ELSE IF (INDEX(INFROM,'@').EQ.0) THEN - INFROM = INFROM(:TRIM(INFROM))//PATHNAME(:LPATH) - END IF - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED').AND. - & SYS_TRNLNM('MX_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED').AND. - & SYS_TRNLNM('PMDF_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MULTINET_ROOT','DEFINED').AND. - & SYS_TRNLNM('MULTINET_SMTP_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - CALL STR$UPCASE(FROM_LINE,FROM_LINE) - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME) - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (SENDER_LINE.NE.' ') THEN - IF (.NOT.NEWS_WRITE(SENDER_LINE(:TRIM(SENDER_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE(FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - ELSE - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ILEN = TRIM(INPUT) - IF (INPUT(:5).EQ.'From:') THEN - GROUP_TEMP = INPUT - ELSE IF (INPUT(:7).EQ.'Sender:') THEN - GROUP_TEMP = 'From:'//INPUT(8:) - ILEN = 0 - END IF - END DO - ILEN = TRIM(GROUP_TEMP) - IF (ILEN.NE.0) THEN - IF (.NOT.NEWS_WRITE(GROUP_TEMP(:ILEN))) RETURN - END IF - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'// - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE IF (TRIM(SUBJECT).EQ.0) THEN - IF (.NOT.NEWS_WRITE('Subject: (none)')) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECT - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) - & GO TO 900 - END IF - - IF (NGROUPS.GT.0) THEN - FROM = USERNAME - DESCRIP = SUBJECT - END IF - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//PATHNAME(:LPATH)//'>')) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Message-ID: ')) GO TO 900 - END IF - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION) - END IF - LORGAN = TRIM(ORGANIZATION) - END IF - - IF (FILENAME.NE.'cancel'.AND.LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN))) - & GO TO 900 - ELSE IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Organization: cancel')) - & GO TO 900 - END IF - - IF (.NOT.USE_INFROM.OR.COMPARE_DATE(TODAY(:11),DATE).GT.13) THEN - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(8:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & ZONE(:LZONE))) GO TO 900 - ELSE - CALL COPY2(NOW,MSG_BTIM) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - TODAY = DATE(:2)//' '//DATE(4:6)//' '//DATE(8:) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & TIME(:8)//' '//ZONE(:LZONE))) GO TO 900 - IER = SYS$ASCTIM(,TODAY,MSG_BTIM,) - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - END IF - - INPUT_HEADER = .FALSE. - - IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel')) THEN - EXPR = NEWS_FEED().OR.USE_INFROM - IF (.NOT.EXPR) EXPR = CLI$PRESENT('EXPIRATION') - IF (EXPR) THEN - CALL SYS_BINTIM(EXDATE//' '//EXTIME,NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - EXDATE = TODAY(:11) - EXTIME = TODAY(13:20) - I = INDEX(EXDATE,'-') - IF (EXDATE(I+5:I+8).EQ.'2100') THEN ! Servers not Y21K compliant - READ (DATE(8:11),'(I4)') J - WRITE (EXDATE(I+5:I+8),'(I4)') J+10 ! 10 years - END IF - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE(FIRST_ALPHA(EXDATE):2) - & //' '//EXDATE(I+1:I+3)//' '//EXDATE(I+5:TRIM(EXDATE)) - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) - & GO TO 900 - ELSE IF (REMOTE_SET.EQ.4) THEN - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT) - END IF - EXTIME = '00:00:00.00' - END IF - IF (.NOT.NEWS_FEED()) THEN - IF (CLI$GET_VALUE('FOLLOWUP',GROUP_TEMP)) THEN - CALL LOWERCASE(GROUP_TEMP) - IF (.NOT.NEWS_WRITE('Followup-To: ' - & //GROUP_TEMP(:TRIM(GROUP_TEMP)))) GO TO 900 - END IF - END IF - END IF - - IF (CREATE) THEN - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURN - END IF - - IF (NEWS_FEED().OR.NEWS2BULL) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (.NOT.NEWS_WRITE('X-Newsreader: News2bull')) GO TO 900 - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (SUBJECT(:6).EQ.'CanceL') THEN - IF (SUBJECT.EQ.'CanceL') THEN - WRITE (6,1055) - ILEN = LINE_LENGTH + 1 ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - IF (.NOT.NEWS_WRITE(INPUT(:ILEN))) RETURN - END IF - END DO - ELSE - IF (.NOT.NEWS_WRITE(SUBJECT(7:TRIM(SUBJECT)-6))) RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).EQ.'240') IER = 0 - ELSE - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - CALL STR$UPCASE(USERNAME,USERNAME) - LOCAL_POST = .FALSE. - RETURN - END IF - - IF (.NOT.INPUT_HEADER) THEN - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2 - END IF - IF (IER1.EQ.0) THEN - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DO - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') THEN - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:MIN(79+SB,EB)) - IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN - WRITE (6,'('' Use /INDENT to change indentation'',$)') - WRITE (6,'(''+ character. See Manager for permanent'',$)') - WRITE (6,'(''+ change.'')') - END IF - END IF - ELSE - LENGTH = (LENGTH+127)/128 - GROUP_LIST = GROUP_LIST1 - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - SAVE_BULL_POINT = BULL_POINT - OLD_NBULL = NBULL - DO I=NGROUPS,1,-1 - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1) - FOLDER_NUMBER = -1 - OLD_NBULL = NBULL - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL ADD_LOCAL_NEWS(8) - CALL ADD_TAG(IER,2) - IF (NEWS_FIND_SUBSCRIBE().LT.FOLDER_MAX) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER1) - IF (IER1.EQ.0.OR.IER1.EQ.OLD_NBULL+1) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(OLD_NBULL+1) - END IF - END IF - END IF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - BULL_POINT = SAVE_BULL_POINT - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - CALL STR$UPCASE(USERNAME,USERNAME) - - LOCAL_POST = .FALSE. - -1055 FORMAT(' State reason for deleting message not owned by you:') - - RETURN - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURN - END IF - END IF - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME) - LPATH = TRIM(PATHNAME) - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NAME - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME) - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE. - END DO - - TEST_NEWS = MAYBE_NEWS - - RETURN - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) RETURN - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULL - FIRST = F1_START - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - REMOTE_SET = 3 - CALL OPEN_BULLDIR_SHARED - INCMD = 'READ' ! REMOTE_GET_HEADER uses NEXT otherwise - I = F_LAST + 1 - IER = I - 1 - DO WHILE (I.NE.IER.AND.I.LE.LAST) - CALL READDIR(I,IER) - I = I + 1 - END DO - CALL CLOSE_BULLDIR - CALL OTS$CVT_L_TI(I-1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNT - NEW_NEWS_F_END = NEWS_F_END - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - F_LAST = LAST - NEWS_F_FIRST = FIRST - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE NEWS2BULL(RECLAIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - DATA BULLCP_NEWS /.FALSE./ - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBER - - DIMENSION NOW(2) - - BULLCP_NEWS = .TRUE. - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV - - CALL DELETE_EXPIRED_NEWS(RECLAIM) - - IF (RECLAIM) CALL EXIT - - CALL SEND_POST - IF (ALT_SET()) CALL UNSET_ALT - - CALL NEWS_LIST - - CALL UPDATE_LOCAL_NEWS - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - IF (NEWS_FEED()) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARD - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (IER) THEN - SAVE_LAST = F_LAST - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER) - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN - SAVE_LAST = F_NBULL - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LAST - FOLDER_BBOARD = 'NONEFEED' - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - IF (FOLDER_BBOARD.EQ.'NONEFEED') THEN - CALL SETUSER('SYSTEM') - ELSE - CALL SETUSER(FOLDER_BBOARD) - END IF - REMOTE_SET = 3 - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/LOCAL/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1) - END IF - CALL CLOSE_BULLFOLDER - CALL SETUSER(USERNAME) - END IF - END IF - END DO - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - CHARACTER*(*) TIME - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+ - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)// - & TIME(16:17)//TIME(19:20) - - RETURN - END - - - - SUBROUTINE ALLPRIV - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1 - PROCPRIV(2) = -1 - NEEDPRIV(1) = -1 - NEEDPRIV(2) = -1 - - RETURN - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COM - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - RETURN - END - - - - SUBROUTINE SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')') - RETURN - END IF - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE - WRITE (6,'('' You are now subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - CALL UPDATE_USERINFO - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - LAST_NEWS_READ(2,J) = F_START - 1 - ELSE - LAST_NEWS_READ2(2,J) = 0 - LAST_NEWS_READ(2,J) = F_NBULL - END IF - CALL CLOSE_BULLNEWS - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - CALL UPDATE_USERINFO_NEWS_ALWAYS - RETURN - END IF - END DO - - END - - - - - - SUBROUTINE UNSUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_EXPIRED - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.LE.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Folder is permanent and cannot not be'', - & '' unsubscribed.'')') - RETURN - END IF - - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - CALL UPDATE_USERINFO - - I = NEWS_FIND_SUBSCRIBE() - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - - CALL FREE_TAGS(I) - - IF (NINCLUDE.GT.0) THEN - WRITE (6,'('' Note: Excludes and/or '', - & ''threads exist for this group.'')') - WRITE (6,'('' Type EXCLUDE/DISABLE/ALL to remove them.'')') - END IF - - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - CALL UPDATE_USERINFO_NEWS_ALWAYS - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (IER.EQ.0) IER = 1 ! None read yet. - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE1() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR.(LAST_NEWS_READ(2,I) - & .GT.NEWS_F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0 - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THEN - COUNT = COUNT + 1 - END IF - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT) - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE - SUBNUM = 0 - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES) -C -C SUBROUTINE NEWS_NEW_NOTIFICATION -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - MESSAGES = .FALSE. - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1 - - FOLDER_DESCRIP = ' ' - REORDER = 0 - DO WHILE (SUBNUM.GT.0) - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUM - UNLOCK 7 - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1 - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - CALL UPDATE_USERINFO - IF (F_START.EQ.0) IER = 1 - ELSE IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR. - & F_START.GT.F_NBULL) THEN - IER = 1 - END IF - END IF - IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (DIFF.GT.0) IER = 1 - END IF - END IF - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - ELSE - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IF - END IF - END DO - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE - - CALL CLOSE_BULLNEWS - - RETURN - END - - - SUBROUTINE REORDER_SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0) - I = I + 1 - END DO - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1 - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1) - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2 - TEMP = LAST_NEWS_READ(L,J) - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K) - LAST_NEWS_READ(L,K) = TEMP - END DO - END IF - END DO - END DO - - RETURN - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE = I - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE1 = I - - RETURN - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - IP = 1 - DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER - & .AND.IP.LE.FOLDER_MAX-1) - IP = IP + 1 - END DO - - IER = .TRUE. - - IF (IP.EQ.FOLDER_MAX) THEN - PERM = .FALSE. - IP = 1 - ELSE - PERM = .TRUE. - END IF - - IF (NOTIFY.EQ.0) THEN - IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).AND. - & .NOT.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (BTEST(INF_REC2(2,IP),14)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - END IF - - IF (BTEST(INF_REC2(2,IP),15)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - END IF - END IF - - CALL UPDATE_USERINFO - - RETURN - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - REWIND UNIT - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '// - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK) - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6, - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) - END IF - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1 - SYSTEM = 0 - CALL ADD_ENTRY - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE UPDATE_NEWS_FOLDER -C -C SUBROUTINE UPDATE_NEWS_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1 - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_EX_BTIM_KEY - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE SEND_POST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /NEWSBULL/ NEWSBULL - DATA NEWSBULL /.FALSE./ - - CHARACTER FILE*132 - - C = 0 - - IF (.NOT.NEWS_LOGIN()) RETURN - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST*',FILE,C)) -50 IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'340') RETURN - - NEWSBULL = .FALSE. - - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (INPUT(:5).EQ.'From:') BULL_PARAMETER = INPUT(7:) - IF (INDEX(INPUT,'X-Newsreader: News2bull').EQ.1) THEN - NEWSBULL = .TRUE. - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (.NOT.NEWS_WRITE('X-Newsreader: News2bull' - & //' '//PATHNAME(:TRIM(PATHNAME)))) GO TO 100 - ELSE - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IF - END IF - END DO - IF (INPUT.NE.'.') THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - IF (BUFFER(:3).EQ.'441'.AND..NOT.ALT_SET()) THEN - REWIND (UNIT=3) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0.AND.INPUT(:12).EQ.'Newsgroups: ') THEN - CLOSE (UNIT=3) - IF (TEST_ALT(INPUT(13:))) THEN - IF (SET_ALT(ALT_FOUND)) GOTO 50 - GOTO 90 - END IF - IER = 2 - END IF - END DO - CLOSE (UNIT=3) - END IF - IF (BUFFER(:3).NE.'240') THEN - CLOSE (UNIT=3) - IF (NEWSBULL.AND.INDEX(FILE,'POST_ERROR').EQ.0) THEN - CALL LIB$RENAME_FILE(FILE,'*.POST_ERROR',,,,,,,,,FILE) - CALL SENDMAIL(FILE,'SYSTEM' - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER) - NEWSBULL = .FALSE. - ELSE IF (.NOT.NEWSBULL) THEN - CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER) - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - CLOSE (UNIT=3,STATUS='DELETE') - END IF - ELSE - CLOSE (UNIT=3,STATUS='DELETE') - END IF -90 IF (ALT_SET()) CALL UNSET_ALT - END DO - -100 CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVS - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST) - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - - IER = SYS_TRNLNM('BULL_PERSONAL_NAME',UNAME) - - IF (UNAME.EQ.'()') THEN - UNAME = ' ' - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IF - - RETURN - END - - - - SUBROUTINE RECOUNT -C -C SUBROUTINE RECOUNT -C -C FUNCTION: -C -C Fixes the message count of stored news groups. This may become wrong -C if old copies of some of the database files are used with newer versions. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - REMOTE_SET = 4 - - DO WHILE (IER.EQ.0) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - END DO - - IF (BTEST(NEWS_F_FLAG,8).AND.IER.EQ.0) THEN - CALL NEWS_TO_FOLDER - - CALL OPEN_BULLDIR_SHARED - - NUM = F_START - F_COUNT = 0 - - IF (F_START.GT.0) THEN - CALL READDIR(NUM,IER) - NEXT = .TRUE. - F_START = NUM - DO WHILE (NUM+1.EQ.IER) - F_COUNT = F_COUNT + 1 - NUM = NUM + 1 - IF (NUM.LE.F_NBULL) CALL READDIR(NUM,IER) - END DO - NEXT = .FALSE. - - F_NBULL = NUM - 1 - END IF - - CALL CLOSE_BULLDIR - - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - - CALL DELLNM('BULL_NEWS_RECOUNT') - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE DELLNM(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$SYSTEM',LOG,PSL$C_SUPER) - - RETURN - END - - - SUBROUTINE DELLNM_USER(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$PROCESS',LOG,PSL$C_USER) - - RETURN - END - - - SUBROUTINE NEWNEWS(SINCE_BTIM,FOUND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - DIMENSION SINCE_BTIM(2) - - START = F_START - END = F_NBULL - - FOUND = 0 - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - IF (.NOT.NEWS_READ()) RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (FOUND.EQ.0) THEN - L = INDEX(BUFFER(SB:EB),' ') - CALL OTS$CVT_TI_L(BUFFER(SB:SB+L-2),IER,,%VAL(1)) - CALL NEWS_TIME(BUFFER(SB+L:EB),MSG_BTIM) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) - & FOUND = IER - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (FOUND.NE.0) THEN - IF (.NOT.OTS$CVT_L_TI(FOUND,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END.AND.FOUND.EQ.0) - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) FOUND = MSG_NUM - I = I + 1 - IF (REMOTE_SET.EQ.3.AND.I.LE.END.AND.FOUND.EQ.0) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - IF (FOUND.EQ.0) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - - RETURN - END - - - - LOGICAL FUNCTION TEST_ALT(FOLDER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - CHARACTER*(*) FOLDER1 - - TEST_ALT = .FALSE. - - OPEN (UNIT=3,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',READONLY) - - IF (IER.NE.0) RETURN - - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) ALT_FOUND - IF (STREQ(ALT_FOUND(:INDEX(ALT_FOUND,':')-1), - & FOLDER1(:TRIM(FOLDER1)))) THEN - ALT_FOUND = ALT_FOUND(INDEX(ALT_FOUND,':')+1:) - CLOSE (UNIT=3) - TEST_ALT = .TRUE. - RETURN - END IF - END DO - - CLOSE (UNIT=3) - - RETURN - END - - - - LOGICAL FUNCTION SET_ALT(NEWALT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NEWALT - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - DATA SETALT/.FALSE./ - - SET_ALT = .FALSE. - - IF (SETALT) THEN - IF (NEWALT.EQ.ALT) THEN - SET_ALT = .TRUE. - RETURN - ELSE - CALL UNSET_ALT - END IF - END IF - - CALL NEWS_LOGOUT - - CALL CRELNM('BULL_NEWS_SERVER',NEWALT(:TRIM(NEWALT))) - - IF (NEWS_LOGIN()) THEN - SET_ALT = .TRUE. - SETALT = .TRUE. - ALT = NEWALT - ELSE - CALL DELLNM_USER('BULL_NEWS_SERVER') - SETALT = .FALSE. - END IF - - RETURN - END - - - - SUBROUTINE UNSET_ALT - - IMPLICIT INTEGER (A-Z) - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - CALL DELLNM_USER('BULL_NEWS_SERVER') - - CALL NEWS_LOGOUT - - SETALT = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALT_SET() - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - ALT_SET = SETALT - - RETURN - END - - - - SUBROUTINE ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION EXPIRED(2) - - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLEN - NEWS_F1_COUNT = NEWS_F_COUNT - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN - NEWS_FOLDER = NEWS_FOLDER(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - NEWS_F_COUNT = NEWS_F1_COUNT - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - IF (IER2.EQ.0) THEN - NEWS_F1_FLAG = NEWS_F_FLAG - NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN - NEWS_F1_EXPIRE = NEWS_F_EXPIRE - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1) - IF (BTEST(NEWS_F1_FLAG,8)) THEN - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_LAST = 0 - END IF - - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE. - IF (SP.GT.0) THEN - IF (FLEN.GT.44) THEN - IF (NEWS_FOLDER1_DESCRIP.NE. - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE - UPDATE = .TRUE. - END IF - IF (SPECIAL) THEN - IF (UPDATE) THEN - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF - ELSE IF (.NOT.UPDATE) THEN - UPDATE = F1_START.LT.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bulletin11.for b/decus/vmslt00a/bulletin/bulletin11.for deleted file mode 100644 index 77a03ee..0000000 --- a/decus/vmslt00a/bulletin/bulletin11.for +++ /dev/null @@ -1,3599 +0,0 @@ -C -C BULLETIN11.FOR, Version 10/6/98 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('CURRENT')) THEN - MESSAGE_NUMBER = BULL_POINT - ELSE IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - IF (.NOT.BULL_NEWS_TAG) RETURN - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*12 BULL_MARK_DIR - CHARACTER*12 TAG_KEY,INPUT_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,) - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1) - ELSE - UNLOCK 13 - END IF - END IF - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - ELSE - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - BULL_NEWS_TAG = .FALSE. - RETURN - END IF - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),) - IF (IER1.NE.0) THEN - CLOSE (UNIT=23) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=128,DISPOSE='DELETE', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1) - NEWS_MARK2(1) = NEWS_MARK2(2) - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE') - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - CALL ERRSNS(IDUMMY,IER2) - IF (IER2.NE.RMS$_RNF) SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURN - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1), - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IF - - RETURN - END - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - - CHARACTER*12 BULL_MARK_DIR - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSE - MARKUNIT = 23 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1 - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEY - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IF - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY) - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURN - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - TAG_TYPE = 0 - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR. - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN - IF (IER.EQ.0) UNLOCK 13 - IER = 0 - MESSAGE = MSG_NUM - ELSE - IER = 36 - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - IER = 36 - - HEADER = .FALSE. - - TAG_TYPE = 0 - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) THEN - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:) - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THEN - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I) - IER = 0 - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - MSG_KEY = NEXT_MSG_KEY - RETURN - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DO - - RETURN - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - DO MESSAGE = MSG_NUM+1,F_NBULL - CALL READDIR(MESSAGE,IER) - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE) - IF (IER.EQ.0) THEN - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END DO - - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2) - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURN - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER) - & INPUT_KEY - END DO - - CLOSE_IT = .FALSE. - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - CALL DECREMENT_MSG_KEY - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR_SHARED - CLOSE_IT = .TRUE. - END IF - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - DELETE (UNIT=13) - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER)) - READ (13,IOSTAT=IER) INPUT_KEY - END DO - END IF - END IF - - END DO - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE. - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1 - DO M=1,2 - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1 - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1 - LIMIT = 256/(NEWS_FORMAT+1) - NEWS_NUMBER = LAST_NEWS_READ2(1,I) - K = 5-NEWS_FORMAT*2 - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1 - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IF - SET_LIST = .FALSE. - END IF - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0) - END DO - K = LIMIT + 1 - END IF - IF (K.GT.LIMIT) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2 - NEWS_REC = NEWS_REC + 1 - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - IF (IER.EQ.0) THEN - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IF - END DO - END IF - END DO - END DO - CLOSE (UNIT=23) - END IF - - RETURN - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = J - ELSE - NEWS_MARK(I) = J - END IF - - RETURN - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG) - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUM - NEWS_TAG(I) = 0 - END DO - - RETURN - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - DO I=1,2 - IF (NEWS_TAG(3,I,ISUB).GT.0) THEN - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB)) - NEWS_TAG(3,I,ISUB) = 0 - NEWS_NUMBER = NEWS_FOLDER_NUMBER - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER) - END IF - END DO - IF (IER.EQ.0) UNLOCK 23 - END IF - - DO J=I,FOLDER_MAX-2 - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J)) - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0 - END DO - END DO - - RETURN - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY - - IER = 36 - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE) - IF (IER.EQ.0) THEN - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THEN - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM) - END IF - IER = 36 - END IF - END IF - END DO - BULL_READ = MSG_NUM - IF (CLOSE_IT) CALL CLOSE_BULLDIR - ELSE - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0 - MSG_KEY = BULLDIR_HEADER - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THEN - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36 - END IF - END IF - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*24 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - SUBROUTINE SENDMAIL(FILE,TO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE '($MAILDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /NEWSBULL/ NEWSBULL - - CHARACTER*(*) FILE,TO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1)) - - CALL DISABLE_PRIVS - - SENDTO = TO - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))// - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:) - END DO - - IF ((USE_INFROM.OR.NEWSBULL).AND.(SYS_TRNLNM('TWF$TCP','DEFINED').OR. - & SYS_TRNLNM('MULTINET_SOCKET_LIBRARY','DEFINED').OR. - & SYS_TRNLNM('UCX$DEVICE','DEFINED')) - & .AND..NOT.SYS_TRNLNM('BULL_DISABLE_SMTP','DEFINED')) THEN - IER = SYS$ASCTIM(,INPUT,,) - INPUT = INPUT(:2)//INPUT(4:6)//INPUT(10:11)// - & INPUT(13:14)//INPUT(16:17)//INPUT(19:20)// - & INPUT(22:23) - IF (INPUT(:1).EQ.' ') INPUT = INPUT(2:) - OPEN (UNIT=8,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & INPUT(:TRIM(INPUT))//'.SMTP',IOSTAT=IER1, - & STATUS='NEW',RECL=256) - IF (IER1.EQ.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - WRITE (8,'(A)',IOSTAT=IER) 'helo '//PATHNAME(2:LPATH) - INPUT = INFROM - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - END IF - WRITE (8,'(A)',IOSTAT=IER) 'MAIL FROM:<'// - & INPUT(:MINGT0(INDEX(INPUT,' ')-1,TRIM(INPUT)))//'>' - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - WRITE (8,'(A)',IOSTAT=IER) 'RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>' - WRITE (8,'(A)',IOSTAT=IER) 'DATA' - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - WRITE (8,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - IF (NHEAD.EQ.0.AND.TRIM(SUBJECT).GT.0) THEN - WRITE (8,'(A)',IOSTAT=IER) - & 'Subject: '//SUBJECT(:TRIM(SUBJECT)) - WRITE (8,'(A)',IOSTAT=IER) - END IF - IF (NEWSBULL) THEN - WRITE (8,'(A)') 'This message was posted via a folder'// - & ' with a news group associated with it.' - WRITE (8,'(A)') 'It will continue to attempt to be'// - & ' posted to the news group using the file:' - WRITE (8,'(A)') FILE(:TRIM(FILE)) - WRITE (8,'(A)') 'If necessary, you can either'// - & ' delete the file or edit it to fix it.' - WRITE (8,'(A)') 'If you edit it, delete old versions.' - WRITE (8,'(A)') ' ' - END IF - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER) - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.EQ.0) THEN - WRITE (8,'(A)',IOSTAT=IER) INPUT(:L) - END IF - END DO - CLOSE (UNIT=3) - REWIND (UNIT=8,IOSTAT=IER) - IF (IER.NE.0) THEN - CLOSE (UNIT=8,STATUS='DELETE') - IER1 = 2 - END IF - END IF - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('helo '//PATHNAME(2:LPATH)//CRLF)) - & GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - INPUT = INFROM - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ELSE IF (I.EQ.0.AND.INDEX(INPUT,'@').EQ.0) THEN - INPUT = INPUT(:TRIM(INPUT))//PATHNAME(:LPATH) - END IF - IF (.NOT.SMTP_WRITE_PACKET('MAIL FROM:<'//INPUT(:TRIM(INPUT)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - IF (.NOT.SMTP_WRITE_PACKET('RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('DATA'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - IF (BTEST(FOLDER_FLAG,15).OR.INPUT(:8).NE.'Subject:') THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:TRIM(INPUT))//CRLF)) - & GOTO 10 - ELSE - IF (.NOT.SMTP_WRITE_PACKET('Subject: '// - & SUBJECT(:TRIM(SUBJECT))//CRLF)) GOTO 10 - END IF - END DO - IF (NHEAD.EQ.0.AND.TRIM(SUBJECT).GT.0) THEN - IF (.NOT.SMTP_WRITE_PACKET('Subject: '// - & SUBJECT(:TRIM(SUBJECT))//CRLF)) GOTO 10 - NHEAD = 1 - END IF - IF (.NOT.SMTP_WRITE_PACKET(CRLF)) GOTO 10 - IF (NEWSBULL) THEN - IF (.NOT.SMTP_WRITE_PACKET('This message was posted via '// - & 'a folder with a news group associated with it.'//CRLF)) - & GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('It will continue to attempt to'// - & ' be posted to the news group using the file:'//CRLF)) - & GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(FILE(:TRIM(FILE))//CRLF)) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('If necessary, you can either'// - & ' delete the file or edit it to fix it.'//CRLF)) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('If you edit it, '// - & 'delete old versions.'//CRLF)) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(CRLF)) GOTO 10 - END IF - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER2) - DO WHILE (IER2.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER2) L,INPUT - IF (IER2.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) IER2 = 2 - END IF - END DO - CLOSE (UNIT=3) - IF (IER2.EQ.2) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IER2 = 1 - GOTO 20 -10 IER2 = 2 -20 CALL SMTP_DISCONNECT() - IF (IER1.EQ.0) THEN - IF (IER2) THEN - CLOSE (UNIT=8,STATUS='DELETE') - ELSE - CLOSE (UNIT=8) - END IF - END IF - CALL ENABLE_PRIVS - STATUS = 1 - RETURN - END IF - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR) - - IER = SYS_TRNLNM('BULL_PERSONAL_NAME',INPUT) - IF (IER) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(INPUT),MAIL$_SEND_PERS_NAME, - & %LOC(INPUT)) - CALL END_ITMLST(SEND_ITMLST) - STATUS = MAIL$SEND_BEGIN(C,%VAL(SEND_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - ELSE - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - END IF - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO)) - I = INDEX(SENDTO(J:),',') - 1 - IF (I.EQ.-1) I = TRIM(SENDTO(J:)) - CALL INIT_ITMLST - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME, - & %LOC(SENDTO(J:J+I-1))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - J = J + I - IF (SENDTO(J:J).EQ.',') J = J + 1 - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO)) - CALL END_ITMLST(ATTRIBUTE_ITMLST) - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - CALL LIB$REVERT - - RETURN - END - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,) - - RETURN - END - - - - - SUBROUTINE SET_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEXT/ NEXT - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DIMENSION EXPIRED(2) - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IF - - ENTRY SHOW_NEWS - - LIMIT = -2 - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1)) - IF (.NOT.IER.OR.LIMIT.LT.-1) THEN - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')') - RETURN - END IF - END IF - - EXPIRE = -1 - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1)) - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN - END IF - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR. - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')') - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - IF (CLI$PRESENT('DEFAULT')) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1 - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - RETURN - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE) - FOLDER1_NUMBER = NEWS_F1_COUNT - FOLDER1 = BULL_PARAMETER - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10) - CALL WRITE_FOLDER_FILE_TEMP(IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMP - REWRITE (7) NEWS_FOLDER1_COM - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER) - END IF - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - END IF - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS') - DEFAULT = CLI$PRESENT('DEFAULT') - ALL = CLI$PRESENT('ALL') - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE') - ENABLE = CLI$PRESENT('ENABLE') - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - - STORED = 0 - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN - WRITE (6,'('' Stored setting was not removed.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'[.BULLNEWS*]*.*;*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_SAVE = FOLDER - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - FOLDER = FOLDER_SAVE - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0 - F1_NBULL = 0 - F1_COUNT = 0 - F1_LAST = 0 - END IF - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3) - IF (IER.NE.0) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - END IF - CALL RESET_PROTECTION - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IF - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THEN - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')') - ELSE - WRITE (6,'('' Default is not stored.'')') - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS) THEN - WRITE (6,'('' Expiration is DEFAULT value.'')') - ELSE - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Default expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no default expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')') - ELSE - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - NOTIFY_FLAG_NEWS = .FALSE. - SET_FLAG_NEWS = .FALSE. - BRIEF_FLAG_NEWS = .FALSE. - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a default news group.'')') - ELSE - IER1 = 2 - END IF - END IF - NOTIFY_PERM_FLAG_NEWS = .FALSE. - SET_PERM_FLAG_NEWS = .FALSE. - BRIEF_PERM_FLAG_NEWS = .FALSE. - DO WHILE (REC_LOCK(IER2)) - READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC - END DO - IF (IER2.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a permanent news group.'')') - END IF - END IF - PERM = .FALSE. - IF (SET_FLAG_NEWS) THEN - IF (BRIEF_FLAG_NEWS) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE IF (BRIEF_FLAG_NEWS) THEN - IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - IF (.NOT.PERM) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (BRIEF_PERM_FLAG_NEWS.AND..NOT.SET_PERM_FLAG_NEWS) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (NOTIFY_FLAG_NEWS) THEN - IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' NOTIFY is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLINF - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IF - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER) - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) - END IF - FOUND = .FALSE. - MODALL = INDEX(GROUP,'.').NE.LG - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR. - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.')) - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER) - END DO - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER) - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - RETURN - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - END DO - END IF - - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - ALL = CLI$PRESENT('ALL') - FULL = CLI$PRESENT('FULL') - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (CLI$PRESENT('SUBJECT')) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IF - ELSE - INPUT = FROM - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:) - ELSE - INPUT = DESCRIP - END IF - END IF - LEN_P = TRIM(INPUT) - CALL CLOSE_BULLFIL - END IF - - SUB = CLI$PRESENT('SUBJECT') - DISABLE = CLI$PRESENT('DISABLE') - EXC = 0 - - GO TO 5 - - ENTRY INCLUDE_SUBJECT(EXCLUDE) - - IF (REMOTE_SET.GE.3.AND.NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) RETURN - - LEN_P = TRIM(INPUT) - ALL = .FALSE. - DISABLE = .FALSE. - SUB = .TRUE. - EXC = -1 - -5 IF (SUB) THEN - IF (DISABLE) THEN - IF (STREQ(INPUT(:3),'RE:')) INPUT = INPUT(5:) - INPUT = INPUT(:MIN(LEN_P,LEN(DESCRIP))) - LEN_P = TRIM(INPUT) - END IF - INPUT = 'SUBJECT:'//INPUT - LEN_P = LEN_P + 8 - ELSE - INPUT = 'FROM:'//INPUT - LEN_P = LEN_P + 5 - END IF - - IF (EXCLUDE) THEN - INPUT = ':exclude:'//INPUT - LEN_P = LEN_P + 9 - ELSE - INPUT = ':include:'//INPUT - LEN_P = LEN_P + 9 - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - FLEN = TRIM(FOLDER_NAME) - INPUT = FOLDER_NAME(:FLEN)//INPUT - ILEN = FLEN + LEN_P - - IF (EXC.EQ.0) THEN - EXC = -1 - IER = CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P) - IF (IER) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) EXC - IF (EXC.LT.0.OR.EXC.GT.999.OR.IER.NE.0) THEN - WRITE(6,'('' ERROR: Valid limit is 0-999.'')') - RETURN - END IF - END IF - END IF - - CHECK_ONLY = .FALSE. - - GO TO 100 - - ENTRY CHECK_EXCLUDES - - CHECK_ONLY = .TRUE. - DISABLE = .TRUE. - LEN_P = 0 - INPUT = ' ' - ILEN = 1 - -100 IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) THEN - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - CLOSE (UNIT=4,DISPOSE='SAVE') - RETURN - END IF - - IER = 0 - CONVERT = .FALSE. - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - I = STRFIND(OLD_BUFFER,':RE: ') - IF (IER.EQ.0) THEN - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THEN - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5) - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill' - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF ((STREQ(OLD_BUFFER(:ILEN),INPUT(:ILEN)).AND. - & OLD_BUFFER(ILEN+1:ILEN+1).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:OLEN),INPUT(:OLEN))).OR. - & (DISABLE.AND.I.GT.0.AND. - & ((STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:MAX(I+5,ILEN+4)), - & INPUT(:ILEN)).AND.OLD_BUFFER(ILEN+5:ILEN+5).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:OLEN), - & INPUT(:OLEN)))))) THEN - CONTINUE - ELSE IF (.NOT.(ALL.AND.STREQ(INPUT(:FLEN+8), - & OLD_BUFFER(:MIN(FLEN+8,OLEN))))) THEN - IER2 = OLD_BUFFER(:1).EQ.':'.OR. - & INDEX(OLD_BUFFER,':defaults:').GT.0 - IF (.NOT.IER2) THEN - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC1,BLIMIT,BDATE,IER1) - IF (IER1) IER2 = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1) - & ,' ').GT.-EXC1 - CONVERT = .NOT.IER1 - END IF - IF (.NOT.IER1.OR.EXC1.EQ.0.OR.IER2) - & WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN) - END IF - END IF - END DO - - IF (.NOT.DISABLE) THEN - IF (FULL) THEN - WRITE (4,'(A)',IOSTAT=IER) FOLDER_NAME(:FLEN)//':defaults:kill' - ELSE - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - - IF (CONVERT) THEN - WRITE (6,'('' NOTE: See help on the new SET EXLIMIT command.'')') - END IF - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - SUBROUTINE UPDATE_EXCLUDE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - DATA SCRATCH_B1/0/,NINCLUDE/0/,EXC_CHANGED/.FALSE./ - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - IF (.NOT.EXC_CHANGED) RETURN - EXC_CHANGED = .FALSE. - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (.NOT.(IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ. - & INPUT(:MIN(TRIM(FOLDER_NAME)+1,ILEN)).AND.INPUT(:1).NE.':' - & .AND.INDEX(INPUT,':defaults:').EQ.0)) THEN - IF (IER.EQ.0) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE SET_CUSTOM(PARAM) -C -C SUBROUTINE SET_CUSTOM -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - CHARACTER*(*) PARAM - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IF - - LENP = LEN(PARAM) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0.AND.PARAM(:LENP).NE.INPUT(2:LENP+1)) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - IF (CLI$GET_VALUE('SET_PARAM2',INPUT,ILEN)) THEN - WRITE (4,'(A)',IOSTAT=IER) ':'//PARAM(:LENP)//':'//INPUT(:ILEN) - END IF - - IF (PARAM.EQ.'exclude_limit') - & DECODE(ILEN,'(I)',INPUT(:ILEN)) EXCLUDE_LIMIT - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - DIMENSION BTIM(2) - - FILE_DIRECTORY = ' ' - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THEN - BULL_USER_CUSTOM = .FALSE. - ELSE - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IF - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',OLD_BUFFER) - IF (.NOT.IER) OLD_BUFFER = 'SYS$LOGIN:BULL.CUSTOM' - - OPEN(UNIT=17,FILE=OLD_BUFFER(:TRIM(OLD_BUFFER)), - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURN - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - NINCLUDE = 0 - OLD_FORMAT = .FALSE. - FLEN = TRIM(FOLDER_NAME) - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL LOWERCASE(OLD_BUFFER) - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults') - & .EQ.1) THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - OLD_FORMAT = OLD_FORMAT.OR.(.NOT.IER1) - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXC - & .OR.EXC.EQ.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1 - ELSE - EXC_CHANGED = .TRUE. - END IF - END IF - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - IF (INDEX(OLD_BUFFER,':file_directory').GT.0) - & FILE_DIRECTORY = OLD_BUFFER(17:) - IF (INDEX(OLD_BUFFER,':exclude_limit').GT.0) THEN - DECODE(OLEN-15,'(I)',OLD_BUFFER(16:),IOSTAT=IER1) - & EXCLUDE_LIMIT - EXCLUDE_LIMIT = MIN(999,EXCLUDE_LIMIT) - END IF - END IF - END DO - - CLOSE (UNIT=17) - - IF (OLD_FORMAT) CALL CHECK_EXCLUDES - - RETURN - END - - - - - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /DIRMODE/ DIRMODE - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - CHARACTER*(*) STRING,STRING1 - CHARACTER*132 ADDRESS - - CHARACTER*12 EXFROM - - INCLUDE_MSG = .TRUE. - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURN - - MATCH_FROM = .FALSE. - SYSTEM = IBCLR(SYSTEM,8) - - IF (STRING.EQ.'>') THEN - INCLUDE_MSG = .FALSE. - SYSTEM = IBCLR(SYSTEM,8) - RETURN - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - DO I=1,NINCLUDE - OLD_SCRATCH_B = SCRATCH_B - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (DIRMODE) BLIMIT = MIN(BLIMIT,FLEN+17+LEN(DESCRIP)) - MATCH = .FALSE. - IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:')) THEN - CALL GET_FROM(EXFROM,OLD_BUFFER(FLEN+15:), - & TRIM(OLD_BUFFER(FLEN+15:))) - IF (STREQ(ADDRESS(STRING),ADDRESS(OLD_BUFFER(FLEN+15: - & TRIM(OLD_BUFFER(FLEN+15:BLIMIT))+FLEN+14))).OR. - & (DIRMODE.AND.STREQ(FROM,EXFROM))) THEN - MATCH = .TRUE. - MATCH_FROM = .TRUE. - END IF - ELSE IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND. - & STRFIND(STRING1(:TRIM(STRING1)), - & OLD_BUFFER(FLEN+18:BLIMIT)).GT.0) THEN - MATCH = .TRUE. - END IF - IF (MATCH) THEN - CDATE = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ') - IF (CDATE.NE.0.AND.EXC.NE.0) THEN - IF (OLD_BUFFER(BLIMIT+1:BLIMIT+1).EQ.':') EXC = -1 - CALL ADD_EXCL(OLD_BUFFER,BLIMIT,EXC) - CALL WRITE_QUEUE(%VAL(OLD_SCRATCH_B),OLD_SCRATCH_B, - & OLD_BUFFER) - EXC_CHANGED = .TRUE. - END IF - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THEN - SYSTEM = IBSET(SYSTEM,8) - INCLUDE_MSG = .TRUE. - ELSE IF (.NOT.BTEST(SYSTEM,8).OR.MATCH_FROM) THEN -C -C Only "from" matches override threads, but not subject matches. -C - INCLUDE_MSG = .FALSE. - SYSTEM = IBCLR(SYSTEM,8) - IF (MATCH_FROM) RETURN - END IF - END IF - END DO - - RETURN - END - - - - FUNCTION STRFIND(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) STRING,STRING1 - - L = LEN(STRING1) - DO I=0,LEN(STRING)-L - J = 1 - DO WHILE (J.LE.L) - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(STRING1(J:J)) - & .OR..NOT.ALPHA(STRING(I+J:I+J)))) THEN - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = I + 1 - RETURN - ELSE - J = J + 1 - END IF - END DO - END DO - - STRFIND = 0 - - RETURN - END - - - - - SUBROUTINE SHOW_EXCLUDE(TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (TYPE.EQ.0) WRITE (6,'('' There are no excludes.'')') - IF (TYPE.EQ.1) WRITE (6,'('' There are no threads.'')') - RETURN - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - FOUND = .FALSE. - - L = 1 - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - IF (STREQ(FOLDER_NAME(:FLEN)//':',OLD_BUFFER(:MIN(FLEN+1,OLEN))) - & .AND.((TYPE.EQ.1.AND.STREQ(OLD_BUFFER(FLEN+2:FLEN+8), - & 'INCLUDE')).OR.(TYPE.EQ.0.AND.STREQ( - & OLD_BUFFER(FLEN+2:FLEN+8),'EXCLUDE')))) THEN - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'Excludes for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'Threads for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - FOUND = .TRUE. - END IF - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (BLIMIT+5-FLEN.GT.PAGE_WIDTH.AND.L+2.GT.PAGE_LENGTH-1) THEN - L = L + 2 - ELSE - IF (L.EQ.0) THEN - WRITE (6,'(''+'',A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - ELSE - WRITE (6,'(1X,A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - END IF - IF (OLD_BUFFER(BDATE+1:BDATE+1).EQ.'-') - & OLD_BUFFER(BDATE:) = ' '//OLD_BUFFER(BDATE:) - OUTLEN = MIN(BLIMIT,PAGE_WIDTH+FLEN+9)-FLEN-9 - IF (OUTLEN.GT.PAGE_WIDTH-16) THEN - WRITE (6,'(1X,X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 2 - ELSE - WRITE (6,'(''+'',X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 1 - END IF - END IF - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & INPUT(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'No excludes found for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'No threads found for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - CHARACTER*12 NEW,OLD - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to set a new name.'')') - RETURN - END IF - - CALL CLI$GET_VALUE('OLDNAME',OLD,LENO) - CALL CLI$GET_VALUE('NEWNAME',NEW,LENN) - - CALL OPEN_BULLUSER_SHARED - - TEMP_USER = USERNAME - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY - END DO - - IF (IER.EQ.0) THEN - USERNAME = NEW - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=NEW) - END DO - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) USER_ENTRY - ELSE - REWRITE (4,IOSTAT=IER) USER_ENTRY - END IF - END IF - - USERNAME = TEMP_USER - DO WHILE (REC_LOCK(IER1)) - READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY - END DO - - CALL CLOSE_BULLUSER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Old name not found.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN))) - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - IF (LENO.GT.1) THEN - OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1))) - ELSE - OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2))) - END IF - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - IF (LENN.GT.1) THEN - NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1))) - ELSE - NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))) - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - SUBROUTINE CHECK_EXCL(BUFFER,L,EXC,BLIMIT,BDATE,IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - - CHARACTER*(*) BUFFER - - DIMENSION BTIM(2) - - BLIMIT = L - BDATE = L+3 - - IER = BUFFER(L:L).EQ.':' - IF (IER) THEN - I = LAST_INDEX(BUFFER(:L-1),':') - IF (I.GT.0) THEN - J = LAST_INDEX(BUFFER(:I-1),':') - IF (J.GT.0) THEN - IF (J.LT.I-1) THEN - DECODE(I-J-1,'(I)',BUFFER(J+1:I-1),IOSTAT=IER) EXC - IER = IER.EQ.0 - ELSE - EXC = EXCLUDE_LIMIT - END IF - IF (IER) BLIMIT = J - 1 - CALL STR$UPCASE(BUFFER(I+1:L-1),BUFFER(I+1:L-1)) - IF (IER) IER = SYS_BINTIM(BUFFER(I+1:L-1),BTIM) - BDATE = I + 1 - END IF - ELSE - IER = .FALSE. - END IF - END IF - - IF (.NOT.IER) CALL ADD_EXCL(BUFFER,L,-1) - - RETURN - END - - - - SUBROUTINE ADD_EXCL(BUFFER,L,EXC) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2) - - CHARACTER*(*) BUFFER - - CHARACTER TODAY*24 - - IF (EXC.EQ.-1) THEN - BUFFER = BUFFER(:L)//':' - ELSE - BUFFER = BUFFER(:L)//':' - WRITE (BUFFER(L+2:),'(I3)') EXC - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - BUFFER = BUFFER(:TRIM(BUFFER))//':'//TODAY(:INDEX(TODAY,' ')-1)//':' - - L = TRIM(BUFFER) - - RETURN - END - - - - - CHARACTER*(*) FUNCTION ADDRESS(INPUT) - - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) INPUT - - ADDRESS = INPUT - - IF (INDEX(INPUT,'@').EQ.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - ADDRESS = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - ELSE - ADDRESS = INPUT(:MINGT0(TRIM(INPUT),INDEX(INPUT,' ')-1)) - IF (INDEX(ADDRESS,'(').GT.0) - & ADDRESS = ADDRESS(:INDEX(ADDRESS,'(')-1) - END IF - - RETURN - END - - - - - SUBROUTINE SEND_MAIL - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - C = 0 - DO WHILE (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) - OPEN (UNIT=8,FILE=INPUT(:TRIM(INPUT)),IOSTAT=IER,RECL=256) - IF (IER.NE.0) GOTO 30 - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - DO I=1,3 - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - END DO - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - DO WHILE (IER.EQ.0) - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - END IF - END DO - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - CLOSE (UNIT=8,STATUS='DELETE') - GOTO 20 -10 CLOSE (UNIT=8) -20 CALL SMTP_DISCONNECT() -30 CONTINUE - END DO - - CALL EXIT - END diff --git a/decus/vmslt00a/bulletin/bulletin2.for b/decus/vmslt00a/bulletin/bulletin2.for deleted file mode 100644 index 3582b62..0000000 --- a/decus/vmslt00a/bulletin/bulletin2.for +++ /dev/null @@ -1,2692 +0,0 @@ -C -C BULLETIN2.FOR, Version 11/11/99 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'('' WARNING: Account used by other folder.'', - & '' If you specify the same account,'')') - WRITE (6,'('' you must specify the address'', - & '' of the mailing list in the folder description.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to make this change? ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) THEN - CALL CLOSE_BULLUSER - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Specified file cannot be opened.'')') - RETURN - END IF - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.EQ.0) THEN - INFROM = INPUT(:ILEN)//',' - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (MSG_OWN) THEN - ILEN = TRIM(INPUT) - 6 - INFROM = INFROM(:LENFRO)//INPUT(7:) - IF (INDEX(INFROM,' "').GT.INDEX(INFROM,'@')) THEN - I = INDEX(INFROM,' "') - INFROM = INFROM(:I-1)// - & INFROM(INDEX(INFROM(I+2:),'"')+I+2:) - DO WHILE (INDEX(INFROM,'""').GT.0) - INFROM = INFROM(:INDEX(INFROM,'""'))// - & INFROM(INDEX(INFROM,'""')+2:) - END DO - END IF - CALL ADD_PROTOCOL(INFROM(LENFRO+1:),ILEN) - LENFRO = LENFRO + ILEN - END IF - IF (EDIT.AND.TEXT) THEN - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:TRIM(INPUT)-1) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:TRIM(INPUT))//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_P = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LEN_P.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') BULL_PARAMETER(:LEN_P)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THEN - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - IER = 0 - END IF - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')') - END IF - END IF - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IF - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (.NOT.FILESPEC) THEN - WRITE (6,'('' Enter message: End with ctrl-z,'', - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - ELSE - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IF - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IF - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - END IF - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No message added.'')') - IF (.NOT.STATUS) THEN - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ') - IF (STREQ(INPUT(:1),'Y')) THEN - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV') - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IF - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C -C SUBROUTINE ADD_SIGNATURE -C -C FUNCTION: Adds signature to message being mailed/posted. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATURE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/ - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURN - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) RETURN - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IF - - ICOUNT = 0 - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME))) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THEN - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END DO - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IF - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE. - ELSE - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' ' - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - END DO - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,INPUT1 - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(INPUT(I:I)) - & .OR..NOT.ALPHA(INPUT1(I:I)))) RETURN - END DO - - STREQ = .TRUE. - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -C -C SUBROUTINE RESPOND_MAIL -C -C FUNCTION: Sends mail to address. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,MLDESCRIP*(LINE_LENGTH) - - PRIVS = FILE.NE.'SYS$LOGIN:BULL.SCR' - - MLDESCRIP = SUBJECT - LENDES = TRIM(MLDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES) - IF (MLDESCRIP(I:I).EQ.'"') THEN - IF (LENDES.EQ.LINE_LENGTH) THEN - MLDESCRIP(I:I) = '`' - ELSE - MLDESCRIP = MLDESCRIP(:I)//'"' - & //MLDESCRIP(I+1:) - I = I + 1 - LENDES = LENDES + 1 - END IF - END IF - I = I + 1 - END DO - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0 - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD) - IF (PRIVS) CALL DISABLE_PRIVS - - IF (LISTSERV) THEN - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('MX_REPLY_TO','DEFINED')) - & CALL CRELNM('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('PMDF_REPLY_TO','DEFINED')) - & CALL CRELNM('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - IF (.NOT.SYS_TRNLNM('MULTINET_SMTP_REPLY_TO','DEFINED')) - & CALL CRELNM('MULTINET_SMTP_REPLY_TO', - & USERNAME(:TRIM(USERNAME))) - END IF - END IF - - IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (LPATH.GT.0) THEN - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - END IF - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - CALL CRELNM('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - CALL CRELNM('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE - CALL CRELNM('MULTINET_SMTP_REPLY_TO',INFROM(:TRIM(INFROM))) - END IF - END IF - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO) - & //'""" """'//MLDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IF - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//MLDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE - I = INDEX(SENDTO,'%""') + 3 - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THEN - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THEN - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THEN - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & MLDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) -C -C Use the following if you do not have VMS V5.3 or greater. -C -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//MLDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IF - - IF (PRIVS) CALL ENABLE_PRIVS - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV.OR.USE_INFROM) THEN - USE_INFROM = .FALSE. - CALL DELLNM_USER('MULTINET_SMTP_REPLY_TO') - CALL DELLNM_USER('PMDF_REPLY_TO') - CALL DELLNM_USER('MX_REPLY_TO') - END IF - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: CHANGE command subroutine. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWER - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IF - -C -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - LENFROM = 0 - IF (CLI$PRESENT('OWNER')) THEN - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - IER = CLI$GET_VALUE('OWNER',INFROM,LENFROM) - INFROM = 'From: '//INFROM - LENFROM = LENFROM + 6 - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('OWNER')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')') - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')') - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL.OR.LENFROM.GT.0) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (LENFROM.EQ.0) THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description header - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT, - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - IF (CLI$PRESENT('OWNER')) THEN - CALL GET_FROM(FROM,INFROM(7:),LENFROM-6) - CALL STR$UPCASE(FROM,FROM) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2100' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2100' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10) - - CHARACTER GROUP*80,STAT*4 - - EXTERNAL CLI$_ABSENT - - IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SEARCH_LEN(1) = 3 - SEARCH_NUM = 1 - NFOLDER = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - SEARCH_NUM = 1 - NFOLDER = 1 - INPUT = DESCRIP - CALL INCLUDE_SUBJECT(0) - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1 - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM) - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1 - NFOLDER = 1 - ELSE - IF (NFOLDER.EQ.0) NFOLDER = 1 - SEARCH_STRING = ' ' - END IF - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - END IF - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME - NFOLDER = NFOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DO - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - SCRATCH_F = SCRATCH_F1 - NFOLDER = NFOLDER + 1 - END IF - - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - OLD_BUFFER = ' ' - END IF - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - END IF - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IF (NFOLDER.NE.0) FOUND = 0 - - CHANGE = .FALSE. - IF (CLI$PRESENT('REPLY').OR. - & TRIM(SEARCH_STRING).GT.0) THEN - REVERSE = CLI$PRESENT('REVERSE') - ELSE - REVERSE = .FALSE. - END IF - - DO WHILE (NFOLDER.NE.0.AND.FOUND.LE.0.AND.FOUND.GT.-3) - IF ((NFOLDER.GT.0.AND.(.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1)).OR. - & (NFOLDER.LT.0.AND.OLD_BUFFER.NE.' ')) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL, - & REVERSE,CLI$PRESENT('SUBJECT') - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'), - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),CHANGE) - IF (FOUND.LE.0.AND.FOUND.GE.-2) THEN - NFOLDER = NFOLDER - 1 - IF (NFOLDER.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F, - & FOLDER1_NAME) - END IF - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - END IF - END DO - ELSE IF (NFOLDER.LT.0) THEN - NFOLDER = NFOLDER + 1 - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - IF (GFOUND) THEN - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - GFOUND = .FALSE. - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - END IF - ELSE - NFOLDER = 0 - END IF - END DO - CALL CLOSE_BULLFOLDER - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - END IF - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - NFOLDER = 0 - END IF - CALL CANCEL_CTRLC_AST - END IF - END IF - END DO - - IF (FOUND.EQ.-3) FOUND = 0 - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - IF (CHANGE) THEN - WRITE (6,'('' No matches found in current folder: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' No matches found.'')') - END IF - ELSE IF (FOUND.EQ.-2) THEN - IF (CHANGE) THEN - WRITE (6,'('' ERROR: No more messages in current folder: '' - & ,A)') FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' ERROR: No more messages.'')') - END IF - END IF - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN, - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE,CHANGE) -C -C SUBROUTINE GET_SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEXT/ NEXT - LOGICAL NEXT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*4 SAVECMD - - CHARACTER*128 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - OLD_REVERSE = REVERSE - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THEN - OLD_REVERSE = REVERSE - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(BULL_POINT,IER) - IF (BULL_POINT+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (STREQ(DESCRIP(:4),'RE: ').AND.TRIM(DESCRIP).GE. - & LEN(DESCRIP)-1) THEN - IF (FILES) CALL OPEN_BULLFIL_SHARED - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - SEARCH_STRING = INPUT(11:) - SEARCH_STRING = SEARCH_STRING(:LEN(DESCRIP)) - ELSE - SEARCH_STRING = DESCRIP(5:) - END IF - IF (FILES) CALL CLOSE_BULLFIL - ELSE IF (STREQ(DESCRIP(:4),'RE: ')) THEN - SEARCH_STRING = DESCRIP(5:) - END IF - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - ELSE - SEARCH_NUM = OLD_SEARCH_NUM - IF (SEARCH_LEN(1).EQ.0) SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (OLD_REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - OLD_SEARCH_NUM = SEARCH_NUM - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.CHANGE.OR. - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last - END IF - IF (REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - SEARCH_STRING = ' ' - RETURN - END IF - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0 - BULL_SEARCH = START_BULL+1 - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR. - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY) - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - ELSE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - IF (IER.EQ.0) THEN - IER = BULL_SEARCH + 1 - ELSE - GO TO 800 - END IF - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - IF (SEARCH_MODE.EQ.4) THEN - CALL STR$UPCASE(DESCRIP1,FROM) - ELSE - IF (LEN(DESCRIP).EQ.TRIM(DESCRIP)) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - DESCRIP1 = INPUT(7:) - END IF - CALL STR$UPCASE(DESCRIP1,DESCRIP1) - ELSE - CALL STR$UPCASE(DESCRIP1,DESCRIP) - END IF - END IF - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (TRIM(SEARCH_STRING).EQ.LEN(DESCRIP).AND. - & DESCRIP1(:LEN(DESCRIP)).EQ.SEARCH_STRING).OR. - & (STREQ(DESCRIP1(:4),'RE: ').AND.DESCRIP1(5:).EQ. - & SEARCH_STRING(:MIN(TRIM(SEARCH_STRING),LEN(DESCRIP1)-4)) - & )))) THEN - IF (.NOT.NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - ELSE IF (NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - MATCHES = 0 - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE. - END DO - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THEN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I) - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR. - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - END IF - END DO - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE - FOUND = -1 - END IF - END IF - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULL - END DO - -800 FOUND = 0 - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - NEXT = .FALSE. - CALL READDIR(BULL_POINT,IER) - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - END IF - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - IF (.NOT.IER1) SEARCH_STRING = ' ' - NEXT = .FALSE. - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMD - - RETURN - END - - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE) - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRING - - OLD_MATCH = .FALSE. - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURN - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE. - RETURN - END IF - J = J + SEARCH_LEN(I) - END DO - - RETURN - END - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')') - RETURN - END IF -C -C Get the bulletin number to be undeleted. -C - - IF (INCMD(:3).EQ.'DIR') THEN - BULL_DELETE = BULL_POINT ! Delete the file we are reading - ELSE - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:11).LT.'1900') EXDATE(8:9) = '19' - IF (EXDATE(8:11).LT.'1995') EXDATE(8:9) = '20' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'21'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'21'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - IF (INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE IF (INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END - - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - CHARACTER*256 INPUT_OUT - CHARACTER*128 TEMP - - INPUT_OUT = ' ' - - I = 0 - - DO WHILE (I.LT.TRIM(INPUT)) - INPUT = INPUT(I+1:) - IF (I.GT.0) INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//',' - J = INDEX(INPUT,',') - IF (INDEX(INPUT,'(').LT.J.AND.INDEX(INPUT,')').GT.J) THEN - INPUT = INPUT(:INDEX(INPUT,'(')-1)//INPUT(INDEX(INPUT,')')+1:) - END IF - I = MINGT0(INDEX(INPUT,','),TRIM(INPUT)+1) - IF (INDEX(INPUT,',').EQ.I.AND.INDEX(INPUT(:I),'@').EQ.0) - & I = TRIM(INPUT)+1 - TEMP = INPUT(:I-1) - CALL ADD_PROTOCOL_SUB(TEMP) - INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//TEMP(:TRIM(TEMP)) - END DO - - INPUT = INPUT_OUT - - IF (ILEN.NE.0) ILEN = TRIM(INPUT) - - RETURN - END - - - - SUBROUTINE ADD_PROTOCOL_SUB(INPUT) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - END IF - - IF (LMAIL.EQ.0) THEN - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN - MAIL_PROTOCOL = MAILER - END IF - LMAIL = TRIM(MAIL_PROTOCOL) - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%' - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1 - RETURN - END IF - END IF - - I = INDEX(INPUT,'@') - IF (I.GT.0) THEN - INPUT = INPUT(:INDEX(INPUT(I:),' ')+I-2) - IF (INDEX(INPUT(I:),'(').GT.0) - & INPUT = INPUT(:INDEX(INPUT(I:),'(')+I-2) - END IF - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"' - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bulletin3.for b/decus/vmslt00a/bulletin/bulletin3.for deleted file mode 100644 index cf5b221..0000000 --- a/decus/vmslt00a/bulletin/bulletin3.for +++ /dev/null @@ -1,2518 +0,0 @@ -C -C BULLETIN3.FOR, Version 11/2/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2100' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2100' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - ILEN = 0 - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2100 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2100 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_TPU' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THEN - CALL EDT$EDIT('NL:',OUT) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT) - ELSE - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IF - END IF - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT - ELSE - WRITE(6,'('' Could not activate editor.'')') - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE) - - RETURN - END - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - NOW = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - IF (.NOT.NOW) NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.1000.AND.NEMPTY.GT.NBLOCK/10) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - CALL SYS$SETAST(%VAL(0)) - CALL REGISTER_BULLCP - IER1 = 1 - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - - BBOARD_LOOP = BBOARD_LOOP + 1 - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & (NEWS_LOOP.EQ.0.OR.NOW)) THEN - IF (NOW) THEN - CALL CREATE_PROCESS('BULLCP NEWS1') - ELSE - CALL CREATE_PROCESS('BULLCP NEWS') - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - - C = 0 - IF (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) THEN - CALL CREATE_PROCESS('BULLCP SMTP') - END IF - - NOW = .FALSE. - - NEWS_LOOP = NEWS_LOOP + 1 - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIME - CALL HIBER('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - DIMENSION NEW_SYSTEM_FLAG(FLONG) - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2)) - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER) - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - CALL SETUSER(USERNAME) - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAG - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - END DO - FOLDER_FLAG = FOLDER1_FLAG - FOLDER_NUMBER = 0 - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - CALL CLOSE_BULLUSER - ELSE - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DO - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IF - CLOSE (UNIT=REMOTE_UNIT) - END DO - END IF - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE HIBER(MIN) -C -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -C -C SUBROUTINE DELETE_EXPIRED_NEWS -C -C FUNCTION: -C -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - CHARACTER*4 GET_VMS_VERSION - - INTEGER TODAY(2),NEXT_EX_BTIM(2),NO_EXPIRE(2) - - CHARACTER*8 TODAY_KEY,TEMP - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - IF (NOW) THEN - IER = SYS$SETPRN('BULL NEWS1') - IF (.NOT.IER) CALL EXIT - IER = SYS$SETPRN('BULL NEWS') - IF (.NOT.IER) CALL EXIT - END IF - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - CALL SYS_BINTIM('-',TODAY) - - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - REMOTE_SET = 4 - -C -C A bug keeps messing up the last expired date key so that stored -C news groups do not get found. Someday when this is fixed, we can -C add code like this: -C -C INPUT = GET_VMS_VERSION() -C IF (INPUT(:2).EQ.'V5'.OR.INPUT(:2).EQ.'V4') VMSOLD = .TRUE..AND.NOW - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER).OR.(NOW.AND.IER.EQ.0.AND. - & (.NOT.BTEST(NEWS_F_FLAG,8).OR. - & COMPARE_BTIM(TODAY,NEWEST_EXBTIM).LT.0))) - IF (NOW) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - ELSE - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END IF - END DO - CALL NEWS_TO_FOLDER - - UNLOCK 7 - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - GO TO 1000 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,8)) GO TO 900 - - CALL OPEN_BULLDIR_SHARED - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0 - NDEL = -1 - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM) - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. - IF (NDEL.GT.NEWS_F_END) THEN - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1 - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (EXDATE(8:11).LT.'1995') THEN ! Deleted manually? - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) - EXTIME = ASCTIME(13:23) - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0 - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0 - UNLOCK 2 - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER) - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_START - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - IF (I.LE.F_NBULL) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0 - END DO - F_START = I - NEXT = .FALSE. - END IF - CALL READDIR(F_NBULL,IER) - IF (F_START.LT.F_NBULL.AND.(DN.OR.F_NBULL.EQ.IER)) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I) - I = I - 1 - IF (I.GE.F_START) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = I - END DO - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLDIR - END DO - -900 CALL CLOSE_BULLNEWS - -1000 IF (NOW.OR.IER.EQ.0) THEN - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.*]'//'*.' - INPUT = GET_VMS_VERSION() - CALL LIB$DAY_OF_WEEK(TODAY,DAY) - IF (DAY.NE.7) THEN - IER = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - IF (IER) THEN - DAY = 7 - CALL DELLNM('BULL_NEWS_CLEANUP') - END IF - END IF - IF (INPUT(:2).NE.'V5'.AND.INPUT(:2).NE.'V4') THEN - CONTEXT = 0 - DO WHILE (LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT)) - IER = CONV$RECLAIM(INPUT(:TRIM(INPUT))) - END DO - ELSE IF (DAY.EQ.7) THEN - REMOTE_SET = 4 - DIRLIST = .TRUE. - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(1000,IER) - CALL READ_FOLDER_FILE(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NO_EXPIRE) - DO WHILE (IER.EQ.0) - UNLOCK 7 - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - C = 0 - IF (LIB$FIND_FILE(BULLNEWSDIR_FILE - & (:TRIM(BULLNEWSDIR_FILE))//';1',INPUT,C)) THEN - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';2') - ELSE - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - END IF - CALL OPEN_BULLDIR_SHARED - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE,SHARED, - & BUFFERCOUNT=127, - & INITIALSIZE=(NEWSDIR_RECORD_LENGTH*F_COUNT)/512, - & STATUS='NEW',FORM='UNFORMATTED',DISPOSE='DELETE', - & RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,IOSTAT=IER, - & ORGANIZATION='INDEXED',RECORDTYPE='FIXED', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - END IF - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (2,IOSTAT=IER) NEWSDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - WRITE (9,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - ELSE - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY), - & %DESCR(EX_BTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & CALL COPY2(NEWEST_EXBTIM,EX_BTIM) - END IF - END IF - END DO - CLOSE (UNIT=9,DISPOSE='KEEP') - CALL CLOSE_BULLDIR_DELETE - CALL GET_MSGKEY(NEWEST_EXBTIM,TEMP) - IF (TEMP.NE.NEWS_F_EXPIRED_DATE) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - NEWS_F_EXPIRED_DATE = TEMP - CALL REWRITE_FOLDER_FILE(IER) - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - END IF - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - ELSE - IF (NO_EXPIRE(1).NE.NEWEST_EXBTIM(1).OR. - & NO_EXPIRE(2).NE.NEWEST_EXBTIM(2)) THEN - CALL GET_MSGKEY(NO_EXPIRE,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - ELSE - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - END IF - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';') - END DO - END IF - CALL READ_FOLDER_FILE(IER) - END DO - CALL CLOSE_BULLNEWS - END IF - DIRLIST = .FALSE. - NEWSLIST = .TRUE. - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - IER = .TRUE. - DO WHILE (IER) - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;') - IER = INDEX(FOLDER_FILE,']1JAN').EQ.0 - END DO - J = INDEX(FOLDER_FILE,']') - DECODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) THEN - DO I=1,10 - YEAR = YEAR - 1 - IF (YEAR.EQ.-1) YEAR = 99 - ENCODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) IER = LIB$DELETE_FILE(FOLDER_FILE(:J) - & //'*.*;*') - END DO - END IF - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IF - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'READ/NEW' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - - IER = 0 - CALL STRIP_HEADER(' ',-1,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.EQ.0) THEN - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP) - IF (STRIP.AND.INPUT(:5).EQ.'From:') INFROM = ' ' - END IF - END DO - -C -C If more than one folder has same BBOARD account, don't use the -C To: line to determine which folder to put the mail message in. -C - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - DUP = .FALSE. - DO WHILE (.NOT.DUP.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - DUP = FOLDER.NE.FOLDER1.AND.FOLDER_BBOARD.EQ.FOLDER1_BBOARD - END DO - IF (DUP.OR..NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - FOUND = .FALSE. - J = 0 - IF (DUP) J = 1 - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THEN - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - FOUND = INTO.EQ.F_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - END IF - FLEN = TRIM(F_BBOARD) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DO - END IF - END IF - END DO - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COM - END IF - - NUMHEAD = 0 - IF (NHEAD.GT.0) NUMHEAD = NHEAD + 1 - - IF (NUMHEAD.GT.0) THEN - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - SAVE_Q = HEADER_Q - SAVE_Q1 = HEADER_Q1 - NHEAD1 = NHEAD - HEADER_Q1 = 0 - ! INIT_MESSAGE_ADD_BBOARD reinits header so save it - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NUMHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - ELSE IF (NUMHEAD.EQ.1) THEN - INPUT = ' ' - LEN_INPUT = 1 - NUMHEAD = NUMHEAD - 1 - ELSE - CALL READ_QUEUE(%VAL(SAVE_Q),SAVE_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - USE_INFROM = .TRUE. - - NHEAD = NHEAD1 - HEADER_Q1 = SAVE_Q1 - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL SYS$SETAST(%VAL(1)) - IF (.NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) - & CALL NEWS2BULL(.FALSE.) - END IF - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE. - - LEN_BBOARD = LEN(BBOARD) - 1 - LEN_INPUT = TRIM(INPUT) - - DO I=1,LEN_INPUT-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND. - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND. - & (I.EQ.LEN_INPUT-LEN_BBOARD.OR. - & (INDEX('@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0 - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND. - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALPHA(IN) - - CHARACTER*(*) IN - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURN - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN - - BBOARD_NAME = FOLDER_DESCRIP(I+1:) - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!') - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DO - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - IER = 0 - DO WHILE (IER.EQ.0) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - END DO - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - IF (INDEX(IMAGENAME,';').GT.0) ILEN = INDEX(IMAGENAME,';') - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0) - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - IF (.NOT.IER.AND..NOT.DEL) THEN - CALL DELPRC('BULLCP NEWS',DEL) - IER = .NOT.DEL - ELSE - IER = .TRUE. - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI) -C -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL ADD_2_ITMLST(4,JPI$_ENQLM,%LOC(ENQLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF - END IF - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_ENQLM - CALL LIB$MOVC3(4,ENQLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2)) - - RETURN - END - - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - CHARACTER*4 FUNCTION GET_VMS_VERSION -C -C FUNCTION GET_VMS_VERSION -C -C FUNCTION: Gets VMS version -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER VERSION*4 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,SYI$_NODE_SWVERS,%LOC(VERSION)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - GET_VMS_VERSION = VERSION - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL OPEN_BULLDIR_SHARED - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DO - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - CALL CLOSE_BULLUSER - CALL CLOSE_BULLDIR - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAM - - DATA OBIO/0/,OCPU/0/,ODIO/0/ - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAM - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU)) - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IF - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1 - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - END IF - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND. - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIO - ODIO = DIO - OCPU = CPU - IER = 0 - RETURN - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IF - RETURN - END diff --git a/decus/vmslt00a/bulletin/bulletin4.for b/decus/vmslt00a/bulletin/bulletin4.for deleted file mode 100644 index bde2891..0000000 --- a/decus/vmslt00a/bulletin/bulletin4.for +++ /dev/null @@ -1,2349 +0,0 @@ -C -C BULLETIN4.FOR, Version 12/17/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(' ',-1,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - READ_HEAD = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) THEN ! No more records. - IF (STRIP.AND..NOT.READ_HEAD.AND.NHEAD.GT.0) THEN - IBLOCK = SBLOCK - ILEN = LINE_LENGTH+1 - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - READS = 0 - IF (SEEN_FROM) READS = READS + 1 - IF (SEEN_SUBJ) READS = READS + 1 - IF (MSG_SENT) READS = READS + 1 - IF (READS.GT.0) THEN - DO I=1,READS - ILEN = 0 - DO WHILE (ILEN.EQ.0) - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - END DO - END DO - END IF - STRIP = .FALSE. - ELSE - RETURN - END IF - END IF - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' '.AND..NOT.MAIL_POST()) THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - IF (STRIP.AND.BUFFER(:5).EQ.'From:') READ_HEAD = .TRUE. - IF (.NOT.STRIP.AND..NOT.READ_HEAD.AND.NHEAD.GT.0) THEN - IBLOCK = SBLOCK - ILEN = LINE_LENGTH+1 - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - READS = 0 - IF (SEEN_FROM) READS = READS + 1 - IF (SEEN_SUBJ) READS = READS + 1 - IF (MSG_SENT) READS = READS + 1 - IF (READS.GT.0) THEN - DO I=1,READS - ILEN = 0 - DO WHILE (ILEN.EQ.0) - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - END DO - END DO - END IF - END IF - ELSE - IF (.NOT.HEADER) THEN - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - STRIP = .FALSE. - END IF - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - IER = 0 - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - CALL OTS$CVT_L_TI (DAY,EXDATE(:2),%VAL(2)) - CALL OTS$CVT_L_TI (YEAR,EXDATE(8:11),%VAL(4)) - -C ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date -C ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - CHARACTER RESPONSE*4 - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - CALL STR$UPCASE(FOLDER,FOLDER) - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '', - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAX - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - RETURN - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACL - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_NAME = FOLDER - FOLDER_OWNER = FOLDER1_OWNER - - MAILTO = 0 - I = INDEX(FOLDER_DESCRIP,'<') - J = INDEX(FOLDER_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER_DESCRIP(I:),'@').LT.1.OR. - & INDEX(FOLDER_DESCRIP(I:),'@').GT.J-I+1).AND.NEWS_FEED()) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - I = INDEX(FOLDER_DESCRIP,'[') - J = INDEX(FOLDER_DESCRIP,']') - END IF - - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - IF (I.GT.0.AND.J.GT.I.AND..NOT.NEWS_FEED().AND.MAILTO.EQ.0 - & .AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - IF (CLI$GET_VALUE('COPY',FOLDER1,FLEN).NE.%LOC(CLI$_ABSENT)) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Unable to copy folder settings.'')') - ELSE - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - 1 - IF (.NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) THEN - LAST(1,FOLDER1_NUMBER+1) = LAST(1,FOLDER_NUMBER+1) - LAST(2,FOLDER1_NUMBER+1) = LAST(2,FOLDER_NUMBER+1) - REWRITE (9,IOSTAT=IER) TEMP_USER,LAST - END IF - END IF - END DO - CALL CLOSE_BULLINF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(SET_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SET_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(NOTIFY_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - END IF - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - END IF - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -C -C Description: -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -C -C SUBROUTINE CREATE_NEWS_FOLDER -C -C FUNCTION: Creates a new newsgroup. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME) - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF -C -C If file specified in command, read file. -C Else, read from the terminal. -C - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file -2010 FORMAT(A) - ICOUNT = ICOUNT + ILEN - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER, - & 'Adding newsgroup.') - CLOSE (UNIT=3) - - RETURN - -920 WRITE(6,1020) -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURN - -910 WRITE(6,1010) -1010 FORMAT (' No news group was added.') - CLOSE (UNIT=3) - RETURN - - END - - - - - SUBROUTINE INIT_COMPRESS - - IMPLICIT INTEGER (A-Z) - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127 - DO J=0,127 - A(J,I) = ' ' - END DO - END DO - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DO - - J = 1 - DO I=1,8 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=10,31 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=127,254 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - - RETURN - - ENTRY COMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.126) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.126) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:))) - IF (T(O:O).NE.' ') THEN - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND. - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1)) - C = C + 1 - K = K + 1 - END DO - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1) - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0) - O = O + 1 - ELSE - T(O:O) = IN(K:K) - IF (ICHAR(T(O:O)).LT.9.OR.(ICHAR(T(O:O)).GT.9.AND. - & ICHAR(T(O:O)).LT.32)) T(O:O) = ' ' - K = K + 1 - O = O + 1 - END IF - END DO - IF (K.EQ.L) THEN - T(O:O) = IN(K:K) - ELSE - O = O - 1 - END IF - - OUT = T - - RETURN - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1 - T(O:O) = IN(I+2:I+2) - END DO - I = I + 3 - ELSE - B = UNMAP(J) - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1 - T(O:O) = IN(I:I) - ELSE - O = O + 2 - T(O-1:O) = B - END IF - I = I + 1 - END IF - END DO - - OUT = T(:O) - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bulletin5.for b/decus/vmslt00a/bulletin/bulletin5.for deleted file mode 100644 index bc7c3a7..0000000 --- a/decus/vmslt00a/bulletin/bulletin5.for +++ /dev/null @@ -1,2516 +0,0 @@ -C -C BULLETIN5.FOR, Version 3/5/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3) THEN - CALL SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - RETURN - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - NODEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (NODEFAULT) THEN - IF (NOTIFY.NE.-1) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) THEN - CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - END IF - REWRITE(4) USER_HEADER - ELSE IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & (FOLDER1_NUMBER.EQ.0.AND.FOLDER1_BBOARD(:2).NE.'::')) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - IF (FOLDER1_NUMBER.NE.0.OR.FOLDER1_BBOARD(:2).NE.'::') THEN - ! Test is due to bug which changes folder number to zero - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG - IF (BTEST(FOLDER1_FLAG,2)) THEN - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAG - FOLDER_NUMBER = TEMP_NUMBER - END IF - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - CALL UPDATE_EXCLUDE - - CALL UPDATE_USERINFO - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET').OR.(INCMD(:3).EQ.'SEA') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & (F1_START.GT.0.OR.F_START.LE.F_NBULL)) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_COUNT = F1_COUNT - IF (F1_START.GT.0) THEN - IF (F1_NBULL.LT.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER-1.GE.F1_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - ELSE - F_NBULL = F1_NBULL - END IF - F_START = F1_START - ELSE - F_START = F_NBULL + 1 - END IF - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - REMOTE_SET_NEW = 1 - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - IF (COMMAND.AND.INCMD(:3).NE.'REP'.AND. - & INCMD(:3).NE.'DEL') HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER1) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.IER1.EQ.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11).AND.WRITE_ACCESS) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s news group.'')') - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP( - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE IF (REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - ELSE IF (REMOTE_SET.EQ.3.OR.REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN - WRITE (6,'('' Folder only accessible for reading.'')') - END IF - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THEN - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - BULL_PARAMETER = 'MARKED' - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - BULL_PARAMETER = 'SEEN' - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED' - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN' - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - WRITE(6,'('' WARNING: No '',A, - & '' messages found.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IF - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE. - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - LAST_FOLDER_NUMBER = FOLDER_NUMBER - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IF - - IF (TEST_NEWS(FOLDER1)) THEN - INCMD = 'SET NEWS ' - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL ' - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Access is limited.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0) - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,10)) THEN - WRITE (6,'('' POST_ONLY has been set.'')') - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THEN - WRITE (6,'('' COMPRESS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,15)) THEN - WRITE (6,'('' GATEWAY has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - IF (NEWS_FEED()) THEN - WRITE (6,'('' Last message fed by news group was: '',I)') F_LAST - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/, - & ' Description: ',A) -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/, - & ' Description: ',A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/ - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' ' - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. - STORED = .FALSE. - CLASS = .FALSE. - NEW = .FALSE. - PERM = .FALSE. - DEFA = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counter - NLINE = 1 - START = .FALSE. - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE. - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - CALL NEWS_LIST - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - END IF - COUNT = CLI$PRESENT('COUNT') - IF (COUNT) TOTAL_COUNT = 0 - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - NEW = CLI$PRESENT('NEWGROUPS') - CLASS = CLI$PRESENT('CLASS') - PERM = CLI$PRESENT('PERMANENT') - DEFA = CLI$PRESENT('DEFAULT') - IF (CLASS) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - ELSE IF (PERM) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE IF (DEFA) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER) - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER - FOLDER_COUNT = -1 - RETURN - ELSE - START = .TRUE. - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN) - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0 - FOLDER_COUNT = -1 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN - SUBNUM = -2 - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DECLARE_CTRLC_AST - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE. - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (PERM.OR.DEFA) THEN - IER = 1 - DO WHILE (INUM.LE.FOLDER_MAX.AND.IER.NE.0) - IF (INF_REC2(1,INUM).NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (ZEXT(INF_REC2(1,INUM)),IER) - END IF - INUM = INUM + 1 - END DO - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2 - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THEN - NEW_NEWS = FOLDER1_NUMBER - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP) - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)), - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - END IF - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - FSTATUS1 = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (.NOT.NEWS_TEST) THEN - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN - IER1 = 1 - MORE = .TRUE. - END IF - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DO - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1 - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THEN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))') - ELSE IF (CLASS) THEN - WRITE (6,'(1X,''Class'',/,1X,(''-''))') - ELSE IF (SUBSCRIBE) THEN - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,''Status'',7X, - & ''First Last'',/,1X,(''-''))') - END IF - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1 - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1.AND. - & FLAG.NE.100) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - ELSE - FSTATUS1 = ' ' - END IF - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNT - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0 - END IF - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '* '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - END IF - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IF - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER - IF (NEWS_TEST.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - CALL GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & FSTATUS1,IER,ACTIVE) - MORE = MORE.AND.FOUND - IF (MORE) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND.AND.FLAG.NE.1) FLAG = 100 - END IF - END DO - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - END IF - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNT - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSE - WRITE(6,1100) ! Else say there are more - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10) -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS.OR.CLI$PRESENT('CLASS')) THEN - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.' - END IF - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER ! Open folder file - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - CALL RESET_PROTECTION - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')') - RETURN - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0) - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER) - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE - CALL SET_FOLDER_FILE(0) - END IF - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INDEX(INPUT,'[').EQ.0.AND.INDEX(INPUT,']').GT.0.AND. - & ID(:1).EQ.'[') INPUT = ID(:TRIM(ID))//','//INPUT - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').GT.0) - & COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"'.AND.INDEX(INPUT(2:),'"').GT.0) - & COMMA = INDEX(INPUT(2:),'"') + 2 - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').EQ.0) COMMA = 0 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ILEN = TRIM(ID) - ELSE - ID = INPUT - INPUT = ' ' - ILEN = TRIM(ID) - END IF - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE IF (ID(:1).NE.'['.OR.INDEX(ID,']').NE.0) THEN - IF (ILEN.EQ.0) THEN - IER = SS$_IVIDENT - ELSE IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IF - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*256 ACLENT - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURN - - ENTRY WRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER_COM - END IF - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - DO I=1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - NEW_NEWS_ACCESS = - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS' - - RETURN - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C)) - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' ' - ELSE - FILE = FILE(:L) - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - F = LEN(FIND) - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & STAT,IER,ACTIVE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*(*) STAT,FOLDER_MATCH - - CHARACTER NEWS_ACCESS*132 - - FOUND = .FALSE. - STAR = INDEX(FOLDER_MATCH,'*') - ONE = STAR.EQ.0.AND.TRIM(FOLDER_MATCH).GT.0 - START = .FALSE. - IF (STAR.GT.1) - & START = FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1) - STARTNOW = START - - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - IF (ONE) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER_MATCH(:TRIM(FOLDER_MATCH)),IER) - FOLDER_MATCH = ' ' - ELSE IF (STARTNOW) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP - & (FOLDER_MATCH(:STAR-1),IER) - STARTNOW = .FALSE. - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - END IF - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - STAT(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - STAT = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(STAT(:1).NE.'x'.AND. - & .NOT.BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (ONE.OR..NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1) - ELSE - FOUND1 = .TRUE. - END IF - END IF - FOUND = FOUND1 - ELSE - FOUND = .TRUE. - END IF - ELSE IF (IER.EQ.0.AND.START) THEN - IF (FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1)) RETURN - END IF - IF (ONE) RETURN - END DO - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bulletin6.for b/decus/vmslt00a/bulletin/bulletin6.for deleted file mode 100644 index 92a761f..0000000 --- a/decus/vmslt00a/bulletin/bulletin6.for +++ /dev/null @@ -1,2835 +0,0 @@ -C -C BULLETIN6.FOR, Version 11/2/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - TRY = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.TRY.EQ.0) THEN - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - TRY = 1 - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL_NAME - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & BUFFERCOUNT=127, - & ORGANIZATION='INDEXED',IOSTAT=IER) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open file: '',A)') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - IF (UNIT.EQ.14) THEN - WRITE (6,'('' Database conversion in progress. Try later.'')') - ELSE - WRITE (6,'('' Please try again later.'')') - END IF - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - COMMON /NEWSLIST/ NEWSLIST - DATA NEWSLIST/0/ - - COMMON /DIRLIST/ DIRLIST - DATA DIRLIST/0/ - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - LUN = 2 - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL_NAME - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & BUFFERCOUNT=127, - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - END IF - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) WRITE(6,'(1X,A)') - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1))) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULL - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LAST - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMIT - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLNEWSDIR - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($FORIOSDEF)' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*180 TEMP - - CHARACTER BUFFER*12,DATETIME*24 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - CALL OPEN_BULLNEWS - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=180/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & BUFFERCOUNT=127,KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR]') - IF (.NOT.IER1) GO TO 900 - - NEW_FOLDER_NUMBER = 0 - - DO WHILE (IER.EQ.0) - READ (2,IOSTAT=IER) TEMP - IF (GET_INTEGER(%REF(TEMP)).NE.NEW_FOLDER_NUMBER) THEN - IF (NEW_FOLDER_NUMBER.NE.0) CLOSE (UNIT=9,DISPOSE='KEEP') - NEW_FOLDER_NUMBER = GET_INTEGER(%REF(TEMP)) - CALL SET_BULLNEWSDIR_FILE(NEW_FOLDER_NUMBER) - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE, - & STATUS='UNKNOWN',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) GO TO 900 - END IF - NEWS_MSG_NUM = GET_INTEGER(%REF(TEMP(5:))) - NEWS_MSG_BTIM_KEY = TEMP(13:) - NEWS_EX_BTIM_KEY = TEMP(89:) - NEWS_MSGID = TEMP(21:) - CALL COPY2(MSG_BTIM,%REF(TEMP(97:))) - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL LIB$MOVC3(76,%REF(TEMP(105:)),NEWS_BLOCK) - - WRITE (9,IOSTAT=IER1) NEWSDIR_ENTRY - END DO - - CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - - CALL RESET_PROTECTION - - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - - IER = LIB$RENAME_FILE(BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - & ,'BULLNEWSDIR.OLD') - - WRITE (6,'('' BULLNEWSDIR.DAT has been renamed to '', - & '' BULLNEWSDIR.OLD and may now be deleted.'')') - - RETURN - -900 CALL RESET_PROTECTION - - CALL CLOSE_BULLNEWS - - WRITE(6,'('' ERROR: Cannot convert BULLNEWSDIR.DAT'')') - IF (IER.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - - END - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(81:84) = BUFFER(85:) - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL RESET_PROTECTION - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - IF (ASK_SIZE.EQ.184) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST) - ELSE - F_LAST = 0 - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LAST - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER)) - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0 - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -C -C SUBROUTINE CONVERT_BULLNEWS -C -C FUNCTION: Converts bulletin NEWS file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. '' - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0 - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE) - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0 - NEWS_F_END = 0 - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108) - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:) - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1 - IF (LMOVE.LE.0) THEN - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP - ELSE - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE)) - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) - END IF - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SET_PROTECTION - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL RESET_PROTECTION - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXT - - COMMON /KEEPLOCK/ KEEPLOCK - DATA KEEPLOCK/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /THREAD/ THREAD - - CHARACTER*4 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSE - DIR_NUM = 0 - END IF - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURN - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 250 blocks (1000 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.1000.AND.NEMPTY.GT.NBLOCK/10 - & .AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLFIL - CALL OPEN_BULLDIR - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPFIL','*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1') - END DO - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULL*','*.*;1') - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - NEMPTY = 0 - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - CALL OPEN_BULLFIL - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEYGE=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0.AND.ICOUNT.EQ.F_START) THEN - READ(2,KEYGT=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.EQ.0) ICOUNT = NEWS_MSG_NUM - END IF - END IF - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND. - & MSG_NUM.GT.F_START) THEN - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER,IER2) - F_START = MSG_NUM - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IF - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THEN - ICOUNT = MSG_NUM - BULLETIN_NUM = ICOUNT - END IF - END IF - ELSE - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 - END IF - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IF (REMOTE_SET.NE.4) CALL STR$UPCASE(FROM,FROM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IF - - IF (IER.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1 - ELSE IF (THREAD) THEN - DUMMY = INCLUDE_MSG(FROM,DESCRIP) - END IF - END IF - END IF - - RETURN - - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM) - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z) - - INTEGER TEMP - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I) - END DO - - RETURN - END - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/1/ - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.2.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.2.AND.MSG_NUM.NE.0) THEN - IF (MSG_NUM.GT.NEWS_F_END) THEN - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36 - UNLOCK 2 - END IF - END IF - END IF - ELSE - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - IER = 0 - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10 - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY),%DESCR(EX_BTIM)) - IF (POSTTIME) THEN - CALL GET_MSGKEY(%REF(NEWS_POST_KEY),%DESCR(MSG_BTIM)) - CALL CONVERT_FROM_GMT(MSG_BTIM) ! Assume stored is GMT - END IF - DESCRIP = NEWS_DESCRIP - FROM = NEWS_FROM - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IF - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11) - EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME(:11) - TIME = DATETIME(13:23) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*52 BULLDIR_HEADER1 - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER1 - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - ELSE - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IF (BULLETIN_NUM.NE.NEWS_F_END+1) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END DO - END IF - ELSE - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IF - IF (REMOTE_SET.EQ.4.AND. - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN - CALL SPECIAL_NEWSDIR_ENTRY(IER) - ELSE IF (IER.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEN - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*140 TEMP - - DIMENSION BTIM(2) - - READ (2,KEYID=3,KEY=NEWS_POST_KEY,IOSTAT=IER) TEMP - DO WHILE (IER.EQ.0.AND.NEWS_POST_KEY.EQ.TEMP(57:64)) - IF (NEWS_MSGID.EQ.TEMP(21:56)) THEN - IER = 2 - RETURN - END IF - READ (2,IOSTAT=IER) TEMP - END DO - -10 IER1 = 0 - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=0,KEYGT=NEWS_F_END, - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - DO WHILE (IER1.EQ.0) - CALL LIB$MOVC3(4,%REF(INPUT),FNUM) - CALL GET_MSGKEY(%REF(INPUT(13:)),%DESCR(BTIM)) - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IF - F_COUNT = F_COUNT + 1 - CALL LIB$MOVC3(4,%REF(INPUT),NEWS_F_END) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - END DO - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IF - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSE - F_COUNT = F_COUNT + 1 - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,MSG_BTIM) - ELSE - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - END IF - - IF (LOCAL_POST) THEN - CALL SYS_BINTIM(DATE//' '//TIME - & (:TRIM(TIME)-2)//'00',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP - NEWS_FROM = FROM - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH - NEWS_MSG_NUM = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,NEWS_MSG_BTIM_KEY) - CALL GET_MSGKEY(EX_BTIM,NEWS_EX_BTIM_KEY) - ELSE - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - - RETURN - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KEYID/ NEWS_KEYID - - COMMON /KEEPLOCK/ KEEPLOCK - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 2 - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - CALL READDIR_KEYGE(NDEL) - KEEPLOCK = .FALSE. - NEWS_KEYID = 1 - - RETURN - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII)) - IF (ACLSTR(START_ID:START_ID).NE.','.AND. - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DO - IF (ASCII) THEN - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl output - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C -C SUBROUTINE COPY_ACL1 -C -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - ! Read input file acl - - IF (.NOT.IER) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./ - - IF (CHECKED) RETURN - - CHECKED = .TRUE. - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C) - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORY - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - END IF - - CALL CHECK_DIR(FOLDER_DIRECTORY,.FALSE.) - CALL CHECK_DIR(NEWS_DIRECTORY,.FALSE.) - - CALL ADD_DIRECTORIES - - RETURN - END - - - - SUBROUTINE ADD_DIRECTORIES - - INCLUDE 'BULLFILES.INC' - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE) - - RETURN - END - - - - LOGICAL FUNCTION CHECK_DIR(DIRECTORY,LIBRARY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - CHECK_DIR = PRESENT(BULLUSER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLFOLDER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLINF_FILE,DIRECTORY,TEST) - - IF (CHECK_DIR) THEN - IF (SYS_TRNLNM(DIRECTORY,TEST)) DIRECTORY = TEST - RETURN - END IF - - TEST = ' ' - - IF (INDEX(DIRECTORY,']').EQ.0) THEN - CALL SYS_TRNLNM(DIRECTORY,TEST1) - ELSE - TEST1 = DIRECTORY - END IF - - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - - IF (.NOT.LIBRARY.AND.TEST.EQ.' ') THEN - IER = SYS_TRNLNM_SYSTEM(DIRECTORY,TEST) - IF (.NOT.IER.AND.TEST1.EQ.DIRECTORY) RETURN - END IF - - IF (TEST.NE.TEST1) THEN - IF (LIBRARY) THEN - WRITE (6,'('' ERROR: Not a valid library. '')') - RETURN - END IF - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER) - CLOSE(UNIT=3,STATUS='DELETE') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)') - & TEST1(:TRIM(TEST1)) - CALL EXIT - END IF - DIRECTORY = TEST1 - ELSE - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - CHECK_DIR = .TRUE. - END IF - - RETURN - END - - - - - LOGICAL FUNCTION PRESENT(FILE,DIR,TEST) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILE,DIR,TEST - - FILE = FILE(INDEX(FILE,':')+1:) - FILE = FILE(INDEX(FILE,']')+1:) - IF (INDEX(DIR,':').EQ.0.AND.INDEX(DIR,'[').EQ.0.AND. - & INDEX(DIR,'<').EQ.0) DIR = DIR(:TRIM(DIR))//':' - C = 0 - PRESENT = LIB$FIND_FILE(DIR(:TRIM(DIR))//FILE,TEST,C) - - RETURN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:) - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:) - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':' - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURN - END - - - - SUBROUTINE SET_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CALL CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P) - - IF (CHECK_DIR(BULL_PARAMETER,.TRUE.)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - CALL UPDATE_USERINFO - CALL OPEN_USERINFO - INCMD = 'SHOW' - CALL UPDATE_READ(0) - END IF - - RETURN - END - - - - SUBROUTINE SHOW_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (CLI$PRESENT('ALL')) THEN - IER = 1 - N = 1 - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',BULL_PARAMETER) - IF (IER) THEN - IF (N.EQ.1) THEN - WRITE (6,'('' The following are valid libraries:'')') - N = 0 - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER - END IF - END DO - IF (N.EQ.1) WRITE (6,'('' No libraries are present.'')') - ELSE - WRITE (6,'('' Present library is: '',A)') - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - END IF - - RETURN - END - - - - SUBROUTINE SET_BULLNEWSDIR_FILE(FN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - BULLNEWSDIR_FILE = ' ' - - ENCODE(6,'(I6)',BULLNEWSDIR_FILE) FN - BULLNEWSDIR_FILE = BULLNEWSDIR_FILE(FIRST_ALPHA(BULLNEWSDIR_FILE):) - L = TRIM(BULLNEWSDIR_FILE) - - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.'// - & BULLNEWSDIR_FILE(:L-3)//']'// - & BULLNEWSDIR_FILE(L-2:TRIM(BULLNEWSDIR_FILE))//'.' - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bulletin7.for b/decus/vmslt00a/bulletin/bulletin7.for deleted file mode 100644 index d845a85..0000000 --- a/decus/vmslt00a/bulletin/bulletin7.for +++ /dev/null @@ -1,2374 +0,0 @@ -C -C BULLETIN7.FOR, Version 11/3/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - CHARACTER FOLDER_NAME_SAVE*80 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER_NAME_SAVE.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - FOLDER_NAME_SAVE = FOLDER_NAME - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCALPOST/ LOCAL_POST - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - IF (.NOT.LOCAL_POST) THEN - DATE = NEWEST_DATE - TIME = NEWEST_TIME - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIR - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /OUTPUT/ REASSIGNED - LOGICAL REASSIGNED - DATA REASSIGNED /.FALSE./ - - CALL DISABLE_PRIVS ! Disable SYSPRV - - IF (.NOT.REASSIGNED) THEN - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - END IF - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - IF (INDEX(INPUT,']').GT.0) THEN - SYS_TRNLNM = .FALSE. - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX)) - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1 - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IF - - RETURN - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - IER1 = 0 - ELSE - IF (IER.GT.0) THEN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0 - CALL SET_FOLDER_FILE(0) - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER BUFFER*128 - - CALL OPEN_BULLDIR - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR;-1') - END DO - - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPFIL;-1') - END DO - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULL*','*.*;1') - NEMPTY = 0 - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - CALL CLOSE_BULLDIR - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = -1 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0) - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULL*','*.*;1') - - CALL OPEN_BULLDIR - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.-1) THEN - NEMPTY = 0 - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - - CALL CLOSE_BULLDIR - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*12 DATE_SAVE,EXDATE_SAVE - CHARACTER*12 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - END IF - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER PSCAN$_BEGIN = '00000000'X - PARAMETER PSCAN$_ACCOUNT = '00000001'X - PARAMETER PSCAN$_AUTHPRI = '00000002'X - PARAMETER PSCAN$_CURPRIV = '00000003'X - PARAMETER PSCAN$_GRP = '00000004'X - PARAMETER PSCAN$_HW_MODEL = '00000005'X - PARAMETER PSCAN$_HW_NAME = '00000006'X - PARAMETER PSCAN$_JOBPRCCNT = '00000007'X - PARAMETER PSCAN$_JOBTYPE = '00000008'X - PARAMETER PSCAN$_MASTER_PID = '00000009'X - PARAMETER PSCAN$_MEM = '0000000A'X - PARAMETER PSCAN$_MODE = '0000000B'X - PARAMETER PSCAN$_NODE_CSID = '0000000C'X - PARAMETER PSCAN$_NODENAME = '0000000D'X - PARAMETER PSCAN$_OWNER = '0000000E'X - PARAMETER PSCAN$_PRCCNT = '0000000F'X - PARAMETER PSCAN$_PRCNAM = '00000010'X - PARAMETER PSCAN$_PRI = '00000011'X - PARAMETER PSCAN$_PRIB = '00000012'X - PARAMETER PSCAN$_STATE = '00000013'X - PARAMETER PSCAN$_STS = '00000014'X - PARAMETER PSCAN$_TERMINAL = '00000015'X - PARAMETER PSCAN$_UIC = '00000016'X - PARAMETER PSCAN$_USERNAME = '00000017'X - PARAMETER PSCAN$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER PSCAN$_END = '00000019'X - PARAMETER PSCAN$k_type = '00000081'X - PARAMETER PSCAN$M_OR = '00000001'X - PARAMETER PSCAN$M_BIT_ALL = '00000002'X - PARAMETER PSCAN$M_BIT_ANY = '00000004'X - PARAMETER PSCAN$M_GEQ = '00000008'X - PARAMETER PSCAN$M_GTR = '00000010'X - PARAMETER PSCAN$M_LEQ = '00000020'X - PARAMETER PSCAN$M_LSS = '00000040'X - PARAMETER PSCAN$M_PREFIX_MATCH = '00000080'X - PARAMETER PSCAN$M_WILDCARD = '00000100'X - PARAMETER PSCAN$M_CASE_BLIND = '00000200'X - PARAMETER PSCAN$M_EQL = '00000400'X - PARAMETER PSCAN$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER PSCAN$S_OR = 1 - PARAMETER PSCAN$V_OR = 0 - PARAMETER PSCAN$S_BIT_ALL = 1 - PARAMETER PSCAN$V_BIT_ALL = 1 - PARAMETER PSCAN$S_BIT_ANY = 1 - PARAMETER PSCAN$V_BIT_ANY = 2 - PARAMETER PSCAN$S_GEQ = 1 - PARAMETER PSCAN$V_GEQ = 3 - PARAMETER PSCAN$S_GTR = 1 - PARAMETER PSCAN$V_GTR = 4 - PARAMETER PSCAN$S_LEQ = 1 - PARAMETER PSCAN$V_LEQ = 5 - PARAMETER PSCAN$S_LSS = 1 - PARAMETER PSCAN$V_LSS = 6 - PARAMETER PSCAN$S_PREFIX_MATCH = 1 - PARAMETER PSCAN$V_PREFIX_MATCH = 7 - PARAMETER PSCAN$S_WILDCARD = 1 - PARAMETER PSCAN$V_WILDCARD = 8 - PARAMETER PSCAN$S_CASE_BLIND = 1 - PARAMETER PSCAN$V_CASE_BLIND = 9 - PARAMETER PSCAN$S_EQL = 1 - PARAMETER PSCAN$V_EQL = 10 - PARAMETER PSCAN$S_NEQ = 1 - PARAMETER PSCAN$V_NEQ = 11 - BYTE %FILL (2) - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -C -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -C -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE)) -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1 -C UJPIMODE = -1 -C TERMINAL(1:1) = CHAR(0) -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./ - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - CHANGED = .FALSE. - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time warp - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - LAST(1,I) = TODAY_BTIM(1) - LAST(2,I) = TODAY_BTIM(2) - CHANGED = .TRUE. - END IF - END DO - IF (CHANGED) REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - DO I=1,FOLDER_MAX - DO J=1,2 - LAST(J,I) = LAST_READ_BTIM(J,I) - END DO - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.EQ.0) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - WRITE (9,IOSTAT=IER) USERNAME,INF_REC - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIM - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0 - LAST_SYS_BTIM(2,I) = 0 - END DO - END IF - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -C -C SUBROUTINE READ_NEWS_USERINFO -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) NAME - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2))) - END IF - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READ - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - EQUIVALENCE (OLD_LAST_NEWS_READ2(1,1),OLD_LAST_NEWS_READ(1,1)) - INTEGER*2 OLD_LAST_NEWS_READ2(4,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF = (LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF1 = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF1 = (LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF2 = .FALSE. - GO TO 10 - - ENTRY UPDATE_USERINFO_NEWS_ALWAYS - DIFF2 = .TRUE. - -10 IF (.NOT.DIFF2) THEN - DO I=1,FOLDER_MAX - DIFF2 = (LAST_NEWS_READ(1,I).NE. - & OLD_LAST_NEWS_READ(1,I)).OR. - & (LAST_NEWS_READ(2,I).NE. - & OLD_LAST_NEWS_READ(2,I)).OR.DIFF2 - END DO - END IF - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHARED - - IF (DIFF) THEN - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & LAST(J,I) = LAST_READ_BTIM(J,I) - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - END IF - - IF (DIFF1) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & OLD_LAST_SYS_BTIM(J,I) = LAST_SYS_BTIM(J,I) - LAST_SYS_BTIM(J,I) = OLD_LAST_SYS_BTIM(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF - - IF (DIFF2) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=2,1,-1 - IF (I.EQ.NEWS_FIND_SUBSCRIBE().OR. - & OLD_LAST_NEWS_READ2(1,I).NE.LAST_NEWS_READ2(1,I)) - & OLD_LAST_NEWS_READ(J,I) = LAST_NEWS_READ(J,I) - LAST_NEWS_READ(J,I) = OLD_LAST_NEWS_READ(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - CHARACTER*24 TIME1 - - TIME1 = TIME(FIRST_ALPHA(TIME):) - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:) - END DO - - IF (TIME1.EQ.'-') TIME1 = '-- :' - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder info - ELSE IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND. - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A)') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - IF (INCMD(:4).EQ.'SHOW') THEN - SAVE_FOLDER_Q1 = 0 - RETURN - END IF - IF (NEW_MESS.OR.NEWS_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1 - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0 - END IF - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE(IER) - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER) - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bulletin8.for b/decus/vmslt00a/bulletin/bulletin8.for deleted file mode 100644 index a195588..0000000 --- a/decus/vmslt00a/bulletin/bulletin8.for +++ /dev/null @@ -1,2165 +0,0 @@ -C -C BULLETIN8.FOR, Version 10/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND. - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0, - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - IF (NUM.GT.0) THEN - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - END IF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE. - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THEN - ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX)) - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV) - END IF - END IF - END IF - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND. - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24 - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM) - P = 4 + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (BTEST(FOLDER_FLAG,14)) FROM = 'ANONYMOUS' - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - IF (NEWS_FEED()) THEN - BULL_POINT = NBULL - INCMD = 'COPY/ORIGINAL/LOCAL '// - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1 - & :INDEX(FOLDER_DESCRIP,'>')-1) - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - END IF - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT) - P = 4 + P - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER) - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - CALL CLOSE_BULLFOLDER - END IF - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = -1 - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV) - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - INIT = INIT + 2 - IF (INIT.GT.60) THEN - WRITE (6,'('' Bulletin aborting due to record lock'', - & '' problem. Alert system administrator.'')') - CALL EXIT - END IF - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /WINDOW/ WINDOW - - CHARACTER*80 MESSAGE - - WINDOW = 1 - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - - COMMON /TEMP_INPUT/ NODE_TEMP - CHARACTER NODE_TEMP*256 - - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,PASSWORD*32,TEMP_USER*12 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - RETURN - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C -C SUBROUTINE SET_FOLDER_FILE -C -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE, -C if = 1, set FOLDER1_FILE -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NUM.EQ.0) THEN - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE) - END IF - - RETURN - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C -C SUBROUTINE SET_FILE -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILE - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - ELSE - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)// - & '.]' - END IF - - RETURN - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12 - - DATA UPDATE/.FALSE./, JUST_NAME/.FALSE./ - - UPDATE = .TRUE. - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_UPDATE - - UPDATE = .NOT.UPDATE - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_NAME - - JUST_NAME = .NOT.JUST_NAME - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATE - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):) - - M = INDEX(FILDATE,'-') - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3) - - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN - FOLDER_FILE = FOLDER1_FILE - IF (JUST_NAME) THEN - JUST_NAME = .FALSE. - RETURN - END IF - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THEN - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHARED - END IF - END IF - - JUST_NAME = .FALSE. - - IF (UPDATE) THEN - READ (1'1) NBLOCK - REWRITE (1) NBLOCK + LENGTH - UPDATE = .FALSE. - END IF - - RETURN - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THEN - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE - MINGT0 = MIN(I,J) - END IF - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bulletin9.for b/decus/vmslt00a/bulletin/bulletin9.for deleted file mode 100644 index 0a54525..0000000 --- a/decus/vmslt00a/bulletin/bulletin9.for +++ /dev/null @@ -1,2474 +0,0 @@ -C -C BULLETIN9.FOR, Version 4/8/98 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - -C IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN -C WRITE (6,'(A)') ' A new BULLETIN executable has been '// -C & 'installed since your last use.' -C WRITE (6,'(A)') -C & ' Type HELP NEW_FEATURES for help on any new features.' -C END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - EXTERNAL BULLETIN_SUBCOMMANDS - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IF - END IF - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE - WRITE (6,1000) - END IF - IF (.NOT.SUBSCRIBE) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - DO I = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IF - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1 - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THEN - NUM_FOLDER = 0 - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1), - & 'HIT any key for next page....') - END IF - END DO - IF (NUM_FOLDERS.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE IF (INEW) THEN - NEW = INEW - IF (REMOTE_SET.GE.3) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSE - CALL FIND_NEWEST_BULL - END IF - END IF - - IF (INCMD(:4).NE.'INDE') THEN - IER = CLI$DCL_PARSE('INDEX',BULLETIN_SUBCOMMANDS) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1010 FORMAT (' The following folders with new messages are present'/) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - FOLDER_PRESENT = CLI$PRESENT('FOLDER') - - IF (FOLDER_PRESENT) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z') - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME) - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURN - END IF - END IF - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid date specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURN - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN - END IF - ELSE IF (SINCE) THEN - IF (BULL_POINT.EQ.0) THEN - WRITE (6,'('' ERROR: No current message.'')') - RETURN - ELSE IF (NEWS) THEN - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THEN - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSE - STARTMSG = 1 - END IF - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - ELSE - IF (NEWS) THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1 - END DO - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND. - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0 - NEWSMSG = 1 - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THEN - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0 - ELSE - FOUND = .FALSE. - END IF - IF (FOUND.AND.NEWS) THEN - WRITE (6,'(1X,A,'' latest message read '', - & I,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'', - & '' to specified folder.'')') - END IF - END IF - IF (.NOT.ALL) THEN - IF (IER.NE.0) THEN - WRITE (6,'('' User info does not exist.'')') - END IF - IER = 2 - END IF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - CALL CLOSE_BULLUSER - ELSE - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - CALL CLOSE_BULLUSER - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - DATA SCRTYPE/-1/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESS - - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - IER1 = 1 - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER2) THEN - CALL ADD_DIRECTORIES - ELSE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IF - END IF - END DO - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - LDESCR = 0 - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - IF (NEWS_FEED()) THEN - CALL STRIP_HEADER(' ',-1,IER) - END IF - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - MAIL = BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0 - IF (MAIL) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.MAIL' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0 - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - ELSE IF (NEWS_FEED().OR.LEN_FROM.EQ.0 - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - SCRTYPE = 0 - SCRNAME = 'SYS$LOGIN:BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - IF (IER1.NE.0) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW') - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /STORED/ STORED - - CHARACTER*256 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.NEWS_FEED().AND. - & .NOT.BTEST(FOLDER_FLAG,11).AND..NOT.STORED) CLOSE (UNIT=3) - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - CHARACTER*24 TODAY - - COMMON /STORED/ STORED - DATA STORED /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THEN - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER - RETURN - ELSE IF (BUFFER(:5).EQ.'From:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE. - OLD_BUFFER_FROM = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Reply-To:') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - END IF - STORED = .TRUE. - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STORED - STORED = .FALSE. - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3) - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - IF (LEN_BUFFER.GT.0) THEN - IF (.NOT.TEXT) THEN - IF (.NOT.NEWS_FEED()) THEN - TEXT = .TRUE. - ELSE - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - END IF - IF (TEXT) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - ELSE - IF (TEXT) WRITE (3,'(A)') ' ' - END IF - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF (.NOT.STORED.AND. - & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') ' ' - CALL STRIP_HEADER(' ',-1,IER) - END IF - CALL STORE_BULL(1,' ',NBLOCK) - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2 - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-') - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO - INEXDATE = .TRUE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - IF (NEWS_FEED().AND..NOT.TEXT) THEN - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - ELSE - TEXT = .TRUE. - END IF - IF (.NOT.STORED.AND. - & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAY - - CHARACTER USER_SAVE*12,PROC_SAVE*12 - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1 - FIRST_BREAK = .FALSE. - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - SCRTYPE = -1 - END IF - RETURN - END IF - - EXTIME = '00:00:00.00' - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2100' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - IF (SCRTYPE.EQ.0.AND.NEWS_FEED()) THEN - FOLDER1_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,'>')-1) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL NEWS_POST('ignore',.TRUE.,IER,INDESCRIP) - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3) - END IF - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.EQ.0) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL GETUSER(PROC_SAVE) - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME) - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARD - END IF - IF (.NOT.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(SCRNAME,INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - ELSE - CALL RESPOND_MAIL(SCRNAME,INPUT, - & INDESCRIP(:LEN_DESCRP),STATUS) - END IF - CALL LIB$DELETE_FILE(SCRNAME(:TRIM(SCRNAME))//';*') - CALL SETUSER(PROC_SAVE) - USERNAME = USER_SAVE - ELSE - CLOSE (UNIT=3) - END IF - ELSE IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - END IF - - CALL STRIP_HEADER(' ',-1,IER) - - SCRTYPE = -1 - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - -C IF (.NOT.NEWS_FEED()) THEN - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) -C END IF - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(FROM,INFROM,LEN_INFROM) - - RETURN - END - - - SUBROUTINE GET_FROM(FROM,INFROM1,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INFROM1,FROM - - CHARACTER*256 INFROM - - INFROM = INFROM1 - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - I = INDEX(INFROM,'<') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<')+1:) ! personal-name - END IF - - I = INDEX(INFROM,'(') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'(')+1:) ! personal-name (net-name) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR.INFROM(I:I).LE.' '.OR. - & INFROM(I:I).GE.CHAR(127).OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) - I = I + 1 - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1 - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND.INFROM(I:I).GT.' '.AND. - & INFROM(I:I).LT.CHAR(127).AND. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.126) - & INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN -C IF (LEN_DESCRP.GT.LEN(DESCRIP).AND..NOT.NEWS_FEED()) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - CALL INIT_QUEUE(HEADER_Q1,INPUT) - IF (BLEN.EQ.-1) THEN - CALL INIT_QUEUE(HEADER_Q1,INPUT) - HEADER_Q = HEADER_Q1 - NHEAD = 0 - END IF - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - END IF - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) THEN ! of previous header line - IF (LAST_NEWSGROUPS) THEN - NEWSGROUPS = NEWSGROUPS(:TRIM(NEWSGROUPS))//BUFFER(2:) - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - END IF - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - LAST_NEWSGROUPS = .FALSE. - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.' - END IF - ELSE IF (BUFFER(:11).EQ.'Newsgroups:') THEN - NEWSGROUPS = BUFFER(13:) - LAST_NEWSGROUPS = .TRUE. - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - - RETURN - END - - - - - SUBROUTINE SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_NEWS_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified news group -C Note: If NOTIFY READNEW and BRIEF = 0, it is either news -C group removal or SET SUBSCRIBE command. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - ALL = .FALSE. - DEFAULT = 1 - NODEFAULT = 0 - SUB = ABS(BRIEF)+ABS(NOTIFY)+ABS(READNEW).EQ.0 - - IF (NOTIFY.EQ.1.AND.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: /NOTIFY is invalid with non-stored'', - & '' news group.'')') - RETURN - END IF - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - IF (CLI$PRESENT('NOPERMANENT').OR.CLI$PRESENT('PERMANENT').OR. - & (SUB.AND.(NODEFAULT.OR.CLI$PRESENT('NOPERMANENT')))) THEN - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (SUB) DEFAULT = 1 - ELSE IF (CLI$PRESENT('NOPERMANENT').OR.NODEFAULT) THEN - IF (NOTIFY.GE.0) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - IF (SUB) - & CALL SET_NEWS_FLAG(IER,-1,-1,-1) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*PERM ',INF_REC - END IF - END IF - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - IF (NODEFAULT.AND.SUB) THEN - NOTIFY = -1 - READNEW = -1 - BRIEF = -1 - END IF - IF (DEFAULT.OR.NODEFAULT) THEN - IF (NODEFAULT.AND..NOT.SUB) THEN - IF (NOTIFY.NE.-1) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - ELSE - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*DEFAULT ',INF_REC - END IF - END IF - IF ((ALL.OR.(SUB.AND.INCMD(:3).NE.'SET')).AND.IER.EQ.0) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY=TEMP_USER,IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - - RETURN - END - - - - - SUBROUTINE READ_INF_REC - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - RETURN - - ENTRY SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & INF_REC2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1.AND.TEMP_USER(:1).EQ.'*') THEN - WRITE (6,'('' ERROR: You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - IER = 0 - RETURN - END IF - - IF (INF_REC2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IF (NOTIFY+READNEW+BRIEF.EQ.-3) THEN - DO J=I,FOLDER_MAX-2 - CALL COPY2(INF_REC(1,J),INF_REC(1,J+1)) - END DO - END IF - IER = 1 - RETURN - END IF - - IF (NOTIFY+READNEW+BRIEF.EQ.-3) RETURN - - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(INF_REC2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(INF_REC(1,J),INF_REC(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - INF_REC2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - INF_REC2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - INF_REC(2,J) = F_START - 1 - ELSE - INF_REC2(2,J) = 0 - INF_REC(2,J) = F_NBULL - END IF - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IER = 1 - RETURN - END IF - END DO - - RETURN - END diff --git a/decus/vmslt00a/bulletin/bullfiles.inc b/decus/vmslt00a/bulletin/bullfiles.inc deleted file mode 100644 index 0df9866..0000000 --- a/decus/vmslt00a/bulletin/bullfiles.inc +++ /dev/null @@ -1,39 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vmslt00a/bulletin/bullfolder.inc b/decus/vmslt00a/bulletin/bullfolder.inc deleted file mode 100644 index b3d94c8..0000000 --- a/decus/vmslt00a/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vmslt00a/bulletin/bullmain.cld b/decus/vmslt00a/bulletin/bullmain.cld deleted file mode 100644 index bb3a4b5..0000000 --- a/decus/vmslt00a/bulletin/bullmain.cld +++ /dev/null @@ -1,34 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vmslt00a/bulletin/bullnews.inc b/decus/vmslt00a/bulletin/bullnews.inc deleted file mode 100644 index fcbc81f..0000000 --- a/decus/vmslt00a/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vmslt00a/bulletin/bullstart.com b/decus/vmslt00a/bulletin/bullstart.com deleted file mode 100644 index ed1779c..0000000 --- a/decus/vmslt00a/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vmslt00a/bulletin/bulluser.inc b/decus/vmslt00a/bulletin/bulluser.inc deleted file mode 100644 index 5760e92..0000000 --- a/decus/vmslt00a/bulletin/bulluser.inc +++ /dev/null @@ -1,53 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vmslt00a/bulletin/changes.txt b/decus/vmslt00a/bulletin/changes.txt deleted file mode 100644 index e231fb3..0000000 --- a/decus/vmslt00a/bulletin/changes.txt +++ /dev/null @@ -1,692 +0,0 @@ -V2.5 -If a message gets rejected from a news server that was posted via a folder -that has a news group associated with it, the error message gets sent to the -local postmaster, and the message continues to attempt to be posted until it -is either delivered, or the postmaster kills it. 10/20/98 - -Fixed bug which caused the RESET command to wipe out SET NOTIFY on a new -group. 10/6/98 - -Changed behavior of threads and excludes. Only excludes based on FROM will -take precedence over THREADs. 10/1/98 - -Fixed 2 very old bugs. One which would cause one of the databases to be -stuck opened preventing anyone else from using BULLETIN, the other which -caused READNEW behavior when logging in for folders which did not have that -feature enabled. 9/20/98 - -V2.4 -Adding the ability to change one's personal name used in postings to news -groups and mail message by defining the logical name BULL_PERSONAL_NAME. -7/22/98 - -Added the SET GATEWAY command to change the how the subject lines looks in -messages which are sent to an email address associated with a folder. 2/25/98 - -Many bugs were fixed, mainly with respect to the news-email-folder gateway. - -V2.3 - -Added the ability to create a folder that can post and read to a news group, -and can send and read messages via email. See NEWS_TO_FOLDER.TXT for more -info. 4/18/97 - -Added the ability for BULLETIN to see news groups from secondary news groups -(see NEWS.TXT). 4/18/97 - -V 2.25 - -Changes to make it easier to click on news group name to select them: You can -enter a news group name at the prompt and it will select it (without typing -SELECT). News groups displayed without period at end when BULLETIN lists the -ones that have new messages. NEWS/SUBS has space between * and news group -when denoting which ones have new messages. 3/21/96 - -V 2.24 - -When replying to a message in a news group that has been crossposted, give the -user the option of just posting the reply to the news group in which the -message is being read rather than all the news groups in the crosspost. -11/20/95 - -Messages added to folders and stored news groups are now marked as being read -so that the person does not see them when doing a READ/NEW. 11/20/95 - -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vmslt00a/bulletin/cmds.mai b/decus/vmslt00a/bulletin/cmds.mai deleted file mode 100644 index 804e43e..0000000 --- a/decus/vmslt00a/bulletin/cmds.mai +++ /dev/null @@ -1,22 +0,0 @@ -The address for getting BULLETIN is BULLETIN@PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file - (only one file per command). - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - -BULLETIN is also available via ANONYMOUS FTP from PFC.MIT.EDU, but the account -is set at low priority, so I suggest using it during non-prime hours. - - Mark diff --git a/decus/vmslt00a/bulletin/copyright.txt b/decus/vmslt00a/bulletin/copyright.txt deleted file mode 100644 index b6edd1b..0000000 --- a/decus/vmslt00a/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vmslt00a/bulletin/create.com b/decus/vmslt00a/bulletin/create.com deleted file mode 100644 index 9427f4f..0000000 --- a/decus/vmslt00a/bulletin/create.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vmslt00a/bulletin/debug.txt b/decus/vmslt00a/bulletin/debug.txt deleted file mode 100644 index e69de29..0000000 diff --git a/decus/vmslt00a/bulletin/handout.txt b/decus/vmslt00a/bulletin/handout.txt deleted file mode 100644 index 5a1acd2..0000000 --- a/decus/vmslt00a/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vmslt00a/bulletin/install.com b/decus/vmslt00a/bulletin/install.com deleted file mode 100644 index 34427ba..0000000 --- a/decus/vmslt00a/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vmslt00a/bulletin/instruct.com b/decus/vmslt00a/bulletin/instruct.com deleted file mode 100644 index 273d3e9..0000000 --- a/decus/vmslt00a/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vmslt00a/bulletin/instruct.txt b/decus/vmslt00a/bulletin/instruct.txt deleted file mode 100644 index 6699642..0000000 --- a/decus/vmslt00a/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vmslt00a/bulletin/login.com b/decus/vmslt00a/bulletin/login.com deleted file mode 100644 index e670783..0000000 --- a/decus/vmslt00a/bulletin/login.com +++ /dev/null @@ -1,31 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! If you want to have more than one BULLETIN database, replace BULL_DIR -$! with the actual directory to allow redefining BULL_DIR. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vmslt00a/bulletin/makefile b/decus/vmslt00a/bulletin/makefile deleted file mode 100644 index c5bbf6f..0000000 --- a/decus/vmslt00a/bulletin/makefile +++ /dev/null @@ -1,82 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.5" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vmslt00a/bulletin/master.com b/decus/vmslt00a/bulletin/master.com deleted file mode 100644 index 112d981..0000000 --- a/decus/vmslt00a/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vmslt00a/bulletin/mx.mai b/decus/vmslt00a/bulletin/mx.mai deleted file mode 100644 index 2631763..0000000 --- a/decus/vmslt00a/bulletin/mx.mai +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_LIBRARY") .eqs. "" -$ then say "BULL_LIBRARY logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_library/LIB,SYS$SYSTEM:SYS.STB/SEL,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_LIBRARY to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P4 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P4 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P4 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p4 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p2' 'p3' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p2' 'p3' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vmslt00a/bulletin/news.txt b/decus/vmslt00a/bulletin/news.txt deleted file mode 100644 index 86274c1..0000000 --- a/decus/vmslt00a/bulletin/news.txt +++ /dev/null @@ -1,133 +0,0 @@ -BULLETIN has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was -to run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added -the ability in BULLETIN (actually BULLCP) so that it acts as as a gateway -between decnet and tcp for NEWS. This method does not require spawning any -processes, since the detached process BULLCP is always present, so the access -is very fast. Also, since BULLETIN uses a shared database to store info on -the NEWS groups and periodically updates it, there is no need for that to be -done when a user accesses the NEWS groups. Several other NEWS readers do this -when you run them, which is why they take a long time to start up. It is also -possible to feed NEWS groups into a "real" BULLETIN folder, so that the -messages are saved on disk (see the file NEWS_TO_FOLDER.TXT). - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER to -be a system logical name pointing to either your internet or decnet NEWS node. -If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -It is also possible for BULLETIN to access news groups that are located on -other news servers than the one specified by BULL_NEWS_SERVER. This is done -by creating the file BULL_DIR:BULL_ALT_NEWS.LIS and adding a line which -containsthe name of the news group and the news server where it's located. -The format is news-group-name:news-server-name. - -In order to post messages, BULLETIN needs to know the internet nodename of the -local host. This is done automatically for nodes running MULTINET. For other -nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This can -be hardcoded into the source by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, -it will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will -cause subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -If you have any problems or questions, please let me know. - MRL diff --git a/decus/vmslt00a/bulletin/news_to_folder.txt b/decus/vmslt00a/bulletin/news_to_folder.txt deleted file mode 100644 index c100f09..0000000 --- a/decus/vmslt00a/bulletin/news_to_folder.txt +++ /dev/null @@ -1,48 +0,0 @@ -It is possible to automatically have messages from a news group be fed into a -real folder, and visa versa. This allows BULLETIN messages to be shared with -a news group, thus giving access to such messages to people who do not have -access to BULLETIN. This can also be combined with email access for people -who have neither BULLETIN nor news group access. - -To associate a folder with a news group, place the name of the news group into -the folder description surrounded by <>, i.e. . It must be in -lower case. (Other text is allowed in the description, i.e. "THIS IS A TEST -FOLDER ".) When messages are added the folder, they are also sent -to the news group, and new messages from the group are posted to the folder -(via the BULLCP process which wakes up on a periodic basis). Whenever you -modify the folder description and specify the news group name, you will be -prompted as to whether you want to initializee the news group counter to -either load all the messages present in the news group, or to load only news -messages that appear there. - -Messages posted to the news group from such a folder have a special line in -their header indicating they were sent from that node using bulletin. When -bulletin feeds new postings back to the folder, it will see that header line -and also see that it was posted from that node, and thus will avoid adding it -to the folder (and thus creating a duplicate message). Note that messages are -added to the news group via the BULLCP process, so they will not appear -immediately after being added to the folder. - -If you are modifying an existing folder to make it associated with a news -group, and if you want to copy any existing messages in the folder to the news -group, you can do that by using the command COPY/ORIGINAL/LOCAL and specifying -the news group as the destination. /ORIGINAL will cause the original owner -names and dates to be preserved (note, however, that dates older than 14 days -in the past are not usually accepted by the news server, so dates older than -that will be changed to the present date). /LOCAL will create the special -header line in the messages to prevent BULLCP from adding those messages back -to the folder from the news group. /ALL can be specified to copy all the -messages in the folder. - -If you create a remote folder that points to a folder that has a news group -associated with it, you do not have to specify the news group in the -description of the remote node. However, on the node on which the folder -actually exists, the news group has be a stored news group, i.e. you must -issue the command SET NEWS/STORED for that news group. - -When a news group is specified for a folder, it is still possible to associate -an email address for the messages to be sent to in the folder description. -You do this by using [] to enclose the address rather than the usual <>, i.e. -[mrl@pfc.mit.edu] See help in BULLETIN on the command CREATE/DESCRIPTION for -more info about associated email addresses. Note that these features allow -you to create a full gateway between a news group and a mailing list. diff --git a/decus/vmslt00a/bulletin/nonsystem.txt b/decus/vmslt00a/bulletin/nonsystem.txt deleted file mode 100644 index f1f7d86..0000000 --- a/decus/vmslt00a/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vmslt00a/bulletin/optimize_rms.com b/decus/vmslt00a/bulletin/optimize_rms.com deleted file mode 100644 index 576fa3e..0000000 --- a/decus/vmslt00a/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vmslt00a/bulletin/pmdf.com b/decus/vmslt00a/bulletin/pmdf.com deleted file mode 100644 index 6a700ce..0000000 --- a/decus/vmslt00a/bulletin/pmdf.com +++ /dev/null @@ -1,4 +0,0 @@ -$link/exe=pmdf_exe:bulletin_master.exe - - pmdf_exe:bulletin_master.obj/sysexe,pmdf_exe:pmdfshr_link.opt/opt, - - pmdf_com:ident.opt/opt,pmdf_exe:rmspro, - - bull.olb/lib,sys$share:vaxcrtl/lib diff --git a/decus/vmslt00a/bulletin/pmdf.txt b/decus/vmslt00a/bulletin/pmdf.txt deleted file mode 100644 index e3a40bc..0000000 --- a/decus/vmslt00a/bulletin/pmdf.txt +++ /dev/null @@ -1,29 +0,0 @@ -To allow PMDF to be able to transfer mail to BULLETIN folders, edit the file -PMDF_TABLE:PMDF.CNF, and append the following 5 lines to the rewrite section -(make sure you do not include any lines with spaces in that section. Replace -the string "urdomain", with your domain (i.e., my domain is PSFC.MIT.EDU). - -! -! Rewrites for bulletin channel -! -BULLETIN $U%BULLETIN@BULLETIN-DAEMON -BULLETIN.urdomain $U%BULLETIN@BULLETIN-DAEMON - -Then, add the following 5 lines to the channel section (or just put it at the -end of that file). - -! -! The BULLETIN Channel rule -! -bull_local single master slave_debug master_debug logging defragment charset7 us-ascii charset8 iso-8859-1 -BULLETIN-DAEMON - -After you do this, you can now link and install the BULLETIN executable using -PMDF.COM Once you do that, if you want email messages to be automatically -transferred to a BULLETIN folder, you will need to add an alias to -PMDF_TABLE:PMDF.CNF For example, if you email sent to TEST to be placed in -the TEST folder, you would add the line: - -test: test@bulletin - -Note that folder names do not necessarily have to match account names. diff --git a/decus/vmslt00a/bulletin/restart.com b/decus/vmslt00a/bulletin/restart.com deleted file mode 100644 index 71f7023..0000000 --- a/decus/vmslt00a/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vmslt00a/bulletin/setuser.mar b/decus/vmslt00a/bulletin/setuser.mar deleted file mode 100644 index 489f36f..0000000 --- a/decus/vmslt00a/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vmslt00a/bulletin/update.fil b/decus/vmslt00a/bulletin/update.fil deleted file mode 100644 index 6f20f13..0000000 --- a/decus/vmslt00a/bulletin/update.fil +++ /dev/null @@ -1,11 +0,0 @@ -$ if p1 .nes. "" then FS 'P1' -$ COPY 'FM' [MRL.BULLETIN.SEND]/LOG -$ COPY 'FM' CMODA::IR:[BULLETIN]/LOG -$ TAB2SP 'FM' -$ RENAME 'FM' [MRL.NET] -$ PUR [MRL.BULLETIN.SEND]'FM' -$ PUR [MRL.NET]'FM' -$ IF FM .EQS. "CHMAIL.MAI" THEN P3 = "AAAREADME." -$ IF P2 .EQS. "" THEN COPY 'FM' [ANONYMOUS.BULLETIN]'P3' -$ IF P3 .EQS. "" THEN PUR [ANONYMOUS.BULLETIN]'FM' -$ IF P3 .NES. "" THEN PUR [ANONYMOUS.BULLETIN]'p3' diff --git a/decus/vmslt00a/bulletin/upgrade.com b/decus/vmslt00a/bulletin/upgrade.com deleted file mode 100644 index b91fa7c..0000000 --- a/decus/vmslt00a/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vmslt00a/bulletin/writemsg.txt b/decus/vmslt00a/bulletin/writemsg.txt deleted file mode 100644 index 2bfabfd..0000000 --- a/decus/vmslt00a/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vmslt02a/bulletin/aaareadme b/decus/vmslt02a/bulletin/aaareadme deleted file mode 100644 index f4cc15c..0000000 --- a/decus/vmslt02a/bulletin/aaareadme +++ /dev/null @@ -1,68 +0,0 @@ -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -If you are running a version of BULLETIN older than 2.11, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. NOTE: -Problems can occur if the old version of BULLETIN is run after the -data files have been modified. Such a situation is possible on a -cluster where each node has installed the executable separately. To -help installation, a new command procedure UPGRADE.COM has been -included. Read the comments in the file for information on how to use -it. - -NOTE: The following commands can be sent to BULLETIN@PSFC.MIT.EDU: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -You will be receiving 22 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) BULLETIN10.FOR - 13) BULLETIN11.FOR - 14) ALLMACS.MAR - 15) BULLCOMS1.HLP - 16) BULLCOMS2.HLP - 17) BULLET1.COM - 18) BULLET2.COM - 19) PMDF.COM - 20) MX.COM - 21) NEWS.COM - 22) ALLMACS_AXP.MAR - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. However, this only applies -to PMDF V3.2 or earlier, as later versions of PMDF have the necessary -interface code for BULLETIN included in it. In that case, or in case -you don't have PMDF, you can delete it. The same applies to MX. Then, -read AAAREADME.TXT for BULLETN installation instructions. If you are -using the news feature, NEWS.COM contains files which pertain to news. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@PSFC.MIT.EDU diff --git a/decus/vmslt02a/bulletin/aaareadme.txt b/decus/vmslt02a/bulletin/aaareadme.txt deleted file mode 100644 index d8d9bfc..0000000 --- a/decus/vmslt02a/bulletin/aaareadme.txt +++ /dev/null @@ -1,210 +0,0 @@ -BULLETIN - -Bulletin is a utility that works a lot like VMS MAIL but that maintains -many message folders and is designed to allow many to many communication -like that of Usenet news. Many options to shift messages from Bulletin -to or from VMS MAIL exist and it can act as a USENET news reader as -well. It is very handy for communication within groups or companies. - -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -By default, BULLETIN uses the format IN%"email-address" when sending mail via -VMS MAIL. The IN% is hardcoded in BULLNEWS.INC. If you use a different -protocol, you should either change the reference in that file, or you can -define logical name BULL_NEWS_MAILER to point to the new protocol, i.e. -DEFINE/SYSTEM BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vmslt02a/bulletin/allmacs.mar b/decus/vmslt02a/bulletin/allmacs.mar deleted file mode 100644 index 3725b8a..0000000 --- a/decus/vmslt02a/bulletin/allmacs.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vmslt02a/bulletin/allmacs_axp.mar b/decus/vmslt02a/bulletin/allmacs_axp.mar deleted file mode 100644 index fb06e99..0000000 --- a/decus/vmslt02a/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vmslt02a/bulletin/board_digest.com b/decus/vmslt02a/bulletin/board_digest.com deleted file mode 100644 index dec53c1..0000000 --- a/decus/vmslt02a/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vmslt02a/bulletin/board_special.com b/decus/vmslt02a/bulletin/board_special.com deleted file mode 100644 index 93e16c3..0000000 --- a/decus/vmslt02a/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vmslt02a/bulletin/bull_news.c b/decus/vmslt02a/bulletin/bull_news.c deleted file mode 100644 index 177fef6..0000000 --- a/decus/vmslt02a/bulletin/bull_news.c +++ /dev/null @@ -1,934 +0,0 @@ -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s,s1; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} - - -smtp_assign() -{ - int n; - -#if MULTINET || TWG - /* - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()). - */ - - if (!hp1) { - int h[4],i; - if (sscanf(node1,"%d.%d.%d.%d",&h[0],&h[1],&h[2],&h[3]) == 4) { - for (i=0;i<4;i++) if (h[i] < 0 || h[i] > 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp1->h_addrtype; - memcpy(&sin.sin_addr, hp1->h_addr, hp1->h_length); - } -#if TWG - sin.sin_port = htons(25); -#else - sin.sin_port = htons1(25); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s1,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s1,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node1),DSC$K_CLASS_S,DSC$K_DTYPE_T,node1}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s1,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s1,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - - -smtp_create() -{ -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s1,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(25); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s1,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#else - if (!(sys$qiow(0,s1,IO$_CREATE,&iosb,0,0,node1,25,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#endif - - return(1); -} - -smtp_disconnect() -{ -#if UCX - sys$cancel(s1); - sys$qiow(0,s1,IO$_DEACCESS,0,0,0,0,0,0,0,0,0); -#endif - sys$dassgn(s1); -} - - -smtp_connect() -{ - if (!smtp_gethost()) return(0); - if (!smtp_assign()) return(0); - if (!smtp_socket()) return(0); - return(smtp_create()); -} - -char node2[132]; - -smtp_gethost() -{ - /* - * Get the IP address of the SMTP host. - * As of MULTINET 3.0, cannot be done at AST level - * so can't do in SMTP_ASSIGN(), as BULLCP calls it at - * AST level if the decnet gateway feature is used. - */ -#if TWG - struct hostent *gethostbyname(); -#else -#if MULTINET -#endif -#endif - - node1 = getenv("BULL_SMTP_SERVER"); - if (!node1) { -#if TWG - gethostname(node2,132); -#else -#if MULTINET - gethostname1(node2,132); -#endif -#endif - node1 = node2; - } - -#if TWG - hp1 = gethostbyname(node1); -#else -#if MULTINET - hp1 = gethostbyname1(node1); -#endif -#endif - return(1); -} - - - -smtp_write_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - - -smtp_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s1,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - - -smtp_socket() -{ - -#if MULTINET || TWG - if (!(sys$qiow(0,s1,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s1,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#endif - - return(1); -} diff --git a/decus/vmslt02a/bulletin/bull_newsdummy.for b/decus/vmslt02a/bulletin/bull_newsdummy.for deleted file mode 100644 index 90c0f81..0000000 --- a/decus/vmslt02a/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,137 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END - - - - SUBROUTINE SMTP_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION SMTP_CONNECT - - SMTP_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION SMTP_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION SMTP_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_READ_PACKET = 0 - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bullcom.cld b/decus/vmslt02a/bulletin/bullcom.cld deleted file mode 100644 index 7c2bf51..0000000 --- a/decus/vmslt02a/bulletin/bullcom.cld +++ /dev/null @@ -1,771 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 11/9/99 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER COPY, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FORCE - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER DELETE - QUALIFIER UNDELETE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER LOCAL - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER NOW - QUALIFIER OUTPUT,VALUE(REQUIRED,TYPE=$FILE) - QUALIFIER POST, DEFAULT - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW DELETE AND UNDELETE - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB THREAD - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE, NONNEGATABLE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER FORCE - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER THREADS - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - KEYWORD GATEWAY - KEYWORD NOGATEWAY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD THREAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vmslt02a/bulletin/bullcoms1.hlp b/decus/vmslt02a/bulletin/bullcoms1.hlp deleted file mode 100644 index c82f17a..0000000 --- a/decus/vmslt02a/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1276 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is -specified. A node which does not have BULLCP running cannot have a -message broadcasted to it, (even though it is able to create a remote -folder). A broadcasted message is limited to 1600 characters - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with -> at the beginning of each line. This can be -suppressed or the indentation character changed with /[NO]INDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message will -be deleted after the node on which the message was submitted from is -rebooted. If you wish the message to be deleted after a different node -reboots, you have the option of specifying that node name. The message -deletion is keyed by BULLETIN running on the node that reboots. It -writes into the database info that the node has rebooted, and when -BULLCP wakes up and sees this info, it will delete any shutdown messages -for that node. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current process -to another process in your job. - -The ATTACH command allows you to move quickly between processes that you -have created with the SPAWN command. For example, while you are editing -a file, you can SPAWN a subprocess to read a new message. Enter the -ATTACH command to get back to back to the editing session. If you want -to read another new message, you can use the ATTACH command to get back -to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers -so that either the message text, expiration date, or the header are to -be changed. If no qualifier is added, the default is that all these -parameters are to be changed. If the text of the message is to be -changed, a file can be specified which contains the text. If the editor -is used for changing the text, the old message text will be extracted. -This can be suppressed by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /OWNER - /OWNER=string - -Specifies a new owner name. Can only be changed if you own the folder -or have privileges. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. A -range of messages can be specified, i.e. /NUMBER=1-5. Only the -expiration date and message headers can be changed if a range is -specified. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be copied -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list via -the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to be mailed to the email address. This is common if you have -users that don't have access to BULLETIN. Note: When you specify an -email address, the folder automatically will have the ADD_ONLY flag set, -which causes both ADD and POST to both add a message and send mail the -message. Note that a message added to the folder via the BBOARD feature -will also be mailed to the specified email address. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. If you create a remote folder pointing to a folder -associated with an email address, you must specify the email address in -the description of the remote folder also. Please also read about the -SET GATEWAY command. - -It is also possible to use the description to specify a news group from -which messages are fed into the folder. See the file FOLDER_TO_NEWS.TXT -for more info. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. The -identifier can not be any longer than 12 characters. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The specified node is checked to see if -a folder of the same name is located on that node. If so, the folder -will then be modified to point to that folder. For example if there was -a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be -shared between more than one node. This capability is only present if -the BULLCP process is running on the remote node via the BULL/STARTUP -command. If the remote folder name is different from the local folder -name, the remote folder name is specified using the /REMOTENAME -qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data -Base. If the RDB does not exist on your system, a privileged user will -have to create it. If a user is not in the RDB, this program will -automatically enter the user into it (unless this feature was disabled -during the compilation of this program). NOTE: See HELP SET ACCESS for -more info. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW -for more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -either /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The -BULLETIN utility must be installed properly on the other nodes. You can -specify a different username to use at the other nodes by either using -the USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. The -specified subject need not be the exact subject of the message. It can -be a substring of the subject. This is in case you have forgotten the -exact subject that was specified. Case is not critical either. You -will be notified if the deletion was successful. See also /NEGATED. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting -messages on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message. -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /CONTINUE -Used with /GROUP. Allows you to continue a search after you have broken -the search by entering a command, i.e. READ, SEARCH, etc. Note: If you -enter a SEARCH command which specifies a string, and then continue the -directory search using /CONTINUE, the new search pattern will be used -when continuing the search. -2 /DELETE -Deletes all the messages which are displayed. Immediate deletes are not -available in this mode. Paging is turned off while deleting occurs. -2 /UNDELETE -Undeletes all the messages which are displayed. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of -folder. -2 /EXPIRATION -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the DIRECTORY -command are to be written into the specified file. All qualifiers which -are valid for the EXTRACT command are valid in conjunction with /EXTRACT -except for /NEW which conflicts with the DIRECTORY /NEW qualifier. The -listof messages to be printed will be displayed on the terminal (in -nopaging format). - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /FEEDBACK -Used only in conjunction with /GROUP. Specifies to show when new news -groups are selected. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS. -2 /FROM - /FROM=[string] - -Specifies that only messages whose username contains the specified string -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Used with the search -qualifiers /SEARCH, /SUBJECT, or /FROM. Wildcards are permitted in the -specified string. Use /FEEDBACK to see when groups are selected. At -any time during the search you may enter other commands, i.e. you may -read a message, see a full directory listing, etc. You may then restart -the search listing by typing DIR/CONTINUE. For more info, see help on -the /CONTINUOUS qualifier. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don't -match the specified search command are displayed. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWS -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /OUTPUT - /OUTPUT=filename - -Specifies to write the directory output to a file rather than the -terminal. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED. -2 /SEARCH - /SEARCH=[string] - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDE -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings. - - Format: - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. /FROM is the default. - -Note: EXCLUDEs based on FROM will take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE. -2 /FROM -Specifies to exclude the message based on the message owner. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. When /FULL is specified, the EXCLUDE command will -not add an exclude, so it can't be used with any other qualifier except -for /DISABLE. -2 /LIMIT - /LIMIT=days - -Specifies that the exclude will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROM -and /SUBJECT cannot be specified at the same time. -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. If the file exists, the -message is appended to the file, unless the /NEW qualifier is specified. - - Format: - FILE [filename] [message_number][-message_number1],[...] - -If the filename is omitted, a file will be created based on the name of -the folder. - -A range of messages to be copied can optionally be specified, i.e. FILE -2-5. The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /ALL -Copies all the messages in the current folder. -2 /FF -Specifies that a form feed is placed between messages in the file. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 FIRST -Specifies that the first message in the folder is to be read. -1 Folders -All messages are divided into separate folders. New folders can be -created by any user. As an example, the following creates a folder for -GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that user -will be alerted of topics of new messages at login time, and will then -be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If instead you -specify /SEMIPRIVATE, all users can read the messages in the folder, but -only those given access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote -DECNET node. Messages added to a remote node are actually stored on the -folder on the remote node. The BULLCP process (created by -BULLETIN/STARTUP) must be running on the remote node for this option to -be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another use -is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, -and giving access to that UIC group. Only users in that UIC group will -see the messages in that folder when they log in. -1 FORWARD -Synonym for MAIL command. -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INCLUDE -This command is a synonym for the THREAD command. -1 INDEX -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after one -has read a message. /RESTART must be specified to start from the first -folder if a scan is in progress. All other qualifiers are ignored while -a scan is in progress. - - Format: - INDEX - -When a directory is displayed, you can read the first message in the -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for older -versions of BULLETIN. -2 /MARKED -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED, -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. -2 /NEW - /[NO]NEW - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message. -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -2 /SET - /[NO]SET - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -2 Suggestions -Here are keypads settings that the author personally uses. Note that -the IND/SUBS commands are useful only for reading NEWS. - -DEFINE/KEY PERIOD "IND/SUBS"/TERM -DEFINE/KEY PERIOD "IND/SUBS/NONEW"/IF_STATE=GOLD/TERM -DEFINE/KEY MINUS "READ/THREAD"/IF_STATE=GOLD/TERM -DEFINE/KEY PF1 ""/IF_STATE=GOLD/SET=NOEDIT -DEFINE/KEY PF1 ""/IF_STATE=NOEDIT/SET=NOH -DEFINE/KEY PF3 "EXT"/TERM -DEFINE/KEY KP9 "MAIL/EDIT/NOHEAD"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP8 "REPLY/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP7 "SEND/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/H"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/NOH"/IF_STATE=NOH/TERM -DEFINE/KEY KP5 "RESPOND/NOEDIT "/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP5 "RESPOND/EXTRACT/LIST/EDIT "/TERM -DEFINE/KEY KP2 "SEARCH/REP "/TERM -DEFINE/KEY KP2 "SEARCH/REV/REP "/TERM/IF_STATE=GOLD -DEFINE/KEY KP2 "SEARCH/REV "/IF_STATE=NOEDIT -DEFINE/KEY COMMA "SPAWN"/TERM -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying an -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" must -be specified as xxx%"""address""". -2 /EDIT -Specifies that the editor is to be used to edit the message before -mailing it. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers] - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 MODIFY -Modifies the database information for the current folder. Only the -owner of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to automatically mailed to the email address. This is common if -you have users that don't have access to BULLETIN. In order to do this, -you should use the SET ADD_ONLY command. This causes all messages added -to the folder to also be sent to the email address. This also applies -to messages which are added via the BBOARD feature. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. Please also read about the SET GATEWAY command. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can -be specified following the folder name, i.e. COPY NEWFOLDER 2-5. -However, if the old folder is remote, they will be copied but not -deleted, as only one message can be delted from a remote folder at a -time. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be moved -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEWS -Displays the list of available news groups. - -Format: - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed. - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL will -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /DEFAULT -If specified, will show news groups that have be defined as default -groups using the SET SUBSCRIBE command. -2 /NEWGROUP -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /PERMANENT -If specified, will show news groups that have be defined as permanent -groups using the SET SUBSCRIBE command. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B. -2 /STORED -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 New_features -Here is a list of new features which may be of interest to the general -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - -------------------------------------------------------------------------- -V 2.24 -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -SHOW EXCLUDE and INCLUDE commands added. 5/16/95 - -V 2.21 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -Added /FOLLOWUP to POST command when used with news groups. It specifies -which news group you want replies to your message to be sent to. 10/28/94 - -V 2.20 - -Logical names can be specified in POST/GROUPS=. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/11/94 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group by -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92 - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 Personal_name -Any messages posted to news groups or sent as mail automatically will -include the personal name which is set in the VMS mail utility. If you -don't want this to happen, you can define the logical name -BULL_PERSONAL_NAME to be the personal name you want BULLETIN to use: - -$ DEFINE BULL_PERSONAL_NAME "John Doe" -$ BULLETIN - -If you don't want any personal name, define it to be " ". diff --git a/decus/vmslt02a/bulletin/bullcoms2.hlp b/decus/vmslt02a/bulletin/bullcoms2.hlp deleted file mode 100644 index 8971375..0000000 --- a/decus/vmslt02a/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1463 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with -> at the -beginning of each line. This can be suppressed or the indentation -character changed with /[NO]INDENT. -2 /FOLLOWUP - /FOLLOWUP=string - -Specifies that any replies generated by people reading the message -should be sent to the specified newsgroup. This is useful if you want -to post to more than one group, but don't want reply messages posted on -all the groups. To specify more than one newsgroup, surround the list -with quotes, i.e. FOLLOWUP="newsgroup1,newsgroup2". If replies should -only be sent to the message owner and not a newsgroup, the string -"poster" should be specified. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message -to the specified NEWS group(s) in addition to the selected NEWS group. -Logical names are allowed. -2 /HEADER -Allows customized headers line to be added to the message header. When -specified, header lines can be added by inserting them at the top of the -message, with the header lines and the text of the message separated by -a blank line. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. -In order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply -surround the exclusive text starting with the line "START " -and ending with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The file created by the PRINT command is not -released to the print queue until you exit, unless you add the qualifier -/NOW or change one of the print job's qualifiers. Multiple messages are -concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /CANCEL -Cancels any messages waiting to be printed. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL level -to find out the name of the mounted form and the default form for a -particular queue. If you specify a form whose stock is different from -the stock of the form mounted on the queue, your job is placed in a -pending state until the stock of the mounted form of the queue is set -equal to the stock of the form associated with the job. (In order to -have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the file -or files have been printed. If /NONOTIFY is specified, there is no -notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 QUIT -Exits the BULLETIN program. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. If you -specify a number greater than the number of messages in the folder, the -last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -/HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /THREADS -Reads all messages that have been included by the THREAD command. If -neither message number nor /SINCE is specified, the search starts with -the first new message. After the first READ/THREADS command, typing -READ/THREADS will continue the search from where it left off (as long as -you do not select a different folder or news group). Also, after a -message has been fully read, if the return key is hit without entering a -command, it is equivalent to typing the READ/THREADS command. Messages -which are parts of threads and under read will be displayed in the -directory listing by a preceeding #. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /INDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read -them. (Note: Reading the last message does the same thing, but RESET -does it without having to read it.) -2 /CURRENT -Resets the new message counter to the current message. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using the -qualifer /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected or /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text strings. - - Format: - - SEARCH [search-string[,...]] - -The search starts from the first message in the current folder. You can -specify the message to start at using the qualifier /START. If you use -this qualifier without a parameter, it starts with the current message. -The search includes both the text of the message, and the description -header. If a "search-string" is not specified, a search is made using -the previously specified string, starting with the message following the -one you are currently reading (or have just read). After fully reading -the message found by the search, if you hit the return key without -entering a command, it is equivlanent to typing SEARCH without a search -string and will search for the next message. Once started, a search can -be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FEEDBACK -Used only in conjunction with /FOLDER and /GROUP. Specifies to show -when new folders or news groups are selected. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for a -match. If, during a search, no more matches or messages are found, the -next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. Use /FEEDBACK to see when folders are -selected. News groups can be specified here. However, to search news -group with wild cards, use /GROUP. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Wildcards are permitted in -the specified string. If the string does not contain an * and does not -specify a news group, * is automatically placed at the beginning and end -of the string. I.e. if the string is "comp", then all news groups -containing the word "comp" will be searched. Use /FEEDBACK to see when -groups are selected. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /MATCH - /MATCH[=option] - -Interprets and matches multiple search strings in one of the following -ways: - - AND A match occurs only if all of the strings are found. - - OR A match occurs if any of the strings are found. - - XOR A match occurs if only one of the strings is found. - -If you specify none of these options, the default is /MATCH=OR. If you -specify the /NEGATED qualifier, you will get the negated operation. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If no -starting message is specified, the search is started from the last -message. /REVERSE must be specified with a search string. -2 /START - /START=message_number - -Specifies the message number to start the search at. If you omit the -message number, it starts with the current message. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. UICs can contain -wildcards, i.e. [130,*]. Note that by default, a process is given the -process rights id SYS$NODE_nodename, where nodename is the decnet -nodename. Thus, by specifing this id, a folder can be restricted to a -specific node, which is useful when the folder is shared among nodes in -a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUS -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name. - - Format: - - SET [NO]ANONYMOUS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. - - Format: - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If -ADD_ONLY is set and a mailing address is present (see /DESCRIPTION), -when a message is added to the folder, it will also be mailed to the -address (in addition to being stored in the folder). This also applies -to a message which is added via the BBOARD feature . If ADD_ONLY is set -and a user uses the POST command, the ADD command will be used instead. -One use for this is to mail messages in a folder to users who do not -have access to BULLETIN. - - Format: - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages. - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30" -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The form -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY. -The time will always be 00:00, even if the time is specified on the line. -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be: - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account. - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV. -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION. -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by the -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier. -2 COMPRESS -Specifies that messages added to the folder will be in compressed format. -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires -very little cpu overhead. - - Format: - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed every -time when logging in, until the new messages are read. Normally, the -BRIEF setting causes notification only at the first time that new messages -are detected. - - Format: - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - - Format: - - SET DEFAULT_EXPIRE days - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages. - - Format: - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it. -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format: - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) -2 EXCLUDE -Specifies to ignore any EXCLUDEs or THREADs that are present. - - Format: - - SET [NO]EXCLUDE - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or THREADs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 EXLIMIT -Specifies the default limit for the EXCLUDE command. - - Format: - - SET EXLIMIT days - -If no match is found for an exclude after the specified number of days, -the exclude will automatically be deleted. The default is no limit, -which is specified by specifying 0 days. This default can be overriden -by the /LIMIT switch on the EXCLUDE command. -2 FILE_DIRECTORY -Select the directory where messages are written to when using the -EXTRACT or file COMMAND. By default, the message is written into the -current directory. - - Format: - - SET FILE_DIRECTORY [directory] - -If directory is omitted, the setting is removed. Note: This information -is stored in the customization file (SYS$LOGIN:BULL.CUSTOM). -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new messages will be displayed for upon -logging in. -2 GATEWAY -Valid for folders that are associated with an email address. Messages -which are mailed to the email address are by default modified so that -the subject line starts with the folder name, followed by the phrase -"folder message: ", followed original subject line. If you specify -GATEWAY, the subject line is not modified this way. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to by -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. -2 LIBRARY -Specifies a library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command to see if there are other libraries. -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NAME -Copies all stored settings from one user to another. Used when a user's -account name is changed. - - Format: - - SET NAME old-username new-username -2 NEWS -Changes attributes of the specified news group or class of news groups. -This command requires privileges. - - Format: - - SET NEWS [news-group] - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALL - /NOALL - -If specified with /CLASS or /DEFAULT, all groups that are presently -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of any -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the default -attributes (using /DEFAULT) with /NOALL, the attributes for misc.test -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. -3 /CLASS - /CLASS=classname - -Specifies to modify attributes for a class of news groups rather than a -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes of -existing groups which are in the class are modified, and any groups -created in the future will automatically have those attributes. -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETE -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLE -Specifies that the news group is enabled and can be accessed. This is -the default. -3 /EXPIRATION - /EXPIRATION=days - -Specifies the default expiration time for messages if none is specified. -The default is 7. -3 /FULL -Control whether all information of the news groups is displayed, i.e. -the access list if the news group is private. This information is only -those who have access to that folder. -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified is --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default. -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is posted -every month with an expiration date of one month in the future. -3 /PRIVATE - /PRIVATE - /NOPRIVATE - -Specifies that the news group or class can have it's access modified by -the SET ACCESS command. To accomplish this, a file is created in -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access -to news groups in that class is to set /NOPRIVATE, as then time won't be -wasted checking a file for ACLs. -3 /STORED - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessed -via the network from the server node. This results in faster access, -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED. -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder. - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node, -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are logged -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 POST_ONLY -Specifies that the selected folder has the POST_ONLY attribute. This -causes the ADD command to mail the message to the mailing address if it -is present (see /DESCRIPTION), rather than add to the folder. - - Format: - - SET [NO]POST_ONLY -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format: - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers. -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed. -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that READNEW is a permanent flag and cannot be changed by the -individual. This is a privileged qualifier. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all -users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged -qualifier. -2 STRIP -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If STRIP -is set, the header of the mail message will be stripped off before it is -stored as a BULLETIN message. - - Format: - - SET [NO]STRIP - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SUBSCRIBE -Can be used to force users to be subscribed to the selected news group. -This is a privileged command. - - Format: - - SET SUBSCRIBE - -Note: If you execute the commands SET SHOWNEW, READNEW, BRIEF, or -NOTIFY, and add /DEFAULT or /PERMAMENT, it is equivalent to doing a SET -SUBSCRIBE command with the addition that the specified feature will be -the default and/or permanent setting. -3 /ALL -Specifies that all present and future users will be subscribed to the -news group. -3 /DEFAULT - /[NO]DEFAULT - -Specifies that new users will automatically be subscribed to the news -group. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that new users will automatically be subscribed to the news -group and that users cannot unsubscribe the news group. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 EXCLUDE -Displays the list of excludes which are present for the current folder. -The right hand side of the display shows the date of the last time a -match for the exclude was found, and also the number of days from the -time of the last match after which the excludes expires. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected -via the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 THREAD -Displays the list of includes which are present for the current folder. -2 KEYPAD -Displays the keypad command definitions. - - Format: - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either SET KEYPAD, or if /KEYPAD is -specified on the command line, the keypad keys will be defined as -commands. The default settings for the keypad are shown via SHOW KEYPAD -or HELP KEYPAD. Settings can be changed by using an initialization file -with DEFINE/KEY commands. BULLETIN looks first for the file pointed to -by the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -3 /STATE - /STATE=(state,state,...) - -Specifies the name of a state for which the specified key definitions -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when a -key name has been specified. -2 LIBRARY -Shows the library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the /ALL -qualifier to see if there are other libraries. -3 /ALL -Specifies to show all available libraries. -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGIN - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDER - /FOLDER=[foldername] - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups. -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSION -Shows the version of BULLETIN and the date that the executable was -linked. -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of the -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. -1 THREAD -Specifies that the current message is defined as a thread based on -either the subject or the message owner. Since threads are much more -commonly based on the subject, this is the default. Threads are read by -using the command READ/THREADS. - - Format: - THREAD [string] - -If a string is specified, then the message is a thread if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one THREAD may be -specified per folder. - -Note: EXCLUDEs based on FROM will take precedence over THREADs. -2 /ALL -Used with /DISABLE to specify to disable all THREADs. -2 /DISABLE -Specifies to permanently disable the THREAD. -2 /FROM -Specifies to include the message based on the message owner. /FROM -and /SUBJECT cannot be specified at the same time. -2 /LIMIT - /LIMIT=days - -Specifies that the thread will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to include the message based on the message subject. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 Storing_Threads -THREADs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] -1 UNSUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See the -SUBSCRIBE command for further info. -1 Usenet_news -BULLETIN can also read USENET NEWS if your system has network access to -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group -in order to keep track of which messages you have read in that group. -Most of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read all your subscribed news groups that have new -messages, use INDEX/SUBSCRIBE. diff --git a/decus/vmslt02a/bulletin/bulldir.inc b/decus/vmslt02a/bulletin/bulldir.inc deleted file mode 100644 index ab5027c..0000000 --- a/decus/vmslt02a/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vmslt02a/bulletin/bulletin.cld b/decus/vmslt02a/bulletin/bulletin.cld deleted file mode 100644 index 95c9f31..0000000 --- a/decus/vmslt02a/bulletin/bulletin.cld +++ /dev/null @@ -1,44 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vmslt02a/bulletin/bulletin.for b/decus/vmslt02a/bulletin/bulletin.for deleted file mode 100644 index 8b9ef63..0000000 --- a/decus/vmslt02a/bulletin/bulletin.for +++ /dev/null @@ -1,2129 +0,0 @@ -C -C BULLETIN.FOR, Version 2/27/98 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - DATA NEXT_COMMAND/' '/ - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - CALL INIT_BULLETIN(.TRUE.) - -C -C The MAIN loop for processing bulletin commands. -C - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IF (IER.GT.0) THEN - IF (INDEX(INCMD(:IER),' ').EQ.0.AND. - & INDEX(INCMD,'/').EQ.0.AND. - & INDEX(INCMD,'.').GT.0) INCMD = 'SELECT '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE IF (READ_COUNT.NE.0) THEN - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - ELSE IF (NEXT_COMMAND.NE.' ') THEN - INCMD = NEXT_COMMAND - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL DO_COMMAND(INCMD) - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - CALL DO_COMMAND(INCMD) - -100 CONTINUE - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) - - END - - - - - SUBROUTINE DO_COMMAND(INCMD) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - CHARACTER*(*) INCMD - - NEXT_COMMAND = ' ' - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (HLEN.EQ.0) THEN - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - END IF - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL'.OR. - & INCMD(:4).EQ.'POST'.OR. - & INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - WRITE (6,'('' ERROR: /FOLDER not valid when posting'', - & '' a message to a news group.'')') - ELSE - INCMD = 'POST '//INCMD(4:) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - END IF - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,'('' ERROR: There are no more preceding messages.'')') - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').AND.CLI$PRESENT('NEWS')) THEN - WRITE (6,'('' ERROR: /NEWS and /FOLDER cannot be '' - & ''specified at the same time.'')') - ELSE IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.,.FALSE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR - ELSE IF (INCMD(:4).EQ.'INCL'.OR. ! INCLUDE? - & INCMD(:4).EQ.'THRE') THEN ! THREAD? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IF (CLI$PRESENT('THREADS')) NEXT_COMMAND = 'READ/THREADS' - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - NEXT_COMMAND = 'SEARCH' - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'FI') THEN ! SET FILE_DIRECTORY? - CALL SET_CUSTOM('file_directory') - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SH') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SU') THEN ! SET SUBSCRIBE? - IF (REMOTE_SET.GE.3) THEN - D1 = 0 - D2 = 0 - D3 = 0 - CALL SET_FOLDER_DEFAULT(D1,D2,D3) - ELSE - WRITE (6,'('' ERROR: Command invalid for folder.'')') - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'GEN') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOGEN') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LIB') THEN ! SET LIBRARY? - CALL SET_LIBRARY - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS? - CALL SET_NEWS - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE? - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE? - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:3).EQ.'EXL') THEN ! SET EXLIMIT? - CALL SET_CUSTOM('exclude_limit') - ELSE IF (BULL_PARAMETER(:4).EQ.'NAME') THEN ! SET NAME? - CALL SET_NEWNAME - ELSE IF (BULL_PARAMETER(:3).EQ.'GAT') THEN ! SET GATEWAY? - CALL SET_FOLDER_FLAG(.TRUE.,15,'GATEWAY') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOGAT') THEN ! SET NOGATEWAY? - CALL SET_FOLDER_FLAG(.FALSE.,15,'GATEWAY') - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'EX') THEN ! SHOW EXCLUDE? - CALL SHOW_EXCLUDE(0) - ELSE IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:2).EQ.'IN'.OR. - & BULL_PARAMETER(:2).EQ.'TH') THEN ! SHOW INCLUDE? - CALL SHOW_EXCLUDE(1) - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SHOW LIBRARY - CALL SHOW_LIBRARY - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATION - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1) - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN? - CALL TAG(.FALSE.,2) - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - - RETURN - END - - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER INEXDATE*12,INEXTIME*12,INDENT*4 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,BULLETIN_SUBCOMMANDS - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT') - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - LENI = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',INDENT,LENI) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LENI.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') INDENT(:LENI)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2100' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2100' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60) - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60) - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - IF (CLI$PRESENT('EXTRACT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35 - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - BLENGTH = BLENGTH + ILEN - 1 + 2 - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE. - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting by '', - & I6,'' characters. Limit is '',I3,''.'')') - & BLENGTH - 82*12 - 2, 82*12 - 2 - CALL GET_INPUT_PROMPT(INPUT,ILEN, - & 'Type C to broadcast anyway, A to only ADD message,' - & //' or Q to Quit: ') - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN - BRDCST = .TRUE. - ELSE IF (.NOT.STREQ(INPUT(:1),'C')) THEN - GO TO 910 - END IF - END IF - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! Username - END IF - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THEN - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '// - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK) - END IF - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletin - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IF - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF (FOLDER_NUMBER.GE.0) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL ADD_TAG(IER1,2) - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF -C -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP, -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same cluster -C as that of the BULLCP node. -C - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET) - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - ELSE IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR. - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - IF (BTEST(FOLDER_FLAG,10).OR.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & INDESCRIP(:LENDES),STATUS) - ELSE - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LENDES),STATUS) - END IF - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & ERR=910,FORM='FORMATTED') - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IF - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INLINE,ILEN).NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INLINE,ILEN) - IF (LENFRO.EQ.0) THEN - INPUT = INLINE(:ILEN)//',' - ELSE - INPUT = INPUT(:LENFRO)//INLINE(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - - IF (LENFRO.GT.1) THEN - LENFRO = LENFRO - 1 - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INPUT(I:I).EQ.'"') THEN - INPUT = INPUT(:I)//'"'//INPUT(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & INDESCRIP(:LENDES),STATUS) - END IF - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:INDEX(FOLDER_DESCRIP,'>')-1) - CALL NEWS_POST(BULL_PARAMETER(:LEN_P),.FALSE.,IER, - & INDESCRIP) - END IF - -200 IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GO TO 200 - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GO TO 200 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 200 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 200 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 200 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds ',I,' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*4 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP)) - - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG) - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC' - - DATA READ_UAI/.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE. - RETURN - END IF - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE. - END IF - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURN - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')') - RETURN - END IF - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN) - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN() - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - RETURN - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - SUBROUTINE INIT_BULLETIN(NOX) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - DATA PAGE_LENGTH/24/,PAGE_WIDTH/80/ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (NOX) CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER(:LEN_P) - CALL CHECK_DIR(BULL_PARAMETER,.FALSE.) - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - END IF - CALL LIB$REVERT - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE IF (COMMAND_PROMPT(I:I).EQ.'/') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL(.FALSE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS1') THEN - CALL NEWS2BULL(.TRUE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'SMTP') THEN - CALL SEND_MAIL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - IF (NOX) CALL CRELNM('SYS$INPUT','TT') ! Input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - IF (NOX) CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - - CALL OPEN_OLD_TAG - - IF (.NOT.NOX) THEN - CALL NEW_MESSAGE_NOTIFICATION - RETURN - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IF - END IF - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bulletin.hlp b/decus/vmslt02a/bulletin/bulletin.hlp deleted file mode 100644 index 8479322..0000000 --- a/decus/vmslt02a/bulletin/bulletin.hlp +++ /dev/null @@ -1,151 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vmslt02a/bulletin/bulletin.lnk b/decus/vmslt02a/bulletin/bulletin.lnk deleted file mode 100644 index f0fed2c..0000000 --- a/decus/vmslt02a/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.3" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.5" diff --git a/decus/vmslt02a/bulletin/bulletin0.for b/decus/vmslt02a/bulletin/bulletin0.for deleted file mode 100644 index e427729..0000000 --- a/decus/vmslt02a/bulletin/bulletin0.for +++ /dev/null @@ -1,2583 +0,0 @@ -C -C BULLETIN0.FOR, Version 11/9/99 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - IMMEDIATE = 0 - IF (INCMD(:3).EQ.'DIR') THEN - FORCE = .TRUE. - ELSE - FORCE = CLI$PRESENT('FORCE') - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IF (INCMD(:3).EQ.'DIR') THEN - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - ELSE - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET.EQ.1) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IER1 = SBULL + 1 - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER1) - SUBJECT = DESCRIP - IER2 = 0 - IF (IER2.EQ.0.AND.IER1.EQ.SBULL+1) CALL - & REMOTE_DELETE(SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - ELSE IF (REMOTE_SET.EQ.3) THEN - BULL_DELETE = SBULL - 1 - IER = 0 - IF (CLI$PRESENT('REASON')) THEN - CALL CLI$GET_VALUE('REASON',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) RETURN - IF (EBULL.EQ.SBULL) THEN - WRITE(6,1030) - RETURN - END IF - END IF - END DO - SUBJECT = DESCRIP - IF (.NOT.TEST_NEWS_OWNER().AND.SETPRV_PRIV().AND. - & .NOT.FORCE) THEN - SUBJECT = 'CanceL' - IF (CLI$PRESENT('REASON')) THEN - SUBJECT = SUBJECT(:6)//BULL_PARAMETER(:LEN_P) - END IF - END IF - CALL REMOTE_DELETE - & (SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - RETURN - END IF - END DO - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - SUBJECT = DESCRIP - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.NE.USERNAME - END IF - IF (ASK.AND..NOT.FORCE) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - IF (REMOTE_SET.EQ.4) THEN - SUBJECT = 'CanceL' - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.(TEST_NEWS_OWNER().OR. - & SETPRV_PRIV())) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2),EX(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:9).EQ.'19') EXDATE(8:9) = '18' - IF (EXDATE(8:9).EQ.'20') EXDATE(8:9) = '19' - IF (EXDATE(8:9).EQ.'18'.AND.EXDATE(10:10).LT.'6') - & EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX,EX) - IER = SYS$ASCTIM(,INPUT,EX,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - DATA EXCLUDE_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DIRMODE/ DIRMODE - DATA DIRMODE/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - CHARACTER GROUP*80,STAT*4 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - DIRMODE = .TRUE. - - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - FOUND = 0 - OUT = 6 - - CONT = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - CONT = CLI$PRESENT('CONTINUE') - ELSE IF (INCMD(:3).EQ.' '.AND.NFOLDER.LT.0) THEN - CONT = .TRUE. - END IF - IF (CONT) THEN - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - SUBJECT = SUBJECT1 - REPLY = REPLY1 - SEARCH = SEARCH1 - FROM_SEARCH = FROM_SEARCH1 - SINCE = SINCE1 - NEW = NEW1 - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - IF (.NOT.ANY_SEARCH) THEN - WRITE (6,'('' ERROR: No previous search to continue.'')') - RETURN - END IF - INCMD = ' ' - LEN_P = 0 - DIR_COUNT = DIR_COUNT1 - NFOLDER = NFOLDER1 - I = DIR_COUNT - IF (DIR_COUNT.EQ.-1) THEN - I = SBULL - 1 - END IF - GO TO 200 - END IF - NFOLDER = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('OUTPUT',BULL_PARAMETER,LEN_P)) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & DEFAULTFILE='.LIS', - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - WRITE(6,1000) BULL_PARAMETER(:LEN_P) - RETURN - END IF - OUT = 3 - INQUIRE (UNIT=3,NAME=BULL_PARAMETER) - WRITE (6,1040) BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - END IF - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - EXTRACTING = CLI$PRESENT('EXTRACT') - DELETING = CLI$PRESENT('DELETE') - UNDELETING = CLI$PRESENT('UNDELETE') - IF (DELETING.OR.UNDELETING) THEN - OLDPAGING = PAGING - PAGING = .FALSE. - END IF - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - NEGATED = CLI$PRESENT('NEGATED') - IF (SEARCH) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (SUBJECT) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (FROM_SEARCH) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (REPLY) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3 - NEGATED = .TRUE. - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - DELETING = .FALSE. - UNDELETING = .FALSE. - IF (INCMD(:3).EQ.'IND') THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - REPLY_FIRST = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - ELSE - NEW = .FALSE. - END IF - END IF - OUTPUT = EXTRACTING.OR.PRINTING - - START = .FALSE. - SINCE = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - NFOLDER1 = -1000 - SUBJECT1 = SUBJECT - REPLY1 = REPLY - SEARCH1 = SEARCH - FROM_SEARCH1 = FROM_SEARCH - I = SBULL - 1 - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - SINCE1 = SINCE - NEW1 = NEW - GOTO 200 - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - CALL INIT_QUEUE(EXCLUDE_D1,%DESCR(I)) - EXCLUDE_D = EXCLUDE_D1 - NEXCLUDE = 0 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - IF (NEW.AND.IER.EQ.0) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - IF (READ_TAG) CALL DECREMENT_MSG_KEY - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - INCMD(253:) = INCMD(:4) - INCMD(:4) = 'LAST' - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - I = I - 1 - END DO - INCMD = INCMD(253:) - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - INCMD(253:) = INCMD(:4) - INCMD(:4) = 'LAST' - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - IF (NUM.GT.0) I = I - 1 - END DO - INCMD = INCMD(253:) - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) THEN - J = J + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT.OR.OUT.EQ.3) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - EXCLUDE_D = EXCLUDE_D1 - SEXC = NBULL + 1 - LEXC = 0 - DO I=1,NEXCLUDE - CALL READ_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(J)) - J = ABS(J) - IF (J.LT.SEXC) SEXC = J - IF (J.GT.LEXC) LEXC = J - END DO - I1 = SBULL - I = SBULL - NEXT = .FALSE. - DO WHILE (I.LE.EBULL.AND.I1.LE.NBULL) - EXCLUDE_D = EXCLUDE_D1 - J = 0 - IER = I1 - IF (I1.GE.SEXC.AND.I1.LE.LEXC) THEN - N = NEXCLUDE - DO WHILE (N.GT.0.AND.J.EQ.0) - CALL READ_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(J)) - N = N - 1 - IF (J.NE.I1.AND.J.NE.-I1) J = 0 - END DO - IF (J.LE.0) THEN - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(I1,IER) - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - IF (J.LT.0) SYSTEM = IBSET(SYSTEM,8) - END IF - ELSE - CALL READDIR(I1,IER) - END IF - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1 - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - I = I + 1 - END IF - I1 = I1 + 1 - END DO - NEXT = .TRUE. - EBULL = I - 1 - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - EBULL = EBULL - SBULL + DIR_COUNT - SBULL = DIR_COUNT - I = SBULL - END IF - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY, - & TAG_TYPE) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVE - END IF - END IF - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - END IF - ELSE - NBULL = 0 - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN - DIR_TYPE = 'seen' - END IF - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - IF (INCMD(:3).EQ.'DIR'.AND.ANY_SEARCH) THEN - IF (.NOT.CLI$PRESENT('START').AND..NOT.CONT) THEN - WRITE (6,'('' No matches found starting search'', - & '' from message number '',I)') SBULL - DIR_COUNT = -1 - GO TO 9999 - END IF - END IF - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - IF (NFOLDER.EQ.0) CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT, - & DELETING,UNDELETING) - - TAG = (BULL_TAG.AND.(REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1)).OR. - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THEN - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN - START_SEARCH = BULL_POINT - END IF -200 CLOSED = .FALSE. - IF (ANY_SEARCH.OR.OUTPUT) THEN - NUM = 0 - IF (NFOLDER.NE.-1000) THEN - CLOSED = .TRUE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - CLOSED_FILES = .FALSE. - SEARCH_NUM = 1 - REVERSE = .FALSE. - END IF - DO WHILE (I.LE.EBULL.AND.FOUND.GT.-3) - IF (.NOT.ANY_SEARCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (NFOLDER.NE.-1000.AND.I.GE.SBULL) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SLEN,0, - & START_SEARCH,REVERSE,SUBJECT,REPLY_FIRST,.FALSE., - & .TRUE.,FROM_SEARCH,NEGATED,.FALSE.) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - IF (NFOLDER.LT.0.AND.(I.EQ.F_START.OR.I.EQ.DIR_COUNT)) THEN - IF (FEEDBACK) CALL LIB$ERASE_PAGE(1,1) - CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT, - & DELETING,UNDELETING) - DIR_COUNT = 0 - BULL_POINT = MSG_NUM - 1 - PRINT_HEADER = .TRUE. - END IF - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - TAG_TYPE = DUMMY - END IF - IF (NFOLDER.LT.0.AND..NOT.OUTPUT) THEN - NUM = NUM + 1 - IF (NUM.EQ.PAGE_LENGTH-6) I = EBULL + 1 - END IF - ELSE IF (NFOLDER.LT.0.AND.(OUTPUT.OR.I.LE.SBULL)) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSED = .FALSE. - END IF - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - CALL CLOSE_BULLFOLDER - IF (GFOUND) THEN - START_BULL = 0 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - IF (F1_START.GT.0.AND.F1_START.LE.F1_NBULL) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - START_SEARCH = F_START - 1 - IF (IER.AND.(NEW.OR.SINCE)) THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER1,DATETIME) - CALL CLOSE_BULLDIR - IF (IER1.NE.0) THEN - START_SEARCH = IER1 - 1 - ELSE - IER = 0 - END IF - END IF - END IF - IF (.NOT.IER.OR.F1_START.EQ.0.OR. - & F1_START.GT.F1_NBULL) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER, - & IER) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - GFOUND = .FALSE. - IF (FLAG.EQ.1) CALL CLOSE_BULLFOLDER - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - SBULL = F_START - I = SBULL - 1 - EBULL = F_NBULL - END IF - ELSE - NFOLDER = 0 - END IF - END DO - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - ELSE IF (NFOLDER.EQ.0) THEN - WRITE (6,'('' No messages found.'')') - END IF - IF (NFOLDER.EQ.0) I = EBULL + 1 - IF (NFOLDER.LT.-1000) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED = .TRUE. - END IF - NFOLDER1 = NFOLDER - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - I = EBULL + 1 - END IF - CALL CANCEL_CTRLC_AST - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.GE.SBULL.AND.I.LE.EBULL.AND.NFOLDER.NE.-1000) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN - OUTLINE = '>' - ELSE IF (BTEST(SYSTEM,8)) THEN - OUTLINE = '#' - ELSE - OUTLINE = ' ' - END IF - IF (BTEST(SYSTEM,29)) THEN - OUTLINE(2:) = '*' - ELSE - OUTLINE(2:) = ' ' - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3) - IF (EXDATE(8:12).LT.'1994'.AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin? - EXPIRES = 'Permanent' - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11) - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9) - ELSE - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11) - END IF - NOTHING = .FALSE. - IF (OUT.EQ.6) THEN - WRITE(OUT,'(1X,A)') OUTLINE - ELSE - WRITE(OUT,'(A)') OUTLINE - END IF - IF (OUTPUT) THEN - FOUND_MSG = .TRUE. - CALL SYS$SETAST(%VAL(0)) - NEXT = .FALSE. - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES) - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES,PRINT_HEADER) - PRINT_HEADER = .FALSE. - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0 - ELSE - MSG_NUM = -MSG_NUM - END IF - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1)) - END IF - IF (DELETING) THEN - BULL_SAVE = BULL_POINT - BULL_POINT = MSG_NUM - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - CALL DELETE_MSG - IF (CLOSED) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - BULL_POINT = BULL_SAVE - ELSE IF (UNDELETING) THEN - BULL_SAVE = BULL_POINT - BULL_POINT = MSG_NUM - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - CALL UNDELETE - IF (CLOSED) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - BULL_POINT = BULL_SAVE - END IF - END IF - I = I + 1 - IF (ANY_SEARCH) IER = SYS$CANTIM(,) - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.OUTPUT) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IF - END IF - - IF (DIR_COUNT.GT.NBULL - & .OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THEN - ! Outputted all entries? - IF (PRINTING) THEN - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THEN - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IF - ELSE IF (EXTRACTING.AND.FOUND_MSG) THEN - CALL FILE(0,CLOSED_FILES,.FALSE.) - END IF - IF (NFOLDER.LT.0) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE - DIR_COUNT = -1 ! Yes. Set counter to -1. - END IF - ELSE IF (NFOLDER.NE.0.OR.(-NFOLDER1.EQ.FOLDER_NUMBER.AND. - & INCMD(:1).EQ.' ')) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE IF (FLAG.NE.1) THEN - WRITE(6,1010) ! Else say there are more - END IF - -9999 POSTTIME = .FALSE. - NEXT = .FALSE. - DIRMODE = .FALSE. - IF (NFOLDER.NE.0.OR.-NFOLDER1.EQ.FOLDER_NUMBER) THEN - DIR_COUNT1 = DIR_COUNT - IF (DIR_COUNT1.GT.NBULL) DIR_COUNT1 = -1 - END IF - IF (OUT.EQ.3) CLOSE (UNIT=3) - IF (DELETING.OR.UNDELETING) PAGING = OLDPAGING - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(1X,/,' Press RETURN for more...',/) -1020 FORMAT(1X,/,' Press RETURN for more, type SEARCH to read ', - & 'these messages.',/) -1040 FORMAT(' Output being written to ',A,'.') - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER) - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT,PRINT_HEADER) -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER*128 FILENAME - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THEN - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IF - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THEN - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IF - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - END IF - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = FILE_NUM - EBULL = SBULL - END IF - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F) - - IF (.NOT.IER) THEN - FILENAME = FOLDER - DO I=1,LEN(FILENAME) - IF (FILENAME(I:I).EQ.'.') FILENAME(I:I) = '_' - END DO - FILENAME = FILENAME(:TRIM(FILENAME))//'.TXT' - LEN_F = TRIM(FILENAME) - END IF - - IF (TRIM(FILE_DIRECTORY).GT.0.AND.INDEX(FILENAME,':').EQ.0 - & .AND.INDEX(FILENAME,'[').EQ.0) THEN - FILENAME = FILE_DIRECTORY(:TRIM(FILE_DIRECTORY))//FILENAME - LEN_F = TRIM(FILENAME) - END IF - - CALL STR$UPCASE(FILENAME,FILENAME) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE. - FIRST = .TRUE. - END IF - - IF (PRINT_HEADER) THEN - WRITE (3,'(/,''Newsgroup: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1 - IF (FBULL1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - OPENED = .FALSE. - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(FBULL,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DO - -100 IF (FILE_NUM.GT.0) THEN - FILE_NUM = -FILE_NUM - RETURN - END IF - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created. - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - END IF - - GO TO 10 - -900 WRITE(6,1000) FILENAME(:LEN_F) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message ',A,' written to ',A) -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A) -1050 FORMAT('Subj: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN) - - CALL LIB$MOVC3(8,IN,OUT) - - RETURN - END - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - FOLDER_NAME = FOLDER - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSE - RETURN ! Don't notify - END IF - END IF - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSE - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM) - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time - ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSER - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LOGIN_BTIM_NEW) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF - - CALL GET_NODE_NUMBER(NODE_NUMBER1,NODE_AREA1) - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100 - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IGNORE = BTEST(SYSTEM,2).AND.(NODE_AREA.EQ.NODE_AREA1).AND. - & (NODE_NUMBER.AND.NODE_NUMBER1) - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF ((USERNAME.NE.FROM.OR.SYSTEM).AND..NOT.IGNORE) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - ELSE - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - END IF - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - INREAD = '+' - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' ' - END IF - IF (LEFT) THEN - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN) - LEFT = .FALSE. - ILEN = 0 - INREAD = '+' - ELSE IF (ILEN.LE.WIDTH) THEN - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN) - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSE - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ') - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH) - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0) - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DO - IF (INPUT(ILEN:ILEN).EQ.' ') THEN - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEN - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE. - ELSE - WIDTH = PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE (6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - PAGE = PAGE + 1 - ELSE - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)// - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN) - & //' '//FOLDER_NAME(:FLEN)// - & ' to read these messages.' - END IF - PAGE = PAGE + 1 - END IF - -9999 IF (LOGIN_SWITCH) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION, - & OUT,DELETING,UNDELETING) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - CHARACTER*(*) OUTLINE - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULL - ELSE - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IF - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ') - OUTLINE(I:) = OUTLINE(I+1:) - END DO - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINE - BULL_PARAMETER = ' ' - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1)) THEN - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THEN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IF - IF (PRINTING) THEN - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - ELSE IF (DELETING) THEN - BULL_PARAMETER = 'DELETING '//BULL_PARAMETER - ELSE IF (UNDELETING) THEN - BULL_PARAMETER = 'UNDELETING '//BULL_PARAMETER - END IF - - IF (OUT.EQ.6) THEN - WRITE (OUT,'(''+'',A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - ELSE - WRITE (OUT,'(A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - END IF - -1000 FORMAT(A,1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(A,1X,'Description',43X,'From',8X,'Expires',/) - - RETURN - END - - - - SUBROUTINE GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER TODAY(2) - - CHARACTER DATETIME*24 - - IF (SINCE) THEN ! Was /SINCE specified? - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - IER = 0 - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - END IF - END IF - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bulletin1.for b/decus/vmslt02a/bulletin/bulletin1.for deleted file mode 100644 index 7879346..0000000 --- a/decus/vmslt02a/bulletin/bulletin1.for +++ /dev/null @@ -1,2502 +0,0 @@ -C -C BULLETIN1.FOR, Version 8/24/00 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_S = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',SENDTO(LEN_S+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_S = LEN_S + I + 1 - SENDTO(LEN_S:LEN_S) = ',' - END DO - LEN_S = LEN_S - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_S) - IF (SENDTO(I:I).EQ.'"') THEN - SENDTO = SENDTO(:I)//'""'//SENDTO(I+1:) - I = I + 2 - LEN_S = LEN_S + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',SENDTO(:LEN_S) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//SENDTO(:LEN_S) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*32 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - INIT_NEWSFEED = .FALSE. - - NEWSGROUP = .FALSE. - MAILTO = 0 - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - RETURN - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - I = INDEX(FOLDER1_DESCRIP,'<') - J = INDEX(FOLDER1_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'@').LT.1 - & .OR.INDEX(FOLDER1_DESCRIP(I:),'@').GT.J-I+1).AND. - & (INDEX(FOLDER1_DESCRIP(I:),'.') - & .LE.J-I+1.AND.INDEX(FOLDER1_DESCRIP(I:),'.').GT.0)) THEN - NEWSGROUP = .TRUE. - WRITE (6,'('' Init news feed counter to feed '', - & ''all messages in news group (Y),'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'or set to feed only new messages (N,default) ? ') - INIT_NEWSFEED = RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y' - I = INDEX(FOLDER1_DESCRIP,'[') - J = INDEX(FOLDER1_DESCRIP,']') - END IF - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER1_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER1_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'.') - & .GT.J-I+1.OR.INDEX(FOLDER1_DESCRIP(I:),'.').EQ.0) - & .AND.MAILTO.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(RESPONSE) - IF (TRIM(RESPONSE).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//RESPONSE(:TRIM(RESPONSE))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - IF (NEWSGROUP) FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - IF (MAILTO.EQ.2) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (MAILTO.EQ.3) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (INIT_NEWSFEED) THEN - F_LAST = 0 - ELSE IF (NEWSGROUP) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - I = INDEX(FOLDER_DESCRIP,'<') + 1 - J = INDEX(FOLDER_DESCRIP,'>') - 1 - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER_DESCRIP(I:J),IER) - CALL CLOSE_BULLNEWS - CALL OPEN_BULLFOLDER - F_LAST = F1_NBULL - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /FEED/ FEED - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256,TODAY*24 - CHARACTER SCRFILE*18 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - IF (.NOT.BULLCP_NEWS.AND.FOLDER.EQ.FOLDER1) THEN - WRITE (6,'('' ERROR: Destination cannot be same as'', - & '' current location.'')') - RETURN - END IF - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.EQ.2) THEN - CALL DISCONNECT_REMOTE - ELSE IF (IER1.EQ.0) THEN - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER1 = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - NEWS2BULL = NEWS2BULL.AND..NOT.TO_NEWS.AND.ORIGINAL - IF (IER1.EQ.0.AND..NOT.NEWS2BULL) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (IER1.EQ.0.AND.TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.EQ.4) THEN - IER1 = 0 - ELSE IF (IER1.NE.0) THEN - I = IER - ELSE IF (.NOT.NEWS2BULL) THEN - NUM_COPY = NUM_COPY + 1 - END IF - NEWS2BULL = .FALSE. - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - FROM_BULL_POINT = BULL_POINT - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (REMOTE_SET.EQ.4.AND..NOT.BULLCP_NEWS).OR.REMOTE_SET.EQ.3 - - POST_FEED = .FALSE. - SLIST = 0 - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST:INDEX(FOLDER_DESCRIP,'>')-1) - POST_FEED = .TRUE. - END IF - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') + 1 - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - END IF - IF (SLIST.GT.1) THEN - IF (NEWS_FEED()) THEN - ELIST = INDEX(FOLDER_DESCRIP,']') - 1 - ELSE - ELIST = INDEX(FOLDER_DESCRIP,'>') - 1 - END IF - END IF - IF (CLI$PRESENT('LOCAL').AND..NOT.BULLCP_NEWS) SLIST = 0 - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS.OR.(POST_FEED.AND.SLIST.LE.1)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - END IF - IF (.NOT.POST_NEWS) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=FROM_BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF ((FROM_REMOTE.OR.FROM_REMOTE.EQ.4).AND. - & (TO_NEWS.AND.ORIGINAL)) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2100' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (SLIST.GT.1.OR.POST_NEWS.OR.POST_FEED) THEN - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - IF (SLIST.GT.1) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE='BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'BULL.SCR' - END IF - ENDIF - ILEN = LINE_LENGTH + 1 - - INFROM = FROM - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - IF (POST_NEWS.OR.POST_FEED) THEN - USE_INFROM = ORIGINAL - IF (CLI$PRESENT('LOCAL')) NEWS2BULL = .TRUE. - CALL NEWS_POST - & (SCRFILE(:TRIM(SCRFILE)),.TRUE.,IER,POST_SUBJECT) - NEWS2BULL = .FALSE. - END IF - IF (SLIST.GT.1) THEN - CLOSE (UNIT=3) - USE_INFROM = ORIGINAL - IF (BTEST(FOLDER_FLAG,10).OR.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - ELSE - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - END IF - CALL LIB$DELETE_FILE(SCRFILE(:TRIM(SCRFILE))//';') - ELSE IF (POST_FEED.OR.POST_NEWS) THEN - REWIND (UNIT=3) - END IF - BLOCK = BLOCK_SAVE - LENGTH = LENGTH_SAVE - END IF - IF (.NOT.POST_NEWS) THEN - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - IF (.NOT.ORIGINAL) SYSTEM = IBSET(SYSTEM,4) - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (SLIST.LT.1.AND.POST_NEWS.OR.POST_FEED) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - IF (TEST_BULLCP().NE.2) - & WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADER - IF (BULLCP_NEWS) RETURN - - IF (INDEX(INCMD,' ').EQ.TRIM(INCMD)+1) - & INCMD = INCMD(:TRIM(INCMD))//' '//FOLDER1 - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IF - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./ - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND. - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0 - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN) - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0) - IF (CHANGED) THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IF - - IF (INCMD(:4).EQ.'PRIN') THEN - IF (CLI$PRESENT('CANCEL')) THEN - WRITE (6,'('' Cancelling all previously queued messages.'')') - CLOSE (UNIT=24,DISPOSE='DELETE') - FIRST = .TRUE. - RETURN - END IF - END IF - -50 IF (PRINT_NUM.EQ.0) THEN - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = PRINT_NUM - EBULL = SBULL - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name - IF (QLEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - END IF - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100 - CLOSE (UNIT=24,DISPOSE='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - END IF - -1040 FORMAT(' Message ',A,' sent to printer.') -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE. - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) - END IF - - CALL DISABLE_PRIVS - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A, - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE. - GO TO 50 - END IF - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ_MSG -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /POST/ POSTTIME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /THREAD/ THREAD - DATA THREAD /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/,LAST_THREAD/.FALSE./ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH) - CHARACTER HEADLINE*132 - - LOGICAL SINCE,PAGE - - EXTERNAL CLI$_NEGATED - - FIRST = BULL_READ.LT.F_START - KILL = BTEST(BULL_USER_CUSTOM,3) - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3) - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE. - END IF - ROTC = CLI$PRESENT('ROTATE') - END IF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - THREAD = .FALSE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - THREAD = CLI$PRESENT('THREADS') - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSE - BULL_READ = 1 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE').AND. - & .NOT.THREAD) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW').OR.(THREAD.AND..NOT. - & CLI$PRESENT('SINCE').AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND.(.NOT.LAST_THREAD - & .OR.LAST_THREAD_NUMBER.NE.FOLDER_NUMBER) - & .AND.CLI$PRESENT('NEW').NE.%LOC(CLI$_NEGATED))) THEN - NEW = .TRUE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READDIR_KEYGE(IER) - IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_BTIM) - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - CALL CLOSE_BULLDIR - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - IER = 0 - END IF - END DO - CALL CLOSE_BULLDIR - ELSE - IER = 0 - SKIPPED_THREAD = .FALSE. - IF (THREAD) CALL OPEN_BULLDIR_SHARED - DO WHILE (IER.EQ.0) - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - BULL_READ = IER - END IF - IF ((SKIPPED_THREAD.OR.(THREAD.AND.IER.NE.0)).AND. - & BULL_READ.LE.F_NBULL) THEN - CALL READDIR(BULL_READ,IER) - IER = IER - 1 - IF (IER.NE.BULL_READ) IER = 0 - END IF - IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - MSG_NUM = IER - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,DUMMY,DUMMY) - IF (IER1.EQ.0) THEN - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(IER) - ELSE - BULL_READ = BULL_READ + 1 - END IF - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - WRITE (6,'('' No more messages are present.'')') - IF (SKIPPED_THREAD) CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - SKIPPED_THREAD = .TRUE. - BULL_READ = IER + 1 - IER = 0 - END IF - END DO - END IF - IF (THREAD) CALL CLOSE_BULLDIR - BULL_READ = IER - IER = IER + 1 - ELSE IF (THREAD) THEN - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999 - ELSE - BULL_READ = IER - 1 - IER = IER + 1 - END IF - SINCE = .TRUE. - ELSE IF (CLI$PRESENT('BULLETIN_NUMBER')) THEN - BULL_READ = BULL_READ - 1 - ELSE IF (LAST_THREAD_NUMBER.EQ.FOLDER_NUMBER) THEN - BULL_READ = LAST_THREAD_READ - ELSE - BULL_READ = BULL_POINT - 1 - END IF - CALL OPEN_BULLDIR_SHARED - IER = BULL_READ + 1 - IER1 = .FALSE. - DO WHILE (.NOT.IER1.AND.IER.EQ.BULL_READ+1.AND. - & BULL_READ.LT.F_NBULL) - BULL_READ = BULL_READ + 1 - CALL READDIR(BULL_READ,IER) - IER1 = BTEST(SYSTEM,8) - IF (IER1.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER2,DUMMY,DUMMY) - IER1 = IER2.NE.0 - END IF - END DO - IF (.NOT.IER1) THEN - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - END IF - END IF - - NEXT = .FALSE. - LAST_THREAD = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - LAST_THREAD = THREAD - IF (THREAD) THEN - LAST_THREAD_READ = BULL_READ - LAST_THREAD_NUMBER = FOLDER_NUMBER - ELSE - IF (.NOT.SINCE.AND..NOT.NEW - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF - END IF - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THEN - IER = 0 - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR. - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN - MSG_NUM = F_NBULL+1 - ELSE - MSG_NUM = BULL_NOW - END IF - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE - CALL GET_THIS_OR_NEXT_TAG - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0 - END IF - END IF - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END IF - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END DO - CALL CLOSE_BULLDIR - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READ - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSE - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0 - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IF - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE. - CALL READDIR(BULL_READ,IER) - END IF - END IF - IF (REMOTE_SET.LT.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - IF (IER.NE.BULL_READ+1) THEN - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0 - END IF - CALL CLOSE_BULLDIR - ELSE - IER = -1 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) ! If not, then error out - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - - SAVE_BULL_POINT = BULL_POINT - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(FIRST.OR.NEW.OR.NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEN - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - OK = OK.AND.(.NOT.THREAD.OR.BTEST(SYSTEM,8)) - - IF (.NOT.OK) THEN - BULL_POINT = SAVE_BULL_POINT - BULL_NOW = MSG_NUM - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN - BULL_READ = MSG_NUM - 1 - ELSE - BULL_READ = MSG_NUM + 1 - IF (INCMD(:4).EQ.'FIRS'.OR.FIRST) NEXT = .TRUE. - END IF - IF (REMOTE_SET) CALL CLOSE_BULLFIL - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - ELSE IF (.NOT.THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_NOW) - END IF - IF (BULL_READ.GT.F_NBULL.OR.BULL_READ.LT.F_START) THEN - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - GO TO 50 - END IF - BLOCK = BLOCK_SAVE - END IF - - NEXT = .FALSE. - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (.NOT.THREAD.OR.INCMD(:4).NE.'READ') THEN - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.BULL_READ) - & CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - END IF - END IF - - EDIT = .FALSE. - - PAGE_WIDTH = REAL_PAGE_WIDTH - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN - IF (CLI$PRESENT('EDIT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 9999 - END IF - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTH - PAGE = .FALSE. - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSE - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL - END IF - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:) - END DO - I = TRIM(HEADLINE) - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)) - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - ELSE - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ' - & .AND..NOT.BTEST(SYSTEM,4)) THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROM - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - IF (EDIT) WRITE(3,'(1X)') - ELSE - END = END + 1 - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IF - END IF - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) THEN - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter - GO TO 9999 - END IF - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - -9999 POSTTIME = .FALSE. - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - RETURN - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO - - RETURN - END - - - - - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1 - EQUIVALENCE (INREAD4,INREAD) - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - BULL_POINT_READ = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - - GO TO 12 - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - - BULL_POINT = BULL_POINT_SAVE - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN - ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL FILE(0,.TRUE.,.FALSE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THEN - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THEN - WRITE (6,'(''+B'',$)') - INCMD = 'RESPOND/LIST' - ELSE - GO TO 11 - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')') - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLY - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message', - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),', - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) -1040 FORMAT(' Type P to post reply, U to reply to user,', - & ' B to do both, or other to quit: ',$) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END - - - - - LOGICAL FUNCTION NEWS_FEED() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - I = SLIST + 1 - FLEN = TRIM(FOLDER_DESCRIP) - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN -C IF (INDEX(FOLDER_DESCRIP(SLIST:I),'.').GT.0) -C & NEWS_FEED = .TRUE. - NEWS_FEED = .TRUE. - RETURN - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND. - & FOLDER_DESCRIP(I:I).NE.'@'.AND. - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE - I = FLEN + 2 - END IF - END DO - END IF - - RETURN - END - - - - - LOGICAL FUNCTION MAIL_POST() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NEWS_FEED()) THEN - MAIL_POST = INDEX(FOLDER_DESCRIP,'[').GT.0 - ELSE - MAIL_POST = INDEX(FOLDER_DESCRIP,'<').GT.0 - END IF - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bulletin10.for b/decus/vmslt02a/bulletin/bulletin10.for deleted file mode 100644 index 3aef60c..0000000 --- a/decus/vmslt02a/bulletin/bulletin10.for +++ /dev/null @@ -1,4168 +0,0 @@ -C -C BULLETIN10.FOR, Version 7/21/01 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - COMMON /HEADER_SEEN/ HEADER_SEEN - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - LAST_LF_SEEN = LF_SEEN - LAST_REAL_LF_SEEN = REAL_LF_SEEN - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - CR_SEEN = INDEX(BUFFER(START_READ:END_READ),CR) - IF (CR_SEEN.GT.0) THEN - IF (END_LINE.GT.0) THEN - IF (CR_SEEN.EQ.END_LINE-2.AND.BUFFER(START_READ+CR_SEEN: - & START_READ+CR_SEEN).EQ.CR) CR_SEEN = CR_SEEN + 1 - ELSE - IF (START_READ+CR_SEEN.EQ.END_READ.AND. - & BUFFER(END_READ:END_READ).EQ.CR) CR_SEEN = 0 - END IF - END IF - IF ((END_LINE.EQ.0.AND.CR_SEEN+START_READ-1.LT.END_READ.AND. - & CR_SEEN.GT.0).OR.CR_SEEN.LT.END_LINE-1) THEN - END_LINE = CR_SEEN - CR_SEEN = 1 - ELSE - CR_SEEN = 0 - END IF - LF_SEEN = END_LINE.GT.0 - IF (END_LINE.GT.257-CR_SEEN.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - IF (.NOT.HEADER_SEEN) END_LINE = 254 - END IF - REAL_LF_SEEN = INDEX(BUFFER(START_READ:END_READ),LF).LE.END_LINE - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - IF (BUFFER(EB:EB).EQ.LF) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - IF (EB.GT.0.OR.LAST_LF_SEEN) RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE(:MIN(LEN(WRITE),256)) - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - NEWS_WRITE = NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - - LOGICAL FUNCTION NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - NEWS_RECONNECT = .FALSE. - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - NEWS_RECONNECT = .TRUE. - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /HEADER/ HEADER - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER().OR.SETPRV_PRIV()) THEN - IF (REMOTE_SET.EQ.4) THEN - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (INPUT(:11).EQ.'Message-ID:') THEN - MESSAGE_ID = INPUT(14:ILEN-1) - ILEN = 0 - END IF - END DO - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - CALL NEWS_POST('cancel',0,IER,SUBJ) - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - DO WHILE (BUFFER(SB:EB).NE.'.'.AND. - & .NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX( - & BUFFER(SB:EB),' ')+SB-2),J,,%VAL(1))) - IF (.NOT.NEWS_READ()) RETURN - END DO - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - STAT = .TRUE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(FROM,TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - HEADER_SEEN = .FALSE. - LF_SEEN = .FALSE. - LAST_LF_SEEN = .FALSE. - REAL_LF_SEEN = .FALSE. - LAST_REAL_LF_SEEN = .FALSE. - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8 - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONE - CHARACTER*4 ZONE - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/ - - CHARACTER*8 TIMES(1) - DATA TIMES /'-5:30'/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - IF (INDEX(ZONES,ZONE)/4.LT.4) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) - END IF - ELSE - HOUR = '00:00' - END IF - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_TI_L(TIME(:2),DATE,,%VAL(1)) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - SENDER_LINE = ' ' - NEWSGROUPS = ' ' - FOLLOWUP = ' ' - LREF = 0 - NEWS2BULL = .FALSE. - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.'.OR..NOT.LAST_REAL_LF_SEEN) - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126) - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(FROM,BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+6).EQ.'Sender:'.AND.EB.GE.SB+8) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+8:EB))+SB+7 - SENDER_LINE = ': '//BUFFER(SB1:EB) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+11).EQ.'Followup-To:'.AND. - & EB.GT.SB+12) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+13:EB))+SB+12 - FOLLOWUP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (INDEX(BUFFER(SB:), - & 'X-Newsreader: News2bull').EQ.1) THEN - NEWS2BULL = .TRUE. - IF (LPATH.EQ.0) CALL GET_PATHNAME - I = INDEX(BUFFER(SB:),'@') - IF (I.GT.0) THEN - SAMEHOST = STREQ(PATHNAME(2:LPATH),BUFFER(SB+I:EB)) - END IF - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN - IF (SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = SENDER_LINE(:TRIM(SENDER_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - ELSE - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - CALL GET_FROM(FROM,FROM_LINE(7:),TRIM(FROM_LINE)) - END IF - LAST_FROM = .TRUE. - ELSE - LAST_FROM = .FALSE. - END IF - IF (.NOT.LAST_FROM.AND.SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = 'From'//SENDER_LINE - END IF - END IF - END DO - - NEWS2BULL = NEWS2BULL.AND.SAMEHOST - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IER = 4 - RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'1FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - START = -1 - CALL NEWNEWS(IN_BTIM,IER) - IF (IER.NE.0) START = IER -C -C The following code makes use of the NNTP command NEWNEWS, but is -C known to be slow and buggy in many servers. -C -C IER = SYS$ASCTIM(,TIME,IN_BTIM,) -C CALL DATE_TIME(TIME) -C SKIP = 0 -C DO WHILE (SKIP.GE.0) -C IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( -C & FOLDER_NAME))//' '//TIME)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C IF (BUFFER(:2).EQ.'23') THEN -C IF (.NOT.NEWS_READ()) CALL EXIT -C DO I=1,SKIP -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (FIRST.EQ.'.') RETURN -C DO WHILE (BUFFER(SB:EB).NE.'.') -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) -C & CALL EXIT -C IF (.NOT.NEWS_READ()) CALL EXIT -C IF (BUFFER(:2).EQ.'22') THEN -C IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN -C I = F_NBULL + 1 -C DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. -C & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) -C & .OR.I.GT.F_NBULL)) -C I = I - 1 -C IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN -C IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C END DO -C IF (I.GE.F_START) START = I -C ELSE -C IER = OTS$CVT_TI_L(BUFFER(SB+4: -C & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) -C END IF -C RETURN -C END IF -C END IF -C SKIP = SKIP + 1 -C END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2 - IER = IER1 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - CHARACTER*256 TEMP - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IF - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0 - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE - IER = NEWS_READ() - IF (IER.AND.(BUFFER(SB:EB).NE.'.' - & .OR..NOT.LAST_REAL_LF_SEEN)) THEN - IER = 0 - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THEN - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF ((INDEX(TEMP,': ').EQ.0.AND. - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255).OR. - & (LTEMP.EQ.254.AND..NOT.LAST_LF_SEEN)) THEN - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IF - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IF - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF - ELSE - HEADER_SEEN = .TRUE. - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128 - ELSE - ILEN = 128 - END IF - END IF - ELSE - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ABS(ILEN).EQ.128) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - HEADER_SEEN = .TRUE. - - RETURN - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /READIT/ READIT - - COMMON /NEWS_INIT/ END_READ - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - CHARACTER*64 ALT_SAVE - - DIMENSION DUMMY(4) - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - ALT_SET_SAVE = ALT_SET() - IF (ALT_SET_SAVE) CALL UNSET_ALT - END_READ = 0 - IER = 0 - IF (.NOT.NEWS_LOGIN()) THEN - IER = 2 - IF (.NOT.TEST_ALT(FOLDER1)) RETURN - IER = 1 - END IF - IF (IER.NE.1) CALL NEWS_GROUP(IER) - IF (IER.EQ.1) THEN - IF (TEST_ALT(FOLDER1)) THEN - IER1 = SET_ALT(ALT_FOUND) - IF (IER1) CALL NEWS_GROUP(IER) - IF (.NOT.IER1.OR.IER.NE.0) THEN - CALL UNSET_ALT - IF (ALT_SET_SAVE) THEN - CALL SET_ALT(ALT_SAVE) - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER1) - END IF - RETURN - END IF - ALT_SAVE = ALT_FOUND - IER = 0 - ELSE IF (ALT_SET_SAVE) THEN - CALL SET_ALT(ALT_SAVE) - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER1) - IER = 1 - END IF - RETURN - END IF - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY) - IF (SYSLOG) THEN - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3)) - END IF - END IF - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUP - - CHARACTER*8 NUMBER - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURN - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1 - RETURN - ELSE IF (ICOUNT.EQ.-1) THEN - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THEN - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF - END DO - IF ((INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST').AND. - & ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF ((INCMD(:4).NE.'READ'.AND.INCMD(:4).NE.'DIRE') - & .AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURN - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - START = ICOUNT - BULLETIN_NUM = START - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0 - CALL NEWS_HEADER(IER) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - BLOCK = START - MSG_NUM = START - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN - END - - - - SUBROUTINE NEWS_GROUP(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN - IER = 1 - RETURN - END IF - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)) - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT') - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURN - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME - - CHARACTER*28 TIME - - DIMENSION DIFF(2) - - I = 1 - LTIME = TRIM(INTIME) - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:)) - - DO J = 1,2 - I = 1 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-' - END DO - - IF (I.EQ.LEN(TIME)) RETURN - - IF (TIME(I+3:I+3).EQ.' ') THEN - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IF - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DO - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - IF (INDEX(TIME(:I-2),'.').GT.0) THEN - CALL SYS_BINTIM(TIME(:INDEX(TIME(:I-2),'.'))//'00',BTIM) - ELSE IF (TIME(I-4:I-4).EQ.':'.AND.TIME(I-7:I-7).EQ.':') THEN - CALL SYS_BINTIM(TIME(:I-2)//'.00',BTIM) - ELSE - CALL SYS_BINTIM(TIME(:I-2)//':00.00',BTIM) - END IF - - IF (TIME(I:I).EQ.'+'.OR.TIME(I:I).EQ.'-') THEN - IER = SYS_BINTIM('0 '//TIME(I+1:I+2)//':'//TIME(I+3:I+4),DIFF) - IF (IER) THEN - IF (TIME(I:I).EQ.'-') THEN - IER = LIB$SUBX(BTIM,DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,DIFF,BTIM) - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE NEWS_LIST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - COMMON /NEWSLIST/ NEWSLIST - - CHARACTER TODAY*24 - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR. - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER)) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - NEWS_FOLDER1_BBOARD = '::' - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14 - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNT - DAMAGED = .FALSE. - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - IF (INDEX(BUFFER(SB:),' ').EQ.0) DAMAGED = .TRUE. - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IF (INDEX(BUFFER(SP:),' ').EQ.0) DAMAGED = .TRUE. - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IF (INDEX(BUFFER(SP:),' ').EQ.0) DAMAGED = .TRUE. - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1 - IF (IER.EQ.0.AND.IER1.EQ.0) - & NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) ! Old bug caused this. - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF ((FLEN.LE.44.OR.FLEN-44+EB-SP+1.LT. - & LEN(NEWS_FOLDER1_DESCRIP)).AND..NOT.DAMAGED) THEN - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)// - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - END IF - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - END IF - ELSE - CALL UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - END IF - IF (DAMAGED) THEN - IER = NEWS_READ() - DAMAGED = .FALSE. - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - OPEN (UNIT=33,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',READONLY) - - DO WHILE (IER.EQ.0) - READ (33,'(A)',IOSTAT=IER) INPUT - IF (IER.EQ.0) THEN - FLEN = INDEX(INPUT,':')-1 - NEWS_FOLDER1 = INPUT(:FLEN) - IF (SET_ALT(INPUT(FLEN+2:))) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER1) - IF (IER1.NE.0) THEN - FOLDER1_DESCRIP = NEWS_FOLDER1 - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = INPUT(45:FLEN) - ELSE - NEWS_FOLDER1_DESCRIP = ' ' - END IF - END IF - CALL NEWS_GROUP(IER2) - IF (IER2.EQ.0) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - IF (IER1.NE.0) THEN - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - ELSE - CALL UPDATE_NEWS_ENTRY(.FALSE.,LOCAL_UPDATE,FLEN,0) - END IF - END IF - END IF - ELSE - CLOSE (UNIT=33) - END IF - IF (ALT_SET()) THEN - CALL UNSET_ALT - IF (.NOT.NEWS_LOGIN()) RETURN - END IF - END DO - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.1.AND.TEST_ALT(NEWS_FOLDER1// - & NEWS_FOLDER1_DESCRIP)) THEN - IER = 0 - ELSE IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.F1_START.AND. - & NEWS_F1_FIRST.GT.F1_NBULL) THEN - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE), - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (((F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND..NOT.BTEST(NEWS_F1_FLAG,8)) THEN - DELETE (UNIT=7) - IER = 0 - ELSE IF (IER.EQ.1) THEN - IF (NEWS_F1_NBULL.LT.NEWS_F1_START - & .OR.NEWS_F1_START.EQ.0) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(NEWS_F1_START,IER1) - CALL CLOSE_BULLDIR - IER1 = NEWS_F1_START+1.EQ.IER1 - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - IF (.NOT.IER1) DELETE (UNIT=7) - END IF - IER = 0 - END IF - END IF - END DO - END IF - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - NEWSLIST = .FALSE. - - IF (SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED')) CALL RECOUNT - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DO - - RETURN - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4 - - COMMON /LOCALPOST/ LOCAL_POST - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /TEMP_INPUT/ GROUP_TEMP - CHARACTER GROUP_TEMP*256 - - COMMON /HEADER/ HEADER - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER RESPONSE*4 - - CHARACTER TODAY*24,UNAME*132 - DATA UNAME /'()'/ - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /NEWS2BULL/ NEWS2BULL - - CHARACTER*256 ANON_LINE - DATA LENA/0/ - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1) - IF (IER1.NE.0) RETURN - ELSE - REWIND (UNIT=3) - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900 - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3) - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSE - I = INDEX(NEWS_MSGID,'.') - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & NEWS_MSGID(:I-1)// - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256) - IF (IER.NE.0) RETURN - LOCAL_POST = .TRUE. - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1 - END IF - - ANON = .FALSE. - IF (.NOT.NEWS_FEED().AND.FILENAME.NE.'cancel') THEN - IF (CLI$PRESENT('ANONYMOUS')) THEN - ANON = .TRUE. - IER = CLI$GET_VALUE('ANONYMOUS',ANON_LINE,LENA) - IF (LENA.EQ.0) THEN - WRITE(6,'('' Enter anonymous address:'')') - CALL GET_LINE(ANON_LINE,LENA) - END IF - END IF - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (FILENAME.EQ.'cancel') THEN -C IF (.NOT.NEWS_WRITE('Newsgroups: junk')) GO TO 900 - IF (.NOT.NEWS_WRITE('Newsgroups: '// - & FOLDER_NAME(:TRIM(FOLDER_NAME)))) GO TO 900 - ELSE IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP - ELSE IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - IF (TRIM(FOLLOWUP).EQ.0) THEN - INPUT = 'Newsgroups: '//NEWSGROUPS - IF (INDEX(NEWSGROUPS,',').GT.0) THEN - WRITE (6,'('' Warning: Original message was cross'', - & ''posted to the following news groups:'')') - DO I=1,TRIM(NEWSGROUPS),PAGE_WIDTH - WRITE (6,'(1X,A)') NEWSGROUPS(I: - & I-1+MIN(PAGE_WIDTH,TRIM(NEWSGROUPS(I:)))) - END DO - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Type Y if you want your reply crossposted also, '// - & 'N for no: (default = Y) ') - IF (RESPONSE(:1).EQ.'n'.OR.RESPONSE(:1).EQ.'N') THEN - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - END IF - ELSE - INPUT = 'Newsgroups: '//FOLLOWUP - END IF - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE.AND. - & .NOT.NEWS_FEED()) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER) - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0 - DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP)) - IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP) - DO WHILE (TRIM(GROUP_TEMP).GT.0) - COMMA = INDEX(GROUP_TEMP,',') - IF (COMMA.GT.0) THEN - FOLDER1_NAME = GROUP_TEMP(1:COMMA-1) - GROUP_TEMP = GROUP_TEMP(COMMA+1:) - ELSE - FOLDER1_NAME = GROUP_TEMP - GROUP_TEMP = ' ' - END IF - CALL LOWERCASE(FOLDER1_NAME) - FLEN = TRIM(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1) - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9) - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND. - & INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND. - & INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST), - & GROUP_LIST,FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - ELSE - WRITE (6,'(1X,A,'' is not a valid news group.'')') - & FOLDER1_NAME(:FLEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to specify it? (default = Y) ') - IF (RESPONSE(:1).NE.'n'.AND. - & RESPONSE(:1).NE.'N') THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - END IF - END IF - END DO - END DO - CALL CLOSE_BULLNEWS - END IF - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900 - END IF - ATSIGN = INDEX(PATHNAME,'@') - PCSIGN = INDEX(PATHNAME,'%') - CALL LOWERCASE(USERNAME) - IF (FILENAME.EQ.'cancel'.AND.SUBJECT(:6).EQ.'CanceL') THEN - IF (.NOT.NEWS_WRITE('Path: cyberspam!usenet')) GO TO 900 - ELSE IF (.NOT.ANON) THEN - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - END IF - END IF - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME) - - IF (FILENAME.NE.'cancel') THEN - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (ANON) THEN - IF (.NOT.NEWS_WRITE('From: '//ANON_LINE(:TRIM(ANON_LINE)))) - & GO TO 900 - ELSE IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - IF (INDEX(INFROM,' ').GT.0) - & INFROM = INFROM(:INDEX(INFROM,' ')-1) - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - ELSE IF (INDEX(INFROM,'@').EQ.0) THEN - INFROM = INFROM(:TRIM(INFROM))//PATHNAME(:LPATH) - END IF - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED').AND. - & SYS_TRNLNM('MX_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED').AND. - & SYS_TRNLNM('PMDF_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MULTINET_ROOT','DEFINED').AND. - & SYS_TRNLNM('MULTINET_SMTP_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - CALL STR$UPCASE(FROM_LINE,FROM_LINE) - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME) - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (SENDER_LINE.NE.' ') THEN - IF (.NOT.NEWS_WRITE(SENDER_LINE(:TRIM(SENDER_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE(FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - ELSE - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ILEN = TRIM(INPUT) - IF (INPUT(:5).EQ.'From:') THEN - GROUP_TEMP = INPUT - ELSE IF (INPUT(:7).EQ.'Sender:') THEN - GROUP_TEMP = 'From:'//INPUT(8:) - ILEN = 0 - END IF - END DO - ILEN = TRIM(GROUP_TEMP) - IF (ILEN.NE.0) THEN - IF (.NOT.NEWS_WRITE(GROUP_TEMP(:ILEN))) RETURN - END IF - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'// - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE IF (TRIM(SUBJECT).EQ.0) THEN - IF (.NOT.NEWS_WRITE('Subject: (none)')) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECT - - IF (INCMD(:2).EQ.'RE'.OR.FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) - & GO TO 900 - END IF - - IF (NGROUPS.GT.0) THEN - FROM = USERNAME - DESCRIP = SUBJECT - END IF - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION) - END IF - LORGAN = TRIM(ORGANIZATION) - END IF - - IF (.NOT.ANON) THEN - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - ELSE - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//'@anon' - LORGAN = 0 - END IF - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//'>')) GO TO 900 - END IF - - IF (FILENAME.NE.'cancel'.AND.LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN))) - & GO TO 900 - ELSE IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Organization: cancel')) - & GO TO 900 - END IF - - IF (.NOT.USE_INFROM.OR.COMPARE_DATE(TODAY(:11),DATE).GT.13) THEN - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(8:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & ZONE(:LZONE))) GO TO 900 - ELSE - CALL COPY2(NOW,MSG_BTIM) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - TODAY = DATE(:2)//' '//DATE(4:6)//' '//DATE(8:) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & TIME(:8)//' '//ZONE(:LZONE))) GO TO 900 - IER = SYS$ASCTIM(,TODAY,MSG_BTIM,) - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - END IF - - INPUT_HEADER = .FALSE. - - IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel')) THEN - EXPR = NEWS_FEED().OR.USE_INFROM - IF (.NOT.EXPR) EXPR = CLI$PRESENT('EXPIRATION') - IF (EXPR) THEN - CALL SYS_BINTIM(EXDATE//' '//EXTIME,NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - EXDATE = TODAY(:11) - EXTIME = TODAY(13:20) - I = INDEX(EXDATE,'-') - IF (EXDATE(I+5:I+8).EQ.'2100') THEN ! Servers not Y21K compliant - READ (DATE(8:11),'(I4)') J - WRITE (EXDATE(I+5:I+8),'(I4)') J+10 ! 10 years - END IF - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE(FIRST_ALPHA(EXDATE):2) - & //' '//EXDATE(I+1:I+3)//' '//EXDATE(I+5:TRIM(EXDATE)) - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) - & GO TO 900 - ELSE IF (REMOTE_SET.EQ.4) THEN - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT) - END IF - EXTIME = '00:00:00.00' - END IF - IF (.NOT.NEWS_FEED()) THEN - IF (CLI$GET_VALUE('FOLLOWUP',GROUP_TEMP)) THEN - CALL LOWERCASE(GROUP_TEMP) - IF (.NOT.NEWS_WRITE('Followup-To: ' - & //GROUP_TEMP(:TRIM(GROUP_TEMP)))) GO TO 900 - END IF - END IF - END IF - - IF (CREATE) THEN - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURN - END IF - - IF (NEWS_FEED().OR.NEWS2BULL) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (.NOT.NEWS_WRITE('X-Newsreader: News2bull')) GO TO 900 - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (SUBJECT(:6).EQ.'CanceL') THEN - IF (SUBJECT.EQ.'CanceL') THEN - WRITE (6,1055) - ILEN = LINE_LENGTH + 1 ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - IF (.NOT.NEWS_WRITE(INPUT(:ILEN))) RETURN - END IF - END DO - ELSE - IF (.NOT.NEWS_WRITE(SUBJECT(7:TRIM(SUBJECT)-6))) RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).EQ.'240') IER = 0 - ELSE - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - CALL STR$UPCASE(USERNAME,USERNAME) - LOCAL_POST = .FALSE. - RETURN - END IF - - IF (.NOT.INPUT_HEADER) THEN - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2 - END IF - IF (IER1.EQ.0) THEN - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DO - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') THEN - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:MIN(79+SB,EB)) - IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN - WRITE (6,'('' Use /INDENT to change indentation'',$)') - WRITE (6,'(''+ character. See Manager for permanent'',$)') - WRITE (6,'(''+ change.'')') - END IF - END IF - ELSE - LENGTH = (LENGTH+127)/128 - GROUP_LIST = GROUP_LIST1 - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - SAVE_BULL_POINT = BULL_POINT - OLD_NBULL = NBULL - DO I=NGROUPS,1,-1 - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1) - FOLDER_NUMBER = -1 - OLD_NBULL = NBULL - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL ADD_LOCAL_NEWS(8) - CALL ADD_TAG(IER,2) - IF (NEWS_FIND_SUBSCRIBE().LT.FOLDER_MAX) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER1) - IF (IER1.EQ.0.OR.IER1.EQ.OLD_NBULL+1) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(OLD_NBULL+1) - END IF - END IF - END IF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - BULL_POINT = SAVE_BULL_POINT - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - CALL STR$UPCASE(USERNAME,USERNAME) - - LOCAL_POST = .FALSE. - -1055 FORMAT(' State reason for deleting message not owned by you:') - - RETURN - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURN - END IF - END IF - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME) - LPATH = TRIM(PATHNAME) - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NAME - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME) - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE. - END DO - - TEST_NEWS = MAYBE_NEWS - - RETURN - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) RETURN - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULL - FIRST = F1_START - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - REMOTE_SET = 3 - CALL OPEN_BULLDIR_SHARED - INCMD = 'READ' ! REMOTE_GET_HEADER uses NEXT otherwise - I = F_LAST + 1 - IER = I - 1 - DO WHILE (I.NE.IER.AND.I.LE.LAST) - CALL READDIR(I,IER) - I = I + 1 - END DO - CALL CLOSE_BULLDIR - CALL OTS$CVT_L_TI(I-1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNT - NEW_NEWS_F_END = NEWS_F_END - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - F_LAST = LAST - NEWS_F_FIRST = FIRST - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE NEWS2BULL(RECLAIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - DATA BULLCP_NEWS /.FALSE./ - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBER - - DIMENSION NOW(2) - - BULLCP_NEWS = .TRUE. - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV - - CALL DELETE_EXPIRED_NEWS(RECLAIM) - - IF (RECLAIM) CALL EXIT - - CALL SEND_POST - IF (ALT_SET()) CALL UNSET_ALT - - CALL NEWS_LIST - - CALL UPDATE_LOCAL_NEWS - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - IF (NEWS_FEED()) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARD - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (IER) THEN - SAVE_LAST = F_LAST - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER) - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN - SAVE_LAST = F_NBULL - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LAST - FOLDER_BBOARD = 'NONEFEED' - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - IF (FOLDER_BBOARD.EQ.'NONEFEED') THEN - CALL SETUSER('SYSTEM') - ELSE - CALL SETUSER(FOLDER_BBOARD) - END IF - REMOTE_SET = 3 - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/LOCAL/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1) - END IF - CALL CLOSE_BULLFOLDER - CALL SETUSER(USERNAME) - END IF - END IF - END DO - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - CHARACTER*(*) TIME - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+ - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)// - & TIME(16:17)//TIME(19:20) - - RETURN - END - - - - SUBROUTINE ALLPRIV - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1 - PROCPRIV(2) = -1 - NEEDPRIV(1) = -1 - NEEDPRIV(2) = -1 - - RETURN - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COM - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - RETURN - END - - - - SUBROUTINE SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')') - RETURN - END IF - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE - WRITE (6,'('' You are now subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - CALL UPDATE_USERINFO - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - LAST_NEWS_READ(2,J) = F_START - 1 - ELSE - LAST_NEWS_READ2(2,J) = 0 - LAST_NEWS_READ(2,J) = F_NBULL - END IF - CALL CLOSE_BULLNEWS - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - CALL UPDATE_USERINFO_NEWS_ALWAYS - RETURN - END IF - END DO - - END - - - - - - SUBROUTINE UNSUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_EXPIRED - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.LE.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Folder is permanent and cannot not be'', - & '' unsubscribed.'')') - RETURN - END IF - - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - CALL UPDATE_USERINFO - - I = NEWS_FIND_SUBSCRIBE() - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - - CALL FREE_TAGS(I) - - IF (NINCLUDE.GT.0) THEN - WRITE (6,'('' Note: Excludes and/or '', - & ''threads exist for this group.'')') - WRITE (6,'('' Type EXCLUDE/DISABLE/ALL to remove them.'')') - END IF - - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - CALL UPDATE_USERINFO_NEWS_ALWAYS - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (IER.EQ.0) IER = 1 ! None read yet. - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE1() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR.(LAST_NEWS_READ(2,I) - & .GT.NEWS_F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0 - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THEN - COUNT = COUNT + 1 - END IF - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT) - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE - SUBNUM = 0 - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES) -C -C SUBROUTINE NEWS_NEW_NOTIFICATION -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - MESSAGES = .FALSE. - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1 - - FOLDER_DESCRIP = ' ' - REORDER = 0 - DO WHILE (SUBNUM.GT.0) - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUM - UNLOCK 7 - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1 - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - CALL UPDATE_USERINFO - IF (F_START.EQ.0) IER = 1 - ELSE IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR. - & F_START.GT.F_NBULL) THEN - IER = 1 - END IF - END IF - IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (DIFF.GT.0) IER = 1 - END IF - END IF - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - ELSE - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IF - END IF - END DO - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE - - CALL CLOSE_BULLNEWS - - RETURN - END - - - SUBROUTINE REORDER_SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0) - I = I + 1 - END DO - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1 - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1) - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2 - TEMP = LAST_NEWS_READ(L,J) - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K) - LAST_NEWS_READ(L,K) = TEMP - END DO - END IF - END DO - END DO - - RETURN - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE = I - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE1 = I - - RETURN - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - IP = 1 - DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER - & .AND.IP.LE.FOLDER_MAX-1) - IP = IP + 1 - END DO - - IER = .TRUE. - - IF (IP.EQ.FOLDER_MAX) THEN - PERM = .FALSE. - IP = 1 - ELSE - PERM = .TRUE. - END IF - - IF (NOTIFY.EQ.0) THEN - IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).AND. - & .NOT.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (BTEST(INF_REC2(2,IP),14)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - END IF - - IF (BTEST(INF_REC2(2,IP),15)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - END IF - END IF - - CALL UPDATE_USERINFO - - RETURN - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - REWIND UNIT - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '// - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK) - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6, - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) - END IF - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1 - SYSTEM = 0 - CALL ADD_ENTRY - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE UPDATE_NEWS_FOLDER -C -C SUBROUTINE UPDATE_NEWS_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1 - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_EX_BTIM_KEY - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE SEND_POST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /NEWSBULL/ NEWSBULL - DATA NEWSBULL /.FALSE./ - - CHARACTER FILE*132 - - C = 0 - - IF (.NOT.NEWS_LOGIN()) RETURN - - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST*',FILE,C)) -50 NEWSBULL = .FALSE. - - IF (.NOT.NEWS_WRITE('POST')) THEN - IF (ALT_SET()) CALL UNSET_ALT - RETURN - END IF - IF (.NOT.NEWS_READ()) THEN - IF (ALT_SET()) CALL UNSET_ALT - RETURN - END IF - IF (BUFFER(:3).NE.'340') GOTO 90 - - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (INPUT(:5).EQ.'From:') BULL_PARAMETER = INPUT(7:) - IF (INDEX(INPUT,'X-Newsreader: News2bull').EQ.1) THEN - NEWSBULL = .TRUE. - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (.NOT.NEWS_WRITE('X-Newsreader: News2bull' - & //' '//PATHNAME(:TRIM(PATHNAME)))) GO TO 100 - ELSE - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IF - END IF - END DO - IF (INPUT.NE.'.') THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - IF (BUFFER(:3).EQ.'441'.AND..NOT.ALT_SET()) THEN - REWIND (UNIT=3) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0.AND.INPUT(:12).EQ.'Newsgroups: ') THEN - CLOSE (UNIT=3) - IF (TEST_ALT(INPUT(13:))) THEN - IF (SET_ALT(ALT_FOUND)) GOTO 50 - GOTO 90 - END IF - IER = 2 - END IF - END DO - CLOSE (UNIT=3) - END IF - IF (BUFFER(:3).NE.'240') THEN - CLOSE (UNIT=3) - IF (NEWSBULL.AND.INDEX(FILE,'POST_ERROR').EQ.0) THEN - CALL LIB$RENAME_FILE(FILE,'*.POST_ERROR',,,,,,,,,FILE) - CALL SENDMAIL(FILE,'SYSTEM' - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER) - NEWSBULL = .FALSE. - ELSE IF (.NOT.NEWSBULL) THEN - CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER) - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - CLOSE (UNIT=3,STATUS='DELETE') - END IF - ELSE - CLOSE (UNIT=3,STATUS='DELETE') - END IF -90 IF (ALT_SET()) CALL UNSET_ALT - NEWSBULL = .FALSE. - END DO - -100 CLOSE (UNIT=3) - IF (ALT_SET()) CALL UNSET_ALT - - RETURN - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVS - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST) - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - - IER = SYS_TRNLNM('BULL_PERSONAL_NAME',UNAME) - - IF (UNAME.EQ.'()') THEN - UNAME = ' ' - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IF - - RETURN - END - - - - SUBROUTINE RECOUNT -C -C SUBROUTINE RECOUNT -C -C FUNCTION: -C -C Fixes the message count of stored news groups. This may become wrong -C if old copies of some of the database files are used with newer versions. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - REMOTE_SET = 4 - - DO WHILE (IER.EQ.0) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - END DO - - IF (BTEST(NEWS_F_FLAG,8).AND.IER.EQ.0) THEN - CALL NEWS_TO_FOLDER - - CALL OPEN_BULLDIR_SHARED - - NUM = F_START - F_COUNT = 0 - - IF (F_START.GT.0) THEN - CALL READDIR(NUM,IER) - NEXT = .TRUE. - F_START = NUM - DO WHILE (NUM+1.EQ.IER) - F_COUNT = F_COUNT + 1 - NUM = NUM + 1 - IF (NUM.LE.F_NBULL) CALL READDIR(NUM,IER) - END DO - NEXT = .FALSE. - - F_NBULL = NUM - 1 - END IF - - CALL CLOSE_BULLDIR - - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - - CALL DELLNM('BULL_NEWS_RECOUNT') - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE DELLNM(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$SYSTEM',LOG,PSL$C_SUPER) - - RETURN - END - - - SUBROUTINE DELLNM_USER(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$PROCESS',LOG,PSL$C_USER) - - RETURN - END - - - SUBROUTINE NEWNEWS(SINCE_BTIM,FOUND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - DIMENSION SINCE_BTIM(2) - - START = F_START - END = F_NBULL - - FOUND = 0 - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' '.AND.TRIM(NUMBER1).GT.0) - NUMBER1 = NUMBER1(2:) - END DO - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - IF (.NOT.NEWS_READ()) RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (FOUND.EQ.0) THEN - L = INDEX(BUFFER(SB:EB),' ') - CALL OTS$CVT_TI_L(BUFFER(SB:SB+L-2),IER,,%VAL(1)) - CALL NEWS_TIME(BUFFER(SB+L:EB),MSG_BTIM) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) - & FOUND = IER - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (FOUND.NE.0) THEN - IF (.NOT.OTS$CVT_L_TI(FOUND,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END.AND.FOUND.EQ.0) - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) FOUND = MSG_NUM - I = I + 1 - IF (REMOTE_SET.EQ.3.AND.I.LE.END.AND.FOUND.EQ.0) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - IF (FOUND.EQ.0) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - - RETURN - END - - - - LOGICAL FUNCTION TEST_ALT(FOLDER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - CHARACTER*(*) FOLDER1 - - TEST_ALT = .FALSE. - - OPEN (UNIT=3,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',READONLY) - - IF (IER.NE.0) RETURN - - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) ALT_FOUND - IF (STREQ(ALT_FOUND(:INDEX(ALT_FOUND,':')-1), - & FOLDER1(:TRIM(FOLDER1)))) THEN - ALT_FOUND = ALT_FOUND(INDEX(ALT_FOUND,':')+1:) - CLOSE (UNIT=3) - TEST_ALT = .TRUE. - RETURN - END IF - END DO - - CLOSE (UNIT=3) - - RETURN - END - - - - LOGICAL FUNCTION SET_ALT(NEWALT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NEWALT - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - DATA SETALT/.FALSE./ - - SET_ALT = .FALSE. - - IF (SETALT) THEN - IF (NEWALT.EQ.ALT) THEN - SET_ALT = .TRUE. - RETURN - ELSE - CALL UNSET_ALT - END IF - END IF - - CALL NEWS_LOGOUT - - CALL CRELNM('BULL_NEWS_SERVER',NEWALT(:TRIM(NEWALT))) - - IF (NEWS_LOGIN()) THEN - SET_ALT = .TRUE. - SETALT = .TRUE. - ALT = NEWALT - ELSE - CALL DELLNM_USER('BULL_NEWS_SERVER') - SETALT = .FALSE. - END IF - - RETURN - END - - - - SUBROUTINE UNSET_ALT - - IMPLICIT INTEGER (A-Z) - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - CALL DELLNM_USER('BULL_NEWS_SERVER') - - CALL NEWS_LOGOUT - - SETALT = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALT_SET() - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - ALT_SET = SETALT - - RETURN - END - - - - SUBROUTINE ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION EXPIRED(2) - - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLEN - NEWS_F1_COUNT = NEWS_F_COUNT - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN - NEWS_FOLDER = NEWS_FOLDER(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - NEWS_F_COUNT = NEWS_F1_COUNT - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - IF (IER2.EQ.0) THEN - NEWS_F1_FLAG = NEWS_F_FLAG - NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN - NEWS_F1_EXPIRE = NEWS_F_EXPIRE - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1) - IF (BTEST(NEWS_F1_FLAG,8)) THEN - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_LAST = 0 - END IF - - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE. - IF (SP.GT.0) THEN - IF (FLEN.GT.44) THEN - IF (NEWS_FOLDER1_DESCRIP.NE. - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE - UPDATE = .TRUE. - END IF - IF (SPECIAL) THEN - IF (UPDATE) THEN - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF - ELSE IF (.NOT.UPDATE) THEN - UPDATE = F1_START.LT.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bulletin11.for b/decus/vmslt02a/bulletin/bulletin11.for deleted file mode 100644 index 04ca8de..0000000 --- a/decus/vmslt02a/bulletin/bulletin11.for +++ /dev/null @@ -1,3618 +0,0 @@ -C -C BULLETIN11.FOR, Version 3/28/00 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('CURRENT')) THEN - MESSAGE_NUMBER = BULL_POINT - ELSE IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - IF (.NOT.BULL_NEWS_TAG) RETURN - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*12 BULL_MARK_DIR - CHARACTER*12 TAG_KEY,INPUT_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,) - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1) - ELSE - UNLOCK 13 - END IF - END IF - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - ELSE - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - BULL_NEWS_TAG = .FALSE. - RETURN - END IF - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),) - IF (IER1.NE.0) THEN - CLOSE (UNIT=23) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=128,DISPOSE='DELETE', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1) - NEWS_MARK2(1) = NEWS_MARK2(2) - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE') - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - CALL ERRSNS(IDUMMY,IER2) - IF (IER2.NE.RMS$_RNF) SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURN - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1), - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IF - - RETURN - END - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - - CHARACTER*12 BULL_MARK_DIR - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSE - MARKUNIT = 23 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1 - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEY - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IF - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY) - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURN - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - TAG_TYPE = 0 - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR. - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN - IF (IER.EQ.0) UNLOCK 13 - IER = 0 - MESSAGE = MSG_NUM - ELSE - IER = 36 - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - IER = 36 - - HEADER = .FALSE. - - TAG_TYPE = 0 - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) THEN - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:) - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THEN - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I) - IER = 0 - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - MSG_KEY = NEXT_MSG_KEY - RETURN - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DO - - RETURN - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - DO MESSAGE = MSG_NUM+1,F_NBULL - CALL READDIR(MESSAGE,IER) - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE) - IF (IER.EQ.0) THEN - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END DO - - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2) - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURN - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER) - & INPUT_KEY - END DO - - CLOSE_IT = .FALSE. - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - CALL DECREMENT_MSG_KEY - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR_SHARED - CLOSE_IT = .TRUE. - END IF - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - DELETE (UNIT=13) - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER)) - READ (13,IOSTAT=IER) INPUT_KEY - END DO - END IF - END IF - - END DO - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE. - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1 - DO M=1,2 - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1 - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1 - LIMIT = 256/(NEWS_FORMAT+1) - NEWS_NUMBER = LAST_NEWS_READ2(1,I) - K = 5-NEWS_FORMAT*2 - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1 - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IF - SET_LIST = .FALSE. - END IF - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0) - END DO - K = LIMIT + 1 - END IF - IF (K.GT.LIMIT) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2 - NEWS_REC = NEWS_REC + 1 - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - IF (IER.EQ.0) THEN - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IF - END DO - END IF - END DO - END DO - CLOSE (UNIT=23) - END IF - - RETURN - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = J - ELSE - NEWS_MARK(I) = J - END IF - - RETURN - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG) - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUM - NEWS_TAG(I) = 0 - END DO - - RETURN - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - DO I=1,2 - IF (NEWS_TAG(3,I,ISUB).GT.0) THEN - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB)) - NEWS_TAG(3,I,ISUB) = 0 - NEWS_NUMBER = NEWS_FOLDER_NUMBER - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER) - END IF - END DO - IF (IER.EQ.0) UNLOCK 23 - END IF - - DO J=I,FOLDER_MAX-2 - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J)) - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0 - END DO - END DO - - RETURN - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY - - IER = 36 - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE) - IF (IER.EQ.0) THEN - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THEN - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM) - END IF - IER = 36 - END IF - END IF - END DO - BULL_READ = MSG_NUM - IF (CLOSE_IT) CALL CLOSE_BULLDIR - ELSE - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0 - MSG_KEY = BULLDIR_HEADER - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THEN - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36 - END IF - END IF - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*24 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - SUBROUTINE SENDMAIL(FILE,TO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE '($MAILDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /NEWSBULL/ NEWSBULL - - CHARACTER*(*) FILE,TO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1)) - - CALL DISABLE_PRIVS - - SENDTO = TO - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))// - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:) - END DO - - IF ((USE_INFROM.OR.NEWSBULL).AND.(SYS_TRNLNM('TWF$TCP','DEFINED').OR. - & SYS_TRNLNM('MULTINET_SOCKET_LIBRARY','DEFINED').OR. - & SYS_TRNLNM('UCX$DEVICE','DEFINED')) - & .AND..NOT.SYS_TRNLNM('BULL_DISABLE_SMTP','DEFINED')) THEN - IER = SYS$ASCTIM(,INPUT,,) - INPUT = INPUT(:2)//INPUT(4:6)//INPUT(10:11)// - & INPUT(13:14)//INPUT(16:17)//INPUT(19:20)// - & INPUT(22:23) - IF (INPUT(:1).EQ.' ') INPUT = INPUT(2:) - OPEN (UNIT=8,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & INPUT(:TRIM(INPUT))//'.SMTP',IOSTAT=IER1, - & STATUS='NEW',RECL=256) - IF (IER1.EQ.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - WRITE (8,'(A)',IOSTAT=IER) 'helo '//PATHNAME(2:LPATH) - INPUT = INFROM - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - END IF - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:) - INPUT = INPUT(:INDEX(INPUT,'"')-1) - END IF - WRITE (8,'(A)',IOSTAT=IER) 'MAIL FROM:<'// - & INPUT(:MINGT0(INDEX(INPUT,' ')-1,TRIM(INPUT)))//'>' - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - WRITE (8,'(A)',IOSTAT=IER) 'RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>' - WRITE (8,'(A)',IOSTAT=IER) 'DATA' - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - WRITE (8,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - IF (NHEAD.EQ.0.AND.TRIM(SUBJECT).GT.0) THEN - WRITE (8,'(A)',IOSTAT=IER) - & 'Subject: '//SUBJECT(:TRIM(SUBJECT)) - WRITE (8,'(A)',IOSTAT=IER) - END IF - IF (NEWSBULL) THEN - WRITE (8,'(A)') 'This message was posted via a folder'// - & ' with a news group associated with it.' - WRITE (8,'(A)') 'It will continue to attempt to be'// - & ' posted to the news group using the file:' - WRITE (8,'(A)') FILE(:TRIM(FILE)) - WRITE (8,'(A)') 'If necessary, you can either'// - & ' delete the file or edit it to fix it.' - WRITE (8,'(A)') 'If you edit it, delete old versions.' - WRITE (8,'(A)') ' ' - END IF - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER) - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.EQ.0) THEN - WRITE (8,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END IF - END DO - CLOSE (UNIT=3) - REWIND (UNIT=8,IOSTAT=IER) - IF (IER.NE.0) THEN - CLOSE (UNIT=8,STATUS='DELETE') - IER1 = 2 - END IF - END IF - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('helo '//PATHNAME(2:LPATH)//CRLF)) - & GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - INPUT = INFROM - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:) - INPUT = INPUT(:INDEX(INPUT,'"')-1) - END IF - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ELSE IF (I.EQ.0.AND.INDEX(INPUT,'@').EQ.0) THEN - INPUT = INPUT(:TRIM(INPUT))//PATHNAME(:LPATH) - END IF - IF (.NOT.SMTP_WRITE_PACKET('MAIL FROM:<'//INPUT(:TRIM(INPUT)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - IF (.NOT.SMTP_WRITE_PACKET('RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('DATA'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - IF (BTEST(FOLDER_FLAG,15).OR.INPUT(:8).NE.'Subject:') THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:TRIM(INPUT))//CRLF)) - & GOTO 10 - ELSE - IF (.NOT.SMTP_WRITE_PACKET('Subject: '// - & SUBJECT(:TRIM(SUBJECT))//CRLF)) GOTO 10 - END IF - END DO - IF (NHEAD.EQ.0.AND.TRIM(SUBJECT).GT.0) THEN - IF (.NOT.SMTP_WRITE_PACKET('Subject: '// - & SUBJECT(:TRIM(SUBJECT))//CRLF)) GOTO 10 - NHEAD = 1 - END IF - IF (.NOT.SMTP_WRITE_PACKET(CRLF)) GOTO 10 - IF (NEWSBULL) THEN - IF (.NOT.SMTP_WRITE_PACKET('This message was posted via '// - & 'a folder with a news group associated with it.'//CRLF)) - & GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('It will continue to attempt to'// - & ' be posted to the news group using the file:'//CRLF)) - & GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(FILE(:TRIM(FILE))//CRLF)) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('If necessary, you can either'// - & ' delete the file or edit it to fix it.'//CRLF)) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('If you edit it, '// - & 'delete old versions.'//CRLF)) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(CRLF)) GOTO 10 - END IF - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER2) - DO WHILE (IER2.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER2) L,INPUT - IF (IER2.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:TRIM(INPUT))//CRLF)) - & IER2 = 2 - END IF - END DO - CLOSE (UNIT=3) - IF (IER2.EQ.2) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IER2 = 1 - GOTO 20 -10 IER2 = 2 -20 CALL SMTP_DISCONNECT() - IF (IER1.EQ.0) THEN - IF (IER2) THEN - CLOSE (UNIT=8,STATUS='DELETE') - ELSE - CLOSE (UNIT=8) - END IF - END IF - CALL ENABLE_PRIVS - STATUS = 1 - RETURN - END IF - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR) - - IER = SYS_TRNLNM('BULL_PERSONAL_NAME',INPUT) - IF (IER) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(INPUT),MAIL$_SEND_PERS_NAME, - & %LOC(INPUT)) - CALL END_ITMLST(SEND_ITMLST) - STATUS = MAIL$SEND_BEGIN(C,%VAL(SEND_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - ELSE - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - END IF - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO)) - I = INDEX(SENDTO(J:),',') - 1 - IF (I.EQ.-1) I = TRIM(SENDTO(J:)) - CALL INIT_ITMLST - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME, - & %LOC(SENDTO(J:J+I-1))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - J = J + I - IF (SENDTO(J:J).EQ.',') J = J + 1 - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO)) - CALL END_ITMLST(ATTRIBUTE_ITMLST) - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - CALL LIB$REVERT - - RETURN - END - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,) - - RETURN - END - - - - - SUBROUTINE SET_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEXT/ NEXT - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DIMENSION EXPIRED(2) - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IF - - ENTRY SHOW_NEWS - - LIMIT = -2 - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1)) - IF (.NOT.IER.OR.LIMIT.LT.-1) THEN - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')') - RETURN - END IF - END IF - - EXPIRE = -1 - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1)) - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN - END IF - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR. - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')') - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - IF (CLI$PRESENT('DEFAULT')) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1 - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - RETURN - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE) - FOLDER1_NUMBER = NEWS_F1_COUNT - FOLDER1 = BULL_PARAMETER - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10) - CALL WRITE_FOLDER_FILE_TEMP(IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMP - REWRITE (7) NEWS_FOLDER1_COM - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER) - END IF - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - END IF - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS') - DEFAULT = CLI$PRESENT('DEFAULT') - ALL = CLI$PRESENT('ALL') - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE') - ENABLE = CLI$PRESENT('ENABLE') - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - - STORED = 0 - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN - WRITE (6,'('' Stored setting was not removed.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'[.BULLNEWS*]*.*;*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_SAVE = FOLDER - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - FOLDER = FOLDER_SAVE - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0 - F1_NBULL = 0 - F1_COUNT = 0 - F1_LAST = 0 - END IF - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3) - IF (IER.NE.0) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - END IF - CALL RESET_PROTECTION - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IF - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THEN - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')') - ELSE - WRITE (6,'('' Default is not stored.'')') - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS) THEN - WRITE (6,'('' Expiration is DEFAULT value.'')') - ELSE - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Default expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no default expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')') - ELSE - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - NOTIFY_FLAG_NEWS = .FALSE. - SET_FLAG_NEWS = .FALSE. - BRIEF_FLAG_NEWS = .FALSE. - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a default news group.'')') - ELSE - IER1 = 2 - END IF - END IF - NOTIFY_PERM_FLAG_NEWS = .FALSE. - SET_PERM_FLAG_NEWS = .FALSE. - BRIEF_PERM_FLAG_NEWS = .FALSE. - DO WHILE (REC_LOCK(IER2)) - READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC - END DO - IF (IER2.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a permanent news group.'')') - END IF - END IF - PERM = .FALSE. - IF (SET_FLAG_NEWS) THEN - IF (BRIEF_FLAG_NEWS) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE IF (BRIEF_FLAG_NEWS) THEN - IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - IF (.NOT.PERM) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (BRIEF_PERM_FLAG_NEWS.AND..NOT.SET_PERM_FLAG_NEWS) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (NOTIFY_FLAG_NEWS) THEN - IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' NOTIFY is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLINF - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IF - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER) - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) - END IF - FOUND = .FALSE. - MODALL = INDEX(GROUP,'.').NE.LG - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR. - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.')) - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER) - END DO - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER) - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - RETURN - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - END DO - END IF - - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - ALL = CLI$PRESENT('ALL') - FULL = CLI$PRESENT('FULL') - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (CLI$PRESENT('SUBJECT')) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IF - ELSE - INPUT = FROM - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:) - ELSE - INPUT = DESCRIP - END IF - END IF - LEN_P = TRIM(INPUT) - CALL CLOSE_BULLFIL - END IF - - SUB = CLI$PRESENT('SUBJECT') - DISABLE = CLI$PRESENT('DISABLE') - EXC = 0 - - GO TO 5 - - ENTRY INCLUDE_SUBJECT(EXCLUDE) - - IF (REMOTE_SET.GE.3.AND.NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) RETURN - - LEN_P = TRIM(INPUT) - ALL = .FALSE. - DISABLE = .FALSE. - SUB = .TRUE. - EXC = -1 - -5 IF (SUB) THEN - IF (DISABLE) THEN - IF (STREQ(INPUT(:3),'RE:')) INPUT = INPUT(5:) -C INPUT = INPUT(:MIN(LEN_P,LEN(DESCRIP))) - LEN_P = TRIM(INPUT) - END IF - INPUT = 'SUBJECT:'//INPUT - LEN_P = LEN_P + 8 - ELSE - INPUT = 'FROM:'//INPUT - LEN_P = LEN_P + 5 - END IF - -10 IF (EXCLUDE) THEN - INPUT = ':exclude:'//INPUT - LEN_P = LEN_P + 9 - ELSE - INPUT = ':include:'//INPUT - LEN_P = LEN_P + 9 - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - FLEN = TRIM(FOLDER_NAME) - INPUT = FOLDER_NAME(:FLEN)//INPUT - ILEN = FLEN + LEN_P - - IF (EXC.EQ.0) THEN - EXC = -1 - IER = CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P) - IF (IER) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) EXC - IF (EXC.LT.0.OR.EXC.GT.999.OR.IER.NE.0) THEN - WRITE(6,'('' ERROR: Valid limit is 0-999.'')') - RETURN - END IF - END IF - END IF - - CHECK_ONLY = .FALSE. - - GO TO 100 - - ENTRY CHECK_EXCLUDES - - CHECK_ONLY = .TRUE. - DISABLE = .TRUE. - LEN_P = 0 - INPUT = ' ' - ILEN = 1 - -100 IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) THEN - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - CLOSE (UNIT=4,DISPOSE='SAVE') - RETURN - END IF - - IER = 0 - CONVERT = .FALSE. - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - I = STRFIND(OLD_BUFFER,':RE: ') - IF (IER.EQ.0) THEN - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THEN - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5) - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill' - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF ((STREQ(OLD_BUFFER(:ILEN),INPUT(:ILEN)).AND. - & OLD_BUFFER(ILEN+1:ILEN+1).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:OLEN),INPUT(:OLEN))).OR. - & (DISABLE.AND.I.GT.0.AND. - & ((STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:MAX(I+5,ILEN+4)), - & INPUT(:ILEN)).AND.OLD_BUFFER(ILEN+5:ILEN+5).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:OLEN), - & INPUT(:OLEN)))))) THEN - CONTINUE - ELSE IF (.NOT.(ALL.AND.STREQ(INPUT(:FLEN+8), - & OLD_BUFFER(:MIN(FLEN+8,OLEN))))) THEN - IER2 = OLD_BUFFER(:1).EQ.':'.OR. - & INDEX(OLD_BUFFER,':defaults:').GT.0 - IF (.NOT.IER2) THEN - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC1,BLIMIT,BDATE,IER1) - IF (IER1) IER2 = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1) - & ,' ').GT.-EXC1 - CONVERT = .NOT.IER1 - END IF - IF (.NOT.IER1.OR.EXC1.EQ.0.OR.IER2) - & WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN) - END IF - END IF - END DO - - IF (.NOT.DISABLE) THEN - IF (FULL) THEN - WRITE (4,'(A)',IOSTAT=IER) FOLDER_NAME(:FLEN)//':defaults:kill' - ELSE - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - - IF (CONVERT) THEN - WRITE (6,'('' NOTE: See help on the new SET EXLIMIT command.'')') - END IF - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (SUB.AND.DISABLE) THEN - INPUT = DESCRIP - IF (STREQ(INPUT(:3),'RE:')) INPUT = INPUT(5:) - LEN_P = TRIM(INPUT) - INPUT = 'SUBJECT:'//INPUT - LEN_P = LEN_P + 8 - SUB = .FALSE. - GO TO 10 - END IF - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - SUBROUTINE UPDATE_EXCLUDE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - DATA SCRATCH_B1/0/,NINCLUDE/0/,EXC_CHANGED/.FALSE./ - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - IF (.NOT.EXC_CHANGED) RETURN - EXC_CHANGED = .FALSE. - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (.NOT.(IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ. - & INPUT(:MIN(TRIM(FOLDER_NAME)+1,ILEN)).AND.INPUT(:1).NE.':' - & .AND.INDEX(INPUT,':defaults:').EQ.0)) THEN - IF (IER.EQ.0) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE SET_CUSTOM(PARAM) -C -C SUBROUTINE SET_CUSTOM -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - CHARACTER*(*) PARAM - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IF - - LENP = LEN(PARAM) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0.AND.PARAM(:LENP).NE.INPUT(2:LENP+1)) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - IF (CLI$GET_VALUE('SET_PARAM2',INPUT,ILEN)) THEN - WRITE (4,'(A)',IOSTAT=IER) ':'//PARAM(:LENP)//':'//INPUT(:ILEN) - END IF - - IF (PARAM.EQ.'exclude_limit') - & DECODE(ILEN,'(I)',INPUT(:ILEN)) EXCLUDE_LIMIT - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - DIMENSION BTIM(2) - - FILE_DIRECTORY = ' ' - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THEN - BULL_USER_CUSTOM = .FALSE. - ELSE - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IF - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',OLD_BUFFER) - IF (.NOT.IER) OLD_BUFFER = 'SYS$LOGIN:BULL.CUSTOM' - - OPEN(UNIT=17,FILE=OLD_BUFFER(:TRIM(OLD_BUFFER)), - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURN - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - NINCLUDE = 0 - OLD_FORMAT = .FALSE. - FLEN = TRIM(FOLDER_NAME) - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL LOWERCASE(OLD_BUFFER) - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults') - & .EQ.1) THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - OLD_FORMAT = OLD_FORMAT.OR.(.NOT.IER1) - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXC - & .OR.EXC.EQ.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1 - ELSE - EXC_CHANGED = .TRUE. - END IF - END IF - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - IF (INDEX(OLD_BUFFER,':file_directory').GT.0) - & FILE_DIRECTORY = OLD_BUFFER(17:) - IF (INDEX(OLD_BUFFER,':exclude_limit').GT.0) THEN - DECODE(OLEN-15,'(I)',OLD_BUFFER(16:),IOSTAT=IER1) - & EXCLUDE_LIMIT - EXCLUDE_LIMIT = MIN(999,EXCLUDE_LIMIT) - END IF - END IF - END DO - - CLOSE (UNIT=17) - - IF (OLD_FORMAT) CALL CHECK_EXCLUDES - - RETURN - END - - - - - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /DIRMODE/ DIRMODE - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - CHARACTER*(*) STRING,STRING1 - CHARACTER*132 ADDRESS - - CHARACTER*12 EXFROM - - INCLUDE_MSG = .TRUE. - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURN - - MATCH_FROM = .FALSE. - SYSTEM = IBCLR(SYSTEM,8) - - IF (STRING.EQ.'>') THEN - INCLUDE_MSG = .FALSE. - SYSTEM = IBCLR(SYSTEM,8) - RETURN - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - DO I=1,NINCLUDE - OLD_SCRATCH_B = SCRATCH_B - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (DIRMODE) BLIMIT = MIN(BLIMIT,FLEN+17+LEN(DESCRIP)) - MATCH = .FALSE. - IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:')) THEN - CALL GET_FROM(EXFROM,OLD_BUFFER(FLEN+15:), - & TRIM(OLD_BUFFER(FLEN+15:))) - IF (STREQ(ADDRESS(STRING),ADDRESS(OLD_BUFFER(FLEN+15: - & TRIM(OLD_BUFFER(FLEN+15:BLIMIT))+FLEN+14))).OR. - & (DIRMODE.AND.STREQ(FROM,EXFROM))) THEN - MATCH = .TRUE. - MATCH_FROM = .TRUE. - END IF - ELSE IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND. - & STRFIND(STRING1(:TRIM(STRING1)), - & OLD_BUFFER(FLEN+18:BLIMIT)).GT.0) THEN - MATCH = .TRUE. - END IF - IF (MATCH) THEN - CDATE = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ') - IF (CDATE.NE.0.AND.EXC.NE.0) THEN - IF (OLD_BUFFER(BLIMIT+1:BLIMIT+1).EQ.':') EXC = -1 - CALL ADD_EXCL(OLD_BUFFER,BLIMIT,EXC) - CALL WRITE_QUEUE(%VAL(OLD_SCRATCH_B),OLD_SCRATCH_B, - & OLD_BUFFER) - EXC_CHANGED = .TRUE. - END IF - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THEN - SYSTEM = IBSET(SYSTEM,8) - INCLUDE_MSG = .TRUE. - ELSE IF (.NOT.BTEST(SYSTEM,8).OR.MATCH_FROM) THEN -C -C Only "from" matches override threads, but not subject matches. -C - INCLUDE_MSG = .FALSE. - SYSTEM = IBCLR(SYSTEM,8) - IF (MATCH_FROM) RETURN - END IF - END IF - END DO - - RETURN - END - - - - FUNCTION STRFIND(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) STRING,STRING1 - - L = LEN(STRING1) - DO I=0,LEN(STRING)-L - J = 1 - DO WHILE (J.LE.L) - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(STRING1(J:J)) - & .OR..NOT.ALPHA(STRING(I+J:I+J)))) THEN - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = I + 1 - RETURN - ELSE - J = J + 1 - END IF - END DO - END DO - - STRFIND = 0 - - RETURN - END - - - - - SUBROUTINE SHOW_EXCLUDE(TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (TYPE.EQ.0) WRITE (6,'('' There are no excludes.'')') - IF (TYPE.EQ.1) WRITE (6,'('' There are no threads.'')') - RETURN - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - FOUND = .FALSE. - - L = 1 - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - IF (STREQ(FOLDER_NAME(:FLEN)//':',OLD_BUFFER(:MIN(FLEN+1,OLEN))) - & .AND.((TYPE.EQ.1.AND.STREQ(OLD_BUFFER(FLEN+2:FLEN+8), - & 'INCLUDE')).OR.(TYPE.EQ.0.AND.STREQ( - & OLD_BUFFER(FLEN+2:FLEN+8),'EXCLUDE')))) THEN - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'Excludes for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'Threads for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - FOUND = .TRUE. - END IF - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (BLIMIT+5-FLEN.GT.PAGE_WIDTH.AND.L+2.GT.PAGE_LENGTH-1) THEN - L = L + 2 - ELSE - IF (L.EQ.0) THEN - WRITE (6,'(''+'',A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - ELSE - WRITE (6,'(1X,A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - END IF - IF (OLD_BUFFER(BDATE+1:BDATE+1).EQ.'-') - & OLD_BUFFER(BDATE:) = ' '//OLD_BUFFER(BDATE:) - OUTLEN = MIN(BLIMIT,PAGE_WIDTH+FLEN+9)-FLEN-9 - IF (OUTLEN.GT.PAGE_WIDTH-16) THEN - WRITE (6,'(1X,X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 2 - ELSE - WRITE (6,'(''+'',X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 1 - END IF - END IF - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & INPUT(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'No excludes found for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'No threads found for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - CHARACTER*12 NEW,OLD - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to set a new name.'')') - RETURN - END IF - - CALL CLI$GET_VALUE('OLDNAME',OLD,LENO) - CALL CLI$GET_VALUE('NEWNAME',NEW,LENN) - - CALL OPEN_BULLUSER_SHARED - - TEMP_USER = USERNAME - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY - END DO - - IF (IER.EQ.0) THEN - USERNAME = NEW - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=NEW) - END DO - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) USER_ENTRY - ELSE - REWRITE (4,IOSTAT=IER) USER_ENTRY - END IF - END IF - - USERNAME = TEMP_USER - DO WHILE (REC_LOCK(IER1)) - READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY - END DO - - CALL CLOSE_BULLUSER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Old name not found.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN))) - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - IF (LENO.GT.1) THEN - OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1))) - ELSE - OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2))) - END IF - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - IF (LENN.GT.1) THEN - NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1))) - ELSE - NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))) - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - SUBROUTINE CHECK_EXCL(BUFFER,L,EXC,BLIMIT,BDATE,IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - - CHARACTER*(*) BUFFER - - DIMENSION BTIM(2) - - BLIMIT = L - BDATE = L+3 - - IER = BUFFER(L:L).EQ.':' - IF (IER) THEN - I = LAST_INDEX(BUFFER(:L-1),':') - IF (I.GT.0) THEN - J = LAST_INDEX(BUFFER(:I-1),':') - IF (J.GT.0) THEN - IF (J.LT.I-1) THEN - DECODE(I-J-1,'(I)',BUFFER(J+1:I-1),IOSTAT=IER) EXC - IER = IER.EQ.0 - ELSE - EXC = EXCLUDE_LIMIT - END IF - IF (IER) BLIMIT = J - 1 - CALL STR$UPCASE(BUFFER(I+1:L-1),BUFFER(I+1:L-1)) - IF (IER) IER = SYS_BINTIM(BUFFER(I+1:L-1),BTIM) - BDATE = I + 1 - END IF - ELSE - IER = .FALSE. - END IF - END IF - - IF (.NOT.IER) CALL ADD_EXCL(BUFFER,L,-1) - - RETURN - END - - - - SUBROUTINE ADD_EXCL(BUFFER,L,EXC) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2) - - CHARACTER*(*) BUFFER - - CHARACTER TODAY*24 - - IF (EXC.EQ.-1) THEN - BUFFER = BUFFER(:L)//':' - ELSE - BUFFER = BUFFER(:L)//':' - WRITE (BUFFER(L+2:),'(I3)') EXC - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - BUFFER = BUFFER(:TRIM(BUFFER))//':'//TODAY(:INDEX(TODAY,' ')-1)//':' - - L = TRIM(BUFFER) - - RETURN - END - - - - - CHARACTER*(*) FUNCTION ADDRESS(INPUT) - - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) INPUT - - ADDRESS = INPUT - - IF (INDEX(INPUT,'@').EQ.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - ADDRESS = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - ELSE - ADDRESS = INPUT(:MINGT0(TRIM(INPUT),INDEX(INPUT,' ')-1)) - IF (INDEX(ADDRESS,'(').GT.0) - & ADDRESS = ADDRESS(:INDEX(ADDRESS,'(')-1) - END IF - - RETURN - END - - - - - SUBROUTINE SEND_MAIL - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - C = 0 - DO WHILE (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) - OPEN (UNIT=8,FILE=INPUT(:TRIM(INPUT)),IOSTAT=IER,RECL=256) - IF (IER.NE.0) GOTO 30 - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - DO I=1,3 - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - END DO - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - DO WHILE (IER.EQ.0) - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - END IF - END DO - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - CLOSE (UNIT=8,STATUS='DELETE') - GOTO 20 -10 CLOSE (UNIT=8) -20 CALL SMTP_DISCONNECT() -30 CONTINUE - END DO - - CALL EXIT - END diff --git a/decus/vmslt02a/bulletin/bulletin2.for b/decus/vmslt02a/bulletin/bulletin2.for deleted file mode 100644 index 88da4de..0000000 --- a/decus/vmslt02a/bulletin/bulletin2.for +++ /dev/null @@ -1,2693 +0,0 @@ -C -C BULLETIN2.FOR, Version 11/11/99 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'('' WARNING: Account used by other folder.'', - & '' If you specify the same account,'')') - WRITE (6,'('' you must specify the address'', - & '' of the mailing list in the folder description.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to make this change? ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) THEN - CALL CLOSE_BULLUSER - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Specified file cannot be opened.'')') - RETURN - END IF - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.EQ.0) THEN - INFROM = INPUT(:ILEN)//',' - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (MSG_OWN) THEN - ILEN = TRIM(INPUT) - 6 - INFROM = INFROM(:LENFRO)//INPUT(7:) - IF (INDEX(INFROM,' "').GT.INDEX(INFROM,'@')) THEN - I = INDEX(INFROM,' "') - INFROM = INFROM(:I-1)// - & INFROM(INDEX(INFROM(I+2:),'"')+I+2:) - DO WHILE (INDEX(INFROM,'""').GT.0) - INFROM = INFROM(:INDEX(INFROM,'""'))// - & INFROM(INDEX(INFROM,'""')+2:) - END DO - END IF - CALL ADD_PROTOCOL(INFROM(LENFRO+1:),ILEN) - LENFRO = LENFRO + ILEN - END IF - IF (EDIT.AND.TEXT) THEN - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:TRIM(INPUT)-1) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:TRIM(INPUT))//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_P = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LEN_P.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') BULL_PARAMETER(:LEN_P)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THEN - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - IER = 0 - END IF - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')') - END IF - END IF - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IF - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (.NOT.FILESPEC) THEN - WRITE (6,'('' Enter message: End with ctrl-z,'', - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - ELSE - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IF - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IF - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - END IF - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No message added.'')') - IF (.NOT.STATUS) THEN - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ') - IF (STREQ(INPUT(:1),'Y')) THEN - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV') - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IF - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C -C SUBROUTINE ADD_SIGNATURE -C -C FUNCTION: Adds signature to message being mailed/posted. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATURE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/ - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURN - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) RETURN - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IF - - ICOUNT = 0 - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME))) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THEN - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END DO - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IF - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE. - ELSE - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' ' - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - END DO - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,INPUT1 - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(INPUT(I:I)) - & .OR..NOT.ALPHA(INPUT1(I:I)))) RETURN - END DO - - STREQ = .TRUE. - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -C -C SUBROUTINE RESPOND_MAIL -C -C FUNCTION: Sends mail to address. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,MLDESCRIP*(LINE_LENGTH) - - PRIVS = FILE.NE.'SYS$LOGIN:BULL.SCR' - - MLDESCRIP = SUBJECT - LENDES = TRIM(MLDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES) - IF (MLDESCRIP(I:I).EQ.'"') THEN - IF (LENDES.EQ.LINE_LENGTH) THEN - MLDESCRIP(I:I) = '`' - ELSE - MLDESCRIP = MLDESCRIP(:I)//'"' - & //MLDESCRIP(I+1:) - I = I + 1 - LENDES = LENDES + 1 - END IF - END IF - I = I + 1 - END DO - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0 - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD) - IF (PRIVS) CALL DISABLE_PRIVS - - IF (LISTSERV) THEN - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('MX_REPLY_TO','DEFINED')) - & CALL CRELNM('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('PMDF_REPLY_TO','DEFINED')) - & CALL CRELNM('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - IF (.NOT.SYS_TRNLNM('MULTINET_SMTP_REPLY_TO','DEFINED')) - & CALL CRELNM('MULTINET_SMTP_REPLY_TO', - & USERNAME(:TRIM(USERNAME))) - END IF - END IF - - IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (LPATH.GT.0) THEN - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - END IF - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - CALL CRELNM('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - CALL CRELNM('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE - CALL CRELNM('MULTINET_SMTP_REPLY_TO',INFROM(:TRIM(INFROM))) - END IF - END IF - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO) - & //'""" """'//MLDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IF - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//MLDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE - I = INDEX(SENDTO,'%""') + 3 - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THEN - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THEN - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THEN - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & MLDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) -C -C Use the following if you do not have VMS V5.3 or greater. -C -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//MLDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IF - - IF (PRIVS) CALL ENABLE_PRIVS - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV.OR.USE_INFROM) THEN - USE_INFROM = .FALSE. - CALL DELLNM_USER('MULTINET_SMTP_REPLY_TO') - CALL DELLNM_USER('PMDF_REPLY_TO') - CALL DELLNM_USER('MX_REPLY_TO') - END IF - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: CHANGE command subroutine. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWER - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IF - -C -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - LENFROM = 0 - IF (CLI$PRESENT('OWNER')) THEN - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - IER = CLI$GET_VALUE('OWNER',INFROM,LENFROM) - INFROM = 'From: '//INFROM - LENFROM = LENFROM + 6 - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('OWNER')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')') - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')') - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL.OR.LENFROM.GT.0) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (LENFROM.EQ.0) THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description header - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT, - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - IF (CLI$PRESENT('OWNER')) THEN - CALL GET_FROM(FROM,INFROM(7:),LENFROM-6) - CALL STR$UPCASE(FROM,FROM) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2100' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2100' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10) - - CHARACTER GROUP*80,STAT*4 - - EXTERNAL CLI$_ABSENT - - IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SEARCH_LEN(1) = 3 - SEARCH_NUM = 1 - NFOLDER = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - SEARCH_NUM = 1 - NFOLDER = 1 - INPUT = DESCRIP - CALL INCLUDE_SUBJECT(0) - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1 - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM) - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1 - NFOLDER = 1 - ELSE - IF (NFOLDER.EQ.0) NFOLDER = 1 - SEARCH_STRING = ' ' - END IF - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - END IF - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME - NFOLDER = NFOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DO - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - SCRATCH_F = SCRATCH_F1 - NFOLDER = NFOLDER + 1 - END IF - - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - OLD_BUFFER = ' ' - END IF - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - END IF - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IF (NFOLDER.NE.0) FOUND = 0 - - CHANGE = .FALSE. - IF (CLI$PRESENT('REPLY').OR. - & TRIM(SEARCH_STRING).GT.0) THEN - REVERSE = CLI$PRESENT('REVERSE') - ELSE - REVERSE = .FALSE. - END IF - - DO WHILE (NFOLDER.NE.0.AND.FOUND.LE.0.AND.FOUND.GT.-3) - IF ((NFOLDER.GT.0.AND.(.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1)).OR. - & (NFOLDER.LT.0.AND.OLD_BUFFER.NE.' ')) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL, - & REVERSE,CLI$PRESENT('SUBJECT') - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'), - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),CHANGE) - IF (FOUND.LE.0.AND.FOUND.GE.-2) THEN - NFOLDER = NFOLDER - 1 - IF (NFOLDER.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F, - & FOLDER1_NAME) - END IF - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - END IF - END DO - ELSE IF (NFOLDER.LT.0) THEN - NFOLDER = NFOLDER + 1 - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - IF (GFOUND) THEN - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - GFOUND = .FALSE. - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - END IF - ELSE - NFOLDER = 0 - END IF - END DO - CALL CLOSE_BULLFOLDER - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - END IF - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - NFOLDER = 0 - END IF - CALL CANCEL_CTRLC_AST - END IF - END IF - END DO - - IF (FOUND.EQ.-3) FOUND = 0 - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - IF (CHANGE) THEN - WRITE (6,'('' No matches found in current folder: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' No matches found.'')') - END IF - ELSE IF (FOUND.EQ.-2) THEN - IF (CHANGE) THEN - WRITE (6,'('' ERROR: No more messages in current folder: '' - & ,A)') FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' ERROR: No more messages.'')') - END IF - END IF - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN, - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE,CHANGE) -C -C SUBROUTINE GET_SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEXT/ NEXT - LOGICAL NEXT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*4 SAVECMD - - CHARACTER*128 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - OLD_REVERSE = REVERSE - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THEN - OLD_REVERSE = REVERSE - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(BULL_POINT,IER) - IF (BULL_POINT+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (STREQ(DESCRIP(:4),'RE: ').AND.TRIM(DESCRIP).GE. - & LEN(DESCRIP)-1) THEN - IF (FILES) CALL OPEN_BULLFIL_SHARED - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - SEARCH_STRING = INPUT(11:) - SEARCH_STRING = SEARCH_STRING(:LEN(DESCRIP)) - ELSE - SEARCH_STRING = DESCRIP(5:) - END IF - IF (FILES) CALL CLOSE_BULLFIL - ELSE IF (STREQ(DESCRIP(:4),'RE: ')) THEN - SEARCH_STRING = DESCRIP(5:) - END IF - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - ELSE - SEARCH_NUM = OLD_SEARCH_NUM - IF (SEARCH_LEN(1).EQ.0) SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (OLD_REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - OLD_SEARCH_NUM = SEARCH_NUM - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.CHANGE.OR. - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last - END IF - IF (REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - SEARCH_STRING = ' ' - RETURN - END IF - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0 - BULL_SEARCH = START_BULL+1 - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR. - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY) - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - ELSE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - IF (IER.EQ.0) THEN - IER = BULL_SEARCH + 1 - ELSE - GO TO 800 - END IF - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - IF (SEARCH_MODE.EQ.4) THEN - CALL STR$UPCASE(DESCRIP1,FROM) - ELSE - IF (LEN(DESCRIP)-1.LE.TRIM(DESCRIP)) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - DESCRIP1 = INPUT(7:) - END IF - CALL STR$UPCASE(DESCRIP1,DESCRIP1) - ELSE - CALL STR$UPCASE(DESCRIP1,DESCRIP) - END IF - IF (DESCRIP1(:4).EQ.'RE: ') DESCRIP1 = DESCRIP1(5:) - IF (TRIM(SEARCH_STRING).GE.LEN(DESCRIP)-5.AND. - & TRIM(DESCRIP1).GT.TRIM(SEARCH_STRING)) - & DESCRIP1 = DESCRIP1(:TRIM(SEARCH_STRING)) - END IF - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (TRIM(SEARCH_STRING).EQ.LEN(DESCRIP).AND. - & DESCRIP1(:LEN(DESCRIP)).EQ.SEARCH_STRING)))) THEN - IF (.NOT.NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - ELSE IF (NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - MATCHES = 0 - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE. - END DO - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THEN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I) - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR. - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - END IF - END DO - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE - FOUND = -1 - END IF - END IF - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULL - END DO - -800 FOUND = 0 - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - NEXT = .FALSE. - CALL READDIR(BULL_POINT,IER) - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - END IF - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - IF (.NOT.IER1) SEARCH_STRING = ' ' - NEXT = .FALSE. - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMD - - RETURN - END - - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE) - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRING - - OLD_MATCH = .FALSE. - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURN - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE. - RETURN - END IF - J = J + SEARCH_LEN(I) - END DO - - RETURN - END - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')') - RETURN - END IF -C -C Get the bulletin number to be undeleted. -C - - IF (INCMD(:3).EQ.'DIR') THEN - BULL_DELETE = BULL_POINT ! Delete the file we are reading - ELSE - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:11).LT.'1900') EXDATE(8:9) = '19' - IF (EXDATE(8:11).LT.'1995') EXDATE(8:9) = '20' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'21'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'21'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - IF (INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE IF (INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END - - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - CHARACTER*256 INPUT_OUT - CHARACTER*128 TEMP - - INPUT_OUT = ' ' - - I = 0 - - DO WHILE (I.LT.TRIM(INPUT)) - INPUT = INPUT(I+1:) - IF (I.GT.0) INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//',' - J = INDEX(INPUT,',') - IF (INDEX(INPUT,'(').LT.J.AND.INDEX(INPUT,')').GT.J) THEN - INPUT = INPUT(:INDEX(INPUT,'(')-1)//INPUT(INDEX(INPUT,')')+1:) - END IF - I = MINGT0(INDEX(INPUT,','),TRIM(INPUT)+1) - IF (INDEX(INPUT,',').EQ.I.AND.INDEX(INPUT(:I),'@').EQ.0) - & I = TRIM(INPUT)+1 - TEMP = INPUT(:I-1) - CALL ADD_PROTOCOL_SUB(TEMP) - INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//TEMP(:TRIM(TEMP)) - END DO - - INPUT = INPUT_OUT - - IF (ILEN.NE.0) ILEN = TRIM(INPUT) - - RETURN - END - - - - SUBROUTINE ADD_PROTOCOL_SUB(INPUT) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - END IF - - IF (LMAIL.EQ.0) THEN - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN - MAIL_PROTOCOL = MAILER - END IF - LMAIL = TRIM(MAIL_PROTOCOL) - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%' - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1 - RETURN - END IF - END IF - - I = INDEX(INPUT,'@') - IF (I.GT.0) THEN - INPUT = INPUT(:INDEX(INPUT(I:),' ')+I-2) - IF (INDEX(INPUT(I:),'(').GT.0) - & INPUT = INPUT(:INDEX(INPUT(I:),'(')+I-2) - END IF - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"' - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bulletin3.for b/decus/vmslt02a/bulletin/bulletin3.for deleted file mode 100644 index cf5b221..0000000 --- a/decus/vmslt02a/bulletin/bulletin3.for +++ /dev/null @@ -1,2518 +0,0 @@ -C -C BULLETIN3.FOR, Version 11/2/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2100' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2100' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - ILEN = 0 - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2100 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2100 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_TPU' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THEN - CALL EDT$EDIT('NL:',OUT) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT) - ELSE - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IF - END IF - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT - ELSE - WRITE(6,'('' Could not activate editor.'')') - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE) - - RETURN - END - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - NOW = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - IF (.NOT.NOW) NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.1000.AND.NEMPTY.GT.NBLOCK/10) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - CALL SYS$SETAST(%VAL(0)) - CALL REGISTER_BULLCP - IER1 = 1 - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - - BBOARD_LOOP = BBOARD_LOOP + 1 - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & (NEWS_LOOP.EQ.0.OR.NOW)) THEN - IF (NOW) THEN - CALL CREATE_PROCESS('BULLCP NEWS1') - ELSE - CALL CREATE_PROCESS('BULLCP NEWS') - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - - C = 0 - IF (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) THEN - CALL CREATE_PROCESS('BULLCP SMTP') - END IF - - NOW = .FALSE. - - NEWS_LOOP = NEWS_LOOP + 1 - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIME - CALL HIBER('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - DIMENSION NEW_SYSTEM_FLAG(FLONG) - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2)) - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER) - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - CALL SETUSER(USERNAME) - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAG - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - END DO - FOLDER_FLAG = FOLDER1_FLAG - FOLDER_NUMBER = 0 - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - CALL CLOSE_BULLUSER - ELSE - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DO - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IF - CLOSE (UNIT=REMOTE_UNIT) - END DO - END IF - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE HIBER(MIN) -C -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -C -C SUBROUTINE DELETE_EXPIRED_NEWS -C -C FUNCTION: -C -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - CHARACTER*4 GET_VMS_VERSION - - INTEGER TODAY(2),NEXT_EX_BTIM(2),NO_EXPIRE(2) - - CHARACTER*8 TODAY_KEY,TEMP - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - IF (NOW) THEN - IER = SYS$SETPRN('BULL NEWS1') - IF (.NOT.IER) CALL EXIT - IER = SYS$SETPRN('BULL NEWS') - IF (.NOT.IER) CALL EXIT - END IF - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - CALL SYS_BINTIM('-',TODAY) - - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - REMOTE_SET = 4 - -C -C A bug keeps messing up the last expired date key so that stored -C news groups do not get found. Someday when this is fixed, we can -C add code like this: -C -C INPUT = GET_VMS_VERSION() -C IF (INPUT(:2).EQ.'V5'.OR.INPUT(:2).EQ.'V4') VMSOLD = .TRUE..AND.NOW - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER).OR.(NOW.AND.IER.EQ.0.AND. - & (.NOT.BTEST(NEWS_F_FLAG,8).OR. - & COMPARE_BTIM(TODAY,NEWEST_EXBTIM).LT.0))) - IF (NOW) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - ELSE - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END IF - END DO - CALL NEWS_TO_FOLDER - - UNLOCK 7 - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - GO TO 1000 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,8)) GO TO 900 - - CALL OPEN_BULLDIR_SHARED - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0 - NDEL = -1 - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM) - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. - IF (NDEL.GT.NEWS_F_END) THEN - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1 - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (EXDATE(8:11).LT.'1995') THEN ! Deleted manually? - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) - EXTIME = ASCTIME(13:23) - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0 - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0 - UNLOCK 2 - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER) - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_START - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - IF (I.LE.F_NBULL) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0 - END DO - F_START = I - NEXT = .FALSE. - END IF - CALL READDIR(F_NBULL,IER) - IF (F_START.LT.F_NBULL.AND.(DN.OR.F_NBULL.EQ.IER)) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I) - I = I - 1 - IF (I.GE.F_START) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = I - END DO - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLDIR - END DO - -900 CALL CLOSE_BULLNEWS - -1000 IF (NOW.OR.IER.EQ.0) THEN - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.*]'//'*.' - INPUT = GET_VMS_VERSION() - CALL LIB$DAY_OF_WEEK(TODAY,DAY) - IF (DAY.NE.7) THEN - IER = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - IF (IER) THEN - DAY = 7 - CALL DELLNM('BULL_NEWS_CLEANUP') - END IF - END IF - IF (INPUT(:2).NE.'V5'.AND.INPUT(:2).NE.'V4') THEN - CONTEXT = 0 - DO WHILE (LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT)) - IER = CONV$RECLAIM(INPUT(:TRIM(INPUT))) - END DO - ELSE IF (DAY.EQ.7) THEN - REMOTE_SET = 4 - DIRLIST = .TRUE. - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(1000,IER) - CALL READ_FOLDER_FILE(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NO_EXPIRE) - DO WHILE (IER.EQ.0) - UNLOCK 7 - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - C = 0 - IF (LIB$FIND_FILE(BULLNEWSDIR_FILE - & (:TRIM(BULLNEWSDIR_FILE))//';1',INPUT,C)) THEN - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';2') - ELSE - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - END IF - CALL OPEN_BULLDIR_SHARED - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE,SHARED, - & BUFFERCOUNT=127, - & INITIALSIZE=(NEWSDIR_RECORD_LENGTH*F_COUNT)/512, - & STATUS='NEW',FORM='UNFORMATTED',DISPOSE='DELETE', - & RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,IOSTAT=IER, - & ORGANIZATION='INDEXED',RECORDTYPE='FIXED', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - END IF - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (2,IOSTAT=IER) NEWSDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - WRITE (9,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - ELSE - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY), - & %DESCR(EX_BTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & CALL COPY2(NEWEST_EXBTIM,EX_BTIM) - END IF - END IF - END DO - CLOSE (UNIT=9,DISPOSE='KEEP') - CALL CLOSE_BULLDIR_DELETE - CALL GET_MSGKEY(NEWEST_EXBTIM,TEMP) - IF (TEMP.NE.NEWS_F_EXPIRED_DATE) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - NEWS_F_EXPIRED_DATE = TEMP - CALL REWRITE_FOLDER_FILE(IER) - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - END IF - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - ELSE - IF (NO_EXPIRE(1).NE.NEWEST_EXBTIM(1).OR. - & NO_EXPIRE(2).NE.NEWEST_EXBTIM(2)) THEN - CALL GET_MSGKEY(NO_EXPIRE,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - ELSE - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - END IF - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';') - END DO - END IF - CALL READ_FOLDER_FILE(IER) - END DO - CALL CLOSE_BULLNEWS - END IF - DIRLIST = .FALSE. - NEWSLIST = .TRUE. - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - IER = .TRUE. - DO WHILE (IER) - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;') - IER = INDEX(FOLDER_FILE,']1JAN').EQ.0 - END DO - J = INDEX(FOLDER_FILE,']') - DECODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) THEN - DO I=1,10 - YEAR = YEAR - 1 - IF (YEAR.EQ.-1) YEAR = 99 - ENCODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) IER = LIB$DELETE_FILE(FOLDER_FILE(:J) - & //'*.*;*') - END DO - END IF - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IF - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'READ/NEW' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - - IER = 0 - CALL STRIP_HEADER(' ',-1,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.EQ.0) THEN - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP) - IF (STRIP.AND.INPUT(:5).EQ.'From:') INFROM = ' ' - END IF - END DO - -C -C If more than one folder has same BBOARD account, don't use the -C To: line to determine which folder to put the mail message in. -C - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - DUP = .FALSE. - DO WHILE (.NOT.DUP.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - DUP = FOLDER.NE.FOLDER1.AND.FOLDER_BBOARD.EQ.FOLDER1_BBOARD - END DO - IF (DUP.OR..NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - FOUND = .FALSE. - J = 0 - IF (DUP) J = 1 - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THEN - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - FOUND = INTO.EQ.F_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - END IF - FLEN = TRIM(F_BBOARD) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DO - END IF - END IF - END DO - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COM - END IF - - NUMHEAD = 0 - IF (NHEAD.GT.0) NUMHEAD = NHEAD + 1 - - IF (NUMHEAD.GT.0) THEN - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - SAVE_Q = HEADER_Q - SAVE_Q1 = HEADER_Q1 - NHEAD1 = NHEAD - HEADER_Q1 = 0 - ! INIT_MESSAGE_ADD_BBOARD reinits header so save it - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NUMHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - ELSE IF (NUMHEAD.EQ.1) THEN - INPUT = ' ' - LEN_INPUT = 1 - NUMHEAD = NUMHEAD - 1 - ELSE - CALL READ_QUEUE(%VAL(SAVE_Q),SAVE_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - USE_INFROM = .TRUE. - - NHEAD = NHEAD1 - HEADER_Q1 = SAVE_Q1 - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL SYS$SETAST(%VAL(1)) - IF (.NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) - & CALL NEWS2BULL(.FALSE.) - END IF - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE. - - LEN_BBOARD = LEN(BBOARD) - 1 - LEN_INPUT = TRIM(INPUT) - - DO I=1,LEN_INPUT-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND. - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND. - & (I.EQ.LEN_INPUT-LEN_BBOARD.OR. - & (INDEX('@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0 - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND. - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALPHA(IN) - - CHARACTER*(*) IN - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURN - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN - - BBOARD_NAME = FOLDER_DESCRIP(I+1:) - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!') - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DO - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - IER = 0 - DO WHILE (IER.EQ.0) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - END DO - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - IF (INDEX(IMAGENAME,';').GT.0) ILEN = INDEX(IMAGENAME,';') - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0) - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - IF (.NOT.IER.AND..NOT.DEL) THEN - CALL DELPRC('BULLCP NEWS',DEL) - IER = .NOT.DEL - ELSE - IER = .TRUE. - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI) -C -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL ADD_2_ITMLST(4,JPI$_ENQLM,%LOC(ENQLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF - END IF - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_ENQLM - CALL LIB$MOVC3(4,ENQLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2)) - - RETURN - END - - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - CHARACTER*4 FUNCTION GET_VMS_VERSION -C -C FUNCTION GET_VMS_VERSION -C -C FUNCTION: Gets VMS version -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER VERSION*4 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,SYI$_NODE_SWVERS,%LOC(VERSION)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - GET_VMS_VERSION = VERSION - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL OPEN_BULLDIR_SHARED - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DO - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - CALL CLOSE_BULLUSER - CALL CLOSE_BULLDIR - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAM - - DATA OBIO/0/,OCPU/0/,ODIO/0/ - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAM - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU)) - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IF - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1 - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - END IF - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND. - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIO - ODIO = DIO - OCPU = CPU - IER = 0 - RETURN - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IF - RETURN - END diff --git a/decus/vmslt02a/bulletin/bulletin4.for b/decus/vmslt02a/bulletin/bulletin4.for deleted file mode 100644 index 23abda9..0000000 --- a/decus/vmslt02a/bulletin/bulletin4.for +++ /dev/null @@ -1,2350 +0,0 @@ -C -C BULLETIN4.FOR, Version 12/17/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(' ',-1,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - READ_HEAD = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) THEN ! No more records. - IF (STRIP.AND..NOT.READ_HEAD.AND.NHEAD.GT.0) THEN - IBLOCK = SBLOCK - ILEN = LINE_LENGTH+1 - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - READS = 0 - IF (SEEN_FROM) READS = READS + 1 - IF (SEEN_SUBJ) READS = READS + 1 - IF (MSG_SENT) READS = READS + 1 - IF (READS.GT.0) THEN - DO I=1,READS - ILEN = 0 - DO WHILE (ILEN.EQ.0) - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - END DO - END DO - END IF - STRIP = .FALSE. - ELSE - RETURN - END IF - END IF - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' '.AND..NOT.MAIL_POST()) THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - IF (STRIP.AND.BUFFER(:5).EQ.'From:') READ_HEAD = .TRUE. - IF (.NOT.STRIP.AND..NOT.READ_HEAD.AND.NHEAD.GT.0) THEN - IBLOCK = SBLOCK - ILEN = LINE_LENGTH+1 - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - READS = 0 - IF (SEEN_FROM) READS = READS + 1 - IF (SEEN_SUBJ) READS = READS + 1 - IF (MSG_SENT) READS = READS + 1 - IF (READS.GT.0) THEN - DO I=1,READS - ILEN = 0 - DO WHILE (ILEN.EQ.0) - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - END DO - END DO - END IF - END IF - ELSE - IF (.NOT.HEADER) THEN - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - STRIP = .FALSE. - END IF - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - IER = 0 - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - CALL OTS$CVT_L_TI (DAY,EXDATE(:2),%VAL(2)) - IF (EXDATE(1:1).EQ.'0') EXDATE(1:1) = ' ' - CALL OTS$CVT_L_TI (YEAR,EXDATE(8:11),%VAL(4)) - -C ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date -C ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - CHARACTER RESPONSE*4 - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - CALL STR$UPCASE(FOLDER,FOLDER) - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '', - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAX - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - RETURN - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACL - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_NAME = FOLDER - FOLDER_OWNER = FOLDER1_OWNER - - MAILTO = 0 - I = INDEX(FOLDER_DESCRIP,'<') - J = INDEX(FOLDER_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER_DESCRIP(I:),'@').LT.1.OR. - & INDEX(FOLDER_DESCRIP(I:),'@').GT.J-I+1).AND.NEWS_FEED()) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - I = INDEX(FOLDER_DESCRIP,'[') - J = INDEX(FOLDER_DESCRIP,']') - END IF - - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - IF (I.GT.0.AND.J.GT.I.AND..NOT.NEWS_FEED().AND.MAILTO.EQ.0 - & .AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - IF (CLI$GET_VALUE('COPY',FOLDER1,FLEN).NE.%LOC(CLI$_ABSENT)) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Unable to copy folder settings.'')') - ELSE - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - 1 - IF (.NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) THEN - LAST(1,FOLDER1_NUMBER+1) = LAST(1,FOLDER_NUMBER+1) - LAST(2,FOLDER1_NUMBER+1) = LAST(2,FOLDER_NUMBER+1) - REWRITE (9,IOSTAT=IER) TEMP_USER,LAST - END IF - END IF - END DO - CALL CLOSE_BULLINF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(SET_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SET_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(NOTIFY_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - END IF - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - END IF - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -C -C Description: -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -C -C SUBROUTINE CREATE_NEWS_FOLDER -C -C FUNCTION: Creates a new newsgroup. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME) - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF -C -C If file specified in command, read file. -C Else, read from the terminal. -C - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file -2010 FORMAT(A) - ICOUNT = ICOUNT + ILEN - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER, - & 'Adding newsgroup.') - CLOSE (UNIT=3) - - RETURN - -920 WRITE(6,1020) -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURN - -910 WRITE(6,1010) -1010 FORMAT (' No news group was added.') - CLOSE (UNIT=3) - RETURN - - END - - - - - SUBROUTINE INIT_COMPRESS - - IMPLICIT INTEGER (A-Z) - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127 - DO J=0,127 - A(J,I) = ' ' - END DO - END DO - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DO - - J = 1 - DO I=1,8 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=10,31 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=127,254 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - - RETURN - - ENTRY COMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.126) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.126) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:))) - IF (T(O:O).NE.' ') THEN - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND. - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1)) - C = C + 1 - K = K + 1 - END DO - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1) - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0) - O = O + 1 - ELSE - T(O:O) = IN(K:K) - IF (ICHAR(T(O:O)).LT.9.OR.(ICHAR(T(O:O)).GT.9.AND. - & ICHAR(T(O:O)).LT.32)) T(O:O) = ' ' - K = K + 1 - O = O + 1 - END IF - END DO - IF (K.EQ.L) THEN - T(O:O) = IN(K:K) - ELSE - O = O - 1 - END IF - - OUT = T - - RETURN - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1 - T(O:O) = IN(I+2:I+2) - END DO - I = I + 3 - ELSE - B = UNMAP(J) - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1 - T(O:O) = IN(I:I) - ELSE - O = O + 2 - T(O-1:O) = B - END IF - I = I + 1 - END IF - END DO - - OUT = T(:O) - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bulletin5.for b/decus/vmslt02a/bulletin/bulletin5.for deleted file mode 100644 index bc7c3a7..0000000 --- a/decus/vmslt02a/bulletin/bulletin5.for +++ /dev/null @@ -1,2516 +0,0 @@ -C -C BULLETIN5.FOR, Version 3/5/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3) THEN - CALL SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - RETURN - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - NODEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (NODEFAULT) THEN - IF (NOTIFY.NE.-1) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) THEN - CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - END IF - REWRITE(4) USER_HEADER - ELSE IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & (FOLDER1_NUMBER.EQ.0.AND.FOLDER1_BBOARD(:2).NE.'::')) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - IF (FOLDER1_NUMBER.NE.0.OR.FOLDER1_BBOARD(:2).NE.'::') THEN - ! Test is due to bug which changes folder number to zero - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG - IF (BTEST(FOLDER1_FLAG,2)) THEN - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAG - FOLDER_NUMBER = TEMP_NUMBER - END IF - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - CALL UPDATE_EXCLUDE - - CALL UPDATE_USERINFO - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET').OR.(INCMD(:3).EQ.'SEA') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & (F1_START.GT.0.OR.F_START.LE.F_NBULL)) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_COUNT = F1_COUNT - IF (F1_START.GT.0) THEN - IF (F1_NBULL.LT.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER-1.GE.F1_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - ELSE - F_NBULL = F1_NBULL - END IF - F_START = F1_START - ELSE - F_START = F_NBULL + 1 - END IF - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - REMOTE_SET_NEW = 1 - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - IF (COMMAND.AND.INCMD(:3).NE.'REP'.AND. - & INCMD(:3).NE.'DEL') HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER1) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.IER1.EQ.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11).AND.WRITE_ACCESS) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s news group.'')') - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP( - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE IF (REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - ELSE IF (REMOTE_SET.EQ.3.OR.REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN - WRITE (6,'('' Folder only accessible for reading.'')') - END IF - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THEN - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - BULL_PARAMETER = 'MARKED' - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - BULL_PARAMETER = 'SEEN' - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED' - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN' - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - WRITE(6,'('' WARNING: No '',A, - & '' messages found.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IF - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE. - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - LAST_FOLDER_NUMBER = FOLDER_NUMBER - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IF - - IF (TEST_NEWS(FOLDER1)) THEN - INCMD = 'SET NEWS ' - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL ' - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Access is limited.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0) - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,10)) THEN - WRITE (6,'('' POST_ONLY has been set.'')') - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THEN - WRITE (6,'('' COMPRESS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,15)) THEN - WRITE (6,'('' GATEWAY has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - IF (NEWS_FEED()) THEN - WRITE (6,'('' Last message fed by news group was: '',I)') F_LAST - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/, - & ' Description: ',A) -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/, - & ' Description: ',A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/ - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' ' - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. - STORED = .FALSE. - CLASS = .FALSE. - NEW = .FALSE. - PERM = .FALSE. - DEFA = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counter - NLINE = 1 - START = .FALSE. - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE. - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - CALL NEWS_LIST - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - END IF - COUNT = CLI$PRESENT('COUNT') - IF (COUNT) TOTAL_COUNT = 0 - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - NEW = CLI$PRESENT('NEWGROUPS') - CLASS = CLI$PRESENT('CLASS') - PERM = CLI$PRESENT('PERMANENT') - DEFA = CLI$PRESENT('DEFAULT') - IF (CLASS) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - ELSE IF (PERM) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE IF (DEFA) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER) - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER - FOLDER_COUNT = -1 - RETURN - ELSE - START = .TRUE. - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN) - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0 - FOLDER_COUNT = -1 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN - SUBNUM = -2 - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DECLARE_CTRLC_AST - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE. - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (PERM.OR.DEFA) THEN - IER = 1 - DO WHILE (INUM.LE.FOLDER_MAX.AND.IER.NE.0) - IF (INF_REC2(1,INUM).NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (ZEXT(INF_REC2(1,INUM)),IER) - END IF - INUM = INUM + 1 - END DO - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2 - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THEN - NEW_NEWS = FOLDER1_NUMBER - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP) - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)), - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - END IF - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - FSTATUS1 = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (.NOT.NEWS_TEST) THEN - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN - IER1 = 1 - MORE = .TRUE. - END IF - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DO - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1 - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THEN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))') - ELSE IF (CLASS) THEN - WRITE (6,'(1X,''Class'',/,1X,(''-''))') - ELSE IF (SUBSCRIBE) THEN - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,''Status'',7X, - & ''First Last'',/,1X,(''-''))') - END IF - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1 - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1.AND. - & FLAG.NE.100) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - ELSE - FSTATUS1 = ' ' - END IF - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNT - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0 - END IF - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '* '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - END IF - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IF - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER - IF (NEWS_TEST.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - CALL GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & FSTATUS1,IER,ACTIVE) - MORE = MORE.AND.FOUND - IF (MORE) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND.AND.FLAG.NE.1) FLAG = 100 - END IF - END DO - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - END IF - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNT - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSE - WRITE(6,1100) ! Else say there are more - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10) -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS.OR.CLI$PRESENT('CLASS')) THEN - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.' - END IF - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER ! Open folder file - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - CALL RESET_PROTECTION - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')') - RETURN - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0) - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER) - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE - CALL SET_FOLDER_FILE(0) - END IF - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INDEX(INPUT,'[').EQ.0.AND.INDEX(INPUT,']').GT.0.AND. - & ID(:1).EQ.'[') INPUT = ID(:TRIM(ID))//','//INPUT - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').GT.0) - & COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"'.AND.INDEX(INPUT(2:),'"').GT.0) - & COMMA = INDEX(INPUT(2:),'"') + 2 - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').EQ.0) COMMA = 0 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ILEN = TRIM(ID) - ELSE - ID = INPUT - INPUT = ' ' - ILEN = TRIM(ID) - END IF - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE IF (ID(:1).NE.'['.OR.INDEX(ID,']').NE.0) THEN - IF (ILEN.EQ.0) THEN - IER = SS$_IVIDENT - ELSE IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IF - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*256 ACLENT - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURN - - ENTRY WRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER_COM - END IF - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - DO I=1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - NEW_NEWS_ACCESS = - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS' - - RETURN - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C)) - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' ' - ELSE - FILE = FILE(:L) - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - F = LEN(FIND) - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & STAT,IER,ACTIVE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*(*) STAT,FOLDER_MATCH - - CHARACTER NEWS_ACCESS*132 - - FOUND = .FALSE. - STAR = INDEX(FOLDER_MATCH,'*') - ONE = STAR.EQ.0.AND.TRIM(FOLDER_MATCH).GT.0 - START = .FALSE. - IF (STAR.GT.1) - & START = FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1) - STARTNOW = START - - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - IF (ONE) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER_MATCH(:TRIM(FOLDER_MATCH)),IER) - FOLDER_MATCH = ' ' - ELSE IF (STARTNOW) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP - & (FOLDER_MATCH(:STAR-1),IER) - STARTNOW = .FALSE. - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - END IF - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - STAT(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - STAT = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(STAT(:1).NE.'x'.AND. - & .NOT.BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (ONE.OR..NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1) - ELSE - FOUND1 = .TRUE. - END IF - END IF - FOUND = FOUND1 - ELSE - FOUND = .TRUE. - END IF - ELSE IF (IER.EQ.0.AND.START) THEN - IF (FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1)) RETURN - END IF - IF (ONE) RETURN - END DO - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bulletin6.for b/decus/vmslt02a/bulletin/bulletin6.for deleted file mode 100644 index 92a761f..0000000 --- a/decus/vmslt02a/bulletin/bulletin6.for +++ /dev/null @@ -1,2835 +0,0 @@ -C -C BULLETIN6.FOR, Version 11/2/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - TRY = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.TRY.EQ.0) THEN - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - TRY = 1 - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL_NAME - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & BUFFERCOUNT=127, - & ORGANIZATION='INDEXED',IOSTAT=IER) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open file: '',A)') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - IF (UNIT.EQ.14) THEN - WRITE (6,'('' Database conversion in progress. Try later.'')') - ELSE - WRITE (6,'('' Please try again later.'')') - END IF - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - COMMON /NEWSLIST/ NEWSLIST - DATA NEWSLIST/0/ - - COMMON /DIRLIST/ DIRLIST - DATA DIRLIST/0/ - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - LUN = 2 - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL_NAME - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & BUFFERCOUNT=127, - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - END IF - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) WRITE(6,'(1X,A)') - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1))) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULL - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LAST - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMIT - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLNEWSDIR - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($FORIOSDEF)' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*180 TEMP - - CHARACTER BUFFER*12,DATETIME*24 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - CALL OPEN_BULLNEWS - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=180/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & BUFFERCOUNT=127,KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR]') - IF (.NOT.IER1) GO TO 900 - - NEW_FOLDER_NUMBER = 0 - - DO WHILE (IER.EQ.0) - READ (2,IOSTAT=IER) TEMP - IF (GET_INTEGER(%REF(TEMP)).NE.NEW_FOLDER_NUMBER) THEN - IF (NEW_FOLDER_NUMBER.NE.0) CLOSE (UNIT=9,DISPOSE='KEEP') - NEW_FOLDER_NUMBER = GET_INTEGER(%REF(TEMP)) - CALL SET_BULLNEWSDIR_FILE(NEW_FOLDER_NUMBER) - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE, - & STATUS='UNKNOWN',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) GO TO 900 - END IF - NEWS_MSG_NUM = GET_INTEGER(%REF(TEMP(5:))) - NEWS_MSG_BTIM_KEY = TEMP(13:) - NEWS_EX_BTIM_KEY = TEMP(89:) - NEWS_MSGID = TEMP(21:) - CALL COPY2(MSG_BTIM,%REF(TEMP(97:))) - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL LIB$MOVC3(76,%REF(TEMP(105:)),NEWS_BLOCK) - - WRITE (9,IOSTAT=IER1) NEWSDIR_ENTRY - END DO - - CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - - CALL RESET_PROTECTION - - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - - IER = LIB$RENAME_FILE(BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - & ,'BULLNEWSDIR.OLD') - - WRITE (6,'('' BULLNEWSDIR.DAT has been renamed to '', - & '' BULLNEWSDIR.OLD and may now be deleted.'')') - - RETURN - -900 CALL RESET_PROTECTION - - CALL CLOSE_BULLNEWS - - WRITE(6,'('' ERROR: Cannot convert BULLNEWSDIR.DAT'')') - IF (IER.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - - END - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(81:84) = BUFFER(85:) - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL RESET_PROTECTION - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - IF (ASK_SIZE.EQ.184) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST) - ELSE - F_LAST = 0 - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LAST - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER)) - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0 - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -C -C SUBROUTINE CONVERT_BULLNEWS -C -C FUNCTION: Converts bulletin NEWS file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. '' - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0 - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE) - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0 - NEWS_F_END = 0 - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108) - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:) - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1 - IF (LMOVE.LE.0) THEN - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP - ELSE - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE)) - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) - END IF - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SET_PROTECTION - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL RESET_PROTECTION - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXT - - COMMON /KEEPLOCK/ KEEPLOCK - DATA KEEPLOCK/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /THREAD/ THREAD - - CHARACTER*4 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSE - DIR_NUM = 0 - END IF - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURN - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 250 blocks (1000 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.1000.AND.NEMPTY.GT.NBLOCK/10 - & .AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLFIL - CALL OPEN_BULLDIR - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPFIL','*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1') - END DO - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULL*','*.*;1') - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - NEMPTY = 0 - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - CALL OPEN_BULLFIL - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEYGE=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0.AND.ICOUNT.EQ.F_START) THEN - READ(2,KEYGT=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.EQ.0) ICOUNT = NEWS_MSG_NUM - END IF - END IF - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND. - & MSG_NUM.GT.F_START) THEN - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER,IER2) - F_START = MSG_NUM - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IF - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THEN - ICOUNT = MSG_NUM - BULLETIN_NUM = ICOUNT - END IF - END IF - ELSE - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 - END IF - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IF (REMOTE_SET.NE.4) CALL STR$UPCASE(FROM,FROM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IF - - IF (IER.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1 - ELSE IF (THREAD) THEN - DUMMY = INCLUDE_MSG(FROM,DESCRIP) - END IF - END IF - END IF - - RETURN - - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM) - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z) - - INTEGER TEMP - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I) - END DO - - RETURN - END - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/1/ - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.2.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.2.AND.MSG_NUM.NE.0) THEN - IF (MSG_NUM.GT.NEWS_F_END) THEN - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36 - UNLOCK 2 - END IF - END IF - END IF - ELSE - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - IER = 0 - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10 - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY),%DESCR(EX_BTIM)) - IF (POSTTIME) THEN - CALL GET_MSGKEY(%REF(NEWS_POST_KEY),%DESCR(MSG_BTIM)) - CALL CONVERT_FROM_GMT(MSG_BTIM) ! Assume stored is GMT - END IF - DESCRIP = NEWS_DESCRIP - FROM = NEWS_FROM - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IF - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11) - EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME(:11) - TIME = DATETIME(13:23) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*52 BULLDIR_HEADER1 - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER1 - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - ELSE - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IF (BULLETIN_NUM.NE.NEWS_F_END+1) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END DO - END IF - ELSE - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IF - IF (REMOTE_SET.EQ.4.AND. - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN - CALL SPECIAL_NEWSDIR_ENTRY(IER) - ELSE IF (IER.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEN - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*140 TEMP - - DIMENSION BTIM(2) - - READ (2,KEYID=3,KEY=NEWS_POST_KEY,IOSTAT=IER) TEMP - DO WHILE (IER.EQ.0.AND.NEWS_POST_KEY.EQ.TEMP(57:64)) - IF (NEWS_MSGID.EQ.TEMP(21:56)) THEN - IER = 2 - RETURN - END IF - READ (2,IOSTAT=IER) TEMP - END DO - -10 IER1 = 0 - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=0,KEYGT=NEWS_F_END, - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - DO WHILE (IER1.EQ.0) - CALL LIB$MOVC3(4,%REF(INPUT),FNUM) - CALL GET_MSGKEY(%REF(INPUT(13:)),%DESCR(BTIM)) - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IF - F_COUNT = F_COUNT + 1 - CALL LIB$MOVC3(4,%REF(INPUT),NEWS_F_END) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - END DO - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IF - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSE - F_COUNT = F_COUNT + 1 - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,MSG_BTIM) - ELSE - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - END IF - - IF (LOCAL_POST) THEN - CALL SYS_BINTIM(DATE//' '//TIME - & (:TRIM(TIME)-2)//'00',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP - NEWS_FROM = FROM - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH - NEWS_MSG_NUM = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,NEWS_MSG_BTIM_KEY) - CALL GET_MSGKEY(EX_BTIM,NEWS_EX_BTIM_KEY) - ELSE - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - - RETURN - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KEYID/ NEWS_KEYID - - COMMON /KEEPLOCK/ KEEPLOCK - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 2 - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - CALL READDIR_KEYGE(NDEL) - KEEPLOCK = .FALSE. - NEWS_KEYID = 1 - - RETURN - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII)) - IF (ACLSTR(START_ID:START_ID).NE.','.AND. - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DO - IF (ASCII) THEN - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl output - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C -C SUBROUTINE COPY_ACL1 -C -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - ! Read input file acl - - IF (.NOT.IER) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./ - - IF (CHECKED) RETURN - - CHECKED = .TRUE. - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C) - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORY - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - END IF - - CALL CHECK_DIR(FOLDER_DIRECTORY,.FALSE.) - CALL CHECK_DIR(NEWS_DIRECTORY,.FALSE.) - - CALL ADD_DIRECTORIES - - RETURN - END - - - - SUBROUTINE ADD_DIRECTORIES - - INCLUDE 'BULLFILES.INC' - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE) - - RETURN - END - - - - LOGICAL FUNCTION CHECK_DIR(DIRECTORY,LIBRARY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - CHECK_DIR = PRESENT(BULLUSER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLFOLDER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLINF_FILE,DIRECTORY,TEST) - - IF (CHECK_DIR) THEN - IF (SYS_TRNLNM(DIRECTORY,TEST)) DIRECTORY = TEST - RETURN - END IF - - TEST = ' ' - - IF (INDEX(DIRECTORY,']').EQ.0) THEN - CALL SYS_TRNLNM(DIRECTORY,TEST1) - ELSE - TEST1 = DIRECTORY - END IF - - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - - IF (.NOT.LIBRARY.AND.TEST.EQ.' ') THEN - IER = SYS_TRNLNM_SYSTEM(DIRECTORY,TEST) - IF (.NOT.IER.AND.TEST1.EQ.DIRECTORY) RETURN - END IF - - IF (TEST.NE.TEST1) THEN - IF (LIBRARY) THEN - WRITE (6,'('' ERROR: Not a valid library. '')') - RETURN - END IF - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER) - CLOSE(UNIT=3,STATUS='DELETE') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)') - & TEST1(:TRIM(TEST1)) - CALL EXIT - END IF - DIRECTORY = TEST1 - ELSE - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - CHECK_DIR = .TRUE. - END IF - - RETURN - END - - - - - LOGICAL FUNCTION PRESENT(FILE,DIR,TEST) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILE,DIR,TEST - - FILE = FILE(INDEX(FILE,':')+1:) - FILE = FILE(INDEX(FILE,']')+1:) - IF (INDEX(DIR,':').EQ.0.AND.INDEX(DIR,'[').EQ.0.AND. - & INDEX(DIR,'<').EQ.0) DIR = DIR(:TRIM(DIR))//':' - C = 0 - PRESENT = LIB$FIND_FILE(DIR(:TRIM(DIR))//FILE,TEST,C) - - RETURN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:) - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:) - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':' - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURN - END - - - - SUBROUTINE SET_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CALL CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P) - - IF (CHECK_DIR(BULL_PARAMETER,.TRUE.)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - CALL UPDATE_USERINFO - CALL OPEN_USERINFO - INCMD = 'SHOW' - CALL UPDATE_READ(0) - END IF - - RETURN - END - - - - SUBROUTINE SHOW_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (CLI$PRESENT('ALL')) THEN - IER = 1 - N = 1 - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',BULL_PARAMETER) - IF (IER) THEN - IF (N.EQ.1) THEN - WRITE (6,'('' The following are valid libraries:'')') - N = 0 - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER - END IF - END DO - IF (N.EQ.1) WRITE (6,'('' No libraries are present.'')') - ELSE - WRITE (6,'('' Present library is: '',A)') - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - END IF - - RETURN - END - - - - SUBROUTINE SET_BULLNEWSDIR_FILE(FN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - BULLNEWSDIR_FILE = ' ' - - ENCODE(6,'(I6)',BULLNEWSDIR_FILE) FN - BULLNEWSDIR_FILE = BULLNEWSDIR_FILE(FIRST_ALPHA(BULLNEWSDIR_FILE):) - L = TRIM(BULLNEWSDIR_FILE) - - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.'// - & BULLNEWSDIR_FILE(:L-3)//']'// - & BULLNEWSDIR_FILE(L-2:TRIM(BULLNEWSDIR_FILE))//'.' - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bulletin7.for b/decus/vmslt02a/bulletin/bulletin7.for deleted file mode 100644 index bb0fcc1..0000000 --- a/decus/vmslt02a/bulletin/bulletin7.for +++ /dev/null @@ -1,2374 +0,0 @@ -C -C BULLETIN7.FOR, Version 3/13/00 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000.OR.TRIM(USERNAME).EQ.0) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - CHARACTER FOLDER_NAME_SAVE*80 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER_NAME_SAVE.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - FOLDER_NAME_SAVE = FOLDER_NAME - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCALPOST/ LOCAL_POST - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - IF (.NOT.LOCAL_POST) THEN - DATE = NEWEST_DATE - TIME = NEWEST_TIME - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIR - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /OUTPUT/ REASSIGNED - LOGICAL REASSIGNED - DATA REASSIGNED /.FALSE./ - - CALL DISABLE_PRIVS ! Disable SYSPRV - - IF (.NOT.REASSIGNED) THEN - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - END IF - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - IF (INDEX(INPUT,']').GT.0) THEN - SYS_TRNLNM = .FALSE. - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX)) - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1 - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IF - - RETURN - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - IER1 = 0 - ELSE - IF (IER.GT.0) THEN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0 - CALL SET_FOLDER_FILE(0) - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER BUFFER*128 - - CALL OPEN_BULLDIR - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR;-1') - END DO - - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPFIL;-1') - END DO - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULL*','*.*;1') - NEMPTY = 0 - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - CALL CLOSE_BULLDIR - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = -1 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0) - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULL*','*.*;1') - - CALL OPEN_BULLDIR - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.-1) THEN - NEMPTY = 0 - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - - CALL CLOSE_BULLDIR - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*12 DATE_SAVE,EXDATE_SAVE - CHARACTER*12 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - END IF - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER PSCAN$_BEGIN = '00000000'X - PARAMETER PSCAN$_ACCOUNT = '00000001'X - PARAMETER PSCAN$_AUTHPRI = '00000002'X - PARAMETER PSCAN$_CURPRIV = '00000003'X - PARAMETER PSCAN$_GRP = '00000004'X - PARAMETER PSCAN$_HW_MODEL = '00000005'X - PARAMETER PSCAN$_HW_NAME = '00000006'X - PARAMETER PSCAN$_JOBPRCCNT = '00000007'X - PARAMETER PSCAN$_JOBTYPE = '00000008'X - PARAMETER PSCAN$_MASTER_PID = '00000009'X - PARAMETER PSCAN$_MEM = '0000000A'X - PARAMETER PSCAN$_MODE = '0000000B'X - PARAMETER PSCAN$_NODE_CSID = '0000000C'X - PARAMETER PSCAN$_NODENAME = '0000000D'X - PARAMETER PSCAN$_OWNER = '0000000E'X - PARAMETER PSCAN$_PRCCNT = '0000000F'X - PARAMETER PSCAN$_PRCNAM = '00000010'X - PARAMETER PSCAN$_PRI = '00000011'X - PARAMETER PSCAN$_PRIB = '00000012'X - PARAMETER PSCAN$_STATE = '00000013'X - PARAMETER PSCAN$_STS = '00000014'X - PARAMETER PSCAN$_TERMINAL = '00000015'X - PARAMETER PSCAN$_UIC = '00000016'X - PARAMETER PSCAN$_USERNAME = '00000017'X - PARAMETER PSCAN$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER PSCAN$_END = '00000019'X - PARAMETER PSCAN$k_type = '00000081'X - PARAMETER PSCAN$M_OR = '00000001'X - PARAMETER PSCAN$M_BIT_ALL = '00000002'X - PARAMETER PSCAN$M_BIT_ANY = '00000004'X - PARAMETER PSCAN$M_GEQ = '00000008'X - PARAMETER PSCAN$M_GTR = '00000010'X - PARAMETER PSCAN$M_LEQ = '00000020'X - PARAMETER PSCAN$M_LSS = '00000040'X - PARAMETER PSCAN$M_PREFIX_MATCH = '00000080'X - PARAMETER PSCAN$M_WILDCARD = '00000100'X - PARAMETER PSCAN$M_CASE_BLIND = '00000200'X - PARAMETER PSCAN$M_EQL = '00000400'X - PARAMETER PSCAN$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER PSCAN$S_OR = 1 - PARAMETER PSCAN$V_OR = 0 - PARAMETER PSCAN$S_BIT_ALL = 1 - PARAMETER PSCAN$V_BIT_ALL = 1 - PARAMETER PSCAN$S_BIT_ANY = 1 - PARAMETER PSCAN$V_BIT_ANY = 2 - PARAMETER PSCAN$S_GEQ = 1 - PARAMETER PSCAN$V_GEQ = 3 - PARAMETER PSCAN$S_GTR = 1 - PARAMETER PSCAN$V_GTR = 4 - PARAMETER PSCAN$S_LEQ = 1 - PARAMETER PSCAN$V_LEQ = 5 - PARAMETER PSCAN$S_LSS = 1 - PARAMETER PSCAN$V_LSS = 6 - PARAMETER PSCAN$S_PREFIX_MATCH = 1 - PARAMETER PSCAN$V_PREFIX_MATCH = 7 - PARAMETER PSCAN$S_WILDCARD = 1 - PARAMETER PSCAN$V_WILDCARD = 8 - PARAMETER PSCAN$S_CASE_BLIND = 1 - PARAMETER PSCAN$V_CASE_BLIND = 9 - PARAMETER PSCAN$S_EQL = 1 - PARAMETER PSCAN$V_EQL = 10 - PARAMETER PSCAN$S_NEQ = 1 - PARAMETER PSCAN$V_NEQ = 11 - BYTE %FILL (2) - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -C -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -C -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE)) -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1 -C UJPIMODE = -1 -C TERMINAL(1:1) = CHAR(0) -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./ - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - CHANGED = .FALSE. - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time warp - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - LAST(1,I) = TODAY_BTIM(1) - LAST(2,I) = TODAY_BTIM(2) - CHANGED = .TRUE. - END IF - END DO - IF (CHANGED) REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - DO I=1,FOLDER_MAX - DO J=1,2 - LAST(J,I) = LAST_READ_BTIM(J,I) - END DO - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.EQ.0) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - WRITE (9,IOSTAT=IER) USERNAME,INF_REC - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIM - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0 - LAST_SYS_BTIM(2,I) = 0 - END DO - END IF - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -C -C SUBROUTINE READ_NEWS_USERINFO -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) NAME - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2))) - END IF - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READ - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - EQUIVALENCE (OLD_LAST_NEWS_READ2(1,1),OLD_LAST_NEWS_READ(1,1)) - INTEGER*2 OLD_LAST_NEWS_READ2(4,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF = (LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF1 = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF1 = (LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF2 = .FALSE. - GO TO 10 - - ENTRY UPDATE_USERINFO_NEWS_ALWAYS - DIFF2 = .TRUE. - -10 IF (.NOT.DIFF2) THEN - DO I=1,FOLDER_MAX - DIFF2 = (LAST_NEWS_READ(1,I).NE. - & OLD_LAST_NEWS_READ(1,I)).OR. - & (LAST_NEWS_READ(2,I).NE. - & OLD_LAST_NEWS_READ(2,I)).OR.DIFF2 - END DO - END IF - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHARED - - IF (DIFF) THEN - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & LAST(J,I) = LAST_READ_BTIM(J,I) - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - END IF - - IF (DIFF1) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & OLD_LAST_SYS_BTIM(J,I) = LAST_SYS_BTIM(J,I) - LAST_SYS_BTIM(J,I) = OLD_LAST_SYS_BTIM(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF - - IF (DIFF2) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=2,1,-1 - IF (I.EQ.NEWS_FIND_SUBSCRIBE().OR. - & OLD_LAST_NEWS_READ2(1,I).NE.LAST_NEWS_READ2(1,I)) - & OLD_LAST_NEWS_READ(J,I) = LAST_NEWS_READ(J,I) - LAST_NEWS_READ(J,I) = OLD_LAST_NEWS_READ(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - CHARACTER*24 TIME1 - - TIME1 = TIME(FIRST_ALPHA(TIME):) - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:) - END DO - - IF (TIME1.EQ.'-') TIME1 = '-- :' - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder info - ELSE IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND. - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A)') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - IF (INCMD(:4).EQ.'SHOW') THEN - SAVE_FOLDER_Q1 = 0 - RETURN - END IF - IF (NEW_MESS.OR.NEWS_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1 - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0 - END IF - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE(IER) - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER) - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bulletin8.for b/decus/vmslt02a/bulletin/bulletin8.for deleted file mode 100644 index a195588..0000000 --- a/decus/vmslt02a/bulletin/bulletin8.for +++ /dev/null @@ -1,2165 +0,0 @@ -C -C BULLETIN8.FOR, Version 10/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND. - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0, - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - IF (NUM.GT.0) THEN - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - END IF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE. - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THEN - ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX)) - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV) - END IF - END IF - END IF - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND. - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24 - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM) - P = 4 + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (BTEST(FOLDER_FLAG,14)) FROM = 'ANONYMOUS' - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - IF (NEWS_FEED()) THEN - BULL_POINT = NBULL - INCMD = 'COPY/ORIGINAL/LOCAL '// - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1 - & :INDEX(FOLDER_DESCRIP,'>')-1) - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - END IF - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT) - P = 4 + P - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER) - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - CALL CLOSE_BULLFOLDER - END IF - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = -1 - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV) - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - INIT = INIT + 2 - IF (INIT.GT.60) THEN - WRITE (6,'('' Bulletin aborting due to record lock'', - & '' problem. Alert system administrator.'')') - CALL EXIT - END IF - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /WINDOW/ WINDOW - - CHARACTER*80 MESSAGE - - WINDOW = 1 - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - - COMMON /TEMP_INPUT/ NODE_TEMP - CHARACTER NODE_TEMP*256 - - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,PASSWORD*32,TEMP_USER*12 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - RETURN - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C -C SUBROUTINE SET_FOLDER_FILE -C -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE, -C if = 1, set FOLDER1_FILE -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NUM.EQ.0) THEN - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE) - END IF - - RETURN - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C -C SUBROUTINE SET_FILE -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILE - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - ELSE - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)// - & '.]' - END IF - - RETURN - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12 - - DATA UPDATE/.FALSE./, JUST_NAME/.FALSE./ - - UPDATE = .TRUE. - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_UPDATE - - UPDATE = .NOT.UPDATE - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_NAME - - JUST_NAME = .NOT.JUST_NAME - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATE - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):) - - M = INDEX(FILDATE,'-') - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3) - - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN - FOLDER_FILE = FOLDER1_FILE - IF (JUST_NAME) THEN - JUST_NAME = .FALSE. - RETURN - END IF - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THEN - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHARED - END IF - END IF - - JUST_NAME = .FALSE. - - IF (UPDATE) THEN - READ (1'1) NBLOCK - REWRITE (1) NBLOCK + LENGTH - UPDATE = .FALSE. - END IF - - RETURN - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THEN - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE - MINGT0 = MIN(I,J) - END IF - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bulletin9.for b/decus/vmslt02a/bulletin/bulletin9.for deleted file mode 100644 index a436378..0000000 --- a/decus/vmslt02a/bulletin/bulletin9.for +++ /dev/null @@ -1,2480 +0,0 @@ -C -C BULLETIN9.FOR, Version 3/12/00 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - -C IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN -C WRITE (6,'(A)') ' A new BULLETIN executable has been '// -C & 'installed since your last use.' -C WRITE (6,'(A)') -C & ' Type HELP NEW_FEATURES for help on any new features.' -C END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - EXTERNAL BULLETIN_SUBCOMMANDS - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IF - END IF - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE - WRITE (6,1000) - END IF - IF (.NOT.SUBSCRIBE) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - DO I = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IF - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1 - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THEN - NUM_FOLDER = 0 - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1), - & 'HIT any key for next page....') - END IF - END DO - IF (NUM_FOLDERS.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE IF (INEW) THEN - NEW = INEW - IF (REMOTE_SET.GE.3) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSE - CALL FIND_NEWEST_BULL - END IF - END IF - - IF (INCMD(:4).NE.'INDE') THEN - IER = CLI$DCL_PARSE('INDEX',BULLETIN_SUBCOMMANDS) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1010 FORMAT (' The following folders with new messages are present'/) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - FOLDER_PRESENT = CLI$PRESENT('FOLDER') - - IF (FOLDER_PRESENT) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z') - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME) - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURN - END IF - END IF - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid date specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURN - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN - END IF - ELSE IF (SINCE) THEN - IF (BULL_POINT.EQ.0) THEN - WRITE (6,'('' ERROR: No current message.'')') - RETURN - ELSE IF (NEWS) THEN - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THEN - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSE - STARTMSG = 1 - END IF - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - ELSE - IF (NEWS) THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1 - END DO - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND. - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0 - NEWSMSG = 1 - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THEN - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0 - ELSE - FOUND = .FALSE. - END IF - IF (FOUND.AND.NEWS) THEN - WRITE (6,'(1X,A,'' latest message read '', - & I,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'', - & '' to specified folder.'')') - END IF - END IF - IF (.NOT.ALL) THEN - IF (IER.NE.0) THEN - WRITE (6,'('' User info does not exist.'')') - END IF - IER = 2 - END IF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - CALL CLOSE_BULLUSER - ELSE - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - CALL CLOSE_BULLUSER - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - DATA SCRTYPE/-1/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /MAIL_INFO/ USE_INFROM - - IF (TRIM(USERNAME).EQ.0) USE_INFROM = 1 ! PMDF OR SIMILAR - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESS - - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - IER1 = 1 - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER2) THEN - CALL ADD_DIRECTORIES - ELSE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IF - END IF - END DO - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - LDESCR = 0 - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - IF (NEWS_FEED()) THEN - CALL STRIP_HEADER(' ',-1,IER1) - END IF - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - MAIL = BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0 - IF (MAIL) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.MAIL' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0 - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - ELSE IF (NEWS_FEED().OR.LEN_FROM.EQ.0 - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - SCRTYPE = 0 - SCRNAME = 'SYS$LOGIN:BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - IF (IER1.NE.0) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW') - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /STORED/ STORED - - CHARACTER*256 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.NEWS_FEED().AND. - & .NOT.BTEST(FOLDER_FLAG,11).AND..NOT.STORED) CLOSE (UNIT=3) - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - CHARACTER*24 TODAY - - COMMON /STORED/ STORED - DATA STORED /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THEN - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER - RETURN - ELSE IF (BUFFER(:5).EQ.'From:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE. - OLD_BUFFER_FROM = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Reply-To:') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - END IF - STORED = .TRUE. - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STORED - STORED = .FALSE. - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3) - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - IF (LEN_BUFFER.GT.0) THEN -C IF (.NOT.TEXT) THEN -C IF (.NOT.NEWS_FEED()) THEN - TEXT = .TRUE. -C ELSE -C CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) -C TEXT = .NOT.IER -C END IF -C END IF - IF (TEXT) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - ELSE - IF (TEXT) WRITE (3,'(A)') ' ' - END IF - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF (.NOT.STORED.AND. - & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') ' ' - CALL STRIP_HEADER(' ',-1,IER) - END IF - CALL STORE_BULL(1,' ',NBLOCK) - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2 - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-') - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO - INEXDATE = .TRUE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) -C IF (NEWS_FEED().AND..NOT.TEXT) THEN -C CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) -C TEXT = .NOT.IER -C ELSE - TEXT = .TRUE. -C END IF - IF (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11)) THEN -C & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAY - - CHARACTER USER_SAVE*12,PROC_SAVE*12 - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1 - FIRST_BREAK = .FALSE. - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - SCRTYPE = -1 - END IF - RETURN - END IF - - EXTIME = '00:00:00.00' - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2100' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - IF (SCRTYPE.EQ.0.AND.NEWS_FEED()) THEN - FOLDER1_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,'>')-1) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL NEWS_POST('ignore',.TRUE.,IER,INDESCRIP) - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3) - END IF - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.EQ.0) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL GETUSER(PROC_SAVE) - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME) - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARD - END IF - IF (.NOT.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(SCRNAME,INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - ELSE - CALL RESPOND_MAIL(SCRNAME,INPUT, - & INDESCRIP(:LEN_DESCRP),STATUS) - END IF - CALL LIB$DELETE_FILE(SCRNAME(:TRIM(SCRNAME))//';*') - CALL SETUSER(PROC_SAVE) - USERNAME = USER_SAVE - ELSE - CLOSE (UNIT=3) - END IF - ELSE IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - END IF - - CALL STRIP_HEADER(' ',-1,IER) - - SCRTYPE = -1 - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - -C IF (.NOT.NEWS_FEED()) THEN - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) -C END IF - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(FROM,INFROM,LEN_INFROM) - - RETURN - END - - - SUBROUTINE GET_FROM(FROM,INFROM1,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INFROM1,FROM - - CHARACTER*256 INFROM - - INFROM = INFROM1 - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - I = INDEX(INFROM,'<') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<')+1:) ! personal-name - END IF - -C I = INDEX(INFROM,'(') -C IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form -C INFROM = INFROM(INDEX(INFROM,'(')+1:) ! personal-name (net-name) -C END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR.INFROM(I:I).LE.' '.OR. - & INFROM(I:I).GE.CHAR(127).OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) - I = I + 1 - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1 - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND.INFROM(I:I).GT.' '.AND. - & INFROM(I:I).LT.CHAR(127).AND. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.126) - & INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN -C IF (LEN_DESCRP.GT.LEN(DESCRIP).AND..NOT.NEWS_FEED()) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - CALL INIT_QUEUE(HEADER_Q1,INPUT) - IF (BLEN.EQ.-1) THEN - CALL INIT_QUEUE(HEADER_Q1,INPUT) - HEADER_Q = HEADER_Q1 - NHEAD = 0 - END IF - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - END IF - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) THEN ! of previous header line - IF (LAST_NEWSGROUPS) THEN - NEWSGROUPS = NEWSGROUPS(:TRIM(NEWSGROUPS))//BUFFER(2:) - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - END IF - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - LAST_NEWSGROUPS = .FALSE. - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.' - END IF - ELSE IF (BUFFER(:11).EQ.'Newsgroups:') THEN - NEWSGROUPS = BUFFER(13:) - LAST_NEWSGROUPS = .TRUE. - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - - RETURN - END - - - - - SUBROUTINE SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_NEWS_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified news group -C Note: If NOTIFY READNEW and BRIEF = 0, it is either news -C group removal or SET SUBSCRIBE command. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - ALL = .FALSE. - DEFAULT = 1 - NODEFAULT = 0 - SUB = ABS(BRIEF)+ABS(NOTIFY)+ABS(READNEW).EQ.0 - - IF (NOTIFY.EQ.1.AND.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: /NOTIFY is invalid with non-stored'', - & '' news group.'')') - RETURN - END IF - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - IF (CLI$PRESENT('NOPERMANENT').OR.CLI$PRESENT('PERMANENT').OR. - & (SUB.AND.(NODEFAULT.OR.CLI$PRESENT('NOPERMANENT')))) THEN - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (SUB) DEFAULT = 1 - ELSE IF (CLI$PRESENT('NOPERMANENT').OR.NODEFAULT) THEN - IF (NOTIFY.GE.0) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - IF (SUB) - & CALL SET_NEWS_FLAG(IER,-1,-1,-1) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*PERM ',INF_REC - END IF - END IF - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - IF (NODEFAULT.AND.SUB) THEN - NOTIFY = -1 - READNEW = -1 - BRIEF = -1 - END IF - IF (DEFAULT.OR.NODEFAULT) THEN - IF (NODEFAULT.AND..NOT.SUB) THEN - IF (NOTIFY.NE.-1) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - ELSE - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*DEFAULT ',INF_REC - END IF - END IF - IF ((ALL.OR.(SUB.AND.INCMD(:3).NE.'SET')).AND.IER.EQ.0) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY=TEMP_USER,IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - - RETURN - END - - - - - SUBROUTINE READ_INF_REC - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - RETURN - - ENTRY SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & INF_REC2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1.AND.TEMP_USER(:1).EQ.'*') THEN - WRITE (6,'('' ERROR: You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - IER = 0 - RETURN - END IF - - IF (INF_REC2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IF (NOTIFY+READNEW+BRIEF.EQ.-3) THEN - DO J=I,FOLDER_MAX-2 - CALL COPY2(INF_REC(1,J),INF_REC(1,J+1)) - END DO - END IF - IER = 1 - RETURN - END IF - - IF (NOTIFY+READNEW+BRIEF.EQ.-3) RETURN - - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(INF_REC2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(INF_REC(1,J),INF_REC(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - INF_REC2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - INF_REC2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - INF_REC(2,J) = F_START - 1 - ELSE - INF_REC2(2,J) = 0 - INF_REC(2,J) = F_NBULL - END IF - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IER = 1 - RETURN - END IF - END DO - - RETURN - END diff --git a/decus/vmslt02a/bulletin/bullfiles.inc b/decus/vmslt02a/bulletin/bullfiles.inc deleted file mode 100644 index 0df9866..0000000 --- a/decus/vmslt02a/bulletin/bullfiles.inc +++ /dev/null @@ -1,39 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vmslt02a/bulletin/bullfolder.inc b/decus/vmslt02a/bulletin/bullfolder.inc deleted file mode 100644 index b3d94c8..0000000 --- a/decus/vmslt02a/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vmslt02a/bulletin/bullmain.cld b/decus/vmslt02a/bulletin/bullmain.cld deleted file mode 100644 index bb3a4b5..0000000 --- a/decus/vmslt02a/bulletin/bullmain.cld +++ /dev/null @@ -1,34 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vmslt02a/bulletin/bullnews.inc b/decus/vmslt02a/bulletin/bullnews.inc deleted file mode 100644 index fcbc81f..0000000 --- a/decus/vmslt02a/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vmslt02a/bulletin/bullstart.com b/decus/vmslt02a/bulletin/bullstart.com deleted file mode 100644 index ed1779c..0000000 --- a/decus/vmslt02a/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vmslt02a/bulletin/bulluser.inc b/decus/vmslt02a/bulletin/bulluser.inc deleted file mode 100644 index 5760e92..0000000 --- a/decus/vmslt02a/bulletin/bulluser.inc +++ /dev/null @@ -1,53 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vmslt02a/bulletin/changes.txt b/decus/vmslt02a/bulletin/changes.txt deleted file mode 100644 index e231fb3..0000000 --- a/decus/vmslt02a/bulletin/changes.txt +++ /dev/null @@ -1,692 +0,0 @@ -V2.5 -If a message gets rejected from a news server that was posted via a folder -that has a news group associated with it, the error message gets sent to the -local postmaster, and the message continues to attempt to be posted until it -is either delivered, or the postmaster kills it. 10/20/98 - -Fixed bug which caused the RESET command to wipe out SET NOTIFY on a new -group. 10/6/98 - -Changed behavior of threads and excludes. Only excludes based on FROM will -take precedence over THREADs. 10/1/98 - -Fixed 2 very old bugs. One which would cause one of the databases to be -stuck opened preventing anyone else from using BULLETIN, the other which -caused READNEW behavior when logging in for folders which did not have that -feature enabled. 9/20/98 - -V2.4 -Adding the ability to change one's personal name used in postings to news -groups and mail message by defining the logical name BULL_PERSONAL_NAME. -7/22/98 - -Added the SET GATEWAY command to change the how the subject lines looks in -messages which are sent to an email address associated with a folder. 2/25/98 - -Many bugs were fixed, mainly with respect to the news-email-folder gateway. - -V2.3 - -Added the ability to create a folder that can post and read to a news group, -and can send and read messages via email. See NEWS_TO_FOLDER.TXT for more -info. 4/18/97 - -Added the ability for BULLETIN to see news groups from secondary news groups -(see NEWS.TXT). 4/18/97 - -V 2.25 - -Changes to make it easier to click on news group name to select them: You can -enter a news group name at the prompt and it will select it (without typing -SELECT). News groups displayed without period at end when BULLETIN lists the -ones that have new messages. NEWS/SUBS has space between * and news group -when denoting which ones have new messages. 3/21/96 - -V 2.24 - -When replying to a message in a news group that has been crossposted, give the -user the option of just posting the reply to the news group in which the -message is being read rather than all the news groups in the crosspost. -11/20/95 - -Messages added to folders and stored news groups are now marked as being read -so that the person does not see them when doing a READ/NEW. 11/20/95 - -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vmslt02a/bulletin/cmds.mai b/decus/vmslt02a/bulletin/cmds.mai deleted file mode 100644 index 804e43e..0000000 --- a/decus/vmslt02a/bulletin/cmds.mai +++ /dev/null @@ -1,22 +0,0 @@ -The address for getting BULLETIN is BULLETIN@PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file - (only one file per command). - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - -BULLETIN is also available via ANONYMOUS FTP from PFC.MIT.EDU, but the account -is set at low priority, so I suggest using it during non-prime hours. - - Mark diff --git a/decus/vmslt02a/bulletin/copyright.txt b/decus/vmslt02a/bulletin/copyright.txt deleted file mode 100644 index b6edd1b..0000000 --- a/decus/vmslt02a/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vmslt02a/bulletin/create.com b/decus/vmslt02a/bulletin/create.com deleted file mode 100644 index 9427f4f..0000000 --- a/decus/vmslt02a/bulletin/create.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vmslt02a/bulletin/handout.txt b/decus/vmslt02a/bulletin/handout.txt deleted file mode 100644 index 5a1acd2..0000000 --- a/decus/vmslt02a/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vmslt02a/bulletin/install.com b/decus/vmslt02a/bulletin/install.com deleted file mode 100644 index 34427ba..0000000 --- a/decus/vmslt02a/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vmslt02a/bulletin/instruct.com b/decus/vmslt02a/bulletin/instruct.com deleted file mode 100644 index 273d3e9..0000000 --- a/decus/vmslt02a/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vmslt02a/bulletin/instruct.txt b/decus/vmslt02a/bulletin/instruct.txt deleted file mode 100644 index 6699642..0000000 --- a/decus/vmslt02a/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vmslt02a/bulletin/login.com b/decus/vmslt02a/bulletin/login.com deleted file mode 100644 index e670783..0000000 --- a/decus/vmslt02a/bulletin/login.com +++ /dev/null @@ -1,31 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! If you want to have more than one BULLETIN database, replace BULL_DIR -$! with the actual directory to allow redefining BULL_DIR. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vmslt02a/bulletin/makefile b/decus/vmslt02a/bulletin/makefile deleted file mode 100644 index c5bbf6f..0000000 --- a/decus/vmslt02a/bulletin/makefile +++ /dev/null @@ -1,82 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.5" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vmslt02a/bulletin/master.com b/decus/vmslt02a/bulletin/master.com deleted file mode 100644 index 112d981..0000000 --- a/decus/vmslt02a/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vmslt02a/bulletin/mx.mai b/decus/vmslt02a/bulletin/mx.mai deleted file mode 100644 index 2631763..0000000 --- a/decus/vmslt02a/bulletin/mx.mai +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_LIBRARY") .eqs. "" -$ then say "BULL_LIBRARY logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_library/LIB,SYS$SYSTEM:SYS.STB/SEL,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_LIBRARY to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P4 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P4 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P4 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p4 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p2' 'p3' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p2' 'p3' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vmslt02a/bulletin/news.txt b/decus/vmslt02a/bulletin/news.txt deleted file mode 100644 index 86274c1..0000000 --- a/decus/vmslt02a/bulletin/news.txt +++ /dev/null @@ -1,133 +0,0 @@ -BULLETIN has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was -to run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added -the ability in BULLETIN (actually BULLCP) so that it acts as as a gateway -between decnet and tcp for NEWS. This method does not require spawning any -processes, since the detached process BULLCP is always present, so the access -is very fast. Also, since BULLETIN uses a shared database to store info on -the NEWS groups and periodically updates it, there is no need for that to be -done when a user accesses the NEWS groups. Several other NEWS readers do this -when you run them, which is why they take a long time to start up. It is also -possible to feed NEWS groups into a "real" BULLETIN folder, so that the -messages are saved on disk (see the file NEWS_TO_FOLDER.TXT). - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER to -be a system logical name pointing to either your internet or decnet NEWS node. -If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -It is also possible for BULLETIN to access news groups that are located on -other news servers than the one specified by BULL_NEWS_SERVER. This is done -by creating the file BULL_DIR:BULL_ALT_NEWS.LIS and adding a line which -containsthe name of the news group and the news server where it's located. -The format is news-group-name:news-server-name. - -In order to post messages, BULLETIN needs to know the internet nodename of the -local host. This is done automatically for nodes running MULTINET. For other -nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This can -be hardcoded into the source by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, -it will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will -cause subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -If you have any problems or questions, please let me know. - MRL diff --git a/decus/vmslt02a/bulletin/news_to_folder.txt b/decus/vmslt02a/bulletin/news_to_folder.txt deleted file mode 100644 index c100f09..0000000 --- a/decus/vmslt02a/bulletin/news_to_folder.txt +++ /dev/null @@ -1,48 +0,0 @@ -It is possible to automatically have messages from a news group be fed into a -real folder, and visa versa. This allows BULLETIN messages to be shared with -a news group, thus giving access to such messages to people who do not have -access to BULLETIN. This can also be combined with email access for people -who have neither BULLETIN nor news group access. - -To associate a folder with a news group, place the name of the news group into -the folder description surrounded by <>, i.e. . It must be in -lower case. (Other text is allowed in the description, i.e. "THIS IS A TEST -FOLDER ".) When messages are added the folder, they are also sent -to the news group, and new messages from the group are posted to the folder -(via the BULLCP process which wakes up on a periodic basis). Whenever you -modify the folder description and specify the news group name, you will be -prompted as to whether you want to initializee the news group counter to -either load all the messages present in the news group, or to load only news -messages that appear there. - -Messages posted to the news group from such a folder have a special line in -their header indicating they were sent from that node using bulletin. When -bulletin feeds new postings back to the folder, it will see that header line -and also see that it was posted from that node, and thus will avoid adding it -to the folder (and thus creating a duplicate message). Note that messages are -added to the news group via the BULLCP process, so they will not appear -immediately after being added to the folder. - -If you are modifying an existing folder to make it associated with a news -group, and if you want to copy any existing messages in the folder to the news -group, you can do that by using the command COPY/ORIGINAL/LOCAL and specifying -the news group as the destination. /ORIGINAL will cause the original owner -names and dates to be preserved (note, however, that dates older than 14 days -in the past are not usually accepted by the news server, so dates older than -that will be changed to the present date). /LOCAL will create the special -header line in the messages to prevent BULLCP from adding those messages back -to the folder from the news group. /ALL can be specified to copy all the -messages in the folder. - -If you create a remote folder that points to a folder that has a news group -associated with it, you do not have to specify the news group in the -description of the remote node. However, on the node on which the folder -actually exists, the news group has be a stored news group, i.e. you must -issue the command SET NEWS/STORED for that news group. - -When a news group is specified for a folder, it is still possible to associate -an email address for the messages to be sent to in the folder description. -You do this by using [] to enclose the address rather than the usual <>, i.e. -[mrl@pfc.mit.edu] See help in BULLETIN on the command CREATE/DESCRIPTION for -more info about associated email addresses. Note that these features allow -you to create a full gateway between a news group and a mailing list. diff --git a/decus/vmslt02a/bulletin/nonsystem.txt b/decus/vmslt02a/bulletin/nonsystem.txt deleted file mode 100644 index f1f7d86..0000000 --- a/decus/vmslt02a/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vmslt02a/bulletin/optimize_rms.com b/decus/vmslt02a/bulletin/optimize_rms.com deleted file mode 100644 index 576fa3e..0000000 --- a/decus/vmslt02a/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vmslt02a/bulletin/pmdf.com b/decus/vmslt02a/bulletin/pmdf.com deleted file mode 100644 index 6a700ce..0000000 --- a/decus/vmslt02a/bulletin/pmdf.com +++ /dev/null @@ -1,4 +0,0 @@ -$link/exe=pmdf_exe:bulletin_master.exe - - pmdf_exe:bulletin_master.obj/sysexe,pmdf_exe:pmdfshr_link.opt/opt, - - pmdf_com:ident.opt/opt,pmdf_exe:rmspro, - - bull.olb/lib,sys$share:vaxcrtl/lib diff --git a/decus/vmslt02a/bulletin/pmdf.txt b/decus/vmslt02a/bulletin/pmdf.txt deleted file mode 100644 index e3a40bc..0000000 --- a/decus/vmslt02a/bulletin/pmdf.txt +++ /dev/null @@ -1,29 +0,0 @@ -To allow PMDF to be able to transfer mail to BULLETIN folders, edit the file -PMDF_TABLE:PMDF.CNF, and append the following 5 lines to the rewrite section -(make sure you do not include any lines with spaces in that section. Replace -the string "urdomain", with your domain (i.e., my domain is PSFC.MIT.EDU). - -! -! Rewrites for bulletin channel -! -BULLETIN $U%BULLETIN@BULLETIN-DAEMON -BULLETIN.urdomain $U%BULLETIN@BULLETIN-DAEMON - -Then, add the following 5 lines to the channel section (or just put it at the -end of that file). - -! -! The BULLETIN Channel rule -! -bull_local single master slave_debug master_debug logging defragment charset7 us-ascii charset8 iso-8859-1 -BULLETIN-DAEMON - -After you do this, you can now link and install the BULLETIN executable using -PMDF.COM Once you do that, if you want email messages to be automatically -transferred to a BULLETIN folder, you will need to add an alias to -PMDF_TABLE:PMDF.CNF For example, if you email sent to TEST to be placed in -the TEST folder, you would add the line: - -test: test@bulletin - -Note that folder names do not necessarily have to match account names. diff --git a/decus/vmslt02a/bulletin/restart.com b/decus/vmslt02a/bulletin/restart.com deleted file mode 100644 index 71f7023..0000000 --- a/decus/vmslt02a/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vmslt02a/bulletin/setuser.mar b/decus/vmslt02a/bulletin/setuser.mar deleted file mode 100644 index 489f36f..0000000 --- a/decus/vmslt02a/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vmslt02a/bulletin/update.fil b/decus/vmslt02a/bulletin/update.fil deleted file mode 100644 index 6f20f13..0000000 --- a/decus/vmslt02a/bulletin/update.fil +++ /dev/null @@ -1,11 +0,0 @@ -$ if p1 .nes. "" then FS 'P1' -$ COPY 'FM' [MRL.BULLETIN.SEND]/LOG -$ COPY 'FM' CMODA::IR:[BULLETIN]/LOG -$ TAB2SP 'FM' -$ RENAME 'FM' [MRL.NET] -$ PUR [MRL.BULLETIN.SEND]'FM' -$ PUR [MRL.NET]'FM' -$ IF FM .EQS. "CHMAIL.MAI" THEN P3 = "AAAREADME." -$ IF P2 .EQS. "" THEN COPY 'FM' [ANONYMOUS.BULLETIN]'P3' -$ IF P3 .EQS. "" THEN PUR [ANONYMOUS.BULLETIN]'FM' -$ IF P3 .NES. "" THEN PUR [ANONYMOUS.BULLETIN]'p3' diff --git a/decus/vmslt02a/bulletin/upgrade.com b/decus/vmslt02a/bulletin/upgrade.com deleted file mode 100644 index b91fa7c..0000000 --- a/decus/vmslt02a/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vmslt02a/bulletin/writemsg.txt b/decus/vmslt02a/bulletin/writemsg.txt deleted file mode 100644 index 2bfabfd..0000000 --- a/decus/vmslt02a/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vmslt97a/bulletin/aaareadme.1st b/decus/vmslt97a/bulletin/aaareadme.1st deleted file mode 100644 index fb97c8c..0000000 --- a/decus/vmslt97a/bulletin/aaareadme.1st +++ /dev/null @@ -1,201 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vmslt97a/bulletin/aaareadme.txt b/decus/vmslt97a/bulletin/aaareadme.txt deleted file mode 100644 index fb97c8c..0000000 --- a/decus/vmslt97a/bulletin/aaareadme.txt +++ /dev/null @@ -1,201 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vmslt97a/bulletin/allmacs.mar b/decus/vmslt97a/bulletin/allmacs.mar deleted file mode 100644 index b7498eb..0000000 --- a/decus/vmslt97a/bulletin/allmacs.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vmslt97a/bulletin/allmacs_axp.mar b/decus/vmslt97a/bulletin/allmacs_axp.mar deleted file mode 100644 index efb71ec..0000000 --- a/decus/vmslt97a/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vmslt97a/bulletin/bad.for b/decus/vmslt97a/bulletin/bad.for deleted file mode 100644 index c32e9b7..0000000 --- a/decus/vmslt97a/bulletin/bad.for +++ /dev/null @@ -1,22 +0,0 @@ - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=5,FILE='BULLNEWS.DAT',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - BULLNEWS_FILE = 'BULL_DIR:BULLNEWS.DAT' - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) WRITE (5,IOSTAT=IER) NEWS_FOLDER1_COM - END DO - - TYPE *,FOLDER1 - END diff --git a/decus/vmslt97a/bulletin/board_digest.com b/decus/vmslt97a/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vmslt97a/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vmslt97a/bulletin/board_special.com b/decus/vmslt97a/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vmslt97a/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vmslt97a/bulletin/bull_news.c b/decus/vmslt97a/bulletin/bull_news.c deleted file mode 100644 index 4f09cd3..0000000 --- a/decus/vmslt97a/bulletin/bull_news.c +++ /dev/null @@ -1,705 +0,0 @@ -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} diff --git a/decus/vmslt97a/bulletin/bull_newsdummy.for b/decus/vmslt97a/bulletin/bull_newsdummy.for deleted file mode 100644 index a17d3ec..0000000 --- a/decus/vmslt97a/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,99 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bullcom.cld b/decus/vmslt97a/bulletin/bullcom.cld deleted file mode 100644 index bb514da..0000000 --- a/decus/vmslt97a/bulletin/bullcom.cld +++ /dev/null @@ -1,763 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 11/3/95 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER COPY, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FORCE - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER OUTPUT,VALUE(REQUIRED,TYPE=$FILE) - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB THREAD - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE, NONNEGATABLE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER FORCE - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER THREADS - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD THREAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vmslt97a/bulletin/bullcoms1.hlp b/decus/vmslt97a/bulletin/bullcoms1.hlp deleted file mode 100644 index 73996de..0000000 --- a/decus/vmslt97a/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1260 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is -specified. A node which does not have BULLCP running cannot have a -message broadcasted to it, (even though it is able to create a remote -folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with -> at the beginning of each line. This can be -suppressed or the indentation character changed with /[NO]INDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message will -be deleted after the node on which the message was submitted from is -rebooted. If you wish the message to be deleted after a different node -reboots, you have the option of specifying that node name. The message -deletion is keyed by BULLETIN running on the node that reboots. It -writes into the database info that the node has rebooted, and when -BULLCP wakes up and sees this info, it will delete any shutdown messages -for that node. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current process -to another process in your job. - -The ATTACH command allows you to move quickly between processes that you -have created with the SPAWN command. For example, while you are editing -a file, you can SPAWN a subprocess to read a new message. Enter the -ATTACH command to get back to back to the editing session. If you want -to read another new message, you can use the ATTACH command to get back -to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers -so that either the message text, expiration date, or the header are to -be changed. If no qualifier is added, the default is that all these -parameters are to be changed. If the text of the message is to be -changed, a file can be specified which contains the text. If the editor -is used for changing the text, the old message text will be extracted. -This can be suppressed by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /OWNER - /OWNER=string - -Specifies a new owner name. Can only be changed if you own the folder -or have privileges. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. A -range of messages can be specified, i.e. /NUMBER=1-5. Only the -expiration date and message headers can be changed if a range is -specified. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be copied -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list via -the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to be mailed to the email address. This is common if you have -users that don't have access to BULLETIN. Note: When you specify an -email address, the folder automatically will have the ADD_ONLY flag set, -which causes both ADD and POST to both add a message and send mail the -message. Note that a message added to the folder via the BBOARD feature -will also be mailed to the specified email address. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. If you create a remote folder pointing to a folder -associated with an email address, you must specify the email address in -the description of the remote folder also. - -It is also possible to use the description to specify a news group from -which messages are fed into the folder. See the file FOLDER_TO_NEWS.TXT -for more info. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. The -identifier can not be any longer than 12 characters. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The specified node is checked to see if -a folder of the same name is located on that node. If so, the folder -will then be modified to point to that folder. For example if there was -a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be -shared between more than one node. This capability is only present if -the BULLCP process is running on the remote node via the BULL/STARTUP -command. If the remote folder name is different from the local folder -name, the remote folder name is specified using the /REMOTENAME -qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data -Base. If the RDB does not exist on your system, a privileged user will -have to create it. If a user is not in the RDB, this program will -automatically enter the user into it (unless this feature was disabled -during the compilation of this program). NOTE: See HELP SET ACCESS for -more info. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW -for more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -either /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The -BULLETIN utility must be installed properly on the other nodes. You can -specify a different username to use at the other nodes by either using -the USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. The -specified subject need not be the exact subject of the message. It can -be a substring of the subject. This is in case you have forgotten the -exact subject that was specified. Case is not critical either. You -will be notified if the deletion was successful. See also /NEGATED. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting -messages on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message. -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /CONTINUE -Used with /GROUP. Allows you to continue a search after you have broken -the search by entering a command, i.e. READ, SEARCH, etc. Note: If you -enter a SEARCH command which specifies a string, and then continue the -directory search using /CONTINUE, the new search pattern will be used -when continuing the search. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of -folder. -2 /EXPIRATION -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the DIRECTORY -command are to be written into the specified file. All qualifiers which -are valid for the EXTRACT command are valid in conjunction with /EXTRACT -except for /NEW which conflicts with the DIRECTORY /NEW qualifier. The -listof messages to be printed will be displayed on the terminal (in -nopaging format). - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /FEEDBACK -Used only in conjunction with /GROUP. Specifies to show when new news -groups are selected. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS. -2 /FROM - /FROM=[string] - -Specifies that only messages whose username contains the specified string -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Used with the search -qualifiers /SEARCH, /SUBJECT, or /FROM. Wildcards are permitted in the -specified string. Use /FEEDBACK to see when groups are selected. At -any time during the search you may enter other commands, i.e. you may -read a message, see a full directory listing, etc. You may then restart -the search listing by typing DIR/CONTINUE. For more info, see help on -the /CONTINUOUS qualifier. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don't -match the specified search command are displayed. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWS -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /OUTPUT - /OUTPUT=filename - -Specifies to write the directory output to a file rather than the -terminal. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED. -2 /SEARCH - /SEARCH=[string] - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDE -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings. - - Format: - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. /FROM is the default. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE. -2 /FROM -Specifies to exclude the message based on the message owner. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. When /FULL is specified, the EXCLUDE command will -not add an exclude, so it can't be used with any other qualifier except -for /DISABLE. -2 /LIMIT - /LIMIT=days - -Specifies that the exclude will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROM -and /SUBJECT cannot be specified at the same time. -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. If the file exists, the -message is appended to the file, unless the /NEW qualifier is specified. - - Format: - FILE [filename] [message_number][-message_number1],[...] - -If the filename is omitted, a file will be created based on the name of -the folder. - -A range of messages to be copied can optionally be specified, i.e. FILE -2-5. The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /ALL -Copies all the messages in the current folder. -2 /FF -Specifies that a form feed is placed between messages in the file. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 FIRST -Specifies that the first message in the folder is to be read. -1 Folders -All messages are divided into separate folders. New folders can be -created by any user. As an example, the following creates a folder for -GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that user -will be alerted of topics of new messages at login time, and will then -be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If instead you -specify /SEMIPRIVATE, all users can read the messages in the folder, but -only those given access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote -DECNET node. Messages added to a remote node are actually stored on the -folder on the remote node. The BULLCP process (created by -BULLETIN/STARTUP) must be running on the remote node for this option to -be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another use -is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, -and giving access to that UIC group. Only users in that UIC group will -see the messages in that folder when they log in. -1 FORWARD -Synonym for MAIL command. -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INCLUDE -This command is a synonym for the THREAD command. -1 INDEX -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after one -has read a message. /RESTART must be specified to start from the first -folder if a scan is in progress. All other qualifiers are ignored while -a scan is in progress. - - Format: - INDEX - -When a directory is displayed, you can read the first message in the -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for older -versions of BULLETIN. -2 /MARKED -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED, -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. -2 /NEW - /[NO]NEW - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message. -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -2 /SET - /[NO]SET - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -2 Suggestions -Here are keypads settings that the author personally uses. Note that -the IND/SUBS commands are useful only for reading NEWS. - -DEFINE/KEY PERIOD "IND/SUBS"/TERM -DEFINE/KEY PERIOD "IND/SUBS/NONEW"/IF_STATE=GOLD/TERM -DEFINE/KEY MINUS "READ/THREAD"/IF_STATE=GOLD/TERM -DEFINE/KEY PF1 ""/IF_STATE=GOLD/SET=NOEDIT -DEFINE/KEY PF1 ""/IF_STATE=NOEDIT/SET=NOH -DEFINE/KEY PF3 "EXT"/TERM -DEFINE/KEY KP9 "MAIL/EDIT/NOHEAD"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP8 "REPLY/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP7 "SEND/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/H"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/NOH"/IF_STATE=NOH/TERM -DEFINE/KEY KP5 "RESPOND/NOEDIT "/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP5 "RESPOND/EXTRACT/LIST/EDIT "/TERM -DEFINE/KEY KP2 "SEARCH/REP "/TERM -DEFINE/KEY KP2 "SEARCH/REV/REP "/TERM/IF_STATE=GOLD -DEFINE/KEY KP2 "SEARCH/REV "/IF_STATE=NOEDIT -DEFINE/KEY COMMA "SPAWN"/TERM -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying an -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" must -be specified as xxx%"""address""". -2 /EDIT -Specifies that the editor is to be used to edit the message before -mailing it. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers] - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 MODIFY -Modifies the database information for the current folder. Only the -owner of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to automatically mailed to the email address. This is common if -you have users that don't have access to BULLETIN. In order to do this, -you should use the SET ADD_ONLY command. This causes all messages added -to the folder to also be sent to the email address. This also applies -to messages which are added via the BBOARD feature. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can -be specified following the folder name, i.e. COPY NEWFOLDER 2-5. -However, if the old folder is remote, they will be copied but not -deleted, as only one message can be delted from a remote folder at a -time. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be moved -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEWS -Displays the list of available news groups. - -Format: - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed. - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL will -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /DEFAULT -If specified, will show news groups that have be defined as default -groups using the SET SUBSCRIBE command. -2 /NEWGROUP -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /PERMANENT -If specified, will show news groups that have be defined as permanent -groups using the SET SUBSCRIBE command. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B. -2 /STORED -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 New_features -Here is a list of new features which may be of interest to the general -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - -------------------------------------------------------------------------- -V 2.24 -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -SHOW EXCLUDE and INCLUDE commands added. 5/16/95 - -V 2.21 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -Added /FOLLOWUP to POST command when used with news groups. It specifies -which news group you want replies to your message to be sent to. 10/28/94 - -V 2.20 - -Logical names can be specified in POST/GROUPS=. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/11/94 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group by -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92 - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. diff --git a/decus/vmslt97a/bulletin/bullcoms2.hlp b/decus/vmslt97a/bulletin/bullcoms2.hlp deleted file mode 100644 index 91b3738..0000000 --- a/decus/vmslt97a/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1457 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with -> at the -beginning of each line. This can be suppressed or the indentation -character changed with /[NO]INDENT. -2 /FOLLOWUP - /FOLLOWUP=string - -Specifies that any replies generated by people reading the message -should be sent to the specified newsgroup. This is useful if you want -to post to more than one group, but don't want reply messages posted on -all the groups. To specify more than one newsgroup, surround the list -with quotes, i.e. FOLLOWUP="newsgroup1,newsgroup2". If replies should -only be sent to the message owner and not a newsgroup, the string -"poster" should be specified. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message -to the specified NEWS group(s) in addition to the selected NEWS group. -Logical names are allowed. -2 /HEADER -Allows customized headers line to be added to the message header. When -specified, header lines can be added by inserting them at the top of the -message, with the header lines and the text of the message separated by -a blank line. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. -In order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply -surround the exclusive text starting with the line "START " -and ending with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The file created by the PRINT command is not -released to the print queue until you exit, unless you add the qualifier -/NOW or change one of the print job's qualifiers. Multiple messages are -concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /CANCEL -Cancels any messages waiting to be printed. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL level -to find out the name of the mounted form and the default form for a -particular queue. If you specify a form whose stock is different from -the stock of the form mounted on the queue, your job is placed in a -pending state until the stock of the mounted form of the queue is set -equal to the stock of the form associated with the job. (In order to -have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the file -or files have been printed. If /NONOTIFY is specified, there is no -notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 QUIT -Exits the BULLETIN program. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. If you -specify a number greater than the number of messages in the folder, the -last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -/HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /THREADS -Reads all messages that have been included by the THREAD command. If -neither message number nor /SINCE is specified, the search starts with -the first new message. After the first READ/THREADS command, typing -READ/THREADS will continue the search from where it left off (as long as -you do not select a different folder or news group). Also, after a -message has been fully read, if the return key is hit without entering a -command, it is equivalent to typing the READ/THREADS command. Messages -which are parts of threads and under read will be displayed in the -directory listing by a preceeding #. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /INDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read -them. (Note: Reading the last message does the same thing, but RESET -does it without having to read it.) -2 /CURRENT -Resets the new message counter to the current message. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using the -qualifer /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected or /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text strings. - - Format: - - SEARCH [search-string[,...]] - -The search starts from the first message in the current folder. You can -specify the message to start at using the qualifier /START. If you use -this qualifier without a parameter, it starts with the current message. -The search includes both the text of the message, and the description -header. If a "search-string" is not specified, a search is made using -the previously specified string, starting with the message following the -one you are currently reading (or have just read). After fully reading -the message found by the search, if you hit the return key without -entering a command, it is equivlanent to typing SEARCH without a search -string and will search for the next message. Once started, a search can -be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FEEDBACK -Used only in conjunction with /FOLDER and /GROUP. Specifies to show -when new folders or news groups are selected. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for a -match. If, during a search, no more matches or messages are found, the -next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. Use /FEEDBACK to see when folders are -selected. News groups can be specified here. However, to search news -group with wild cards, use /GROUP. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Wildcards are permitted in -the specified string. If the string does not contain an * and does not -specify a news group, * is automatically placed at the beginning and end -of the string. I.e. if the string is "comp", then all news groups -containing the word "comp" will be searched. Use /FEEDBACK to see when -groups are selected. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /MATCH - /MATCH[=option] - -Interprets and matches multiple search strings in one of the following -ways: - - AND A match occurs only if all of the strings are found. - - OR A match occurs if any of the strings are found. - - XOR A match occurs if only one of the strings is found. - -If you specify none of these options, the default is /MATCH=OR. If you -specify the /NEGATED qualifier, you will get the negated operation. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If no -starting message is specified, the search is started from the last -message. /REVERSE must be specified with a search string. -2 /START - /START=message_number - -Specifies the message number to start the search at. If you omit the -message number, it starts with the current message. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. UICs can contain -wildcards, i.e. [130,*]. Note that by default, a process is given the -process rights id SYS$NODE_nodename, where nodename is the decnet -nodename. Thus, by specifing this id, a folder can be restricted to a -specific node, which is useful when the folder is shared among nodes in -a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUS -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name. - - Format: - - SET [NO]ANONYMOUS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. - - Format: - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If -ADD_ONLY is set and a mailing address is present (see /DESCRIPTION), -when a message is added to the folder, it will also be mailed to the -address (in addition to being stored in the folder). This also applies -to a message which is added via the BBOARD feature . If ADD_ONLY is set -and a user uses the POST command, the ADD command will be used instead. -One use for this is to mail messages in a folder to users who do not -have access to BULLETIN. - - Format: - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages. - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30" -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The form -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY. -The time will always be 00:00, even if the time is specified on the line. -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be: - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account. - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV. -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION. -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by the -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier. -2 COMPRESS -Specifies that messages added to the folder will be in compressed format. -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires -very little cpu overhead. - - Format: - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed every -time when logging in, until the new messages are read. Normally, the -BRIEF setting causes notification only at the first time that new messages -are detected. - - Format: - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - - Format: - - SET DEFAULT_EXPIRE days - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages. - - Format: - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it. -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format: - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) -2 EXCLUDE -Specifies to ignore any EXCLUDEs or THREADs that are present. - - Format: - - SET [NO]EXCLUDE - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or THREADs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 EXLIMIT -Specifies the default limit for the EXCLUDE command. - - Format: - - SET EXLIMIT days - -If no match is found for an exclude after the specified number of days, -the exclude will automatically be deleted. The default is no limit, -which is specified by specifying 0 days. This default can be overriden -by the /LIMIT switch on the EXCLUDE command. -2 FILE_DIRECTORY -Select the directory where messages are written to when using the -EXTRACT or file COMMAND. By default, the message is written into the -current directory. - - Format: - - SET FILE_DIRECTORY [directory] - -If directory is omitted, the setting is removed. Note: This information -is stored in the customization file (SYS$LOGIN:BULL.CUSTOM). -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new messages will be displayed for upon -logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to by -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. -2 LIBRARY -Specifies a library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command to see if there are other libraries. -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NAME -Copies all stored settings from one user to another. Used when a user's -account name is changed. - - Format: - - SET NAME old-username new-username -2 NEWS -Changes attributes of the specified news group or class of news groups. -This command requires privileges. - - Format: - - SET NEWS [news-group] - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALL - /NOALL - -If specified with /CLASS or /DEFAULT, all groups that are presently -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of any -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the default -attributes (using /DEFAULT) with /NOALL, the attributes for misc.test -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. -3 /CLASS - /CLASS=classname - -Specifies to modify attributes for a class of news groups rather than a -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes of -existing groups which are in the class are modified, and any groups -created in the future will automatically have those attributes. -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETE -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLE -Specifies that the news group is enabled and can be accessed. This is -the default. -3 /EXPIRATION - /EXPIRATION=days - -Specifies the default expiration time for messages if none is specified. -The default is 7. -3 /FULL -Control whether all information of the news groups is displayed, i.e. -the access list if the news group is private. This information is only -those who have access to that folder. -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified is --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default. -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is posted -every month with an expiration date of one month in the future. -3 /PRIVATE - /PRIVATE - /NOPRIVATE - -Specifies that the news group or class can have it's access modified by -the SET ACCESS command. To accomplish this, a file is created in -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access -to news groups in that class is to set /NOPRIVATE, as then time won't be -wasted checking a file for ACLs. -3 /STORED - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessed -via the network from the server node. This results in faster access, -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED. -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder. - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node, -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are logged -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 POST_ONLY -Specifies that the selected folder has the POST_ONLY attribute. This -causes the ADD command to mail the message to the mailing address if it -is present (see /DESCRIPTION), rather than add to the folder. - - Format: - - SET [NO]POST_ONLY -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format: - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers. -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed. -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that READNEW is a permanent flag and cannot be changed by the -individual. This is a privileged qualifier. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all -users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged -qualifier. -2 STRIP -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If STRIP -is set, the header of the mail message will be stripped off before it is -stored as a BULLETIN message. - - Format: - - SET [NO]STRIP - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SUBSCRIBE -Can be used to force users to be subscribed to the selected news group. -This is a privileged command. - - Format: - - SET SUBSCRIBE - -Note: If you execute the commands SET SHOWNEW, READNEW, BRIEF, or -NOTIFY, and add /DEFAULT or /PERMAMENT, it is equivalent to doing a SET -SUBSCRIBE command with the addition that the specified feature will be -the default and/or permanent setting. -3 /ALL -Specifies that all present and future users will be subscribed to the -news group. -3 /DEFAULT - /[NO]DEFAULT - -Specifies that new users will automatically be subscribed to the news -group. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that new users will automatically be subscribed to the news -group and that users cannot unsubscribe the news group. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 EXCLUDE -Displays the list of excludes which are present for the current folder. -The right hand side of the display shows the date of the last time a -match for the exclude was found, and also the number of days from the -time of the last match after which the excludes expires. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected -via the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 THREAD -Displays the list of includes which are present for the current folder. -2 KEYPAD -Displays the keypad command definitions. - - Format: - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either SET KEYPAD, or if /KEYPAD is -specified on the command line, the keypad keys will be defined as -commands. The default settings for the keypad are shown via SHOW KEYPAD -or HELP KEYPAD. Settings can be changed by using an initialization file -with DEFINE/KEY commands. BULLETIN looks first for the file pointed to -by the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -3 /STATE - /STATE=(state,state,...) - -Specifies the name of a state for which the specified key definitions -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when a -key name has been specified. -2 LIBRARY -Shows the library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the /ALL -qualifier to see if there are other libraries. -3 /ALL -Specifies to show all available libraries. -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGIN - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDER - /FOLDER=[foldername] - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups. -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSION -Shows the version of BULLETIN and the date that the executable was -linked. -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of the -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. -1 THREAD -Specifies that the current message is defined as a thread based on -either the subject or the message owner. Since threads are much more -commonly based on the subject, this is the default. Threads are read by -using the command READ/THREADS. - - Format: - THREAD [string] - -If a string is specified, then the message is a thread if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one THREAD may be -specified per folder. - -Note: EXCLUDEs take precedence over THREADs. -2 /ALL -Used with /DISABLE to specify to disable all THREADs. -2 /DISABLE -Specifies to permanently disable the THREAD. -2 /FROM -Specifies to include the message based on the message owner. /FROM -and /SUBJECT cannot be specified at the same time. -2 /LIMIT - /LIMIT=days - -Specifies that the thread will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to include the message based on the message subject. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 Storing_Threads -THREADs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] -1 UNSUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See the -SUBSCRIBE command for further info. -1 Usenet_news -BULLETIN can also read USENET NEWS if your system has network access to -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group -in order to keep track of which messages you have read in that group. -Most of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read all your subscribed news groups that have new -messages, use INDEX/SUBSCRIBE. diff --git a/decus/vmslt97a/bulletin/bulldir.inc b/decus/vmslt97a/bulletin/bulldir.inc deleted file mode 100644 index f66cc78..0000000 --- a/decus/vmslt97a/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vmslt97a/bulletin/bullet1.com b/decus/vmslt97a/bulletin/bullet1.com deleted file mode 100644 index 280b69f..0000000 --- a/decus/vmslt97a/bulletin/bullet1.com +++ /dev/null @@ -1,2760 +0,0 @@ -$set nover -$copy/log sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. -$eod -$copy/log sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) -$eod -$copy/log sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. -$eod -$copy/log sys$input BULLETIN.LNK -$deck -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.3" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.3" -$eod -$copy/log sys$input BULLFILES.INC -$deck -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ -$eod -$copy/log sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) -$eod -$copy/log sys$input BULLNEWS.INC -$deck - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ -$eod -$copy/log sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy/log sys$input BULL_NEWS.C -$deck -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s,s1; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} - - -smtp_assign() -{ - int n; - -#if MULTINET || TWG - /* - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()). - */ - - if (!hp1) { - int h[4],i; - if (sscanf(node1,"%d.%d.%d.%d",&h[0],&h[1],&h[2],&h[3]) == 4) { - for (i=0;i<4;i++) if (h[i] < 0 || h[i] > 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp1->h_addrtype; - memcpy(&sin.sin_addr, hp1->h_addr, hp1->h_length); - } -#if TWG - sin.sin_port = htons(25); -#else - sin.sin_port = htons1(25); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s1,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s1,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node1),DSC$K_CLASS_S,DSC$K_DTYPE_T,node1}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s1,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s1,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - - -smtp_create() -{ -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s1,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(25); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s1,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#else - if (!(sys$qiow(0,s1,IO$_CREATE,&iosb,0,0,node1,25,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#endif - - return(1); -} - -smtp_disconnect() -{ -#if UCX - sys$cancel(s1); - sys$qiow(0,s1,IO$_DEACCESS,0,0,0,0,0,0,0,0,0); -#endif - sys$dassgn(s1); -} - - -smtp_connect() -{ - if (!smtp_gethost()) return(0); - if (!smtp_assign()) return(0); - if (!smtp_socket()) return(0); - return(smtp_create()); -} - -char node2[132]; - -smtp_gethost() -{ - /* - * Get the IP address of the SMTP host. - * As of MULTINET 3.0, cannot be done at AST level - * so can't do in SMTP_ASSIGN(), as BULLCP calls it at - * AST level if the decnet gateway feature is used. - */ -#if TWG - struct hostent *gethostbyname(); -#else -#if MULTINET -#endif -#endif - - node1 = getenv("BULL_SMTP_SERVER"); - if (!node1) { -#if TWG - gethostname(node2,132); -#else -#if MULTINET - gethostname1(node2,132); -#endif -#endif - node1 = node2; - } - -#if TWG - hp1 = gethostbyname(node1); -#else -#if MULTINET - hp1 = gethostbyname1(node1); -#endif -#endif - return(1); -} - - - -smtp_write_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - - -smtp_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s1,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - - -smtp_socket() -{ - -#if MULTINET || TWG - if (!(sys$qiow(0,s1,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s1,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#endif - - return(1); -} -$eod -$copy/log sys$input CHANGES.TXT -$deck -V2.3 - -Added the ability to create a folder that can post and read to a news group, -and can send and read messages via email. See NEWS_TO_FOLDER.TXT for more -info. 4/18/97 - -Added the ability for BULLETIN to see news groups from secondary news groups -(see NEWS.TXT). 4/18/97 - -V 2.25 - -Changes to make it easier to click on news group name to select them: You can -enter a news group name at the prompt and it will select it (without typing -SELECT). News groups displayed without period at end when BULLETIN lists the -ones that have new messages. NEWS/SUBS has space between * and news group -when denoting which ones have new messages. 3/21/96 - -V 2.24 - -When replying to a message in a news group that has been crossposted, give the -user the option of just posting the reply to the news group in which the -message is being read rather than all the news groups in the crosspost. -11/20/95 - -Messages added to folders and stored news groups are now marked as being read -so that the person does not see them when doing a READ/NEW. 11/20/95 - -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. -$eod -$copy/log sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy/log sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy/log sys$input NEWS.TXT -$deck -BULLETIN has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was -to run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added -the ability in BULLETIN (actually BULLCP) so that it acts as as a gateway -between decnet and tcp for NEWS. This method does not require spawning any -processes, since the detached process BULLCP is always present, so the access -is very fast. Also, since BULLETIN uses a shared database to store info on -the NEWS groups and periodically updates it, there is no need for that to be -done when a user accesses the NEWS groups. Several other NEWS readers do this -when you run them, which is why they take a long time to start up. It is also -possible to feed NEWS groups into a "real" BULLETIN folder, so that the -messages are saved on disk (see the file NEWS_TO_FOLDER.TXT). - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER to -be a system logical name pointing to either your internet or decnet NEWS node. -If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -It is also possible for BULLETIN to access news groups that are located on -other news servers than the one specified by BULL_NEWS_SERVER. This is done -by creating the file BULL_DIR:BULL_ALT_NEWS.LIS and adding a line which -containsthe name of the news group and the news server where it's located. -The format is news-group-name:news-server-name. - -In order to post messages, BULLETIN needs to know the internet nodename of the -local host. This is done automatically for nodes running MULTINET. For other -nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This can -be hardcoded into the source by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, -it will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will -cause subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -If you have any problems or questions, please let me know. - MRL -$eod -$copy/log sys$input NEWS_TO_FOLDER.TXT -$deck -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description -surrounded by <>, i.e. . It must be in lower case. (Other text is -allowed in the description, i.e. "THIS IS A TEST FOLDER ".) When -messages are added the folder, they are also sent to the news group, and new -messages from the group are posted to the folder (via the BULLCP process which -wakes up on a periodic basis). Whenever you modify the folder description and -specify the news group name, you will be prompted as to whether you want to -initializee the news group counter to either load all the messages present in -the news group, or to load only news messages that appear there. - -Messages posted to the news group from such a folder have a special line in -their header indicating they were sent from that node using bulletin. When -bulletin feeds new postings back to the folder, it will see that header line -and also see that it was posted from that node, and thus will avoid adding it -to the folder (and thus creating a duplicate message). Note that messages are -added to the news group via the BULLCP process, so they will not appear -immediately after being added to the folder. - -If you are modifying an existing folder to make it associated with a news -group, and if you want to copy any existing messages in the folder to the news -group, you can do that by using the command COPY/ORIGINAL/LOCAL and specifying -the news group as the destination. /ORIGINAL will cause the original owner -names and dates to be preserved (note, however, that dates older than 14 days -in the past are not usually accepted by the news server, so dates older than -that will be changed to the present date). /LOCAL will create the special -header line in the messages to prevent BULLCP from adding those messages back -to the folder from the news group. /ALL can be specified to copy all the -messages in the folder. - -If you create a remote folder that points to a folder that has a news group -associated with it, you do not have to specify the news group in the -description of the remote node. - -When a news group is specified for a folder, it is still possible to associate -an email address for the messages to be sent to in the folder description. -You do this by using [] to enclose the address rather than the usual <>, i.e. -[mrl@pfc.mit.edu] See help in BULLETIN on the command CREATE/DESCRIPTION for -more info about associated email addresses. Note that these features allow -you to create a full gateway between a news group and a mailing list. -$eod -$copy/log sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod -$copy/log sys$input WRITEMSG.TXT -$deck -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/vmslt97a/bulletin/bullet2.com b/decus/vmslt97a/bulletin/bullet2.com deleted file mode 100644 index b0d2276..0000000 --- a/decus/vmslt97a/bulletin/bullet2.com +++ /dev/null @@ -1,1703 +0,0 @@ -$set nover -$copy/log sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy/log sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy/log sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 4/10/97 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER COPY, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FORCE - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER OUTPUT,VALUE(REQUIRED,TYPE=$FILE) - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB THREAD - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE, NONNEGATABLE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER FORCE - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER THREADS - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD THREAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE -$eod -$copy/log sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP -$eod -$copy/log sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP -$eod -$copy/log sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy/log sys$input BULL_NEWSDUMMY.FOR -$deck - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END - - - - SUBROUTINE SMTP_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION SMTP_CONNECT - - SMTP_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION SMTP_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION SMTP_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_READ_PACKET = 0 - - RETURN - END -$eod -$copy/log sys$input CREATE.COM -$deck -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK -$eod -$copy/log sys$input INSTALL.COM -$deck -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy/log sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy/log sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.3" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* -$eod -$copy/log sys$input OPTIMIZE_RMS.COM -$deck -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS -$eod -$copy/log sys$input RESTART.COM -$deck -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START -$eod -$copy/log sys$input SETUSER.MAR -$deck - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program -$eod -$copy/log sys$input UPGRADE.COM -$deck -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE -$eod diff --git a/decus/vmslt97a/bulletin/bulletin.ann b/decus/vmslt97a/bulletin/bulletin.ann deleted file mode 100644 index c374df5..0000000 --- a/decus/vmslt97a/bulletin/bulletin.ann +++ /dev/null @@ -1,26 +0,0 @@ -Article 168253 of comp.os.vms: -BULLETIN is a bulletin board utility which I wrote for VMS. However, because -many of our VAX users moved to PCs and MACs, they have wanted access to read -and post to the BULLETIN folders. In the past I accomplished this via EMAIL -and used the feature which allowed mail to be sent to and from a folder. -However, some people have asked for Web access. In order to easily provide -this feature without a lot of work, we decided to do the following: Since -news server software is now easily and cheapily available, and most news -readers (i.e. Netscape) have the ability to read usenet news groups from more -than one news server, I set up a local news server to serve private news -groups. I then modified BULLETIN to allow a folder with email access to also -have the ability to post and receive to a specified news group. I also had to -modify BULLETIN to allow it to access more than one news server. Thus, a user -can now post and read the same folder either via either BULLETIN, EMAIL, or -WEB access via a newsgroup. - -The new version of BULLETIN (v2.3) which has this feature is available via -anonymous ftp to PSFC.MIT.EDU in the BULLETIN sub-directory. - -Note: The newsgroup-folder feature had existed in the past but would not work -with email. It also was crude in that if you added a message, it would first -post the message to the newsgroup and then later be added to the folder. It -now is added immediately to the folder. Sharp users will note that this gives -BULLETIN the ability to be used as a newsgroup to mailing list gateway. - - diff --git a/decus/vmslt97a/bulletin/bulletin.cld b/decus/vmslt97a/bulletin/bulletin.cld deleted file mode 100644 index deb3c36..0000000 --- a/decus/vmslt97a/bulletin/bulletin.cld +++ /dev/null @@ -1,44 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vmslt97a/bulletin/bulletin.com b/decus/vmslt97a/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vmslt97a/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vmslt97a/bulletin/bulletin.for b/decus/vmslt97a/bulletin/bulletin.for deleted file mode 100644 index ad9859a..0000000 --- a/decus/vmslt97a/bulletin/bulletin.for +++ /dev/null @@ -1,2095 +0,0 @@ -C -C BULLETIN.FOR, Version 2/27/97 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - DATA NEXT_COMMAND/' '/ - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - CALL INIT_BULLETIN(.TRUE.) - -C -C The MAIN loop for processing bulletin commands. -C - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IF (IER.GT.0) THEN - IF (INDEX(INCMD(:IER),' ').EQ.0.AND. - & INDEX(INCMD,'/').EQ.0.AND. - & INDEX(INCMD,'.').GT.0) INCMD = 'SELECT '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE IF (READ_COUNT.NE.0) THEN - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - ELSE IF (NEXT_COMMAND.NE.' ') THEN - INCMD = NEXT_COMMAND - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL DO_COMMAND(INCMD) - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - CALL DO_COMMAND(INCMD) - -100 CONTINUE - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) - - END - - - - - SUBROUTINE DO_COMMAND(INCMD) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - CHARACTER*(*) INCMD - - NEXT_COMMAND = ' ' - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (HLEN.EQ.0) THEN - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - END IF - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL'.OR. - & INCMD(:4).EQ.'POST'.OR. - & INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - WRITE (6,'('' ERROR: /FOLDER not valid when posting'', - & '' a message to a news group.'')') - ELSE - INCMD = 'POST '//INCMD(4:) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - END IF - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,'('' ERROR: There are no more preceding messages.'')') - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').AND.CLI$PRESENT('NEWS')) THEN - WRITE (6,'('' ERROR: /NEWS and /FOLDER cannot be '' - & ''specified at the same time.'')') - ELSE IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.,.FALSE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR - ELSE IF (INCMD(:4).EQ.'INCL'.OR. ! INCLUDE? - & INCMD(:4).EQ.'THRE') THEN ! THREAD? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IF (CLI$PRESENT('THREADS')) NEXT_COMMAND = 'READ/THREADS' - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - NEXT_COMMAND = 'SEARCH' - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'FI') THEN ! SET FILE_DIRECTORY? - CALL SET_CUSTOM('file_directory') - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SH') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SU') THEN ! SET SUBSCRIBE? - IF (REMOTE_SET.GE.3) THEN - D1 = 0 - D2 = 0 - D3 = 0 - CALL SET_FOLDER_DEFAULT(D1,D2,D3) - ELSE - WRITE (6,'('' ERROR: Command invalid for folder.'')') - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LIB') THEN ! SET LIBRARY? - CALL SET_LIBRARY - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS? - CALL SET_NEWS - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE? - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE? - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:3).EQ.'EXL') THEN ! SET EXLIMIT? - CALL SET_CUSTOM('exclude_limit') - ELSE IF (BULL_PARAMETER(:4).EQ.'NAME') THEN ! SET NAME? - CALL SET_NEWNAME - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'EX') THEN ! SHOW EXCLUDE? - CALL SHOW_EXCLUDE(0) - ELSE IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:2).EQ.'IN'.OR. - & BULL_PARAMETER(:2).EQ.'TH') THEN ! SHOW INCLUDE? - CALL SHOW_EXCLUDE(1) - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SHOW LIBRARY - CALL SHOW_LIBRARY - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATION - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1) - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN? - CALL TAG(.FALSE.,2) - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - - RETURN - END - - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER INEXDATE*12,INEXTIME*12,INDENT*4 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,BULLETIN_SUBCOMMANDS - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT') - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - LENI = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',INDENT,LENI) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LENI.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') INDENT(:LENI)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2100' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2100' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60) - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60) - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - IF (CLI$PRESENT('EXTRACT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35 - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - BLENGTH = BLENGTH + ILEN - 1 + 2 - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE. - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting.'', - & '' A truncated message will be broadcast.'')') - CALL GET_INPUT_PROMPT(INPUT,ILEN, - & 'Type C to continue, A to only ADD message, or Q to Quit: ') - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN - BRDCST = .TRUE. - END IF - END IF - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! Username - END IF - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THEN - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '// - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK) - END IF - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletin - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IF - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF (FOLDER_NUMBER.GE.0) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL ADD_TAG(IER1,2) - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF -C -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP, -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same cluster -C as that of the BULLCP node. -C - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET) - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - ELSE IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR. - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & INDESCRIP(:LENDES),STATUS) - ELSE - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LENDES),STATUS) - END IF - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & ERR=910,FORM='FORMATTED') - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IF - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:INDEX(FOLDER_DESCRIP,'>')-1) - CALL NEWS_POST(BULL_PARAMETER(:LEN_P),.FALSE.,IER, - & INDESCRIP) - END IF - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GOTO 100 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*4 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP)) - - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG) - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC' - - DATA READ_UAI/.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE. - RETURN - END IF - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE. - END IF - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURN - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')') - RETURN - END IF - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN) - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN() - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - RETURN - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - SUBROUTINE INIT_BULLETIN(NOX) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - DATA PAGE_LENGTH/24/,PAGE_WIDTH/80/ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (NOX) CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER(:LEN_P) - CALL CHECK_DIR(BULL_PARAMETER,.FALSE.) - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - END IF - CALL LIB$REVERT - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE IF (COMMAND_PROMPT(I:I).EQ.'/') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL(.FALSE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS1') THEN - CALL NEWS2BULL(.TRUE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'SMTP') THEN - CALL SEND_MAIL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - IF (NOX) CALL CRELNM('SYS$INPUT','TT') ! Input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - IF (NOX) CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - - CALL OPEN_OLD_TAG - - IF (.NOT.NOX) THEN - CALL NEW_MESSAGE_NOTIFICATION - RETURN - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IF - END IF - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bulletin.hlp b/decus/vmslt97a/bulletin/bulletin.hlp deleted file mode 100644 index cf279b3..0000000 --- a/decus/vmslt97a/bulletin/bulletin.hlp +++ /dev/null @@ -1,151 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vmslt97a/bulletin/bulletin.lnk b/decus/vmslt97a/bulletin/bulletin.lnk deleted file mode 100644 index 8d8a7d2..0000000 --- a/decus/vmslt97a/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.24" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.24" diff --git a/decus/vmslt97a/bulletin/bulletin0.for b/decus/vmslt97a/bulletin/bulletin0.for deleted file mode 100644 index 3d5d39a..0000000 --- a/decus/vmslt97a/bulletin/bulletin0.for +++ /dev/null @@ -1,2439 +0,0 @@ -C -C BULLETIN0.FOR, Version 9/20/96 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET.EQ.1) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IER1 = SBULL + 1 - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER1) - SUBJECT = DESCRIP - IER2 = 0 - IF (IER2.EQ.0.AND.IER1.EQ.SBULL+1) CALL - & REMOTE_DELETE(SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - ELSE IF (REMOTE_SET.EQ.3) THEN - BULL_DELETE = SBULL - 1 - IER = 0 - IF (CLI$PRESENT('REASON')) THEN - CALL CLI$GET_VALUE('REASON',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) RETURN - IF (EBULL.EQ.SBULL) THEN - WRITE(6,1030) - RETURN - END IF - END IF - END DO - SUBJECT = DESCRIP - IF (.NOT.TEST_NEWS_OWNER().AND.SETPRV_PRIV().AND. - & .NOT.CLI$PRESENT('FORCE')) THEN - SUBJECT = 'CanceL' - IF (CLI$PRESENT('REASON')) THEN - SUBJECT = SUBJECT(:6)//BULL_PARAMETER(:LEN_P) - END IF - END IF - CALL REMOTE_DELETE - & (SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - RETURN - END IF - END DO - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - SUBJECT = DESCRIP - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.NE.USERNAME - END IF - IF (ASK.AND..NOT.CLI$PRESENT('FORCE')) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - IF (REMOTE_SET.EQ.4) THEN - SUBJECT = 'CanceL' - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.(TEST_NEWS_OWNER().OR. - & SETPRV_PRIV())) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2),EX(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:9).EQ.'19') EXDATE(8:9) = '18' - IF (EXDATE(8:9).EQ.'20') EXDATE(8:9) = '19' - IF (EXDATE(8:9).EQ.'18'.AND.EXDATE(10:10).LT.'6') - & EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX,EX) - IER = SYS$ASCTIM(,INPUT,EX,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DIRMODE/ DIRMODE - DATA DIRMODE/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - CHARACTER GROUP*80,STAT*4 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - DIRMODE = .TRUE. - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - FOUND = 0 - OUT = 6 - - CONT = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - CONT = CLI$PRESENT('CONTINUE') - ELSE IF (INCMD(:3).EQ.' '.AND.NFOLDER.LT.0) THEN - CONT = .TRUE. - END IF - IF (CONT) THEN - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - SUBJECT = SUBJECT1 - REPLY = REPLY1 - SEARCH = SEARCH1 - FROM_SEARCH = FROM_SEARCH1 - SINCE = SINCE1 - NEW = NEW1 - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - IF (.NOT.ANY_SEARCH) THEN - WRITE (6,'('' ERROR: No previous search to continue.'')') - RETURN - END IF - INCMD = ' ' - LEN_P = 0 - DIR_COUNT = DIR_COUNT1 - NFOLDER = NFOLDER1 - I = DIR_COUNT - IF (DIR_COUNT.EQ.-1) THEN - I = SBULL - 1 - END IF - GO TO 200 - END IF - NFOLDER = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('OUTPUT',BULL_PARAMETER,LEN_P)) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & DEFAULTFILE='.LIS', - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - WRITE(6,1000) BULL_PARAMETER(:LEN_P) - RETURN - END IF - OUT = 3 - INQUIRE (UNIT=3,NAME=BULL_PARAMETER) - WRITE (6,1040) BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - END IF - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - EXTRACTING = CLI$PRESENT('EXTRACT') - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - NEGATED = CLI$PRESENT('NEGATED') - IF (SEARCH) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (SUBJECT) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (FROM_SEARCH) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (REPLY) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3 - NEGATED = .TRUE. - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - IF (INCMD(:3).EQ.'IND') THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - REPLY_FIRST = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - ELSE - NEW = .FALSE. - END IF - END IF - OUTPUT = EXTRACTING.OR.PRINTING - - START = .FALSE. - SINCE = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - NFOLDER1 = -1000 - SUBJECT1 = SUBJECT - REPLY1 = REPLY - SEARCH1 = SEARCH - FROM_SEARCH1 = FROM_SEARCH - I = SBULL - 1 - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - SINCE1 = SINCE - NEW1 = NEW - GOTO 200 - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - IF (NEW.AND.IER.EQ.0) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - IF (READ_TAG) CALL DECREMENT_MSG_KEY - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) NUM = NUM + 1 - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - END IF - I = I - 1 - END DO - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - END IF - IF (NUM.GT.0) I = I - 1 - END DO - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) NUM = NUM + 1 - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) J = J + 1 - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT.OR.OUT.EQ.3) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I1 = SBULL - I = SBULL - DO WHILE (I.LE.EBULL) - CALL READDIR(I1,IER) ! Into the queue - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1 - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - I = I + 1 - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1 - END IF - I1 = I1 + 1 - END DO - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - EBULL = EBULL - SBULL + DIR_COUNT - SBULL = DIR_COUNT - I = SBULL - END IF - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY, - & TAG_TYPE) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVE - END IF - END IF - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - END IF - ELSE - NBULL = 0 - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN - DIR_TYPE = 'seen' - END IF - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - IF (INCMD(:3).EQ.'DIR'.AND.ANY_SEARCH) THEN - IF (.NOT.CLI$PRESENT('START').AND. - & .NOT.CLI$PRESENT('CONT')) THEN - WRITE (6,'('' No matches found starting search'', - & '' from message number '',I)') SBULL - DIR_COUNT = -1 - GO TO 9999 - END IF - END IF - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - IF (NFOLDER.EQ.0) CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT) - - TAG = (BULL_TAG.AND.(REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1)).OR. - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THEN - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN - START_SEARCH = BULL_POINT - END IF -200 CLOSED = .FALSE. - IF (ANY_SEARCH.OR.OUTPUT) THEN - NUM = 0 - IF (NFOLDER.NE.-1000) THEN - CLOSED = .TRUE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - CLOSED_FILES = .FALSE. - SEARCH_NUM = 1 - REVERSE = .FALSE. - END IF - DO WHILE (I.LE.EBULL.AND.FOUND.GT.-3) - IF (.NOT.ANY_SEARCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (NFOLDER.NE.-1000.AND.I.GE.SBULL) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SLEN,0, - & START_SEARCH,REVERSE,SUBJECT,REPLY_FIRST,.FALSE., - & .TRUE.,FROM_SEARCH,NEGATED,.FALSE.) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - IF (NFOLDER.LT.0.AND.(I.EQ.F_START.OR.I.EQ.DIR_COUNT)) THEN - IF (FEEDBACK) CALL LIB$ERASE_PAGE(1,1) - CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT) - DIR_COUNT = 0 - BULL_POINT = MSG_NUM - 1 - PRINT_HEADER = .TRUE. - END IF - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - TAG_TYPE = DUMMY - END IF - IF (NFOLDER.LT.0.AND..NOT.OUTPUT) THEN - NUM = NUM + 1 - IF (NUM.EQ.PAGE_LENGTH-6) I = EBULL + 1 - END IF - ELSE IF (NFOLDER.LT.0.AND.(OUTPUT.OR.I.LE.SBULL)) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSED = .FALSE. - END IF - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - CALL CLOSE_BULLFOLDER - IF (GFOUND) THEN - START_BULL = 0 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - IF (F1_START.GT.0.AND.F1_START.LE.F1_NBULL) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - START_SEARCH = F_START - 1 - IF (IER.AND.(NEW.OR.SINCE)) THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER1,DATETIME) - CALL CLOSE_BULLDIR - IF (IER1.NE.0) THEN - START_SEARCH = IER1 - 1 - ELSE - IER = 0 - END IF - END IF - END IF - IF (.NOT.IER.OR.F1_START.EQ.0.OR. - & F1_START.GT.F1_NBULL) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER, - & IER) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - GFOUND = .FALSE. - IF (FLAG.EQ.1) CALL CLOSE_BULLFOLDER - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - SBULL = F_START - I = SBULL - 1 - EBULL = F_NBULL - END IF - ELSE - NFOLDER = 0 - END IF - END DO - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - ELSE IF (NFOLDER.EQ.0) THEN - WRITE (6,'('' No messages found.'')') - END IF - IF (NFOLDER.EQ.0) I = EBULL + 1 - IF (NFOLDER.LT.-1000) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED = .TRUE. - END IF - NFOLDER1 = NFOLDER - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - I = EBULL + 1 - END IF - CALL CANCEL_CTRLC_AST - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.GE.SBULL.AND.I.LE.EBULL.AND.NFOLDER.NE.-1000) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN - OUTLINE = '>' - ELSE IF (BTEST(SYSTEM,8)) THEN - OUTLINE = '#' - ELSE - OUTLINE = ' ' - END IF - IF (BTEST(SYSTEM,29)) THEN - OUTLINE(2:) = '*' - ELSE - OUTLINE(2:) = ' ' - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3) - IF (EXDATE(8:12).LT.'1994'.AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin? - EXPIRES = 'Permanent' - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11) - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9) - ELSE - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11) - END IF - NOTHING = .FALSE. - IF (OUT.EQ.6) THEN - WRITE(OUT,'(1X,A)') OUTLINE - ELSE - WRITE(OUT,'(A)') OUTLINE - END IF - IF (OUTPUT) THEN - FOUND_MSG = .TRUE. - CALL SYS$SETAST(%VAL(0)) - NEXT = .FALSE. - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES) - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES,PRINT_HEADER) - PRINT_HEADER = .FALSE. - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0 - ELSE - MSG_NUM = -MSG_NUM - END IF - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1)) - END IF - END IF - I = I + 1 - IF (ANY_SEARCH) IER = SYS$CANTIM(,) - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.OUTPUT) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IF - END IF - - IF (DIR_COUNT.GT.NBULL - & .OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THEN - ! Outputted all entries? - IF (PRINTING) THEN - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THEN - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IF - ELSE IF (EXTRACTING.AND.FOUND_MSG) THEN - CALL FILE(0,CLOSED_FILES,.FALSE.) - END IF - IF (NFOLDER.LT.0) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE - DIR_COUNT = -1 ! Yes. Set counter to -1. - END IF - ELSE IF (NFOLDER.NE.0.OR.(-NFOLDER1.EQ.FOLDER_NUMBER.AND. - & INCMD(:1).EQ.' ')) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE IF (FLAG.NE.1) THEN - WRITE(6,1010) ! Else say there are more - END IF - -9999 POSTTIME = .FALSE. - NEXT = .FALSE. - DIRMODE = .FALSE. - IF (NFOLDER.NE.0.OR.-NFOLDER1.EQ.FOLDER_NUMBER) THEN - DIR_COUNT1 = DIR_COUNT - IF (DIR_COUNT1.GT.NBULL) DIR_COUNT1 = -1 - END IF - IF (OUT.EQ.3) CLOSE (UNIT=3) - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(1X,/,' Press RETURN for more...',/) -1020 FORMAT(1X,/,' Press RETURN for more, type SEARCH to read ', - & 'these messages.',/) -1040 FORMAT(' Output being written to ',A,'.') - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER) - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT,PRINT_HEADER) -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER*128 FILENAME - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THEN - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IF - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THEN - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IF - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - END IF - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = FILE_NUM - EBULL = SBULL - END IF - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F) - - IF (.NOT.IER) THEN - FILENAME = FOLDER - DO I=1,LEN(FILENAME) - IF (FILENAME(I:I).EQ.'.') FILENAME(I:I) = '_' - END DO - FILENAME = FILENAME(:TRIM(FILENAME))//'.TXT' - LEN_F = TRIM(FILENAME) - END IF - - IF (TRIM(FILE_DIRECTORY).GT.0.AND.INDEX(FILENAME,':').EQ.0 - & .AND.INDEX(FILENAME,'[').EQ.0) THEN - FILENAME = FILE_DIRECTORY(:TRIM(FILE_DIRECTORY))//FILENAME - LEN_F = TRIM(FILENAME) - END IF - - CALL STR$UPCASE(FILENAME,FILENAME) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE. - FIRST = .TRUE. - END IF - - IF (PRINT_HEADER) THEN - WRITE (3,'(/,''Newsgroup: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1 - IF (FBULL1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - OPENED = .FALSE. - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(FBULL,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DO - -100 IF (FILE_NUM.GT.0) THEN - FILE_NUM = -FILE_NUM - RETURN - END IF - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created. - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - END IF - - GO TO 10 - -900 WRITE(6,1000) FILENAME(:LEN_F) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message ',A,' written to ',A) -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A) -1050 FORMAT('Subj: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN) - - CALL LIB$MOVC3(8,IN,OUT) - - RETURN - END - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - FOLDER_NAME = FOLDER - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSE - RETURN ! Don't notify - END IF - END IF - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSE - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM) - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time - ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSER - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LOGIN_BTIM_NEW) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF - - CALL GET_NODE_NUMBER(NODE_NUMBER1,NODE_AREA1) - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100 - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IGNORE = BTEST(SYSTEM,2).AND.(NODE_AREA.EQ.NODE_AREA1).AND. - & (NODE_NUMBER.AND.NODE_NUMBER1) - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF ((USERNAME.NE.FROM.OR.SYSTEM).AND..NOT.IGNORE) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - ELSE - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - END IF - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - INREAD = '+' - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' ' - END IF - IF (LEFT) THEN - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN) - LEFT = .FALSE. - ILEN = 0 - INREAD = '+' - ELSE IF (ILEN.LE.WIDTH) THEN - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN) - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSE - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ') - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH) - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0) - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DO - IF (INPUT(ILEN:ILEN).EQ.' ') THEN - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEN - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE. - ELSE - WIDTH = PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE (6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - PAGE = PAGE + 1 - ELSE - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)// - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN) - & //' '//FOLDER_NAME(:FLEN)// - & ' to read these messages.' - END IF - PAGE = PAGE + 1 - END IF - -9999 IF (LOGIN_SWITCH) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION, - & OUT) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - CHARACTER*(*) OUTLINE - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULL - ELSE - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IF - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ') - OUTLINE(I:) = OUTLINE(I+1:) - END DO - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINE - BULL_PARAMETER = ' ' - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1)) THEN - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THEN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IF - IF (PRINTING) THEN - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - END IF - - IF (OUT.EQ.6) THEN - WRITE (OUT,'(''+'',A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - ELSE - WRITE (OUT,'(A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - END IF - -1000 FORMAT(A,1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(A,1X,'Description',43X,'From',8X,'Expires',/) - - RETURN - END - - - - SUBROUTINE GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER TODAY(2) - - CHARACTER DATETIME*24 - - IF (SINCE) THEN ! Was /SINCE specified? - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - IER = 0 - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - END IF - END IF - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bulletin1.for b/decus/vmslt97a/bulletin/bulletin1.for deleted file mode 100644 index d04fc6f..0000000 --- a/decus/vmslt97a/bulletin/bulletin1.for +++ /dev/null @@ -1,2495 +0,0 @@ -C -C BULLETIN1.FOR, Version 2/27/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_S = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',SENDTO(LEN_S+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_S = LEN_S + I + 1 - SENDTO(LEN_S:LEN_S) = ',' - END DO - LEN_S = LEN_S - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_S) - IF (SENDTO(I:I).EQ.'"') THEN - SENDTO = SENDTO(:I)//'""'//SENDTO(I+1:) - I = I + 2 - LEN_S = LEN_S + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',SENDTO(:LEN_S) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//SENDTO(:LEN_S) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*32 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - INIT_NEWSFEED = .FALSE. - - NEWSGROUP = .FALSE. - MAILTO = 0 - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - RETURN - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - I = INDEX(FOLDER1_DESCRIP,'<') - J = INDEX(FOLDER1_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'@').LT.1 - & .OR.INDEX(FOLDER1_DESCRIP(I:),'@').GT.J-I+1).AND. - & (INDEX(FOLDER1_DESCRIP(I:),'.') - & .LE.J-I+1.AND.INDEX(FOLDER1_DESCRIP(I:),'.').GT.0)) THEN - NEWSGROUP = .TRUE. - WRITE (6,'('' Init news feed counter to feed '', - & ''all messages in news group (Y),'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'or set to feed only new messages (N,default) ? ') - INIT_NEWSFEED = RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y' - I = INDEX(FOLDER1_DESCRIP,'[') - J = INDEX(FOLDER1_DESCRIP,']') - END IF - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER1_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER1_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'.') - & .GT.J-I+1.OR.INDEX(FOLDER1_DESCRIP(I:),'.').EQ.0) - & .AND.MAILTO.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(RESPONSE) - IF (TRIM(RESPONSE).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//RESPONSE(:TRIM(RESPONSE))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - IF (NEWSGROUP) FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - IF (MAILTO.EQ.2) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (MAILTO.EQ.3) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (INIT_NEWSFEED) THEN - F_LAST = 0 - ELSE IF (NEWSGROUP) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - I = INDEX(FOLDER_DESCRIP,'<') + 1 - J = INDEX(FOLDER_DESCRIP,'>') - 1 - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER_DESCRIP(I:J),IER) - CALL CLOSE_BULLNEWS - CALL OPEN_BULLFOLDER - F_LAST = F1_NBULL - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /FEED/ FEED - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256,TODAY*24 - CHARACTER SCRFILE*18 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - IF (.NOT.BULLCP_NEWS.AND.FOLDER.EQ.FOLDER1) THEN - WRITE (6,'('' ERROR: Destination cannot be same as'', - & '' current location.'')') - RETURN - END IF - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER1 = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - NEWS2BULL = NEWS2BULL.AND..NOT.TO_NEWS.AND.ORIGINAL - IF (IER1.EQ.0.AND..NOT.NEWS2BULL) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THEN - I = IER - ELSE IF (.NOT.NEWS2BULL) THEN - NUM_COPY = NUM_COPY + 1 - END IF - NEWS2BULL = .FALSE. - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - FROM_BULL_POINT = BULL_POINT - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (REMOTE_SET.EQ.4.AND..NOT.BULLCP_NEWS).OR.REMOTE_SET.EQ.3 - - POST_FEED = .FALSE. - SLIST = 0 - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST:INDEX(FOLDER_DESCRIP,'>')-1) - POST_FEED = .TRUE. - END IF - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') + 1 - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - END IF - IF (SLIST.GT.1) THEN - IF (NEWS_FEED()) THEN - ELIST = INDEX(FOLDER_DESCRIP,']') - 1 - ELSE - ELIST = INDEX(FOLDER_DESCRIP,'>') - 1 - END IF - END IF - IF (CLI$PRESENT('LOCAL').AND..NOT.BULLCP_NEWS) SLIST = 0 - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS.OR.(POST_FEED.AND.SLIST.LE.1)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - END IF - IF (.NOT.POST_NEWS) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=FROM_BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF ((FROM_REMOTE.OR.FROM_REMOTE.EQ.4).AND. - & (TO_NEWS.AND.ORIGINAL)) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2100' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (SLIST.GT.1.OR.POST_NEWS.OR.POST_FEED) THEN - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - IF (SLIST.GT.1) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE='BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'BULL.SCR' - END IF - ENDIF - ILEN = LINE_LENGTH + 1 - - INFROM = FROM - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - IF (POST_NEWS.OR.POST_FEED) THEN - USE_INFROM = ORIGINAL - IF (CLI$PRESENT('LOCAL')) NEWS2BULL = .TRUE. - CALL NEWS_POST - & (SCRFILE(:TRIM(SCRFILE)),.TRUE.,IER,POST_SUBJECT) - NEWS2BULL = .FALSE. - END IF - IF (SLIST.GT.1) THEN - CLOSE (UNIT=3) - USE_INFROM = ORIGINAL - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - ELSE - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - END IF - CALL LIB$DELETE_FILE(SCRFILE(:TRIM(SCRFILE))//';') - ELSE IF (POST_FEED.OR.POST_NEWS) THEN - REWIND (UNIT=3) - END IF - BLOCK = BLOCK_SAVE - LENGTH = LENGTH_SAVE - END IF - IF (.NOT.POST_NEWS) THEN - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - IF (.NOT.ORIGINAL) SYSTEM = IBSET(SYSTEM,3) - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (SLIST.LT.1.AND.POST_NEWS.OR.POST_FEED) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - IF (TEST_BULLCP().NE.2) - & WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADER - IF (BULLCP_NEWS) RETURN - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IF - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./ - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND. - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0 - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN) - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0) - IF (CHANGED) THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IF - - IF (INCMD(:4).EQ.'PRIN') THEN - IF (CLI$PRESENT('CANCEL')) THEN - WRITE (6,'('' Cancelling all previously queued messages.'')') - CLOSE (UNIT=24,DISPOSE='DELETE') - FIRST = .TRUE. - RETURN - END IF - END IF - -50 IF (PRINT_NUM.EQ.0) THEN - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = PRINT_NUM - EBULL = SBULL - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name - IF (QLEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - END IF - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100 - CLOSE (UNIT=24,DISPOSE='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - END IF - -1040 FORMAT(' Message ',A,' sent to printer.') -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE. - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) - END IF - - CALL DISABLE_PRIVS - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A, - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE. - GO TO 50 - END IF - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ_MSG -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /POST/ POSTTIME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /THREAD/ THREAD - DATA THREAD /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/,LAST_THREAD/.FALSE./ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH) - CHARACTER HEADLINE*132 - - LOGICAL SINCE,PAGE - - EXTERNAL CLI$_NEGATED - - FIRST = BULL_READ.LT.F_START - KILL = BTEST(BULL_USER_CUSTOM,3) - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3) - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE. - END IF - ROTC = CLI$PRESENT('ROTATE') - END IF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - THREAD = .FALSE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - THREAD = CLI$PRESENT('THREADS') - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSE - BULL_READ = 1 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE').AND. - & .NOT.THREAD) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW').OR.(THREAD.AND..NOT. - & CLI$PRESENT('SINCE').AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND.(.NOT.LAST_THREAD - & .OR.LAST_THREAD_NUMBER.NE.FOLDER_NUMBER) - & .AND.CLI$PRESENT('NEW').NE.%LOC(CLI$_NEGATED))) THEN - NEW = .TRUE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READDIR_KEYGE(IER) - IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_BTIM) - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - CALL CLOSE_BULLDIR - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - IER = 0 - END IF - END DO - CALL CLOSE_BULLDIR - ELSE - IER = 0 - SKIPPED_THREAD = .FALSE. - IF (THREAD) CALL OPEN_BULLDIR_SHARED - DO WHILE (IER.EQ.0) - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - BULL_READ = IER - END IF - IF ((SKIPPED_THREAD.OR.(THREAD.AND.IER.NE.0)).AND. - & BULL_READ.LE.F_NBULL) THEN - CALL READDIR(BULL_READ,IER) - IER = IER - 1 - IF (IER.NE.BULL_READ) IER = 0 - END IF - IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - MSG_NUM = IER - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,DUMMY,DUMMY) - IF (IER1.EQ.0) THEN - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(IER) - ELSE - BULL_READ = BULL_READ + 1 - END IF - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - WRITE (6,'('' No more messages are present.'')') - IF (SKIPPED_THREAD) CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - SKIPPED_THREAD = .TRUE. - BULL_READ = IER + 1 - IER = 0 - END IF - END DO - END IF - IF (THREAD) CALL CLOSE_BULLDIR - BULL_READ = IER - IER = IER + 1 - ELSE IF (THREAD) THEN - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999 - ELSE - BULL_READ = IER - 1 - IER = IER + 1 - END IF - SINCE = .TRUE. - ELSE IF (CLI$PRESENT('BULLETIN_NUMBER')) THEN - BULL_READ = BULL_READ - 1 - ELSE IF (LAST_THREAD_NUMBER.EQ.FOLDER_NUMBER) THEN - BULL_READ = LAST_THREAD_READ - ELSE - BULL_READ = BULL_POINT - 1 - END IF - CALL OPEN_BULLDIR_SHARED - IER = BULL_READ + 1 - IER1 = .FALSE. - DO WHILE (.NOT.IER1.AND.IER.EQ.BULL_READ+1.AND. - & BULL_READ.LT.F_NBULL) - BULL_READ = BULL_READ + 1 - CALL READDIR(BULL_READ,IER) - IER1 = BTEST(SYSTEM,8) - IF (IER1.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER2,DUMMY,DUMMY) - IER1 = IER2.NE.0 - END IF - END DO - IF (.NOT.IER1) THEN - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - END IF - END IF - - NEXT = .FALSE. - LAST_THREAD = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - LAST_THREAD = THREAD - IF (THREAD) THEN - LAST_THREAD_READ = BULL_READ - LAST_THREAD_NUMBER = FOLDER_NUMBER - END IF - IF (.NOT.SINCE.AND..NOT.NEW - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THEN - IER = 0 - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR. - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN - MSG_NUM = F_NBULL+1 - ELSE - MSG_NUM = BULL_NOW - END IF - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE - CALL GET_THIS_OR_NEXT_TAG - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0 - END IF - END IF - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END IF - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END DO - CALL CLOSE_BULLDIR - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READ - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSE - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0 - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IF - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE. - CALL READDIR(BULL_READ,IER) - END IF - END IF - IF (REMOTE_SET.LT.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - IF (IER.NE.BULL_READ+1) THEN - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0 - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) ! If not, then error out - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - - SAVE_BULL_POINT = BULL_POINT - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(FIRST.OR.NEW.OR.NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEN - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - OK = OK.AND.(.NOT.THREAD.OR.BTEST(SYSTEM,8)) - - IF (.NOT.OK) THEN - BULL_POINT = SAVE_BULL_POINT - BULL_NOW = MSG_NUM - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN - BULL_READ = MSG_NUM - 1 - ELSE - BULL_READ = MSG_NUM + 1 - IF (INCMD(:4).EQ.'FIRS'.OR.FIRST) NEXT = .TRUE. - END IF - IF (REMOTE_SET) CALL CLOSE_BULLFIL - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - ELSE IF (.NOT.THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_NOW) - END IF - IF (BULL_READ.GT.F_NBULL.OR.BULL_READ.LT.F_START) THEN - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - GO TO 50 - END IF - BLOCK = BLOCK_SAVE - END IF - - NEXT = .FALSE. - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (.NOT.THREAD.OR.INCMD(:4).NE.'READ') THEN - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.BULL_READ) - & CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - END IF - END IF - - EDIT = .FALSE. - - PAGE_WIDTH = REAL_PAGE_WIDTH - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN - IF (CLI$PRESENT('EDIT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 9999 - END IF - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTH - PAGE = .FALSE. - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSE - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL - END IF - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:) - END DO - I = TRIM(HEADLINE) - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)) - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - ELSE - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ' - & .AND..NOT.BTEST(SYSTEM,3)) THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROM - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - IF (EDIT) WRITE(3,'(1X)') - ELSE - END = END + 1 - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IF - END IF - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) THEN - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter - GO TO 9999 - END IF - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - -9999 POSTTIME = .FALSE. - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - RETURN - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO - - RETURN - END - - - - - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1 - EQUIVALENCE (INREAD4,INREAD) - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - BULL_POINT_READ = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - - GO TO 12 - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - - BULL_POINT = BULL_POINT_SAVE - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN - ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL FILE(0,.TRUE.,.FALSE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THEN - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THEN - WRITE (6,'(''+B'',$)') - INCMD = 'RESPOND/LIST' - ELSE - GO TO 11 - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')') - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLY - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message', - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),', - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) -1040 FORMAT(' Type P to post reply, U to reply to user,', - & ' B to do both, or other to quit: ',$) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END - - - - - LOGICAL FUNCTION NEWS_FEED() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - I = SLIST + 1 - FLEN = TRIM(FOLDER_DESCRIP) - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN - IF (INDEX(FOLDER_DESCRIP(SLIST:I),'.').GT.0) - & NEWS_FEED = .TRUE. - RETURN - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND. - & FOLDER_DESCRIP(I:I).NE.'@'.AND. - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE - I = FLEN + 2 - END IF - END DO - END IF - - RETURN - END - - - - - LOGICAL FUNCTION MAIL_POST() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NEWS_FEED()) THEN - MAIL_POST = INDEX(FOLDER_DESCRIP,'[').GT.0 - ELSE - MAIL_POST = INDEX(FOLDER_DESCRIP,'<').GT.0 - END IF - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bulletin10.for b/decus/vmslt97a/bulletin/bulletin10.for deleted file mode 100644 index 8c50f12..0000000 --- a/decus/vmslt97a/bulletin/bulletin10.for +++ /dev/null @@ -1,4059 +0,0 @@ -C -C BULLETIN10.FOR, Version 2/27/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - COMMON /HEADER_SEEN/ HEADER_SEEN - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - LAST_LF_SEEN = LF_SEEN - LAST_REAL_LF_SEEN = REAL_LF_SEEN - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - CR_SEEN = INDEX(BUFFER(START_READ:END_READ),CR) - IF (CR_SEEN.GT.0) THEN - IF (END_LINE.GT.0) THEN - IF (CR_SEEN.EQ.END_LINE-2.AND.BUFFER(START_READ+CR_SEEN: - & START_READ+CR_SEEN).EQ.CR) CR_SEEN = CR_SEEN + 1 - ELSE - IF (START_READ+CR_SEEN.EQ.END_READ.AND. - & BUFFER(END_READ:END_READ).EQ.CR) CR_SEEN = 0 - END IF - END IF - IF ((END_LINE.EQ.0.AND.CR_SEEN+START_READ-1.LT.END_READ.AND. - & CR_SEEN.GT.0).OR.CR_SEEN.LT.END_LINE-1) THEN - END_LINE = CR_SEEN - CR_SEEN = 1 - ELSE - CR_SEEN = 0 - END IF - LF_SEEN = END_LINE.GT.0 - IF (END_LINE.GT.257-CR_SEEN.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - IF (.NOT.HEADER_SEEN) END_LINE = 254 - END IF - REAL_LF_SEEN = INDEX(BUFFER(START_READ:END_READ),LF).LE.END_LINE - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - IF (BUFFER(EB:EB).EQ.LF) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - IF (EB.GT.0.OR.LAST_LF_SEEN) RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE(:MIN(LEN(WRITE),256)) - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - NEWS_WRITE = NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - - LOGICAL FUNCTION NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - NEWS_RECONNECT = .FALSE. - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - NEWS_RECONNECT = .TRUE. - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /HEADER/ HEADER - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER().OR.SETPRV_PRIV()) THEN - IF (REMOTE_SET.EQ.4) THEN - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (INPUT(:11).EQ.'Message-ID:') THEN - MESSAGE_ID = INPUT(14:ILEN-1) - ILEN = 0 - END IF - END DO - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - CALL NEWS_POST('cancel',0,IER,SUBJ) - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - DO WHILE (BUFFER(SB:EB).NE.'.'.AND. - & .NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX( - & BUFFER(SB:EB),' ')+SB-2),J,,%VAL(1))) - IF (.NOT.NEWS_READ()) RETURN - END DO - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - STAT = .TRUE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(FROM,TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - HEADER_SEEN = .FALSE. - LF_SEEN = .FALSE. - LAST_LF_SEEN = .FALSE. - REAL_LF_SEEN = .FALSE. - LAST_REAL_LF_SEEN = .FALSE. - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8 - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONE - CHARACTER*4 ZONE - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/ - - CHARACTER*8 TIMES(1) - DATA TIMES /'-5:30'/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - IF (INDEX(ZONES,ZONE)/4.LT.4) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) - END IF - ELSE - HOUR = '00:00' - END IF - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_TI_L(TIME(:2),DATE,,%VAL(1)) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - SENDER_LINE = ' ' - NEWSGROUPS = ' ' - FOLLOWUP = ' ' - LREF = 0 - NEWS2BULL = .FALSE. - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.'.OR..NOT.LAST_REAL_LF_SEEN) - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126) - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(FROM,BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+6).EQ.'Sender:'.AND.EB.GE.SB+8) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+8:EB))+SB+7 - SENDER_LINE = ': '//BUFFER(SB1:EB) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+11).EQ.'Followup-To:'.AND. - & EB.GT.SB+12) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+13:EB))+SB+12 - FOLLOWUP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (INDEX(BUFFER(SB:), - & 'NNTP-Posting-Host:').EQ.1) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - CALL LOWERCASE(BUFFER(SB+19:EB)) - SAMEHOST = STREQ(PATHNAME(2:LPATH),BUFFER(SB+19:EB)) - ELSE IF (INDEX(BUFFER(SB:), - & 'X-Newsreader: News2bull').EQ.1) THEN - NEWS2BULL = .TRUE. - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN - IF (SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = SENDER_LINE(:TRIM(SENDER_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - ELSE - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - CALL GET_FROM(FROM,FROM_LINE(7:),TRIM(FROM_LINE)) - END IF - LAST_FROM = .TRUE. - ELSE - LAST_FROM = .FALSE. - END IF - IF (.NOT.LAST_FROM.AND.SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = 'From'//SENDER_LINE - END IF - END IF - END DO - - NEWS2BULL = NEWS2BULL.AND.SAMEHOST - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'1FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - START = -1 - CALL NEWNEWS(IN_BTIM,IER) - IF (IER.NE.0) START = IER -C -C The following code makes use of the NNTP command NEWNEWS, but is -C known to be slow and buggy in many servers. -C -C IER = SYS$ASCTIM(,TIME,IN_BTIM,) -C CALL DATE_TIME(TIME) -C SKIP = 0 -C DO WHILE (SKIP.GE.0) -C IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( -C & FOLDER_NAME))//' '//TIME)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C IF (BUFFER(:2).EQ.'23') THEN -C IF (.NOT.NEWS_READ()) CALL EXIT -C DO I=1,SKIP -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (FIRST.EQ.'.') RETURN -C DO WHILE (BUFFER(SB:EB).NE.'.') -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) -C & CALL EXIT -C IF (.NOT.NEWS_READ()) CALL EXIT -C IF (BUFFER(:2).EQ.'22') THEN -C IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN -C I = F_NBULL + 1 -C DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. -C & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) -C & .OR.I.GT.F_NBULL)) -C I = I - 1 -C IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN -C IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C END DO -C IF (I.GE.F_START) START = I -C ELSE -C IER = OTS$CVT_TI_L(BUFFER(SB+4: -C & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) -C END IF -C RETURN -C END IF -C END IF -C SKIP = SKIP + 1 -C END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2 - IER = IER1 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - CHARACTER*256 TEMP - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IF - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0 - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE - IER = NEWS_READ() - IF (IER.AND.(BUFFER(SB:EB).NE.'.' - & .OR..NOT.LAST_REAL_LF_SEEN)) THEN - IER = 0 - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THEN - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF ((INDEX(TEMP,': ').EQ.0.AND. - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255).OR. - & (LTEMP.EQ.254.AND..NOT.LAST_LF_SEEN)) THEN - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IF - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IF - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF - ELSE - HEADER_SEEN = .TRUE. - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128 - ELSE - ILEN = 128 - END IF - END IF - ELSE - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ABS(ILEN).EQ.128) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - HEADER_SEEN = .TRUE. - - RETURN - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /READIT/ READIT - - COMMON /NEWS_INIT/ END_READ - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - CHARACTER*64 ALT_SAVE - - DIMENSION DUMMY(4) - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - ALT_SET_SAVE = ALT_SET() - IF (ALT_SET_SAVE) CALL UNSET_ALT - END_READ = 0 - IER = 0 - IF (.NOT.NEWS_LOGIN()) THEN - IER = 2 - IF (.NOT.TEST_ALT(FOLDER1)) RETURN - IER = 1 - END IF - IF (IER.NE.1) CALL NEWS_GROUP(IER) - IF (IER.EQ.1) THEN - IF (TEST_ALT(FOLDER1)) THEN - IER1 = SET_ALT(ALT_FOUND) - IF (IER1) CALL NEWS_GROUP(IER) - IF (.NOT.IER1.OR.IER.NE.0) THEN - CALL UNSET_ALT - IF (ALT_SET_SAVE) IER = SET_ALT(ALT_SAVE) - RETURN - END IF - ALT_SAVE = FOLDER1(INDEX(':',FOLDER1)+1:) - IER = 0 - ELSE IF (ALT_SET_SAVE) THEN - IER = SET_ALT(ALT_SAVE) - END IF - RETURN - END IF - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY) - IF (SYSLOG) THEN - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3)) - END IF - END IF - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUP - - CHARACTER*8 NUMBER - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURN - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1 - RETURN - ELSE IF (ICOUNT.EQ.-1) THEN - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THEN - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURN - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - START = ICOUNT - BULLETIN_NUM = START - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0 - CALL NEWS_HEADER(IER) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - BLOCK = START - MSG_NUM = START - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN - END - - - - SUBROUTINE NEWS_GROUP(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN - IER = 1 - RETURN - END IF - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)) - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT') - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURN - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME - - CHARACTER*28 TIME - - DIMENSION DIFF(2) - - I = 1 - LTIME = TRIM(INTIME) - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:)) - - DO J = 1,2 - I = 1 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-' - END DO - - IF (I.EQ.LEN(TIME)) RETURN - - IF (TIME(I+3:I+3).EQ.' ') THEN - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IF - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DO - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - IF (INDEX(TIME(:I-2),'.').GT.0) THEN - CALL SYS_BINTIM(TIME(:INDEX(TIME(:I-2),'.'))//'00',BTIM) - ELSE IF (TIME(I-4:I-4).EQ.':'.AND.TIME(I-7:I-7).EQ.':') THEN - CALL SYS_BINTIM(TIME(:I-2)//'.00',BTIM) - ELSE - CALL SYS_BINTIM(TIME(:I-2)//':00.00',BTIM) - END IF - - IF (TIME(I:I).EQ.'+'.OR.TIME(I:I).EQ.'-') THEN - IER = SYS_BINTIM('0 '//TIME(I+1:I+2)//':'//TIME(I+3:I+4),DIFF) - IF (IER) THEN - IF (TIME(I:I).EQ.'-') THEN - IER = LIB$SUBX(BTIM,DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,DIFF,BTIM) - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE NEWS_LIST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - COMMON /NEWSLIST/ NEWSLIST - - CHARACTER TODAY*24 - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR. - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER)) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - NEWS_FOLDER1_BBOARD = '::' - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14 - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNT - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1 - IF (IER.EQ.0.AND.IER1.EQ.0) - & NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) ! Old bug caused this. - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)// - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - END IF - IF (FLEN.LE.44.OR.FLEN-44+EB-SP+1.LT. - & LEN(NEWS_FOLDER1_DESCRIP)) THEN - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - END IF - ELSE - CALL UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - OPEN (UNIT=33,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',SHARED) - - DO WHILE (IER.EQ.0) - READ (33,'(A)',IOSTAT=IER) INPUT - IF (IER.EQ.0) THEN - FLEN = INDEX(INPUT,':')-1 - NEWS_FOLDER1 = INPUT(:FLEN) - IF (SET_ALT(INPUT(FLEN+2:))) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER1) - IF (IER1.NE.0) THEN - FOLDER1_DESCRIP = NEWS_FOLDER1 - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = INPUT(45:FLEN) - ELSE - NEWS_FOLDER1_DESCRIP = ' ' - END IF - END IF - CALL NEWS_GROUP(IER) - IF (IER.EQ.0) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - IF (IER1.NE.0) THEN - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - ELSE - CALL UPDATE_NEWS_ENTRY(.FALSE.,LOCAL_UPDATE,FLEN,0) - END IF - END IF - END IF - END IF - IF (IER.NE.0) CLOSE (UNIT=33) - IF (ALT_SET()) THEN - CALL UNSET_ALT - IF (.NOT.NEWS_LOGIN()) RETURN - END IF - END DO - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.1.AND.TEST_ALT(NEWS_FOLDER1// - & NEWS_FOLDER1_DESCRIP)) THEN - IER = 0 - ELSE IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.F1_START.AND. - & NEWS_F1_FIRST.GT.F1_NBULL) THEN - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE), - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (((F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND..NOT.BTEST(NEWS_F1_FLAG,8)) THEN - DELETE (UNIT=7) - IER = 0 - ELSE IF (IER.EQ.1) THEN - IF (NEWS_F1_NBULL.LT.NEWS_F1_START - & .OR.NEWS_F1_START.EQ.0) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(NEWS_F1_START,IER1) - CALL CLOSE_BULLDIR - IER1 = NEWS_F1_START+1.EQ.IER1 - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - IF (.NOT.IER1) DELETE (UNIT=7) - END IF - IER = 0 - END IF - END IF - END DO - END IF - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - NEWSLIST = .FALSE. - - IF (SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED')) CALL RECOUNT - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DO - - RETURN - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4 - - COMMON /LOCALPOST/ LOCAL_POST - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /TEMP_INPUT/ GROUP_TEMP - CHARACTER GROUP_TEMP*256 - - COMMON /HEADER/ HEADER - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER RESPONSE*4 - - CHARACTER TODAY*24,UNAME*132 - DATA UNAME /'()'/ - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /NEWS2BULL/ NEWS2BULL - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1) - IF (IER1.NE.0) RETURN - ELSE - REWIND (UNIT=3) - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900 - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3) - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSE - I = INDEX(NEWS_MSGID,'.') - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & NEWS_MSGID(:I-1)// - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256) - IF (IER.NE.0) RETURN - LOCAL_POST = .TRUE. - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1 - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP - ELSE IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - IF (TRIM(FOLLOWUP).EQ.0) THEN - INPUT = 'Newsgroups: '//NEWSGROUPS - IF (INDEX(NEWSGROUPS,',').GT.0) THEN - WRITE (6,'('' Warning: Original message was cross'', - & ''posted to the following news groups:'')') - DO I=1,TRIM(NEWSGROUPS),PAGE_WIDTH - WRITE (6,'(1X,A)') NEWSGROUPS(I: - & I-1+MIN(PAGE_WIDTH,TRIM(NEWSGROUPS(I:)))) - END DO - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Type Y if you want your reply crossposted also, '// - & 'N for no: (default = Y) ') - IF (RESPONSE(:1).EQ.'n'.OR.RESPONSE(:1).EQ.'N') THEN - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - END IF - ELSE - INPUT = 'Newsgroups: '//FOLLOWUP - END IF - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE.AND. - & .NOT.NEWS_FEED()) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER) - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0 - DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP)) - IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP) - DO WHILE (TRIM(GROUP_TEMP).GT.0) - COMMA = INDEX(GROUP_TEMP,',') - IF (COMMA.GT.0) THEN - FOLDER1_NAME = GROUP_TEMP(1:COMMA-1) - GROUP_TEMP = GROUP_TEMP(COMMA+1:) - ELSE - FOLDER1_NAME = GROUP_TEMP - GROUP_TEMP = ' ' - END IF - CALL LOWERCASE(FOLDER1_NAME) - FLEN = TRIM(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1) - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9) - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND. - & INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND. - & INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST), - & GROUP_LIST,FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - ELSE - WRITE (6,'(1X,A,'' is not a valid news group.'')') - & FOLDER1_NAME(:FLEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to specify it? (default = Y) ') - IF (RESPONSE(:1).NE.'n'.AND. - & RESPONSE(:1).NE.'N') THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - END IF - END IF - END DO - END DO - CALL CLOSE_BULLNEWS - END IF - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900 - END IF - ATSIGN = INDEX(PATHNAME,'@') - PCSIGN = INDEX(PATHNAME,'%') - CALL LOWERCASE(USERNAME) - IF (FILENAME.EQ.'cancel'.AND.SUBJECT(:6).EQ.'CanceL') THEN - IF (.NOT.NEWS_WRITE('Path: cyberspam!usenet')) GO TO 900 - ELSE - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - END IF - END IF - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME) - - IF (FILENAME.NE.'cancel') THEN - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - END IF - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED').AND. - & SYS_TRNLNM('MX_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED').AND. - & SYS_TRNLNM('PMDF_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MULTINET_ROOT','DEFINED').AND. - & SYS_TRNLNM('MULTINET_SMTP_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - CALL STR$UPCASE(FROM_LINE,FROM_LINE) - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME) - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (SENDER_LINE.NE.' ') THEN - IF (.NOT.NEWS_WRITE(SENDER_LINE(:TRIM(SENDER_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE(FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - ELSE - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ILEN = TRIM(INPUT) - IF (INPUT(:5).EQ.'From:') THEN - GROUP_TEMP = INPUT - ELSE IF (INPUT(:7).EQ.'Sender:') THEN - GROUP_TEMP = 'From:'//INPUT(8:) - ILEN = 0 - END IF - END DO - ILEN = TRIM(GROUP_TEMP) - IF (ILEN.NE.0) THEN - IF (.NOT.NEWS_WRITE(GROUP_TEMP(:ILEN))) RETURN - END IF - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - - IF (FILENAME.EQ.'cancel'.AND.SUBJECT(:6).EQ.'CanceL') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel ')) GO TO 900 - ELSE IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'// - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE IF (TRIM(SUBJECT).EQ.0) THEN - IF (.NOT.NEWS_WRITE('Subject: (none)')) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECT - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) - & GO TO 900 - END IF - - IF (NGROUPS.GT.0) THEN - FROM = USERNAME - DESCRIP = SUBJECT - END IF - - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//PATHNAME(:LPATH)//'>')) GO TO 900 - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION) - END IF - LORGAN = TRIM(ORGANIZATION) - END IF - - IF (FILENAME.NE.'cancel'.AND.LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN))) - & GO TO 900 - END IF - - IF (.NOT.USE_INFROM.OR.COMPARE_DATE(TODAY(:11),DATE).GT.13) THEN - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & ZONE(:LZONE))) GO TO 900 - ELSE - TODAY = DATE(:2)//' '//DATE(4:6)//' '//DATE(10:) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & TIME(:8)//' '//ZONE(:LZONE))) GO TO 900 - END IF - - INPUT_HEADER = .FALSE. - - IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel')) THEN - EXPR = NEWS_FEED().OR.USE_INFROM - IF (.NOT.EXPR) EXPR = CLI$PRESENT('EXPIRATION') - IF (EXPR) THEN - I = INDEX(EXDATE,'-') - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE( - & FIRST_ALPHA(EXDATE):2) - & //' '//EXDATE(I+1:I+3)//' '//EXDATE(I+7:TRIM(EXDATE)) - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900 - ELSE IF (REMOTE_SET.EQ.4) THEN - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT) - END IF - EXTIME = '00:00:00.00' - END IF - IF (.NOT.NEWS_FEED()) THEN - IF (CLI$GET_VALUE('FOLLOWUP',GROUP_TEMP)) THEN - CALL LOWERCASE(GROUP_TEMP) - IF (.NOT.NEWS_WRITE('Followup-To: ' - & //GROUP_TEMP(:TRIM(GROUP_TEMP)))) GO TO 900 - END IF - END IF - END IF - - IF (CREATE) THEN - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURN - END IF - - IF (NEWS_FEED().OR.NEWS2BULL) THEN - IF (.NOT.NEWS_WRITE('X-Newsreader: News2bull')) GO TO 900 - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (SUBJECT(:6).EQ.'CanceL') THEN - IF (.NOT.NEWS_WRITE('Control: cancel ')) RETURN - ELSE IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - END IF - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (SUBJECT(:6).EQ.'CanceL') THEN - IF (SUBJECT.EQ.'CanceL') THEN - WRITE (6,1055) - ILEN = LINE_LENGTH + 1 ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - IF (.NOT.NEWS_WRITE(INPUT(:ILEN))) RETURN - END IF - END DO - ELSE - IF (.NOT.NEWS_WRITE(SUBJECT(7:TRIM(SUBJECT)-6))) RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).EQ.'240') IER = 0 - ELSE - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - CALL STR$UPCASE(USERNAME,USERNAME) - LOCAL_POST = .FALSE. - RETURN - END IF - - IF (.NOT.INPUT_HEADER) THEN - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2 - END IF - IF (IER1.EQ.0) THEN - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DO - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') THEN - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:MIN(79+SB,EB)) - IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN - WRITE (6,'('' Use /INDENT to change indentation'',$)') - WRITE (6,'(''+ character. See Manager for permanent'',$)') - WRITE (6,'(''+ change.'')') - END IF - END IF - ELSE - LENGTH = (LENGTH+127)/128 - GROUP_LIST = GROUP_LIST1 - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - SAVE_BULL_POINT = BULL_POINT - OLD_NBULL = NBULL - DO I=NGROUPS,1,-1 - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1) - FOLDER_NUMBER = -1 - OLD_NBULL = NBULL - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL ADD_LOCAL_NEWS(8) - CALL ADD_TAG(IER,2) - IF (NEWS_FIND_SUBSCRIBE().LT.FOLDER_MAX) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER1) - IF (IER1.EQ.0.OR.IER1.EQ.OLD_NBULL+1) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(OLD_NBULL+1) - END IF - END IF - END IF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - BULL_POINT = SAVE_BULL_POINT - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - CALL STR$UPCASE(USERNAME,USERNAME) - - LOCAL_POST = .FALSE. - -1055 FORMAT(' State reason for deleting message not owned by you:') - - RETURN - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURN - END IF - END IF - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME) - LPATH = TRIM(PATHNAME) - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NAME - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME) - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE. - END DO - - TEST_NEWS = MAYBE_NEWS - - RETURN - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) RETURN - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULL - FIRST = F1_START - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - REMOTE_SET = 3 - CALL OPEN_BULLDIR_SHARED - I = F_LAST + 1 - IER = I - 1 - DO WHILE (I.NE.IER.AND.I.LE.LAST) - CALL READDIR(I,IER) - I = I + 1 - END DO - CALL CLOSE_BULLDIR - CALL OTS$CVT_L_TI(I-1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNT - NEW_NEWS_F_END = NEWS_F_END - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - F_LAST = LAST - NEWS_F_FIRST = FIRST - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE NEWS2BULL(RECLAIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - DATA BULLCP_NEWS /.FALSE./ - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBER - - DIMENSION NOW(2) - - BULLCP_NEWS = .TRUE. - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV - - CALL DELETE_EXPIRED_NEWS(RECLAIM) - - IF (RECLAIM) CALL EXIT - - CALL SEND_POST - IF (ALT_SET()) CALL UNSET_ALT - - CALL NEWS_LIST - - CALL UPDATE_LOCAL_NEWS - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - IF (NEWS_FEED()) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARD - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (IER) THEN - SAVE_LAST = F_LAST - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER) - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN - SAVE_LAST = F_NBULL - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LAST - FOLDER_BBOARD = 'NONEFEED' - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - IF (FOLDER_BBOARD.EQ.'NONEFEED') THEN - CALL SETUSER('SYSTEM') - ELSE - CALL SETUSER(FOLDER_BBOARD) - END IF - REMOTE_SET = 3 - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/LOCAL/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1) - END IF - CALL CLOSE_BULLFOLDER - CALL SETUSER(USERNAME) - END IF - END IF - END DO - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - CHARACTER*(*) TIME - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+ - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)// - & TIME(16:17)//TIME(19:20) - - RETURN - END - - - - SUBROUTINE ALLPRIV - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1 - PROCPRIV(2) = -1 - NEEDPRIV(1) = -1 - NEEDPRIV(2) = -1 - - RETURN - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COM - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - RETURN - END - - - - SUBROUTINE SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')') - RETURN - END IF - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE - WRITE (6,'('' You are now subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - CALL UPDATE_USERINFO - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - LAST_NEWS_READ(2,J) = F_START - 1 - ELSE - LAST_NEWS_READ2(2,J) = 0 - LAST_NEWS_READ(2,J) = F_NBULL - END IF - CALL CLOSE_BULLNEWS - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - CALL UPDATE_USERINFO_NEWS_ALWAYS - RETURN - END IF - END DO - - END - - - - - - SUBROUTINE UNSUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_EXPIRED - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.LE.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Folder is permanent and cannot not be'', - & '' unsubscribed.'')') - RETURN - END IF - - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - CALL UPDATE_USERINFO - - I = NEWS_FIND_SUBSCRIBE() - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - - CALL FREE_TAGS(I) - - IF (NINCLUDE.GT.0) WRITE (6,'('' Note: Excludes and/or '', - & ''threads exist for this group.'')') - - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - CALL UPDATE_USERINFO_NEWS_ALWAYS - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (IER.EQ.0) IER = 1 ! None read yet. - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE1() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR.(LAST_NEWS_READ(2,I) - & .GT.NEWS_F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0 - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THEN - COUNT = COUNT + 1 - END IF - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT) - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE - SUBNUM = 0 - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES) -C -C SUBROUTINE NEWS_NEW_NOTIFICATION -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - MESSAGES = .FALSE. - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1 - - FOLDER_DESCRIP = ' ' - REORDER = 0 - DO WHILE (SUBNUM.GT.0) - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUM - UNLOCK 7 - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1 - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - ELSE IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR. - & F_START.GT.F_NBULL) THEN - IER = 1 - END IF - END IF - IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (DIFF.GT.0) IER = 1 - END IF - END IF - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - ELSE - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IF - END IF - END DO - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE - - CALL CLOSE_BULLNEWS - - RETURN - END - - - SUBROUTINE REORDER_SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0) - I = I + 1 - END DO - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1 - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1) - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2 - TEMP = LAST_NEWS_READ(L,J) - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K) - LAST_NEWS_READ(L,K) = TEMP - END DO - END IF - END DO - END DO - - RETURN - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE = I - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE1 = I - - RETURN - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - IP = 1 - DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER - & .AND.IP.LE.FOLDER_MAX-1) - IP = IP + 1 - END DO - - IER = .TRUE. - - IF (IP.EQ.FOLDER_MAX) THEN - PERM = .FALSE. - IP = 1 - ELSE - PERM = .TRUE. - END IF - - IF (NOTIFY.EQ.0) THEN - IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).AND. - & .NOT.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (BTEST(INF_REC2(2,IP),14)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - END IF - - IF (BTEST(INF_REC2(2,IP),15)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - END IF - END IF - - CALL UPDATE_USERINFO - - RETURN - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - REWIND UNIT - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '// - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK) - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6, - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) - END IF - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1 - SYSTEM = 0 - CALL ADD_ENTRY - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE UPDATE_NEWS_FOLDER -C -C SUBROUTINE UPDATE_NEWS_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1 - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_EX_BTIM_KEY - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE SEND_POST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - CHARACTER FILE*132 - - C = 0 - - IF (.NOT.NEWS_LOGIN()) RETURN - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST',FILE,C)) -50 IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'340') RETURN - - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (INPUT(:5).EQ.'From:') BULL_PARAMETER = INPUT(7:) - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IF - END DO - IF (INPUT.NE.'.') THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - IF (BUFFER(:3).EQ.'441'.AND..NOT.ALT_SET()) THEN - REWIND (UNIT=3) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0.AND.INPUT(:12).EQ.'Newsgroups: ') THEN - CLOSE (UNIT=3) - IF (TEST_ALT(INPUT(13:))) THEN - CALL SET_ALT(ALT_FOUND) - GOTO 50 - END IF - IER = 2 - END IF - END DO - CLOSE (UNIT=3) - END IF - IF (BUFFER(:3).NE.'240') THEN - CLOSE (UNIT=3) - CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER) - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - END IF - CLOSE (UNIT=3,STATUS='DELETE') - IF (ALT_SET()) CALL UNSET_ALT - END DO - -100 CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVS - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST) - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - - IF (UNAME.EQ.'()') THEN - UNAME = ' ' - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IF - - RETURN - END - - - - SUBROUTINE RECOUNT -C -C SUBROUTINE RECOUNT -C -C FUNCTION: -C -C Fixes the message count of stored news groups. This may become wrong -C if old copies of some of the database files are used with newer versions. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - REMOTE_SET = 4 - - DO WHILE (IER.EQ.0) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - END DO - - IF (BTEST(NEWS_F_FLAG,8).AND.IER.EQ.0) THEN - CALL NEWS_TO_FOLDER - - CALL OPEN_BULLDIR_SHARED - - NUM = F_START - F_COUNT = 0 - - IF (F_START.GT.0) THEN - CALL READDIR(NUM,IER) - NEXT = .TRUE. - F_START = NUM - DO WHILE (NUM+1.EQ.IER) - F_COUNT = F_COUNT + 1 - NUM = NUM + 1 - IF (NUM.LE.F_NBULL) CALL READDIR(NUM,IER) - END DO - NEXT = .FALSE. - - F_NBULL = NUM - 1 - END IF - - CALL CLOSE_BULLDIR - - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - - CALL DELLNM('BULL_NEWS_RECOUNT') - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE DELLNM(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$SYSTEM',LOG,PSL$C_SUPER) - - RETURN - END - - - SUBROUTINE DELLNM_USER(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$PROCESS',LOG,PSL$C_USER) - - RETURN - END - - - SUBROUTINE NEWNEWS(SINCE_BTIM,FOUND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - DIMENSION SINCE_BTIM(2) - - START = F_START - END = F_NBULL - - FOUND = 0 - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - IF (.NOT.NEWS_READ()) RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (FOUND.EQ.0) THEN - L = INDEX(BUFFER(SB:EB),' ') - CALL OTS$CVT_TI_L(BUFFER(SB:SB+L-2),IER,,%VAL(1)) - CALL NEWS_TIME(BUFFER(SB+L:EB),MSG_BTIM) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) - & FOUND = IER - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (FOUND.NE.0) THEN - IF (.NOT.OTS$CVT_L_TI(FOUND,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END.AND.FOUND.EQ.0) - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) FOUND = MSG_NUM - I = I + 1 - IF (REMOTE_SET.EQ.3.AND.I.LE.END.AND.FOUND.EQ.0) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - IF (FOUND.EQ.0) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - - RETURN - END - - - - LOGICAL FUNCTION TEST_ALT(FOLDER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - CHARACTER*(*) FOLDER1 - - TEST_ALT = .FALSE. - - OPEN (UNIT=3,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',SHARED) - - IF (IER.NE.0) RETURN - - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) ALT_FOUND - IF (STREQ(ALT_FOUND(:INDEX(ALT_FOUND,':')-1), - & FOLDER1(:TRIM(FOLDER1)))) THEN - ALT_FOUND = ALT_FOUND(INDEX(ALT_FOUND,':')+1:) - CLOSE (UNIT=3) - TEST_ALT = .TRUE. - RETURN - END IF - END DO - - CLOSE (UNIT=3) - - RETURN - END - - - - LOGICAL FUNCTION SET_ALT(NEWALT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NEWALT - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - DATA SETALT/.FALSE./ - - SET_ALT = .FALSE. - - IF (SETALT) THEN - IF (NEWALT.EQ.ALT) THEN - SET_ALT = .TRUE. - RETURN - ELSE - CALL UNSET_ALT - END IF - END IF - - CALL NEWS_LOGOUT - - CALL CRELNM('BULL_NEWS_SERVER',NEWALT(:TRIM(NEWALT))) - - IF (NEWS_LOGIN()) THEN - SET_ALT = .TRUE. - SETALT = .TRUE. - ALT = NEWALT - ELSE - CALL DELLNM_USER('BULL_NEWS_SERVER') - SETALT = .FALSE. - END IF - - RETURN - END - - - - SUBROUTINE UNSET_ALT - - IMPLICIT INTEGER (A-Z) - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - CALL DELLNM_USER('BULL_NEWS_SERVER') - - CALL NEWS_LOGOUT - - SETALT = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALT_SET() - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - ALT_SET = SETALT - - RETURN - END - - - - SUBROUTINE ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION EXPIRED(2) - - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLEN - NEWS_F1_COUNT = NEWS_F_COUNT - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN - NEWS_FOLDER = NEWS_FOLDER(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - NEWS_F_COUNT = NEWS_F1_COUNT - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - IF (IER2.EQ.0) THEN - NEWS_F1_FLAG = NEWS_F_FLAG - NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN - NEWS_F1_EXPIRE = NEWS_F_EXPIRE - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1) - IF (BTEST(NEWS_F1_FLAG,8)) THEN - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_LAST = 0 - END IF - - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE. - IF (SP.GT.0) THEN - IF (FLEN.GT.44) THEN - IF (NEWS_FOLDER1_DESCRIP.NE. - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE - UPDATE = .TRUE. - END IF - IF (SPECIAL) THEN - IF (UPDATE) THEN - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF - ELSE IF (.NOT.UPDATE) THEN - UPDATE = F1_START.LT.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bulletin11.for b/decus/vmslt97a/bulletin/bulletin11.for deleted file mode 100644 index bcaae91..0000000 --- a/decus/vmslt97a/bulletin/bulletin11.for +++ /dev/null @@ -1,3536 +0,0 @@ -C -C BULLETIN11.FOR, Version 4/5/97 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('CURRENT')) THEN - MESSAGE_NUMBER = BULL_POINT - ELSE IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - IF (.NOT.BULL_NEWS_TAG) RETURN - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*12 BULL_MARK_DIR - CHARACTER*12 TAG_KEY,INPUT_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,) - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1) - ELSE - UNLOCK 13 - END IF - END IF - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - ELSE - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - BULL_NEWS_TAG = .FALSE. - RETURN - END IF - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),) - IF (IER1.NE.0) THEN - CLOSE (UNIT=23) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=128,DISPOSE='DELETE', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1) - NEWS_MARK2(1) = NEWS_MARK2(2) - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE') - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - CALL ERRSNS(IDUMMY,IER2) - IF (IER2.NE.RMS$_RNF) SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURN - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1), - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IF - - RETURN - END - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - - CHARACTER*12 BULL_MARK_DIR - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSE - MARKUNIT = 23 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1 - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEY - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IF - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY) - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURN - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - TAG_TYPE = 0 - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR. - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN - IF (IER.EQ.0) UNLOCK 13 - IER = 0 - MESSAGE = MSG_NUM - ELSE - IER = 36 - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - IER = 36 - - HEADER = .FALSE. - - TAG_TYPE = 0 - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) THEN - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:) - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THEN - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I) - IER = 0 - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - MSG_KEY = NEXT_MSG_KEY - RETURN - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DO - - RETURN - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - DO MESSAGE = MSG_NUM+1,F_NBULL - CALL READDIR(MESSAGE,IER) - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE) - IF (IER.EQ.0) THEN - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END DO - - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2) - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURN - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER) - & INPUT_KEY - END DO - - CLOSE_IT = .FALSE. - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - CALL DECREMENT_MSG_KEY - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR_SHARED - CLOSE_IT = .TRUE. - END IF - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - DELETE (UNIT=13) - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER)) - READ (13,IOSTAT=IER) INPUT_KEY - END DO - END IF - END IF - - END DO - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE. - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1 - DO M=1,2 - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1 - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1 - LIMIT = 256/(NEWS_FORMAT+1) - NEWS_NUMBER = LAST_NEWS_READ2(1,I) - K = 5-NEWS_FORMAT*2 - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1 - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IF - SET_LIST = .FALSE. - END IF - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0) - END DO - K = LIMIT + 1 - END IF - IF (K.GT.LIMIT) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2 - NEWS_REC = NEWS_REC + 1 - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - IF (IER.EQ.0) THEN - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IF - END DO - END IF - END DO - END DO - CLOSE (UNIT=23) - END IF - - RETURN - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = J - ELSE - NEWS_MARK(I) = J - END IF - - RETURN - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG) - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUM - NEWS_TAG(I) = 0 - END DO - - RETURN - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - DO I=1,2 - IF (NEWS_TAG(3,I,ISUB).GT.0) THEN - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB)) - NEWS_TAG(3,I,ISUB) = 0 - NEWS_NUMBER = NEWS_FOLDER_NUMBER - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER) - END IF - END DO - IF (IER.EQ.0) UNLOCK 23 - END IF - - DO J=I,FOLDER_MAX-2 - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J)) - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0 - END DO - END DO - - RETURN - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY - - IER = 36 - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE) - IF (IER.EQ.0) THEN - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THEN - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM) - END IF - IER = 36 - END IF - END IF - END DO - BULL_READ = MSG_NUM - IF (CLOSE_IT) CALL CLOSE_BULLDIR - ELSE - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0 - MSG_KEY = BULLDIR_HEADER - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THEN - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36 - END IF - END IF - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*24 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - SUBROUTINE SENDMAIL(FILE,TO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE '($MAILDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - CHARACTER*(*) FILE,TO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1)) - - CALL DISABLE_PRIVS - - SENDTO = TO - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))// - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:) - END DO - - IF (USE_INFROM.AND.(SYS_TRNLNM('TWF$TCP','DEFINED').OR. - & SYS_TRNLNM('MULTINET_SOCKET_LIBRARY','DEFINED').OR. - & SYS_TRNLNM('UCX$DEVICE','DEFINED')) - & .AND..NOT.SYS_TRNLNM('BULL_DISABLE_SMTP','DEFINED')) THEN - IER = SYS$ASCTIM(,INPUT,,) - INPUT = INPUT(:2)//INPUT(4:6)//INPUT(10:11)// - & INPUT(13:14)//INPUT(16:17)//INPUT(19:20)// - & INPUT(22:23) - IF (INPUT(:1).EQ.' ') INPUT = INPUT(2:) - OPEN (UNIT=8,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & INPUT(:TRIM(INPUT))//'.SMTP',IOSTAT=IER1, - & STATUS='NEW',RECL=256) - IF (IER1.EQ.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - WRITE (8,'(A)',IOSTAT=IER) 'helo '//PATHNAME(:LPATH) - INPUT = INFROM - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - END IF - WRITE (8,'(A)',IOSTAT=IER) 'MAIL FROM:<'// - & INPUT(:TRIM(INPUT))//'>' - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - WRITE (8,'(A)',IOSTAT=IER) 'RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>' - WRITE (8,'(A)',IOSTAT=IER) 'DATA' - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - WRITE (8,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER) - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.EQ.0) THEN - WRITE (8,'(A)',IOSTAT=IER) INPUT(:L) - END IF - END DO - CLOSE (UNIT=3) - REWIND (UNIT=8,IOSTAT=IER) - IF (IER.NE.0) THEN - CLOSE (UNIT=8,STATUS='DELETE') - IER1 = 2 - END IF - END IF - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('helo '//PATHNAME(2:LPATH)//CRLF)) - & GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - INPUT = INFROM - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - END IF - IF (.NOT.SMTP_WRITE_PACKET('MAIL FROM:<'//INPUT(:TRIM(INPUT)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - IF (.NOT.SMTP_WRITE_PACKET('RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('DATA'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:TRIM(INPUT))//CRLF)) - & GOTO 10 - END DO - IF (NHEAD.GT.0.AND..NOT.SMTP_WRITE_PACKET(CRLF)) GOTO 10 - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER2) - DO WHILE (IER2.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER2) L,INPUT - IF (IER2.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) IER2 = 2 - END IF - END DO - CLOSE (UNIT=3) - IF (IER2.EQ.2) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IER2 = 1 - GOTO 20 -10 IER2 = 2 -20 CALL SMTP_DISCONNECT() - IF (IER1.EQ.0) THEN - IF (IER2) THEN - CLOSE (UNIT=8,STATUS='DELETE') - ELSE - CLOSE (UNIT=8) - END IF - END IF - CALL ENABLE_PRIVS - STATUS = 1 - RETURN - END IF - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR) - - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO)) - I = INDEX(SENDTO(J:),',') - 1 - IF (I.EQ.-1) I = TRIM(SENDTO(J:)) - CALL INIT_ITMLST - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - J = J + I - IF (SENDTO(J:J).EQ.',') J = J + 1 - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO)) - CALL END_ITMLST(ATTRIBUTE_ITMLST) - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - CALL LIB$REVERT - - RETURN - END - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,) - - RETURN - END - - - - - SUBROUTINE SET_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEXT/ NEXT - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DIMENSION EXPIRED(2) - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IF - - ENTRY SHOW_NEWS - - LIMIT = -2 - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1)) - IF (.NOT.IER.OR.LIMIT.LT.-1) THEN - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')') - RETURN - END IF - END IF - - EXPIRE = -1 - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1)) - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN - END IF - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR. - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')') - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - IF (CLI$PRESENT('DEFAULT')) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1 - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - RETURN - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE) - FOLDER1_NUMBER = NEWS_F1_COUNT - FOLDER1 = BULL_PARAMETER - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10) - CALL WRITE_FOLDER_FILE_TEMP(IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMP - REWRITE (7) NEWS_FOLDER1_COM - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER) - END IF - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - END IF - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS') - DEFAULT = CLI$PRESENT('DEFAULT') - ALL = CLI$PRESENT('ALL') - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE') - ENABLE = CLI$PRESENT('ENABLE') - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - - STORED = 0 - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN - WRITE (6,'('' Stored setting was not removed.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'[.BULLNEWS*]*.*;*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_SAVE = FOLDER - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - FOLDER = FOLDER_SAVE - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0 - F1_NBULL = 0 - F1_COUNT = 0 - F1_LAST = 0 - END IF - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3) - IF (IER.NE.0) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - END IF - CALL RESET_PROTECTION - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IF - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THEN - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')') - ELSE - WRITE (6,'('' Default is not stored.'')') - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS) THEN - WRITE (6,'('' Expiration is DEFAULT value.'')') - ELSE - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Default expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no default expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')') - ELSE - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - NOTIFY_FLAG_NEWS = .FALSE. - SET_FLAG_NEWS = .FALSE. - BRIEF_FLAG_NEWS = .FALSE. - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a default news group.'')') - ELSE - IER1 = 2 - END IF - END IF - NOTIFY_PERM_FLAG_NEWS = .FALSE. - SET_PERM_FLAG_NEWS = .FALSE. - BRIEF_PERM_FLAG_NEWS = .FALSE. - DO WHILE (REC_LOCK(IER2)) - READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC - END DO - IF (IER2.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a permanent news group.'')') - END IF - END IF - PERM = .FALSE. - IF (SET_FLAG_NEWS) THEN - IF (BRIEF_FLAG_NEWS) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE IF (BRIEF_FLAG_NEWS) THEN - IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - IF (.NOT.PERM) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (BRIEF_PERM_FLAG_NEWS.AND..NOT.SET_PERM_FLAG_NEWS) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (NOTIFY_FLAG_NEWS) THEN - IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' NOTIFY is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLINF - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IF - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER) - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) - END IF - FOUND = .FALSE. - MODALL = INDEX(GROUP,'.').NE.LG - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR. - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.')) - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER) - END DO - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER) - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - RETURN - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - END DO - END IF - - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - ALL = CLI$PRESENT('ALL') - FULL = CLI$PRESENT('FULL') - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (CLI$PRESENT('SUBJECT')) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IF - ELSE - INPUT = FROM - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:) - ELSE - INPUT = DESCRIP - END IF - END IF - LEN_P = TRIM(INPUT) - CALL CLOSE_BULLFIL - END IF - - SUB = CLI$PRESENT('SUBJECT') - DISABLE = CLI$PRESENT('DISABLE') - EXC = 0 - - GO TO 5 - - ENTRY INCLUDE_SUBJECT(EXCLUDE) - - IF (REMOTE_SET.GE.3.AND.NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) RETURN - - LEN_P = TRIM(INPUT) - ALL = .FALSE. - DISABLE = .FALSE. - SUB = .TRUE. - EXC = -1 - -5 IF (SUB) THEN - IF (DISABLE) THEN - IF (STREQ(INPUT(:3),'RE:')) INPUT = INPUT(5:) - INPUT = INPUT(:MIN(LEN_P,LEN(DESCRIP))) - LEN_P = TRIM(INPUT) - END IF - INPUT = 'SUBJECT:'//INPUT - LEN_P = LEN_P + 8 - ELSE - INPUT = 'FROM:'//INPUT - LEN_P = LEN_P + 5 - END IF - - IF (EXCLUDE) THEN - INPUT = ':exclude:'//INPUT - LEN_P = LEN_P + 9 - ELSE - INPUT = ':include:'//INPUT - LEN_P = LEN_P + 9 - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - FLEN = TRIM(FOLDER_NAME) - INPUT = FOLDER_NAME(:FLEN)//INPUT - ILEN = FLEN + LEN_P - - IF (EXC.EQ.0) THEN - EXC = -1 - IER = CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P) - IF (IER) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) EXC - IF (EXC.LT.0.OR.EXC.GT.999.OR.IER.NE.0) THEN - WRITE(6,'('' ERROR: Valid limit is 0-999.'')') - RETURN - END IF - END IF - END IF - - CHECK_ONLY = .FALSE. - - GO TO 100 - - ENTRY CHECK_EXCLUDES - - CHECK_ONLY = .TRUE. - DISABLE = .TRUE. - LEN_P = 0 - INPUT = ' ' - ILEN = 1 - -100 IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) THEN - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - CLOSE (UNIT=4,DISPOSE='SAVE') - RETURN - END IF - - IER = 0 - CONVERT = .FALSE. - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - I = STRFIND(OLD_BUFFER,':RE: ') - IF (IER.EQ.0) THEN - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THEN - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5) - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill' - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF ((STREQ(OLD_BUFFER(:ILEN),INPUT(:ILEN)).AND. - & OLD_BUFFER(ILEN+1:ILEN+1).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:OLEN),INPUT(:OLEN))).OR. - & (DISABLE.AND.I.GT.0.AND. - & ((STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:MAX(I+5,ILEN+4)), - & INPUT(:ILEN)).AND.OLD_BUFFER(ILEN+5:ILEN+5).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:OLEN), - & INPUT(:OLEN)))))) THEN - CONTINUE - ELSE IF (.NOT.(ALL.AND.STREQ(INPUT(:FLEN+8), - & OLD_BUFFER(:MIN(FLEN+8,OLEN))))) THEN - IER2 = OLD_BUFFER(:1).EQ.':'.OR. - & INDEX(OLD_BUFFER,':defaults:').GT.0 - IF (.NOT.IER2) THEN - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC1,BLIMIT,BDATE,IER1) - IF (IER1) IER2 = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1) - & ,' ').GT.-EXC1 - CONVERT = .NOT.IER1 - END IF - IF (.NOT.IER1.OR.EXC1.EQ.0.OR.IER2) - & WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN) - END IF - END IF - END DO - - IF (.NOT.DISABLE) THEN - IF (FULL) THEN - WRITE (4,'(A)',IOSTAT=IER) FOLDER_NAME(:FLEN)//':defaults:kill' - ELSE - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - - IF (CONVERT) THEN - WRITE (6,'('' NOTE: See help on the new SET EXLIMIT command.'')') - END IF - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - SUBROUTINE UPDATE_EXCLUDE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - DATA SCRATCH_B1/0/,NINCLUDE/0/,EXC_CHANGED/.FALSE./ - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - IF (.NOT.EXC_CHANGED) RETURN - EXC_CHANGED = .FALSE. - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (.NOT.(IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ. - & INPUT(:MIN(TRIM(FOLDER_NAME)+1,ILEN)).AND.INPUT(:1).NE.':' - & .AND.INDEX(INPUT,':defaults:').EQ.0)) THEN - IF (IER.EQ.0) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE SET_CUSTOM(PARAM) -C -C SUBROUTINE SET_CUSTOM -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - CHARACTER*(*) PARAM - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IF - - LENP = LEN(PARAM) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0.AND.PARAM(:LENP).NE.INPUT(2:LENP+1)) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - IF (CLI$GET_VALUE('SET_PARAM2',INPUT,ILEN)) THEN - WRITE (4,'(A)',IOSTAT=IER) ':'//PARAM(:LENP)//':'//INPUT(:ILEN) - END IF - - IF (PARAM.EQ.'exclude_limit') - & DECODE(ILEN,'(I)',INPUT(:ILEN)) EXCLUDE_LIMIT - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - DIMENSION BTIM(2) - - FILE_DIRECTORY = ' ' - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THEN - BULL_USER_CUSTOM = .FALSE. - ELSE - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IF - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - OPEN(UNIT=17,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURN - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - NINCLUDE = 0 - OLD_FORMAT = .FALSE. - FLEN = TRIM(FOLDER_NAME) - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL LOWERCASE(OLD_BUFFER) - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults') - & .EQ.1) THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - OLD_FORMAT = OLD_FORMAT.OR.(.NOT.IER1) - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXC - & .OR.EXC.EQ.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1 - ELSE - EXC_CHANGED = .TRUE. - END IF - END IF - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - IF (INDEX(OLD_BUFFER,':file_directory').GT.0) - & FILE_DIRECTORY = OLD_BUFFER(17:) - IF (INDEX(OLD_BUFFER,':exclude_limit').GT.0) THEN - DECODE(OLEN-15,'(I)',OLD_BUFFER(16:),IOSTAT=IER1) - & EXCLUDE_LIMIT - EXCLUDE_LIMIT = MIN(999,EXCLUDE_LIMIT) - END IF - END IF - END DO - - CLOSE (UNIT=17) - - IF (OLD_FORMAT) CALL CHECK_EXCLUDES - - RETURN - END - - - - - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /DIRMODE/ DIRMODE - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - CHARACTER*(*) STRING,STRING1 - CHARACTER*132 ADDRESS - - CHARACTER*12 EXFROM - - INCLUDE_MSG = .TRUE. - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURN - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - DO I=1,NINCLUDE - OLD_SCRATCH_B = SCRATCH_B - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - IF (STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (DIRMODE) BLIMIT = MIN(BLIMIT,FLEN+17+LEN(DESCRIP)) - - MATCH = .FALSE. - IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:')) THEN - CALL GET_FROM(EXFROM,OLD_BUFFER(FLEN+15:), - & TRIM(OLD_BUFFER(FLEN+15:))) - IF (STREQ(ADDRESS(STRING),ADDRESS(OLD_BUFFER(FLEN+15: - & TRIM(OLD_BUFFER(FLEN+15:BLIMIT))+FLEN+14))).OR. - & (DIRMODE.AND.STREQ(FROM,EXFROM))) MATCH = .TRUE. - ELSE IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND. - & STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER - & (FLEN+18:TRIM(OLD_BUFFER(FLEN+18:BLIMIT))+FLEN+17)).GT.0) - & THEN - MATCH = .TRUE. - END IF - IF (MATCH) THEN - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXC.OR. - & EXC.EQ.0) THEN - IF (OLD_BUFFER(BLIMIT+1:BLIMIT+1).EQ.':') EXC = -1 - CALL ADD_EXCL(OLD_BUFFER,BLIMIT,EXC) - CALL WRITE_QUEUE(%VAL(OLD_SCRATCH_B),OLD_SCRATCH_B, - & OLD_BUFFER) - EXC_CHANGED = .TRUE. - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THEN - SYSTEM = IBSET(SYSTEM,8) - ELSE - INCLUDE_MSG = .FALSE. - SYSTEM = IBCLR(SYSTEM,8) - END IF - END IF - END IF - END IF - END DO - - RETURN - END - - - - FUNCTION STRFIND(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) STRING,STRING1 - - L = LEN(STRING1) - DO I=0,LEN(STRING)-L - J = 1 - DO WHILE (J.LE.L) - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(STRING1(J:J)) - & .OR..NOT.ALPHA(STRING(I+J:I+J)))) THEN - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = I + 1 - RETURN - ELSE - J = J + 1 - END IF - END DO - END DO - - STRFIND = 0 - - RETURN - END - - - - - SUBROUTINE SHOW_EXCLUDE(TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (TYPE.EQ.0) WRITE (6,'('' There are no excludes.'')') - IF (TYPE.EQ.1) WRITE (6,'('' There are no threads.'')') - RETURN - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - FOUND = .FALSE. - - L = 1 - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - IF (STREQ(FOLDER_NAME(:FLEN)//':',OLD_BUFFER(:MIN(FLEN+1,OLEN))) - & .AND.((TYPE.EQ.1.AND.STREQ(OLD_BUFFER(FLEN+2:FLEN+8), - & 'INCLUDE')).OR.(TYPE.EQ.0.AND.STREQ( - & OLD_BUFFER(FLEN+2:FLEN+8),'EXCLUDE')))) THEN - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'Excludes for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'Threads for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - FOUND = .TRUE. - END IF - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (BLIMIT+5-FLEN.GT.PAGE_WIDTH.AND.L+2.GT.PAGE_LENGTH-1) THEN - L = L + 2 - ELSE - IF (L.EQ.0) THEN - WRITE (6,'(''+'',A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - ELSE - WRITE (6,'(1X,A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - END IF - IF (OLD_BUFFER(BDATE+1:BDATE+1).EQ.'-') - & OLD_BUFFER(BDATE:) = ' '//OLD_BUFFER(BDATE:) - OUTLEN = MIN(BLIMIT,PAGE_WIDTH+FLEN+9)-FLEN-9 - IF (OUTLEN.GT.PAGE_WIDTH-16) THEN - WRITE (6,'(1X,X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 2 - ELSE - WRITE (6,'(''+'',X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 1 - END IF - END IF - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & INPUT(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'No excludes found for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'No threads found for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - CHARACTER*12 NEW,OLD - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to set a new name.'')') - RETURN - END IF - - CALL CLI$GET_VALUE('OLDNAME',OLD,LENO) - CALL CLI$GET_VALUE('NEWNAME',NEW,LENN) - - CALL OPEN_BULLUSER_SHARED - - TEMP_USER = USERNAME - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY - END DO - - IF (IER.EQ.0) THEN - USERNAME = NEW - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=NEW) - END DO - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) USER_ENTRY - ELSE - REWRITE (4,IOSTAT=IER) USER_ENTRY - END IF - END IF - - USERNAME = TEMP_USER - DO WHILE (REC_LOCK(IER1)) - READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY - END DO - - CALL CLOSE_BULLUSER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Old name not found.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN))) - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - IF (LENO.GT.1) THEN - OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1))) - ELSE - OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2))) - END IF - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - IF (LENN.GT.1) THEN - NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1))) - ELSE - NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))) - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - SUBROUTINE CHECK_EXCL(BUFFER,L,EXC,BLIMIT,BDATE,IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - - CHARACTER*(*) BUFFER - - DIMENSION BTIM(2) - - BLIMIT = L - BDATE = L+3 - - IER = BUFFER(L:L).EQ.':' - IF (IER) THEN - I = LAST_INDEX(BUFFER(:L-1),':') - IF (I.GT.0) THEN - J = LAST_INDEX(BUFFER(:I-1),':') - IF (J.GT.0) THEN - IF (J.LT.I-1) THEN - DECODE(I-J-1,'(I)',BUFFER(J+1:I-1),IOSTAT=IER) EXC - IER = IER.EQ.0 - ELSE - EXC = EXCLUDE_LIMIT - END IF - IF (IER) BLIMIT = J - 1 - CALL STR$UPCASE(BUFFER(I+1:L-1),BUFFER(I+1:L-1)) - IF (IER) IER = SYS_BINTIM(BUFFER(I+1:L-1),BTIM) - BDATE = I + 1 - END IF - ELSE - IER = .FALSE. - END IF - END IF - - IF (.NOT.IER) CALL ADD_EXCL(BUFFER,L,-1) - - RETURN - END - - - - SUBROUTINE ADD_EXCL(BUFFER,L,EXC) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2) - - CHARACTER*(*) BUFFER - - CHARACTER TODAY*24 - - IF (EXC.EQ.-1) THEN - BUFFER = BUFFER(:L)//':' - ELSE - BUFFER = BUFFER(:L)//':' - WRITE (BUFFER(L+2:),'(I3)') EXC - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - BUFFER = BUFFER(:TRIM(BUFFER))//':'//TODAY(:INDEX(TODAY,' ')-1)//':' - - L = TRIM(BUFFER) - - RETURN - END - - - - - CHARACTER*(*) FUNCTION ADDRESS(INPUT) - - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) INPUT - - ADDRESS = INPUT - - IF (INDEX(INPUT,'@').EQ.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - ADDRESS = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - ELSE - I = INDEX(INPUT,'@') - IF (I.GT.0) THEN - ADDRESS = INPUT(:INDEX(INPUT(I:),' ')+I-2) - IF (INDEX(ADDRESS(I:),'(').GT.0) - & ADDRESS = ADDRESS(:INDEX(ADDRESS(I:),'(')+I-2) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SEND_MAIL - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - C = 0 - DO WHILE (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) - OPEN (UNIT=8,FILE=INPUT(:TRIM(INPUT)),IOSTAT=IER,RECL=256) - IF (IER.NE.0) GOTO 30 - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - DO I=1,3 - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - END DO - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - DO WHILE (IER.EQ.0) - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - END IF - END DO - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - CLOSE (UNIT=8,STATUS='DELETE') - GOTO 20 -10 CLOSE (UNIT=8) -20 CALL SMTP_DISCONNECT() -30 CONTINUE - END DO - - CALL EXIT - END diff --git a/decus/vmslt97a/bulletin/bulletin2.for b/decus/vmslt97a/bulletin/bulletin2.for deleted file mode 100644 index bd900df..0000000 --- a/decus/vmslt97a/bulletin/bulletin2.for +++ /dev/null @@ -1,2670 +0,0 @@ -C -C BULLETIN2.FOR, Version 3/10/97 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'('' WARNING: Account used by other folder.'', - & '' If you specify the same account,'')') - WRITE (6,'('' you must specify the address'', - & '' of the mailing list in the folder description.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to make this change? ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) THEN - CALL CLOSE_BULLUSER - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Specified file cannot be opened.'')') - RETURN - END IF - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.EQ.0) THEN - INFROM = INPUT(:ILEN)//',' - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (MSG_OWN) THEN - ILEN = TRIM(INPUT) - 6 - INFROM = INFROM(:LENFRO)//INPUT(7:) - IF (INDEX(INFROM,' "').GT.INDEX(INFROM,'@')) THEN - I = INDEX(INFROM,' "') - INFROM = INFROM(:I-1)// - & INFROM(INDEX(INFROM(I+2:),'"')+I+2:) - DO WHILE (INDEX(INFROM,'""').GT.0) - INFROM = INFROM(:INDEX(INFROM,'""'))// - & INFROM(INDEX(INFROM,'""')+2:) - END DO - END IF - CALL ADD_PROTOCOL(INFROM(LENFRO+1:),ILEN) - LENFRO = LENFRO + ILEN - END IF - IF (EDIT.AND.TEXT) THEN - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:TRIM(INPUT)-1) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:TRIM(INPUT))//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_P = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LEN_P.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') BULL_PARAMETER(:LEN_P)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THEN - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - IER = 0 - END IF - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')') - END IF - END IF - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (.NOT.FILESPEC) THEN - WRITE (6,'('' Enter message: End with ctrl-z,'', - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - ELSE - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IF - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - END IF - END IF - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No message added.'')') - IF (.NOT.STATUS) THEN - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ') - IF (STREQ(INPUT(:1),'Y')) THEN - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV') - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IF - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C -C SUBROUTINE ADD_SIGNATURE -C -C FUNCTION: Adds signature to message being mailed/posted. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATURE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/ - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURN - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) RETURN - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IF - - ICOUNT = 0 - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME))) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THEN - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END DO - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IF - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE. - ELSE - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' ' - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - END DO - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,INPUT1 - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(INPUT(I:I)) - & .OR..NOT.ALPHA(INPUT1(I:I)))) RETURN - END DO - - STREQ = .TRUE. - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -C -C SUBROUTINE RESPOND_MAIL -C -C FUNCTION: Sends mail to address. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,MLDESCRIP*(LINE_LENGTH) - - PRIVS = FILE.NE.'SYS$LOGIN:BULL.SCR' - - MLDESCRIP = SUBJECT - LENDES = TRIM(MLDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES) - IF (MLDESCRIP(I:I).EQ.'"') THEN - IF (LENDES.EQ.LINE_LENGTH) THEN - MLDESCRIP(I:I) = '`' - ELSE - MLDESCRIP = MLDESCRIP(:I)//'"' - & //MLDESCRIP(I+1:) - I = I + 1 - LENDES = LENDES + 1 - END IF - END IF - I = I + 1 - END DO - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0 - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD) - IF (PRIVS) CALL DISABLE_PRIVS - - IF (LISTSERV) THEN - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('MX_REPLY_TO','DEFINED')) - & CALL CRELNM('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('PMDF_REPLY_TO','DEFINED')) - & CALL CRELNM('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - IF (.NOT.SYS_TRNLNM('MULTINET_SMTP_REPLY_TO','DEFINED')) - & CALL CRELNM('MULTINET_SMTP_REPLY_TO', - & USERNAME(:TRIM(USERNAME))) - END IF - END IF - - IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (LPATH.GT.0) THEN - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - END IF - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - CALL CRELNM('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - CALL CRELNM('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE - CALL CRELNM('MULTINET_SMTP_REPLY_TO',INFROM(:TRIM(INFROM))) - END IF - END IF - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO) - & //'""" """'//MLDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IF - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//MLDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE - I = INDEX(SENDTO,'%""') + 3 - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THEN - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THEN - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THEN - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & MLDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) -C -C Use the following if you do not have VMS V5.3 or greater. -C -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//MLDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IF - - IF (PRIVS) CALL ENABLE_PRIVS - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV.OR.USE_INFROM) THEN - USE_INFROM = .FALSE. - CALL DELLNM_USER('MULTINET_SMTP_REPLY_TO') - CALL DELLNM_USER('PMDF_REPLY_TO') - CALL DELLNM_USER('MX_REPLY_TO') - END IF - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: CHANGE command subroutine. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWER - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IF - -C -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - LENFROM = 0 - IF (CLI$PRESENT('OWNER')) THEN - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - IER = CLI$GET_VALUE('OWNER',INFROM,LENFROM) - INFROM = 'From: '//INFROM - LENFROM = LENFROM + 6 - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('OWNER')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')') - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')') - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL.OR.LENFROM.GT.0) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (LENFROM.EQ.0) THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description header - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT, - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - IF (LENFROM.GT.0) CALL GET_FROM(FROM,INFROM(7:),LENFROM-6) - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2100' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2100' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10) - - CHARACTER GROUP*80,STAT*4 - - EXTERNAL CLI$_ABSENT - - IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SEARCH_LEN(1) = 3 - SEARCH_NUM = 1 - NFOLDER = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - SEARCH_NUM = 1 - NFOLDER = 1 - INPUT = DESCRIP - CALL INCLUDE_SUBJECT(0) - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1 - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM) - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1 - NFOLDER = 1 - ELSE - IF (NFOLDER.EQ.0) NFOLDER = 1 - SEARCH_STRING = ' ' - END IF - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - END IF - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME - NFOLDER = NFOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DO - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - SCRATCH_F = SCRATCH_F1 - NFOLDER = NFOLDER + 1 - END IF - - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - OLD_BUFFER = ' ' - END IF - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - END IF - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IF (NFOLDER.NE.0) FOUND = 0 - - CHANGE = .FALSE. - IF (CLI$PRESENT('REPLY').OR. - & TRIM(SEARCH_STRING).GT.0) THEN - REVERSE = CLI$PRESENT('REVERSE') - ELSE - REVERSE = .FALSE. - END IF - - DO WHILE (NFOLDER.NE.0.AND.FOUND.LE.0.AND.FOUND.GT.-3) - IF ((NFOLDER.GT.0.AND.(.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1)).OR. - & (NFOLDER.LT.0.AND.OLD_BUFFER.NE.' ')) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL, - & REVERSE,CLI$PRESENT('SUBJECT') - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'), - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),CHANGE) - IF (FOUND.LE.0.AND.FOUND.GE.-2) THEN - NFOLDER = NFOLDER - 1 - IF (NFOLDER.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F, - & FOLDER1_NAME) - END IF - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - END IF - END DO - ELSE IF (NFOLDER.LT.0) THEN - NFOLDER = NFOLDER + 1 - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - IF (GFOUND) THEN - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - GFOUND = .FALSE. - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - END IF - ELSE - NFOLDER = 0 - END IF - END DO - CALL CLOSE_BULLFOLDER - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - END IF - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - NFOLDER = 0 - END IF - CALL CANCEL_CTRLC_AST - END IF - END IF - END DO - - IF (FOUND.EQ.-3) FOUND = 0 - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - IF (CHANGE) THEN - WRITE (6,'('' No matches found in current folder: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' No matches found.'')') - END IF - ELSE IF (FOUND.EQ.-2) THEN - IF (CHANGE) THEN - WRITE (6,'('' ERROR: No more messages in current folder: '' - & ,A)') FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' ERROR: No more messages.'')') - END IF - END IF - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN, - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE,CHANGE) -C -C SUBROUTINE GET_SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEXT/ NEXT - LOGICAL NEXT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*4 SAVECMD - - CHARACTER*128 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - OLD_REVERSE = REVERSE - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THEN - OLD_REVERSE = REVERSE - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(BULL_POINT,IER) - IF (BULL_POINT+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (STREQ(DESCRIP(:4),'RE: ').AND.TRIM(DESCRIP).GE. - & LEN(DESCRIP)-1) THEN - IF (FILES) CALL OPEN_BULLFIL_SHARED - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - SEARCH_STRING = INPUT(11:) - SEARCH_STRING = SEARCH_STRING(:LEN(DESCRIP)) - ELSE - SEARCH_STRING = DESCRIP(5:) - END IF - IF (FILES) CALL CLOSE_BULLFIL - ELSE IF (STREQ(DESCRIP(:4),'RE: ')) THEN - SEARCH_STRING = DESCRIP(5:) - END IF - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - ELSE - SEARCH_NUM = OLD_SEARCH_NUM - IF (SEARCH_LEN(1).EQ.0) SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (OLD_REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - OLD_SEARCH_NUM = SEARCH_NUM - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.CHANGE.OR. - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last - END IF - IF (REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - SEARCH_STRING = ' ' - RETURN - END IF - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0 - BULL_SEARCH = START_BULL+1 - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR. - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY) - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - ELSE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - IF (IER.EQ.0) THEN - IER = BULL_SEARCH + 1 - ELSE - GO TO 800 - END IF - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - IF (SEARCH_MODE.EQ.4) THEN - CALL STR$UPCASE(DESCRIP1,FROM) - ELSE - IF (LEN(DESCRIP).EQ.TRIM(DESCRIP)) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - DESCRIP1 = INPUT(7:) - END IF - CALL STR$UPCASE(DESCRIP1,DESCRIP1) - ELSE - CALL STR$UPCASE(DESCRIP1,DESCRIP) - END IF - END IF - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (TRIM(SEARCH_STRING).EQ.LEN(DESCRIP).AND. - & DESCRIP1(:LEN(DESCRIP)).EQ.SEARCH_STRING).OR. - & (STREQ(DESCRIP1(:4),'RE: ').AND.DESCRIP1(5:).EQ. - & SEARCH_STRING(:MIN(TRIM(SEARCH_STRING),LEN(DESCRIP1)-4)) - & )))) THEN - IF (.NOT.NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - ELSE IF (NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - MATCHES = 0 - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE. - END DO - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THEN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I) - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR. - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - END IF - END DO - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE - FOUND = -1 - END IF - END IF - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULL - END DO - -800 FOUND = 0 - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - NEXT = .FALSE. - CALL READDIR(BULL_POINT,IER) - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - END IF - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - IF (.NOT.IER1) SEARCH_STRING = ' ' - NEXT = .FALSE. - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMD - - RETURN - END - - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE) - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRING - - OLD_MATCH = .FALSE. - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURN - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE. - RETURN - END IF - J = J + SEARCH_LEN(I) - END DO - - RETURN - END - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')') - RETURN - END IF -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:11).LT.'1900') EXDATE(8:9) = '19' - IF (EXDATE(8:11).LT.'1995') EXDATE(8:9) = '20' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'21'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'21'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')') - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END - - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - CHARACTER*256 INPUT_OUT - CHARACTER*128 TEMP - - INPUT_OUT = ' ' - - I = 0 - - DO WHILE (I.LT.TRIM(INPUT)) - INPUT = INPUT(I+1:) - IF (I.GT.0) INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//',' - I = MINGT0(INDEX(INPUT,','),TRIM(INPUT)+1) - TEMP = INPUT(:I-1) - CALL ADD_PROTOCOL_SUB(TEMP) - INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//TEMP(:TRIM(TEMP)) - END DO - - INPUT = INPUT_OUT - - IF (ILEN.NE.0) ILEN = TRIM(INPUT) - - RETURN - END - - - - SUBROUTINE ADD_PROTOCOL_SUB(INPUT) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - END IF - - IF (LMAIL.EQ.0) THEN - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN - MAIL_PROTOCOL = MAILER - END IF - LMAIL = TRIM(MAIL_PROTOCOL) - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%' - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1 - RETURN - END IF - END IF - - I = INDEX(INPUT,'@') - IF (I.GT.0) THEN - INPUT = INPUT(:INDEX(INPUT(I:),' ')+I-2) - IF (INDEX(INPUT(I:),'(').GT.0) - & INPUT = INPUT(:INDEX(INPUT(I:),'(')+I-2) - END IF - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"' - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bulletin3.for b/decus/vmslt97a/bulletin/bulletin3.for deleted file mode 100644 index 5a2c134..0000000 --- a/decus/vmslt97a/bulletin/bulletin3.for +++ /dev/null @@ -1,2505 +0,0 @@ -C -C BULLETIN3.FOR, Version 12/12/96 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2100' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2100' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2100 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2100 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_EDT' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THEN - CALL EDT$EDIT('NL:',OUT) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT) - ELSE - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IF - END IF - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT - ELSE - WRITE(6,'('' Could not activate editor.'')') - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE) - - RETURN - END - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - NOW = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - IF (.NOT.NOW) NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - CALL SYS$SETAST(%VAL(0)) - CALL REGISTER_BULLCP - IER1 = 1 - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - - BBOARD_LOOP = BBOARD_LOOP + 1 - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & (NEWS_LOOP.EQ.0.OR.NOW)) THEN - IF (NOW) THEN - CALL CREATE_PROCESS('BULLCP NEWS1') - ELSE - CALL CREATE_PROCESS('BULLCP NEWS') - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - - C = 0 - IF (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) THEN - CALL CREATE_PROCESS('BULLCP SMTP') - END IF - - NOW = .FALSE. - - NEWS_LOOP = NEWS_LOOP + 1 - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIME - CALL HIBER('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - DIMENSION NEW_SYSTEM_FLAG(FLONG) - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2)) - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER) - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - CALL SETUSER(USERNAME) - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAG - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - END DO - FOLDER_FLAG = FOLDER1_FLAG - FOLDER_NUMBER = 0 - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - CALL CLOSE_BULLUSER - ELSE - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DO - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IF - CLOSE (UNIT=REMOTE_UNIT) - END DO - END IF - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE HIBER(MIN) -C -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -C -C SUBROUTINE DELETE_EXPIRED_NEWS -C -C FUNCTION: -C -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - CHARACTER*4 GET_VMS_VERSION - - INTEGER TODAY(2),NEXT_EX_BTIM(2),NO_EXPIRE(2) - - CHARACTER*8 TODAY_KEY,TEMP - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - IF (NOW) THEN - IER = SYS$SETPRN('BULL NEWS1') - IF (.NOT.IER) CALL EXIT - IER = SYS$SETPRN('BULL NEWS') - IF (.NOT.IER) CALL EXIT - END IF - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - CALL SYS_BINTIM('-',TODAY) - - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - REMOTE_SET = 4 - -C -C A bug keeps messing up the last expired date key so that stored -C news groups do not get found. Someday when this is fixed, we can -C add code like this: -C -C INPUT = GET_VMS_VERSION() -C IF (INPUT(:2).EQ.'V5'.OR.INPUT(:2).EQ.'V4') VMSOLD = .TRUE..AND.NOW - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER).OR.(NOW.AND.IER.EQ.0.AND. - & (.NOT.BTEST(NEWS_F_FLAG,8).OR. - & COMPARE_BTIM(TODAY,NEWEST_EXBTIM).LT.0))) - IF (NOW) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - ELSE - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END IF - END DO - CALL NEWS_TO_FOLDER - - UNLOCK 7 - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - GO TO 1000 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,8)) GO TO 900 - - CALL OPEN_BULLDIR_SHARED - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0 - NDEL = -1 - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM) - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. - IF (NDEL.GT.NEWS_F_END) THEN - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1 - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (EXDATE(8:11).LT.'1995') THEN ! Deleted manually? - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) - EXTIME = ASCTIME(13:23) - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0 - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0 - UNLOCK 2 - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER) - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_START - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - IF (I.LE.F_NBULL) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0 - END DO - F_START = I - NEXT = .FALSE. - END IF - CALL READDIR(F_NBULL,IER) - IF (F_START.LT.F_NBULL.AND.(DN.OR.F_NBULL.EQ.IER)) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I) - I = I - 1 - IF (I.GE.F_START) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = I - END DO - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLDIR - END DO - -900 CALL CLOSE_BULLNEWS - -1000 IF (NOW.OR.IER.EQ.0) THEN - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.*]'//'*.' - INPUT = GET_VMS_VERSION() - CALL LIB$DAY_OF_WEEK(TODAY,DAY) - IF (DAY.NE.7) THEN - IER = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - IF (IER) THEN - DAY = 7 - CALL DELLNM('BULL_NEWS_CLEANUP') - END IF - END IF - IF (INPUT(:2).NE.'V5'.AND.INPUT(:2).NE.'V4') THEN - CONTEXT = 0 - DO WHILE (LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT)) - IER = CONV$RECLAIM(INPUT(:TRIM(INPUT))) - END DO - ELSE IF (DAY.EQ.7) THEN - REMOTE_SET = 4 - DIRLIST = .TRUE. - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(1000,IER) - CALL READ_FOLDER_FILE(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NO_EXPIRE) - DO WHILE (IER.EQ.0) - UNLOCK 7 - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - C = 0 - IF (LIB$FIND_FILE(BULLNEWSDIR_FILE - & (:TRIM(BULLNEWSDIR_FILE))//';1',INPUT,C)) THEN - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';2') - ELSE - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - END IF - CALL OPEN_BULLDIR_SHARED - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE,SHARED, - & BUFFERCOUNT=127, - & INITIALSIZE=(NEWSDIR_RECORD_LENGTH*F_COUNT)/512, - & STATUS='NEW',FORM='UNFORMATTED',DISPOSE='DELETE', - & RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,IOSTAT=IER, - & ORGANIZATION='INDEXED',RECORDTYPE='FIXED', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - END IF - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (2,IOSTAT=IER) NEWSDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - WRITE (9,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - ELSE - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY), - & %DESCR(EX_BTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & CALL COPY2(NEWEST_EXBTIM,EX_BTIM) - END IF - END IF - END DO - CLOSE (UNIT=9,DISPOSE='KEEP') - CALL CLOSE_BULLDIR_DELETE - CALL GET_MSGKEY(NEWEST_EXBTIM,TEMP) - IF (TEMP.NE.NEWS_F_EXPIRED_DATE) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - NEWS_F_EXPIRED_DATE = TEMP - CALL REWRITE_FOLDER_FILE(IER) - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - END IF - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - ELSE - IF (NO_EXPIRE(1).NE.NEWEST_EXBTIM(1).OR. - & NO_EXPIRE(2).NE.NEWEST_EXBTIM(2)) THEN - CALL GET_MSGKEY(NO_EXPIRE,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - ELSE - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - END IF - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';') - END DO - END IF - CALL READ_FOLDER_FILE(IER) - END DO - CALL CLOSE_BULLNEWS - END IF - DIRLIST = .FALSE. - NEWSLIST = .TRUE. - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - IER = .TRUE. - DO WHILE (IER) - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;') - IER = INDEX(FOLDER_FILE,']1JAN').EQ.0 - END DO - J = INDEX(FOLDER_FILE,']') - DECODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) THEN - DO I=1,10 - YEAR = YEAR - 1 - IF (YEAR.EQ.-1) YEAR = 99 - ENCODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) IER = LIB$DELETE_FILE(FOLDER_FILE(:J) - & //'*.*;*') - END DO - END IF - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IF - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'READ/NEW' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - - IER = 0 - CALL STRIP_HEADER(' ',-1,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.EQ.0) THEN - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP) - IF (STRIP.AND.INPUT(:5).EQ.'From:') INFROM = ' ' - END IF - END DO - -C -C If more than one folder has same BBOARD account, don't use the -C To: line to determine which folder to put the mail message in. -C - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - DUP = .FALSE. - DO WHILE (.NOT.DUP.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - DUP = FOLDER.NE.FOLDER1.AND.FOLDER_BBOARD.EQ.FOLDER1_BBOARD - END DO - IF (DUP.OR..NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - FOUND = .FALSE. - J = 0 - IF (DUP) J = 1 - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THEN - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - FOUND = INTO.EQ.F_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - END IF - FLEN = TRIM(F_BBOARD) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DO - END IF - END IF - END DO - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COM - END IF - - IF (NHEAD.GT.0) NUMHEAD = NHEAD + 1 - - IF (NUMHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - ELSE - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - SAVE_Q = HEADER_Q - HEADER_Q1 = 0 - ! INIT_MESSAGE_ADD_BBOARD reinits header so save it - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NUMHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - ELSE IF (NUMHEAD.EQ.1) THEN - INPUT = ' ' - LEN_INPUT = 1 - NUMHEAD = NUMHEAD - 1 - ELSE - CALL READ_QUEUE(%VAL(SAVE_Q),SAVE_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - USE_INFROM = .TRUE. - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL SYS$SETAST(%VAL(1)) - IF (.NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) - & CALL NEWS2BULL(.FALSE.) - END IF - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE. - - LEN_BBOARD = LEN(BBOARD) - 1 - - DO I=1,TRIM(INPUT)-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND. - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND. - & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR. - & (INDEX('@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0 - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND. - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALPHA(IN) - - CHARACTER*(*) IN - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURN - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN - - BBOARD_NAME = FOLDER_DESCRIP(I+1:) - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!') - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DO - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - IER = 0 - DO WHILE (IER.EQ.0) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - END DO - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - IF (INDEX(IMAGENAME,';').GT.0) ILEN = INDEX(IMAGENAME,';') - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0) - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - IF (.NOT.IER.AND..NOT.DEL) THEN - CALL DELPRC('BULLCP NEWS',DEL) - IER = .NOT.DEL - ELSE - IER = .TRUE. - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI) -C -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL ADD_2_ITMLST(4,JPI$_ENQLM,%LOC(ENQLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF - END IF - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_ENQLM - CALL LIB$MOVC3(4,ENQLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2)) - - RETURN - END - - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - CHARACTER*4 FUNCTION GET_VMS_VERSION -C -C FUNCTION GET_VMS_VERSION -C -C FUNCTION: Gets VMS version -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER VERSION*4 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,SYI$_NODE_SWVERS,%LOC(VERSION)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - GET_VMS_VERSION = VERSION - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DO - - CALL CLOSE_BULLDIR - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAM - - DATA OBIO/0/,OCPU/0/,ODIO/0/ - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAM - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU)) - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IF - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1 - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - END IF - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND. - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIO - ODIO = DIO - OCPU = CPU - IER = 0 - RETURN - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IF - RETURN - END diff --git a/decus/vmslt97a/bulletin/bulletin4.for b/decus/vmslt97a/bulletin/bulletin4.for deleted file mode 100644 index eaf39b7..0000000 --- a/decus/vmslt97a/bulletin/bulletin4.for +++ /dev/null @@ -1,2300 +0,0 @@ -C -C BULLETIN4.FOR, Version 4/19/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(' ',-1,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records. - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' '.AND..NOT.MAIL_POST()) THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - ELSE - IF (.NOT.HEADER) THEN - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - STRIP = .FALSE. - END IF - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - IER = 0 - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - CHARACTER RESPONSE*4 - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - CALL STR$UPCASE(FOLDER,FOLDER) - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '', - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAX - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - RETURN - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACL - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_NAME = FOLDER - FOLDER_OWNER = FOLDER1_OWNER - - MAILTO = 0 - I = INDEX(FOLDER_DESCRIP,'<') - J = INDEX(FOLDER_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER_DESCRIP(I:),'@').LT.1.OR. - & INDEX(FOLDER_DESCRIP(I:),'@').GT.J-I+1).AND.NEWS_FEED()) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - I = INDEX(FOLDER_DESCRIP,'[') - J = INDEX(FOLDER_DESCRIP,']') - END IF - - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - IF (I.GT.0.AND.J.GT.I.AND..NOT.NEWS_FEED().AND.MAILTO.EQ.0 - & .AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - IF (CLI$GET_VALUE('COPY',FOLDER1,FLEN).NE.%LOC(CLI$_ABSENT)) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Unable to copy folder settings.'')') - ELSE - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - 1 - IF (.NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) THEN - LAST(1,FOLDER1_NUMBER+1) = LAST(1,FOLDER_NUMBER+1) - LAST(2,FOLDER1_NUMBER+1) = LAST(2,FOLDER_NUMBER+1) - REWRITE (9,IOSTAT=IER) TEMP_USER,LAST - END IF - END IF - END DO - CALL CLOSE_BULLINF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(SET_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SET_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(NOTIFY_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - END IF - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - END IF - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -C -C Description: -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -C -C SUBROUTINE CREATE_NEWS_FOLDER -C -C FUNCTION: Creates a new newsgroup. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME) - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF -C -C If file specified in command, read file. -C Else, read from the terminal. -C - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file -2010 FORMAT(A) - ICOUNT = ICOUNT + ILEN - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER, - & 'Adding newsgroup.') - CLOSE (UNIT=3) - - RETURN - -920 WRITE(6,1020) -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURN - -910 WRITE(6,1010) -1010 FORMAT (' No news group was added.') - CLOSE (UNIT=3) - RETURN - - END - - - - - SUBROUTINE INIT_COMPRESS - - IMPLICIT INTEGER (A-Z) - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127 - DO J=0,127 - A(J,I) = ' ' - END DO - END DO - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DO - - J = 1 - DO I=1,8 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=10,31 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=127,254 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - - RETURN - - ENTRY COMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.126) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.126) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:))) - IF (T(O:O).NE.' ') THEN - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND. - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1)) - C = C + 1 - K = K + 1 - END DO - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1) - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0) - O = O + 1 - ELSE - T(O:O) = IN(K:K) - IF (ICHAR(T(O:O)).LT.9.OR.(ICHAR(T(O:O)).GT.9.AND. - & ICHAR(T(O:O)).LT.32)) T(O:O) = ' ' - K = K + 1 - O = O + 1 - END IF - END DO - IF (K.EQ.L) THEN - T(O:O) = IN(K:K) - ELSE - O = O - 1 - END IF - - OUT = T - - RETURN - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1 - T(O:O) = IN(I+2:I+2) - END DO - I = I + 3 - ELSE - B = UNMAP(J) - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1 - T(O:O) = IN(I:I) - ELSE - O = O + 2 - T(O-1:O) = B - END IF - I = I + 1 - END IF - END DO - - OUT = T(:O) - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bulletin5.for b/decus/vmslt97a/bulletin/bulletin5.for deleted file mode 100644 index 25e1c5e..0000000 --- a/decus/vmslt97a/bulletin/bulletin5.for +++ /dev/null @@ -1,2513 +0,0 @@ -C -C BULLETIN5.FOR, Version 3/5/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3) THEN - CALL SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - RETURN - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - NODEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (NODEFAULT) THEN - IF (NOTIFY.NE.-1) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) THEN - CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - END IF - REWRITE(4) USER_HEADER - ELSE IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & (FOLDER1_NUMBER.EQ.0.AND.FOLDER1_BBOARD(:2).NE.'::')) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - IF (FOLDER1_NUMBER.NE.0.OR.FOLDER1_BBOARD(:2).NE.'::') THEN - ! Test is due to bug which changes folder number to zero - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG - IF (BTEST(FOLDER1_FLAG,2)) THEN - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAG - FOLDER_NUMBER = TEMP_NUMBER - END IF - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - CALL UPDATE_EXCLUDE - - CALL UPDATE_USERINFO - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET').OR.(INCMD(:3).EQ.'SEA') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & (F1_START.GT.0.OR.F_START.LE.F_NBULL)) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_COUNT = F1_COUNT - IF (F1_START.GT.0) THEN - IF (F1_NBULL.LT.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER-1.GE.F1_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - ELSE - F_NBULL = F1_NBULL - END IF - F_START = F1_START - ELSE - F_START = F_NBULL + 1 - END IF - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - REMOTE_SET_NEW = 1 - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - IF (COMMAND.AND.INCMD(:3).NE.'REP'.AND. - & INCMD(:3).NE.'DEL') HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER1) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.IER1.EQ.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11).AND.WRITE_ACCESS) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s news group.'')') - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP( - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE IF (REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - ELSE IF (REMOTE_SET.EQ.3.OR.REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN - WRITE (6,'('' Folder only accessible for reading.'')') - END IF - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THEN - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - BULL_PARAMETER = 'MARKED' - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - BULL_PARAMETER = 'SEEN' - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED' - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN' - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - WRITE(6,'('' WARNING: No '',A, - & '' messages found.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IF - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE. - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - LAST_FOLDER_NUMBER = FOLDER_NUMBER - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IF - - IF (TEST_NEWS(FOLDER1)) THEN - INCMD = 'SET NEWS ' - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL ' - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Access is limited.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0) - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,10)) THEN - WRITE (6,'('' POST_ONLY has been set.'')') - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THEN - WRITE (6,'('' COMPRESS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - IF (NEWS_FEED()) THEN - WRITE (6,'('' Last message fed by news group was: '',I)') F_LAST - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/, - & ' Description: ',A) -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/, - & ' Description: ',A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/ - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' ' - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. - STORED = .FALSE. - CLASS = .FALSE. - NEW = .FALSE. - PERM = .FALSE. - DEFA = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counter - NLINE = 1 - START = .FALSE. - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE. - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - CALL NEWS_LIST - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - END IF - COUNT = CLI$PRESENT('COUNT') - IF (COUNT) TOTAL_COUNT = 0 - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - NEW = CLI$PRESENT('NEWGROUPS') - CLASS = CLI$PRESENT('CLASS') - PERM = CLI$PRESENT('PERMANENT') - DEFA = CLI$PRESENT('DEFAULT') - IF (CLASS) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - ELSE IF (PERM) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE IF (DEFA) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER) - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER - FOLDER_COUNT = -1 - RETURN - ELSE - START = .TRUE. - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN) - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0 - FOLDER_COUNT = -1 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN - SUBNUM = -2 - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DECLARE_CTRLC_AST - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE. - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (PERM.OR.DEFA) THEN - IER = 1 - DO WHILE (INUM.LE.FOLDER_MAX.AND.IER.NE.0) - IF (INF_REC2(1,INUM).NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (ZEXT(INF_REC2(1,INUM)),IER) - END IF - INUM = INUM + 1 - END DO - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2 - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THEN - NEW_NEWS = FOLDER1_NUMBER - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP) - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)), - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - END IF - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - FSTATUS1 = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (.NOT.NEWS_TEST) THEN - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN - IER1 = 1 - MORE = .TRUE. - END IF - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DO - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1 - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THEN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))') - ELSE IF (CLASS) THEN - WRITE (6,'(1X,''Class'',/,1X,(''-''))') - ELSE IF (SUBSCRIBE) THEN - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,''Status'',7X, - & ''First Last'',/,1X,(''-''))') - END IF - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1 - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1.AND. - & FLAG.NE.100) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - ELSE - FSTATUS1 = ' ' - END IF - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNT - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0 - END IF - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '* '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - END IF - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IF - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER - IF (NEWS_TEST.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - CALL GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & FSTATUS1,IER,ACTIVE) - MORE = MORE.AND.FOUND - IF (MORE) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND.AND.FLAG.NE.1) FLAG = 100 - END IF - END DO - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - END IF - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNT - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSE - WRITE(6,1100) ! Else say there are more - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10) -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS.OR.CLI$PRESENT('CLASS')) THEN - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.' - END IF - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER ! Open folder file - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - CALL RESET_PROTECTION - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')') - RETURN - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0) - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER) - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE - CALL SET_FOLDER_FILE(0) - END IF - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INDEX(INPUT,'[').EQ.0.AND.INDEX(INPUT,']').GT.0.AND. - & ID(:1).EQ.'[') INPUT = ID(:TRIM(ID))//','//INPUT - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').GT.0) - & COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"'.AND.INDEX(INPUT(2:),'"').GT.0) - & COMMA = INDEX(INPUT(2:),'"') + 2 - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').EQ.0) COMMA = 0 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ILEN = TRIM(ID) - ELSE - ID = INPUT - INPUT = ' ' - ILEN = TRIM(ID) - END IF - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE IF (ID(:1).NE.'['.OR.INDEX(ID,']').NE.0) THEN - IF (ILEN.EQ.0) THEN - IER = SS$_IVIDENT - ELSE IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IF - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*256 ACLENT - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURN - - ENTRY WRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER_COM - END IF - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - DO I=1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - NEW_NEWS_ACCESS = - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS' - - RETURN - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C)) - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' ' - ELSE - FILE = FILE(:L) - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - F = LEN(FIND) - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & STAT,IER,ACTIVE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*(*) STAT,FOLDER_MATCH - - CHARACTER NEWS_ACCESS*132 - - FOUND = .FALSE. - STAR = INDEX(FOLDER_MATCH,'*') - ONE = STAR.EQ.0.AND.TRIM(FOLDER_MATCH).GT.0 - START = .FALSE. - IF (STAR.GT.1) - & START = FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1) - STARTNOW = START - - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - IF (ONE) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER_MATCH(:TRIM(FOLDER_MATCH)),IER) - FOLDER_MATCH = ' ' - ELSE IF (STARTNOW) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP - & (FOLDER_MATCH(:STAR-1),IER) - STARTNOW = .FALSE. - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - END IF - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - STAT(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - STAT = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(STAT(:1).NE.'x'.AND. - & .NOT.BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (ONE.OR..NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1) - ELSE - FOUND1 = .TRUE. - END IF - END IF - FOUND = FOUND1 - ELSE - FOUND = .TRUE. - END IF - ELSE IF (IER.EQ.0.AND.START) THEN - IF (FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1)) RETURN - END IF - IF (ONE) RETURN - END DO - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bulletin6.for b/decus/vmslt97a/bulletin/bulletin6.for deleted file mode 100644 index 3bab532..0000000 --- a/decus/vmslt97a/bulletin/bulletin6.for +++ /dev/null @@ -1,2810 +0,0 @@ -C -C BULLETIN6.FOR, Version 9/15/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - TRY = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.TRY.EQ.0) THEN - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - TRY = 1 - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL_NAME - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & BUFFERCOUNT=127, - & ORGANIZATION='INDEXED',IOSTAT=IER) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open file: '',A)') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - IF (UNIT.EQ.14) THEN - WRITE (6,'('' Database conversion in progress. Try later.'')') - ELSE - WRITE (6,'('' Please try again later.'')') - END IF - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - COMMON /NEWSLIST/ NEWSLIST - DATA NEWSLIST/0/ - - COMMON /DIRLIST/ DIRLIST - DATA DIRLIST/0/ - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - LUN = 2 - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL_NAME - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & BUFFERCOUNT=127, - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - END IF - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) WRITE(6,'(1X,A)') - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1))) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULL - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LAST - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMIT - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLNEWSDIR - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($FORIOSDEF)' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*180 TEMP - - CHARACTER BUFFER*12,DATETIME*24 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - CALL OPEN_BULLNEWS - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=180/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & BUFFERCOUNT=127,KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR]') - IF (.NOT.IER1) GO TO 900 - - NEW_FOLDER_NUMBER = 0 - - DO WHILE (IER.EQ.0) - READ (2,IOSTAT=IER) TEMP - IF (GET_INTEGER(%REF(TEMP)).NE.NEW_FOLDER_NUMBER) THEN - IF (NEW_FOLDER_NUMBER.NE.0) CLOSE (UNIT=9,DISPOSE='KEEP') - NEW_FOLDER_NUMBER = GET_INTEGER(%REF(TEMP)) - CALL SET_BULLNEWSDIR_FILE(NEW_FOLDER_NUMBER) - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE, - & STATUS='UNKNOWN',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) GO TO 900 - END IF - NEWS_MSG_NUM = GET_INTEGER(%REF(TEMP(5:))) - NEWS_MSG_BTIM_KEY = TEMP(13:) - NEWS_EX_BTIM_KEY = TEMP(89:) - NEWS_MSGID = TEMP(21:) - CALL COPY2(MSG_BTIM,%REF(TEMP(97:))) - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL LIB$MOVC3(76,%REF(TEMP(105:)),NEWS_BLOCK) - - WRITE (9,IOSTAT=IER1) NEWSDIR_ENTRY - END DO - - CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - - CALL RESET_PROTECTION - - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - - IER = LIB$RENAME_FILE(BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - & ,'BULLNEWSDIR.OLD') - - WRITE (6,'('' BULLNEWSDIR.DAT has been renamed to '', - & '' BULLNEWSDIR.OLD and may now be deleted.'')') - - RETURN - -900 CALL RESET_PROTECTION - - CALL CLOSE_BULLNEWS - - WRITE(6,'('' ERROR: Cannot convert BULLNEWSDIR.DAT'')') - IF (IER.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - - END - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(81:84) = BUFFER(85:) - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL RESET_PROTECTION - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - IF (ASK_SIZE.EQ.184) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST) - ELSE - F_LAST = 0 - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LAST - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER)) - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0 - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -C -C SUBROUTINE CONVERT_BULLNEWS -C -C FUNCTION: Converts bulletin NEWS file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. '' - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0 - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE) - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0 - NEWS_F_END = 0 - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108) - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:) - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1 - IF (LMOVE.LE.0) THEN - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP - ELSE - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE)) - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) - END IF - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SET_PROTECTION - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL RESET_PROTECTION - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXT - - COMMON /KEEPLOCK/ KEEPLOCK - DATA KEEPLOCK/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /THREAD/ THREAD - - CHARACTER*4 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSE - DIR_NUM = 0 - END IF - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURN - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEYGE=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0.AND.ICOUNT.EQ.F_START) THEN - READ(2,KEYGT=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.EQ.0) ICOUNT = NEWS_MSG_NUM - END IF - END IF - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND. - & MSG_NUM.GT.F_START) THEN - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER,IER2) - F_START = MSG_NUM - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IF - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THEN - ICOUNT = MSG_NUM - BULLETIN_NUM = ICOUNT - END IF - END IF - ELSE - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 - END IF - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END IF - END DO - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IF - - IF (IER.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1 - ELSE IF (THREAD) THEN - DUMMY = INCLUDE_MSG(FROM,DESCRIP) - END IF - END IF - END IF - - RETURN - - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM) - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z) - - INTEGER TEMP - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I) - END DO - - RETURN - END - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/1/ - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.2.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.2.AND.MSG_NUM.NE.0) THEN - IF (MSG_NUM.GT.NEWS_F_END) THEN - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36 - UNLOCK 2 - END IF - END IF - END IF - ELSE - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - IER = 0 - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10 - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY),%DESCR(EX_BTIM)) - IF (POSTTIME) THEN - CALL GET_MSGKEY(%REF(NEWS_POST_KEY),%DESCR(MSG_BTIM)) - CALL CONVERT_FROM_GMT(MSG_BTIM) ! Assume stored is GMT - END IF - DESCRIP = NEWS_DESCRIP - FROM = NEWS_FROM - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IF - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11) - EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME(:11) - TIME = DATETIME(13:23) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - ELSE - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IF (BULLETIN_NUM.NE.NEWS_F_END+1) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END DO - END IF - ELSE - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IF - IF (REMOTE_SET.EQ.4.AND. - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN - CALL SPECIAL_NEWSDIR_ENTRY(IER) - ELSE IF (IER.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEN - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*140 TEMP - - DIMENSION BTIM(2) - - READ (2,KEYID=3,KEY=NEWS_POST_KEY,IOSTAT=IER) TEMP - DO WHILE (IER.EQ.0.AND.NEWS_POST_KEY.EQ.TEMP(57:64)) - IF (NEWS_MSGID.EQ.TEMP(21:56)) THEN - IER = 2 - RETURN - END IF - READ (2,IOSTAT=IER) TEMP - END DO - -10 IER1 = 0 - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=0,KEYGT=NEWS_F_END, - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - DO WHILE (IER1.EQ.0) - CALL LIB$MOVC3(4,%REF(INPUT),FNUM) - CALL GET_MSGKEY(%REF(INPUT(13:)),%DESCR(BTIM)) - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IF - F_COUNT = F_COUNT + 1 - CALL LIB$MOVC3(4,%REF(INPUT),NEWS_F_END) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - END DO - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IF - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSE - F_COUNT = F_COUNT + 1 - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,MSG_BTIM) - ELSE - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - END IF - - IF (LOCAL_POST) THEN - CALL SYS_BINTIM(DATE//' '//TIME - & (:TRIM(TIME)-2)//'00',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP - NEWS_FROM = FROM - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH - NEWS_MSG_NUM = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,NEWS_MSG_BTIM_KEY) - CALL GET_MSGKEY(EX_BTIM,NEWS_EX_BTIM_KEY) - ELSE - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - - RETURN - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KEYID/ NEWS_KEYID - - COMMON /KEEPLOCK/ KEEPLOCK - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 2 - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - CALL READDIR_KEYGE(NDEL) - KEEPLOCK = .FALSE. - NEWS_KEYID = 1 - - RETURN - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII)) - IF (ACLSTR(START_ID:START_ID).NE.','.AND. - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DO - IF (ASCII) THEN - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl output - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C -C SUBROUTINE COPY_ACL1 -C -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - ! Read input file acl - - IF (.NOT.IER) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./ - - IF (CHECKED) RETURN - - CHECKED = .TRUE. - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C) - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORY - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - END IF - - CALL CHECK_DIR(FOLDER_DIRECTORY,.FALSE.) - CALL CHECK_DIR(NEWS_DIRECTORY,.FALSE.) - - CALL ADD_DIRECTORIES - - RETURN - END - - - - SUBROUTINE ADD_DIRECTORIES - - INCLUDE 'BULLFILES.INC' - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE) - - RETURN - END - - - - LOGICAL FUNCTION CHECK_DIR(DIRECTORY,LIBRARY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - CHECK_DIR = PRESENT(BULLUSER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLFOLDER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLINF_FILE,DIRECTORY,TEST) - - IF (CHECK_DIR) THEN - IF (SYS_TRNLNM(DIRECTORY,TEST)) DIRECTORY = TEST - RETURN - END IF - - TEST = ' ' - - IF (INDEX(DIRECTORY,']').EQ.0) THEN - CALL SYS_TRNLNM(DIRECTORY,TEST1) - ELSE - TEST1 = DIRECTORY - END IF - - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - - IF (.NOT.LIBRARY.AND.TEST.EQ.' ') THEN - IER = SYS_TRNLNM_SYSTEM(DIRECTORY,TEST) - IF (.NOT.IER.AND.TEST1.EQ.DIRECTORY) RETURN - END IF - - IF (TEST.NE.TEST1) THEN - IF (LIBRARY) THEN - WRITE (6,'('' ERROR: Not a valid library. '')') - RETURN - END IF - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER) - CLOSE(UNIT=3,STATUS='DELETE') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)') - & TEST1(:TRIM(TEST1)) - CALL EXIT - END IF - DIRECTORY = TEST1 - ELSE - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - CHECK_DIR = .TRUE. - END IF - - RETURN - END - - - - - LOGICAL FUNCTION PRESENT(FILE,DIR,TEST) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILE,DIR,TEST - - FILE = FILE(INDEX(FILE,':')+1:) - FILE = FILE(INDEX(FILE,']')+1:) - IF (INDEX(DIR,':').EQ.0.AND.INDEX(DIR,'[').EQ.0.AND. - & INDEX(DIR,'<').EQ.0) DIR = DIR(:TRIM(DIR))//':' - C = 0 - PRESENT = LIB$FIND_FILE(DIR(:TRIM(DIR))//FILE,TEST,C) - - RETURN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:) - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:) - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':' - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURN - END - - - - SUBROUTINE SET_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CALL CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P) - - IF (CHECK_DIR(BULL_PARAMETER,.TRUE.)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - CALL UPDATE_USERINFO - CALL OPEN_USERINFO - INCMD = 'SHOW' - CALL UPDATE_READ(0) - END IF - - RETURN - END - - - - SUBROUTINE SHOW_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (CLI$PRESENT('ALL')) THEN - IER = 1 - N = 1 - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',BULL_PARAMETER) - IF (IER) THEN - IF (N.EQ.1) THEN - WRITE (6,'('' The following are valid libraries:'')') - N = 0 - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER - END IF - END DO - IF (N.EQ.1) WRITE (6,'('' No libraries are present.'')') - ELSE - WRITE (6,'('' Present library is: '',A)') - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - END IF - - RETURN - END - - - - SUBROUTINE SET_BULLNEWSDIR_FILE(FN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - BULLNEWSDIR_FILE = ' ' - - ENCODE(6,'(I6)',BULLNEWSDIR_FILE) FN - BULLNEWSDIR_FILE = BULLNEWSDIR_FILE(FIRST_ALPHA(BULLNEWSDIR_FILE):) - L = TRIM(BULLNEWSDIR_FILE) - - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.'// - & BULLNEWSDIR_FILE(:L-3)//']'// - & BULLNEWSDIR_FILE(L-2:TRIM(BULLNEWSDIR_FILE))//'.' - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bulletin7.for b/decus/vmslt97a/bulletin/bulletin7.for deleted file mode 100644 index dc23c6c..0000000 --- a/decus/vmslt97a/bulletin/bulletin7.for +++ /dev/null @@ -1,2347 +0,0 @@ -C -C BULLETIN7.FOR, Version 3/20/96 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER1_NAME.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCALPOST/ LOCAL_POST - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - IF (.NOT.LOCAL_POST) THEN - DATE = NEWEST_DATE - TIME = NEWEST_TIME - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIR - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /OUTPUT/ REASSIGNED - LOGICAL REASSIGNED - DATA REASSIGNED /.FALSE./ - - CALL DISABLE_PRIVS ! Disable SYSPRV - - IF (.NOT.REASSIGNED) THEN - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - END IF - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - IF (INDEX(INPUT,']').GT.0) THEN - SYS_TRNLNM = .FALSE. - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX)) - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1 - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IF - - RETURN - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - IER1 = 0 - ELSE - IF (IER.GT.0) THEN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0 - CALL SET_FOLDER_FILE(0) - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0) - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*12 DATE_SAVE,EXDATE_SAVE - CHARACTER*12 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - END IF - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER PSCAN$_BEGIN = '00000000'X - PARAMETER PSCAN$_ACCOUNT = '00000001'X - PARAMETER PSCAN$_AUTHPRI = '00000002'X - PARAMETER PSCAN$_CURPRIV = '00000003'X - PARAMETER PSCAN$_GRP = '00000004'X - PARAMETER PSCAN$_HW_MODEL = '00000005'X - PARAMETER PSCAN$_HW_NAME = '00000006'X - PARAMETER PSCAN$_JOBPRCCNT = '00000007'X - PARAMETER PSCAN$_JOBTYPE = '00000008'X - PARAMETER PSCAN$_MASTER_PID = '00000009'X - PARAMETER PSCAN$_MEM = '0000000A'X - PARAMETER PSCAN$_MODE = '0000000B'X - PARAMETER PSCAN$_NODE_CSID = '0000000C'X - PARAMETER PSCAN$_NODENAME = '0000000D'X - PARAMETER PSCAN$_OWNER = '0000000E'X - PARAMETER PSCAN$_PRCCNT = '0000000F'X - PARAMETER PSCAN$_PRCNAM = '00000010'X - PARAMETER PSCAN$_PRI = '00000011'X - PARAMETER PSCAN$_PRIB = '00000012'X - PARAMETER PSCAN$_STATE = '00000013'X - PARAMETER PSCAN$_STS = '00000014'X - PARAMETER PSCAN$_TERMINAL = '00000015'X - PARAMETER PSCAN$_UIC = '00000016'X - PARAMETER PSCAN$_USERNAME = '00000017'X - PARAMETER PSCAN$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER PSCAN$_END = '00000019'X - PARAMETER PSCAN$k_type = '00000081'X - PARAMETER PSCAN$M_OR = '00000001'X - PARAMETER PSCAN$M_BIT_ALL = '00000002'X - PARAMETER PSCAN$M_BIT_ANY = '00000004'X - PARAMETER PSCAN$M_GEQ = '00000008'X - PARAMETER PSCAN$M_GTR = '00000010'X - PARAMETER PSCAN$M_LEQ = '00000020'X - PARAMETER PSCAN$M_LSS = '00000040'X - PARAMETER PSCAN$M_PREFIX_MATCH = '00000080'X - PARAMETER PSCAN$M_WILDCARD = '00000100'X - PARAMETER PSCAN$M_CASE_BLIND = '00000200'X - PARAMETER PSCAN$M_EQL = '00000400'X - PARAMETER PSCAN$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER PSCAN$S_OR = 1 - PARAMETER PSCAN$V_OR = 0 - PARAMETER PSCAN$S_BIT_ALL = 1 - PARAMETER PSCAN$V_BIT_ALL = 1 - PARAMETER PSCAN$S_BIT_ANY = 1 - PARAMETER PSCAN$V_BIT_ANY = 2 - PARAMETER PSCAN$S_GEQ = 1 - PARAMETER PSCAN$V_GEQ = 3 - PARAMETER PSCAN$S_GTR = 1 - PARAMETER PSCAN$V_GTR = 4 - PARAMETER PSCAN$S_LEQ = 1 - PARAMETER PSCAN$V_LEQ = 5 - PARAMETER PSCAN$S_LSS = 1 - PARAMETER PSCAN$V_LSS = 6 - PARAMETER PSCAN$S_PREFIX_MATCH = 1 - PARAMETER PSCAN$V_PREFIX_MATCH = 7 - PARAMETER PSCAN$S_WILDCARD = 1 - PARAMETER PSCAN$V_WILDCARD = 8 - PARAMETER PSCAN$S_CASE_BLIND = 1 - PARAMETER PSCAN$V_CASE_BLIND = 9 - PARAMETER PSCAN$S_EQL = 1 - PARAMETER PSCAN$V_EQL = 10 - PARAMETER PSCAN$S_NEQ = 1 - PARAMETER PSCAN$V_NEQ = 11 - BYTE %FILL (2) - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -C -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -C -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE)) -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1 -C UJPIMODE = -1 -C TERMINAL(1:1) = CHAR(0) -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./ - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IF - END DO - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - DO I=1,FOLDER_MAX - DO J=1,2 - LAST(J,I) = LAST_READ_BTIM(J,I) - END DO - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.EQ.0) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - WRITE (9,IOSTAT=IER) USERNAME,INF_REC - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIM - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0 - LAST_SYS_BTIM(2,I) = 0 - END DO - END IF - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -C -C SUBROUTINE READ_NEWS_USERINFO -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) NAME - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2))) - END IF - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READ - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - EQUIVALENCE (OLD_LAST_NEWS_READ2(1,1),OLD_LAST_NEWS_READ(1,1)) - INTEGER*2 OLD_LAST_NEWS_READ2(4,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF = (LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF1 = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF1 = (LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF2 = .FALSE. - GO TO 10 - - ENTRY UPDATE_USERINFO_NEWS_ALWAYS - DIFF2 = .TRUE. - -10 IF (.NOT.DIFF2) THEN - DO I=1,FOLDER_MAX - DIFF2 = (LAST_NEWS_READ(1,I).NE. - & OLD_LAST_NEWS_READ(1,I)).OR. - & (LAST_NEWS_READ(2,I).NE. - & OLD_LAST_NEWS_READ(2,I)).OR.DIFF2 - END DO - END IF - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHARED - - IF (DIFF) THEN - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & LAST(J,I) = LAST_READ_BTIM(J,I) - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - END IF - - IF (DIFF1) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & OLD_LAST_SYS_BTIM(J,I) = LAST_SYS_BTIM(J,I) - LAST_SYS_BTIM(J,I) = OLD_LAST_SYS_BTIM(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF - - IF (DIFF2) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=2,1,-1 - IF (I.EQ.NEWS_FIND_SUBSCRIBE().OR. - & OLD_LAST_NEWS_READ2(1,I).NE.LAST_NEWS_READ2(1,I)) - & OLD_LAST_NEWS_READ(J,I) = LAST_NEWS_READ(J,I) - LAST_NEWS_READ(J,I) = OLD_LAST_NEWS_READ(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - CHARACTER*24 TIME1 - - TIME1 = TIME(FIRST_ALPHA(TIME):) - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:) - END DO - - IF (TIME1.EQ.'-') TIME1 = '-- :' - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder info - ELSE IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND. - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A)') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - IF (INCMD(:4).EQ.'SHOW') THEN - SAVE_FOLDER_Q1 = 0 - RETURN - END IF - IF (NEW_MESS.OR.NEWS_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1 - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0 - END IF - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE(IER) - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER) - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bulletin8.for b/decus/vmslt97a/bulletin/bulletin8.for deleted file mode 100644 index ecb8e23..0000000 --- a/decus/vmslt97a/bulletin/bulletin8.for +++ /dev/null @@ -1,2163 +0,0 @@ -C -C BULLETIN8.FOR, Version 10/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND. - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0, - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - END IF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE. - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THEN - ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX)) - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV) - END IF - END IF - END IF - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND. - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24 - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM) - P = 4 + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (BTEST(FOLDER_FLAG,14)) FROM = 'ANONYMOUS' - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - IF (NEWS_FEED()) THEN - BULL_POINT = NBULL - INCMD = 'COPY/ORIGINAL/LOCAL '// - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1 - & :INDEX(FOLDER_DESCRIP,'>')-1) - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - END IF - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT) - P = 4 + P - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER) - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - CALL CLOSE_BULLFOLDER - END IF - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = -1 - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV) - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - INIT = INIT + 2 - IF (INIT.GT.60) THEN - WRITE (6,'('' Bulletin aborting due to record lock'', - & '' problem. Alert system administrator.'')') - CALL EXIT - END IF - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /WINDOW/ WINDOW - - CHARACTER*80 MESSAGE - - WINDOW = 1 - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - - COMMON /TEMP_INPUT/ NODE_TEMP - CHARACTER NODE_TEMP*256 - - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,PASSWORD*32,TEMP_USER*12 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - RETURN - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C -C SUBROUTINE SET_FOLDER_FILE -C -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE, -C if = 1, set FOLDER1_FILE -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NUM.EQ.0) THEN - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE) - END IF - - RETURN - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C -C SUBROUTINE SET_FILE -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILE - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - ELSE - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)// - & '.]' - END IF - - RETURN - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12 - - DATA UPDATE/.FALSE./, JUST_NAME/.FALSE./ - - UPDATE = .TRUE. - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_UPDATE - - UPDATE = .NOT.UPDATE - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_NAME - - JUST_NAME = .NOT.JUST_NAME - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATE - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):) - - M = INDEX(FILDATE,'-') - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3) - - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN - FOLDER_FILE = FOLDER1_FILE - IF (JUST_NAME) THEN - JUST_NAME = .FALSE. - RETURN - END IF - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THEN - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHARED - END IF - END IF - - JUST_NAME = .FALSE. - - IF (UPDATE) THEN - READ (1'1) NBLOCK - REWRITE (1) NBLOCK + LENGTH - UPDATE = .FALSE. - END IF - - RETURN - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THEN - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE - MINGT0 = MIN(I,J) - END IF - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bulletin9.for b/decus/vmslt97a/bulletin/bulletin9.for deleted file mode 100644 index 6760e7f..0000000 --- a/decus/vmslt97a/bulletin/bulletin9.for +++ /dev/null @@ -1,2469 +0,0 @@ -C -C BULLETIN9.FOR, Version 2/28/97 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - - IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN - WRITE (6,'(A)') ' A new BULLETIN executable has been '// - & 'installed since your last use.' - WRITE (6,'(A)') - & ' Type HELP NEW_FEATURES for help on any new features.' - END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - EXTERNAL BULLETIN_SUBCOMMANDS - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IF - END IF - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE - WRITE (6,1000) - END IF - IF (.NOT.SUBSCRIBE) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - DO I = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IF - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1 - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THEN - NUM_FOLDER = 0 - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1), - & 'HIT any key for next page....') - END IF - END DO - IF (NUM_FOLDERS.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE IF (INEW) THEN - NEW = INEW - IF (REMOTE_SET.GE.3) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSE - CALL FIND_NEWEST_BULL - END IF - END IF - - IF (INCMD(:4).NE.'INDE') THEN - IER = CLI$DCL_PARSE('INDEX',BULLETIN_SUBCOMMANDS) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1010 FORMAT (' The following folders with new messages are present'/) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - FOLDER_PRESENT = CLI$PRESENT('FOLDER') - - IF (FOLDER_PRESENT) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z') - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME) - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURN - END IF - END IF - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid date specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURN - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN - END IF - ELSE IF (SINCE) THEN - IF (BULL_POINT.EQ.0) THEN - WRITE (6,'('' ERROR: No current message.'')') - RETURN - ELSE IF (NEWS) THEN - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THEN - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSE - STARTMSG = 1 - END IF - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - ELSE - IF (NEWS) THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1 - END DO - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND. - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0 - NEWSMSG = 1 - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THEN - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0 - ELSE - FOUND = .FALSE. - END IF - IF (FOUND.AND.NEWS) THEN - WRITE (6,'(1X,A,'' latest message read '', - & I,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'', - & '' to specified folder.'')') - END IF - END IF - IF (.NOT.ALL) THEN - IF (IER.NE.0) THEN - WRITE (6,'('' User info does not exist.'')') - END IF - IER = 2 - END IF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - CALL CLOSE_BULLUSER - ELSE - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - CALL CLOSE_BULLUSER - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - DATA SCRTYPE/-1/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESS - - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - IER1 = 1 - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER2) THEN - CALL ADD_DIRECTORIES - ELSE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IF - END IF - END DO - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - LDESCR = 0 - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - IF (NEWS_FEED()) THEN - CALL STRIP_HEADER(' ',-1,IER) - END IF - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - MAIL = BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0 - IF (MAIL) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.MAIL' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0 - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - ELSE IF (NEWS_FEED().OR.LEN_FROM.EQ.0 - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - SCRTYPE = 0 - SCRNAME = 'SYS$LOGIN:BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - IF (IER1.NE.0) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW') - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /STORED/ STORED - - CHARACTER*256 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.NEWS_FEED().AND. - & .NOT.BTEST(FOLDER_FLAG,11).AND..NOT.STORED) CLOSE (UNIT=3) - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - CHARACTER*24 TODAY - - COMMON /STORED/ STORED - DATA STORED /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THEN - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER - RETURN - ELSE IF (BUFFER(:5).EQ.'From:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE. - OLD_BUFFER_FROM = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Reply-To:') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - END IF - STORED = .TRUE. - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STORED - STORED = .FALSE. - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3) - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - IF (LEN_BUFFER.GT.0) THEN - IF (.NOT.TEXT) THEN - IF (.NOT.NEWS_FEED()) THEN - TEXT = .TRUE. - ELSE - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - END IF - IF (TEXT) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - ELSE - IF (TEXT) WRITE (3,'(A)') ' ' - END IF - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF (.NOT.STORED.AND. - & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') ' ' - END IF - CALL STORE_BULL(1,' ',NBLOCK) - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2 - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-') - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO - INEXDATE = .TRUE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - TEXT = .TRUE. - IF (NEWS_FEED()) THEN - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - IF (.NOT.STORED.AND. - & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAY - - CHARACTER USER_SAVE*12,PROC_SAVE*12 - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1 - FIRST_BREAK = .FALSE. - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - SCRTYPE = -1 - END IF - RETURN - END IF - - EXTIME = '00:00:00.00' - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2100' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - IF (SCRTYPE.EQ.0.AND.NEWS_FEED()) THEN - FOLDER1_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,'>')-1) - CALL SYS$SETAST(%VAL(1)) - CALL NEWS_POST('ignore',.TRUE.,IER,INDESCRIP) - IF (TEST_BULLCP().EQ.2) CALL SYS$SETAST(%VAL(0)) - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3) - END IF - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.EQ.0) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL GETUSER(PROC_SAVE) - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME) - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARD - END IF - CALL RESPOND_MAIL(SCRNAME,INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE(SCRNAME(:TRIM(SCRNAME))//';*') - CALL SETUSER(PROC_SAVE) - USERNAME = USER_SAVE - ELSE - CLOSE (UNIT=3) - END IF - ELSE IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - END IF - - CALL STRIP_HEADER(' ',-1,IER) - - SCRTYPE = -1 - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - - IF (.NOT.NEWS_FEED()) THEN - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - END IF - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(FROM,INFROM,LEN_INFROM) - - RETURN - END - - - SUBROUTINE GET_FROM(FROM,INFROM1,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INFROM1,FROM - - CHARACTER*256 INFROM - - INFROM = INFROM1 - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - I = INDEX(INFROM,'<') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<')+1:) ! personal-name - END IF - - I = INDEX(INFROM,'(') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'(')+1:) ! personal-name (net-name) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR.INFROM(I:I).LE.' '.OR. - & INFROM(I:I).GE.CHAR(127).OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) - I = I + 1 - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1 - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND.INFROM(I:I).GT.' '.AND. - & INFROM(I:I).LT.CHAR(127).AND. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.126) - & INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP).AND..NOT.NEWS_FEED()) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - CALL INIT_QUEUE(HEADER_Q1,INPUT) - IF (BLEN.EQ.-1) THEN - CALL INIT_QUEUE(HEADER_Q1,INPUT) - HEADER_Q = HEADER_Q1 - NHEAD = 0 - END IF - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - END IF - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) THEN ! of previous header line - IF (LAST_NEWSGROUPS) THEN - NEWSGROUPS = NEWSGROUPS(:TRIM(NEWSGROUPS))//BUFFER(2:) - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - END IF - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - LAST_NEWSGROUPS = .FALSE. - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.' - END IF - ELSE IF (BUFFER(:11).EQ.'Newsgroups:') THEN - NEWSGROUPS = BUFFER(13:) - LAST_NEWSGROUPS = .TRUE. - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - - RETURN - END - - - - - SUBROUTINE SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_NEWS_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified news group -C Note: If NOTIFY READNEW and BRIEF = 0, it is either news -C group removal or SET SUBSCRIBE command. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - ALL = .FALSE. - DEFAULT = 1 - NODEFAULT = 0 - SUB = ABS(BRIEF)+ABS(NOTIFY)+ABS(READNEW).EQ.0 - - IF (NOTIFY.EQ.1.AND.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: /NOTIFY is invalid with non-stored'', - & '' news group.'')') - RETURN - END IF - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - IF (CLI$PRESENT('NOPERMANENT').OR.CLI$PRESENT('PERMANENT').OR. - & (SUB.AND.(NODEFAULT.OR.CLI$PRESENT('NOPERMANENT')))) THEN - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (SUB) DEFAULT = 1 - ELSE IF (CLI$PRESENT('NOPERMANENT').OR.NODEFAULT) THEN - IF (NOTIFY.GE.0) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - IF (SUB) - & CALL SET_NEWS_FLAG(IER,-1,-1,-1) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*PERM ',INF_REC - END IF - END IF - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - IF (NODEFAULT.AND.SUB) THEN - NOTIFY = -1 - READNEW = -1 - BRIEF = -1 - END IF - IF (DEFAULT.OR.NODEFAULT) THEN - IF (NODEFAULT.AND..NOT.SUB) THEN - IF (NOTIFY.NE.-1) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - ELSE - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*DEFAULT ',INF_REC - END IF - END IF - IF ((ALL.OR.(SUB.AND.INCMD(:3).NE.'SET')).AND.IER.EQ.0) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY=TEMP_USER,IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - - RETURN - END - - - - - SUBROUTINE READ_INF_REC - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - RETURN - - ENTRY SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & INF_REC2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1.AND.TEMP_USER(:1).EQ.'*') THEN - WRITE (6,'('' ERROR: You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - IER = 0 - RETURN - END IF - - IF (INF_REC2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IF (NOTIFY+READNEW+BRIEF.EQ.-3) THEN - DO J=I,FOLDER_MAX-2 - CALL COPY2(INF_REC(1,J),INF_REC(1,J+1)) - END DO - END IF - IER = 1 - RETURN - END IF - - IF (NOTIFY+READNEW+BRIEF.EQ.-3) RETURN - - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(INF_REC2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(INF_REC(1,J),INF_REC(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - INF_REC2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - INF_REC2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - INF_REC(2,J) = F_START - 1 - ELSE - INF_REC2(2,J) = 0 - INF_REC(2,J) = F_NBULL - END IF - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IER = 1 - RETURN - END IF - END DO - - RETURN - END diff --git a/decus/vmslt97a/bulletin/bullfiles.inc b/decus/vmslt97a/bulletin/bullfiles.inc deleted file mode 100644 index af8ee2e..0000000 --- a/decus/vmslt97a/bulletin/bullfiles.inc +++ /dev/null @@ -1,39 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vmslt97a/bulletin/bullfolder.inc b/decus/vmslt97a/bulletin/bullfolder.inc deleted file mode 100644 index 117f8fc..0000000 --- a/decus/vmslt97a/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vmslt97a/bulletin/bullmain.cld b/decus/vmslt97a/bulletin/bullmain.cld deleted file mode 100644 index 32c0642..0000000 --- a/decus/vmslt97a/bulletin/bullmain.cld +++ /dev/null @@ -1,34 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vmslt97a/bulletin/bullnews.inc b/decus/vmslt97a/bulletin/bullnews.inc deleted file mode 100644 index 251895d..0000000 --- a/decus/vmslt97a/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vmslt97a/bulletin/bullstart.com b/decus/vmslt97a/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vmslt97a/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vmslt97a/bulletin/bulluser.inc b/decus/vmslt97a/bulletin/bulluser.inc deleted file mode 100644 index 215a667..0000000 --- a/decus/vmslt97a/bulletin/bulluser.inc +++ /dev/null @@ -1,53 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vmslt97a/bulletin/changes.txt b/decus/vmslt97a/bulletin/changes.txt deleted file mode 100644 index 977b040..0000000 --- a/decus/vmslt97a/bulletin/changes.txt +++ /dev/null @@ -1,648 +0,0 @@ -V 2.24 - -When replying to a message in a news group that has been crossposted, give the -user the option of just posting the reply to the news group in which the -message is being read rather than all the news groups in the crosspost. -11/20/95 - -Messages added to folders and stored news groups are now marked as being read -so that the person does not see them when doing a READ/NEW. 11/20/95 - -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vmslt97a/bulletin/cmds.mai b/decus/vmslt97a/bulletin/cmds.mai deleted file mode 100644 index 1340739..0000000 --- a/decus/vmslt97a/bulletin/cmds.mai +++ /dev/null @@ -1,22 +0,0 @@ -The address for getting BULLETIN is BULLETIN@PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file - (only one file per command). - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - -BULLETIN is also available via ANONYMOUS FTP from PFC.MIT.EDU, but the account -is set at low priority, so I suggest using it during non-prime hours. - - Mark diff --git a/decus/vmslt97a/bulletin/copyright.txt b/decus/vmslt97a/bulletin/copyright.txt deleted file mode 100644 index ee33a7e..0000000 --- a/decus/vmslt97a/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vmslt97a/bulletin/create.com b/decus/vmslt97a/bulletin/create.com deleted file mode 100644 index 5e90fde..0000000 --- a/decus/vmslt97a/bulletin/create.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vmslt97a/bulletin/handout.txt b/decus/vmslt97a/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vmslt97a/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vmslt97a/bulletin/install.com b/decus/vmslt97a/bulletin/install.com deleted file mode 100644 index 758acd4..0000000 --- a/decus/vmslt97a/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vmslt97a/bulletin/instruct.com b/decus/vmslt97a/bulletin/instruct.com deleted file mode 100644 index a9cf299..0000000 --- a/decus/vmslt97a/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vmslt97a/bulletin/instruct.txt b/decus/vmslt97a/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vmslt97a/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vmslt97a/bulletin/login.com b/decus/vmslt97a/bulletin/login.com deleted file mode 100644 index 5c0c2d5..0000000 --- a/decus/vmslt97a/bulletin/login.com +++ /dev/null @@ -1,31 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! If you want to have more than one BULLETIN database, replace BULL_DIR -$! with the actual directory to allow redefining BULL_DIR. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vmslt97a/bulletin/makefile b/decus/vmslt97a/bulletin/makefile deleted file mode 100644 index 964fa04..0000000 --- a/decus/vmslt97a/bulletin/makefile +++ /dev/null @@ -1,82 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.24" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vmslt97a/bulletin/master.com b/decus/vmslt97a/bulletin/master.com deleted file mode 100644 index 4cd0125..0000000 --- a/decus/vmslt97a/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vmslt97a/bulletin/mx.com b/decus/vmslt97a/bulletin/mx.com deleted file mode 100644 index 47bd33c..0000000 --- a/decus/vmslt97a/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_SOURCE to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vmslt97a/bulletin/mx.mai b/decus/vmslt97a/bulletin/mx.mai deleted file mode 100644 index ec864aa..0000000 --- a/decus/vmslt97a/bulletin/mx.mai +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_LIBRARY") .eqs. "" -$ then say "BULL_LIBRARY logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_library/LIB,SYS$SYSTEM:SYS.STB/SEL,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_LIBRARY to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P4 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P4 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P4 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p4 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p2' 'p3' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p2' 'p3' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vmslt97a/bulletin/news.alt b/decus/vmslt97a/bulletin/news.alt deleted file mode 100644 index e33d065..0000000 --- a/decus/vmslt97a/bulletin/news.alt +++ /dev/null @@ -1,254 +0,0 @@ - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales diff --git a/decus/vmslt97a/bulletin/news.com b/decus/vmslt97a/bulletin/news.com deleted file mode 100644 index fb7775e..0000000 --- a/decus/vmslt97a/bulletin/news.com +++ /dev/null @@ -1,679 +0,0 @@ -$set nover -$copy/log sys$input NEWS.ALT -$deck - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales -$eod -$copy/log sys$input NEWS.CREATE -$deck -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - -$eod -$copy/log sys$input NEWS.MODERATORS -$deck -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com -$eod diff --git a/decus/vmslt97a/bulletin/news.create b/decus/vmslt97a/bulletin/news.create deleted file mode 100644 index dc1c840..0000000 --- a/decus/vmslt97a/bulletin/news.create +++ /dev/null @@ -1,155 +0,0 @@ -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - diff --git a/decus/vmslt97a/bulletin/news.moderators b/decus/vmslt97a/bulletin/news.moderators deleted file mode 100644 index b53780f..0000000 --- a/decus/vmslt97a/bulletin/news.moderators +++ /dev/null @@ -1,260 +0,0 @@ -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com diff --git a/decus/vmslt97a/bulletin/news.txt b/decus/vmslt97a/bulletin/news.txt deleted file mode 100644 index f52d95e..0000000 --- a/decus/vmslt97a/bulletin/news.txt +++ /dev/null @@ -1,150 +0,0 @@ -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when a -user accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. It is also possible to -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) When the POST and -ADD commands are used with this folder, the messages will be posted to the news -group, rather than actually being added to the folder. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. diff --git a/decus/vmslt97a/bulletin/nonsystem.txt b/decus/vmslt97a/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vmslt97a/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vmslt97a/bulletin/optimize_rms.com b/decus/vmslt97a/bulletin/optimize_rms.com deleted file mode 100644 index 4f42e3e..0000000 --- a/decus/vmslt97a/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vmslt97a/bulletin/pmdf.com b/decus/vmslt97a/bulletin/pmdf.com deleted file mode 100644 index 732bcf2..0000000 --- a/decus/vmslt97a/bulletin/pmdf.com +++ /dev/null @@ -1,1031 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input BULLETIN_MASTER.PAS_V32 -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *) -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - - outbound : text; - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL - 100; - - VAR - line, errorsto : vstring; - bigline : bigvstring; result : rp_bufstruct; - header : he_header; - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string); - - BEGIN (* try_something *) - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *) - end; (* try_something *) - - BEGIN (* return_bad_messages *) - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt'); - try_something (he_read_header (header, qu_rtxt), 'he_read_header'); - errorsto.length := 0; - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i]; - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto), - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr); - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *) - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages (tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable. - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT - -For V3.2: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check your -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vmslt97a/bulletin/restart.com b/decus/vmslt97a/bulletin/restart.com deleted file mode 100644 index 502bfa8..0000000 --- a/decus/vmslt97a/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vmslt97a/bulletin/setuser.mar b/decus/vmslt97a/bulletin/setuser.mar deleted file mode 100644 index 153cb7b..0000000 --- a/decus/vmslt97a/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vmslt97a/bulletin/update.fil b/decus/vmslt97a/bulletin/update.fil deleted file mode 100644 index 97fb572..0000000 --- a/decus/vmslt97a/bulletin/update.fil +++ /dev/null @@ -1,11 +0,0 @@ -$ if p1 .nes. "" then FS 'P1' -$ COPY 'FM' [.SEND]/LOG -$ COPY 'FM' CMODA::IR:[BULLETIN] -$ TAB2SP 'FM' -$ RENAME 'FM' [-.NET] -$ PUR [.SEND]'FM' -$ PUR [-.NET]'FM' -$ IF FM .EQS. "CHMAIL.MAI" THEN P3 = "AAAREADME." -$ IF P2 .EQS. "" THEN COPY 'FM' [ANONYMOUS.BULLETIN]'P3' -$ IF P3 .EQS. "" THEN PUR [ANONYMOUS.BULLETIN]'FM' -$ IF P3 .NES. "" THEN PUR [ANONYMOUS.BULLETIN]'p3' diff --git a/decus/vmslt97a/bulletin/upgrade.com b/decus/vmslt97a/bulletin/upgrade.com deleted file mode 100644 index a2d77c4..0000000 --- a/decus/vmslt97a/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vmslt97a/bulletin/writemsg.txt b/decus/vmslt97a/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vmslt97a/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vmslt98a/bulletin/aaareadme.doc b/decus/vmslt98a/bulletin/aaareadme.doc deleted file mode 100644 index a6e90eb..0000000 --- a/decus/vmslt98a/bulletin/aaareadme.doc +++ /dev/null @@ -1,201 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vmslt98a/bulletin/aaareadme.txt b/decus/vmslt98a/bulletin/aaareadme.txt deleted file mode 100644 index 8bb8c90..0000000 --- a/decus/vmslt98a/bulletin/aaareadme.txt +++ /dev/null @@ -1,21 +0,0 @@ - Introduction to BULLETIN on the Vax - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VMS mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. diff --git a/decus/vmslt98a/bulletin/allmacs.mar b/decus/vmslt98a/bulletin/allmacs.mar deleted file mode 100644 index 3725b8a..0000000 --- a/decus/vmslt98a/bulletin/allmacs.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vmslt98a/bulletin/allmacs_axp.mar b/decus/vmslt98a/bulletin/allmacs_axp.mar deleted file mode 100644 index fb06e99..0000000 --- a/decus/vmslt98a/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vmslt98a/bulletin/bad.for b/decus/vmslt98a/bulletin/bad.for deleted file mode 100644 index 37d9d26..0000000 --- a/decus/vmslt98a/bulletin/bad.for +++ /dev/null @@ -1,22 +0,0 @@ - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=5,FILE='BULLNEWS.DAT',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - BULLNEWS_FILE = 'BULL_DIR:BULLNEWS.DAT' - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) WRITE (5,IOSTAT=IER) NEWS_FOLDER1_COM - END DO - - TYPE *,FOLDER1 - END diff --git a/decus/vmslt98a/bulletin/board_digest.com b/decus/vmslt98a/bulletin/board_digest.com deleted file mode 100644 index dec53c1..0000000 --- a/decus/vmslt98a/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vmslt98a/bulletin/board_special.com b/decus/vmslt98a/bulletin/board_special.com deleted file mode 100644 index 93e16c3..0000000 --- a/decus/vmslt98a/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vmslt98a/bulletin/bull_news.c b/decus/vmslt98a/bulletin/bull_news.c deleted file mode 100644 index 437ad44..0000000 --- a/decus/vmslt98a/bulletin/bull_news.c +++ /dev/null @@ -1,705 +0,0 @@ -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} diff --git a/decus/vmslt98a/bulletin/bull_newsdummy.for b/decus/vmslt98a/bulletin/bull_newsdummy.for deleted file mode 100644 index 8637998..0000000 --- a/decus/vmslt98a/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,99 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bullcom.cld b/decus/vmslt98a/bulletin/bullcom.cld deleted file mode 100644 index d6461ed..0000000 --- a/decus/vmslt98a/bulletin/bullcom.cld +++ /dev/null @@ -1,765 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 4/10/97 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER COPY, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FORCE - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER OUTPUT,VALUE(REQUIRED,TYPE=$FILE) - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB THREAD - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE, NONNEGATABLE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER FORCE - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER THREADS - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - KEYWORD GATEWAY - KEYWORD NOGATEWAY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD THREAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vmslt98a/bulletin/bullcoms1.hlp b/decus/vmslt98a/bulletin/bullcoms1.hlp deleted file mode 100644 index fe43db7..0000000 --- a/decus/vmslt98a/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1261 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is -specified. A node which does not have BULLCP running cannot have a -message broadcasted to it, (even though it is able to create a remote -folder). A broadcasted message is limited to 1600 characters - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with -> at the beginning of each line. This can be -suppressed or the indentation character changed with /[NO]INDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message will -be deleted after the node on which the message was submitted from is -rebooted. If you wish the message to be deleted after a different node -reboots, you have the option of specifying that node name. The message -deletion is keyed by BULLETIN running on the node that reboots. It -writes into the database info that the node has rebooted, and when -BULLCP wakes up and sees this info, it will delete any shutdown messages -for that node. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current process -to another process in your job. - -The ATTACH command allows you to move quickly between processes that you -have created with the SPAWN command. For example, while you are editing -a file, you can SPAWN a subprocess to read a new message. Enter the -ATTACH command to get back to back to the editing session. If you want -to read another new message, you can use the ATTACH command to get back -to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers -so that either the message text, expiration date, or the header are to -be changed. If no qualifier is added, the default is that all these -parameters are to be changed. If the text of the message is to be -changed, a file can be specified which contains the text. If the editor -is used for changing the text, the old message text will be extracted. -This can be suppressed by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /OWNER - /OWNER=string - -Specifies a new owner name. Can only be changed if you own the folder -or have privileges. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. A -range of messages can be specified, i.e. /NUMBER=1-5. Only the -expiration date and message headers can be changed if a range is -specified. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be copied -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list via -the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to be mailed to the email address. This is common if you have -users that don't have access to BULLETIN. Note: When you specify an -email address, the folder automatically will have the ADD_ONLY flag set, -which causes both ADD and POST to both add a message and send mail the -message. Note that a message added to the folder via the BBOARD feature -will also be mailed to the specified email address. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. If you create a remote folder pointing to a folder -associated with an email address, you must specify the email address in -the description of the remote folder also. Please also read about the -SET GATEWAY command. - -It is also possible to use the description to specify a news group from -which messages are fed into the folder. See the file FOLDER_TO_NEWS.TXT -for more info. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. The -identifier can not be any longer than 12 characters. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The specified node is checked to see if -a folder of the same name is located on that node. If so, the folder -will then be modified to point to that folder. For example if there was -a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be -shared between more than one node. This capability is only present if -the BULLCP process is running on the remote node via the BULL/STARTUP -command. If the remote folder name is different from the local folder -name, the remote folder name is specified using the /REMOTENAME -qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data -Base. If the RDB does not exist on your system, a privileged user will -have to create it. If a user is not in the RDB, this program will -automatically enter the user into it (unless this feature was disabled -during the compilation of this program). NOTE: See HELP SET ACCESS for -more info. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW -for more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -either /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The -BULLETIN utility must be installed properly on the other nodes. You can -specify a different username to use at the other nodes by either using -the USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. The -specified subject need not be the exact subject of the message. It can -be a substring of the subject. This is in case you have forgotten the -exact subject that was specified. Case is not critical either. You -will be notified if the deletion was successful. See also /NEGATED. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting -messages on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message. -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /CONTINUE -Used with /GROUP. Allows you to continue a search after you have broken -the search by entering a command, i.e. READ, SEARCH, etc. Note: If you -enter a SEARCH command which specifies a string, and then continue the -directory search using /CONTINUE, the new search pattern will be used -when continuing the search. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of -folder. -2 /EXPIRATION -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the DIRECTORY -command are to be written into the specified file. All qualifiers which -are valid for the EXTRACT command are valid in conjunction with /EXTRACT -except for /NEW which conflicts with the DIRECTORY /NEW qualifier. The -listof messages to be printed will be displayed on the terminal (in -nopaging format). - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /FEEDBACK -Used only in conjunction with /GROUP. Specifies to show when new news -groups are selected. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS. -2 /FROM - /FROM=[string] - -Specifies that only messages whose username contains the specified string -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Used with the search -qualifiers /SEARCH, /SUBJECT, or /FROM. Wildcards are permitted in the -specified string. Use /FEEDBACK to see when groups are selected. At -any time during the search you may enter other commands, i.e. you may -read a message, see a full directory listing, etc. You may then restart -the search listing by typing DIR/CONTINUE. For more info, see help on -the /CONTINUOUS qualifier. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don't -match the specified search command are displayed. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWS -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /OUTPUT - /OUTPUT=filename - -Specifies to write the directory output to a file rather than the -terminal. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED. -2 /SEARCH - /SEARCH=[string] - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDE -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings. - - Format: - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. /FROM is the default. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE. -2 /FROM -Specifies to exclude the message based on the message owner. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. When /FULL is specified, the EXCLUDE command will -not add an exclude, so it can't be used with any other qualifier except -for /DISABLE. -2 /LIMIT - /LIMIT=days - -Specifies that the exclude will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROM -and /SUBJECT cannot be specified at the same time. -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. If the file exists, the -message is appended to the file, unless the /NEW qualifier is specified. - - Format: - FILE [filename] [message_number][-message_number1],[...] - -If the filename is omitted, a file will be created based on the name of -the folder. - -A range of messages to be copied can optionally be specified, i.e. FILE -2-5. The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /ALL -Copies all the messages in the current folder. -2 /FF -Specifies that a form feed is placed between messages in the file. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 FIRST -Specifies that the first message in the folder is to be read. -1 Folders -All messages are divided into separate folders. New folders can be -created by any user. As an example, the following creates a folder for -GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that user -will be alerted of topics of new messages at login time, and will then -be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If instead you -specify /SEMIPRIVATE, all users can read the messages in the folder, but -only those given access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote -DECNET node. Messages added to a remote node are actually stored on the -folder on the remote node. The BULLCP process (created by -BULLETIN/STARTUP) must be running on the remote node for this option to -be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another use -is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, -and giving access to that UIC group. Only users in that UIC group will -see the messages in that folder when they log in. -1 FORWARD -Synonym for MAIL command. -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INCLUDE -This command is a synonym for the THREAD command. -1 INDEX -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after one -has read a message. /RESTART must be specified to start from the first -folder if a scan is in progress. All other qualifiers are ignored while -a scan is in progress. - - Format: - INDEX - -When a directory is displayed, you can read the first message in the -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for older -versions of BULLETIN. -2 /MARKED -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED, -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. -2 /NEW - /[NO]NEW - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message. -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -2 /SET - /[NO]SET - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -2 Suggestions -Here are keypads settings that the author personally uses. Note that -the IND/SUBS commands are useful only for reading NEWS. - -DEFINE/KEY PERIOD "IND/SUBS"/TERM -DEFINE/KEY PERIOD "IND/SUBS/NONEW"/IF_STATE=GOLD/TERM -DEFINE/KEY MINUS "READ/THREAD"/IF_STATE=GOLD/TERM -DEFINE/KEY PF1 ""/IF_STATE=GOLD/SET=NOEDIT -DEFINE/KEY PF1 ""/IF_STATE=NOEDIT/SET=NOH -DEFINE/KEY PF3 "EXT"/TERM -DEFINE/KEY KP9 "MAIL/EDIT/NOHEAD"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP8 "REPLY/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP7 "SEND/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/H"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/NOH"/IF_STATE=NOH/TERM -DEFINE/KEY KP5 "RESPOND/NOEDIT "/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP5 "RESPOND/EXTRACT/LIST/EDIT "/TERM -DEFINE/KEY KP2 "SEARCH/REP "/TERM -DEFINE/KEY KP2 "SEARCH/REV/REP "/TERM/IF_STATE=GOLD -DEFINE/KEY KP2 "SEARCH/REV "/IF_STATE=NOEDIT -DEFINE/KEY COMMA "SPAWN"/TERM -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying an -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" must -be specified as xxx%"""address""". -2 /EDIT -Specifies that the editor is to be used to edit the message before -mailing it. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers] - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 MODIFY -Modifies the database information for the current folder. Only the -owner of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to automatically mailed to the email address. This is common if -you have users that don't have access to BULLETIN. In order to do this, -you should use the SET ADD_ONLY command. This causes all messages added -to the folder to also be sent to the email address. This also applies -to messages which are added via the BBOARD feature. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. Please also read about the SET GATEWAY command. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can -be specified following the folder name, i.e. COPY NEWFOLDER 2-5. -However, if the old folder is remote, they will be copied but not -deleted, as only one message can be delted from a remote folder at a -time. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be moved -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEWS -Displays the list of available news groups. - -Format: - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed. - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL will -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /DEFAULT -If specified, will show news groups that have be defined as default -groups using the SET SUBSCRIBE command. -2 /NEWGROUP -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /PERMANENT -If specified, will show news groups that have be defined as permanent -groups using the SET SUBSCRIBE command. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B. -2 /STORED -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 New_features -Here is a list of new features which may be of interest to the general -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - -------------------------------------------------------------------------- -V 2.24 -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -SHOW EXCLUDE and INCLUDE commands added. 5/16/95 - -V 2.21 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -Added /FOLLOWUP to POST command when used with news groups. It specifies -which news group you want replies to your message to be sent to. 10/28/94 - -V 2.20 - -Logical names can be specified in POST/GROUPS=. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/11/94 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group by -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92 - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. diff --git a/decus/vmslt98a/bulletin/bullcoms2.hlp b/decus/vmslt98a/bulletin/bullcoms2.hlp deleted file mode 100644 index 662cf64..0000000 --- a/decus/vmslt98a/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1463 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with -> at the -beginning of each line. This can be suppressed or the indentation -character changed with /[NO]INDENT. -2 /FOLLOWUP - /FOLLOWUP=string - -Specifies that any replies generated by people reading the message -should be sent to the specified newsgroup. This is useful if you want -to post to more than one group, but don't want reply messages posted on -all the groups. To specify more than one newsgroup, surround the list -with quotes, i.e. FOLLOWUP="newsgroup1,newsgroup2". If replies should -only be sent to the message owner and not a newsgroup, the string -"poster" should be specified. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message -to the specified NEWS group(s) in addition to the selected NEWS group. -Logical names are allowed. -2 /HEADER -Allows customized headers line to be added to the message header. When -specified, header lines can be added by inserting them at the top of the -message, with the header lines and the text of the message separated by -a blank line. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. -In order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply -surround the exclusive text starting with the line "START " -and ending with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The file created by the PRINT command is not -released to the print queue until you exit, unless you add the qualifier -/NOW or change one of the print job's qualifiers. Multiple messages are -concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /CANCEL -Cancels any messages waiting to be printed. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL level -to find out the name of the mounted form and the default form for a -particular queue. If you specify a form whose stock is different from -the stock of the form mounted on the queue, your job is placed in a -pending state until the stock of the mounted form of the queue is set -equal to the stock of the form associated with the job. (In order to -have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the file -or files have been printed. If /NONOTIFY is specified, there is no -notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 QUIT -Exits the BULLETIN program. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. If you -specify a number greater than the number of messages in the folder, the -last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -/HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /THREADS -Reads all messages that have been included by the THREAD command. If -neither message number nor /SINCE is specified, the search starts with -the first new message. After the first READ/THREADS command, typing -READ/THREADS will continue the search from where it left off (as long as -you do not select a different folder or news group). Also, after a -message has been fully read, if the return key is hit without entering a -command, it is equivalent to typing the READ/THREADS command. Messages -which are parts of threads and under read will be displayed in the -directory listing by a preceeding #. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /INDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read -them. (Note: Reading the last message does the same thing, but RESET -does it without having to read it.) -2 /CURRENT -Resets the new message counter to the current message. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using the -qualifer /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected or /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text strings. - - Format: - - SEARCH [search-string[,...]] - -The search starts from the first message in the current folder. You can -specify the message to start at using the qualifier /START. If you use -this qualifier without a parameter, it starts with the current message. -The search includes both the text of the message, and the description -header. If a "search-string" is not specified, a search is made using -the previously specified string, starting with the message following the -one you are currently reading (or have just read). After fully reading -the message found by the search, if you hit the return key without -entering a command, it is equivlanent to typing SEARCH without a search -string and will search for the next message. Once started, a search can -be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FEEDBACK -Used only in conjunction with /FOLDER and /GROUP. Specifies to show -when new folders or news groups are selected. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for a -match. If, during a search, no more matches or messages are found, the -next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. Use /FEEDBACK to see when folders are -selected. News groups can be specified here. However, to search news -group with wild cards, use /GROUP. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Wildcards are permitted in -the specified string. If the string does not contain an * and does not -specify a news group, * is automatically placed at the beginning and end -of the string. I.e. if the string is "comp", then all news groups -containing the word "comp" will be searched. Use /FEEDBACK to see when -groups are selected. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /MATCH - /MATCH[=option] - -Interprets and matches multiple search strings in one of the following -ways: - - AND A match occurs only if all of the strings are found. - - OR A match occurs if any of the strings are found. - - XOR A match occurs if only one of the strings is found. - -If you specify none of these options, the default is /MATCH=OR. If you -specify the /NEGATED qualifier, you will get the negated operation. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If no -starting message is specified, the search is started from the last -message. /REVERSE must be specified with a search string. -2 /START - /START=message_number - -Specifies the message number to start the search at. If you omit the -message number, it starts with the current message. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. UICs can contain -wildcards, i.e. [130,*]. Note that by default, a process is given the -process rights id SYS$NODE_nodename, where nodename is the decnet -nodename. Thus, by specifing this id, a folder can be restricted to a -specific node, which is useful when the folder is shared among nodes in -a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUS -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name. - - Format: - - SET [NO]ANONYMOUS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. - - Format: - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If -ADD_ONLY is set and a mailing address is present (see /DESCRIPTION), -when a message is added to the folder, it will also be mailed to the -address (in addition to being stored in the folder). This also applies -to a message which is added via the BBOARD feature . If ADD_ONLY is set -and a user uses the POST command, the ADD command will be used instead. -One use for this is to mail messages in a folder to users who do not -have access to BULLETIN. - - Format: - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages. - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30" -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The form -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY. -The time will always be 00:00, even if the time is specified on the line. -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be: - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account. - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV. -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION. -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by the -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier. -2 COMPRESS -Specifies that messages added to the folder will be in compressed format. -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires -very little cpu overhead. - - Format: - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed every -time when logging in, until the new messages are read. Normally, the -BRIEF setting causes notification only at the first time that new messages -are detected. - - Format: - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - - Format: - - SET DEFAULT_EXPIRE days - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages. - - Format: - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it. -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format: - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) -2 EXCLUDE -Specifies to ignore any EXCLUDEs or THREADs that are present. - - Format: - - SET [NO]EXCLUDE - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or THREADs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 EXLIMIT -Specifies the default limit for the EXCLUDE command. - - Format: - - SET EXLIMIT days - -If no match is found for an exclude after the specified number of days, -the exclude will automatically be deleted. The default is no limit, -which is specified by specifying 0 days. This default can be overriden -by the /LIMIT switch on the EXCLUDE command. -2 FILE_DIRECTORY -Select the directory where messages are written to when using the -EXTRACT or file COMMAND. By default, the message is written into the -current directory. - - Format: - - SET FILE_DIRECTORY [directory] - -If directory is omitted, the setting is removed. Note: This information -is stored in the customization file (SYS$LOGIN:BULL.CUSTOM). -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new messages will be displayed for upon -logging in. -2 GATEWAY -Valid for folders that are associated with an email address. Messages -which are mailed to the email address are by default modified so that -the subject line starts with the folder name, followed by the phrase -"folder message: ", followed original subject line. If you specify -GATEWAY, the subject line is not modified this way. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to by -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. -2 LIBRARY -Specifies a library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command to see if there are other libraries. -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NAME -Copies all stored settings from one user to another. Used when a user's -account name is changed. - - Format: - - SET NAME old-username new-username -2 NEWS -Changes attributes of the specified news group or class of news groups. -This command requires privileges. - - Format: - - SET NEWS [news-group] - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALL - /NOALL - -If specified with /CLASS or /DEFAULT, all groups that are presently -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of any -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the default -attributes (using /DEFAULT) with /NOALL, the attributes for misc.test -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. -3 /CLASS - /CLASS=classname - -Specifies to modify attributes for a class of news groups rather than a -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes of -existing groups which are in the class are modified, and any groups -created in the future will automatically have those attributes. -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETE -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLE -Specifies that the news group is enabled and can be accessed. This is -the default. -3 /EXPIRATION - /EXPIRATION=days - -Specifies the default expiration time for messages if none is specified. -The default is 7. -3 /FULL -Control whether all information of the news groups is displayed, i.e. -the access list if the news group is private. This information is only -those who have access to that folder. -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified is --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default. -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is posted -every month with an expiration date of one month in the future. -3 /PRIVATE - /PRIVATE - /NOPRIVATE - -Specifies that the news group or class can have it's access modified by -the SET ACCESS command. To accomplish this, a file is created in -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access -to news groups in that class is to set /NOPRIVATE, as then time won't be -wasted checking a file for ACLs. -3 /STORED - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessed -via the network from the server node. This results in faster access, -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED. -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder. - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node, -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are logged -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 POST_ONLY -Specifies that the selected folder has the POST_ONLY attribute. This -causes the ADD command to mail the message to the mailing address if it -is present (see /DESCRIPTION), rather than add to the folder. - - Format: - - SET [NO]POST_ONLY -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format: - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers. -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed. -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that READNEW is a permanent flag and cannot be changed by the -individual. This is a privileged qualifier. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all -users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged -qualifier. -2 STRIP -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If STRIP -is set, the header of the mail message will be stripped off before it is -stored as a BULLETIN message. - - Format: - - SET [NO]STRIP - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SUBSCRIBE -Can be used to force users to be subscribed to the selected news group. -This is a privileged command. - - Format: - - SET SUBSCRIBE - -Note: If you execute the commands SET SHOWNEW, READNEW, BRIEF, or -NOTIFY, and add /DEFAULT or /PERMAMENT, it is equivalent to doing a SET -SUBSCRIBE command with the addition that the specified feature will be -the default and/or permanent setting. -3 /ALL -Specifies that all present and future users will be subscribed to the -news group. -3 /DEFAULT - /[NO]DEFAULT - -Specifies that new users will automatically be subscribed to the news -group. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that new users will automatically be subscribed to the news -group and that users cannot unsubscribe the news group. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 EXCLUDE -Displays the list of excludes which are present for the current folder. -The right hand side of the display shows the date of the last time a -match for the exclude was found, and also the number of days from the -time of the last match after which the excludes expires. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected -via the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 THREAD -Displays the list of includes which are present for the current folder. -2 KEYPAD -Displays the keypad command definitions. - - Format: - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either SET KEYPAD, or if /KEYPAD is -specified on the command line, the keypad keys will be defined as -commands. The default settings for the keypad are shown via SHOW KEYPAD -or HELP KEYPAD. Settings can be changed by using an initialization file -with DEFINE/KEY commands. BULLETIN looks first for the file pointed to -by the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -3 /STATE - /STATE=(state,state,...) - -Specifies the name of a state for which the specified key definitions -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when a -key name has been specified. -2 LIBRARY -Shows the library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the /ALL -qualifier to see if there are other libraries. -3 /ALL -Specifies to show all available libraries. -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGIN - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDER - /FOLDER=[foldername] - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups. -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSION -Shows the version of BULLETIN and the date that the executable was -linked. -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of the -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. -1 THREAD -Specifies that the current message is defined as a thread based on -either the subject or the message owner. Since threads are much more -commonly based on the subject, this is the default. Threads are read by -using the command READ/THREADS. - - Format: - THREAD [string] - -If a string is specified, then the message is a thread if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one THREAD may be -specified per folder. - -Note: EXCLUDEs take precedence over THREADs. -2 /ALL -Used with /DISABLE to specify to disable all THREADs. -2 /DISABLE -Specifies to permanently disable the THREAD. -2 /FROM -Specifies to include the message based on the message owner. /FROM -and /SUBJECT cannot be specified at the same time. -2 /LIMIT - /LIMIT=days - -Specifies that the thread will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to include the message based on the message subject. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 Storing_Threads -THREADs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] -1 UNSUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See the -SUBSCRIBE command for further info. -1 Usenet_news -BULLETIN can also read USENET NEWS if your system has network access to -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group -in order to keep track of which messages you have read in that group. -Most of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read all your subscribed news groups that have new -messages, use INDEX/SUBSCRIBE. diff --git a/decus/vmslt98a/bulletin/bulldir.inc b/decus/vmslt98a/bulletin/bulldir.inc deleted file mode 100644 index ab5027c..0000000 --- a/decus/vmslt98a/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vmslt98a/bulletin/bullet1.com b/decus/vmslt98a/bulletin/bullet1.com deleted file mode 100644 index dff1150..0000000 --- a/decus/vmslt98a/bulletin/bullet1.com +++ /dev/null @@ -1,2776 +0,0 @@ -$set nover -$copy/log sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. -$eod -$copy/log sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) -$eod -$copy/log sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. -$eod -$copy/log sys$input BULLETIN.LNK -$deck -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.3" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.3" -$eod -$copy/log sys$input BULLFILES.INC -$deck -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ -$eod -$copy/log sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) -$eod -$copy/log sys$input BULLNEWS.INC -$deck - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ -$eod -$copy/log sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy/log sys$input BULL_NEWS.C -$deck -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s,s1; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} - - -smtp_assign() -{ - int n; - -#if MULTINET || TWG - /* - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()). - */ - - if (!hp1) { - int h[4],i; - if (sscanf(node1,"%d.%d.%d.%d",&h[0],&h[1],&h[2],&h[3]) == 4) { - for (i=0;i<4;i++) if (h[i] < 0 || h[i] > 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp1->h_addrtype; - memcpy(&sin.sin_addr, hp1->h_addr, hp1->h_length); - } -#if TWG - sin.sin_port = htons(25); -#else - sin.sin_port = htons1(25); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s1,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s1,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node1),DSC$K_CLASS_S,DSC$K_DTYPE_T,node1}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s1,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s1,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - - -smtp_create() -{ -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s1,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(25); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s1,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#else - if (!(sys$qiow(0,s1,IO$_CREATE,&iosb,0,0,node1,25,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#endif - - return(1); -} - -smtp_disconnect() -{ -#if UCX - sys$cancel(s1); - sys$qiow(0,s1,IO$_DEACCESS,0,0,0,0,0,0,0,0,0); -#endif - sys$dassgn(s1); -} - - -smtp_connect() -{ - if (!smtp_gethost()) return(0); - if (!smtp_assign()) return(0); - if (!smtp_socket()) return(0); - return(smtp_create()); -} - -char node2[132]; - -smtp_gethost() -{ - /* - * Get the IP address of the SMTP host. - * As of MULTINET 3.0, cannot be done at AST level - * so can't do in SMTP_ASSIGN(), as BULLCP calls it at - * AST level if the decnet gateway feature is used. - */ -#if TWG - struct hostent *gethostbyname(); -#else -#if MULTINET -#endif -#endif - - node1 = getenv("BULL_SMTP_SERVER"); - if (!node1) { -#if TWG - gethostname(node2,132); -#else -#if MULTINET - gethostname1(node2,132); -#endif -#endif - node1 = node2; - } - -#if TWG - hp1 = gethostbyname(node1); -#else -#if MULTINET - hp1 = gethostbyname1(node1); -#endif -#endif - return(1); -} - - - -smtp_write_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - - -smtp_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s1,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - - -smtp_socket() -{ - -#if MULTINET || TWG - if (!(sys$qiow(0,s1,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s1,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#endif - - return(1); -} -$eod -$copy/log sys$input CHANGES.TXT -$deck -Added the SET GATEWAY command to change the how the subject lines looks in -messages which are sent to an email address associated with a folder. 2/25/98 - -Many bugs were fixed, mainly with respect to the news-email-folder gateway. - -V2.3 - -Added the ability to create a folder that can post and read to a news group, -and can send and read messages via email. See NEWS_TO_FOLDER.TXT for more -info. 4/18/97 - -Added the ability for BULLETIN to see news groups from secondary news groups -(see NEWS.TXT). 4/18/97 - -V 2.25 - -Changes to make it easier to click on news group name to select them: You can -enter a news group name at the prompt and it will select it (without typing -SELECT). News groups displayed without period at end when BULLETIN lists the -ones that have new messages. NEWS/SUBS has space between * and news group -when denoting which ones have new messages. 3/21/96 - -V 2.24 - -When replying to a message in a news group that has been crossposted, give the -user the option of just posting the reply to the news group in which the -message is being read rather than all the news groups in the crosspost. -11/20/95 - -Messages added to folders and stored news groups are now marked as being read -so that the person does not see them when doing a READ/NEW. 11/20/95 - -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. -$eod -$copy/log sys$input DEBUG.TXT -$deck -$eod -$copy/log sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy/log sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy/log sys$input NEWS.TXT -$deck -BULLETIN has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was -to run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added -the ability in BULLETIN (actually BULLCP) so that it acts as as a gateway -between decnet and tcp for NEWS. This method does not require spawning any -processes, since the detached process BULLCP is always present, so the access -is very fast. Also, since BULLETIN uses a shared database to store info on -the NEWS groups and periodically updates it, there is no need for that to be -done when a user accesses the NEWS groups. Several other NEWS readers do this -when you run them, which is why they take a long time to start up. It is also -possible to feed NEWS groups into a "real" BULLETIN folder, so that the -messages are saved on disk (see the file NEWS_TO_FOLDER.TXT). - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER to -be a system logical name pointing to either your internet or decnet NEWS node. -If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -It is also possible for BULLETIN to access news groups that are located on -other news servers than the one specified by BULL_NEWS_SERVER. This is done -by creating the file BULL_DIR:BULL_ALT_NEWS.LIS and adding a line which -containsthe name of the news group and the news server where it's located. -The format is news-group-name:news-server-name. - -In order to post messages, BULLETIN needs to know the internet nodename of the -local host. This is done automatically for nodes running MULTINET. For other -nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This can -be hardcoded into the source by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, -it will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will -cause subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -If you have any problems or questions, please let me know. - MRL -$eod -$copy/log sys$input NEWS_TO_FOLDER.TXT -$deck -It is possible to automatically have messages from a news group be fed into a -real folder, and visa versa. This allows BULLETIN messages to be shared with -a news group, thus giving access to such messages to people who do not have -access to BULLETIN. This can also be combined with email access for people -who have neither BULLETIN nor news group access. - -To associate a folder with a news group, place the name of the news group into -the folder description surrounded by <>, i.e. . It must be in -lower case. (Other text is allowed in the description, i.e. "THIS IS A TEST -FOLDER ".) When messages are added the folder, they are also sent -to the news group, and new messages from the group are posted to the folder -(via the BULLCP process which wakes up on a periodic basis). Whenever you -modify the folder description and specify the news group name, you will be -prompted as to whether you want to initializee the news group counter to -either load all the messages present in the news group, or to load only news -messages that appear there. - -Messages posted to the news group from such a folder have a special line in -their header indicating they were sent from that node using bulletin. When -bulletin feeds new postings back to the folder, it will see that header line -and also see that it was posted from that node, and thus will avoid adding it -to the folder (and thus creating a duplicate message). Note that messages are -added to the news group via the BULLCP process, so they will not appear -immediately after being added to the folder. - -If you are modifying an existing folder to make it associated with a news -group, and if you want to copy any existing messages in the folder to the news -group, you can do that by using the command COPY/ORIGINAL/LOCAL and specifying -the news group as the destination. /ORIGINAL will cause the original owner -names and dates to be preserved (note, however, that dates older than 14 days -in the past are not usually accepted by the news server, so dates older than -that will be changed to the present date). /LOCAL will create the special -header line in the messages to prevent BULLCP from adding those messages back -to the folder from the news group. /ALL can be specified to copy all the -messages in the folder. - -If you create a remote folder that points to a folder that has a news group -associated with it, you do not have to specify the news group in the -description of the remote node. However, on the node on which the folder -actually exists, the news group has be a stored news group, i.e. you must -issue the command SET NEWS/STORED for that news group. - -When a news group is specified for a folder, it is still possible to associate -an email address for the messages to be sent to in the folder description. -You do this by using [] to enclose the address rather than the usual <>, i.e. -[mrl@pfc.mit.edu] See help in BULLETIN on the command CREATE/DESCRIPTION for -more info about associated email addresses. Note that these features allow -you to create a full gateway between a news group and a mailing list. -$eod -$copy/log sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod -$copy/log sys$input WRITEMSG.TXT -$deck -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/vmslt98a/bulletin/bullet2.com b/decus/vmslt98a/bulletin/bullet2.com deleted file mode 100644 index ea6c209..0000000 --- a/decus/vmslt98a/bulletin/bullet2.com +++ /dev/null @@ -1,1701 +0,0 @@ -$set nover -$copy/log sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy/log sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy/log sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 4/10/97 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER COPY, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FORCE - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER OUTPUT,VALUE(REQUIRED,TYPE=$FILE) - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB THREAD - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE, NONNEGATABLE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER FORCE - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER THREADS - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD THREAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE -$eod -$copy/log sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP -$eod -$copy/log sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP -$eod -$copy/log sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy/log sys$input BULL_NEWSDUMMY.FOR -$deck - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END - - - - SUBROUTINE SMTP_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION SMTP_CONNECT - - SMTP_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION SMTP_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION SMTP_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_READ_PACKET = 0 - - RETURN - END -$eod -$copy/log sys$input CREATE.COM -$deck -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CC = "CC/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE DECC$USER_INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA] -$ CC BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK -$eod -$copy/log sys$input INSTALL.COM -$deck -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy/log sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy/log sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.3" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* -$eod -$copy/log sys$input OPTIMIZE_RMS.COM -$deck -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS -$eod -$copy/log sys$input RESTART.COM -$deck -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START -$eod -$copy/log sys$input SETUSER.MAR -$deck - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program -$eod -$copy/log sys$input UPGRADE.COM -$deck -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE -$eod diff --git a/decus/vmslt98a/bulletin/bulletin.cld b/decus/vmslt98a/bulletin/bulletin.cld deleted file mode 100644 index 95c9f31..0000000 --- a/decus/vmslt98a/bulletin/bulletin.cld +++ /dev/null @@ -1,44 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vmslt98a/bulletin/bulletin.com b/decus/vmslt98a/bulletin/bulletin.com deleted file mode 100644 index 84cf294..0000000 --- a/decus/vmslt98a/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vmslt98a/bulletin/bulletin.for b/decus/vmslt98a/bulletin/bulletin.for deleted file mode 100644 index 27b5a59..0000000 --- a/decus/vmslt98a/bulletin/bulletin.for +++ /dev/null @@ -1,2129 +0,0 @@ -C -C BULLETIN.FOR, Version 2/27/98 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - DATA NEXT_COMMAND/' '/ - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - CALL INIT_BULLETIN(.TRUE.) - -C -C The MAIN loop for processing bulletin commands. -C - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IF (IER.GT.0) THEN - IF (INDEX(INCMD(:IER),' ').EQ.0.AND. - & INDEX(INCMD,'/').EQ.0.AND. - & INDEX(INCMD,'.').GT.0) INCMD = 'SELECT '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE IF (READ_COUNT.NE.0) THEN - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - ELSE IF (NEXT_COMMAND.NE.' ') THEN - INCMD = NEXT_COMMAND - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL DO_COMMAND(INCMD) - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - CALL DO_COMMAND(INCMD) - -100 CONTINUE - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) - - END - - - - - SUBROUTINE DO_COMMAND(INCMD) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - CHARACTER*(*) INCMD - - NEXT_COMMAND = ' ' - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (HLEN.EQ.0) THEN - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - END IF - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL'.OR. - & INCMD(:4).EQ.'POST'.OR. - & INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - WRITE (6,'('' ERROR: /FOLDER not valid when posting'', - & '' a message to a news group.'')') - ELSE - INCMD = 'POST '//INCMD(4:) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - END IF - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,'('' ERROR: There are no more preceding messages.'')') - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').AND.CLI$PRESENT('NEWS')) THEN - WRITE (6,'('' ERROR: /NEWS and /FOLDER cannot be '' - & ''specified at the same time.'')') - ELSE IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.,.FALSE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR - ELSE IF (INCMD(:4).EQ.'INCL'.OR. ! INCLUDE? - & INCMD(:4).EQ.'THRE') THEN ! THREAD? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IF (CLI$PRESENT('THREADS')) NEXT_COMMAND = 'READ/THREADS' - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - NEXT_COMMAND = 'SEARCH' - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'FI') THEN ! SET FILE_DIRECTORY? - CALL SET_CUSTOM('file_directory') - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SH') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SU') THEN ! SET SUBSCRIBE? - IF (REMOTE_SET.GE.3) THEN - D1 = 0 - D2 = 0 - D3 = 0 - CALL SET_FOLDER_DEFAULT(D1,D2,D3) - ELSE - WRITE (6,'('' ERROR: Command invalid for folder.'')') - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'GEN') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOGEN') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LIB') THEN ! SET LIBRARY? - CALL SET_LIBRARY - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS? - CALL SET_NEWS - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE? - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE? - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:3).EQ.'EXL') THEN ! SET EXLIMIT? - CALL SET_CUSTOM('exclude_limit') - ELSE IF (BULL_PARAMETER(:4).EQ.'NAME') THEN ! SET NAME? - CALL SET_NEWNAME - ELSE IF (BULL_PARAMETER(:3).EQ.'GAT') THEN ! SET GATEWAY? - CALL SET_FOLDER_FLAG(.TRUE.,15,'GATEWAY') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOGAT') THEN ! SET NOGATEWAY? - CALL SET_FOLDER_FLAG(.FALSE.,15,'GATEWAY') - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'EX') THEN ! SHOW EXCLUDE? - CALL SHOW_EXCLUDE(0) - ELSE IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:2).EQ.'IN'.OR. - & BULL_PARAMETER(:2).EQ.'TH') THEN ! SHOW INCLUDE? - CALL SHOW_EXCLUDE(1) - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SHOW LIBRARY - CALL SHOW_LIBRARY - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATION - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1) - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN? - CALL TAG(.FALSE.,2) - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - - RETURN - END - - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER INEXDATE*12,INEXTIME*12,INDENT*4 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,BULLETIN_SUBCOMMANDS - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT') - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - LENI = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',INDENT,LENI) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LENI.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') INDENT(:LENI)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2100' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2100' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60) - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60) - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - IF (CLI$PRESENT('EXTRACT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35 - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - BLENGTH = BLENGTH + ILEN - 1 + 2 - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE. - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting by '', - & I6,'' characters. Limit is '',I3,''.'')') - & BLENGTH - 82*12 - 2, 82*12 - 2 - CALL GET_INPUT_PROMPT(INPUT,ILEN, - & 'Type C to broadcast anyway, A to only ADD message,' - & //' or Q to Quit: ') - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN - BRDCST = .TRUE. - ELSE IF (.NOT.STREQ(INPUT(:1),'C')) THEN - GO TO 910 - END IF - END IF - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! Username - END IF - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THEN - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '// - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK) - END IF - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletin - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IF - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF (FOLDER_NUMBER.GE.0) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL ADD_TAG(IER1,2) - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF -C -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP, -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same cluster -C as that of the BULLCP node. -C - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET) - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - ELSE IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR. - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - IF (BTEST(FOLDER_FLAG,10).OR.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & INDESCRIP(:LENDES),STATUS) - ELSE - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LENDES),STATUS) - END IF - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & ERR=910,FORM='FORMATTED') - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IF - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INLINE,ILEN).NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INLINE,ILEN) - IF (LENFRO.EQ.0) THEN - INPUT = INLINE(:ILEN)//',' - ELSE - INPUT = INPUT(:LENFRO)//INLINE(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - - IF (LENFRO.GT.1) THEN - LENFRO = LENFRO - 1 - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INPUT(I:I).EQ.'"') THEN - INPUT = INPUT(:I)//'"'//INPUT(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & INDESCRIP(:LENDES),STATUS) - END IF - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:INDEX(FOLDER_DESCRIP,'>')-1) - CALL NEWS_POST(BULL_PARAMETER(:LEN_P),.FALSE.,IER, - & INDESCRIP) - END IF - -200 IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GO TO 200 - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GO TO 200 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 200 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 200 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 200 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*4 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP)) - - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG) - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC' - - DATA READ_UAI/.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE. - RETURN - END IF - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE. - END IF - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURN - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')') - RETURN - END IF - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN) - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN() - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - RETURN - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - SUBROUTINE INIT_BULLETIN(NOX) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - DATA PAGE_LENGTH/24/,PAGE_WIDTH/80/ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (NOX) CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER(:LEN_P) - CALL CHECK_DIR(BULL_PARAMETER,.FALSE.) - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - END IF - CALL LIB$REVERT - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE IF (COMMAND_PROMPT(I:I).EQ.'/') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL(.FALSE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS1') THEN - CALL NEWS2BULL(.TRUE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'SMTP') THEN - CALL SEND_MAIL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - IF (NOX) CALL CRELNM('SYS$INPUT','TT') ! Input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - IF (NOX) CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - - CALL OPEN_OLD_TAG - - IF (.NOT.NOX) THEN - CALL NEW_MESSAGE_NOTIFICATION - RETURN - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IF - END IF - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bulletin.hlp b/decus/vmslt98a/bulletin/bulletin.hlp deleted file mode 100644 index 8479322..0000000 --- a/decus/vmslt98a/bulletin/bulletin.hlp +++ /dev/null @@ -1,151 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vmslt98a/bulletin/bulletin.lnk b/decus/vmslt98a/bulletin/bulletin.lnk deleted file mode 100644 index 135555e..0000000 --- a/decus/vmslt98a/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.24" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.24" diff --git a/decus/vmslt98a/bulletin/bulletin0.for b/decus/vmslt98a/bulletin/bulletin0.for deleted file mode 100644 index 98263c4..0000000 --- a/decus/vmslt98a/bulletin/bulletin0.for +++ /dev/null @@ -1,2520 +0,0 @@ -C -C BULLETIN0.FOR, Version 9/20/96 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET.EQ.1) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IER1 = SBULL + 1 - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER1) - SUBJECT = DESCRIP - IER2 = 0 - IF (IER2.EQ.0.AND.IER1.EQ.SBULL+1) CALL - & REMOTE_DELETE(SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - ELSE IF (REMOTE_SET.EQ.3) THEN - BULL_DELETE = SBULL - 1 - IER = 0 - IF (CLI$PRESENT('REASON')) THEN - CALL CLI$GET_VALUE('REASON',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) RETURN - IF (EBULL.EQ.SBULL) THEN - WRITE(6,1030) - RETURN - END IF - END IF - END DO - SUBJECT = DESCRIP - IF (.NOT.TEST_NEWS_OWNER().AND.SETPRV_PRIV().AND. - & .NOT.CLI$PRESENT('FORCE')) THEN - SUBJECT = 'CanceL' - IF (CLI$PRESENT('REASON')) THEN - SUBJECT = SUBJECT(:6)//BULL_PARAMETER(:LEN_P) - END IF - END IF - CALL REMOTE_DELETE - & (SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - RETURN - END IF - END DO - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - SUBJECT = DESCRIP - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.NE.USERNAME - END IF - IF (ASK.AND..NOT.CLI$PRESENT('FORCE')) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - IF (REMOTE_SET.EQ.4) THEN - SUBJECT = 'CanceL' - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.(TEST_NEWS_OWNER().OR. - & SETPRV_PRIV())) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2),EX(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:9).EQ.'19') EXDATE(8:9) = '18' - IF (EXDATE(8:9).EQ.'20') EXDATE(8:9) = '19' - IF (EXDATE(8:9).EQ.'18'.AND.EXDATE(10:10).LT.'6') - & EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX,EX) - IER = SYS$ASCTIM(,INPUT,EX,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - DATA EXCLUDE_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DIRMODE/ DIRMODE - DATA DIRMODE/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - CHARACTER GROUP*80,STAT*4 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - DIRMODE = .TRUE. - - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - FOUND = 0 - OUT = 6 - - CONT = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - CONT = CLI$PRESENT('CONTINUE') - ELSE IF (INCMD(:3).EQ.' '.AND.NFOLDER.LT.0) THEN - CONT = .TRUE. - END IF - IF (CONT) THEN - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - SUBJECT = SUBJECT1 - REPLY = REPLY1 - SEARCH = SEARCH1 - FROM_SEARCH = FROM_SEARCH1 - SINCE = SINCE1 - NEW = NEW1 - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - IF (.NOT.ANY_SEARCH) THEN - WRITE (6,'('' ERROR: No previous search to continue.'')') - RETURN - END IF - INCMD = ' ' - LEN_P = 0 - DIR_COUNT = DIR_COUNT1 - NFOLDER = NFOLDER1 - I = DIR_COUNT - IF (DIR_COUNT.EQ.-1) THEN - I = SBULL - 1 - END IF - GO TO 200 - END IF - NFOLDER = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('OUTPUT',BULL_PARAMETER,LEN_P)) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & DEFAULTFILE='.LIS', - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - WRITE(6,1000) BULL_PARAMETER(:LEN_P) - RETURN - END IF - OUT = 3 - INQUIRE (UNIT=3,NAME=BULL_PARAMETER) - WRITE (6,1040) BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - END IF - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - EXTRACTING = CLI$PRESENT('EXTRACT') - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - NEGATED = CLI$PRESENT('NEGATED') - IF (SEARCH) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (SUBJECT) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (FROM_SEARCH) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (REPLY) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3 - NEGATED = .TRUE. - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - IF (INCMD(:3).EQ.'IND') THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - REPLY_FIRST = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - ELSE - NEW = .FALSE. - END IF - END IF - OUTPUT = EXTRACTING.OR.PRINTING - - START = .FALSE. - SINCE = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - NFOLDER1 = -1000 - SUBJECT1 = SUBJECT - REPLY1 = REPLY - SEARCH1 = SEARCH - FROM_SEARCH1 = FROM_SEARCH - I = SBULL - 1 - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - SINCE1 = SINCE - NEW1 = NEW - GOTO 200 - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - CALL INIT_QUEUE(EXCLUDE_D1,%DESCR(I)) - EXCLUDE_D = EXCLUDE_D1 - NEXCLUDE = 0 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - IF (NEW.AND.IER.EQ.0) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - IF (READ_TAG) CALL DECREMENT_MSG_KEY - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - I = I - 1 - END DO - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - IF (NUM.GT.0) I = I - 1 - END DO - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) THEN - J = J + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT.OR.OUT.EQ.3) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - EXCLUDE_D = EXCLUDE_D1 - SEXC = NBULL + 1 - LEXC = 0 - DO I=1,NEXCLUDE - CALL READ_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(J)) - IF (J.LT.SEXC) SEXC = J - IF (J.GT.LEXC) LEXC = J - END DO - I1 = SBULL - I = SBULL - DO WHILE (I.LE.EBULL) - EXCLUDE_D = EXCLUDE_D1 - J = 0 - IER = I1 - IF (I1.GE.SEXC.AND.I1.LE.LEXC) THEN - N = NEXCLUDE - DO WHILE (N.GT.0.AND.J.EQ.0) - CALL READ_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(J)) - N = N - 1 - IF (J.NE.I1.AND.J.NE.-I1) J = 0 - END DO - IF (J.LE.0) THEN - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(I1,IER) - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - IF (J.LT.0) SYSTEM = IBSET(SYSTEM,8) - END IF - ELSE - CALL READDIR(I1,IER) - END IF - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1 - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - I = I + 1 - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1 - END IF - I1 = I1 + 1 - END DO - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - EBULL = EBULL - SBULL + DIR_COUNT - SBULL = DIR_COUNT - I = SBULL - END IF - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY, - & TAG_TYPE) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVE - END IF - END IF - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - END IF - ELSE - NBULL = 0 - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN - DIR_TYPE = 'seen' - END IF - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - IF (INCMD(:3).EQ.'DIR'.AND.ANY_SEARCH) THEN - IF (.NOT.CLI$PRESENT('START').AND. - & .NOT.CLI$PRESENT('CONT')) THEN - WRITE (6,'('' No matches found starting search'', - & '' from message number '',I)') SBULL - DIR_COUNT = -1 - GO TO 9999 - END IF - END IF - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - IF (NFOLDER.EQ.0) CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT) - - TAG = (BULL_TAG.AND.(REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1)).OR. - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THEN - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN - START_SEARCH = BULL_POINT - END IF -200 CLOSED = .FALSE. - IF (ANY_SEARCH.OR.OUTPUT) THEN - NUM = 0 - IF (NFOLDER.NE.-1000) THEN - CLOSED = .TRUE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - CLOSED_FILES = .FALSE. - SEARCH_NUM = 1 - REVERSE = .FALSE. - END IF - DO WHILE (I.LE.EBULL.AND.FOUND.GT.-3) - IF (.NOT.ANY_SEARCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (NFOLDER.NE.-1000.AND.I.GE.SBULL) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SLEN,0, - & START_SEARCH,REVERSE,SUBJECT,REPLY_FIRST,.FALSE., - & .TRUE.,FROM_SEARCH,NEGATED,.FALSE.) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - IF (NFOLDER.LT.0.AND.(I.EQ.F_START.OR.I.EQ.DIR_COUNT)) THEN - IF (FEEDBACK) CALL LIB$ERASE_PAGE(1,1) - CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT) - DIR_COUNT = 0 - BULL_POINT = MSG_NUM - 1 - PRINT_HEADER = .TRUE. - END IF - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - TAG_TYPE = DUMMY - END IF - IF (NFOLDER.LT.0.AND..NOT.OUTPUT) THEN - NUM = NUM + 1 - IF (NUM.EQ.PAGE_LENGTH-6) I = EBULL + 1 - END IF - ELSE IF (NFOLDER.LT.0.AND.(OUTPUT.OR.I.LE.SBULL)) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSED = .FALSE. - END IF - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - CALL CLOSE_BULLFOLDER - IF (GFOUND) THEN - START_BULL = 0 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - IF (F1_START.GT.0.AND.F1_START.LE.F1_NBULL) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - START_SEARCH = F_START - 1 - IF (IER.AND.(NEW.OR.SINCE)) THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER1,DATETIME) - CALL CLOSE_BULLDIR - IF (IER1.NE.0) THEN - START_SEARCH = IER1 - 1 - ELSE - IER = 0 - END IF - END IF - END IF - IF (.NOT.IER.OR.F1_START.EQ.0.OR. - & F1_START.GT.F1_NBULL) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER, - & IER) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - GFOUND = .FALSE. - IF (FLAG.EQ.1) CALL CLOSE_BULLFOLDER - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - SBULL = F_START - I = SBULL - 1 - EBULL = F_NBULL - END IF - ELSE - NFOLDER = 0 - END IF - END DO - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - ELSE IF (NFOLDER.EQ.0) THEN - WRITE (6,'('' No messages found.'')') - END IF - IF (NFOLDER.EQ.0) I = EBULL + 1 - IF (NFOLDER.LT.-1000) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED = .TRUE. - END IF - NFOLDER1 = NFOLDER - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - I = EBULL + 1 - END IF - CALL CANCEL_CTRLC_AST - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.GE.SBULL.AND.I.LE.EBULL.AND.NFOLDER.NE.-1000) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN - OUTLINE = '>' - ELSE IF (BTEST(SYSTEM,8)) THEN - OUTLINE = '#' - ELSE - OUTLINE = ' ' - END IF - IF (BTEST(SYSTEM,29)) THEN - OUTLINE(2:) = '*' - ELSE - OUTLINE(2:) = ' ' - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3) - IF (EXDATE(8:12).LT.'1994'.AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin? - EXPIRES = 'Permanent' - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11) - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9) - ELSE - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11) - END IF - NOTHING = .FALSE. - IF (OUT.EQ.6) THEN - WRITE(OUT,'(1X,A)') OUTLINE - ELSE - WRITE(OUT,'(A)') OUTLINE - END IF - IF (OUTPUT) THEN - FOUND_MSG = .TRUE. - CALL SYS$SETAST(%VAL(0)) - NEXT = .FALSE. - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES) - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES,PRINT_HEADER) - PRINT_HEADER = .FALSE. - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0 - ELSE - MSG_NUM = -MSG_NUM - END IF - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1)) - END IF - END IF - I = I + 1 - IF (ANY_SEARCH) IER = SYS$CANTIM(,) - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.OUTPUT) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IF - END IF - - IF (DIR_COUNT.GT.NBULL - & .OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THEN - ! Outputted all entries? - IF (PRINTING) THEN - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THEN - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IF - ELSE IF (EXTRACTING.AND.FOUND_MSG) THEN - CALL FILE(0,CLOSED_FILES,.FALSE.) - END IF - IF (NFOLDER.LT.0) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE - DIR_COUNT = -1 ! Yes. Set counter to -1. - END IF - ELSE IF (NFOLDER.NE.0.OR.(-NFOLDER1.EQ.FOLDER_NUMBER.AND. - & INCMD(:1).EQ.' ')) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE IF (FLAG.NE.1) THEN - WRITE(6,1010) ! Else say there are more - END IF - -9999 POSTTIME = .FALSE. - NEXT = .FALSE. - DIRMODE = .FALSE. - IF (NFOLDER.NE.0.OR.-NFOLDER1.EQ.FOLDER_NUMBER) THEN - DIR_COUNT1 = DIR_COUNT - IF (DIR_COUNT1.GT.NBULL) DIR_COUNT1 = -1 - END IF - IF (OUT.EQ.3) CLOSE (UNIT=3) - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(1X,/,' Press RETURN for more...',/) -1020 FORMAT(1X,/,' Press RETURN for more, type SEARCH to read ', - & 'these messages.',/) -1040 FORMAT(' Output being written to ',A,'.') - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER) - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT,PRINT_HEADER) -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER*128 FILENAME - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THEN - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IF - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THEN - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IF - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - END IF - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = FILE_NUM - EBULL = SBULL - END IF - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F) - - IF (.NOT.IER) THEN - FILENAME = FOLDER - DO I=1,LEN(FILENAME) - IF (FILENAME(I:I).EQ.'.') FILENAME(I:I) = '_' - END DO - FILENAME = FILENAME(:TRIM(FILENAME))//'.TXT' - LEN_F = TRIM(FILENAME) - END IF - - IF (TRIM(FILE_DIRECTORY).GT.0.AND.INDEX(FILENAME,':').EQ.0 - & .AND.INDEX(FILENAME,'[').EQ.0) THEN - FILENAME = FILE_DIRECTORY(:TRIM(FILE_DIRECTORY))//FILENAME - LEN_F = TRIM(FILENAME) - END IF - - CALL STR$UPCASE(FILENAME,FILENAME) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE. - FIRST = .TRUE. - END IF - - IF (PRINT_HEADER) THEN - WRITE (3,'(/,''Newsgroup: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1 - IF (FBULL1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - OPENED = .FALSE. - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(FBULL,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DO - -100 IF (FILE_NUM.GT.0) THEN - FILE_NUM = -FILE_NUM - RETURN - END IF - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created. - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - END IF - - GO TO 10 - -900 WRITE(6,1000) FILENAME(:LEN_F) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message ',A,' written to ',A) -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A) -1050 FORMAT('Subj: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN) - - CALL LIB$MOVC3(8,IN,OUT) - - RETURN - END - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - FOLDER_NAME = FOLDER - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSE - RETURN ! Don't notify - END IF - END IF - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSE - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM) - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time - ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSER - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LOGIN_BTIM_NEW) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF - - CALL GET_NODE_NUMBER(NODE_NUMBER1,NODE_AREA1) - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100 - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IGNORE = BTEST(SYSTEM,2).AND.(NODE_AREA.EQ.NODE_AREA1).AND. - & (NODE_NUMBER.AND.NODE_NUMBER1) - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF ((USERNAME.NE.FROM.OR.SYSTEM).AND..NOT.IGNORE) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - ELSE - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - END IF - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - INREAD = '+' - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' ' - END IF - IF (LEFT) THEN - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN) - LEFT = .FALSE. - ILEN = 0 - INREAD = '+' - ELSE IF (ILEN.LE.WIDTH) THEN - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN) - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSE - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ') - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH) - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0) - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DO - IF (INPUT(ILEN:ILEN).EQ.' ') THEN - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEN - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE. - ELSE - WIDTH = PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE (6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - PAGE = PAGE + 1 - ELSE - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)// - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN) - & //' '//FOLDER_NAME(:FLEN)// - & ' to read these messages.' - END IF - PAGE = PAGE + 1 - END IF - -9999 IF (LOGIN_SWITCH) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION, - & OUT) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - CHARACTER*(*) OUTLINE - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULL - ELSE - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IF - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ') - OUTLINE(I:) = OUTLINE(I+1:) - END DO - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINE - BULL_PARAMETER = ' ' - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1)) THEN - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THEN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IF - IF (PRINTING) THEN - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - END IF - - IF (OUT.EQ.6) THEN - WRITE (OUT,'(''+'',A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - ELSE - WRITE (OUT,'(A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - END IF - -1000 FORMAT(A,1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(A,1X,'Description',43X,'From',8X,'Expires',/) - - RETURN - END - - - - SUBROUTINE GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER TODAY(2) - - CHARACTER DATETIME*24 - - IF (SINCE) THEN ! Was /SINCE specified? - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - IER = 0 - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - END IF - END IF - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bulletin1.for b/decus/vmslt98a/bulletin/bulletin1.for deleted file mode 100644 index 3d254ee..0000000 --- a/decus/vmslt98a/bulletin/bulletin1.for +++ /dev/null @@ -1,2499 +0,0 @@ -C -C BULLETIN1.FOR, Version 4/8/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_S = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',SENDTO(LEN_S+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_S = LEN_S + I + 1 - SENDTO(LEN_S:LEN_S) = ',' - END DO - LEN_S = LEN_S - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_S) - IF (SENDTO(I:I).EQ.'"') THEN - SENDTO = SENDTO(:I)//'""'//SENDTO(I+1:) - I = I + 2 - LEN_S = LEN_S + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',SENDTO(:LEN_S) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//SENDTO(:LEN_S) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*32 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - INIT_NEWSFEED = .FALSE. - - NEWSGROUP = .FALSE. - MAILTO = 0 - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - RETURN - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - I = INDEX(FOLDER1_DESCRIP,'<') - J = INDEX(FOLDER1_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'@').LT.1 - & .OR.INDEX(FOLDER1_DESCRIP(I:),'@').GT.J-I+1).AND. - & (INDEX(FOLDER1_DESCRIP(I:),'.') - & .LE.J-I+1.AND.INDEX(FOLDER1_DESCRIP(I:),'.').GT.0)) THEN - NEWSGROUP = .TRUE. - WRITE (6,'('' Init news feed counter to feed '', - & ''all messages in news group (Y),'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'or set to feed only new messages (N,default) ? ') - INIT_NEWSFEED = RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y' - I = INDEX(FOLDER1_DESCRIP,'[') - J = INDEX(FOLDER1_DESCRIP,']') - END IF - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER1_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER1_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'.') - & .GT.J-I+1.OR.INDEX(FOLDER1_DESCRIP(I:),'.').EQ.0) - & .AND.MAILTO.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(RESPONSE) - IF (TRIM(RESPONSE).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//RESPONSE(:TRIM(RESPONSE))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - IF (NEWSGROUP) FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - IF (MAILTO.EQ.2) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (MAILTO.EQ.3) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (INIT_NEWSFEED) THEN - F_LAST = 0 - ELSE IF (NEWSGROUP) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - I = INDEX(FOLDER_DESCRIP,'<') + 1 - J = INDEX(FOLDER_DESCRIP,'>') - 1 - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER_DESCRIP(I:J),IER) - CALL CLOSE_BULLNEWS - CALL OPEN_BULLFOLDER - F_LAST = F1_NBULL - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /FEED/ FEED - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256,TODAY*24 - CHARACTER SCRFILE*18 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - IF (.NOT.BULLCP_NEWS.AND.FOLDER.EQ.FOLDER1) THEN - WRITE (6,'('' ERROR: Destination cannot be same as'', - & '' current location.'')') - RETURN - END IF - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER1 = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - NEWS2BULL = NEWS2BULL.AND..NOT.TO_NEWS.AND.ORIGINAL - IF (IER1.EQ.0.AND..NOT.NEWS2BULL) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THEN - I = IER - ELSE IF (.NOT.NEWS2BULL) THEN - NUM_COPY = NUM_COPY + 1 - END IF - NEWS2BULL = .FALSE. - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - FROM_BULL_POINT = BULL_POINT - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (REMOTE_SET.EQ.4.AND..NOT.BULLCP_NEWS).OR.REMOTE_SET.EQ.3 - - POST_FEED = .FALSE. - SLIST = 0 - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST:INDEX(FOLDER_DESCRIP,'>')-1) - POST_FEED = .TRUE. - END IF - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') + 1 - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - END IF - IF (SLIST.GT.1) THEN - IF (NEWS_FEED()) THEN - ELIST = INDEX(FOLDER_DESCRIP,']') - 1 - ELSE - ELIST = INDEX(FOLDER_DESCRIP,'>') - 1 - END IF - END IF - IF (CLI$PRESENT('LOCAL').AND..NOT.BULLCP_NEWS) SLIST = 0 - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS.OR.(POST_FEED.AND.SLIST.LE.1)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - END IF - IF (.NOT.POST_NEWS) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=FROM_BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF ((FROM_REMOTE.OR.FROM_REMOTE.EQ.4).AND. - & (TO_NEWS.AND.ORIGINAL)) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2100' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (SLIST.GT.1.OR.POST_NEWS.OR.POST_FEED) THEN - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - IF (SLIST.GT.1) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE='BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'BULL.SCR' - END IF - ENDIF - ILEN = LINE_LENGTH + 1 - - INFROM = FROM - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - IF (POST_NEWS.OR.POST_FEED) THEN - USE_INFROM = ORIGINAL - IF (CLI$PRESENT('LOCAL')) NEWS2BULL = .TRUE. - CALL NEWS_POST - & (SCRFILE(:TRIM(SCRFILE)),.TRUE.,IER,POST_SUBJECT) - NEWS2BULL = .FALSE. - END IF - IF (SLIST.GT.1) THEN - CLOSE (UNIT=3) - USE_INFROM = ORIGINAL - IF (BTEST(FOLDER_FLAG,10).OR.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - ELSE - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - END IF - CALL LIB$DELETE_FILE(SCRFILE(:TRIM(SCRFILE))//';') - ELSE IF (POST_FEED.OR.POST_NEWS) THEN - REWIND (UNIT=3) - END IF - BLOCK = BLOCK_SAVE - LENGTH = LENGTH_SAVE - END IF - IF (.NOT.POST_NEWS) THEN - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - IF (.NOT.ORIGINAL) SYSTEM = IBSET(SYSTEM,4) - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (SLIST.LT.1.AND.POST_NEWS.OR.POST_FEED) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - IF (TEST_BULLCP().NE.2) - & WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADER - IF (BULLCP_NEWS) RETURN - - IF (INDEX(INCMD,' ').EQ.TRIM(INCMD)+1) - & INCMD = INCMD(:TRIM(INCMD))//' '//FOLDER1 - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IF - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./ - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND. - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0 - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN) - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0) - IF (CHANGED) THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IF - - IF (INCMD(:4).EQ.'PRIN') THEN - IF (CLI$PRESENT('CANCEL')) THEN - WRITE (6,'('' Cancelling all previously queued messages.'')') - CLOSE (UNIT=24,DISPOSE='DELETE') - FIRST = .TRUE. - RETURN - END IF - END IF - -50 IF (PRINT_NUM.EQ.0) THEN - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = PRINT_NUM - EBULL = SBULL - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name - IF (QLEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - END IF - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100 - CLOSE (UNIT=24,DISPOSE='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - END IF - -1040 FORMAT(' Message ',A,' sent to printer.') -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE. - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) - END IF - - CALL DISABLE_PRIVS - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A, - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE. - GO TO 50 - END IF - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ_MSG -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /POST/ POSTTIME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /THREAD/ THREAD - DATA THREAD /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/,LAST_THREAD/.FALSE./ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH) - CHARACTER HEADLINE*132 - - LOGICAL SINCE,PAGE - - EXTERNAL CLI$_NEGATED - - FIRST = BULL_READ.LT.F_START - KILL = BTEST(BULL_USER_CUSTOM,3) - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3) - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE. - END IF - ROTC = CLI$PRESENT('ROTATE') - END IF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - THREAD = .FALSE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - THREAD = CLI$PRESENT('THREADS') - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSE - BULL_READ = 1 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE').AND. - & .NOT.THREAD) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW').OR.(THREAD.AND..NOT. - & CLI$PRESENT('SINCE').AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND.(.NOT.LAST_THREAD - & .OR.LAST_THREAD_NUMBER.NE.FOLDER_NUMBER) - & .AND.CLI$PRESENT('NEW').NE.%LOC(CLI$_NEGATED))) THEN - NEW = .TRUE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READDIR_KEYGE(IER) - IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_BTIM) - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - CALL CLOSE_BULLDIR - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - IER = 0 - END IF - END DO - CALL CLOSE_BULLDIR - ELSE - IER = 0 - SKIPPED_THREAD = .FALSE. - IF (THREAD) CALL OPEN_BULLDIR_SHARED - DO WHILE (IER.EQ.0) - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - BULL_READ = IER - END IF - IF ((SKIPPED_THREAD.OR.(THREAD.AND.IER.NE.0)).AND. - & BULL_READ.LE.F_NBULL) THEN - CALL READDIR(BULL_READ,IER) - IER = IER - 1 - IF (IER.NE.BULL_READ) IER = 0 - END IF - IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - MSG_NUM = IER - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,DUMMY,DUMMY) - IF (IER1.EQ.0) THEN - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(IER) - ELSE - BULL_READ = BULL_READ + 1 - END IF - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - WRITE (6,'('' No more messages are present.'')') - IF (SKIPPED_THREAD) CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - SKIPPED_THREAD = .TRUE. - BULL_READ = IER + 1 - IER = 0 - END IF - END DO - END IF - IF (THREAD) CALL CLOSE_BULLDIR - BULL_READ = IER - IER = IER + 1 - ELSE IF (THREAD) THEN - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999 - ELSE - BULL_READ = IER - 1 - IER = IER + 1 - END IF - SINCE = .TRUE. - ELSE IF (CLI$PRESENT('BULLETIN_NUMBER')) THEN - BULL_READ = BULL_READ - 1 - ELSE IF (LAST_THREAD_NUMBER.EQ.FOLDER_NUMBER) THEN - BULL_READ = LAST_THREAD_READ - ELSE - BULL_READ = BULL_POINT - 1 - END IF - CALL OPEN_BULLDIR_SHARED - IER = BULL_READ + 1 - IER1 = .FALSE. - DO WHILE (.NOT.IER1.AND.IER.EQ.BULL_READ+1.AND. - & BULL_READ.LT.F_NBULL) - BULL_READ = BULL_READ + 1 - CALL READDIR(BULL_READ,IER) - IER1 = BTEST(SYSTEM,8) - IF (IER1.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER2,DUMMY,DUMMY) - IER1 = IER2.NE.0 - END IF - END DO - IF (.NOT.IER1) THEN - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - END IF - END IF - - NEXT = .FALSE. - LAST_THREAD = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - LAST_THREAD = THREAD - IF (THREAD) THEN - LAST_THREAD_READ = BULL_READ - LAST_THREAD_NUMBER = FOLDER_NUMBER - ELSE - IF (.NOT.SINCE.AND..NOT.NEW - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF - END IF - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THEN - IER = 0 - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR. - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN - MSG_NUM = F_NBULL+1 - ELSE - MSG_NUM = BULL_NOW - END IF - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE - CALL GET_THIS_OR_NEXT_TAG - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0 - END IF - END IF - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END IF - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END DO - CALL CLOSE_BULLDIR - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READ - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSE - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0 - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IF - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE. - CALL READDIR(BULL_READ,IER) - END IF - END IF - IF (REMOTE_SET.LT.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - IF (IER.NE.BULL_READ+1) THEN - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0 - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) ! If not, then error out - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - - SAVE_BULL_POINT = BULL_POINT - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(FIRST.OR.NEW.OR.NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEN - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - OK = OK.AND.(.NOT.THREAD.OR.BTEST(SYSTEM,8)) - - IF (.NOT.OK) THEN - BULL_POINT = SAVE_BULL_POINT - BULL_NOW = MSG_NUM - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN - BULL_READ = MSG_NUM - 1 - ELSE - BULL_READ = MSG_NUM + 1 - IF (INCMD(:4).EQ.'FIRS'.OR.FIRST) NEXT = .TRUE. - END IF - IF (REMOTE_SET) CALL CLOSE_BULLFIL - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - ELSE IF (.NOT.THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_NOW) - END IF - IF (BULL_READ.GT.F_NBULL.OR.BULL_READ.LT.F_START) THEN - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - GO TO 50 - END IF - BLOCK = BLOCK_SAVE - END IF - - NEXT = .FALSE. - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (.NOT.THREAD.OR.INCMD(:4).NE.'READ') THEN - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.BULL_READ) - & CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - END IF - END IF - - EDIT = .FALSE. - - PAGE_WIDTH = REAL_PAGE_WIDTH - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN - IF (CLI$PRESENT('EDIT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 9999 - END IF - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTH - PAGE = .FALSE. - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSE - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL - END IF - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:) - END DO - I = TRIM(HEADLINE) - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)) - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - ELSE - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ' - & .AND..NOT.BTEST(SYSTEM,4)) THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROM - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - IF (EDIT) WRITE(3,'(1X)') - ELSE - END = END + 1 - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IF - END IF - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) THEN - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter - GO TO 9999 - END IF - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - -9999 POSTTIME = .FALSE. - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - RETURN - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO - - RETURN - END - - - - - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1 - EQUIVALENCE (INREAD4,INREAD) - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - BULL_POINT_READ = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - - GO TO 12 - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - - BULL_POINT = BULL_POINT_SAVE - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN - ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL FILE(0,.TRUE.,.FALSE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THEN - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THEN - WRITE (6,'(''+B'',$)') - INCMD = 'RESPOND/LIST' - ELSE - GO TO 11 - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')') - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLY - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message', - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),', - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) -1040 FORMAT(' Type P to post reply, U to reply to user,', - & ' B to do both, or other to quit: ',$) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END - - - - - LOGICAL FUNCTION NEWS_FEED() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - I = SLIST + 1 - FLEN = TRIM(FOLDER_DESCRIP) - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN - IF (INDEX(FOLDER_DESCRIP(SLIST:I),'.').GT.0) - & NEWS_FEED = .TRUE. - RETURN - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND. - & FOLDER_DESCRIP(I:I).NE.'@'.AND. - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE - I = FLEN + 2 - END IF - END DO - END IF - - RETURN - END - - - - - LOGICAL FUNCTION MAIL_POST() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NEWS_FEED()) THEN - MAIL_POST = INDEX(FOLDER_DESCRIP,'[').GT.0 - ELSE - MAIL_POST = INDEX(FOLDER_DESCRIP,'<').GT.0 - END IF - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bulletin10.for b/decus/vmslt98a/bulletin/bulletin10.for deleted file mode 100644 index 308674c..0000000 --- a/decus/vmslt98a/bulletin/bulletin10.for +++ /dev/null @@ -1,4082 +0,0 @@ -C -C BULLETIN10.FOR, Version 2/27/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - COMMON /HEADER_SEEN/ HEADER_SEEN - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - LAST_LF_SEEN = LF_SEEN - LAST_REAL_LF_SEEN = REAL_LF_SEEN - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - CR_SEEN = INDEX(BUFFER(START_READ:END_READ),CR) - IF (CR_SEEN.GT.0) THEN - IF (END_LINE.GT.0) THEN - IF (CR_SEEN.EQ.END_LINE-2.AND.BUFFER(START_READ+CR_SEEN: - & START_READ+CR_SEEN).EQ.CR) CR_SEEN = CR_SEEN + 1 - ELSE - IF (START_READ+CR_SEEN.EQ.END_READ.AND. - & BUFFER(END_READ:END_READ).EQ.CR) CR_SEEN = 0 - END IF - END IF - IF ((END_LINE.EQ.0.AND.CR_SEEN+START_READ-1.LT.END_READ.AND. - & CR_SEEN.GT.0).OR.CR_SEEN.LT.END_LINE-1) THEN - END_LINE = CR_SEEN - CR_SEEN = 1 - ELSE - CR_SEEN = 0 - END IF - LF_SEEN = END_LINE.GT.0 - IF (END_LINE.GT.257-CR_SEEN.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - IF (.NOT.HEADER_SEEN) END_LINE = 254 - END IF - REAL_LF_SEEN = INDEX(BUFFER(START_READ:END_READ),LF).LE.END_LINE - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - IF (BUFFER(EB:EB).EQ.LF) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - IF (EB.GT.0.OR.LAST_LF_SEEN) RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE(:MIN(LEN(WRITE),256)) - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - NEWS_WRITE = NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - - LOGICAL FUNCTION NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - NEWS_RECONNECT = .FALSE. - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - NEWS_RECONNECT = .TRUE. - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /HEADER/ HEADER - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER().OR.SETPRV_PRIV()) THEN - IF (REMOTE_SET.EQ.4) THEN - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (INPUT(:11).EQ.'Message-ID:') THEN - MESSAGE_ID = INPUT(14:ILEN-1) - ILEN = 0 - END IF - END DO - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - CALL NEWS_POST('cancel',0,IER,SUBJ) - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - DO WHILE (BUFFER(SB:EB).NE.'.'.AND. - & .NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX( - & BUFFER(SB:EB),' ')+SB-2),J,,%VAL(1))) - IF (.NOT.NEWS_READ()) RETURN - END DO - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - STAT = .TRUE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(FROM,TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - HEADER_SEEN = .FALSE. - LF_SEEN = .FALSE. - LAST_LF_SEEN = .FALSE. - REAL_LF_SEEN = .FALSE. - LAST_REAL_LF_SEEN = .FALSE. - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8 - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONE - CHARACTER*4 ZONE - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/ - - CHARACTER*8 TIMES(1) - DATA TIMES /'-5:30'/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - IF (INDEX(ZONES,ZONE)/4.LT.4) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) - END IF - ELSE - HOUR = '00:00' - END IF - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_TI_L(TIME(:2),DATE,,%VAL(1)) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - SENDER_LINE = ' ' - NEWSGROUPS = ' ' - FOLLOWUP = ' ' - LREF = 0 - NEWS2BULL = .FALSE. - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.'.OR..NOT.LAST_REAL_LF_SEEN) - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126) - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(FROM,BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+6).EQ.'Sender:'.AND.EB.GE.SB+8) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+8:EB))+SB+7 - SENDER_LINE = ': '//BUFFER(SB1:EB) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+11).EQ.'Followup-To:'.AND. - & EB.GT.SB+12) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+13:EB))+SB+12 - FOLLOWUP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (INDEX(BUFFER(SB:), - & 'NNTP-Posting-Host:').EQ.1) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - CALL LOWERCASE(BUFFER(SB+19:EB)) - SAMEHOST = STREQ(PATHNAME(2:LPATH),BUFFER(SB+19:EB)) - ELSE IF (INDEX(BUFFER(SB:), - & 'X-Newsreader: News2bull').EQ.1) THEN - NEWS2BULL = .TRUE. - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN - IF (SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = SENDER_LINE(:TRIM(SENDER_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - ELSE - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - CALL GET_FROM(FROM,FROM_LINE(7:),TRIM(FROM_LINE)) - END IF - LAST_FROM = .TRUE. - ELSE - LAST_FROM = .FALSE. - END IF - IF (.NOT.LAST_FROM.AND.SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = 'From'//SENDER_LINE - END IF - END IF - END DO - - NEWS2BULL = NEWS2BULL.AND.SAMEHOST - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'1FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - START = -1 - CALL NEWNEWS(IN_BTIM,IER) - IF (IER.NE.0) START = IER -C -C The following code makes use of the NNTP command NEWNEWS, but is -C known to be slow and buggy in many servers. -C -C IER = SYS$ASCTIM(,TIME,IN_BTIM,) -C CALL DATE_TIME(TIME) -C SKIP = 0 -C DO WHILE (SKIP.GE.0) -C IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( -C & FOLDER_NAME))//' '//TIME)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C IF (BUFFER(:2).EQ.'23') THEN -C IF (.NOT.NEWS_READ()) CALL EXIT -C DO I=1,SKIP -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (FIRST.EQ.'.') RETURN -C DO WHILE (BUFFER(SB:EB).NE.'.') -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) -C & CALL EXIT -C IF (.NOT.NEWS_READ()) CALL EXIT -C IF (BUFFER(:2).EQ.'22') THEN -C IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN -C I = F_NBULL + 1 -C DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. -C & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) -C & .OR.I.GT.F_NBULL)) -C I = I - 1 -C IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN -C IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C END DO -C IF (I.GE.F_START) START = I -C ELSE -C IER = OTS$CVT_TI_L(BUFFER(SB+4: -C & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) -C END IF -C RETURN -C END IF -C END IF -C SKIP = SKIP + 1 -C END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2 - IER = IER1 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - CHARACTER*256 TEMP - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IF - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0 - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE - IER = NEWS_READ() - IF (IER.AND.(BUFFER(SB:EB).NE.'.' - & .OR..NOT.LAST_REAL_LF_SEEN)) THEN - IER = 0 - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THEN - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF ((INDEX(TEMP,': ').EQ.0.AND. - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255).OR. - & (LTEMP.EQ.254.AND..NOT.LAST_LF_SEEN)) THEN - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IF - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IF - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF - ELSE - HEADER_SEEN = .TRUE. - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128 - ELSE - ILEN = 128 - END IF - END IF - ELSE - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ABS(ILEN).EQ.128) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - HEADER_SEEN = .TRUE. - - RETURN - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /READIT/ READIT - - COMMON /NEWS_INIT/ END_READ - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - CHARACTER*64 ALT_SAVE - - DIMENSION DUMMY(4) - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - ALT_SET_SAVE = ALT_SET() - IF (ALT_SET_SAVE) CALL UNSET_ALT - END_READ = 0 - IER = 0 - IF (.NOT.NEWS_LOGIN()) THEN - IER = 2 - IF (.NOT.TEST_ALT(FOLDER1)) RETURN - IER = 1 - END IF - IF (IER.NE.1) CALL NEWS_GROUP(IER) - IF (IER.EQ.1) THEN - IF (TEST_ALT(FOLDER1)) THEN - IER1 = SET_ALT(ALT_FOUND) - IF (IER1) CALL NEWS_GROUP(IER) - IF (.NOT.IER1.OR.IER.NE.0) THEN - CALL UNSET_ALT - IF (ALT_SET_SAVE) IER = SET_ALT(ALT_SAVE) - RETURN - END IF - ALT_SAVE = FOLDER1(INDEX(':',FOLDER1)+1:) - IER = 0 - ELSE IF (ALT_SET_SAVE) THEN - IER = SET_ALT(ALT_SAVE) - END IF - RETURN - END IF - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY) - IF (SYSLOG) THEN - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3)) - END IF - END IF - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUP - - CHARACTER*8 NUMBER - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURN - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1 - RETURN - ELSE IF (ICOUNT.EQ.-1) THEN - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THEN - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURN - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - START = ICOUNT - BULLETIN_NUM = START - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0 - CALL NEWS_HEADER(IER) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - BLOCK = START - MSG_NUM = START - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN - END - - - - SUBROUTINE NEWS_GROUP(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN - IER = 1 - RETURN - END IF - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)) - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT') - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURN - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME - - CHARACTER*28 TIME - - DIMENSION DIFF(2) - - I = 1 - LTIME = TRIM(INTIME) - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:)) - - DO J = 1,2 - I = 1 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-' - END DO - - IF (I.EQ.LEN(TIME)) RETURN - - IF (TIME(I+3:I+3).EQ.' ') THEN - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IF - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DO - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - IF (INDEX(TIME(:I-2),'.').GT.0) THEN - CALL SYS_BINTIM(TIME(:INDEX(TIME(:I-2),'.'))//'00',BTIM) - ELSE IF (TIME(I-4:I-4).EQ.':'.AND.TIME(I-7:I-7).EQ.':') THEN - CALL SYS_BINTIM(TIME(:I-2)//'.00',BTIM) - ELSE - CALL SYS_BINTIM(TIME(:I-2)//':00.00',BTIM) - END IF - - IF (TIME(I:I).EQ.'+'.OR.TIME(I:I).EQ.'-') THEN - IER = SYS_BINTIM('0 '//TIME(I+1:I+2)//':'//TIME(I+3:I+4),DIFF) - IF (IER) THEN - IF (TIME(I:I).EQ.'-') THEN - IER = LIB$SUBX(BTIM,DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,DIFF,BTIM) - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE NEWS_LIST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - COMMON /NEWSLIST/ NEWSLIST - - CHARACTER TODAY*24 - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR. - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER)) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - NEWS_FOLDER1_BBOARD = '::' - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14 - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNT - DAMAGED = .FALSE. - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - IF (INDEX(BUFFER(SB:),' ').EQ.0) DAMAGED = .TRUE. - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IF (INDEX(BUFFER(SP:),' ').EQ.0) DAMAGED = .TRUE. - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IF (INDEX(BUFFER(SP:),' ').EQ.0) DAMAGED = .TRUE. - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1 - IF (IER.EQ.0.AND.IER1.EQ.0) - & NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) ! Old bug caused this. - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF ((FLEN.LE.44.OR.FLEN-44+EB-SP+1.LT. - & LEN(NEWS_FOLDER1_DESCRIP)).AND.DAMAGED) THEN - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)// - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - END IF - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - END IF - ELSE - CALL UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - END IF - IF (DAMAGED) THEN - IER = NEWS_READ() - DAMAGED = .FALSE. - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - OPEN (UNIT=33,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',READONLY) - - DO WHILE (IER.EQ.0) - READ (33,'(A)',IOSTAT=IER) INPUT - IF (IER.EQ.0) THEN - FLEN = INDEX(INPUT,':')-1 - NEWS_FOLDER1 = INPUT(:FLEN) - IF (SET_ALT(INPUT(FLEN+2:))) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER1) - IF (IER1.NE.0) THEN - FOLDER1_DESCRIP = NEWS_FOLDER1 - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = INPUT(45:FLEN) - ELSE - NEWS_FOLDER1_DESCRIP = ' ' - END IF - END IF - CALL NEWS_GROUP(IER) - IF (IER.EQ.0) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - IF (IER1.NE.0) THEN - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - ELSE - CALL UPDATE_NEWS_ENTRY(.FALSE.,LOCAL_UPDATE,FLEN,0) - END IF - END IF - END IF - END IF - IF (IER.NE.0) CLOSE (UNIT=33) - IF (ALT_SET()) THEN - CALL UNSET_ALT - IF (.NOT.NEWS_LOGIN()) RETURN - END IF - END DO - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.1.AND.TEST_ALT(NEWS_FOLDER1// - & NEWS_FOLDER1_DESCRIP)) THEN - IER = 0 - ELSE IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.F1_START.AND. - & NEWS_F1_FIRST.GT.F1_NBULL) THEN - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE), - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (((F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND..NOT.BTEST(NEWS_F1_FLAG,8)) THEN - DELETE (UNIT=7) - IER = 0 - ELSE IF (IER.EQ.1) THEN - IF (NEWS_F1_NBULL.LT.NEWS_F1_START - & .OR.NEWS_F1_START.EQ.0) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(NEWS_F1_START,IER1) - CALL CLOSE_BULLDIR - IER1 = NEWS_F1_START+1.EQ.IER1 - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - IF (.NOT.IER1) DELETE (UNIT=7) - END IF - IER = 0 - END IF - END IF - END DO - END IF - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - NEWSLIST = .FALSE. - - IF (SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED')) CALL RECOUNT - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DO - - RETURN - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4 - - COMMON /LOCALPOST/ LOCAL_POST - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /TEMP_INPUT/ GROUP_TEMP - CHARACTER GROUP_TEMP*256 - - COMMON /HEADER/ HEADER - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER RESPONSE*4 - - CHARACTER TODAY*24,UNAME*132 - DATA UNAME /'()'/ - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /NEWS2BULL/ NEWS2BULL - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1) - IF (IER1.NE.0) RETURN - ELSE - REWIND (UNIT=3) - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900 - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3) - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSE - I = INDEX(NEWS_MSGID,'.') - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & NEWS_MSGID(:I-1)// - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256) - IF (IER.NE.0) RETURN - LOCAL_POST = .TRUE. - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1 - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Newsgroups: junk')) GO TO 900 - ELSE IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP - ELSE IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - IF (TRIM(FOLLOWUP).EQ.0) THEN - INPUT = 'Newsgroups: '//NEWSGROUPS - IF (INDEX(NEWSGROUPS,',').GT.0) THEN - WRITE (6,'('' Warning: Original message was cross'', - & ''posted to the following news groups:'')') - DO I=1,TRIM(NEWSGROUPS),PAGE_WIDTH - WRITE (6,'(1X,A)') NEWSGROUPS(I: - & I-1+MIN(PAGE_WIDTH,TRIM(NEWSGROUPS(I:)))) - END DO - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Type Y if you want your reply crossposted also, '// - & 'N for no: (default = Y) ') - IF (RESPONSE(:1).EQ.'n'.OR.RESPONSE(:1).EQ.'N') THEN - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - END IF - ELSE - INPUT = 'Newsgroups: '//FOLLOWUP - END IF - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE.AND. - & .NOT.NEWS_FEED()) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER) - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0 - DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP)) - IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP) - DO WHILE (TRIM(GROUP_TEMP).GT.0) - COMMA = INDEX(GROUP_TEMP,',') - IF (COMMA.GT.0) THEN - FOLDER1_NAME = GROUP_TEMP(1:COMMA-1) - GROUP_TEMP = GROUP_TEMP(COMMA+1:) - ELSE - FOLDER1_NAME = GROUP_TEMP - GROUP_TEMP = ' ' - END IF - CALL LOWERCASE(FOLDER1_NAME) - FLEN = TRIM(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1) - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9) - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND. - & INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND. - & INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST), - & GROUP_LIST,FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - ELSE - WRITE (6,'(1X,A,'' is not a valid news group.'')') - & FOLDER1_NAME(:FLEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to specify it? (default = Y) ') - IF (RESPONSE(:1).NE.'n'.AND. - & RESPONSE(:1).NE.'N') THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - END IF - END IF - END DO - END DO - CALL CLOSE_BULLNEWS - END IF - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900 - END IF - ATSIGN = INDEX(PATHNAME,'@') - PCSIGN = INDEX(PATHNAME,'%') - CALL LOWERCASE(USERNAME) - IF (FILENAME.EQ.'cancel'.AND.SUBJECT(:6).EQ.'CanceL') THEN - IF (.NOT.NEWS_WRITE('Path: cyberspam!usenet')) GO TO 900 - ELSE - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - END IF - END IF - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME) - - IF (FILENAME.NE.'cancel') THEN - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - IF (INDEX(INFROM,' ').GT.0) - & INFROM = INFROM(:INDEX(INFROM,' ')-1) - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - ELSE IF (INDEX(INFROM,'@').EQ.0) THEN - INFROM = INFROM(:TRIM(INFROM))//PATHNAME(:LPATH) - END IF - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED').AND. - & SYS_TRNLNM('MX_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED').AND. - & SYS_TRNLNM('PMDF_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MULTINET_ROOT','DEFINED').AND. - & SYS_TRNLNM('MULTINET_SMTP_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - CALL STR$UPCASE(FROM_LINE,FROM_LINE) - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME) - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (SENDER_LINE.NE.' ') THEN - IF (.NOT.NEWS_WRITE(SENDER_LINE(:TRIM(SENDER_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE(FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - ELSE - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ILEN = TRIM(INPUT) - IF (INPUT(:5).EQ.'From:') THEN - GROUP_TEMP = INPUT - ELSE IF (INPUT(:7).EQ.'Sender:') THEN - GROUP_TEMP = 'From:'//INPUT(8:) - ILEN = 0 - END IF - END DO - ILEN = TRIM(GROUP_TEMP) - IF (ILEN.NE.0) THEN - IF (.NOT.NEWS_WRITE(GROUP_TEMP(:ILEN))) RETURN - END IF - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'// - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE IF (TRIM(SUBJECT).EQ.0) THEN - IF (.NOT.NEWS_WRITE('Subject: (none)')) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECT - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) - & GO TO 900 - END IF - - IF (NGROUPS.GT.0) THEN - FROM = USERNAME - DESCRIP = SUBJECT - END IF - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//PATHNAME(:LPATH)//'>')) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Message-ID: ')) GO TO 900 - END IF - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION) - END IF - LORGAN = TRIM(ORGANIZATION) - END IF - - IF (FILENAME.NE.'cancel'.AND.LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN))) - & GO TO 900 - ELSE IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Organization: cancel')) - & GO TO 900 - END IF - - IF (.NOT.USE_INFROM.OR.COMPARE_DATE(TODAY(:11),DATE).GT.13) THEN - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(8:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & ZONE(:LZONE))) GO TO 900 - ELSE - CALL CONVERT_TO_GMT(MSG_BTIM) - IER = SYS$ASCTIM(,TODAY,MSG_BTIM,) - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - TODAY = DATE(:2)//' '//DATE(4:6)//' '//DATE(8:) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & TIME(:8)//' '//ZONE(:LZONE))) GO TO 900 - END IF - - INPUT_HEADER = .FALSE. - - IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel')) THEN - EXPR = NEWS_FEED().OR.USE_INFROM - IF (.NOT.EXPR) EXPR = CLI$PRESENT('EXPIRATION') - IF (EXPR) THEN - I = INDEX(EXDATE,'-') - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE(FIRST_ALPHA(EXDATE):2) - & //' '//EXDATE(I+1:I+3)//' '//EXDATE(I+7:TRIM(EXDATE)) - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) - & GO TO 900 - ELSE IF (REMOTE_SET.EQ.4) THEN - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT) - END IF - EXTIME = '00:00:00.00' - END IF - IF (.NOT.NEWS_FEED()) THEN - IF (CLI$GET_VALUE('FOLLOWUP',GROUP_TEMP)) THEN - CALL LOWERCASE(GROUP_TEMP) - IF (.NOT.NEWS_WRITE('Followup-To: ' - & //GROUP_TEMP(:TRIM(GROUP_TEMP)))) GO TO 900 - END IF - END IF - END IF - - IF (CREATE) THEN - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURN - END IF - - IF (NEWS_FEED().OR.NEWS2BULL) THEN - IF (.NOT.NEWS_WRITE('X-Newsreader: News2bull')) GO TO 900 - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (SUBJECT(:6).EQ.'CanceL') THEN - IF (SUBJECT.EQ.'CanceL') THEN - WRITE (6,1055) - ILEN = LINE_LENGTH + 1 ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - IF (.NOT.NEWS_WRITE(INPUT(:ILEN))) RETURN - END IF - END DO - ELSE - IF (.NOT.NEWS_WRITE(SUBJECT(7:TRIM(SUBJECT)-6))) RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).EQ.'240') IER = 0 - ELSE - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - CALL STR$UPCASE(USERNAME,USERNAME) - LOCAL_POST = .FALSE. - RETURN - END IF - - IF (.NOT.INPUT_HEADER) THEN - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2 - END IF - IF (IER1.EQ.0) THEN - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DO - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') THEN - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:MIN(79+SB,EB)) - IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN - WRITE (6,'('' Use /INDENT to change indentation'',$)') - WRITE (6,'(''+ character. See Manager for permanent'',$)') - WRITE (6,'(''+ change.'')') - END IF - END IF - ELSE - LENGTH = (LENGTH+127)/128 - GROUP_LIST = GROUP_LIST1 - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - SAVE_BULL_POINT = BULL_POINT - OLD_NBULL = NBULL - DO I=NGROUPS,1,-1 - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1) - FOLDER_NUMBER = -1 - OLD_NBULL = NBULL - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL ADD_LOCAL_NEWS(8) - CALL ADD_TAG(IER,2) - IF (NEWS_FIND_SUBSCRIBE().LT.FOLDER_MAX) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER1) - IF (IER1.EQ.0.OR.IER1.EQ.OLD_NBULL+1) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(OLD_NBULL+1) - END IF - END IF - END IF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - BULL_POINT = SAVE_BULL_POINT - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - CALL STR$UPCASE(USERNAME,USERNAME) - - LOCAL_POST = .FALSE. - -1055 FORMAT(' State reason for deleting message not owned by you:') - - RETURN - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURN - END IF - END IF - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME) - LPATH = TRIM(PATHNAME) - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NAME - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME) - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE. - END DO - - TEST_NEWS = MAYBE_NEWS - - RETURN - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) RETURN - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULL - FIRST = F1_START - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - REMOTE_SET = 3 - CALL OPEN_BULLDIR_SHARED - INCMD = 'READ' ! REMOTE_GET_HEADER uses NEXT otherwise - I = F_LAST + 1 - IER = I - 1 - DO WHILE (I.NE.IER.AND.I.LE.LAST) - CALL READDIR(I,IER) - I = I + 1 - END DO - CALL CLOSE_BULLDIR - CALL OTS$CVT_L_TI(I-1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNT - NEW_NEWS_F_END = NEWS_F_END - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - F_LAST = LAST - NEWS_F_FIRST = FIRST - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE NEWS2BULL(RECLAIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - DATA BULLCP_NEWS /.FALSE./ - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBER - - DIMENSION NOW(2) - - BULLCP_NEWS = .TRUE. - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV - - CALL DELETE_EXPIRED_NEWS(RECLAIM) - - IF (RECLAIM) CALL EXIT - - CALL SEND_POST - IF (ALT_SET()) CALL UNSET_ALT - - CALL NEWS_LIST - - CALL UPDATE_LOCAL_NEWS - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - IF (NEWS_FEED()) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARD - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (IER) THEN - SAVE_LAST = F_LAST - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER) - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN - SAVE_LAST = F_NBULL - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LAST - FOLDER_BBOARD = 'NONEFEED' - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - IF (FOLDER_BBOARD.EQ.'NONEFEED') THEN - CALL SETUSER('SYSTEM') - ELSE - CALL SETUSER(FOLDER_BBOARD) - END IF - REMOTE_SET = 3 - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/LOCAL/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1) - END IF - CALL CLOSE_BULLFOLDER - CALL SETUSER(USERNAME) - END IF - END IF - END DO - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - CHARACTER*(*) TIME - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+ - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)// - & TIME(16:17)//TIME(19:20) - - RETURN - END - - - - SUBROUTINE ALLPRIV - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1 - PROCPRIV(2) = -1 - NEEDPRIV(1) = -1 - NEEDPRIV(2) = -1 - - RETURN - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COM - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - RETURN - END - - - - SUBROUTINE SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')') - RETURN - END IF - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE - WRITE (6,'('' You are now subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - CALL UPDATE_USERINFO - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - LAST_NEWS_READ(2,J) = F_START - 1 - ELSE - LAST_NEWS_READ2(2,J) = 0 - LAST_NEWS_READ(2,J) = F_NBULL - END IF - CALL CLOSE_BULLNEWS - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - CALL UPDATE_USERINFO_NEWS_ALWAYS - RETURN - END IF - END DO - - END - - - - - - SUBROUTINE UNSUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_EXPIRED - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.LE.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Folder is permanent and cannot not be'', - & '' unsubscribed.'')') - RETURN - END IF - - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - CALL UPDATE_USERINFO - - I = NEWS_FIND_SUBSCRIBE() - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - - CALL FREE_TAGS(I) - - IF (NINCLUDE.GT.0) THEN - WRITE (6,'('' Note: Excludes and/or '', - & ''threads exist for this group.'')') - WRITE (6,'('' Type EXCLUDE/DISABLE/ALL to remove them.'')') - END IF - - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - CALL UPDATE_USERINFO_NEWS_ALWAYS - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (IER.EQ.0) IER = 1 ! None read yet. - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE1() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR.(LAST_NEWS_READ(2,I) - & .GT.NEWS_F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0 - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THEN - COUNT = COUNT + 1 - END IF - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT) - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE - SUBNUM = 0 - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES) -C -C SUBROUTINE NEWS_NEW_NOTIFICATION -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - MESSAGES = .FALSE. - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1 - - FOLDER_DESCRIP = ' ' - REORDER = 0 - DO WHILE (SUBNUM.GT.0) - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUM - UNLOCK 7 - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1 - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - ELSE IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR. - & F_START.GT.F_NBULL) THEN - IER = 1 - END IF - END IF - IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (DIFF.GT.0) IER = 1 - END IF - END IF - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - ELSE - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IF - END IF - END DO - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE - - CALL CLOSE_BULLNEWS - - RETURN - END - - - SUBROUTINE REORDER_SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0) - I = I + 1 - END DO - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1 - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1) - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2 - TEMP = LAST_NEWS_READ(L,J) - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K) - LAST_NEWS_READ(L,K) = TEMP - END DO - END IF - END DO - END DO - - RETURN - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE = I - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE1 = I - - RETURN - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - IP = 1 - DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER - & .AND.IP.LE.FOLDER_MAX-1) - IP = IP + 1 - END DO - - IER = .TRUE. - - IF (IP.EQ.FOLDER_MAX) THEN - PERM = .FALSE. - IP = 1 - ELSE - PERM = .TRUE. - END IF - - IF (NOTIFY.EQ.0) THEN - IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).AND. - & .NOT.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (BTEST(INF_REC2(2,IP),14)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - END IF - - IF (BTEST(INF_REC2(2,IP),15)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - END IF - END IF - - CALL UPDATE_USERINFO - - RETURN - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - REWIND UNIT - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '// - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK) - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6, - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) - END IF - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1 - SYSTEM = 0 - CALL ADD_ENTRY - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE UPDATE_NEWS_FOLDER -C -C SUBROUTINE UPDATE_NEWS_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1 - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_EX_BTIM_KEY - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE SEND_POST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - CHARACTER FILE*132 - - C = 0 - - IF (.NOT.NEWS_LOGIN()) RETURN - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST',FILE,C)) -50 IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'340') RETURN - - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (INPUT(:5).EQ.'From:') BULL_PARAMETER = INPUT(7:) - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IF - END DO - IF (INPUT.NE.'.') THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - IF (BUFFER(:3).EQ.'441'.AND..NOT.ALT_SET()) THEN - REWIND (UNIT=3) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0.AND.INPUT(:12).EQ.'Newsgroups: ') THEN - CLOSE (UNIT=3) - IF (TEST_ALT(INPUT(13:))) THEN - CALL SET_ALT(ALT_FOUND) - GOTO 50 - END IF - IER = 2 - END IF - END DO - CLOSE (UNIT=3) - END IF - IF (BUFFER(:3).NE.'240') THEN - CLOSE (UNIT=3) - CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER) - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - END IF - CLOSE (UNIT=3,STATUS='DELETE') - IF (ALT_SET()) CALL UNSET_ALT - END DO - -100 CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVS - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST) - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - - IF (UNAME.EQ.'()') THEN - UNAME = ' ' - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IF - - RETURN - END - - - - SUBROUTINE RECOUNT -C -C SUBROUTINE RECOUNT -C -C FUNCTION: -C -C Fixes the message count of stored news groups. This may become wrong -C if old copies of some of the database files are used with newer versions. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - REMOTE_SET = 4 - - DO WHILE (IER.EQ.0) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - END DO - - IF (BTEST(NEWS_F_FLAG,8).AND.IER.EQ.0) THEN - CALL NEWS_TO_FOLDER - - CALL OPEN_BULLDIR_SHARED - - NUM = F_START - F_COUNT = 0 - - IF (F_START.GT.0) THEN - CALL READDIR(NUM,IER) - NEXT = .TRUE. - F_START = NUM - DO WHILE (NUM+1.EQ.IER) - F_COUNT = F_COUNT + 1 - NUM = NUM + 1 - IF (NUM.LE.F_NBULL) CALL READDIR(NUM,IER) - END DO - NEXT = .FALSE. - - F_NBULL = NUM - 1 - END IF - - CALL CLOSE_BULLDIR - - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - - CALL DELLNM('BULL_NEWS_RECOUNT') - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE DELLNM(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$SYSTEM',LOG,PSL$C_SUPER) - - RETURN - END - - - SUBROUTINE DELLNM_USER(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$PROCESS',LOG,PSL$C_USER) - - RETURN - END - - - SUBROUTINE NEWNEWS(SINCE_BTIM,FOUND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - DIMENSION SINCE_BTIM(2) - - START = F_START - END = F_NBULL - - FOUND = 0 - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - IF (.NOT.NEWS_READ()) RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (FOUND.EQ.0) THEN - L = INDEX(BUFFER(SB:EB),' ') - CALL OTS$CVT_TI_L(BUFFER(SB:SB+L-2),IER,,%VAL(1)) - CALL NEWS_TIME(BUFFER(SB+L:EB),MSG_BTIM) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) - & FOUND = IER - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (FOUND.NE.0) THEN - IF (.NOT.OTS$CVT_L_TI(FOUND,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END.AND.FOUND.EQ.0) - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) FOUND = MSG_NUM - I = I + 1 - IF (REMOTE_SET.EQ.3.AND.I.LE.END.AND.FOUND.EQ.0) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - IF (FOUND.EQ.0) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - - RETURN - END - - - - LOGICAL FUNCTION TEST_ALT(FOLDER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - CHARACTER*(*) FOLDER1 - - TEST_ALT = .FALSE. - - OPEN (UNIT=3,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',READONLY) - - IF (IER.NE.0) RETURN - - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) ALT_FOUND - IF (STREQ(ALT_FOUND(:INDEX(ALT_FOUND,':')-1), - & FOLDER1(:TRIM(FOLDER1)))) THEN - ALT_FOUND = ALT_FOUND(INDEX(ALT_FOUND,':')+1:) - CLOSE (UNIT=3) - TEST_ALT = .TRUE. - RETURN - END IF - END DO - - CLOSE (UNIT=3) - - RETURN - END - - - - LOGICAL FUNCTION SET_ALT(NEWALT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NEWALT - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - DATA SETALT/.FALSE./ - - SET_ALT = .FALSE. - - IF (SETALT) THEN - IF (NEWALT.EQ.ALT) THEN - SET_ALT = .TRUE. - RETURN - ELSE - CALL UNSET_ALT - END IF - END IF - - CALL NEWS_LOGOUT - - CALL CRELNM('BULL_NEWS_SERVER',NEWALT(:TRIM(NEWALT))) - - IF (NEWS_LOGIN()) THEN - SET_ALT = .TRUE. - SETALT = .TRUE. - ALT = NEWALT - ELSE - CALL DELLNM_USER('BULL_NEWS_SERVER') - SETALT = .FALSE. - END IF - - RETURN - END - - - - SUBROUTINE UNSET_ALT - - IMPLICIT INTEGER (A-Z) - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - CALL DELLNM_USER('BULL_NEWS_SERVER') - - CALL NEWS_LOGOUT - - SETALT = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALT_SET() - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - ALT_SET = SETALT - - RETURN - END - - - - SUBROUTINE ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION EXPIRED(2) - - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLEN - NEWS_F1_COUNT = NEWS_F_COUNT - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN - NEWS_FOLDER = NEWS_FOLDER(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - NEWS_F_COUNT = NEWS_F1_COUNT - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - IF (IER2.EQ.0) THEN - NEWS_F1_FLAG = NEWS_F_FLAG - NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN - NEWS_F1_EXPIRE = NEWS_F_EXPIRE - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1) - IF (BTEST(NEWS_F1_FLAG,8)) THEN - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_LAST = 0 - END IF - - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE. - IF (SP.GT.0) THEN - IF (FLEN.GT.44) THEN - IF (NEWS_FOLDER1_DESCRIP.NE. - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE - UPDATE = .TRUE. - END IF - IF (SPECIAL) THEN - IF (UPDATE) THEN - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF - ELSE IF (.NOT.UPDATE) THEN - UPDATE = F1_START.LT.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bulletin11.for b/decus/vmslt98a/bulletin/bulletin11.for deleted file mode 100644 index 2805f71..0000000 --- a/decus/vmslt98a/bulletin/bulletin11.for +++ /dev/null @@ -1,3549 +0,0 @@ -C -C BULLETIN11.FOR, Version 2/20/98 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('CURRENT')) THEN - MESSAGE_NUMBER = BULL_POINT - ELSE IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - IF (.NOT.BULL_NEWS_TAG) RETURN - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*12 BULL_MARK_DIR - CHARACTER*12 TAG_KEY,INPUT_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,) - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1) - ELSE - UNLOCK 13 - END IF - END IF - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - ELSE - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - BULL_NEWS_TAG = .FALSE. - RETURN - END IF - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),) - IF (IER1.NE.0) THEN - CLOSE (UNIT=23) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=128,DISPOSE='DELETE', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1) - NEWS_MARK2(1) = NEWS_MARK2(2) - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE') - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - CALL ERRSNS(IDUMMY,IER2) - IF (IER2.NE.RMS$_RNF) SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURN - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1), - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IF - - RETURN - END - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - - CHARACTER*12 BULL_MARK_DIR - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSE - MARKUNIT = 23 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1 - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEY - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IF - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY) - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURN - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - TAG_TYPE = 0 - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR. - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN - IF (IER.EQ.0) UNLOCK 13 - IER = 0 - MESSAGE = MSG_NUM - ELSE - IER = 36 - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - IER = 36 - - HEADER = .FALSE. - - TAG_TYPE = 0 - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) THEN - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:) - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THEN - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I) - IER = 0 - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - MSG_KEY = NEXT_MSG_KEY - RETURN - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DO - - RETURN - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - DO MESSAGE = MSG_NUM+1,F_NBULL - CALL READDIR(MESSAGE,IER) - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE) - IF (IER.EQ.0) THEN - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END DO - - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2) - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURN - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER) - & INPUT_KEY - END DO - - CLOSE_IT = .FALSE. - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - CALL DECREMENT_MSG_KEY - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR_SHARED - CLOSE_IT = .TRUE. - END IF - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - DELETE (UNIT=13) - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER)) - READ (13,IOSTAT=IER) INPUT_KEY - END DO - END IF - END IF - - END DO - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE. - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1 - DO M=1,2 - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1 - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1 - LIMIT = 256/(NEWS_FORMAT+1) - NEWS_NUMBER = LAST_NEWS_READ2(1,I) - K = 5-NEWS_FORMAT*2 - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1 - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IF - SET_LIST = .FALSE. - END IF - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0) - END DO - K = LIMIT + 1 - END IF - IF (K.GT.LIMIT) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2 - NEWS_REC = NEWS_REC + 1 - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - IF (IER.EQ.0) THEN - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IF - END DO - END IF - END DO - END DO - CLOSE (UNIT=23) - END IF - - RETURN - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = J - ELSE - NEWS_MARK(I) = J - END IF - - RETURN - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG) - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUM - NEWS_TAG(I) = 0 - END DO - - RETURN - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - DO I=1,2 - IF (NEWS_TAG(3,I,ISUB).GT.0) THEN - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB)) - NEWS_TAG(3,I,ISUB) = 0 - NEWS_NUMBER = NEWS_FOLDER_NUMBER - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER) - END IF - END DO - IF (IER.EQ.0) UNLOCK 23 - END IF - - DO J=I,FOLDER_MAX-2 - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J)) - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0 - END DO - END DO - - RETURN - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY - - IER = 36 - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE) - IF (IER.EQ.0) THEN - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THEN - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM) - END IF - IER = 36 - END IF - END IF - END DO - BULL_READ = MSG_NUM - IF (CLOSE_IT) CALL CLOSE_BULLDIR - ELSE - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0 - MSG_KEY = BULLDIR_HEADER - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THEN - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36 - END IF - END IF - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*24 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - SUBROUTINE SENDMAIL(FILE,TO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE '($MAILDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - CHARACTER*(*) FILE,TO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1)) - - CALL DISABLE_PRIVS - - SENDTO = TO - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))// - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:) - END DO - - IF (USE_INFROM.AND.(SYS_TRNLNM('TWF$TCP','DEFINED').OR. - & SYS_TRNLNM('MULTINET_SOCKET_LIBRARY','DEFINED').OR. - & SYS_TRNLNM('UCX$DEVICE','DEFINED')) - & .AND..NOT.SYS_TRNLNM('BULL_DISABLE_SMTP','DEFINED')) THEN - IER = SYS$ASCTIM(,INPUT,,) - INPUT = INPUT(:2)//INPUT(4:6)//INPUT(10:11)// - & INPUT(13:14)//INPUT(16:17)//INPUT(19:20)// - & INPUT(22:23) - IF (INPUT(:1).EQ.' ') INPUT = INPUT(2:) - OPEN (UNIT=8,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & INPUT(:TRIM(INPUT))//'.SMTP',IOSTAT=IER1, - & STATUS='NEW',RECL=256) - IF (IER1.EQ.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - WRITE (8,'(A)',IOSTAT=IER) 'helo '//PATHNAME(:LPATH) - INPUT = INFROM - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - END IF - WRITE (8,'(A)',IOSTAT=IER) 'MAIL FROM:<'// - & INPUT(:TRIM(INPUT))//'>' - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - WRITE (8,'(A)',IOSTAT=IER) 'RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>' - WRITE (8,'(A)',IOSTAT=IER) 'DATA' - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - WRITE (8,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - IF (NHEAD.EQ.0.AND.TRIM(SUBJECT).GT.0) THEN - WRITE (8,'(A)',IOSTAT=IER) - & 'Subject: '//SUBJECT(:TRIM(SUBJECT)) - WRITE (8,'(A)',IOSTAT=IER) - END IF - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER) - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.EQ.0) THEN - WRITE (8,'(A)',IOSTAT=IER) INPUT(:L) - END IF - END DO - CLOSE (UNIT=3) - REWIND (UNIT=8,IOSTAT=IER) - IF (IER.NE.0) THEN - CLOSE (UNIT=8,STATUS='DELETE') - IER1 = 2 - END IF - END IF - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('helo '//PATHNAME(2:LPATH)//CRLF)) - & GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - INPUT = INFROM - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ELSE IF (I.EQ.0.AND.INDEX(INPUT,'@').EQ.0) THEN - INPUT = INPUT(:TRIM(INPUT))//PATHNAME(:LPATH) - END IF - IF (.NOT.SMTP_WRITE_PACKET('MAIL FROM:<'//INPUT(:TRIM(INPUT)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - IF (.NOT.SMTP_WRITE_PACKET('RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('DATA'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - IF (BTEST(FOLDER_FLAG,15).OR.INPUT(:8).NE.'Subject:') THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:TRIM(INPUT))//CRLF)) - & GOTO 10 - ELSE - IF (.NOT.SMTP_WRITE_PACKET('Subject: '// - & SUBJECT(:TRIM(SUBJECT))//CRLF)) GOTO 10 - END IF - END DO - IF (NHEAD.EQ.0.AND.TRIM(SUBJECT).GT.0) THEN - IF (.NOT.SMTP_WRITE_PACKET('Subject: '// - & SUBJECT(:TRIM(SUBJECT))//CRLF)) GOTO 10 - NHEAD = 1 - END IF - IF (NHEAD.GT.0.AND..NOT.SMTP_WRITE_PACKET(CRLF)) GOTO 10 - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER2) - DO WHILE (IER2.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER2) L,INPUT - IF (IER2.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) IER2 = 2 - END IF - END DO - CLOSE (UNIT=3) - IF (IER2.EQ.2) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IER2 = 1 - GOTO 20 -10 IER2 = 2 -20 CALL SMTP_DISCONNECT() - IF (IER1.EQ.0) THEN - IF (IER2) THEN - CLOSE (UNIT=8,STATUS='DELETE') - ELSE - CLOSE (UNIT=8) - END IF - END IF - CALL ENABLE_PRIVS - STATUS = 1 - RETURN - END IF - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR) - - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO)) - I = INDEX(SENDTO(J:),',') - 1 - IF (I.EQ.-1) I = TRIM(SENDTO(J:)) - CALL INIT_ITMLST - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - J = J + I - IF (SENDTO(J:J).EQ.',') J = J + 1 - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO)) - CALL END_ITMLST(ATTRIBUTE_ITMLST) - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - CALL LIB$REVERT - - RETURN - END - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,) - - RETURN - END - - - - - SUBROUTINE SET_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEXT/ NEXT - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DIMENSION EXPIRED(2) - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IF - - ENTRY SHOW_NEWS - - LIMIT = -2 - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1)) - IF (.NOT.IER.OR.LIMIT.LT.-1) THEN - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')') - RETURN - END IF - END IF - - EXPIRE = -1 - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1)) - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN - END IF - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR. - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')') - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - IF (CLI$PRESENT('DEFAULT')) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1 - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - RETURN - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE) - FOLDER1_NUMBER = NEWS_F1_COUNT - FOLDER1 = BULL_PARAMETER - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10) - CALL WRITE_FOLDER_FILE_TEMP(IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMP - REWRITE (7) NEWS_FOLDER1_COM - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER) - END IF - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - END IF - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS') - DEFAULT = CLI$PRESENT('DEFAULT') - ALL = CLI$PRESENT('ALL') - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE') - ENABLE = CLI$PRESENT('ENABLE') - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - - STORED = 0 - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN - WRITE (6,'('' Stored setting was not removed.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'[.BULLNEWS*]*.*;*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_SAVE = FOLDER - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - FOLDER = FOLDER_SAVE - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0 - F1_NBULL = 0 - F1_COUNT = 0 - F1_LAST = 0 - END IF - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3) - IF (IER.NE.0) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - END IF - CALL RESET_PROTECTION - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IF - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THEN - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')') - ELSE - WRITE (6,'('' Default is not stored.'')') - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS) THEN - WRITE (6,'('' Expiration is DEFAULT value.'')') - ELSE - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Default expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no default expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')') - ELSE - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - NOTIFY_FLAG_NEWS = .FALSE. - SET_FLAG_NEWS = .FALSE. - BRIEF_FLAG_NEWS = .FALSE. - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a default news group.'')') - ELSE - IER1 = 2 - END IF - END IF - NOTIFY_PERM_FLAG_NEWS = .FALSE. - SET_PERM_FLAG_NEWS = .FALSE. - BRIEF_PERM_FLAG_NEWS = .FALSE. - DO WHILE (REC_LOCK(IER2)) - READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC - END DO - IF (IER2.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a permanent news group.'')') - END IF - END IF - PERM = .FALSE. - IF (SET_FLAG_NEWS) THEN - IF (BRIEF_FLAG_NEWS) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE IF (BRIEF_FLAG_NEWS) THEN - IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - IF (.NOT.PERM) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (BRIEF_PERM_FLAG_NEWS.AND..NOT.SET_PERM_FLAG_NEWS) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (NOTIFY_FLAG_NEWS) THEN - IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' NOTIFY is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLINF - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IF - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER) - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) - END IF - FOUND = .FALSE. - MODALL = INDEX(GROUP,'.').NE.LG - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR. - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.')) - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER) - END DO - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER) - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - RETURN - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - END DO - END IF - - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - ALL = CLI$PRESENT('ALL') - FULL = CLI$PRESENT('FULL') - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (CLI$PRESENT('SUBJECT')) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IF - ELSE - INPUT = FROM - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:) - ELSE - INPUT = DESCRIP - END IF - END IF - LEN_P = TRIM(INPUT) - CALL CLOSE_BULLFIL - END IF - - SUB = CLI$PRESENT('SUBJECT') - DISABLE = CLI$PRESENT('DISABLE') - EXC = 0 - - GO TO 5 - - ENTRY INCLUDE_SUBJECT(EXCLUDE) - - IF (REMOTE_SET.GE.3.AND.NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) RETURN - - LEN_P = TRIM(INPUT) - ALL = .FALSE. - DISABLE = .FALSE. - SUB = .TRUE. - EXC = -1 - -5 IF (SUB) THEN - IF (DISABLE) THEN - IF (STREQ(INPUT(:3),'RE:')) INPUT = INPUT(5:) - INPUT = INPUT(:MIN(LEN_P,LEN(DESCRIP))) - LEN_P = TRIM(INPUT) - END IF - INPUT = 'SUBJECT:'//INPUT - LEN_P = LEN_P + 8 - ELSE - INPUT = 'FROM:'//INPUT - LEN_P = LEN_P + 5 - END IF - - IF (EXCLUDE) THEN - INPUT = ':exclude:'//INPUT - LEN_P = LEN_P + 9 - ELSE - INPUT = ':include:'//INPUT - LEN_P = LEN_P + 9 - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - FLEN = TRIM(FOLDER_NAME) - INPUT = FOLDER_NAME(:FLEN)//INPUT - ILEN = FLEN + LEN_P - - IF (EXC.EQ.0) THEN - EXC = -1 - IER = CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P) - IF (IER) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) EXC - IF (EXC.LT.0.OR.EXC.GT.999.OR.IER.NE.0) THEN - WRITE(6,'('' ERROR: Valid limit is 0-999.'')') - RETURN - END IF - END IF - END IF - - CHECK_ONLY = .FALSE. - - GO TO 100 - - ENTRY CHECK_EXCLUDES - - CHECK_ONLY = .TRUE. - DISABLE = .TRUE. - LEN_P = 0 - INPUT = ' ' - ILEN = 1 - -100 IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) THEN - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - CLOSE (UNIT=4,DISPOSE='SAVE') - RETURN - END IF - - IER = 0 - CONVERT = .FALSE. - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - I = STRFIND(OLD_BUFFER,':RE: ') - IF (IER.EQ.0) THEN - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THEN - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5) - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill' - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF ((STREQ(OLD_BUFFER(:ILEN),INPUT(:ILEN)).AND. - & OLD_BUFFER(ILEN+1:ILEN+1).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:OLEN),INPUT(:OLEN))).OR. - & (DISABLE.AND.I.GT.0.AND. - & ((STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:MAX(I+5,ILEN+4)), - & INPUT(:ILEN)).AND.OLD_BUFFER(ILEN+5:ILEN+5).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:OLEN), - & INPUT(:OLEN)))))) THEN - CONTINUE - ELSE IF (.NOT.(ALL.AND.STREQ(INPUT(:FLEN+8), - & OLD_BUFFER(:MIN(FLEN+8,OLEN))))) THEN - IER2 = OLD_BUFFER(:1).EQ.':'.OR. - & INDEX(OLD_BUFFER,':defaults:').GT.0 - IF (.NOT.IER2) THEN - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC1,BLIMIT,BDATE,IER1) - IF (IER1) IER2 = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1) - & ,' ').GT.-EXC1 - CONVERT = .NOT.IER1 - END IF - IF (.NOT.IER1.OR.EXC1.EQ.0.OR.IER2) - & WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN) - END IF - END IF - END DO - - IF (.NOT.DISABLE) THEN - IF (FULL) THEN - WRITE (4,'(A)',IOSTAT=IER) FOLDER_NAME(:FLEN)//':defaults:kill' - ELSE - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - - IF (CONVERT) THEN - WRITE (6,'('' NOTE: See help on the new SET EXLIMIT command.'')') - END IF - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - SUBROUTINE UPDATE_EXCLUDE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - DATA SCRATCH_B1/0/,NINCLUDE/0/,EXC_CHANGED/.FALSE./ - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - IF (.NOT.EXC_CHANGED) RETURN - EXC_CHANGED = .FALSE. - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (.NOT.(IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ. - & INPUT(:MIN(TRIM(FOLDER_NAME)+1,ILEN)).AND.INPUT(:1).NE.':' - & .AND.INDEX(INPUT,':defaults:').EQ.0)) THEN - IF (IER.EQ.0) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE SET_CUSTOM(PARAM) -C -C SUBROUTINE SET_CUSTOM -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - CHARACTER*(*) PARAM - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IF - - LENP = LEN(PARAM) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0.AND.PARAM(:LENP).NE.INPUT(2:LENP+1)) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - IF (CLI$GET_VALUE('SET_PARAM2',INPUT,ILEN)) THEN - WRITE (4,'(A)',IOSTAT=IER) ':'//PARAM(:LENP)//':'//INPUT(:ILEN) - END IF - - IF (PARAM.EQ.'exclude_limit') - & DECODE(ILEN,'(I)',INPUT(:ILEN)) EXCLUDE_LIMIT - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - DIMENSION BTIM(2) - - FILE_DIRECTORY = ' ' - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THEN - BULL_USER_CUSTOM = .FALSE. - ELSE - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IF - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',OLD_BUFFER) - IF (.NOT.IER) OLD_BUFFER = 'SYS$LOGIN:BULL.CUSTOM' - - OPEN(UNIT=17,FILE=OLD_BUFFER(:TRIM(OLD_BUFFER)), - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURN - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - NINCLUDE = 0 - OLD_FORMAT = .FALSE. - FLEN = TRIM(FOLDER_NAME) - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL LOWERCASE(OLD_BUFFER) - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults') - & .EQ.1) THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - OLD_FORMAT = OLD_FORMAT.OR.(.NOT.IER1) - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXC - & .OR.EXC.EQ.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1 - ELSE - EXC_CHANGED = .TRUE. - END IF - END IF - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - IF (INDEX(OLD_BUFFER,':file_directory').GT.0) - & FILE_DIRECTORY = OLD_BUFFER(17:) - IF (INDEX(OLD_BUFFER,':exclude_limit').GT.0) THEN - DECODE(OLEN-15,'(I)',OLD_BUFFER(16:),IOSTAT=IER1) - & EXCLUDE_LIMIT - EXCLUDE_LIMIT = MIN(999,EXCLUDE_LIMIT) - END IF - END IF - END DO - - CLOSE (UNIT=17) - - IF (OLD_FORMAT) CALL CHECK_EXCLUDES - - RETURN - END - - - - - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /DIRMODE/ DIRMODE - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - CHARACTER*(*) STRING,STRING1 - CHARACTER*132 ADDRESS - - CHARACTER*12 EXFROM - - INCLUDE_MSG = .TRUE. - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURN - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - DO I=1,NINCLUDE - OLD_SCRATCH_B = SCRATCH_B - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - IF (STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (DIRMODE) BLIMIT = MIN(BLIMIT,FLEN+17+LEN(DESCRIP)) - MATCH = .FALSE. - IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:')) THEN - CALL GET_FROM(EXFROM,OLD_BUFFER(FLEN+15:), - & TRIM(OLD_BUFFER(FLEN+15:))) - IF (STREQ(ADDRESS(STRING),ADDRESS(OLD_BUFFER(FLEN+15: - & TRIM(OLD_BUFFER(FLEN+15:BLIMIT))+FLEN+14))).OR. - & (DIRMODE.AND.STREQ(FROM,EXFROM))) MATCH = .TRUE. - ELSE IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND. - & STRFIND(STRING1(:TRIM(STRING1)), - & OLD_BUFFER(FLEN+18:BLIMIT)).GT.0) THEN - MATCH = .TRUE. - END IF - IF (MATCH) THEN - CDATE = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ') - IF (CDATE.GT.-EXC.OR.EXC.EQ.0) THEN - IF (CDATE.NE.0.AND.EXC.NE.0) THEN - IF (OLD_BUFFER(BLIMIT+1:BLIMIT+1).EQ.':') EXC = -1 - CALL ADD_EXCL(OLD_BUFFER,BLIMIT,EXC) - CALL WRITE_QUEUE(%VAL(OLD_SCRATCH_B),OLD_SCRATCH_B, - & OLD_BUFFER) - EXC_CHANGED = .TRUE. - END IF - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THEN - SYSTEM = IBSET(SYSTEM,8) - ELSE - INCLUDE_MSG = .FALSE. - SYSTEM = IBCLR(SYSTEM,8) - END IF - END IF - END IF - END IF - END DO - - RETURN - END - - - - FUNCTION STRFIND(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) STRING,STRING1 - - L = LEN(STRING1) - DO I=0,LEN(STRING)-L - J = 1 - DO WHILE (J.LE.L) - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(STRING1(J:J)) - & .OR..NOT.ALPHA(STRING(I+J:I+J)))) THEN - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = I + 1 - RETURN - ELSE - J = J + 1 - END IF - END DO - END DO - - STRFIND = 0 - - RETURN - END - - - - - SUBROUTINE SHOW_EXCLUDE(TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (TYPE.EQ.0) WRITE (6,'('' There are no excludes.'')') - IF (TYPE.EQ.1) WRITE (6,'('' There are no threads.'')') - RETURN - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - FOUND = .FALSE. - - L = 1 - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - IF (STREQ(FOLDER_NAME(:FLEN)//':',OLD_BUFFER(:MIN(FLEN+1,OLEN))) - & .AND.((TYPE.EQ.1.AND.STREQ(OLD_BUFFER(FLEN+2:FLEN+8), - & 'INCLUDE')).OR.(TYPE.EQ.0.AND.STREQ( - & OLD_BUFFER(FLEN+2:FLEN+8),'EXCLUDE')))) THEN - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'Excludes for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'Threads for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - FOUND = .TRUE. - END IF - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (BLIMIT+5-FLEN.GT.PAGE_WIDTH.AND.L+2.GT.PAGE_LENGTH-1) THEN - L = L + 2 - ELSE - IF (L.EQ.0) THEN - WRITE (6,'(''+'',A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - ELSE - WRITE (6,'(1X,A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - END IF - IF (OLD_BUFFER(BDATE+1:BDATE+1).EQ.'-') - & OLD_BUFFER(BDATE:) = ' '//OLD_BUFFER(BDATE:) - OUTLEN = MIN(BLIMIT,PAGE_WIDTH+FLEN+9)-FLEN-9 - IF (OUTLEN.GT.PAGE_WIDTH-16) THEN - WRITE (6,'(1X,X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 2 - ELSE - WRITE (6,'(''+'',X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 1 - END IF - END IF - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & INPUT(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'No excludes found for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'No threads found for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - CHARACTER*12 NEW,OLD - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to set a new name.'')') - RETURN - END IF - - CALL CLI$GET_VALUE('OLDNAME',OLD,LENO) - CALL CLI$GET_VALUE('NEWNAME',NEW,LENN) - - CALL OPEN_BULLUSER_SHARED - - TEMP_USER = USERNAME - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY - END DO - - IF (IER.EQ.0) THEN - USERNAME = NEW - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=NEW) - END DO - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) USER_ENTRY - ELSE - REWRITE (4,IOSTAT=IER) USER_ENTRY - END IF - END IF - - USERNAME = TEMP_USER - DO WHILE (REC_LOCK(IER1)) - READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY - END DO - - CALL CLOSE_BULLUSER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Old name not found.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN))) - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - IF (LENO.GT.1) THEN - OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1))) - ELSE - OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2))) - END IF - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - IF (LENN.GT.1) THEN - NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1))) - ELSE - NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))) - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - SUBROUTINE CHECK_EXCL(BUFFER,L,EXC,BLIMIT,BDATE,IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - - CHARACTER*(*) BUFFER - - DIMENSION BTIM(2) - - BLIMIT = L - BDATE = L+3 - - IER = BUFFER(L:L).EQ.':' - IF (IER) THEN - I = LAST_INDEX(BUFFER(:L-1),':') - IF (I.GT.0) THEN - J = LAST_INDEX(BUFFER(:I-1),':') - IF (J.GT.0) THEN - IF (J.LT.I-1) THEN - DECODE(I-J-1,'(I)',BUFFER(J+1:I-1),IOSTAT=IER) EXC - IER = IER.EQ.0 - ELSE - EXC = EXCLUDE_LIMIT - END IF - IF (IER) BLIMIT = J - 1 - CALL STR$UPCASE(BUFFER(I+1:L-1),BUFFER(I+1:L-1)) - IF (IER) IER = SYS_BINTIM(BUFFER(I+1:L-1),BTIM) - BDATE = I + 1 - END IF - ELSE - IER = .FALSE. - END IF - END IF - - IF (.NOT.IER) CALL ADD_EXCL(BUFFER,L,-1) - - RETURN - END - - - - SUBROUTINE ADD_EXCL(BUFFER,L,EXC) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2) - - CHARACTER*(*) BUFFER - - CHARACTER TODAY*24 - - IF (EXC.EQ.-1) THEN - BUFFER = BUFFER(:L)//':' - ELSE - BUFFER = BUFFER(:L)//':' - WRITE (BUFFER(L+2:),'(I3)') EXC - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - BUFFER = BUFFER(:TRIM(BUFFER))//':'//TODAY(:INDEX(TODAY,' ')-1)//':' - - L = TRIM(BUFFER) - - RETURN - END - - - - - CHARACTER*(*) FUNCTION ADDRESS(INPUT) - - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) INPUT - - ADDRESS = INPUT - - IF (INDEX(INPUT,'@').EQ.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - ADDRESS = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - ELSE - ADDRESS = INPUT(:MINGT0(TRIM(INPUT),INDEX(INPUT,' ')-1)) - IF (INDEX(ADDRESS,'(').GT.0) - & ADDRESS = ADDRESS(:INDEX(ADDRESS,'(')-1) - END IF - - RETURN - END - - - - - SUBROUTINE SEND_MAIL - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - C = 0 - DO WHILE (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) - OPEN (UNIT=8,FILE=INPUT(:TRIM(INPUT)),IOSTAT=IER,RECL=256) - IF (IER.NE.0) GOTO 30 - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - DO I=1,3 - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - END DO - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - DO WHILE (IER.EQ.0) - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - END IF - END DO - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - CLOSE (UNIT=8,STATUS='DELETE') - GOTO 20 -10 CLOSE (UNIT=8) -20 CALL SMTP_DISCONNECT() -30 CONTINUE - END DO - - CALL EXIT - END diff --git a/decus/vmslt98a/bulletin/bulletin2.for b/decus/vmslt98a/bulletin/bulletin2.for deleted file mode 100644 index 0bf191c..0000000 --- a/decus/vmslt98a/bulletin/bulletin2.for +++ /dev/null @@ -1,2675 +0,0 @@ -C -C BULLETIN2.FOR, Version 3/10/97 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'('' WARNING: Account used by other folder.'', - & '' If you specify the same account,'')') - WRITE (6,'('' you must specify the address'', - & '' of the mailing list in the folder description.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to make this change? ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) THEN - CALL CLOSE_BULLUSER - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Specified file cannot be opened.'')') - RETURN - END IF - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.EQ.0) THEN - INFROM = INPUT(:ILEN)//',' - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (MSG_OWN) THEN - ILEN = TRIM(INPUT) - 6 - INFROM = INFROM(:LENFRO)//INPUT(7:) - IF (INDEX(INFROM,' "').GT.INDEX(INFROM,'@')) THEN - I = INDEX(INFROM,' "') - INFROM = INFROM(:I-1)// - & INFROM(INDEX(INFROM(I+2:),'"')+I+2:) - DO WHILE (INDEX(INFROM,'""').GT.0) - INFROM = INFROM(:INDEX(INFROM,'""'))// - & INFROM(INDEX(INFROM,'""')+2:) - END DO - END IF - CALL ADD_PROTOCOL(INFROM(LENFRO+1:),ILEN) - LENFRO = LENFRO + ILEN - END IF - IF (EDIT.AND.TEXT) THEN - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:TRIM(INPUT)-1) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:TRIM(INPUT))//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_P = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LEN_P.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') BULL_PARAMETER(:LEN_P)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THEN - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - IER = 0 - END IF - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')') - END IF - END IF - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (.NOT.FILESPEC) THEN - WRITE (6,'('' Enter message: End with ctrl-z,'', - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - ELSE - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IF - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - END IF - END IF - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No message added.'')') - IF (.NOT.STATUS) THEN - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ') - IF (STREQ(INPUT(:1),'Y')) THEN - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV') - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IF - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C -C SUBROUTINE ADD_SIGNATURE -C -C FUNCTION: Adds signature to message being mailed/posted. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATURE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/ - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURN - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) RETURN - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IF - - ICOUNT = 0 - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME))) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THEN - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END DO - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IF - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE. - ELSE - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' ' - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - END DO - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,INPUT1 - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(INPUT(I:I)) - & .OR..NOT.ALPHA(INPUT1(I:I)))) RETURN - END DO - - STREQ = .TRUE. - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -C -C SUBROUTINE RESPOND_MAIL -C -C FUNCTION: Sends mail to address. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,MLDESCRIP*(LINE_LENGTH) - - PRIVS = FILE.NE.'SYS$LOGIN:BULL.SCR' - - MLDESCRIP = SUBJECT - LENDES = TRIM(MLDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES) - IF (MLDESCRIP(I:I).EQ.'"') THEN - IF (LENDES.EQ.LINE_LENGTH) THEN - MLDESCRIP(I:I) = '`' - ELSE - MLDESCRIP = MLDESCRIP(:I)//'"' - & //MLDESCRIP(I+1:) - I = I + 1 - LENDES = LENDES + 1 - END IF - END IF - I = I + 1 - END DO - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0 - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD) - IF (PRIVS) CALL DISABLE_PRIVS - - IF (LISTSERV) THEN - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('MX_REPLY_TO','DEFINED')) - & CALL CRELNM('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('PMDF_REPLY_TO','DEFINED')) - & CALL CRELNM('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - IF (.NOT.SYS_TRNLNM('MULTINET_SMTP_REPLY_TO','DEFINED')) - & CALL CRELNM('MULTINET_SMTP_REPLY_TO', - & USERNAME(:TRIM(USERNAME))) - END IF - END IF - - IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (LPATH.GT.0) THEN - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - END IF - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - CALL CRELNM('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - CALL CRELNM('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE - CALL CRELNM('MULTINET_SMTP_REPLY_TO',INFROM(:TRIM(INFROM))) - END IF - END IF - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO) - & //'""" """'//MLDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IF - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//MLDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE - I = INDEX(SENDTO,'%""') + 3 - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THEN - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THEN - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THEN - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & MLDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) -C -C Use the following if you do not have VMS V5.3 or greater. -C -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//MLDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IF - - IF (PRIVS) CALL ENABLE_PRIVS - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV.OR.USE_INFROM) THEN - USE_INFROM = .FALSE. - CALL DELLNM_USER('MULTINET_SMTP_REPLY_TO') - CALL DELLNM_USER('PMDF_REPLY_TO') - CALL DELLNM_USER('MX_REPLY_TO') - END IF - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: CHANGE command subroutine. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWER - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IF - -C -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - LENFROM = 0 - IF (CLI$PRESENT('OWNER')) THEN - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - IER = CLI$GET_VALUE('OWNER',INFROM,LENFROM) - INFROM = 'From: '//INFROM - LENFROM = LENFROM + 6 - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('OWNER')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')') - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')') - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL.OR.LENFROM.GT.0) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (LENFROM.EQ.0) THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description header - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT, - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - IF (CLI$PRESENT('OWNER')) THEN - CALL GET_FROM(FROM,INFROM(7:),LENFROM-6) - CALL STR$UPCASE(FROM,FROM) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2100' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2100' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10) - - CHARACTER GROUP*80,STAT*4 - - EXTERNAL CLI$_ABSENT - - IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SEARCH_LEN(1) = 3 - SEARCH_NUM = 1 - NFOLDER = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - SEARCH_NUM = 1 - NFOLDER = 1 - INPUT = DESCRIP - CALL INCLUDE_SUBJECT(0) - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1 - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM) - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1 - NFOLDER = 1 - ELSE - IF (NFOLDER.EQ.0) NFOLDER = 1 - SEARCH_STRING = ' ' - END IF - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - END IF - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME - NFOLDER = NFOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DO - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - SCRATCH_F = SCRATCH_F1 - NFOLDER = NFOLDER + 1 - END IF - - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - OLD_BUFFER = ' ' - END IF - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - END IF - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IF (NFOLDER.NE.0) FOUND = 0 - - CHANGE = .FALSE. - IF (CLI$PRESENT('REPLY').OR. - & TRIM(SEARCH_STRING).GT.0) THEN - REVERSE = CLI$PRESENT('REVERSE') - ELSE - REVERSE = .FALSE. - END IF - - DO WHILE (NFOLDER.NE.0.AND.FOUND.LE.0.AND.FOUND.GT.-3) - IF ((NFOLDER.GT.0.AND.(.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1)).OR. - & (NFOLDER.LT.0.AND.OLD_BUFFER.NE.' ')) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL, - & REVERSE,CLI$PRESENT('SUBJECT') - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'), - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),CHANGE) - IF (FOUND.LE.0.AND.FOUND.GE.-2) THEN - NFOLDER = NFOLDER - 1 - IF (NFOLDER.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F, - & FOLDER1_NAME) - END IF - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - END IF - END DO - ELSE IF (NFOLDER.LT.0) THEN - NFOLDER = NFOLDER + 1 - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - IF (GFOUND) THEN - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - GFOUND = .FALSE. - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - END IF - ELSE - NFOLDER = 0 - END IF - END DO - CALL CLOSE_BULLFOLDER - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - END IF - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - NFOLDER = 0 - END IF - CALL CANCEL_CTRLC_AST - END IF - END IF - END DO - - IF (FOUND.EQ.-3) FOUND = 0 - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - IF (CHANGE) THEN - WRITE (6,'('' No matches found in current folder: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' No matches found.'')') - END IF - ELSE IF (FOUND.EQ.-2) THEN - IF (CHANGE) THEN - WRITE (6,'('' ERROR: No more messages in current folder: '' - & ,A)') FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' ERROR: No more messages.'')') - END IF - END IF - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN, - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE,CHANGE) -C -C SUBROUTINE GET_SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEXT/ NEXT - LOGICAL NEXT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*4 SAVECMD - - CHARACTER*128 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - OLD_REVERSE = REVERSE - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THEN - OLD_REVERSE = REVERSE - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(BULL_POINT,IER) - IF (BULL_POINT+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (STREQ(DESCRIP(:4),'RE: ').AND.TRIM(DESCRIP).GE. - & LEN(DESCRIP)-1) THEN - IF (FILES) CALL OPEN_BULLFIL_SHARED - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - SEARCH_STRING = INPUT(11:) - SEARCH_STRING = SEARCH_STRING(:LEN(DESCRIP)) - ELSE - SEARCH_STRING = DESCRIP(5:) - END IF - IF (FILES) CALL CLOSE_BULLFIL - ELSE IF (STREQ(DESCRIP(:4),'RE: ')) THEN - SEARCH_STRING = DESCRIP(5:) - END IF - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - ELSE - SEARCH_NUM = OLD_SEARCH_NUM - IF (SEARCH_LEN(1).EQ.0) SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (OLD_REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - OLD_SEARCH_NUM = SEARCH_NUM - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.CHANGE.OR. - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last - END IF - IF (REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - SEARCH_STRING = ' ' - RETURN - END IF - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0 - BULL_SEARCH = START_BULL+1 - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR. - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY) - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - ELSE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - IF (IER.EQ.0) THEN - IER = BULL_SEARCH + 1 - ELSE - GO TO 800 - END IF - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - IF (SEARCH_MODE.EQ.4) THEN - CALL STR$UPCASE(DESCRIP1,FROM) - ELSE - IF (LEN(DESCRIP).EQ.TRIM(DESCRIP)) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - DESCRIP1 = INPUT(7:) - END IF - CALL STR$UPCASE(DESCRIP1,DESCRIP1) - ELSE - CALL STR$UPCASE(DESCRIP1,DESCRIP) - END IF - END IF - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (TRIM(SEARCH_STRING).EQ.LEN(DESCRIP).AND. - & DESCRIP1(:LEN(DESCRIP)).EQ.SEARCH_STRING).OR. - & (STREQ(DESCRIP1(:4),'RE: ').AND.DESCRIP1(5:).EQ. - & SEARCH_STRING(:MIN(TRIM(SEARCH_STRING),LEN(DESCRIP1)-4)) - & )))) THEN - IF (.NOT.NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - ELSE IF (NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - MATCHES = 0 - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE. - END DO - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THEN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I) - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR. - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - END IF - END DO - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE - FOUND = -1 - END IF - END IF - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULL - END DO - -800 FOUND = 0 - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - NEXT = .FALSE. - CALL READDIR(BULL_POINT,IER) - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - END IF - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - IF (.NOT.IER1) SEARCH_STRING = ' ' - NEXT = .FALSE. - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMD - - RETURN - END - - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE) - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRING - - OLD_MATCH = .FALSE. - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURN - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE. - RETURN - END IF - J = J + SEARCH_LEN(I) - END DO - - RETURN - END - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')') - RETURN - END IF -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:11).LT.'1900') EXDATE(8:9) = '19' - IF (EXDATE(8:11).LT.'1995') EXDATE(8:9) = '20' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'21'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'21'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')') - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END - - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - CHARACTER*256 INPUT_OUT - CHARACTER*128 TEMP - - INPUT_OUT = ' ' - - I = 0 - - DO WHILE (I.LT.TRIM(INPUT)) - INPUT = INPUT(I+1:) - IF (I.GT.0) INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//',' - I = MINGT0(INDEX(INPUT,','),TRIM(INPUT)+1) - IF (INDEX(INPUT,',').EQ.I.AND.INDEX(INPUT(:I),'@').EQ.0) - & I = TRIM(INPUT)+1 - TEMP = INPUT(:I-1) - CALL ADD_PROTOCOL_SUB(TEMP) - INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//TEMP(:TRIM(TEMP)) - END DO - - INPUT = INPUT_OUT - - IF (ILEN.NE.0) ILEN = TRIM(INPUT) - - RETURN - END - - - - SUBROUTINE ADD_PROTOCOL_SUB(INPUT) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - END IF - - IF (LMAIL.EQ.0) THEN - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN - MAIL_PROTOCOL = MAILER - END IF - LMAIL = TRIM(MAIL_PROTOCOL) - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%' - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1 - RETURN - END IF - END IF - - I = INDEX(INPUT,'@') - IF (I.GT.0) THEN - INPUT = INPUT(:INDEX(INPUT(I:),' ')+I-2) - IF (INDEX(INPUT(I:),'(').GT.0) - & INPUT = INPUT(:INDEX(INPUT(I:),'(')+I-2) - END IF - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"' - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bulletin3.for b/decus/vmslt98a/bulletin/bulletin3.for deleted file mode 100644 index 109b5ad..0000000 --- a/decus/vmslt98a/bulletin/bulletin3.for +++ /dev/null @@ -1,2510 +0,0 @@ -C -C BULLETIN3.FOR, Version 12/4/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2100' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2100' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2100 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2100 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_EDT' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THEN - CALL EDT$EDIT('NL:',OUT) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT) - ELSE - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IF - END IF - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT - ELSE - WRITE(6,'('' Could not activate editor.'')') - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE) - - RETURN - END - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - NOW = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - IF (.NOT.NOW) NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - CALL SYS$SETAST(%VAL(0)) - CALL REGISTER_BULLCP - IER1 = 1 - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - - BBOARD_LOOP = BBOARD_LOOP + 1 - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & (NEWS_LOOP.EQ.0.OR.NOW)) THEN - IF (NOW) THEN - CALL CREATE_PROCESS('BULLCP NEWS1') - ELSE - CALL CREATE_PROCESS('BULLCP NEWS') - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - - C = 0 - IF (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) THEN - CALL CREATE_PROCESS('BULLCP SMTP') - END IF - - NOW = .FALSE. - - NEWS_LOOP = NEWS_LOOP + 1 - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIME - CALL HIBER('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - DIMENSION NEW_SYSTEM_FLAG(FLONG) - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2)) - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER) - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - CALL SETUSER(USERNAME) - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAG - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - END DO - FOLDER_FLAG = FOLDER1_FLAG - FOLDER_NUMBER = 0 - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - CALL CLOSE_BULLUSER - ELSE - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DO - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IF - CLOSE (UNIT=REMOTE_UNIT) - END DO - END IF - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE HIBER(MIN) -C -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -C -C SUBROUTINE DELETE_EXPIRED_NEWS -C -C FUNCTION: -C -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - CHARACTER*4 GET_VMS_VERSION - - INTEGER TODAY(2),NEXT_EX_BTIM(2),NO_EXPIRE(2) - - CHARACTER*8 TODAY_KEY,TEMP - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - IF (NOW) THEN - IER = SYS$SETPRN('BULL NEWS1') - IF (.NOT.IER) CALL EXIT - IER = SYS$SETPRN('BULL NEWS') - IF (.NOT.IER) CALL EXIT - END IF - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - CALL SYS_BINTIM('-',TODAY) - - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - REMOTE_SET = 4 - -C -C A bug keeps messing up the last expired date key so that stored -C news groups do not get found. Someday when this is fixed, we can -C add code like this: -C -C INPUT = GET_VMS_VERSION() -C IF (INPUT(:2).EQ.'V5'.OR.INPUT(:2).EQ.'V4') VMSOLD = .TRUE..AND.NOW - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER).OR.(NOW.AND.IER.EQ.0.AND. - & (.NOT.BTEST(NEWS_F_FLAG,8).OR. - & COMPARE_BTIM(TODAY,NEWEST_EXBTIM).LT.0))) - IF (NOW) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - ELSE - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END IF - END DO - CALL NEWS_TO_FOLDER - - UNLOCK 7 - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - GO TO 1000 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,8)) GO TO 900 - - CALL OPEN_BULLDIR_SHARED - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0 - NDEL = -1 - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM) - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. - IF (NDEL.GT.NEWS_F_END) THEN - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1 - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (EXDATE(8:11).LT.'1995') THEN ! Deleted manually? - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) - EXTIME = ASCTIME(13:23) - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0 - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0 - UNLOCK 2 - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER) - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_START - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - IF (I.LE.F_NBULL) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0 - END DO - F_START = I - NEXT = .FALSE. - END IF - CALL READDIR(F_NBULL,IER) - IF (F_START.LT.F_NBULL.AND.(DN.OR.F_NBULL.EQ.IER)) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I) - I = I - 1 - IF (I.GE.F_START) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = I - END DO - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLDIR - END DO - -900 CALL CLOSE_BULLNEWS - -1000 IF (NOW.OR.IER.EQ.0) THEN - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.*]'//'*.' - INPUT = GET_VMS_VERSION() - CALL LIB$DAY_OF_WEEK(TODAY,DAY) - IF (DAY.NE.7) THEN - IER = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - IF (IER) THEN - DAY = 7 - CALL DELLNM('BULL_NEWS_CLEANUP') - END IF - END IF - IF (INPUT(:2).NE.'V5'.AND.INPUT(:2).NE.'V4') THEN - CONTEXT = 0 - DO WHILE (LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT)) - IER = CONV$RECLAIM(INPUT(:TRIM(INPUT))) - END DO - ELSE IF (DAY.EQ.7) THEN - REMOTE_SET = 4 - DIRLIST = .TRUE. - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(1000,IER) - CALL READ_FOLDER_FILE(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NO_EXPIRE) - DO WHILE (IER.EQ.0) - UNLOCK 7 - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - C = 0 - IF (LIB$FIND_FILE(BULLNEWSDIR_FILE - & (:TRIM(BULLNEWSDIR_FILE))//';1',INPUT,C)) THEN - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';2') - ELSE - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - END IF - CALL OPEN_BULLDIR_SHARED - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE,SHARED, - & BUFFERCOUNT=127, - & INITIALSIZE=(NEWSDIR_RECORD_LENGTH*F_COUNT)/512, - & STATUS='NEW',FORM='UNFORMATTED',DISPOSE='DELETE', - & RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,IOSTAT=IER, - & ORGANIZATION='INDEXED',RECORDTYPE='FIXED', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - END IF - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (2,IOSTAT=IER) NEWSDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - WRITE (9,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - ELSE - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY), - & %DESCR(EX_BTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & CALL COPY2(NEWEST_EXBTIM,EX_BTIM) - END IF - END IF - END DO - CLOSE (UNIT=9,DISPOSE='KEEP') - CALL CLOSE_BULLDIR_DELETE - CALL GET_MSGKEY(NEWEST_EXBTIM,TEMP) - IF (TEMP.NE.NEWS_F_EXPIRED_DATE) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - NEWS_F_EXPIRED_DATE = TEMP - CALL REWRITE_FOLDER_FILE(IER) - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - END IF - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - ELSE - IF (NO_EXPIRE(1).NE.NEWEST_EXBTIM(1).OR. - & NO_EXPIRE(2).NE.NEWEST_EXBTIM(2)) THEN - CALL GET_MSGKEY(NO_EXPIRE,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - ELSE - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - END IF - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';') - END DO - END IF - CALL READ_FOLDER_FILE(IER) - END DO - CALL CLOSE_BULLNEWS - END IF - DIRLIST = .FALSE. - NEWSLIST = .TRUE. - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - IER = .TRUE. - DO WHILE (IER) - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;') - IER = INDEX(FOLDER_FILE,']1JAN').EQ.0 - END DO - J = INDEX(FOLDER_FILE,']') - DECODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) THEN - DO I=1,10 - YEAR = YEAR - 1 - IF (YEAR.EQ.-1) YEAR = 99 - ENCODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) IER = LIB$DELETE_FILE(FOLDER_FILE(:J) - & //'*.*;*') - END DO - END IF - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IF - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'READ/NEW' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - - IER = 0 - CALL STRIP_HEADER(' ',-1,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.EQ.0) THEN - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP) - IF (STRIP.AND.INPUT(:5).EQ.'From:') INFROM = ' ' - END IF - END DO - -C -C If more than one folder has same BBOARD account, don't use the -C To: line to determine which folder to put the mail message in. -C - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - DUP = .FALSE. - DO WHILE (.NOT.DUP.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - DUP = FOLDER.NE.FOLDER1.AND.FOLDER_BBOARD.EQ.FOLDER1_BBOARD - END DO - IF (DUP.OR..NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - FOUND = .FALSE. - J = 0 - IF (DUP) J = 1 - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THEN - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - FOUND = INTO.EQ.F_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - END IF - FLEN = TRIM(F_BBOARD) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DO - END IF - END IF - END DO - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COM - END IF - - NUMHEAD = 0 - IF (NHEAD.GT.0) NUMHEAD = NHEAD + 1 - - IF (NUMHEAD.GT.0) THEN - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - SAVE_Q = HEADER_Q - SAVE_Q1 = HEADER_Q1 - NHEAD1 = NHEAD - HEADER_Q1 = 0 - ! INIT_MESSAGE_ADD_BBOARD reinits header so save it - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NUMHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - ELSE IF (NUMHEAD.EQ.1) THEN - INPUT = ' ' - LEN_INPUT = 1 - NUMHEAD = NUMHEAD - 1 - ELSE - CALL READ_QUEUE(%VAL(SAVE_Q),SAVE_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - USE_INFROM = .TRUE. - - NHEAD = NHEAD1 - HEADER_Q1 = SAVE_Q1 - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL SYS$SETAST(%VAL(1)) - IF (.NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) - & CALL NEWS2BULL(.FALSE.) - END IF - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE. - - LEN_BBOARD = LEN(BBOARD) - 1 - LEN_INPUT = TRIM(INPUT) - - DO I=1,LEN_INPUT-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND. - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND. - & (I.EQ.LEN_INPUT-LEN_BBOARD.OR. - & (INDEX('@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0 - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND. - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALPHA(IN) - - CHARACTER*(*) IN - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURN - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN - - BBOARD_NAME = FOLDER_DESCRIP(I+1:) - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!') - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DO - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - IER = 0 - DO WHILE (IER.EQ.0) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - END DO - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - IF (INDEX(IMAGENAME,';').GT.0) ILEN = INDEX(IMAGENAME,';') - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0) - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - IF (.NOT.IER.AND..NOT.DEL) THEN - CALL DELPRC('BULLCP NEWS',DEL) - IER = .NOT.DEL - ELSE - IER = .TRUE. - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI) -C -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL ADD_2_ITMLST(4,JPI$_ENQLM,%LOC(ENQLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF - END IF - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_ENQLM - CALL LIB$MOVC3(4,ENQLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2)) - - RETURN - END - - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - CHARACTER*4 FUNCTION GET_VMS_VERSION -C -C FUNCTION GET_VMS_VERSION -C -C FUNCTION: Gets VMS version -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER VERSION*4 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,SYI$_NODE_SWVERS,%LOC(VERSION)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - GET_VMS_VERSION = VERSION - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DO - - CALL CLOSE_BULLDIR - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAM - - DATA OBIO/0/,OCPU/0/,ODIO/0/ - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAM - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU)) - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IF - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1 - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - END IF - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND. - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIO - ODIO = DIO - OCPU = CPU - IER = 0 - RETURN - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IF - RETURN - END diff --git a/decus/vmslt98a/bulletin/bulletin4.for b/decus/vmslt98a/bulletin/bulletin4.for deleted file mode 100644 index 30bf4b5..0000000 --- a/decus/vmslt98a/bulletin/bulletin4.for +++ /dev/null @@ -1,2346 +0,0 @@ -C -C BULLETIN4.FOR, Version 12/17/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(' ',-1,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - READ_HEAD = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) THEN ! No more records. - IF (STRIP.AND..NOT.READ_HEAD.AND.NHEAD.GT.0) THEN - IBLOCK = SBLOCK - ILEN = LINE_LENGTH+1 - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - READS = 0 - IF (SEEN_FROM) READS = READS + 1 - IF (SEEN_SUBJ) READS = READS + 1 - IF (MSG_SENT) READS = READS + 1 - IF (READS.GT.0) THEN - DO I=1,READS - ILEN = 0 - DO WHILE (ILEN.EQ.0) - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - END DO - END DO - END IF - STRIP = .FALSE. - ELSE - RETURN - END IF - END IF - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' '.AND..NOT.MAIL_POST()) THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - IF (STRIP.AND.BUFFER(:5).EQ.'From:') READ_HEAD = .TRUE. - IF (.NOT.STRIP.AND..NOT.READ_HEAD.AND.NHEAD.GT.0) THEN - IBLOCK = SBLOCK - ILEN = LINE_LENGTH+1 - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - READS = 0 - IF (SEEN_FROM) READS = READS + 1 - IF (SEEN_SUBJ) READS = READS + 1 - IF (MSG_SENT) READS = READS + 1 - IF (READS.GT.0) THEN - DO I=1,READS - ILEN = 0 - DO WHILE (ILEN.EQ.0) - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - END DO - END DO - END IF - END IF - ELSE - IF (.NOT.HEADER) THEN - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - STRIP = .FALSE. - END IF - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - IER = 0 - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - CHARACTER RESPONSE*4 - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - CALL STR$UPCASE(FOLDER,FOLDER) - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '', - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAX - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - RETURN - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACL - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_NAME = FOLDER - FOLDER_OWNER = FOLDER1_OWNER - - MAILTO = 0 - I = INDEX(FOLDER_DESCRIP,'<') - J = INDEX(FOLDER_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER_DESCRIP(I:),'@').LT.1.OR. - & INDEX(FOLDER_DESCRIP(I:),'@').GT.J-I+1).AND.NEWS_FEED()) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - I = INDEX(FOLDER_DESCRIP,'[') - J = INDEX(FOLDER_DESCRIP,']') - END IF - - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - IF (I.GT.0.AND.J.GT.I.AND..NOT.NEWS_FEED().AND.MAILTO.EQ.0 - & .AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - IF (CLI$GET_VALUE('COPY',FOLDER1,FLEN).NE.%LOC(CLI$_ABSENT)) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Unable to copy folder settings.'')') - ELSE - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - 1 - IF (.NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) THEN - LAST(1,FOLDER1_NUMBER+1) = LAST(1,FOLDER_NUMBER+1) - LAST(2,FOLDER1_NUMBER+1) = LAST(2,FOLDER_NUMBER+1) - REWRITE (9,IOSTAT=IER) TEMP_USER,LAST - END IF - END IF - END DO - CALL CLOSE_BULLINF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(SET_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SET_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(NOTIFY_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - END IF - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - END IF - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -C -C Description: -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -C -C SUBROUTINE CREATE_NEWS_FOLDER -C -C FUNCTION: Creates a new newsgroup. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME) - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF -C -C If file specified in command, read file. -C Else, read from the terminal. -C - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file -2010 FORMAT(A) - ICOUNT = ICOUNT + ILEN - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER, - & 'Adding newsgroup.') - CLOSE (UNIT=3) - - RETURN - -920 WRITE(6,1020) -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURN - -910 WRITE(6,1010) -1010 FORMAT (' No news group was added.') - CLOSE (UNIT=3) - RETURN - - END - - - - - SUBROUTINE INIT_COMPRESS - - IMPLICIT INTEGER (A-Z) - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127 - DO J=0,127 - A(J,I) = ' ' - END DO - END DO - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DO - - J = 1 - DO I=1,8 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=10,31 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=127,254 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - - RETURN - - ENTRY COMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.126) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.126) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:))) - IF (T(O:O).NE.' ') THEN - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND. - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1)) - C = C + 1 - K = K + 1 - END DO - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1) - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0) - O = O + 1 - ELSE - T(O:O) = IN(K:K) - IF (ICHAR(T(O:O)).LT.9.OR.(ICHAR(T(O:O)).GT.9.AND. - & ICHAR(T(O:O)).LT.32)) T(O:O) = ' ' - K = K + 1 - O = O + 1 - END IF - END DO - IF (K.EQ.L) THEN - T(O:O) = IN(K:K) - ELSE - O = O - 1 - END IF - - OUT = T - - RETURN - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1 - T(O:O) = IN(I+2:I+2) - END DO - I = I + 3 - ELSE - B = UNMAP(J) - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1 - T(O:O) = IN(I:I) - ELSE - O = O + 2 - T(O-1:O) = B - END IF - I = I + 1 - END IF - END DO - - OUT = T(:O) - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bulletin5.for b/decus/vmslt98a/bulletin/bulletin5.for deleted file mode 100644 index bc7c3a7..0000000 --- a/decus/vmslt98a/bulletin/bulletin5.for +++ /dev/null @@ -1,2516 +0,0 @@ -C -C BULLETIN5.FOR, Version 3/5/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3) THEN - CALL SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - RETURN - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - NODEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (NODEFAULT) THEN - IF (NOTIFY.NE.-1) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) THEN - CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - END IF - REWRITE(4) USER_HEADER - ELSE IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & (FOLDER1_NUMBER.EQ.0.AND.FOLDER1_BBOARD(:2).NE.'::')) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - IF (FOLDER1_NUMBER.NE.0.OR.FOLDER1_BBOARD(:2).NE.'::') THEN - ! Test is due to bug which changes folder number to zero - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG - IF (BTEST(FOLDER1_FLAG,2)) THEN - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAG - FOLDER_NUMBER = TEMP_NUMBER - END IF - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - CALL UPDATE_EXCLUDE - - CALL UPDATE_USERINFO - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET').OR.(INCMD(:3).EQ.'SEA') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & (F1_START.GT.0.OR.F_START.LE.F_NBULL)) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_COUNT = F1_COUNT - IF (F1_START.GT.0) THEN - IF (F1_NBULL.LT.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER-1.GE.F1_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - ELSE - F_NBULL = F1_NBULL - END IF - F_START = F1_START - ELSE - F_START = F_NBULL + 1 - END IF - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - REMOTE_SET_NEW = 1 - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - IF (COMMAND.AND.INCMD(:3).NE.'REP'.AND. - & INCMD(:3).NE.'DEL') HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER1) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.IER1.EQ.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11).AND.WRITE_ACCESS) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s news group.'')') - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP( - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE IF (REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - ELSE IF (REMOTE_SET.EQ.3.OR.REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN - WRITE (6,'('' Folder only accessible for reading.'')') - END IF - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THEN - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - BULL_PARAMETER = 'MARKED' - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - BULL_PARAMETER = 'SEEN' - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED' - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN' - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - WRITE(6,'('' WARNING: No '',A, - & '' messages found.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IF - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE. - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - LAST_FOLDER_NUMBER = FOLDER_NUMBER - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IF - - IF (TEST_NEWS(FOLDER1)) THEN - INCMD = 'SET NEWS ' - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL ' - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Access is limited.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0) - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,10)) THEN - WRITE (6,'('' POST_ONLY has been set.'')') - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THEN - WRITE (6,'('' COMPRESS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,15)) THEN - WRITE (6,'('' GATEWAY has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - IF (NEWS_FEED()) THEN - WRITE (6,'('' Last message fed by news group was: '',I)') F_LAST - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/, - & ' Description: ',A) -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/, - & ' Description: ',A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/ - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' ' - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. - STORED = .FALSE. - CLASS = .FALSE. - NEW = .FALSE. - PERM = .FALSE. - DEFA = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counter - NLINE = 1 - START = .FALSE. - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE. - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - CALL NEWS_LIST - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - END IF - COUNT = CLI$PRESENT('COUNT') - IF (COUNT) TOTAL_COUNT = 0 - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - NEW = CLI$PRESENT('NEWGROUPS') - CLASS = CLI$PRESENT('CLASS') - PERM = CLI$PRESENT('PERMANENT') - DEFA = CLI$PRESENT('DEFAULT') - IF (CLASS) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - ELSE IF (PERM) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE IF (DEFA) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER) - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER - FOLDER_COUNT = -1 - RETURN - ELSE - START = .TRUE. - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN) - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0 - FOLDER_COUNT = -1 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN - SUBNUM = -2 - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DECLARE_CTRLC_AST - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE. - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (PERM.OR.DEFA) THEN - IER = 1 - DO WHILE (INUM.LE.FOLDER_MAX.AND.IER.NE.0) - IF (INF_REC2(1,INUM).NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (ZEXT(INF_REC2(1,INUM)),IER) - END IF - INUM = INUM + 1 - END DO - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2 - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THEN - NEW_NEWS = FOLDER1_NUMBER - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP) - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)), - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - END IF - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - FSTATUS1 = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (.NOT.NEWS_TEST) THEN - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN - IER1 = 1 - MORE = .TRUE. - END IF - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DO - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1 - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THEN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))') - ELSE IF (CLASS) THEN - WRITE (6,'(1X,''Class'',/,1X,(''-''))') - ELSE IF (SUBSCRIBE) THEN - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,''Status'',7X, - & ''First Last'',/,1X,(''-''))') - END IF - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1 - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1.AND. - & FLAG.NE.100) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - ELSE - FSTATUS1 = ' ' - END IF - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNT - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0 - END IF - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '* '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - END IF - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IF - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER - IF (NEWS_TEST.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - CALL GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & FSTATUS1,IER,ACTIVE) - MORE = MORE.AND.FOUND - IF (MORE) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND.AND.FLAG.NE.1) FLAG = 100 - END IF - END DO - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - END IF - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNT - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSE - WRITE(6,1100) ! Else say there are more - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10) -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS.OR.CLI$PRESENT('CLASS')) THEN - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.' - END IF - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER ! Open folder file - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - CALL RESET_PROTECTION - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')') - RETURN - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0) - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER) - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE - CALL SET_FOLDER_FILE(0) - END IF - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INDEX(INPUT,'[').EQ.0.AND.INDEX(INPUT,']').GT.0.AND. - & ID(:1).EQ.'[') INPUT = ID(:TRIM(ID))//','//INPUT - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').GT.0) - & COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"'.AND.INDEX(INPUT(2:),'"').GT.0) - & COMMA = INDEX(INPUT(2:),'"') + 2 - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').EQ.0) COMMA = 0 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ILEN = TRIM(ID) - ELSE - ID = INPUT - INPUT = ' ' - ILEN = TRIM(ID) - END IF - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE IF (ID(:1).NE.'['.OR.INDEX(ID,']').NE.0) THEN - IF (ILEN.EQ.0) THEN - IER = SS$_IVIDENT - ELSE IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IF - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*256 ACLENT - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURN - - ENTRY WRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER_COM - END IF - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - DO I=1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - NEW_NEWS_ACCESS = - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS' - - RETURN - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C)) - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' ' - ELSE - FILE = FILE(:L) - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - F = LEN(FIND) - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & STAT,IER,ACTIVE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*(*) STAT,FOLDER_MATCH - - CHARACTER NEWS_ACCESS*132 - - FOUND = .FALSE. - STAR = INDEX(FOLDER_MATCH,'*') - ONE = STAR.EQ.0.AND.TRIM(FOLDER_MATCH).GT.0 - START = .FALSE. - IF (STAR.GT.1) - & START = FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1) - STARTNOW = START - - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - IF (ONE) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER_MATCH(:TRIM(FOLDER_MATCH)),IER) - FOLDER_MATCH = ' ' - ELSE IF (STARTNOW) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP - & (FOLDER_MATCH(:STAR-1),IER) - STARTNOW = .FALSE. - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - END IF - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - STAT(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - STAT = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(STAT(:1).NE.'x'.AND. - & .NOT.BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (ONE.OR..NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1) - ELSE - FOUND1 = .TRUE. - END IF - END IF - FOUND = FOUND1 - ELSE - FOUND = .TRUE. - END IF - ELSE IF (IER.EQ.0.AND.START) THEN - IF (FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1)) RETURN - END IF - IF (ONE) RETURN - END DO - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bulletin6.for b/decus/vmslt98a/bulletin/bulletin6.for deleted file mode 100644 index 948cd3f..0000000 --- a/decus/vmslt98a/bulletin/bulletin6.for +++ /dev/null @@ -1,2811 +0,0 @@ -C -C BULLETIN6.FOR, Version 9/15/95 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - TRY = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.TRY.EQ.0) THEN - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - TRY = 1 - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL_NAME - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & BUFFERCOUNT=127, - & ORGANIZATION='INDEXED',IOSTAT=IER) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open file: '',A)') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - IF (UNIT.EQ.14) THEN - WRITE (6,'('' Database conversion in progress. Try later.'')') - ELSE - WRITE (6,'('' Please try again later.'')') - END IF - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - COMMON /NEWSLIST/ NEWSLIST - DATA NEWSLIST/0/ - - COMMON /DIRLIST/ DIRLIST - DATA DIRLIST/0/ - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - LUN = 2 - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL_NAME - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & BUFFERCOUNT=127, - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - END IF - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) WRITE(6,'(1X,A)') - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1))) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULL - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LAST - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMIT - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLNEWSDIR - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($FORIOSDEF)' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*180 TEMP - - CHARACTER BUFFER*12,DATETIME*24 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - CALL OPEN_BULLNEWS - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=180/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & BUFFERCOUNT=127,KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR]') - IF (.NOT.IER1) GO TO 900 - - NEW_FOLDER_NUMBER = 0 - - DO WHILE (IER.EQ.0) - READ (2,IOSTAT=IER) TEMP - IF (GET_INTEGER(%REF(TEMP)).NE.NEW_FOLDER_NUMBER) THEN - IF (NEW_FOLDER_NUMBER.NE.0) CLOSE (UNIT=9,DISPOSE='KEEP') - NEW_FOLDER_NUMBER = GET_INTEGER(%REF(TEMP)) - CALL SET_BULLNEWSDIR_FILE(NEW_FOLDER_NUMBER) - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE, - & STATUS='UNKNOWN',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) GO TO 900 - END IF - NEWS_MSG_NUM = GET_INTEGER(%REF(TEMP(5:))) - NEWS_MSG_BTIM_KEY = TEMP(13:) - NEWS_EX_BTIM_KEY = TEMP(89:) - NEWS_MSGID = TEMP(21:) - CALL COPY2(MSG_BTIM,%REF(TEMP(97:))) - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL LIB$MOVC3(76,%REF(TEMP(105:)),NEWS_BLOCK) - - WRITE (9,IOSTAT=IER1) NEWSDIR_ENTRY - END DO - - CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - - CALL RESET_PROTECTION - - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - - IER = LIB$RENAME_FILE(BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - & ,'BULLNEWSDIR.OLD') - - WRITE (6,'('' BULLNEWSDIR.DAT has been renamed to '', - & '' BULLNEWSDIR.OLD and may now be deleted.'')') - - RETURN - -900 CALL RESET_PROTECTION - - CALL CLOSE_BULLNEWS - - WRITE(6,'('' ERROR: Cannot convert BULLNEWSDIR.DAT'')') - IF (IER.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - - END - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(81:84) = BUFFER(85:) - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL RESET_PROTECTION - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - IF (ASK_SIZE.EQ.184) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST) - ELSE - F_LAST = 0 - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LAST - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER)) - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0 - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -C -C SUBROUTINE CONVERT_BULLNEWS -C -C FUNCTION: Converts bulletin NEWS file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. '' - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0 - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE) - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0 - NEWS_F_END = 0 - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108) - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:) - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1 - IF (LMOVE.LE.0) THEN - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP - ELSE - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE)) - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) - END IF - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SET_PROTECTION - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL RESET_PROTECTION - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXT - - COMMON /KEEPLOCK/ KEEPLOCK - DATA KEEPLOCK/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /THREAD/ THREAD - - CHARACTER*4 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSE - DIR_NUM = 0 - END IF - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURN - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEYGE=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0.AND.ICOUNT.EQ.F_START) THEN - READ(2,KEYGT=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.EQ.0) ICOUNT = NEWS_MSG_NUM - END IF - END IF - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND. - & MSG_NUM.GT.F_START) THEN - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER,IER2) - F_START = MSG_NUM - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IF - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THEN - ICOUNT = MSG_NUM - BULLETIN_NUM = ICOUNT - END IF - END IF - ELSE - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 - END IF - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IF (REMOTE_SET.NE.4) CALL STR$UPCASE(FROM,FROM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IF - - IF (IER.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1 - ELSE IF (THREAD) THEN - DUMMY = INCLUDE_MSG(FROM,DESCRIP) - END IF - END IF - END IF - - RETURN - - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM) - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z) - - INTEGER TEMP - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I) - END DO - - RETURN - END - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/1/ - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.2.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.2.AND.MSG_NUM.NE.0) THEN - IF (MSG_NUM.GT.NEWS_F_END) THEN - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36 - UNLOCK 2 - END IF - END IF - END IF - ELSE - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - IER = 0 - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10 - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY),%DESCR(EX_BTIM)) - IF (POSTTIME) THEN - CALL GET_MSGKEY(%REF(NEWS_POST_KEY),%DESCR(MSG_BTIM)) - CALL CONVERT_FROM_GMT(MSG_BTIM) ! Assume stored is GMT - END IF - DESCRIP = NEWS_DESCRIP - FROM = NEWS_FROM - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IF - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11) - EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME(:11) - TIME = DATETIME(13:23) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - ELSE - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IF (BULLETIN_NUM.NE.NEWS_F_END+1) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END DO - END IF - ELSE - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IF - IF (REMOTE_SET.EQ.4.AND. - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN - CALL SPECIAL_NEWSDIR_ENTRY(IER) - ELSE IF (IER.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEN - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*140 TEMP - - DIMENSION BTIM(2) - - READ (2,KEYID=3,KEY=NEWS_POST_KEY,IOSTAT=IER) TEMP - DO WHILE (IER.EQ.0.AND.NEWS_POST_KEY.EQ.TEMP(57:64)) - IF (NEWS_MSGID.EQ.TEMP(21:56)) THEN - IER = 2 - RETURN - END IF - READ (2,IOSTAT=IER) TEMP - END DO - -10 IER1 = 0 - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=0,KEYGT=NEWS_F_END, - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - DO WHILE (IER1.EQ.0) - CALL LIB$MOVC3(4,%REF(INPUT),FNUM) - CALL GET_MSGKEY(%REF(INPUT(13:)),%DESCR(BTIM)) - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IF - F_COUNT = F_COUNT + 1 - CALL LIB$MOVC3(4,%REF(INPUT),NEWS_F_END) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - END DO - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IF - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSE - F_COUNT = F_COUNT + 1 - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,MSG_BTIM) - ELSE - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - END IF - - IF (LOCAL_POST) THEN - CALL SYS_BINTIM(DATE//' '//TIME - & (:TRIM(TIME)-2)//'00',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP - NEWS_FROM = FROM - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH - NEWS_MSG_NUM = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,NEWS_MSG_BTIM_KEY) - CALL GET_MSGKEY(EX_BTIM,NEWS_EX_BTIM_KEY) - ELSE - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - - RETURN - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KEYID/ NEWS_KEYID - - COMMON /KEEPLOCK/ KEEPLOCK - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 2 - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - CALL READDIR_KEYGE(NDEL) - KEEPLOCK = .FALSE. - NEWS_KEYID = 1 - - RETURN - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII)) - IF (ACLSTR(START_ID:START_ID).NE.','.AND. - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DO - IF (ASCII) THEN - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl output - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C -C SUBROUTINE COPY_ACL1 -C -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - ! Read input file acl - - IF (.NOT.IER) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./ - - IF (CHECKED) RETURN - - CHECKED = .TRUE. - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C) - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORY - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - END IF - - CALL CHECK_DIR(FOLDER_DIRECTORY,.FALSE.) - CALL CHECK_DIR(NEWS_DIRECTORY,.FALSE.) - - CALL ADD_DIRECTORIES - - RETURN - END - - - - SUBROUTINE ADD_DIRECTORIES - - INCLUDE 'BULLFILES.INC' - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE) - - RETURN - END - - - - LOGICAL FUNCTION CHECK_DIR(DIRECTORY,LIBRARY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - CHECK_DIR = PRESENT(BULLUSER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLFOLDER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLINF_FILE,DIRECTORY,TEST) - - IF (CHECK_DIR) THEN - IF (SYS_TRNLNM(DIRECTORY,TEST)) DIRECTORY = TEST - RETURN - END IF - - TEST = ' ' - - IF (INDEX(DIRECTORY,']').EQ.0) THEN - CALL SYS_TRNLNM(DIRECTORY,TEST1) - ELSE - TEST1 = DIRECTORY - END IF - - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - - IF (.NOT.LIBRARY.AND.TEST.EQ.' ') THEN - IER = SYS_TRNLNM_SYSTEM(DIRECTORY,TEST) - IF (.NOT.IER.AND.TEST1.EQ.DIRECTORY) RETURN - END IF - - IF (TEST.NE.TEST1) THEN - IF (LIBRARY) THEN - WRITE (6,'('' ERROR: Not a valid library. '')') - RETURN - END IF - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER) - CLOSE(UNIT=3,STATUS='DELETE') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)') - & TEST1(:TRIM(TEST1)) - CALL EXIT - END IF - DIRECTORY = TEST1 - ELSE - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - CHECK_DIR = .TRUE. - END IF - - RETURN - END - - - - - LOGICAL FUNCTION PRESENT(FILE,DIR,TEST) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILE,DIR,TEST - - FILE = FILE(INDEX(FILE,':')+1:) - FILE = FILE(INDEX(FILE,']')+1:) - IF (INDEX(DIR,':').EQ.0.AND.INDEX(DIR,'[').EQ.0.AND. - & INDEX(DIR,'<').EQ.0) DIR = DIR(:TRIM(DIR))//':' - C = 0 - PRESENT = LIB$FIND_FILE(DIR(:TRIM(DIR))//FILE,TEST,C) - - RETURN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:) - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:) - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':' - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURN - END - - - - SUBROUTINE SET_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CALL CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P) - - IF (CHECK_DIR(BULL_PARAMETER,.TRUE.)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - CALL UPDATE_USERINFO - CALL OPEN_USERINFO - INCMD = 'SHOW' - CALL UPDATE_READ(0) - END IF - - RETURN - END - - - - SUBROUTINE SHOW_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (CLI$PRESENT('ALL')) THEN - IER = 1 - N = 1 - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',BULL_PARAMETER) - IF (IER) THEN - IF (N.EQ.1) THEN - WRITE (6,'('' The following are valid libraries:'')') - N = 0 - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER - END IF - END DO - IF (N.EQ.1) WRITE (6,'('' No libraries are present.'')') - ELSE - WRITE (6,'('' Present library is: '',A)') - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - END IF - - RETURN - END - - - - SUBROUTINE SET_BULLNEWSDIR_FILE(FN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - BULLNEWSDIR_FILE = ' ' - - ENCODE(6,'(I6)',BULLNEWSDIR_FILE) FN - BULLNEWSDIR_FILE = BULLNEWSDIR_FILE(FIRST_ALPHA(BULLNEWSDIR_FILE):) - L = TRIM(BULLNEWSDIR_FILE) - - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.'// - & BULLNEWSDIR_FILE(:L-3)//']'// - & BULLNEWSDIR_FILE(L-2:TRIM(BULLNEWSDIR_FILE))//'.' - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bulletin7.for b/decus/vmslt98a/bulletin/bulletin7.for deleted file mode 100644 index d8769ce..0000000 --- a/decus/vmslt98a/bulletin/bulletin7.for +++ /dev/null @@ -1,2352 +0,0 @@ -C -C BULLETIN7.FOR, Version 8/14/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - CHARACTER FOLDER_NAME_SAVE*80 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER_NAME_SAVE.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - FOLDER_NAME_SAVE = FOLDER_NAME - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCALPOST/ LOCAL_POST - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - IF (.NOT.LOCAL_POST) THEN - DATE = NEWEST_DATE - TIME = NEWEST_TIME - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIR - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /OUTPUT/ REASSIGNED - LOGICAL REASSIGNED - DATA REASSIGNED /.FALSE./ - - CALL DISABLE_PRIVS ! Disable SYSPRV - - IF (.NOT.REASSIGNED) THEN - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - END IF - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - IF (INDEX(INPUT,']').GT.0) THEN - SYS_TRNLNM = .FALSE. - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX)) - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1 - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IF - - RETURN - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - IER1 = 0 - ELSE - IF (IER.GT.0) THEN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0 - CALL SET_FOLDER_FILE(0) - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0) - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*12 DATE_SAVE,EXDATE_SAVE - CHARACTER*12 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - END IF - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER PSCAN$_BEGIN = '00000000'X - PARAMETER PSCAN$_ACCOUNT = '00000001'X - PARAMETER PSCAN$_AUTHPRI = '00000002'X - PARAMETER PSCAN$_CURPRIV = '00000003'X - PARAMETER PSCAN$_GRP = '00000004'X - PARAMETER PSCAN$_HW_MODEL = '00000005'X - PARAMETER PSCAN$_HW_NAME = '00000006'X - PARAMETER PSCAN$_JOBPRCCNT = '00000007'X - PARAMETER PSCAN$_JOBTYPE = '00000008'X - PARAMETER PSCAN$_MASTER_PID = '00000009'X - PARAMETER PSCAN$_MEM = '0000000A'X - PARAMETER PSCAN$_MODE = '0000000B'X - PARAMETER PSCAN$_NODE_CSID = '0000000C'X - PARAMETER PSCAN$_NODENAME = '0000000D'X - PARAMETER PSCAN$_OWNER = '0000000E'X - PARAMETER PSCAN$_PRCCNT = '0000000F'X - PARAMETER PSCAN$_PRCNAM = '00000010'X - PARAMETER PSCAN$_PRI = '00000011'X - PARAMETER PSCAN$_PRIB = '00000012'X - PARAMETER PSCAN$_STATE = '00000013'X - PARAMETER PSCAN$_STS = '00000014'X - PARAMETER PSCAN$_TERMINAL = '00000015'X - PARAMETER PSCAN$_UIC = '00000016'X - PARAMETER PSCAN$_USERNAME = '00000017'X - PARAMETER PSCAN$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER PSCAN$_END = '00000019'X - PARAMETER PSCAN$k_type = '00000081'X - PARAMETER PSCAN$M_OR = '00000001'X - PARAMETER PSCAN$M_BIT_ALL = '00000002'X - PARAMETER PSCAN$M_BIT_ANY = '00000004'X - PARAMETER PSCAN$M_GEQ = '00000008'X - PARAMETER PSCAN$M_GTR = '00000010'X - PARAMETER PSCAN$M_LEQ = '00000020'X - PARAMETER PSCAN$M_LSS = '00000040'X - PARAMETER PSCAN$M_PREFIX_MATCH = '00000080'X - PARAMETER PSCAN$M_WILDCARD = '00000100'X - PARAMETER PSCAN$M_CASE_BLIND = '00000200'X - PARAMETER PSCAN$M_EQL = '00000400'X - PARAMETER PSCAN$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER PSCAN$S_OR = 1 - PARAMETER PSCAN$V_OR = 0 - PARAMETER PSCAN$S_BIT_ALL = 1 - PARAMETER PSCAN$V_BIT_ALL = 1 - PARAMETER PSCAN$S_BIT_ANY = 1 - PARAMETER PSCAN$V_BIT_ANY = 2 - PARAMETER PSCAN$S_GEQ = 1 - PARAMETER PSCAN$V_GEQ = 3 - PARAMETER PSCAN$S_GTR = 1 - PARAMETER PSCAN$V_GTR = 4 - PARAMETER PSCAN$S_LEQ = 1 - PARAMETER PSCAN$V_LEQ = 5 - PARAMETER PSCAN$S_LSS = 1 - PARAMETER PSCAN$V_LSS = 6 - PARAMETER PSCAN$S_PREFIX_MATCH = 1 - PARAMETER PSCAN$V_PREFIX_MATCH = 7 - PARAMETER PSCAN$S_WILDCARD = 1 - PARAMETER PSCAN$V_WILDCARD = 8 - PARAMETER PSCAN$S_CASE_BLIND = 1 - PARAMETER PSCAN$V_CASE_BLIND = 9 - PARAMETER PSCAN$S_EQL = 1 - PARAMETER PSCAN$V_EQL = 10 - PARAMETER PSCAN$S_NEQ = 1 - PARAMETER PSCAN$V_NEQ = 11 - BYTE %FILL (2) - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -C -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -C -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE)) -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1 -C UJPIMODE = -1 -C TERMINAL(1:1) = CHAR(0) -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./ - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IF - END DO - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - DO I=1,FOLDER_MAX - DO J=1,2 - LAST(J,I) = LAST_READ_BTIM(J,I) - END DO - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.EQ.0) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - WRITE (9,IOSTAT=IER) USERNAME,INF_REC - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIM - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0 - LAST_SYS_BTIM(2,I) = 0 - END DO - END IF - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -C -C SUBROUTINE READ_NEWS_USERINFO -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) NAME - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2))) - END IF - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READ - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - EQUIVALENCE (OLD_LAST_NEWS_READ2(1,1),OLD_LAST_NEWS_READ(1,1)) - INTEGER*2 OLD_LAST_NEWS_READ2(4,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF = (LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF1 = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF1 = (LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF2 = .FALSE. - GO TO 10 - - ENTRY UPDATE_USERINFO_NEWS_ALWAYS - DIFF2 = .TRUE. - -10 IF (.NOT.DIFF2) THEN - DO I=1,FOLDER_MAX - DIFF2 = (LAST_NEWS_READ(1,I).NE. - & OLD_LAST_NEWS_READ(1,I)).OR. - & (LAST_NEWS_READ(2,I).NE. - & OLD_LAST_NEWS_READ(2,I)).OR.DIFF2 - END DO - END IF - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHARED - - IF (DIFF) THEN - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & LAST(J,I) = LAST_READ_BTIM(J,I) - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - END IF - - IF (DIFF1) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & OLD_LAST_SYS_BTIM(J,I) = LAST_SYS_BTIM(J,I) - LAST_SYS_BTIM(J,I) = OLD_LAST_SYS_BTIM(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF - - IF (DIFF2) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=2,1,-1 - IF (I.EQ.NEWS_FIND_SUBSCRIBE().OR. - & OLD_LAST_NEWS_READ2(1,I).NE.LAST_NEWS_READ2(1,I)) - & OLD_LAST_NEWS_READ(J,I) = LAST_NEWS_READ(J,I) - LAST_NEWS_READ(J,I) = OLD_LAST_NEWS_READ(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - CHARACTER*24 TIME1 - - TIME1 = TIME(FIRST_ALPHA(TIME):) - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:) - END DO - - IF (TIME1.EQ.'-') TIME1 = '-- :' - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder info - ELSE IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND. - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A)') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - IF (INCMD(:4).EQ.'SHOW') THEN - SAVE_FOLDER_Q1 = 0 - RETURN - END IF - IF (NEW_MESS.OR.NEWS_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1 - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0 - END IF - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - IF (USERNAME(:3).EQ.'MRL'.OR.USERNAME(:7).EQ.'DNELSON') - & TYPE *,LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE(IER) - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER) - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bulletin8.for b/decus/vmslt98a/bulletin/bulletin8.for deleted file mode 100644 index 4fd8825..0000000 --- a/decus/vmslt98a/bulletin/bulletin8.for +++ /dev/null @@ -1,2163 +0,0 @@ -C -C BULLETIN8.FOR, Version 10/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND. - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0, - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - END IF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE. - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THEN - ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX)) - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV) - END IF - END IF - END IF - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND. - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24 - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM) - P = 4 + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (BTEST(FOLDER_FLAG,14)) FROM = 'ANONYMOUS' - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - IF (NEWS_FEED()) THEN - BULL_POINT = NBULL - INCMD = 'COPY/ORIGINAL/LOCAL '// - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1 - & :INDEX(FOLDER_DESCRIP,'>')-1) - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - END IF - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT) - P = 4 + P - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER) - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - CALL CLOSE_BULLFOLDER - END IF - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = -1 - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV) - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - INIT = INIT + 2 - IF (INIT.GT.60) THEN - WRITE (6,'('' Bulletin aborting due to record lock'', - & '' problem. Alert system administrator.'')') - CALL EXIT - END IF - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /WINDOW/ WINDOW - - CHARACTER*80 MESSAGE - - WINDOW = 1 - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - - COMMON /TEMP_INPUT/ NODE_TEMP - CHARACTER NODE_TEMP*256 - - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,PASSWORD*32,TEMP_USER*12 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - RETURN - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C -C SUBROUTINE SET_FOLDER_FILE -C -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE, -C if = 1, set FOLDER1_FILE -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NUM.EQ.0) THEN - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE) - END IF - - RETURN - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C -C SUBROUTINE SET_FILE -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILE - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - ELSE - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)// - & '.]' - END IF - - RETURN - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12 - - DATA UPDATE/.FALSE./, JUST_NAME/.FALSE./ - - UPDATE = .TRUE. - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_UPDATE - - UPDATE = .NOT.UPDATE - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_NAME - - JUST_NAME = .NOT.JUST_NAME - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATE - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):) - - M = INDEX(FILDATE,'-') - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3) - - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN - FOLDER_FILE = FOLDER1_FILE - IF (JUST_NAME) THEN - JUST_NAME = .FALSE. - RETURN - END IF - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THEN - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHARED - END IF - END IF - - JUST_NAME = .FALSE. - - IF (UPDATE) THEN - READ (1'1) NBLOCK - REWRITE (1) NBLOCK + LENGTH - UPDATE = .FALSE. - END IF - - RETURN - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THEN - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE - MINGT0 = MIN(I,J) - END IF - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bulletin9.for b/decus/vmslt98a/bulletin/bulletin9.for deleted file mode 100644 index e068c2e..0000000 --- a/decus/vmslt98a/bulletin/bulletin9.for +++ /dev/null @@ -1,2477 +0,0 @@ -C -C BULLETIN9.FOR, Version 4/8/98 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - -C IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN -C WRITE (6,'(A)') ' A new BULLETIN executable has been '// -C & 'installed since your last use.' -C WRITE (6,'(A)') -C & ' Type HELP NEW_FEATURES for help on any new features.' -C END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - EXTERNAL BULLETIN_SUBCOMMANDS - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IF - END IF - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE - WRITE (6,1000) - END IF - IF (.NOT.SUBSCRIBE) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - DO I = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IF - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1 - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THEN - NUM_FOLDER = 0 - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1), - & 'HIT any key for next page....') - END IF - END DO - IF (NUM_FOLDERS.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE IF (INEW) THEN - NEW = INEW - IF (REMOTE_SET.GE.3) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSE - CALL FIND_NEWEST_BULL - END IF - END IF - - IF (INCMD(:4).NE.'INDE') THEN - IER = CLI$DCL_PARSE('INDEX',BULLETIN_SUBCOMMANDS) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1010 FORMAT (' The following folders with new messages are present'/) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - FOLDER_PRESENT = CLI$PRESENT('FOLDER') - - IF (FOLDER_PRESENT) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z') - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME) - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURN - END IF - END IF - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid date specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURN - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN - END IF - ELSE IF (SINCE) THEN - IF (BULL_POINT.EQ.0) THEN - WRITE (6,'('' ERROR: No current message.'')') - RETURN - ELSE IF (NEWS) THEN - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THEN - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSE - STARTMSG = 1 - END IF - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - ELSE - IF (NEWS) THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1 - END DO - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND. - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0 - NEWSMSG = 1 - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THEN - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0 - ELSE - FOUND = .FALSE. - END IF - IF (FOUND.AND.NEWS) THEN - WRITE (6,'(1X,A,'' latest message read '', - & I,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'', - & '' to specified folder.'')') - END IF - END IF - IF (.NOT.ALL) THEN - IF (IER.NE.0) THEN - WRITE (6,'('' User info does not exist.'')') - END IF - IER = 2 - END IF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - CALL CLOSE_BULLUSER - ELSE - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - CALL CLOSE_BULLUSER - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - DATA SCRTYPE/-1/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESS - - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - IER1 = 1 - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER2) THEN - CALL ADD_DIRECTORIES - ELSE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IF - END IF - END DO - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - LDESCR = 0 - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - IF (NEWS_FEED()) THEN - CALL STRIP_HEADER(' ',-1,IER) - END IF - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - MAIL = BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0 - IF (MAIL) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.MAIL' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0 - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - ELSE IF (NEWS_FEED().OR.LEN_FROM.EQ.0 - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - SCRTYPE = 0 - SCRNAME = 'SYS$LOGIN:BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - IF (IER1.NE.0) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW') - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /STORED/ STORED - - CHARACTER*256 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.NEWS_FEED().AND. - & .NOT.BTEST(FOLDER_FLAG,11).AND..NOT.STORED) CLOSE (UNIT=3) - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - CHARACTER*24 TODAY - - COMMON /STORED/ STORED - DATA STORED /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THEN - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER - RETURN - ELSE IF (BUFFER(:5).EQ.'From:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE. - OLD_BUFFER_FROM = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Reply-To:') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - END IF - STORED = .TRUE. - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STORED - STORED = .FALSE. - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3) - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - IF (LEN_BUFFER.GT.0) THEN - IF (.NOT.TEXT) THEN - IF (.NOT.NEWS_FEED()) THEN - TEXT = .TRUE. - ELSE - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - END IF - IF (TEXT) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - ELSE - IF (TEXT) WRITE (3,'(A)') ' ' - END IF - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF (.NOT.STORED.AND. - & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') ' ' - END IF - CALL STORE_BULL(1,' ',NBLOCK) - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2 - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-') - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO - INEXDATE = .TRUE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - IF (NEWS_FEED().AND..NOT.TEXT) THEN - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - ELSE - TEXT = .TRUE. - END IF - IF (.NOT.STORED.AND. - & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAY - - CHARACTER USER_SAVE*12,PROC_SAVE*12 - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1 - FIRST_BREAK = .FALSE. - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - SCRTYPE = -1 - END IF - RETURN - END IF - - EXTIME = '00:00:00.00' - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2100' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - IF (SCRTYPE.EQ.0.AND.NEWS_FEED()) THEN - FOLDER1_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,'>')-1) - CALL SYS$SETAST(%VAL(1)) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL NEWS_POST('ignore',.TRUE.,IER,INDESCRIP) - IF (TEST_BULLCP().EQ.2) CALL SYS$SETAST(%VAL(0)) - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3) - END IF - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.EQ.0) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL GETUSER(PROC_SAVE) - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME) - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARD - END IF - IF (.NOT.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(SCRNAME,INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - ELSE - CALL RESPOND_MAIL(SCRNAME,INPUT, - & INDESCRIP(:LEN_DESCRP),STATUS) - END IF - CALL LIB$DELETE_FILE(SCRNAME(:TRIM(SCRNAME))//';*') - CALL SETUSER(PROC_SAVE) - USERNAME = USER_SAVE - ELSE - CLOSE (UNIT=3) - END IF - ELSE IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - END IF - - CALL STRIP_HEADER(' ',-1,IER) - - SCRTYPE = -1 - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - -C IF (.NOT.NEWS_FEED()) THEN - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) -C END IF - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(FROM,INFROM,LEN_INFROM) - - RETURN - END - - - SUBROUTINE GET_FROM(FROM,INFROM1,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INFROM1,FROM - - CHARACTER*256 INFROM - - INFROM = INFROM1 - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - I = INDEX(INFROM,'<') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<')+1:) ! personal-name - END IF - - I = INDEX(INFROM,'(') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'(')+1:) ! personal-name (net-name) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR.INFROM(I:I).LE.' '.OR. - & INFROM(I:I).GE.CHAR(127).OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) - I = I + 1 - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1 - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND.INFROM(I:I).GT.' '.AND. - & INFROM(I:I).LT.CHAR(127).AND. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.126) - & INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN -C IF (LEN_DESCRP.GT.LEN(DESCRIP).AND..NOT.NEWS_FEED()) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - CALL INIT_QUEUE(HEADER_Q1,INPUT) - IF (BLEN.EQ.-1) THEN - CALL INIT_QUEUE(HEADER_Q1,INPUT) - HEADER_Q = HEADER_Q1 - NHEAD = 0 - END IF - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - END IF - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) THEN ! of previous header line - IF (LAST_NEWSGROUPS) THEN - NEWSGROUPS = NEWSGROUPS(:TRIM(NEWSGROUPS))//BUFFER(2:) - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - END IF - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - LAST_NEWSGROUPS = .FALSE. - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.' - END IF - ELSE IF (BUFFER(:11).EQ.'Newsgroups:') THEN - NEWSGROUPS = BUFFER(13:) - LAST_NEWSGROUPS = .TRUE. - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - - RETURN - END - - - - - SUBROUTINE SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_NEWS_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified news group -C Note: If NOTIFY READNEW and BRIEF = 0, it is either news -C group removal or SET SUBSCRIBE command. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - ALL = .FALSE. - DEFAULT = 1 - NODEFAULT = 0 - SUB = ABS(BRIEF)+ABS(NOTIFY)+ABS(READNEW).EQ.0 - - IF (NOTIFY.EQ.1.AND.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: /NOTIFY is invalid with non-stored'', - & '' news group.'')') - RETURN - END IF - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - IF (CLI$PRESENT('NOPERMANENT').OR.CLI$PRESENT('PERMANENT').OR. - & (SUB.AND.(NODEFAULT.OR.CLI$PRESENT('NOPERMANENT')))) THEN - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (SUB) DEFAULT = 1 - ELSE IF (CLI$PRESENT('NOPERMANENT').OR.NODEFAULT) THEN - IF (NOTIFY.GE.0) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - IF (SUB) - & CALL SET_NEWS_FLAG(IER,-1,-1,-1) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*PERM ',INF_REC - END IF - END IF - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - IF (NODEFAULT.AND.SUB) THEN - NOTIFY = -1 - READNEW = -1 - BRIEF = -1 - END IF - IF (DEFAULT.OR.NODEFAULT) THEN - IF (NODEFAULT.AND..NOT.SUB) THEN - IF (NOTIFY.NE.-1) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - ELSE - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*DEFAULT ',INF_REC - END IF - END IF - IF ((ALL.OR.(SUB.AND.INCMD(:3).NE.'SET')).AND.IER.EQ.0) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY=TEMP_USER,IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - - RETURN - END - - - - - SUBROUTINE READ_INF_REC - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - RETURN - - ENTRY SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & INF_REC2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1.AND.TEMP_USER(:1).EQ.'*') THEN - WRITE (6,'('' ERROR: You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - IER = 0 - RETURN - END IF - - IF (INF_REC2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IF (NOTIFY+READNEW+BRIEF.EQ.-3) THEN - DO J=I,FOLDER_MAX-2 - CALL COPY2(INF_REC(1,J),INF_REC(1,J+1)) - END DO - END IF - IER = 1 - RETURN - END IF - - IF (NOTIFY+READNEW+BRIEF.EQ.-3) RETURN - - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(INF_REC2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(INF_REC(1,J),INF_REC(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - INF_REC2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - INF_REC2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - INF_REC(2,J) = F_START - 1 - ELSE - INF_REC2(2,J) = 0 - INF_REC(2,J) = F_NBULL - END IF - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IER = 1 - RETURN - END IF - END DO - - RETURN - END diff --git a/decus/vmslt98a/bulletin/bullfiles.inc b/decus/vmslt98a/bulletin/bullfiles.inc deleted file mode 100644 index 0df9866..0000000 --- a/decus/vmslt98a/bulletin/bullfiles.inc +++ /dev/null @@ -1,39 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vmslt98a/bulletin/bullfolder.inc b/decus/vmslt98a/bulletin/bullfolder.inc deleted file mode 100644 index b3d94c8..0000000 --- a/decus/vmslt98a/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vmslt98a/bulletin/bullmain.cld b/decus/vmslt98a/bulletin/bullmain.cld deleted file mode 100644 index bb3a4b5..0000000 --- a/decus/vmslt98a/bulletin/bullmain.cld +++ /dev/null @@ -1,34 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vmslt98a/bulletin/bullnews.inc b/decus/vmslt98a/bulletin/bullnews.inc deleted file mode 100644 index fcbc81f..0000000 --- a/decus/vmslt98a/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vmslt98a/bulletin/bullstart.com b/decus/vmslt98a/bulletin/bullstart.com deleted file mode 100644 index ed1779c..0000000 --- a/decus/vmslt98a/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vmslt98a/bulletin/bulluser.inc b/decus/vmslt98a/bulletin/bulluser.inc deleted file mode 100644 index 5760e92..0000000 --- a/decus/vmslt98a/bulletin/bulluser.inc +++ /dev/null @@ -1,53 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vmslt98a/bulletin/changes.txt b/decus/vmslt98a/bulletin/changes.txt deleted file mode 100644 index 366fa00..0000000 --- a/decus/vmslt98a/bulletin/changes.txt +++ /dev/null @@ -1,648 +0,0 @@ -V 2.24 - -When replying to a message in a news group that has been crossposted, give the -user the option of just posting the reply to the news group in which the -message is being read rather than all the news groups in the crosspost. -11/20/95 - -Messages added to folders and stored news groups are now marked as being read -so that the person does not see them when doing a READ/NEW. 11/20/95 - -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vmslt98a/bulletin/cmds.mai b/decus/vmslt98a/bulletin/cmds.mai deleted file mode 100644 index 804e43e..0000000 --- a/decus/vmslt98a/bulletin/cmds.mai +++ /dev/null @@ -1,22 +0,0 @@ -The address for getting BULLETIN is BULLETIN@PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file - (only one file per command). - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - -BULLETIN is also available via ANONYMOUS FTP from PFC.MIT.EDU, but the account -is set at low priority, so I suggest using it during non-prime hours. - - Mark diff --git a/decus/vmslt98a/bulletin/copyright.txt b/decus/vmslt98a/bulletin/copyright.txt deleted file mode 100644 index b6edd1b..0000000 --- a/decus/vmslt98a/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vmslt98a/bulletin/create.com b/decus/vmslt98a/bulletin/create.com deleted file mode 100644 index 9427f4f..0000000 --- a/decus/vmslt98a/bulletin/create.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vmslt98a/bulletin/handout.txt b/decus/vmslt98a/bulletin/handout.txt deleted file mode 100644 index 5a1acd2..0000000 --- a/decus/vmslt98a/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vmslt98a/bulletin/install.com b/decus/vmslt98a/bulletin/install.com deleted file mode 100644 index 34427ba..0000000 --- a/decus/vmslt98a/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vmslt98a/bulletin/instruct.com b/decus/vmslt98a/bulletin/instruct.com deleted file mode 100644 index 273d3e9..0000000 --- a/decus/vmslt98a/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vmslt98a/bulletin/instruct.txt b/decus/vmslt98a/bulletin/instruct.txt deleted file mode 100644 index 6699642..0000000 --- a/decus/vmslt98a/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vmslt98a/bulletin/login.com b/decus/vmslt98a/bulletin/login.com deleted file mode 100644 index e670783..0000000 --- a/decus/vmslt98a/bulletin/login.com +++ /dev/null @@ -1,31 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! If you want to have more than one BULLETIN database, replace BULL_DIR -$! with the actual directory to allow redefining BULL_DIR. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vmslt98a/bulletin/makefile b/decus/vmslt98a/bulletin/makefile deleted file mode 100644 index 303858d..0000000 --- a/decus/vmslt98a/bulletin/makefile +++ /dev/null @@ -1,82 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.24" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vmslt98a/bulletin/master.com b/decus/vmslt98a/bulletin/master.com deleted file mode 100644 index 112d981..0000000 --- a/decus/vmslt98a/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vmslt98a/bulletin/mx.com b/decus/vmslt98a/bulletin/mx.com deleted file mode 100644 index 141e706..0000000 --- a/decus/vmslt98a/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_SOURCE to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vmslt98a/bulletin/mx.mai b/decus/vmslt98a/bulletin/mx.mai deleted file mode 100644 index 2631763..0000000 --- a/decus/vmslt98a/bulletin/mx.mai +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_LIBRARY") .eqs. "" -$ then say "BULL_LIBRARY logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_library/LIB,SYS$SYSTEM:SYS.STB/SEL,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_LIBRARY to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P4 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P4 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P4 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p4 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p2' 'p3' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p2' 'p3' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vmslt98a/bulletin/news.alt b/decus/vmslt98a/bulletin/news.alt deleted file mode 100644 index 1f6de96..0000000 --- a/decus/vmslt98a/bulletin/news.alt +++ /dev/null @@ -1,254 +0,0 @@ - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales diff --git a/decus/vmslt98a/bulletin/news.com b/decus/vmslt98a/bulletin/news.com deleted file mode 100644 index 2889055..0000000 --- a/decus/vmslt98a/bulletin/news.com +++ /dev/null @@ -1,679 +0,0 @@ -$set nover -$copy/log sys$input NEWS.ALT -$deck - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales -$eod -$copy/log sys$input NEWS.CREATE -$deck -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - -$eod -$copy/log sys$input NEWS.MODERATORS -$deck -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com -$eod diff --git a/decus/vmslt98a/bulletin/news.create b/decus/vmslt98a/bulletin/news.create deleted file mode 100644 index 7f28ba6..0000000 --- a/decus/vmslt98a/bulletin/news.create +++ /dev/null @@ -1,155 +0,0 @@ -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - diff --git a/decus/vmslt98a/bulletin/news.moderators b/decus/vmslt98a/bulletin/news.moderators deleted file mode 100644 index 7797de2..0000000 --- a/decus/vmslt98a/bulletin/news.moderators +++ /dev/null @@ -1,260 +0,0 @@ -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com diff --git a/decus/vmslt98a/bulletin/news.txt b/decus/vmslt98a/bulletin/news.txt deleted file mode 100644 index 1117dc6..0000000 --- a/decus/vmslt98a/bulletin/news.txt +++ /dev/null @@ -1,150 +0,0 @@ -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when a -user accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. It is also possible to -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) When the POST and -ADD commands are used with this folder, the messages will be posted to the news -group, rather than actually being added to the folder. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. diff --git a/decus/vmslt98a/bulletin/nonsystem.txt b/decus/vmslt98a/bulletin/nonsystem.txt deleted file mode 100644 index f1f7d86..0000000 --- a/decus/vmslt98a/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vmslt98a/bulletin/optimize_rms.com b/decus/vmslt98a/bulletin/optimize_rms.com deleted file mode 100644 index 576fa3e..0000000 --- a/decus/vmslt98a/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vmslt98a/bulletin/pmdf.com b/decus/vmslt98a/bulletin/pmdf.com deleted file mode 100644 index 932715c..0000000 --- a/decus/vmslt98a/bulletin/pmdf.com +++ /dev/null @@ -1,1031 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input BULLETIN_MASTER.PAS_V32 -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *) -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - - outbound : text; - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL - 100; - - VAR - line, errorsto : vstring; - bigline : bigvstring; result : rp_bufstruct; - header : he_header; - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string); - - BEGIN (* try_something *) - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *) - end; (* try_something *) - - BEGIN (* return_bad_messages *) - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt'); - try_something (he_read_header (header, qu_rtxt), 'he_read_header'); - errorsto.length := 0; - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i]; - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto), - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr); - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *) - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages (tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable. - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT - -For V3.2: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check your -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vmslt98a/bulletin/restart.com b/decus/vmslt98a/bulletin/restart.com deleted file mode 100644 index 71f7023..0000000 --- a/decus/vmslt98a/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vmslt98a/bulletin/setuser.mar b/decus/vmslt98a/bulletin/setuser.mar deleted file mode 100644 index 489f36f..0000000 --- a/decus/vmslt98a/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vmslt98a/bulletin/update.fil b/decus/vmslt98a/bulletin/update.fil deleted file mode 100644 index 06f3135..0000000 --- a/decus/vmslt98a/bulletin/update.fil +++ /dev/null @@ -1,11 +0,0 @@ -$ if p1 .nes. "" then FS 'P1' -$ COPY 'FM' [.SEND]/LOG -$ COPY 'FM' CMODA::IR:[BULLETIN] -$ TAB2SP 'FM' -$ RENAME 'FM' [-.NET] -$ PUR [.SEND]'FM' -$ PUR [-.NET]'FM' -$ IF FM .EQS. "CHMAIL.MAI" THEN P3 = "AAAREADME." -$ IF P2 .EQS. "" THEN COPY 'FM' [ANONYMOUS.BULLETIN]'P3' -$ IF P3 .EQS. "" THEN PUR [ANONYMOUS.BULLETIN]'FM' -$ IF P3 .NES. "" THEN PUR [ANONYMOUS.BULLETIN]'p3' diff --git a/decus/vmslt98a/bulletin/upgrade.com b/decus/vmslt98a/bulletin/upgrade.com deleted file mode 100644 index b91fa7c..0000000 --- a/decus/vmslt98a/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vmslt98a/bulletin/writemsg.txt b/decus/vmslt98a/bulletin/writemsg.txt deleted file mode 100644 index 2bfabfd..0000000 --- a/decus/vmslt98a/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vmslt98b/bulletin/aaareadme.1st b/decus/vmslt98b/bulletin/aaareadme.1st deleted file mode 100644 index fb97c8c..0000000 --- a/decus/vmslt98b/bulletin/aaareadme.1st +++ /dev/null @@ -1,201 +0,0 @@ -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. diff --git a/decus/vmslt98b/bulletin/aaareadme.txt b/decus/vmslt98b/bulletin/aaareadme.txt deleted file mode 100644 index 6c2181f..0000000 --- a/decus/vmslt98b/bulletin/aaareadme.txt +++ /dev/null @@ -1,78 +0,0 @@ -BULLETIN -Bulletin is a utility which is a message repository, permitting -use like VMS MAIL, but where VMS MAIL is one to one, Bulletin is -one to many. Messages are organized into messages and folders so a -user can search the folders at will. Messages can be set to expire -after some number of days, or can be permanent. - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. diff --git a/decus/vmslt98b/bulletin/allmacs.mar b/decus/vmslt98b/bulletin/allmacs.mar deleted file mode 100644 index b7498eb..0000000 --- a/decus/vmslt98b/bulletin/allmacs.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vmslt98b/bulletin/allmacs_axp.mar b/decus/vmslt98b/bulletin/allmacs_axp.mar deleted file mode 100644 index efb71ec..0000000 --- a/decus/vmslt98b/bulletin/allmacs_axp.mar +++ /dev/null @@ -1,312 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=SETACC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETACC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R6 ; Address of current process - MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - - .PSECT SETUIC_DATA,NOEXE - -UIC: .BLKL 1 -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - MOVL R3,UIC - $CMKRNL_S ROUTIN=SETUIC_C ; Must run in kernel mode -5$: RET - - .ENTRY SETUIC_C,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R2 ; Address of current process - MOVL UIC,PCB$L_UIC(R2) ; Set UIC to specified -; MOVL UIC,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -OLDLEN: .BLKW 1 -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - MOVL R6,OLDLEN - $CMKRNL_S ROUTIN=SETUSER_C2 ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=SETUSER_C1 ; Must run in kernel mode -5$: RET - - .ENTRY SETUSER_C1,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET - - .ENTRY SETUSER_C2,^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler - MOVL @#CTL$GL_PCB,R7 ; Address of current process - MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block -; MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC OLDLEN,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $EIHDDEF - $EIHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - MOVL EIHD$L_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL EIHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=EIHI$Q_LINKTIME(R7) - - RET - -.END diff --git a/decus/vmslt98b/bulletin/bad.for b/decus/vmslt98b/bulletin/bad.for deleted file mode 100644 index c32e9b7..0000000 --- a/decus/vmslt98b/bulletin/bad.for +++ /dev/null @@ -1,22 +0,0 @@ - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=5,FILE='BULLNEWS.DAT',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - BULLNEWS_FILE = 'BULL_DIR:BULLNEWS.DAT' - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) WRITE (5,IOSTAT=IER) NEWS_FOLDER1_COM - END DO - - TYPE *,FOLDER1 - END diff --git a/decus/vmslt98b/bulletin/board_digest.com b/decus/vmslt98b/bulletin/board_digest.com deleted file mode 100644 index 5629db0..0000000 --- a/decus/vmslt98b/bulletin/board_digest.com +++ /dev/null @@ -1,77 +0,0 @@ -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; diff --git a/decus/vmslt98b/bulletin/board_special.com b/decus/vmslt98b/bulletin/board_special.com deleted file mode 100644 index ca5cef4..0000000 --- a/decus/vmslt98b/bulletin/board_special.com +++ /dev/null @@ -1,108 +0,0 @@ -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT diff --git a/decus/vmslt98b/bulletin/bull_news.c b/decus/vmslt98b/bulletin/bull_news.c deleted file mode 100644 index 4f09cd3..0000000 --- a/decus/vmslt98b/bulletin/bull_news.c +++ /dev/null @@ -1,705 +0,0 @@ -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} diff --git a/decus/vmslt98b/bulletin/bull_newsdummy.for b/decus/vmslt98b/bulletin/bull_newsdummy.for deleted file mode 100644 index a17d3ec..0000000 --- a/decus/vmslt98b/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,99 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bullcom.cld b/decus/vmslt98b/bulletin/bullcom.cld deleted file mode 100644 index 279cd57..0000000 --- a/decus/vmslt98b/bulletin/bullcom.cld +++ /dev/null @@ -1,765 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 4/10/97 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER COPY, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FORCE - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER OUTPUT,VALUE(REQUIRED,TYPE=$FILE) - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB THREAD - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE, NONNEGATABLE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER FORCE - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER THREADS - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - KEYWORD GATEWAY - KEYWORD NOGATEWAY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD THREAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vmslt98b/bulletin/bullcoms1.hlp b/decus/vmslt98b/bulletin/bullcoms1.hlp deleted file mode 100644 index 3853634..0000000 --- a/decus/vmslt98b/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1271 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is -specified. A node which does not have BULLCP running cannot have a -message broadcasted to it, (even though it is able to create a remote -folder). A broadcasted message is limited to 1600 characters - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with -> at the beginning of each line. This can be -suppressed or the indentation character changed with /[NO]INDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message will -be deleted after the node on which the message was submitted from is -rebooted. If you wish the message to be deleted after a different node -reboots, you have the option of specifying that node name. The message -deletion is keyed by BULLETIN running on the node that reboots. It -writes into the database info that the node has rebooted, and when -BULLCP wakes up and sees this info, it will delete any shutdown messages -for that node. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current process -to another process in your job. - -The ATTACH command allows you to move quickly between processes that you -have created with the SPAWN command. For example, while you are editing -a file, you can SPAWN a subprocess to read a new message. Enter the -ATTACH command to get back to back to the editing session. If you want -to read another new message, you can use the ATTACH command to get back -to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages have -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed. -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen the -message to be notified of it a second time. You can select qualifiers -so that either the message text, expiration date, or the header are to -be changed. If no qualifier is added, the default is that all these -parameters are to be changed. If the text of the message is to be -changed, a file can be specified which contains the text. If the editor -is used for changing the text, the old message text will be extracted. -This can be suppressed by the qualifier /NEW. - - Format: - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are replacing. The old message text is read into the editor unless -a file-name or /NEW is specified. /EDIT is the default if you have -added /EDIT to your BULLETIN command line. -2 /EXPIRATION - /EXPIRATION[=time] - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADER -Specifies that the message header is to be replaced. You will be -prompted for the new message description. -2 /OWNER - /OWNER=string - -Specifies a new owner name. Can only be changed if you own the folder -or have privileges. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totally -new text is to be read in. -2 /NUMBER - /NUMBER=message_number[-message_number1] - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced. A -range of messages can be specified, i.e. /NUMBER=1-5. Only the -expiration date and message headers can be changed if a range is -specified. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer -shutdown. This option is restricted to SYSTEM folders. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is a -privileged command and is restricted to SYSTEM folders. -2 /TEXT -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder. - - Format: - - COPY folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -copied to. Optionally, a range of messages which are to be copied can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be copied -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the copied message will be the original owner -of the message. The default is that the copied message will be owned by -the person copying the message. -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM. - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYS -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLY -Specifies that the folder has the ADD_ONLY attribute. If a mailing -address is present (see /DESCRIPTION), when messages are added to the -folder, they will also be mailed to the address. Users are prevented -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=description - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description. - -If this folder is to receive messages from a network mailing list via -the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to be mailed to the email address. This is common if you have -users that don't have access to BULLETIN. Note: When you specify an -email address, the folder automatically will have the ADD_ONLY flag set, -which causes both ADD and POST to both add a message and send mail the -message. Note that a message added to the folder via the BBOARD feature -will also be mailed to the specified email address. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. If you create a remote folder pointing to a folder -associated with an email address, you must specify the email address in -the description of the remote folder also. Please also read about the -SET GATEWAY command. - -It is also possible to use the description to specify a news group from -which messages are fed into the folder. See the file FOLDER_TO_NEWS.TXT -for more info. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. The -identifier can not be any longer than 12 characters. - -Note: This feature will not work during remote access to the folder. -2 /NODE - /NODE=node - -Specifies that the folder is a remote folder at the specified node. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The specified node is checked to see if -a folder of the same name is located on that node. If so, the folder -will then be modified to point to that folder. For example if there was -a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be -shared between more than one node. This capability is only present if -the BULLCP process is running on the remote node via the BULL/STARTUP -command. If the remote folder name is different from the local folder -name, the remote folder name is specified using the /REMOTENAME -qualifier. - -NOTE: If a message is added to a remote node, the message is stored -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARD -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the user -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFY -Specifies that all users automatically have NOTIFY set for this folder. -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command. -See also /ID. -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have been -granted access via the SET ACCESS command. Note: This option uses ACLs -and users who are granted access must be entered into the Rights Data -Base. If the RDB does not exist on your system, a privileged user will -have to create it. If a user is not in the RDB, this program will -automatically enter the user into it (unless this feature was disabled -during the compilation of this program). NOTE: See HELP SET ACCESS for -more info. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW -for more information.) -2 /REMOTENAME - /REMOTENAME=foldername -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name. -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only with -respect to adding or modifying messages. All users can read the folder. - -WARNING: This command can not be used with remote nodes. Create the -folder without it and then use SET ACCESS to change protection. Also, -access protection on the remote node will override local protection. -2 /SYSTEM -Specifies that the folder is a SYSTEM folder. A SYSTEM folder is -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is not -always true, as BULLETIN will ignore the CTRL-Y if it has a data file -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENT -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format: - - CURRENT -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -either /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want the -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1] - -The message's relative number is found by the DIRECTORY command. It is -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot be -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This will -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk. -2 /LOCAL -Only used with news groups stored on disk. Only the local message will -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to delete the message at the listed DECNET nodes. The -BULLETIN utility must be installed properly on the other nodes. You can -specify a different username to use at the other nodes by either using -the USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specific -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subject - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. The -specified subject need not be the exact subject of the message. It can -be a substring of the subject. This is in case you have forgotten the -exact subject that was specified. Case is not critical either. You -will be notified if the deletion was successful. See also /NEGATED. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when deleting -messages on other DECNET nodes via the /NODE qualifier. -1 DIRECTORY -Lists a summary of the messages. The message number, submitter's name, -date, and subject of each message is displayed. - - Format: - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message. -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /CONTINUE -Used with /GROUP. Allows you to continue a search after you have broken -the search by entering a command, i.e. READ, SEARCH, etc. Note: If you -enter a SEARCH command which specifies a string, and then continue the -directory search using /CONTINUE, the new search pattern will be used -when continuing the search. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description of -folder. -2 /EXPIRATION -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /EXTRACT - /EXTRACT=filename - -Specifies that the text of the messages which are found by the DIRECTORY -command are to be written into the specified file. All qualifiers which -are valid for the EXTRACT command are valid in conjunction with /EXTRACT -except for /NEW which conflicts with the DIRECTORY /NEW qualifier. The -listof messages to be printed will be displayed on the terminal (in -nopaging format). - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /FEEDBACK -Used only in conjunction with /GROUP. Specifies to show when new news -groups are selected. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS. -2 /FROM - /FROM=[string] - -Specifies that only messages whose username contains the specified string -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Used with the search -qualifiers /SEARCH, /SUBJECT, or /FROM. Wildcards are permitted in the -specified string. Use /FEEDBACK to see when groups are selected. At -any time during the search you may enter other commands, i.e. you may -read a message, see a full directory listing, etc. You may then restart -the search listing by typing DIR/CONTINUE. For more info, see help on -the /CONTINUOUS qualifier. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don't -match the specified search command are displayed. -2 /MARKED -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. To see all -messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWS -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /OUTPUT - /OUTPUT=filename - -Specifies to write the directory output to a file rather than the -terminal. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (in -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current message -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED. -2 /SEARCH - /SEARCH=[string] - -Specifies that only messages which contain the specified string are -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used. -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY. -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it's -subject header are to be displayed. This cannot be used in conjunction -with /MARKED. If no string is specified, the previously specified -string is used. -1 EXCLUDE -Specifies to exclude reading messages based on the message owner or the -subject. If it is determined that a message is to be excluded, then the -message is skipped when a user tries to read a message bytyping NEXT or -BACK, or by hitting the return key. Specify /FULL to make all EXCLUDEs -and INCLUDEs for the specified folder apply to all other BULLETIN -commands, including directory listings. - - Format: - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. /FROM is the default. - -Note: EXCLUDEs based on FROM will take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE. -2 /FROM -Specifies to exclude the message based on the message owner. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /FULL -If specified, causes all excludes and includes for the selected folder -to be applied to all BULLETIN commands, including directory listings. -See help customizing for info on how to make this the default for all -folders. Note that specifying this may substantially slow down -directory listings. When /FULL is specified, the EXCLUDE command will -not add an exclude, so it can't be used with any other qualifier except -for /DISABLE. -2 /LIMIT - /LIMIT=days - -Specifies that the exclude will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROM -and /SUBJECT cannot be specified at the same time. -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 EXIT -Exits the BULLETIN program. -1 EXTRACT -Synonym for FILE command. -1 FILE -Copies the current message to the named file. If the file exists, the -message is appended to the file, unless the /NEW qualifier is specified. - - Format: - FILE [filename] [message_number][-message_number1],[...] - -If the filename is omitted, a file will be created based on the name of -the folder. - -A range of messages to be copied can optionally be specified, i.e. FILE -2-5. The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -See the command SET FILE_DIRECTORY for info on setting the directory -where files are stored. The default directory is SYS$LOGIN. -2 /ALL -Copies all the messages in the current folder. -2 /FF -Specifies that a form feed is placed between messages in the file. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file. -1 FIRST -Specifies that the first message in the folder is to be read. -1 Folders -All messages are divided into separate folders. New folders can be -created by any user. As an example, the following creates a folder for -GAMES related messages: - -BULLETIN> CREATE GAMES -Enter a one line description of folder. -GAMES - -To see the list of available folders, use DIRECTORY/FOLDERS. To select -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, that user -will be alerted of topics of new messages at login time, and will then -be given the option of reading them. Similar to READNEW is SHOWNEW, -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option, -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command. - -A folder can be restricted to only certain users, if desired. This is -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If instead you -specify /SEMIPRIVATE, all users can read the messages in the folder, but -only those given access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SET -NODE. A remote folder is one which points to a folder on a remote -DECNET node. Messages added to a remote node are actually stored on the -folder on the remote node. The BULLCP process (created by -BULLETIN/STARTUP) must be running on the remote node for this option to -be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/ -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another use -is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, -and giving access to that UIC group. Only users in that UIC group will -see the messages in that folder when they log in. -1 FORWARD -Synonym for MAIL command. -1 HELP -To obtain help on any topic, type: - - HELP topic -1 INCLUDE -This command is a synonym for the THREAD command. -1 INDEX -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after one -has read a message. /RESTART must be specified to start from the first -folder if a scan is in progress. All other qualifiers are ignored while -a scan is in progress. - - Format: - INDEX - -When a directory is displayed, you can read the first message in the -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for older -versions of BULLETIN. -2 /MARKED -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED, -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKED -Lists messages that have not been marked (marked messages are indicated -by an asterisk). Using /UNMARKED is equivalent to selecting the folder -with /UNMARKED, i.e. only unmarked messages will be shown and be able -to be read. -2 /SEEN -Lists messages that have been seen (indicated by a greater than sign). -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only -seen messages will be shown and be able to be read. -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by a -greater than sign). Using /UNSEEN is equivalent to selecting the folder -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. -2 /NEW - /[NO]NEW - -Specifies to list only those folders or groups that have new unread -messages, and to start the listing with the first unread message. -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified. -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder. -2 /SET - /[NO]SET - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -2 Suggestions -Here are keypads settings that the author personally uses. Note that -the IND/SUBS commands are useful only for reading NEWS. - -DEFINE/KEY PERIOD "IND/SUBS"/TERM -DEFINE/KEY PERIOD "IND/SUBS/NONEW"/IF_STATE=GOLD/TERM -DEFINE/KEY MINUS "READ/THREAD"/IF_STATE=GOLD/TERM -DEFINE/KEY PF1 ""/IF_STATE=GOLD/SET=NOEDIT -DEFINE/KEY PF1 ""/IF_STATE=NOEDIT/SET=NOH -DEFINE/KEY PF3 "EXT"/TERM -DEFINE/KEY KP9 "MAIL/EDIT/NOHEAD"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP8 "REPLY/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP7 "SEND/NOEDIT"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/H"/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP4 "CUR/NOH"/IF_STATE=NOH/TERM -DEFINE/KEY KP5 "RESPOND/NOEDIT "/IF_STATE=NOEDIT/TERM -DEFINE/KEY KP5 "RESPOND/EXTRACT/LIST/EDIT "/TERM -DEFINE/KEY KP2 "SEARCH/REP "/TERM -DEFINE/KEY KP2 "SEARCH/REV/REP "/TERM/IF_STATE=GOLD -DEFINE/KEY KP2 "SEARCH/REV "/IF_STATE=NOEDIT -DEFINE/KEY COMMA "SPAWN"/TERM -1 LAST - -Displays the last message in the current folder. - - Format: - LAST -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format: - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying an -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" must -be specified as xxx%"""address""". -2 /EDIT -Specifies that the editor is to be used to edit the message before -mailing it. -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject. -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directory -listing. A marked message can serve as a reminder of important -information. The UNMARK command sets the current or message-id message -as unmarked. - - Format: - - MARK [message-number or numbers] - UNMARK [message-number or numbers] - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 MODIFY -Modifies the database information for the current folder. Only the -owner of the folder or a user with privileges can use this command. - - Format: - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted for -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing list -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in the -description. This is done by enclosing the address using <> and placing -it at the end of the description, i.e. - - INFOVAX MAILING LIST - -You can also use this feature to have messages which are added to a -folder to automatically mailed to the email address. This is common if -you have users that don't have access to BULLETIN. In order to do this, -you should use the SET ADD_ONLY command. This causes all messages added -to the folder to also be sent to the email address. This also applies -to messages which are added via the BBOARD feature. In this way, users -without access to BULLETIN can add messages by sending mail to the -BBOARD account. Please also read about the SET GATEWAY command. -2 /ID -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presently -assigned to it. Any process which has that identifier assigned to it -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAME - /NAME=foldername - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID. -1 MOVE -Moves a message to another folder and deletes it from the current -folder. - - Format: - - MOVE folder-name [message_number][-message_number1] - -The folder-name is the name of the folder to which the message is to be -be moved to. Optionally, a range of messages which are to be moved can -be specified following the folder name, i.e. COPY NEWFOLDER 2-5. -However, if the old folder is remote, they will be copied but not -deleted, as only one message can be delted from a remote folder at a -time. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADER - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied. -The default is /NOHEADER. -2 /LOCAL -If specified and destination is a folder, the message will only be moved -to the folder, and will not be emailed to a corresponding email address or -sent to a an associated news group, if either is present for the folder. -If the destination is a news group, message header has line added to it -to avoid having the message from being copied to a folder which has that -news group feeding to it. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINAL -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned by -the person moving the message. -1 NEWS -Displays the list of available news groups. - -Format: - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed. - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL will -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /DEFAULT -If specified, will show news groups that have be defined as default -groups using the SET SUBSCRIBE command. -2 /NEWGROUP -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /PERMANENT -If specified, will show news groups that have be defined as permanent -groups using the SET SUBSCRIBE command. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B. -2 /STORED -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 New_features -Here is a list of new features which may be of interest to the general -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - -------------------------------------------------------------------------- -V 2.24 -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -SHOW EXCLUDE and INCLUDE commands added. 5/16/95 - -V 2.21 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -Added /FOLLOWUP to POST command when used with news groups. It specifies -which news group you want replies to your message to be sent to. 10/28/94 - -V 2.20 - -Logical names can be specified in POST/GROUPS=. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/11/94 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -V 2.18 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.17 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -V 2.15 - -A user can make /HEADER be made the default for a folder or news group by -adding a line to the user's customization file. 2/21/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92 - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -A user can make this option the default for a particular folder or -news group. See HELP Customizing. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 Personal_name -Any messages posted to news groups or sent as mail automatically will -include the personal name which is set in the VMS mail utility. If you -don't want this to happen, you can define the logical name -BULL_PERSONAL_NAME to be the personal name you want BULLETIN to use: - -$ DEFINE BULL_PERSONAL_NAME "John Doe" -$ BULLETIN - -If you don't want any personal name, define it to be " ". diff --git a/decus/vmslt98b/bulletin/bullcoms2.hlp b/decus/vmslt98b/bulletin/bullcoms2.hlp deleted file mode 100644 index 286e539..0000000 --- a/decus/vmslt98b/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1463 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with -> at the -beginning of each line. This can be suppressed or the indentation -character changed with /[NO]INDENT. -2 /FOLLOWUP - /FOLLOWUP=string - -Specifies that any replies generated by people reading the message -should be sent to the specified newsgroup. This is useful if you want -to post to more than one group, but don't want reply messages posted on -all the groups. To specify more than one newsgroup, surround the list -with quotes, i.e. FOLLOWUP="newsgroup1,newsgroup2". If replies should -only be sent to the message owner and not a newsgroup, the string -"poster" should be specified. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message -to the specified NEWS group(s) in addition to the selected NEWS group. -Logical names are allowed. -2 /HEADER -Allows customized headers line to be added to the message header. When -specified, header lines can be added by inserting them at the top of the -message, with the header lines and the text of the message separated by -a blank line. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. -In order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply -surround the exclusive text starting with the line "START " -and ending with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have just -read) for printing. The file created by the PRINT command is not -released to the print queue until you exit, unless you add the qualifier -/NOW or change one of the print job's qualifiers. Multiple messages are -concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, in -place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /CANCEL -Cancels any messages waiting to be printed. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL level -to find out the name of the mounted form and the default form for a -particular queue. If you specify a form whose stock is different from -the stock of the form mounted on the queue, your job is placed in a -pending state until the stock of the mounted form of the queue is set -equal to the stock of the form associated with the job. (In order to -have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the file -or files have been printed. If /NONOTIFY is specified, there is no -notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 QUIT -Exits the BULLETIN program. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. If you -specify a number greater than the number of messages in the folder, the -last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. If -/HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command is -set for the folder, it will change the default to be /HEADER. A user -can make this option the default for a particular folder or news group. -See HELP Customizing. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /THREADS -Reads all messages that have been included by the THREAD command. If -neither message number nor /SINCE is specified, the search starts with -the first new message. After the first READ/THREADS command, typing -READ/THREADS will continue the search from where it left off (as long as -you do not select a different folder or news group). Also, after a -message has been fully read, if the return key is hit without entering a -command, it is equivalent to typing the READ/THREADS command. Messages -which are parts of threads and under read will be displayed in the -directory listing by a preceeding #. -2 /NEW -Specifies to read the first unread message. -2 /PAGE - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than one -screenful at a time, and that have a remote printer that can then print -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specified -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format: - REMOVE folder-name -1 REPLY -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /INDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using -the qualifer /[NO]INDENT. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -1 RESET -Resets the new message counter for the selected folder or news group. -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read. - - Format: - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read -them. (Note: Reading the last message does the same thing, but RESET -does it without having to read it.) -2 /CURRENT -Resets the new message counter to the current message. -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail -message to the owner of the currently read message. - - Format: - RESPOND [file-name] - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subject -of the message. -2 /CC - /CC=user[s] -Specifies additional users that should receive the reply. -2 /EDIT -Specifies that the editor is to be used for creating the reply mail -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with -> at the beginning of each line. -This can be suppressed or the indentation character changed using the -qualifer /[NO]INDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected or /LIST is present. Specifies -to send the message to the specified NEWS group(s) in addition to the -selected NEWS group. -2 /LIST -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /INDENT - /[NO]INDENT=string - -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one -exists. Signatures are appended for postings to mailing lists and to -responds. See the help topic POST Signature_file for signature -information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, the description of the message will be used -as the subject preceeded by "RE: ". -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text strings. - - Format: - - SEARCH [search-string[,...]] - -The search starts from the first message in the current folder. You can -specify the message to start at using the qualifier /START. If you use -this qualifier without a parameter, it starts with the current message. -The search includes both the text of the message, and the description -header. If a "search-string" is not specified, a search is made using -the previously specified string, starting with the message following the -one you are currently reading (or have just read). After fully reading -the message found by the search, if you hit the return key without -entering a command, it is equivlanent to typing SEARCH without a search -string and will search for the next message. Once started, a search can -be aborted by typing a CTRL-C. -2 /EDIT -Specifies that the editor is to be used for reading the message. -2 /FEEDBACK -Used only in conjunction with /FOLDER and /GROUP. Specifies to show -when new folders or news groups are selected. -2 /FOLDER - /FOLDER=(folder,[...]) - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages for a -match. If, during a search, no more matches or messages are found, the -next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as the -first folder in the list. Use /FEEDBACK to see when folders are -selected. News groups can be specified here. However, to search news -group with wild cards, use /GROUP. -2 /GROUP - /GROUP=(string,[...]) - -Specifies a list of groups to be searched. Wildcards are permitted in -the specified string. If the string does not contain an * and does not -specify a news group, * is automatically placed at the beginning and end -of the string. I.e. if the string is "comp", then all news groups -containing the word "comp" will be searched. Use /FEEDBACK to see when -groups are selected. -2 /FROM -Specifies that only the username of the messages are to be searched. -2 /MATCH - /MATCH[=option] - -Interprets and matches multiple search strings in one of the following -ways: - - AND A match occurs only if all of the strings are found. - - OR A match occurs if any of the strings are found. - - XOR A match occurs if only one of the strings is found. - -If you specify none of these options, the default is /MATCH=OR. If you -specify the /NEGATED qualifier, you will get the negated operation. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:). -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If no -starting message is specified, the search is started from the last -message. /REVERSE must be specified with a search string. -2 /START - /START=message_number - -Specifies the message number to start the search at. If you omit the -message number, it starts with the current message. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched. -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directory -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers] - UNSEEN [message-number or numbers] - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEEN -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created. - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.) - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command. -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected. -1 SET -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format: - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. UICs can contain -wildcards, i.e. [130,*]. Note that by default, a process is given the -process rights id SYS$NODE_nodename, where nodename is the decnet -nodename. Thus, by specifing this id, a folder can be restricted to a -specific node, which is useful when the folder is shared among nodes in -a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" . -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format: - - SET ACCESS /ALL [folder-name] -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READ -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warning -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ANONYMOUS -Specifies that the selected folder has the ANONYMOUS attribute. This -causes messages in the folder to be displayed with the username -ANONYMOUS rather than the actual user's name. - - Format: - - SET [NO]ANONYMOUS -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. - - Format: - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If -ADD_ONLY is set and a mailing address is present (see /DESCRIPTION), -when a message is added to the folder, it will also be mailed to the -address (in addition to being stored in the folder). This also applies -to a message which is added via the BBOARD feature . If ADD_ONLY is set -and a user uses the POST command, the ADD command will be used instead. -One use for this is to mail messages in a folder to users who do not -have access to BULLETIN. - - Format: - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2. - - Format: - - SET BBOARD [username] - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages. - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30" -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The form -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY. -The time will always be 00:00, even if the time is specified on the line. -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature. -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be: - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account. - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV. -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION. -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa). - - Format: - - SET [NO]BRIEF -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by the -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier. -2 COMPRESS -Specifies that messages added to the folder will be in compressed format. -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires -very little cpu overhead. - - Format: - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed every -time when logging in, until the new messages are read. Normally, the -BRIEF setting causes notification only at the first time that new messages -are detected. - - Format: - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges. - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used. - - Format: - - SET DEFAULT_EXPIRE days - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages. - - Format: - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory (usually BULL_DIR). - - Format: - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) When created, the file will -have an ACL set on it to allow the folder owner to delete it. -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - Format: - - SET [NO]EXPIRE_LIMIT [days] - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) -2 EXCLUDE -Specifies to ignore any EXCLUDEs or THREADs that are present. - - Format: - - SET [NO]EXCLUDE - -The default mode is SET EXCLUDE, which means to display messages based -on specified EXCLUDEs or THREADs. SET NOEXCLUDE will cause all -messages to be displayed for the selected folder, and all future folders -which are selected. -2 EXLIMIT -Specifies the default limit for the EXCLUDE command. - - Format: - - SET EXLIMIT days - -If no match is found for an exclude after the specified number of days, -the exclude will automatically be deleted. The default is no limit, -which is specified by specifying 0 days. This default can be overriden -by the /LIMIT switch on the EXCLUDE command. -2 FILE_DIRECTORY -Select the directory where messages are written to when using the -EXTRACT or file COMMAND. By default, the message is written into the -current directory. - - Format: - - SET FILE_DIRECTORY [directory] - -If directory is omitted, the setting is removed. Note: This information -is stored in the customization file (SYS$LOGIN:BULL.CUSTOM). -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information. - - Format: - - SET FOLDER [node-name::][folder-name] -3 /MARKED -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected. -2 GENERIC -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format: - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the -same user. -3 /DAYS - /DAYS=number_of_days - -Specifies the number days that new messages will be displayed for upon -logging in. -2 GATEWAY -Valid for folders that are associated with an email address. Messages -which are mailed to the email address are by default modified so that -the subject line starts with the folder name, followed by the phrase -"folder message: ", followed original subject line. If you specify -GATEWAY, the subject line is not modified this way. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format: - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to by -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. -2 LIBRARY -Specifies a library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command to see if there are other libraries. -2 LOGIN -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command. - - Format: - - SET [NO]LOGIN username -2 NAME -Copies all stored settings from one user to another. Used when a user's -account name is changed. - - Format: - - SET NAME old-username new-username -2 NEWS -Changes attributes of the specified news group or class of news groups. -This command requires privileges. - - Format: - - SET NEWS [news-group] - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALL - /NOALL - -If specified with /CLASS or /DEFAULT, all groups that are presently -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of any -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the default -attributes (using /DEFAULT) with /NOALL, the attributes for misc.test -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. -3 /CLASS - /CLASS=classname - -Specifies to modify attributes for a class of news groups rather than a -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes of -existing groups which are in the class are modified, and any groups -created in the future will automatically have those attributes. -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETE -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLE -Specifies that the news group is enabled and can be accessed. This is -the default. -3 /EXPIRATION - /EXPIRATION=days - -Specifies the default expiration time for messages if none is specified. -The default is 7. -3 /FULL -Control whether all information of the news groups is displayed, i.e. -the access list if the news group is private. This information is only -those who have access to that folder. -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified is --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default. -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is posted -every month with an expiration date of one month in the future. -3 /PRIVATE - /PRIVATE - /NOPRIVATE - -Specifies that the news group or class can have it's access modified by -the SET ACCESS command. To accomplish this, a file is created in -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access -to news groups in that class is to set /NOPRIVATE, as then time won't be -wasted checking a file for ACLs. -3 /STORED - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accessed -via the network from the server node. This results in faster access, -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED. -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder. - -If you are using V2.16 or greater on both nodes, then if the data files -of the node containing the remote folder are moved to a different node, -(or if you decided to start BULLCP on a different nooe in that cluster), -the nodename of the remote folders will automatically be updated. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the node information is to modified. -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are logged -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared. -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NONOTIFY. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier. -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN. - - Format: - - SET [NO]PAGE -2 POST_ONLY -Specifies that the selected folder has the POST_ONLY attribute. This -causes the ADD command to mail the message to the mailing address if it -is present (see /DESCRIPTION), rather than add to the folder. - - Format: - - SET [NO]POST_ONLY -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format: - - SET PRIVILEGES parameters - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers. -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed. -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format: - - SET [NO]PROMPT_EXPIRE -2 READNEW -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. - - Format: - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder). -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that READNEW is a permanent flag and cannot be changed by the -individual. This is a privileged qualifier. -2 SHOWNEW -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format: - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand new -users (or those that have never logged in). Use /ALL to modify all -users. -3 /FOLDER - /FOLDER=foldername - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that SHOWNEW is a permanent flag and cannot be changed by the -individual, except if changing to READNEW. This is a privileged -qualifier. -2 STRIP -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). If STRIP -is set, the header of the mail message will be stripped off before it is -stored as a BULLETIN message. - - Format: - - SET [NO]STRIP - -The command SHOW FOLDER/FULL will show if STRIP has been set. -2 SUBSCRIBE -Can be used to force users to be subscribed to the selected news group. -This is a privileged command. - - Format: - - SET SUBSCRIBE - -Note: If you execute the commands SET SHOWNEW, READNEW, BRIEF, or -NOTIFY, and add /DEFAULT or /PERMAMENT, it is equivalent to doing a SET -SUBSCRIBE command with the addition that the specified feature will be -the default and/or permanent setting. -3 /ALL -Specifies that all present and future users will be subscribed to the -news group. -3 /DEFAULT - /[NO]DEFAULT - -Specifies that new users will automatically be subscribed to the news -group. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that new users will automatically be subscribed to the news -group and that users cannot unsubscribe the news group. -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command. - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 SHOW -The SHOW command displays information about certain characteristics. -2 EXCLUDE -Displays the list of excludes which are present for the current folder. -The right hand side of the display shows the date of the last time a -match for the exclude was found, and also the number of days from the -time of the last match after which the excludes expires. -2 FLAGS -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected -via the SELECT command, information about that folder is shown. - - Format: - - SHOW FOLDER [folder-name] -3 /FULL -Control whether all information of the folder is displayed. This -includes DUMP & SYSTEM settings, the access list if the folder is -private, and BBOARD information. This information is only those who -have access to that folder. -2 THREAD -Displays the list of includes which are present for the current folder. -2 KEYPAD -Displays the keypad command definitions. - - Format: - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either SET KEYPAD, or if /KEYPAD is -specified on the command line, the keypad keys will be defined as -commands. The default settings for the keypad are shown via SHOW KEYPAD -or HELP KEYPAD. Settings can be changed by using an initialization file -with DEFINE/KEY commands. BULLETIN looks first for the file pointed to -by the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT). -3 /STATE - /STATE=(state,state,...) - -Specifies the name of a state for which the specified key definitions -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when a -key name has been specified. -2 LIBRARY -Shows the library of folders. By default there is only one library. -However, the system manager may decide to create more than one library, -with each library saved in a different directory. Use the /ALL -qualifier to see if there are other libraries. -3 /ALL -Specifies to show all available libraries. -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEW -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enter -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format: - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this. -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command. -3 /LOGIN - /[NO]LOGIN - -Specifies that only those users which do not have NOLOGIN set are to be -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDER - /FOLDER=[foldername] - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups. -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSION -Shows the version of BULLETIN and the date that the executable was -linked. -1 SPAWN -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of the -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. -1 THREAD -Specifies that the current message is defined as a thread based on -either the subject or the message owner. Since threads are much more -commonly based on the subject, this is the default. Threads are read by -using the command READ/THREADS. - - Format: - THREAD [string] - -If a string is specified, then the message is a thread if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one THREAD may be -specified per folder. - -Note: EXCLUDEs based on FROM will take precedence over THREADs. -2 /ALL -Used with /DISABLE to specify to disable all THREADs. -2 /DISABLE -Specifies to permanently disable the THREAD. -2 /FROM -Specifies to include the message based on the message owner. /FROM -and /SUBJECT cannot be specified at the same time. -2 /LIMIT - /LIMIT=days - -Specifies that the thread will be automatically deleted if no match is -found for the specified number of days. The default is no limit, which -is specified by 0. This can be changed via the SET EXLIMIT command. -2 /SUBJECT -Specifies to include the message based on the message subject. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 Storing_Threads -THREADs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):string - -In order for /FULL to be the default for a folder, the following line -must be present: - -folder_name:defaults:kill - -excluding the folder_name causes it to apply to all folders. -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format: - UNDELETE [message-number] -1 UNSUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See the -SUBSCRIBE command for further info. -1 Usenet_news -BULLETIN can also read USENET NEWS if your system has network access to -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group -in order to keep track of which messages you have read in that group. -Most of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read all your subscribed news groups that have new -messages, use INDEX/SUBSCRIBE. diff --git a/decus/vmslt98b/bulletin/bulldir.inc b/decus/vmslt98b/bulletin/bulldir.inc deleted file mode 100644 index f66cc78..0000000 --- a/decus/vmslt98b/bulletin/bulldir.inc +++ /dev/null @@ -1,58 +0,0 @@ - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) diff --git a/decus/vmslt98b/bulletin/bullet1.com b/decus/vmslt98b/bulletin/bullet1.com deleted file mode 100644 index 2b405c4..0000000 --- a/decus/vmslt98b/bulletin/bullet1.com +++ /dev/null @@ -1,2790 +0,0 @@ -$set nover -$copy/log sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - CREATE.COM will automatically determine if you are running on an alpha - rather than a vax and will issue the appropriate commands for that cpu. - Of course, separate executables are needed for the two cpus, so if your - site has both, you will have to run this procedure separately on each. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL] - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. - BULL_DIR_LIST must be defined on all nodes in a cluster. - - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You can - either let users who want to use this command define it themselves, or - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COM - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optional - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits them - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions. - -8) MASTER.COM - If you are using PMDF, and want to use the BBOARD option, a set of - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COM - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed. - - If you use the NEWS feature, it is suggest that you run this procedure - on BULLNEWS.DAT after it is created. Compressing that file greatly speeds - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (or - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT. -$eod -$copy/log sys$input BULLDIR.INC -$deck - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIP - CHARACTER*12 FROM - LOGICAL SYSTEM - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY) - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER) - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY) - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256 - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH) - - PARAMETER NEWSDIR_RECORD_LENGTH = 140 - - COMMON /NEWS_DIR/ NEWS_MSG_NUM,NEWS_MSG_BTIM_KEY - & ,NEWS_EX_BTIM_KEY,NEWS_MSGID,NEWS_POST_KEY,NEWS_BLOCK - & ,NEWS_LENGTH,NEWS_DESCRIP,NEWS_FROM - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEY - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUM - & ,NEWS_NBULL - CHARACTER*36 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROM - CHARACTER*8 NEWS_POST_KEY - - CHARACTER*8 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*8 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_NUM,NEWSDIR_ENTRY) - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADER - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER) -$eod -$copy/log sys$input BULLETIN.HLP -$deck -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. -$eod -$copy/log sys$input BULLETIN.LNK -$deck -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.3" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.5" -$eod -$copy/log sys$input BULLFILES.INC -$deck -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ -$eod -$copy/log sys$input BULLFOLDER.INC -$deck -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) -$eod -$copy/log sys$input BULLNEWS.INC -$deck - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ -$eod -$copy/log sys$input BULLUSER.INC -$deck -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy/log sys$input BULL_NEWS.C -$deck -#include -#include -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include.arpa]inet.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -static struct dns { - unsigned char function; - unsigned char call_code; - short zeros; - short length; - char string[512]; -} buf1, buf2; - -struct sockaddr_un { - short sun_family; /* AF_UNIX */ - char sun_path[109]; /* path name (gag) */ -}; -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s,s1; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -#if MULTINET - -#include -#include -#ifdef __ALPHA -unsigned int __VA_COUNT_BUILTIN(void); -#define va_count(count) (count = __VA_COUNT_BUILTIN()) -#else -#ifdef VAXC -#define va_count(n) vaxc$va_count(&n) -extern int vaxc$va_count(); -#else -#define va_count(n) decc$va_count(&n) -extern int decc$va_count(); -#endif -#endif - -static int FindRoutine(struct dsc$descriptor *image, - struct dsc$descriptor *routine, int (**rtn)()); - -int inet_ntoa1(int *arg1) -{ - static $DESCRIPTOR(image,"MULTINET_SOCKET_LIBRARY"); - static $DESCRIPTOR(routine,"inet_ntoa"); - int arglist[255]; - int i; - static int status; - static int (*rtn)() = 0; - va_list ap; - va_count(arglist[0]); - va_start(ap, arg1); - arglist[1] = *arg1; - for (i=1;i 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG - sin.sin_port = htons(119); -#else - sin.sin_port = htons1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -struct iosb accept_iosb; - -nntp_listen(listen_chan) -int *listen_chan; -{ -#if MULTINET - struct sockaddr_in sin; - struct iosb accept_iosb; - - if (!(sys$assign(&inet_d,listen_chan,0,0) & 1)) return(0); - - /* - * Create an IP-family socket on which to listen for connections - */ - if (!(sys$qiow(0,*listen_chan,IO$_SOCKET,&accept_iosb,0,0,AF_INET, - SOCK_STREAM,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Create a "sockaddr_in" structure which describes the port we - * want to listen to. Address INADDR_ANY means we will accept - * connections to any of our local IP addresses. - */ - - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - sin.sin_port = htons1(119); - - /* - * Bind to that address... - */ - - if (!(sys$qiow(0,*listen_chan,IO$_BIND,&accept_iosb,0,0, - &sin,sizeof(sin),0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - /* - * Declare to the kernel that we want to listen for connections - * on this port, and that the kernel may queue up to five such - * connections for us. - */ - - if (!(sys$qiow(0,*listen_chan,IO$_LISTEN,&accept_iosb,0,0,5, - 0,0,0,0,0) & 1) || !(accept_iosb.status & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#else - return(0); -#endif -} - -nntp_accept_wait(listen_chan,listen_ast,listen_iosb) -int *listen_chan,*listen_ast,*listen_iosb; -{ -#if MULTINET - if (!(sys$qio(0,*listen_chan,IO$_ACCEPT_WAIT,listen_iosb,listen_ast, - 0,0,0,0,0,0,0) & 1)) { - sys$dassgn(*listen_chan); - return(0); - } - - return(1); -#endif -} - -nntp_accept(listen_chan,accept_chan,accept_iosb) -int *listen_chan,*accept_chan; -struct iosb *accept_iosb; -{ -#if MULTINET - struct sockaddr_in sin; - FILE *fp; - char buf[128]; - char *cp, *h; - int s; - struct sockaddr_un sun = {AF_UNIX}; - - *accept_chan = -1; - - /* - * Call accept to accept a new connection. This 'peels' - * a connection off of the original socket and returns to us - * a new channel to the connection. We could now close - * down the original socket if we didn't want to handle - * more connections. - */ - if (!(sys$assign(&inet_d,accept_chan,0,0) & 1)) return(0); - - if (!(sys$qiow(0,*accept_chan,IO$_ACCEPT,accept_iosb,0,0, - &sin,sizeof(sin),*listen_chan,0,0,0) & 1) - || !(accept_iosb->status & 1)) return(0); - - fp = fopen("BULL_TCP_NEWS_GATEWAY", "r"); - if (!fp) return(1); - - /* A non-official way of getting ip name at ast level */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,AF_UNIX, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) - {printf("1 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - strcpy(sun.sun_path,"DNS"); - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sun,sizeof(sun),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("2 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - -/* buf1.function = 1; /* gethostbyname */ - buf1.function = 2; /* gethostbyaddr */ - buf1.call_code = 0; - buf1.length = strlen(inet_ntoa1((int)(&sin.sin_addr))); - strcpy(buf1.string,inet_ntoa1((int)(&sin.sin_addr))); - - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,&buf1, - sizeof(buf1),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("3 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,&buf2, - sizeof(buf2),0,0,0,0) & 1) - || !(iosb.status & 1)) {printf("4 iosb.status = %d\n",iosb.status);sys$dassgn(s);return(0);} - - printf("5 iosb.status = %d\n",iosb.status);sys$dassgn(s); - buf2.string[buf2.length] = 0; - for (cp=buf2.string; *cp; cp++) *cp = tolower(*cp); - - while (fgets(buf, sizeof(buf), fp)) { - for (cp=buf; *cp != '\n'; cp++) *cp = tolower(*cp); - *cp = 0; - for (cp=buf; *cp == ' ' || *cp == '\t'; cp++); - if (*cp == '\n' || *cp == '#') continue; - if (!strcmp(buf2.string,cp)) return (1); - if (*cp == '.' && strstr(buf2.string,cp)) return (1); - } - (void) fclose(fp); - - return (0); -#endif -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(gethostname1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} - - -smtp_assign() -{ - int n; - -#if MULTINET || TWG - /* - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()). - */ - - if (!hp1) { - int h[4],i; - if (sscanf(node1,"%d.%d.%d.%d",&h[0],&h[1],&h[2],&h[3]) == 4) { - for (i=0;i<4;i++) if (h[i] < 0 || h[i] > 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp1->h_addrtype; - memcpy(&sin.sin_addr, hp1->h_addr, hp1->h_length); - } -#if TWG - sin.sin_port = htons(25); -#else - sin.sin_port = htons1(25); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s1,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s1,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node1),DSC$K_CLASS_S,DSC$K_DTYPE_T,node1}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s1,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s1,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - - -smtp_create() -{ -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s1,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(25); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s1,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#else - if (!(sys$qiow(0,s1,IO$_CREATE,&iosb,0,0,node1,25,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#endif - - return(1); -} - -smtp_disconnect() -{ -#if UCX - sys$cancel(s1); - sys$qiow(0,s1,IO$_DEACCESS,0,0,0,0,0,0,0,0,0); -#endif - sys$dassgn(s1); -} - - -smtp_connect() -{ - if (!smtp_gethost()) return(0); - if (!smtp_assign()) return(0); - if (!smtp_socket()) return(0); - return(smtp_create()); -} - -char node2[132]; - -smtp_gethost() -{ - /* - * Get the IP address of the SMTP host. - * As of MULTINET 3.0, cannot be done at AST level - * so can't do in SMTP_ASSIGN(), as BULLCP calls it at - * AST level if the decnet gateway feature is used. - */ -#if TWG - struct hostent *gethostbyname(); -#else -#if MULTINET -#endif -#endif - - node1 = getenv("BULL_SMTP_SERVER"); - if (!node1) { -#if TWG - gethostname(node2,132); -#else -#if MULTINET - gethostname1(node2,132); -#endif -#endif - node1 = node2; - } - -#if TWG - hp1 = gethostbyname(node1); -#else -#if MULTINET - hp1 = gethostbyname1(node1); -#endif -#endif - return(1); -} - - - -smtp_write_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s1,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - - -smtp_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s1,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - - -smtp_socket() -{ - -#if MULTINET || TWG - if (!(sys$qiow(0,s1,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s1); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s1,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s1,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s1); - return(0); - } -#endif - - return(1); -} -$eod -$copy/log sys$input CHANGES.TXT -$deck -V2.5 -Changed behavior of threads and excludes. Only excludes based on FROM will -take precedence over THREADs. 10/1/98 - -Fixed 2 very old bugs. One which would cause one of the databases to be -stuck opened preventing anyone else from using BULLETIN, the other which -caused READNEW behavior when logging in for folders which did not have that -feature enabled. 9/20/98 - -V2.4 -Adding the ability to change one's personal name used in postings to news -groups and mail message by defining the logical name BULL_PERSONAL_NAME. -7/22/98 - -Added the SET GATEWAY command to change the how the subject lines looks in -messages which are sent to an email address associated with a folder. 2/25/98 - -Many bugs were fixed, mainly with respect to the news-email-folder gateway. - -V2.3 - -Added the ability to create a folder that can post and read to a news group, -and can send and read messages via email. See NEWS_TO_FOLDER.TXT for more -info. 4/18/97 - -Added the ability for BULLETIN to see news groups from secondary news groups -(see NEWS.TXT). 4/18/97 - -V 2.25 - -Changes to make it easier to click on news group name to select them: You can -enter a news group name at the prompt and it will select it (without typing -SELECT). News groups displayed without period at end when BULLETIN lists the -ones that have new messages. NEWS/SUBS has space between * and news group -when denoting which ones have new messages. 3/21/96 - -V 2.24 - -When replying to a message in a news group that has been crossposted, give the -user the option of just posting the reply to the news group in which the -message is being read rather than all the news groups in the crosspost. -11/20/95 - -Messages added to folders and stored news groups are now marked as being read -so that the person does not see them when doing a READ/NEW. 11/20/95 - -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. -$eod -$copy/log sys$input DEBUG.TXT -$deck -$eod -$copy/log sys$input HANDOUT.TXT -$deck - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod -$copy/log sys$input INSTRUCT.TXT -$deck -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). -$eod -$copy/log sys$input NEWS.TXT -$deck -BULLETIN has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was -to run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added -the ability in BULLETIN (actually BULLCP) so that it acts as as a gateway -between decnet and tcp for NEWS. This method does not require spawning any -processes, since the detached process BULLCP is always present, so the access -is very fast. Also, since BULLETIN uses a shared database to store info on -the NEWS groups and periodically updates it, there is no need for that to be -done when a user accesses the NEWS groups. Several other NEWS readers do this -when you run them, which is why they take a long time to start up. It is also -possible to feed NEWS groups into a "real" BULLETIN folder, so that the -messages are saved on disk (see the file NEWS_TO_FOLDER.TXT). - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER to -be a system logical name pointing to either your internet or decnet NEWS node. -If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -It is also possible for BULLETIN to access news groups that are located on -other news servers than the one specified by BULL_NEWS_SERVER. This is done -by creating the file BULL_DIR:BULL_ALT_NEWS.LIS and adding a line which -containsthe name of the news group and the news server where it's located. -The format is news-group-name:news-server-name. - -In order to post messages, BULLETIN needs to know the internet nodename of the -local host. This is done automatically for nodes running MULTINET. For other -nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This can -be hardcoded into the source by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, -it will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will -cause subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -If you have any problems or questions, please let me know. - MRL -$eod -$copy/log sys$input NEWS_TO_FOLDER.TXT -$deck -It is possible to automatically have messages from a news group be fed into a -real folder, and visa versa. This allows BULLETIN messages to be shared with -a news group, thus giving access to such messages to people who do not have -access to BULLETIN. This can also be combined with email access for people -who have neither BULLETIN nor news group access. - -To associate a folder with a news group, place the name of the news group into -the folder description surrounded by <>, i.e. . It must be in -lower case. (Other text is allowed in the description, i.e. "THIS IS A TEST -FOLDER ".) When messages are added the folder, they are also sent -to the news group, and new messages from the group are posted to the folder -(via the BULLCP process which wakes up on a periodic basis). Whenever you -modify the folder description and specify the news group name, you will be -prompted as to whether you want to initializee the news group counter to -either load all the messages present in the news group, or to load only news -messages that appear there. - -Messages posted to the news group from such a folder have a special line in -their header indicating they were sent from that node using bulletin. When -bulletin feeds new postings back to the folder, it will see that header line -and also see that it was posted from that node, and thus will avoid adding it -to the folder (and thus creating a duplicate message). Note that messages are -added to the news group via the BULLCP process, so they will not appear -immediately after being added to the folder. - -If you are modifying an existing folder to make it associated with a news -group, and if you want to copy any existing messages in the folder to the news -group, you can do that by using the command COPY/ORIGINAL/LOCAL and specifying -the news group as the destination. /ORIGINAL will cause the original owner -names and dates to be preserved (note, however, that dates older than 14 days -in the past are not usually accepted by the news server, so dates older than -that will be changed to the present date). /LOCAL will create the special -header line in the messages to prevent BULLCP from adding those messages back -to the folder from the news group. /ALL can be specified to copy all the -messages in the folder. - -If you create a remote folder that points to a folder that has a news group -associated with it, you do not have to specify the news group in the -description of the remote node. However, on the node on which the folder -actually exists, the news group has be a stored news group, i.e. you must -issue the command SET NEWS/STORED for that news group. - -When a news group is specified for a folder, it is still possible to associate -an email address for the messages to be sent to in the folder description. -You do this by using [] to enclose the address rather than the usual <>, i.e. -[mrl@pfc.mit.edu] See help in BULLETIN on the command CREATE/DESCRIPTION for -more info about associated email addresses. Note that these features allow -you to create a full gateway between a news group and a mailing list. -$eod -$copy/log sys$input NONSYSTEM.TXT -$deck -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. -$eod -$copy/log sys$input WRITEMSG.TXT -$deck -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -$eod diff --git a/decus/vmslt98b/bulletin/bullet2.com b/decus/vmslt98b/bulletin/bullet2.com deleted file mode 100644 index cc4b282..0000000 --- a/decus/vmslt98b/bulletin/bullet2.com +++ /dev/null @@ -1,1705 +0,0 @@ -$set nover -$copy/log sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy/log sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy/log sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 4/10/97 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER ORIGINAL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER COPY, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Add ,DEFAULT to the end of the following line if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FORCE - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER REASON, VALUE(REQUIRED) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE TYPE SEARCH_MATCHES - KEYWORD AND - KEYWORD OR - DEFAULT - KEYWORD XOR - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER CONTINUE - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER EXTRACT, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER FEEDBACK - QUALIFIER FF - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW - QUALIFIER NOTIFY, DEFAULT - QUALIFIER PRINT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER NOW - QUALIFIER OUTPUT,VALUE(REQUIRED,TYPE=$FILE) - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER ROTATE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW GROUP AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT - DISALLOW FULL AND (ALL OR P1 OR FROM OR SUBJECT) - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=EXTRACT, VALUE(TYPE=$FILE) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB THREAD - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER FULL - QUALIFIER LIMIT, VALUE, NONNEGATABLE - QUALIFIER SUBJECT, DEFAULT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER MATCH, VALUE(DEFAULT="OR",TYPE=SEARCH_MATCHES) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER PERMANENT - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER FORCE - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LOCAL - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER DEFAULT - QUALIFIER PERMANENT - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED - OR PERMANENT OR DEFAULT) - DISALLOW (DEFAULT AND PERMANENT) OR (DEFAULT AND SUBSCRIBE) - DISALLOW PERMANENT AND SUBSCRIBE - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST, DEFAULT - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER CANCEL - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER THREADS - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE) - QUALIFIER CURRENT - DISALLOW CURRENT AND NUMBER - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER INDENT, VALUE(DEFAULT="->"), DEFAULT - QUALIFIER FOLLOWUP, VALUE(REQUIRED) - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING, VALUE(LIST) - QUALIFIER EDIT - QUALIFIER FEEDBACK - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER FROM - QUALIFIER GROUP, VALUE(REQUIRED,LIST) - QUALIFIER NEGATED - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER START, VALUE(TYPE=$NUMBER) - QUALIFIER SUBJECT - QUALIFIER MATCH, VALUE(REQUIRED) - DISALLOW NOT (SEARCH_STRING OR REPLY) AND REVERSE - DISALLOW SEARCH_STRING AND REPLY - DISALLOW GROUP AND SELECT_FOLDER - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LIBRARY, SYNTAX=SET_LIBRARY - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - KEYWORD ANONYMOUS - KEYWORD NOANONYMOUS - KEYWORD EXLIMIT,SYNTAX=SET_EXLIMIT - KEYWORD EXCLUDE - KEYWORD NOEXCLUDE - KEYWORD NAME,SYNTAX=SET_NAME - KEYWORD SUBSCRIBE, SYNTAX=SET_SUBSCRIBE - KEYWORD FILE_DIRECTORY,SYNTAX=SET_FILE_DIRECTORY - KEYWORD GATEWAY - KEYWORD NOGATEWAY - DEFINE SYNTAX SET_EXLIMIT - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - VALUE(REQUIRED,TYPE=$NUMBER) - DEFINE SYNTAX SET_FILE_DIRECTORY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SET_PARAM2 - DEFINE SYNTAX SET_NAME - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=OLDNAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=NEWNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_LIBRARY - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=LIBRARY, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DEFINE SYNTAX SET_SUBSCRIBE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT - QUALIFIER NODEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NODEFAULT AND DEFAULT - DISALLOW NOPERMANENT AND PERMANENT - DISALLOW NODEFAULT AND PERMANENT - DISALLOW NOT (ALL OR DEFAULT OR NODEFAULT OR PERMANENT - OR NOPERMANENT) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD EXCLUDE - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD INCLUDE - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD LIBRARY, SYNTAX=SHOW_LIBRARY - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD THREAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_LIBRARY - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER ALL - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE -$eod -$copy/log sys$input BULLETIN.CLD -$deck -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP -$eod -$copy/log sys$input BULLMAIN.CLD -$deck - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP -$eod -$copy/log sys$input BULLSTART.COM -$deck -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod -$copy/log sys$input BULL_NEWSDUMMY.FOR -$deck - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - NEWS_GET_CHAN = 0 - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - NEWS_SOCKET_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - NEWS_CREATE_BULLCP = 0 - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - NEWS_WRITE_PACKET_BULLCP = 0 - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - NEWS_READ_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - NEWS_GETHOSTNAME = 0 - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - NEWS_GETHOST = 0 - - RETURN - END - - - - SUBROUTINE SMTP_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION SMTP_CONNECT - - SMTP_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION SMTP_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_WRITE_PACKET = 0 - - RETURN - END - - - - INTEGER FUNCTION SMTP_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - SMTP_READ_PACKET = 0 - - RETURN - END -$eod -$copy/log sys$input CREATE.COM -$deck -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK -$eod -$copy/log sys$input INSTALL.COM -$deck -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN -$eod -$copy/log sys$input INSTRUCT.COM -$deck -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod -$copy/log sys$input MAKEFILE. -$deck -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.5" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* -$eod -$copy/log sys$input OPTIMIZE_RMS.COM -$deck -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS -$eod -$copy/log sys$input RESTART.COM -$deck -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START -$eod -$copy/log sys$input SETUSER.MAR -$deck - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program -$eod -$copy/log sys$input UPGRADE.COM -$deck -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE -$eod diff --git a/decus/vmslt98b/bulletin/bulletin.cld b/decus/vmslt98b/bulletin/bulletin.cld deleted file mode 100644 index deb3c36..0000000 --- a/decus/vmslt98b/bulletin/bulletin.cld +++ /dev/null @@ -1,44 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER, value(type=$quoted_string) - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LIBRARY, Value (Required) - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vmslt98b/bulletin/bulletin.com b/decus/vmslt98b/bulletin/bulletin.com deleted file mode 100644 index 441d743..0000000 --- a/decus/vmslt98b/bulletin/bulletin.com +++ /dev/null @@ -1,2 +0,0 @@ -$ DEFINE SYS$INPUT SYS$NET -$ BULLETIN diff --git a/decus/vmslt98b/bulletin/bulletin.for b/decus/vmslt98b/bulletin/bulletin.for deleted file mode 100644 index c52fdb7..0000000 --- a/decus/vmslt98b/bulletin/bulletin.for +++ /dev/null @@ -1,2129 +0,0 @@ -C -C BULLETIN.FOR, Version 2/27/98 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - DATA NEXT_COMMAND/' '/ - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - CALL INIT_BULLETIN(.TRUE.) - -C -C The MAIN loop for processing bulletin commands. -C - - LPROMPT = TRIM(COMMAND_PROMPT) - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' ' - LPROMPT = LPROMPT + 2 - - DO WHILE (LPROMPT.GT.0) - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';' - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE - INCMD = DCL_CMD - DCL_CMD = ' ' - END IF - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THEN - IER = RMS$_EOF - ELSE IF (IER.LE.0) THEN - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ') - INCMD = INCMD(2:IER) - IER = IER - 1 - END DO - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN - INCMD = 'READ '//INCMD - END IF - IF (IER.GT.0) THEN - IF (INDEX(INCMD(:IER),' ').EQ.0.AND. - & INDEX(INCMD,'/').EQ.0.AND. - & INDEX(INCMD,'.').GT.0) INCMD = 'SELECT '//INCMD - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEN - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered - INCMD = ' ' ! Make sure there is none - LEN_P = 0 ! Indicate no parameter in command - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE IF (READ_COUNT.NE.0) THEN - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - ELSE IF (NEXT_COMMAND.NE.' ') THEN - INCMD = NEXT_COMMAND - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL DO_COMMAND(INCMD) - ELSE ! Else try to read next bulletin - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has error - GO TO 100 ! ask for new command - END IF - - CALL DO_COMMAND(INCMD) - -100 CONTINUE - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT - - END DO - -1010 FORMAT(Q,A) - - END - - - - - SUBROUTINE DO_COMMAND(INCMD) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEXT_COMMAND/ NEXT_COMMAND - CHARACTER NEXT_COMMAND*64 - - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - CHARACTER*(*) INCMD - - NEXT_COMMAND = ' ' - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command. - - IF (HLEN.EQ.0) THEN - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THEN - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1 - END IF - END IF - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1 - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN -C FOLDER_COUNT = -1 -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' ' - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0 - FOLDER_COUNT = 0 - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL'.OR. - & INCMD(:4).EQ.'POST'.OR. - & INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - WRITE (6,'('' ERROR: /FOLDER not valid when posting'', - & '' a message to a news group.'')') - ELSE - INCMD = 'POST '//INCMD(4:) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - END IF - ELSE - CALL ADD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH? - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THEN - WRITE(6,'('' ERROR: There are no more preceding messages.'')') - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY? - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE? - CALL CREATE_FOLDER ! Go create the folder - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning. - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE? - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').AND.CLI$PRESENT('NEWS')) THEN - WRITE (6,'('' ERROR: /NEWS and /FOLDER cannot be '' - & ''specified at the same time.'')') - ELSE IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified? - & CLI$PRESENT('NEWS')) THEN ! or /NEWS? - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder - IF (IER) THEN ! If successful - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE(0,.TRUE.,.FALSE.) ! Copy bulletin to file - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1 - BULL_READ = 1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX? - INDEX_COUNT = 1 - CALL FULL_DIR - ELSE IF (INCMD(:4).EQ.'INCL'.OR. ! INCLUDE? - & INCMD(:4).EQ.'THRE') THEN ! THREAD? - CALL INCLUDE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST? - READ_COUNT = -1 - BULL_READ = 9999999 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK? - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAIL - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE? - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT? - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST? - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL ADD - ELSE - CALL RESPOND - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ? - IF (CLI$PRESENT('THREADS')) NEXT_COMMAND = 'READ/THREADS' - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (.NOT.BTEST(FOLDER_FLAG,11).AND.(REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0)) THEN - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - NEXT_COMMAND = 'SEARCH' - CALL SEARCH(READ_COUNT) - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET? - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER) - IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:2).EQ.'FI') THEN ! SET FILE_DIRECTORY? - CALL SET_CUSTOM('file_directory') - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIV - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')') - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD? - CALL SET_KEYPAD - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD? - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE? - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')') - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')') - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP? - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST? - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'AN') THEN ! SET ANONYMOUS? - CALL SET_FOLDER_FLAG(.TRUE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAN') THEN ! SET NOANONYMOUS? - CALL SET_FOLDER_FLAG(.FALSE.,14,'ANONYMOUS') - ELSE IF (BULL_PARAMETER(:3).EQ.'COM') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOCOM') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1) - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'EXP') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P) - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE? - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE? - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXP') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0) - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1) - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SH') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0) - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1) - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('NODEFAULT').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'SU') THEN ! SET SUBSCRIBE? - IF (REMOTE_SET.GE.3) THEN - D1 = 0 - D2 = 0 - D3 = 0 - CALL SET_FOLDER_DEFAULT(D1,D2,D3) - ELSE - WRITE (6,'('' ERROR: Command invalid for folder.'')') - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS? - CALL SET_ACCESS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'GEN') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOGEN') THEN ! SET NOGENERIC? - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LIB') THEN ! SET LIBRARY? - CALL SET_LIBRARY - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN? - CALL SET_LOGIN(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIRE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS? - CALL SET_NEWS - ELSE IF (BULL_PARAMETER(:3).EQ.'EXC') THEN ! SET EXCLUDE? - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOEXC') THEN ! SET NOEXCLUDE? - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - ELSE IF (BULL_PARAMETER(:3).EQ.'EXL') THEN ! SET EXLIMIT? - CALL SET_CUSTOM('exclude_limit') - ELSE IF (BULL_PARAMETER(:4).EQ.'NAME') THEN ! SET NAME? - CALL SET_NEWNAME - ELSE IF (BULL_PARAMETER(:3).EQ.'GAT') THEN ! SET GATEWAY? - CALL SET_FOLDER_FLAG(.TRUE.,15,'GATEWAY') - ELSE IF (BULL_PARAMETER(:5).EQ.'NOGAT') THEN ! SET NOGATEWAY? - CALL SET_FOLDER_FLAG(.FALSE.,15,'GATEWAY') - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW? - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'EX') THEN ! SHOW EXCLUDE? - CALL SHOW_EXCLUDE(0) - ELSE IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGS - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER - ELSE IF (BULL_PARAMETER(:2).EQ.'IN'.OR. - & BULL_PARAMETER(:2).EQ.'TH') THEN ! SHOW INCLUDE? - CALL SHOW_EXCLUDE(1) - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SHOW LIBRARY - CALL SHOW_LIBRARY - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATION - FOLDER1 = SAVE_FOLDER - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESS - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1) - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN? - CALL TAG(.FALSE.,2) - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - - RETURN - END - - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN - END - - - - - - SUBROUTINE ADD -C -C SUBROUTINE ADD -C -C FUNCTION: Adds bulletin to bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER INEXDATE*12,INEXTIME*12,INDENT*4 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,BULLETIN_SUBCOMMANDS - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IF - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT') - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THEN - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - LENI = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',INDENT,LENI) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LENI.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') INDENT(:LENI)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL GET_FOLDER_INFO(IER) - IF (.NOT.IER) GO TO 910 - SELECT_FOLDERS = .TRUE. - ELSE - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present? - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910 - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abort - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IF - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present? - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort - ELSE IF (CLI$PRESENT('CLUSTER')) THEN - SYSTEM = SYSTEM.OR.8 - END IF - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present? - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083) - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2100' - INEXTIME = '00:00:00.00' - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present? - IF (.NOT.ALLOW) THEN ! If no privileges - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abort - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name. - END IF - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - END IF - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit - INEXDATE = '5-NOV-2100' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60) - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60) - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DO - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IF - - SELECT_NODES = .FALSE. - IF (CLI$PRESENT('NODES')) THEN - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940 - SELECT_NODES = .TRUE. - END IF - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSE - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IF - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: " - -C -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - IF (CLI$PRESENT('EXTRACT')) THEN - CONTEXT = 0 - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - END IF - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & ERR=910,FORM='FORMATTED') - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35 - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - ICOUNT = ICOUNT + 1 + MIN(ILEN,80) - BLENGTH = BLENGTH + ILEN - 1 + 2 - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE. - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting by '', - & I6,'' characters. Limit is '',I3,''.'')') - & BLENGTH - 82*12 - 2, 82*12 - 2 - CALL GET_INPUT_PROMPT(INPUT,ILEN, - & 'Type C to broadcast anyway, A to only ADD message,' - & //' or Q to Quit: ') - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN - BRDCST = .TRUE. - ELSE IF (.NOT.STREQ(INPUT(:1),'C')) THEN - GO TO 910 - END IF - END IF - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST' - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1 - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1) - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THEN - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN) - END IF - END DO - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THEN - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INPUT(:80) - GO TO 940 - END IF - REWIND (UNIT=3) - END DO - END IF - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95 - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IF - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1 - FOLDER1 = NODES(I) - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - IF (BTEST(FOLDER_FLAG,14)) THEN - FROM = 'ANONYMOUS' - ELSE - FROM = USERNAME ! Username - END IF - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - IF (.NOT.BTEST(FOLDER_FLAG,14)) THEN - CALL STORE_BULL(LNODE+TRIM(FROM)+6,'From: '// - & LOCAL_NODE(:LNODE)//FROM(:TRIM(FROM)),OBLOCK) - END IF - IF (LENDES.GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IF - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletin - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletin - LENGTH = OCOUNT - (NBLOCK+1) + 1 - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IF - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF (FOLDER_NUMBER.GE.0) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL ADD_TAG(IER1,2) - END IF - END IF - - CALL CLOSE_BULLDIR ! Totally finished with add -C -C Broadcast the bulletin if requested. -C - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THEN - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER')) - END IF -C -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP, -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same cluster -C as that of the BULLCP node. -C - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET) - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')) - END IF - ELSE IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR. - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - IF (BTEST(FOLDER_FLAG,10).OR.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & INDESCRIP(:LENDES),STATUS) - ELSE - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LENDES),STATUS) - END IF - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & ERR=910,FORM='FORMATTED') - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IF - END IF - END DO - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INLINE,ILEN).NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INLINE,ILEN) - IF (LENFRO.EQ.0) THEN - INPUT = INLINE(:ILEN)//',' - ELSE - INPUT = INPUT(:LENFRO)//INLINE(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - - IF (LENFRO.GT.1) THEN - LENFRO = LENFRO - 1 - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INPUT(I:I).EQ.'"') THEN - INPUT = INPUT(:I)//'"'//INPUT(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT, - & INDESCRIP(:LENDES),STATUS) - END IF - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9 - CLOSE (UNIT=I) - END DO - - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:INDEX(FOLDER_DESCRIP,'>')-1) - CALL NEWS_POST(BULL_PARAMETER(:LEN_P),.FALSE.,IER, - & INDESCRIP) - END IF - -200 IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100) - GO TO 200 - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GO TO 200 - -930 WRITE (ERROR_UNIT,1025) - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 200 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018) - CLOSE (UNIT=3) - GO TO 200 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 200 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for system - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A) - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM) - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta time - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURN - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*4 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE. - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURN - END IF - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Want to try again? (Y/N with Y as default): ') - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THEN - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')') - END IF - END IF - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1 - - RETURN - END - - - - SUBROUTINE REPLY - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP)) - - CALL ADD - - RETURN - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST) - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV -C -C FUNCTION: -C To get process privileges. -C OUTPUTS: -C PROCPRIV - Returned privileges -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURN - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/ - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - CALL CLOSE_BULLUSER - NEEDPRIV(1) = USERPRIV(1) - NEEDPRIV(2) = USERPRIV(2) - END IF - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR. - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN - SETPRV_PRIV = .TRUE. - ELSE - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIV - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURN - END - - - - SUBROUTINE GETUSER(USERNAME) -C -C SUBROUTINE GETUSER -C -C FUNCTION: -C To get username of present process. -C OUTPUTS: -C USERNAME - Username owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG) - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC' - - DATA READ_UAI/.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN - CAPTIVE = .FALSE. - RETURN - END IF - - TYPE = 1 - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE. - END IF - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURN - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')') - RETURN - END IF - - CALL DISABLE_PRIVS - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THEN - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN) - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE - CALL LIB$SPAWN() - END IF - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - CALL ENABLE_PRIVS - - RETURN - END - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z) - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN - - INCLUDE '($JPIDEF)' - - CHARACTER*16 PROCESS - - IF (CLI$PRESENT('PROCESS')) THEN - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) - END IF - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD - - RETURN - END - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C -C The largest message that can be broadcasted is dependent on system -C and user quotas. The following limit is 12 lines of ( 80 characters + -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway. -C - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2 - CHARACTER*(BRDCST_LIMIT) BROAD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTH - - IF (RING_BELL) THEN ! Include BELL in message? - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is from - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IF - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1 - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.NE.0) RETURN - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long? - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DO - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL? - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THEN - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,) - END IF - END IF - - CALL SYS$SETRWM(%VAL(0)) - - RETURN - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFO -C -C FUNCTION: Obtains & verifies folder names from command line. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodes - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - CALL STR$UPCASE(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1 - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURN - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM) - IER = 0 - RETURN - END IF - END DO - END DO - - IER = 1 - - RETURN - END - - - - - SUBROUTINE INIT_BULLETIN(NOX) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - DATA PAGE_LENGTH/24/,PAGE_WIDTH/80/ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - DATA DIR_COUNT/0/,READ_COUNT/0/,FOLDER_COUNT/0/,INDEX_COUNT/0/ - - COMMON /DCL/ DCL_CMD,DCL_COMMAND - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - IF (NOX) CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER(:LEN_P) - CALL CHECK_DIR(BULL_PARAMETER,.FALSE.) - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - END IF - CALL LIB$REVERT - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE IF (COMMAND_PROMPT(I:I).EQ.'/') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL(.FALSE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS1') THEN - CALL NEWS2BULL(.TRUE.) - ELSE IF (BULL_PARAMETER(:LENP).EQ.'SMTP') THEN - CALL SEND_MAIL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - IF (NOX) CALL CRELNM('SYS$INPUT','TT') ! Input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - IF (NOX) CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder. -C - - CALL OPEN_USERINFO - - CALL OPEN_OLD_TAG - - IF (.NOT.NOX) THEN - CALL NEW_MESSAGE_NOTIFICATION - RETURN - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - IF ((STS.AND.PCB$M_BATCH).GT.0) THEN - PAGING = .FALSE. - PAGE_WIDTH = 80 - END IF - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IF - END IF - -C -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins. -C - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -C -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit. -C - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bulletin.hlp b/decus/vmslt98b/bulletin/bulletin.hlp deleted file mode 100644 index cf279b3..0000000 --- a/decus/vmslt98b/bulletin/bulletin.hlp +++ /dev/null @@ -1,151 +0,0 @@ -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that new -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command] - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS. -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands. -2 /EDIT -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPAD - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD. -2 /LIBRARY - /LIBRARY=library - -Specifies the library of folders to use. By default there is only one -library. However, the system manager may decide to create more than one -library, with each library saved in a different directory. Use the SHOW -LIBRARY/ALL command within BULLETIN to see if there are other libraries. -2 /PAGE - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory. -2 /PGFLQUOTA - /PGFLQUOTA=pages - -Used if you want to specify the page file quota for the BULLCP process. -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETIN -is aware that it is running on another node. (On the local node where -BULLCP is running, this logical name is automatically defined.) -2 /STOP -Stops the BULLCP process without restarting a new one. (See /STARTUP -for information on the BULLCP process.) -2 /SYSTEM - /SYSTEM=[days] - -Displays system messages that have been recently added. The default is -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages that -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed before -the terminal type is known, and the default width is larger than what the -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process. diff --git a/decus/vmslt98b/bulletin/bulletin.lnk b/decus/vmslt98b/bulletin/bulletin.lnk deleted file mode 100644 index 8d8a7d2..0000000 --- a/decus/vmslt98b/bulletin/bulletin.lnk +++ /dev/null @@ -1,18 +0,0 @@ -$ ULIB = "NONE" -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO LINK -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN GOTO ALINK -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHARE -ID="V2.24" -$ EXIT -$ALINK: -$ LINK/NOTRACE/NONATIVE_ONLY BULL/LIB/INC=BULLETIN$MAIN/SYSEXE- - /USERLIB='ULIB'/EXE=BULLETIN,SYS$SHARE:VAXCRTL/LIB,SYS$INPUT/OPT -ID="V2.24" diff --git a/decus/vmslt98b/bulletin/bulletin0.for b/decus/vmslt98b/bulletin/bulletin0.for deleted file mode 100644 index 4bc7987..0000000 --- a/decus/vmslt98b/bulletin/bulletin0.for +++ /dev/null @@ -1,2520 +0,0 @@ -C -C BULLETIN0.FOR, Version 9/20/96 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET.EQ.1) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IER1 = SBULL + 1 - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER1) - SUBJECT = DESCRIP - IER2 = 0 - IF (IER2.EQ.0.AND.IER1.EQ.SBULL+1) CALL - & REMOTE_DELETE(SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - ELSE IF (REMOTE_SET.EQ.3) THEN - BULL_DELETE = SBULL - 1 - IER = 0 - IF (CLI$PRESENT('REASON')) THEN - CALL CLI$GET_VALUE('REASON',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) RETURN - IF (EBULL.EQ.SBULL) THEN - WRITE(6,1030) - RETURN - END IF - END IF - END DO - SUBJECT = DESCRIP - IF (.NOT.TEST_NEWS_OWNER().AND.SETPRV_PRIV().AND. - & .NOT.CLI$PRESENT('FORCE')) THEN - SUBJECT = 'CanceL' - IF (CLI$PRESENT('REASON')) THEN - SUBJECT = SUBJECT(:6)//BULL_PARAMETER(:LEN_P) - END IF - END IF - CALL REMOTE_DELETE - & (SBULL,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - RETURN - END IF - END DO - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - SUBJECT = DESCRIP - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.NE.USERNAME - END IF - IF (ASK.AND..NOT.CLI$PRESENT('FORCE')) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - IF (REMOTE_SET.EQ.4) THEN - SUBJECT = 'CanceL' - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.(TEST_NEWS_OWNER().OR. - & SETPRV_PRIV())) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,SUBJECT,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2),EX(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:9).EQ.'19') EXDATE(8:9) = '18' - IF (EXDATE(8:9).EQ.'20') EXDATE(8:9) = '19' - IF (EXDATE(8:9).EQ.'18'.AND.EXDATE(10:10).LT.'6') - & EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX) ! Get time 15 minutes from now - IER = SYS$GETTIM(NOW) - IER = LIB$SUBX(NOW,EX,EX) - IER = SYS$ASCTIM(,INPUT,EX,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates. - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THEN - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1) - ELSE - BULL_POINT = SBULL - 1 - END IF - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURN - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-')) - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVAL - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IF - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVAL - IF (IER.NE.0) THEN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = F_NBULL - IER = 0 - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINT - IER = 0 - END IF - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY(DIR_COUNT) -C -C SUBROUTINE DIRECTORY -C -C FUNCTION: Display directory of messages. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA SCRATCH_D1/0/ - DATA EXCLUDE_D1/0/ - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXT - - COMMON /NEW_DIR/ NEW - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DIRMODE/ DIRMODE - DATA DIRMODE/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,OUTLINE*80 - CHARACTER GROUP*80,STAT*4 - - INTEGER TODAY(2) - - CHARACTER*12 EXPIRES,DIR_TYPE - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - DIRMODE = .TRUE. - - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN) - IER=SYS$BINTIM('0 00:00:05.00',TIMADR) - - KILL = BTEST(BULL_USER_CUSTOM,1).AND.BTEST(BULL_USER_CUSTOM,3) - IF (KILL) IER1 = 0 - - FOUND = 0 - OUT = 6 - - CONT = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - CONT = CLI$PRESENT('CONTINUE') - ELSE IF (INCMD(:3).EQ.' '.AND.NFOLDER.LT.0) THEN - CONT = .TRUE. - END IF - IF (CONT) THEN - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - SUBJECT = SUBJECT1 - REPLY = REPLY1 - SEARCH = SEARCH1 - FROM_SEARCH = FROM_SEARCH1 - SINCE = SINCE1 - NEW = NEW1 - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - IF (.NOT.ANY_SEARCH) THEN - WRITE (6,'('' ERROR: No previous search to continue.'')') - RETURN - END IF - INCMD = ' ' - LEN_P = 0 - DIR_COUNT = DIR_COUNT1 - NFOLDER = NFOLDER1 - I = DIR_COUNT - IF (DIR_COUNT.EQ.-1) THEN - I = SBULL - 1 - END IF - GO TO 200 - END IF - NFOLDER = 0 - - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('OUTPUT',BULL_PARAMETER,LEN_P)) THEN - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & DEFAULTFILE='.LIS', - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - WRITE(6,1000) BULL_PARAMETER(:LEN_P) - RETURN - END IF - OUT = 3 - INQUIRE (UNIT=3,NAME=BULL_PARAMETER) - WRITE (6,1040) BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - END IF - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES') - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH') - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - EXTRACTING = CLI$PRESENT('EXTRACT') - PRINTING = CLI$PRESENT('PRINT') - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - NEGATED = CLI$PRESENT('NEGATED') - IF (SEARCH) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (SUBJECT) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (FROM_SEARCH) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (REPLY) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SLEN = 3 - NEGATED = .TRUE. - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - ELSE - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - EXTRACTING = .FALSE. - PRINTING = .FALSE. - POSTTIME = .TRUE. - IF (INCMD(:3).EQ.'IND') THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - REPLY_FIRST = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - ELSE - NEW = .FALSE. - END IF - END IF - OUTPUT = EXTRACTING.OR.PRINTING - - START = .FALSE. - SINCE = .FALSE. - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - NFOLDER1 = -1000 - SUBJECT1 = SUBJECT - REPLY1 = REPLY - SEARCH1 = SEARCH - FROM_SEARCH1 = FROM_SEARCH - I = SBULL - 1 - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - SINCE1 = SINCE - NEW1 = NEW - GOTO 200 - END IF - END IF - -C -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1 - CALL INIT_QUEUE(EXCLUDE_D1,%DESCR(I)) - EXCLUDE_D = EXCLUDE_D1 - NEXCLUDE = 0 - - CALL OPEN_BULLDIR_SHARED ! Get directory file - - CALL READDIR(0,IER) ! Does directory header exist? - NEWDIR = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - NEWDIR = .TRUE. - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified? - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNT - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')') - CALL CLOSE_BULLDIR - DIR_COUNT = 0 - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THEN - SINCE = CLI$PRESENT('SINCE') - IF (SINCE) IER = CLI$GET_VALUE('SINCE',DATETIME) - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - IF (NEW.AND.IER.EQ.0) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - END IF - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - CALL CLOSE_BULLDIR - GO TO 9999 - ELSE - DIR_COUNT = IER - END IF - ELSE - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - IER1 = 0 - - IF (READ_TAG) THEN - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - ANY_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (.NOT.(SINCE.OR.NEW.OR.START)) THEN - DIR_COUNT = 1 - END IF - CALL READDIR(DIR_COUNT,IER1) - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THEN - IF (READ_TAG) THEN - SBULL = NBULL + 1 - GO TO 100 - ELSE - START = .FALSE. - DIR_COUNT = NBULL - END IF - END IF - IF (SINCE.OR.NEW.OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE - DIFF = 1 - IF (REMOTE_SET.LT.3.AND.DIR_COUNT.NE.NBULL) THEN - CALL READDIR(DIR_COUNT,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1, - & FOLDER_NUMBER+1),MSG_BTIM) - IF (LAST_READ_BTIM(1,FOLDER_NUMBER+1).EQ.MSG_BTIM(1) - & .AND.LAST_READ_BTIM(2,FOLDER_NUMBER+1).EQ.MSG_BTIM(2)) - & DIFF = 0 - IF (READ_TAG) CALL DECREMENT_MSG_KEY - ELSE IF (DIR_COUNT.NE.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(DIFF) - IF (DIFF.NE.0) THEN - DIFF = DIFF - DIR_COUNT - 1 - ELSE - DIFF = 1 - END IF - END IF - IF (DIFF.GT.0.AND. - & NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULL - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - IF (SBULL.LT.1) SBULL = 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - END IF - - IER1 = 0 - IF (REMOTE_SET.LT.3) F_START = 1 - IF (DIR_COUNT.GT.F_START.AND.KILL.AND..NOT.(ANY_SEARCH.OR.START - & .OR.SINCE.OR.NEW).AND.NEWDIR.AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - I = DIR_COUNT - NUM = 0 - SBULL = DIR_COUNT - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I.EQ.DIR_COUNT.AND.I+1.NE.IER) DIR_COUNT = I + 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - I = I + 1 - END DO - IF (IER1.EQ.0.AND.NUM.GT.PAGE_LENGTH-7) NUM = PAGE_LENGTH - 7 - IF (IER1.NE.0.AND.NUM.LT.PAGE_LENGTH-5.AND. - & SBULL.GT.F_START) THEN - I = SBULL - 1 - NEXT = .FALSE. - DO WHILE (NUM.LT.PAGE_LENGTH-5.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - DIR_COUNT = I - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - I = I - 1 - END DO - NEXT = .TRUE. - END IF - SBULL = DIR_COUNT - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE. - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1 - END IF - IF ((REMOTE_SET.EQ.4.OR.KILL).AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULL - NEXT = .FALSE. - NUM1 = 0 - EBULL = 0 - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I.EQ.NBULL) IER1 = 1 - IF (I+1.EQ.IER) THEN - IF (EBULL.EQ.0) EBULL = I - NUM = NUM - 1 - NUM1 = NUM1 + 1 - SBULL = I - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - IF (NUM.GT.0) I = I - 1 - END DO - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - NEXT = .TRUE. - NUM = NUM1 - IF (NUM.LE.PAGE_LENGTH-7) THEN - IF (IER1.EQ.0.AND.I.LE.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) THEN - NUM = NUM + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7 - ELSE IF (IER1.NE.0.AND.I.GT.F_START) THEN - I = F_START - 1 - J = 0 - DO WHILE (J.LT.3.AND.I.LT.NBULL) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) THEN - J = J + 1 - IF (BTEST(SYSTEM,8)) THEN - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(-I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - ELSE - CALL WRITE_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D, - & %DESCR(I)) - NEXCLUDE = NEXCLUDE + 1 - END IF - END DO - IF (MSG_NUM.GE.SBULL) THEN - NUM = NUM + 2 - SBULL = F_START - END IF - END IF - END IF - EBULL = SBULL + NUM - 1 - END IF - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IER - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IF - ELSE - IER = 0 - END IF - ELSE - IER = 1 - END IF - END DO - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNT - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IF - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = MSG_NUM-1 - ELSE - CALL DECREMENT_MSG_KEY - END IF - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.OUTPUT.OR.OUT.EQ.3) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - ELSE IF ((.NOT.REMOTE_SET.OR.KILL).AND..NOT.READ_TAG) THEN - IF (REMOTE_SET.EQ.3) NEWGROUP = .TRUE. - EXCLUDE_D = EXCLUDE_D1 - SEXC = NBULL + 1 - LEXC = 0 - DO I=1,NEXCLUDE - CALL READ_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(J)) - IF (J.LT.SEXC) SEXC = J - IF (J.GT.LEXC) LEXC = J - END DO - I1 = SBULL - I = SBULL - DO WHILE (I.LE.EBULL) - EXCLUDE_D = EXCLUDE_D1 - J = 0 - IER = I1 - IF (I1.GE.SEXC.AND.I1.LE.LEXC) THEN - N = NEXCLUDE - DO WHILE (N.GT.0.AND.J.EQ.0) - CALL READ_QUEUE(%VAL(EXCLUDE_D),EXCLUDE_D,%DESCR(J)) - N = N - 1 - IF (J.NE.I1.AND.J.NE.-I1) J = 0 - END DO - IF (J.LE.0) THEN - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(I1,IER) - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - IF (J.LT.0) SYSTEM = IBSET(SYSTEM,8) - END IF - ELSE - CALL READDIR(I1,IER) - END IF - IF (KILL.AND.I1.EQ.NBULL) IER1 = 1 - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - I = I + 1 - ELSE IF (I1.GE.NBULL) THEN - EBULL = I - 1 - END IF - I1 = I1 + 1 - END DO - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE) - IF (I.EQ.0.AND.IER1.EQ.0) THEN - EBULL = EBULL - SBULL + DIR_COUNT - SBULL = DIR_COUNT - I = SBULL - END IF - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0 - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY) - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY, - & TAG_TYPE) - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE - IER1 = 1 - ELSE - EBULL = EBULL_SAVE - END IF - END IF - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - END IF - ELSE - NBULL = 0 - END IF - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN - CALL CLOSE_BULLDIR ! We don't need file anymore - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN - DIR_TYPE = 'seen' - END IF - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - IF (INCMD(:3).EQ.'DIR'.AND.ANY_SEARCH) THEN - IF (.NOT.CLI$PRESENT('START').AND. - & .NOT.CLI$PRESENT('CONT')) THEN - WRITE (6,'('' No matches found starting search'', - & '' from message number '',I)') SBULL - DIR_COUNT = -1 - GO TO 9999 - END IF - END IF - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF - -C -C Directory entries are now in queue. Output queue entries to screen. -C - - IF (NFOLDER.EQ.0) CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT) - - TAG = (BULL_TAG.AND.(REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1)).OR. - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IF - END DO - END IF - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THEN - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN - START_SEARCH = BULL_POINT - END IF -200 CLOSED = .FALSE. - IF (ANY_SEARCH.OR.OUTPUT) THEN - NUM = 0 - IF (NFOLDER.NE.-1000) THEN - CLOSED = .TRUE. - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - END IF - CLOSED_FILES = .FALSE. - SEARCH_NUM = 1 - REVERSE = .FALSE. - END IF - DO WHILE (I.LE.EBULL.AND.FOUND.GT.-3) - IF (.NOT.ANY_SEARCH) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - ELSE - IF (NFOLDER.NE.-1000.AND.I.GE.SBULL) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SLEN,0, - & START_SEARCH,REVERSE,SUBJECT,REPLY_FIRST,.FALSE., - & .TRUE.,FROM_SEARCH,NEGATED,.FALSE.) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - END IF - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THEN - IF (NFOLDER.LT.0.AND.(I.EQ.F_START.OR.I.EQ.DIR_COUNT)) THEN - IF (FEEDBACK) CALL LIB$ERASE_PAGE(1,1) - CALL DIRECTORY_HEADER - & (OUTLINE,PRINTING,EXTRACTING,EXPIRATION,OUT) - DIR_COUNT = 0 - BULL_POINT = MSG_NUM - 1 - PRINT_HEADER = .TRUE. - END IF - SEARCH_STRING = ' ' - START_SEARCH = FOUND - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - NEXT = .FALSE. - CALL READDIR(FOUND,IER) - NEXT = .TRUE. - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - TAG_TYPE = DUMMY - END IF - IF (NFOLDER.LT.0.AND..NOT.OUTPUT) THEN - NUM = NUM + 1 - IF (NUM.EQ.PAGE_LENGTH-6) I = EBULL + 1 - END IF - ELSE IF (NFOLDER.LT.0.AND.(OUTPUT.OR.I.LE.SBULL)) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSED = .FALSE. - END IF - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - CALL CLOSE_BULLFOLDER - IF (GFOUND) THEN - START_BULL = 0 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - IF (F1_START.GT.0.AND.F1_START.LE.F1_NBULL) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - START_SEARCH = F_START - 1 - IF (IER.AND.(NEW.OR.SINCE)) THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_NEW_OR_SINCE(NEW,SINCE,IER1,DATETIME) - CALL CLOSE_BULLDIR - IF (IER1.NE.0) THEN - START_SEARCH = IER1 - 1 - ELSE - IER = 0 - END IF - END IF - END IF - IF (.NOT.IER.OR.F1_START.EQ.0.OR. - & F1_START.GT.F1_NBULL) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER, - & IER) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - GFOUND = .FALSE. - IF (FLAG.EQ.1) CALL CLOSE_BULLFOLDER - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - SBULL = F_START - I = SBULL - 1 - EBULL = F_NBULL - END IF - ELSE - NFOLDER = 0 - END IF - END DO - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - ELSE IF (NFOLDER.EQ.0) THEN - WRITE (6,'('' No messages found.'')') - END IF - IF (NFOLDER.EQ.0) I = EBULL + 1 - IF (NFOLDER.LT.-1000) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.OUTPUT) CALL OPEN_BULLFIL_SHARED - CLOSED = .TRUE. - END IF - NFOLDER1 = NFOLDER - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - I = EBULL + 1 - END IF - CALL CANCEL_CTRLC_AST - ELSE - I = EBULL + 1 - END IF - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.GE.SBULL.AND.I.LE.EBULL.AND.NFOLDER.NE.-1000) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN - OUTLINE = '>' - ELSE IF (BTEST(SYSTEM,8)) THEN - OUTLINE = '#' - ELSE - OUTLINE = ' ' - END IF - IF (BTEST(SYSTEM,29)) THEN - OUTLINE(2:) = '*' - ELSE - OUTLINE(2:) = ' ' - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3) - IF (EXDATE(8:12).LT.'1994'.AND.REMOTE_SET.NE.3) THEN - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & '(DELETED)' - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin? - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin? - EXPIRES = 'Permanent' - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11) - END IF - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & EXPIRES(:9) - ELSE - WRITE(OUTLINE(3:),2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11) - END IF - NOTHING = .FALSE. - IF (OUT.EQ.6) THEN - WRITE(OUT,'(1X,A)') OUTLINE - ELSE - WRITE(OUT,'(A)') OUTLINE - END IF - IF (OUTPUT) THEN - FOUND_MSG = .TRUE. - CALL SYS$SETAST(%VAL(0)) - NEXT = .FALSE. - IF (PRINTING) THEN - CALL PRINT(MSG_NUM,CLOSED_FILES) - ELSE - CALL FILE(MSG_NUM,CLOSED_FILES,PRINT_HEADER) - PRINT_HEADER = .FALSE. - IF (MSG_NUM.GT.0) THEN - I = EBULL - FOUND = 0 - ELSE - MSG_NUM = -MSG_NUM - END IF - END IF - NEXT = .TRUE. - CALL SYS$SETAST(%VAL(1)) - END IF - END IF - I = I + 1 - IF (ANY_SEARCH) IER = SYS$CANTIM(,) - END DO - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.OUTPUT) THEN - IF (CLOSED) THEN - IF (SEARCH.OR.OUTPUT) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THEN - DIR_COUNT = FOUND + 1 - ELSE - DIR_COUNT = NBULL + 1 - END IF - END IF - END IF - - IF (DIR_COUNT.GT.NBULL - & .OR.((READ_TAG.OR.KILL).AND.IER1.NE.0)) THEN - ! Outputted all entries? - IF (PRINTING) THEN - IF (CLI$PRESENT('NOW').AND.FOUND_MSG) THEN - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IF - ELSE IF (EXTRACTING.AND.FOUND_MSG) THEN - CALL FILE(0,CLOSED_FILES,.FALSE.) - END IF - IF (NFOLDER.LT.0) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE - DIR_COUNT = -1 ! Yes. Set counter to -1. - END IF - ELSE IF (NFOLDER.NE.0.OR.(-NFOLDER1.EQ.FOLDER_NUMBER.AND. - & INCMD(:1).EQ.' ')) THEN - IF (FLAG.EQ.1) WRITE(6,1020) - ELSE IF (FLAG.NE.1) THEN - WRITE(6,1010) ! Else say there are more - END IF - -9999 POSTTIME = .FALSE. - NEXT = .FALSE. - DIRMODE = .FALSE. - IF (NFOLDER.NE.0.OR.-NFOLDER1.EQ.FOLDER_NUMBER) THEN - DIR_COUNT1 = DIR_COUNT - IF (DIR_COUNT1.GT.NBULL) DIR_COUNT1 = -1 - END IF - IF (OUT.EQ.3) CLOSE (UNIT=3) - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(1X,/,' Press RETURN for more...',/) -1020 FORMAT(1X,/,' Press RETURN for more, type SEARCH to read ', - & 'these messages.',/) -1040 FORMAT(' Output being written to ',A,'.') - -2010 FORMAT(I,1X,A<54-N>,1X,A12,1X,A9) - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z) - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES - - INQUIRE(UNIT=1,OPENED=IER) - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURN - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I) - END DO - - RETURN - END - - - - SUBROUTINE FILE(FILE_NUM,OPEN_IT,PRINT_HEADER) -C -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER*128 FILENAME - - DATA OPENED /.FALSE./ - - IF (CAPTIVE(1)) THEN - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IF - -10 IF (FILE_NUM.EQ.0) THEN - IF (.NOT.OPEN_IT) THEN - OPENED = .FALSE. - CLOSE (UNIT=3) - RETURN - END IF - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - RETURN - END IF - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - OPENED = .FALSE. - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = FILE_NUM - EBULL = SBULL - END IF - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('EXTRACT',FILENAME,LEN_F) - - IF (.NOT.IER) THEN - FILENAME = FOLDER - DO I=1,LEN(FILENAME) - IF (FILENAME(I:I).EQ.'.') FILENAME(I:I) = '_' - END DO - FILENAME = FILENAME(:TRIM(FILENAME))//'.TXT' - LEN_F = TRIM(FILENAME) - END IF - - IF (TRIM(FILE_DIRECTORY).GT.0.AND.INDEX(FILENAME,':').EQ.0 - & .AND.INDEX(FILENAME,'[').EQ.0) THEN - FILENAME = FILE_DIRECTORY(:TRIM(FILE_DIRECTORY))//FILENAME - LEN_F = TRIM(FILENAME) - END IF - - CALL STR$UPCASE(FILENAME,FILENAME) - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH, - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IF - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - HEAD = CLI$PRESENT('HEADER') - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IF - OPENED = .TRUE. - FIRST = .TRUE. - END IF - - IF (PRINT_HEADER) THEN - WRITE (3,'(/,''Newsgroup: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1 - IF (FBULL1.GT.SBULL) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') - OPENED = .FALSE. - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(FBULL,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DO - -100 IF (FILE_NUM.GT.0) THEN - FILE_NUM = -FILE_NUM - RETURN - END IF - - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN ! Show name of file created. - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F) - END IF - - GO TO 10 - -900 WRITE(6,1000) FILENAME(:LEN_F) - CALL ENABLE_PRIVS ! Reset BYPASS privileges - RETURN - -1000 FORMAT(' ERROR: Error in opening file ',A,'.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message ',A,' written to ',A) -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A) -1050 FORMAT('Subj: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN) - - CALL LIB$MOVC3(8,IN,OUT) - - RETURN - END - - - - SUBROUTINE LOGIN -C -C SUBROUTINE LOGIN -C -C FUNCTION: Alerts user of new messages upon logging in. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*4 - - DATA CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/ - - DATA FIRST_WRITE/.TRUE./ - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2) - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - FOLDER_NAME = FOLDER - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -C -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -C - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entry - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSE - RETURN ! Don't notify - END IF - END IF - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRY - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR. - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DO - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead users - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THEN - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSE - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IF - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away... - END IF - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM) - END DO - WRITE (9,IOSTAT=IER) USERNAME, - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IF - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM) - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD') - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - CALL EXIT ! If no header, no messages - END IF - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entry -C -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility. -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM) - ! then use read date to compare with latest bulletin date - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM) - END IF - END IF - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER) - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1 - IF (READIT.EQ.1) THEN - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSER - RETURN - END IF - - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - ENTRY LOGIN_FOLDER - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login time - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0 - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0 - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - ELSE - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM) - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IF - END IF - END IF - END IF - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - END IF - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs - END IF - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified? - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time - ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSER - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THEN - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LOGIN_BTIM_NEW) - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IF - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL - END IF - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT)) - GEN_DIR = GEN_DIR1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR. - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1 - IF (IER1.EQ.0) THEN - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1 - END IF - END IF - - IF (REMOTE_SET) THEN - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY) - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTE - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IF - - CALL GET_NODE_NUMBER(NODE_NUMBER1,NODE_AREA1) - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1 - ELSE - ICOUNT = ICOUNT1 - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100 - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - IER = ICOUNT + 1 - ELSE - CALL READDIR(ICOUNT,IER) - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user? - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IF - IGNORE = BTEST(SYSTEM,2).AND.(NODE_AREA.EQ.NODE_AREA1).AND. - & (NODE_NUMBER.AND.NODE_NUMBER1) - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF ((USERNAME.NE.FROM.OR.SYSTEM).AND..NOT.IGNORE) THEN - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THEN - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM) - END IF - IF (DIFF.LT.0) THEN - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IF - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THEN - NSYS = NSYS + 1 - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100 - END IF - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END DO -100 CALL CLOSE_BULLDIR -C -C Review new directory entries. If there are system messages, -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2 - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - ELSE - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - END IF - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep... - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0 - DO J=1,NSYS - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IF - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATE - END DO - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2 - END IF - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1 - WIDTH = PAGE_WIDTH - LEFT = .FALSE. - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT) - I = I + 1 - END IF - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - INREAD = '+' - ELSE IF (WIDTH.EQ.PAGE_WIDTH.OR.LEFT) THEN - PAGE = PAGE + 1 - INREAD = ' ' - END IF - IF (LEFT) THEN - WRITE(6,1050) INREAD(:1)//INPUT(:ILEN) - LEFT = .FALSE. - ILEN = 0 - INREAD = '+' - ELSE IF (ILEN.LE.WIDTH) THEN - WRITE(6,1060) INREAD(:1)//INPUT(:ILEN) - WIDTH = PAGE_WIDTH - ILEN = 0 - ELSE - DO WHILE (WIDTH.GT.0.AND.INPUT(WIDTH:WIDTH).NE.' ') - WIDTH = WIDTH - 1 - END DO - WRITE(6,1060) INREAD(:1)//INPUT(:WIDTH) - INPUT = INPUT(WIDTH+1:) - ILEN = ILEN - WIDTH - DO WHILE (INPUT(:1).EQ.' '.AND.ILEN.GT.0) - ILEN = ILEN - 1 - INPUT = INPUT(2:) - END DO - IF (INPUT(ILEN:ILEN).EQ.' ') THEN - CONTINUE - ELSE IF (ALPHA(INPUT(ILEN:ILEN))) THEN - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 1 - ELSE - INPUT = INPUT(:ILEN)//' ' - ILEN = ILEN + 2 - END IF - WIDTH = PAGE_WIDTH - ILEN - IF (WIDTH.GT.0) THEN - IF (ILEN.GT.0) LEFT = .TRUE. - ELSE - WIDTH = PAGE_WIDTH - END IF - END IF - END IF - END DO - IF (NGEN.EQ.0) THEN - WRITE (6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1 - END IF - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1 - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2 - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+7+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), ! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1 - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025) - PAGE = PAGE + 2 - I = 0 - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD(:1), - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD(:1),INREAD(:1)) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD(:1).EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')') - ELSE - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSE - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0) - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated. - END IF -C -C Instruct users how to read displayed messages if READNEW not selected. -C - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030) - ELSE IF (NGEN.EQ.0) THEN - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - PAGE = PAGE + 1 - ELSE - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1 - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)// - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN) - & //' '//FOLDER_NAME(:FLEN)// - & ' to read these messages.' - END IF - PAGE = PAGE + 1 - END IF - -9999 IF (LOGIN_SWITCH) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*')) -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1050 FORMAT(A,$) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - - - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0 - END IF - - RETURN - END - - - - SUBROUTINE DIRECTORY_HEADER(OUTLINE,PRINTING,EXTRACTING,EXPIRATION, - & OUT) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - CHARACTER*(*) OUTLINE - - IF (REMOTE_SET.GE.3) THEN - WRITE (OUTLINE,'('' ['',I,''-'',I,'']'')') - & F_START,F_NBULL - ELSE - WRITE (OUTLINE,'('' [1-'',I,'']'')') NBULL - END IF - DO WHILE (INDEX(OUTLINE,'- ').GT.0) - I = INDEX(OUTLINE,'- ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,'[ ').GT.0) - I = INDEX(OUTLINE,'[ ') - OUTLINE(I+1:) = OUTLINE(I+2:) - END DO - DO WHILE (INDEX(OUTLINE,' ').LT.TRIM(OUTLINE)) - I = INDEX(OUTLINE,' ') - OUTLINE(I:) = OUTLINE(I+1:) - END DO - OUTLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//OUTLINE - BULL_PARAMETER = ' ' - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1)) THEN - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THEN - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IF - IF (PRINTING) THEN - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - ELSE IF (EXTRACTING) THEN - BULL_PARAMETER = 'EXTRACTING '//BULL_PARAMETER - END IF - - IF (OUT.EQ.6) THEN - WRITE (OUT,'(''+'',A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - ELSE - WRITE (OUT,'(A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & OUTLINE(:TRIM(OUTLINE)) - IF (EXPIRATION) THEN - WRITE(OUT,1005) ' #' - ELSE - WRITE(OUT,1000) ' #' - END IF - END IF - -1000 FORMAT(A,1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(A,1X,'Description',43X,'From',8X,'Expires',/) - - RETURN - END - - - - SUBROUTINE GET_NEW_OR_SINCE(NEW,SINCE,IER,DATETIME) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER TODAY(2) - - CHARACTER DATETIME*24 - - IF (SINCE) THEN ! Was /SINCE specified? - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified? - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - IER = 0 - RETURN - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - END IF - END IF - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bulletin1.for b/decus/vmslt98b/bulletin/bulletin1.for deleted file mode 100644 index 603df02..0000000 --- a/decus/vmslt98b/bulletin/bulletin1.for +++ /dev/null @@ -1,2499 +0,0 @@ -C -C BULLETIN1.FOR, Version 4/8/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - SUBJECT_LINE = INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - SUBJECT_LINE = DESCRIP - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(SUBJECT_LINE) - IF (LEN_D.EQ.0) THEN - SUBJECT_LINE = 'BULLETIN message.' - LEN_D = TRIM(SUBJECT_LINE) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (SUBJECT_LINE(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - SUBJECT_LINE(I:I) = '`' - ELSE - SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_S = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',SENDTO(LEN_S+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_S = LEN_S + I + 1 - SENDTO(LEN_S:LEN_S) = ',' - END DO - LEN_S = LEN_S - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_S) - IF (SENDTO(I:I).EQ.'"') THEN - SENDTO = SENDTO(:I)//'""'//SENDTO(I+1:) - I = I + 2 - LEN_S = LEN_S + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',SENDTO(:LEN_S) - & ,SUBJECT_LINE,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//SENDTO(:LEN_S) -C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) -C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - - CALL ENABLE_PRIVS - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER RESPONSE*32 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - INIT_NEWSFEED = .FALSE. - - NEWSGROUP = .FALSE. - MAILTO = 0 - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - RETURN - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - I = INDEX(FOLDER1_DESCRIP,'<') - J = INDEX(FOLDER1_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'@').LT.1 - & .OR.INDEX(FOLDER1_DESCRIP(I:),'@').GT.J-I+1).AND. - & (INDEX(FOLDER1_DESCRIP(I:),'.') - & .LE.J-I+1.AND.INDEX(FOLDER1_DESCRIP(I:),'.').GT.0)) THEN - NEWSGROUP = .TRUE. - WRITE (6,'('' Init news feed counter to feed '', - & ''all messages in news group (Y),'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'or set to feed only new messages (N,default) ? ') - INIT_NEWSFEED = RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y' - I = INDEX(FOLDER1_DESCRIP,'[') - J = INDEX(FOLDER1_DESCRIP,']') - END IF - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER1_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER1_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'.') - & .GT.J-I+1.OR.INDEX(FOLDER1_DESCRIP(I:),'.').EQ.0) - & .AND.MAILTO.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(RESPONSE) - IF (TRIM(RESPONSE).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//RESPONSE(:TRIM(RESPONSE))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IF - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSE - FOLDER1_OWNER = FOLDER_OWNER - END IF - - CALL OPEN_BULLFOLDER ! Open folder file - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IF - - IF (IER.EQ.0) THEN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IF - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) - END IF - IF (NEWSGROUP) FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - IF (MAILTO.EQ.2) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (MAILTO.EQ.3) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (INIT_NEWSFEED) THEN - F_LAST = 0 - ELSE IF (NEWSGROUP) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - I = INDEX(FOLDER_DESCRIP,'<') + 1 - J = INDEX(FOLDER_DESCRIP,'>') - 1 - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER_DESCRIP(I:J),IER) - CALL CLOSE_BULLNEWS - CALL OPEN_BULLFOLDER - F_LAST = F1_NBULL - END IF - CALL WRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF - - RETURN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL) -C -C SUBROUTINE MOVE -C -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /FEED/ FEED - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256,TODAY*24 - CHARACTER SCRFILE*18 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep'' - & ,'' original owner.'')') - RETURN - END IF - - ALL = CLI$PRESENT('ALL') - - MERGE = CLI$PRESENT('MERGE') - - SAVE_BULL_POINT = BULL_POINT - - FROM_REMOTE = REMOTE_SET - CALL CLI$GET_VALUE('FOLDER',FOLDER1) - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - TO_NEWS = TEST_NEWS(FOLDER1) - IF (.NOT.BULLCP_NEWS.AND.FOLDER.EQ.FOLDER1) THEN - WRITE (6,'('' ERROR: Destination cannot be same as'', - & '' current location.'')') - RETURN - END IF - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no message has been read - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - BULL_POINT = SAVE_BULL_POINT - RETURN - END IF - - NUM_COPY = 1 - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURN - ELSE - NUM_COPY = EBULL - SBULL + 1 - BULL_POINT = SBULL - END IF - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull - NEXT = .TRUE. ! If SBULL does not exist, will find - ELSE ! next message after SBULL - SBULL1 = SBULL - CALL READDIR(SBULL,IER) - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - ELSE IF (ALL) THEN - NUM_COPY = NBULL - BULL_POINT = 1 - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IF - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR', - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THEN - OPEN (UNIT=11,FILE='REMOTE.BULLFIL', - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - ELSE - REWIND (12,IOSTAT=IER) - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE. - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1 - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1 - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0 - END IF - IF (LENGTH.EQ.0) IER1 = 1 ! Don't allow empty messages - IF (IER1.EQ.0) THEN - SCRATCH_R = SCRATCH_R1 - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128)) - ELSE - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IF - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DO - END IF - NEWS2BULL = NEWS2BULL.AND..NOT.TO_NEWS.AND.ORIGINAL - IF (IER1.EQ.0.AND..NOT.NEWS2BULL) THEN - BLOCK = NBLOCK - NBLOCK = NBLOCK + LENGTH - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THEN - I = IER - ELSE IF (.NOT.NEWS2BULL) THEN - NUM_COPY = NUM_COPY + 1 - END IF - NEWS2BULL = .FALSE. - END IF - END DO - CALL CLOSE_BULLFIL - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDER - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER - FROM_BULL_POINT = BULL_POINT - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (REMOTE_SET.EQ.4.AND..NOT.BULLCP_NEWS).OR.REMOTE_SET.EQ.3 - - POST_FEED = .FALSE. - SLIST = 0 - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')') - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST:INDEX(FOLDER_DESCRIP,'>')-1) - POST_FEED = .TRUE. - END IF - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') + 1 - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 - END IF - IF (SLIST.GT.1) THEN - IF (NEWS_FEED()) THEN - ELIST = INDEX(FOLDER_DESCRIP,']') - 1 - ELSE - ELIST = INDEX(FOLDER_DESCRIP,'>') - 1 - END IF - END IF - IF (CLI$PRESENT('LOCAL').AND..NOT.BULLCP_NEWS) SLIST = 0 - END IF - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - RETURN - END IF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS.OR.(POST_FEED.AND.SLIST.LE.1)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - END IF - IF (.NOT.POST_NEWS) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - CALL GET_EXDATE(EXDATE,EX) - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //SAVE_FOLDER - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DO - END IF - ELSE - IER= 0 - END IF - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE - HEADER = .FALSE. - END IF - END IF - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THEN - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=FROM_BULL_POINT-1,IOSTAT=IER) - END IF - END IF - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF ((FROM_REMOTE.OR.FROM_REMOTE.EQ.4).AND. - & (TO_NEWS.AND.ORIGINAL)) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN_FOLDER - - IF (REMOTE_SET.GE.3) SYSTEM = 0 - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0 - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message - EXDATE = '5-NOV-2100' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN - LIMIT = NEWS_F_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THEN - CALL GET_EXDATE(EXDATE,LIMIT) - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM) - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0 - GO TO 100 - END IF - ELSE - IF (FOLDER_BBEXPIRE.GT.0) THEN - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN - IER = 0 - GO TO 100 - END IF - END IF - CALL GET_EXDATE(EXDATE,EX) - END IF - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - EXTIME = TODAY(13:) - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message? - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'', - & '' shutdown message.'')') - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIRE - ELSE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 - END IF - EXTIME = '00:00:00.00' - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'', - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1) - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) - EXTIME = '00:00:00.00' - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (SLIST.GT.1.OR.POST_NEWS.OR.POST_FEED) THEN - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - IF (SLIST.GT.1) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'SYS$LOGIN:BULL.SCR' - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE='BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') - SCRFILE = 'BULL.SCR' - END IF - ENDIF - ILEN = LINE_LENGTH + 1 - - INFROM = FROM - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN) - ELSE - POST_SUBJECT = DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) - END DO - - REWIND (UNIT=3) - - IF (POST_NEWS.OR.POST_FEED) THEN - USE_INFROM = ORIGINAL - IF (CLI$PRESENT('LOCAL')) NEWS2BULL = .TRUE. - CALL NEWS_POST - & (SCRFILE(:TRIM(SCRFILE)),.TRUE.,IER,POST_SUBJECT) - NEWS2BULL = .FALSE. - END IF - IF (SLIST.GT.1) THEN - CLOSE (UNIT=3) - USE_INFROM = ORIGINAL - IF (BTEST(FOLDER_FLAG,10).OR.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - ELSE - CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), - & FOLDER_DESCRIP(SLIST:ELIST), - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) - END IF - CALL LIB$DELETE_FILE(SCRFILE(:TRIM(SCRFILE))//';') - ELSE IF (POST_FEED.OR.POST_NEWS) THEN - REWIND (UNIT=3) - END IF - BLOCK = BLOCK_SAVE - LENGTH = LENGTH_SAVE - END IF - IF (.NOT.POST_NEWS) THEN - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE - - IF (IER.EQ.0) THEN - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1 - END DO - END IF - - IF (IER.EQ.0) THEN - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSE - IF (.NOT.ORIGINAL) SYSTEM = IBSET(SYSTEM,4) - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUE - END DO - - IF (SLIST.LT.1.AND.POST_NEWS.OR.POST_FEED) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IF - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS - & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder info -C -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IF - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add - - IF (IER.EQ.0) THEN - IF (TEST_BULLCP().NE.2) - & WRITE (6,'('' Successful copy to folder '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THEN - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSE - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADER - IF (BULLCP_NEWS) RETURN - - IF (INDEX(INCMD,' ').EQ.TRIM(INCMD)+1) - & INCMD = INCMD(:TRIM(INCMD))//' '//FOLDER1 - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1) - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN - IF (FROM_REMOTE.AND.ALL) THEN - WRITE (6,'('' WARNING: Original messages not deleted.'')') - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')') - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IF - - RETURN - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C -C SUBROUTINE PRINT -C -C FUNCTION: Print header to queue. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*32 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./ - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND. - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0 - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN) - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0) - IF (CHANGED) THEN - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IF - - IF (INCMD(:4).EQ.'PRIN') THEN - IF (CLI$PRESENT('CANCEL')) THEN - WRITE (6,'('' Cancelling all previously queued messages.'')') - CLOSE (UNIT=24,DISPOSE='DELETE') - FIRST = .TRUE. - RETURN - END IF - END IF - -50 IF (PRINT_NUM.EQ.0) THEN - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN - END IF - ELSE - SBULL = PRINT_NUM - EBULL = SBULL - END IF - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name - IF (QLEN.EQ.0) THEN - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE) - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - CALL ENABLE_PRIVS - END IF - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IF - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100 - CLOSE (UNIT=24,DISPOSE='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - RETURN - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1) - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER1) - END IF - IF (IER1.NE.0) GO TO 100 - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) THEN - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - END IF - -1040 FORMAT(' Message ',A,' sent to printer.') -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURN - - FIRST = .TRUE. - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE)) - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) - END IF - - CALL DISABLE_PRIVS - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A, - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE. - GO TO 50 - END IF - - RETURN - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER) - RETURN - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C -C SUBROUTINE READ_MSG -C -C FUNCTION: Reads a specified bulletin. -C -C PARAMETER: -C READ_COUNT - Variable to store the record in the message file -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADER - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /POST/ POSTTIME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /THREAD/ THREAD - DATA THREAD /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/,LAST_THREAD/.FALSE./ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH) - CHARACTER HEADLINE*132 - - LOGICAL SINCE,PAGE - - EXTERNAL CLI$_NEGATED - - FIRST = BULL_READ.LT.F_START - KILL = BTEST(BULL_USER_CUSTOM,3) - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3) - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screen - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THEN - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE. - END IF - ROTC = CLI$PRESENT('ROTATE') - END IF - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - THREAD = .FALSE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - THREAD = CLI$PRESENT('THREADS') - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2) - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSE - BULL_READ = 1 - END IF - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE').AND. - & .NOT.THREAD) THEN ! was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY) - ELSE - CALL SYS_BINTIM(DATETIME,MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSE IF (CLI$PRESENT('NEW').OR.(THREAD.AND..NOT. - & CLI$PRESENT('SINCE').AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND.(.NOT.LAST_THREAD - & .OR.LAST_THREAD_NUMBER.NE.FOLDER_NUMBER) - & .AND.CLI$PRESENT('NEW').NE.%LOC(CLI$_NEGATED))) THEN - NEW = .TRUE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - END IF - CALL OPEN_BULLDIR_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READDIR_KEYGE(IER) - IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) - IF (IER1.EQ.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_BTIM) - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY) - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - CALL CLOSE_BULLDIR - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - IER = 0 - END IF - END DO - CALL CLOSE_BULLDIR - ELSE - IER = 0 - SKIPPED_THREAD = .FALSE. - IF (THREAD) CALL OPEN_BULLDIR_SHARED - DO WHILE (IER.EQ.0) - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - BULL_READ = IER - END IF - IF ((SKIPPED_THREAD.OR.(THREAD.AND.IER.NE.0)).AND. - & BULL_READ.LE.F_NBULL) THEN - CALL READDIR(BULL_READ,IER) - IER = IER - 1 - IF (IER.NE.BULL_READ) IER = 0 - END IF - IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - MSG_NUM = IER - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,DUMMY,DUMMY) - IF (IER1.EQ.0) THEN - IF (.NOT.SKIPPED_THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(IER) - ELSE - BULL_READ = BULL_READ + 1 - END IF - IER = 0 - END IF - ELSE IF (IER.EQ.0) THEN - WRITE (6,'('' No more messages are present.'')') - IF (SKIPPED_THREAD) CALL CLOSE_BULLDIR - GO TO 9999 - END IF - IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN - SKIPPED_THREAD = .TRUE. - BULL_READ = IER + 1 - IER = 0 - END IF - END DO - END IF - IF (THREAD) CALL CLOSE_BULLDIR - BULL_READ = IER - IER = IER + 1 - ELSE IF (THREAD) THEN - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999 - ELSE - BULL_READ = IER - 1 - IER = IER + 1 - END IF - SINCE = .TRUE. - ELSE IF (CLI$PRESENT('BULLETIN_NUMBER')) THEN - BULL_READ = BULL_READ - 1 - ELSE IF (LAST_THREAD_NUMBER.EQ.FOLDER_NUMBER) THEN - BULL_READ = LAST_THREAD_READ - ELSE - BULL_READ = BULL_POINT - 1 - END IF - CALL OPEN_BULLDIR_SHARED - IER = BULL_READ + 1 - IER1 = .FALSE. - DO WHILE (.NOT.IER1.AND.IER.EQ.BULL_READ+1.AND. - & BULL_READ.LT.F_NBULL) - BULL_READ = BULL_READ + 1 - CALL READDIR(BULL_READ,IER) - IER1 = BTEST(SYSTEM,8) - IF (IER1.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER2,DUMMY,DUMMY) - IER1 = IER2.NE.0 - END IF - END DO - IF (.NOT.IER1) THEN - WRITE (6,'('' No more messages are present.'')') - GO TO 9999 - END IF - END IF - END IF - - NEXT = .FALSE. - LAST_THREAD = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ') THEN - LAST_THREAD = THREAD - IF (THREAD) THEN - LAST_THREAD_READ = BULL_READ - LAST_THREAD_NUMBER = FOLDER_NUMBER - ELSE - IF (.NOT.SINCE.AND..NOT.NEW - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. - END IF - END IF - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THEN - IER = 0 - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR. - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN - MSG_NUM = F_NBULL+1 - ELSE - MSG_NUM = BULL_NOW - END IF - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHARED - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER) - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE - CALL GET_THIS_OR_NEXT_TAG - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) BULL_NOW = 0 - END IF - END IF - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END IF - DO WHILE (IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - END DO - CALL CLOSE_BULLDIR - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1 - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READ - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSE - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSE - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0 - END IF - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IF - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSE - IER = 0 - END IF - END IF - END IF - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THEN - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE. - CALL READDIR(BULL_READ,IER) - END IF - END IF - IF (REMOTE_SET.LT.3.AND. - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN - READ_COUNT = 0 - IF (IER.NE.BULL_READ+1) THEN - CALL READDIR(0,IER) - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IF - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0 - END IF - CALL CLOSE_BULLDIR - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) ! If not, then error out - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - - SAVE_BULL_POINT = BULL_POINT - BULL_POINT = BULL_READ ! Update bulletin counter - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED - - IF (BTEST(BULL_USER_CUSTOM,1) - & .AND.(FIRST.OR.NEW.OR.NEXT.OR.INCMD(:4).EQ.'BACK'.OR. - & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEN - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - OK = OK.AND.(.NOT.THREAD.OR.BTEST(SYSTEM,8)) - - IF (.NOT.OK) THEN - BULL_POINT = SAVE_BULL_POINT - BULL_NOW = MSG_NUM - IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN - BULL_READ = MSG_NUM - 1 - ELSE - BULL_READ = MSG_NUM + 1 - IF (INCMD(:4).EQ.'FIRS'.OR.FIRST) NEXT = .TRUE. - END IF - IF (REMOTE_SET) CALL CLOSE_BULLFIL - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - ELSE IF (.NOT.THREAD) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_NOW) - END IF - IF (BULL_READ.GT.F_NBULL.OR.BULL_READ.LT.F_START) THEN - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.REMOTE_SET) CALL CLOSE_BULLFIL - GO TO 9999 - END IF - GO TO 50 - END IF - BLOCK = BLOCK_SAVE - END IF - - NEXT = .FALSE. - IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - END IF - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2) - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - ELSE - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - IF (.NOT.THREAD.OR.INCMD(:4).NE.'READ') THEN - IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.BULL_READ) - & CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - END IF - END IF - END IF - - EDIT = .FALSE. - - PAGE_WIDTH = REAL_PAGE_WIDTH - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN - IF (CLI$PRESENT('EDIT')) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 9999 - END IF - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTH - PAGE = .FALSE. - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSE - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL - END IF - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:) - END DO - I = TRIM(HEADLINE) - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN) - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)) - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE)) - END IF - - END = 1 ! Outputted 1 line to screen - - IF (EXDATE(8:11).LT.'1995') THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - ELSE - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IF - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ' - & .AND..NOT.BTEST(SYSTEM,4)) THEN - INPUT = 'From: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1 - ELSE - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROM - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1 - END IF - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:) - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSE - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1 - IF (EDIT) WRITE(3,'(1X)') - ELSE - END = END + 1 - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - IF (LINE_OFFSET.EQ.1) THEN - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IF - END IF - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)') - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue. -C - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSE - READ_COUNT = BLOCK ! Init bulletin record counter - END IF - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE. - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1 - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSE - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - END IF - ELSE - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0 - ELSE - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF - END IF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE. - END IF - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file read - - IF (EDIT) THEN - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counter - GO TO 9999 - END IF - -C -C Bulletin page is now in temporary memory, so output to terminal. -C Note that if this is a /READ, the first line will have problems with -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at the -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -C - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DO - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counter - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read? - IF (ILEN.GT.0) THEN ! Yes, there are still more - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IF - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - -9999 POSTTIME = .FALSE. - IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - RETURN - -1030 FORMAT(' No more messages.') -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO - - RETURN - END - - - - - - - SUBROUTINE READNEW(REDO) -C -C SUBROUTINE READNEW -C -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 - CHARACTER INREAD*1 - EQUIVALENCE (INREAD4,INREAD) - - DATA LEN_FILE_DEF /0/, INREAD/0/ - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there is - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletins - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THEN - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)') - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DO - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DO - CALL EXIT - ELSE - WRITE (6,'(''+o'',$)') - END IF - RETURN ! If NO, exit - ! Include QUIT to be consistent with next question - ELSE - CALL LIB$ERASE_PAGE(1,1) - END IF - END IF - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')') - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1 - END IF - END IF - - READ_COUNT = 0 ! Initialize display pointer - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - BULL_POINT_READ = BULL_POINT - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10 - END IF - CALL CLOSE_BULLDIR - END IF - - GO TO 12 - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF - - BULL_POINT = BULL_POINT_SAVE - LENGTH = LENGTH_SAVE - BLOCK = BLOCK_SAVE - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSE - WRITE(6,1030) - END IF - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case - - BLOCK_SAVE = BLOCK - LENGTH_SAVE = LENGTH - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE. - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN - ! If F then copy bulletin to file - WRITE (6,'(''+ '')') ! Move cursor from end of prompt line - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THEN - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' - LEN_FILE_DEF = ILEN + 5 - ELSE - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER) - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEF - END IF - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL FILE(0,.TRUE.,.FALSE.) - GO TO 11 - ELSE IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR. - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)') - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THEN - WRITE (6,'(''+U'',$)') - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THEN - WRITE (6,'(''+B'',$)') - INCMD = 'RESPOND/LIST' - ELSE - GO TO 11 - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')') - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLY - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit - WRITE(6,1010) - RETURN - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THEN - WRITE (6,'(''+Read'')') - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN - WRITE(6,1010) - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message', - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.') -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),', - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) -1040 FORMAT(' Type P to post reply, U to reply to user,', - & ' B to do both, or other to quit: ',$) - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -C -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER EXPIRE*3 - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')') - ELSE - FOLDER_BBEXPIRE = TEMP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to set expiration.'')') - END IF - - RETURN - END - - - - - LOGICAL FUNCTION NEWS_FEED() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - I = SLIST + 1 - FLEN = TRIM(FOLDER_DESCRIP) - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN - IF (INDEX(FOLDER_DESCRIP(SLIST:I),'.').GT.0) - & NEWS_FEED = .TRUE. - RETURN - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND. - & FOLDER_DESCRIP(I:I).NE.'@'.AND. - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSE - I = FLEN + 2 - END IF - END DO - END IF - - RETURN - END - - - - - LOGICAL FUNCTION MAIL_POST() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NEWS_FEED()) THEN - MAIL_POST = INDEX(FOLDER_DESCRIP,'[').GT.0 - ELSE - MAIL_POST = INDEX(FOLDER_DESCRIP,'<').GT.0 - END IF - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bulletin10.for b/decus/vmslt98b/bulletin/bulletin10.for deleted file mode 100644 index c2de028..0000000 --- a/decus/vmslt98b/bulletin/bulletin10.for +++ /dev/null @@ -1,4120 +0,0 @@ -C -C BULLETIN10.FOR, Version 2/27/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - COMMON /HEADER_SEEN/ HEADER_SEEN - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (NEWS_READ.GT.0) - LAST_LF_SEEN = LF_SEEN - LAST_REAL_LF_SEEN = REAL_LF_SEEN - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - CR_SEEN = INDEX(BUFFER(START_READ:END_READ),CR) - IF (CR_SEEN.GT.0) THEN - IF (END_LINE.GT.0) THEN - IF (CR_SEEN.EQ.END_LINE-2.AND.BUFFER(START_READ+CR_SEEN: - & START_READ+CR_SEEN).EQ.CR) CR_SEEN = CR_SEEN + 1 - ELSE - IF (START_READ+CR_SEEN.EQ.END_READ.AND. - & BUFFER(END_READ:END_READ).EQ.CR) CR_SEEN = 0 - END IF - END IF - IF ((END_LINE.EQ.0.AND.CR_SEEN+START_READ-1.LT.END_READ.AND. - & CR_SEEN.GT.0).OR.CR_SEEN.LT.END_LINE-1) THEN - END_LINE = CR_SEEN - CR_SEEN = 1 - ELSE - CR_SEEN = 0 - END IF - LF_SEEN = END_LINE.GT.0 - IF (END_LINE.GT.257-CR_SEEN.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - IF (.NOT.HEADER_SEEN) END_LINE = 254 - END IF - REAL_LF_SEEN = INDEX(BUFFER(START_READ:END_READ),LF).LE.END_LINE - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - IF (BUFFER(EB:EB).EQ.LF) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - IF (EB.GT.0.OR.LAST_LF_SEEN) RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE(:MIN(LEN(WRITE),256)) - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - NEWS_WRITE = NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - - LOGICAL FUNCTION NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - NEWS_RECONNECT = .FALSE. - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - NEWS_RECONNECT = .TRUE. - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /HEADER/ HEADER - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER().OR.SETPRV_PRIV()) THEN - IF (REMOTE_SET.EQ.4) THEN - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (INPUT(:11).EQ.'Message-ID:') THEN - MESSAGE_ID = INPUT(14:ILEN-1) - ILEN = 0 - END IF - END DO - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - CALL NEWS_POST('cancel',0,IER,SUBJ) - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - STAT = .TRUE. - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - STAT = .FALSE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') - & +SB-2),START,,%VAL(1))) RETURN - END IF - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) THEN - IF (END.GE.F_NBULL) RETURN - START = MIN(F_NBULL,END+1) - ELSE - START = MAX(F_START,START-NUMDIR) - END IF - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - STAT = .TRUE. - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1) THEN - IF (.NOT.NEWS_WRITE - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN - ELSE - IF (.NOT.NEWS_WRITE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - END IF - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - QXHDR = QXHDR1 - IF (.NOT.NEWS_READ()) RETURN - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - DO WHILE (BUFFER(SB:EB).NE.'.'.AND. - & .NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX( - & BUFFER(SB:EB),' ')+SB-2),J,,%VAL(1))) - IF (.NOT.NEWS_READ()) RETURN - END DO - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 - TEMP(I*256+1:) = BUFFER(SB1:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO - END IF - END DO - QXHDR = QXHDR1 - IER = 0 - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - STAT = .TRUE. - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IF - - IF (IER.EQ.0) THEN - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DO J=257,512 - IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126) - & TEMP(J:J) = ' ' - END DO - DESCRIP = TEMP(257:512) - CALL GET_FROM(FROM,TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - END IF - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1 - IF (STAT) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IER = 0 - END IF - - RETURN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - LOGICAL NEWS_CONNECTED /.FALSE./ - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER() - NEWS_CONNECTED = NEWS_CONNECT() - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN - IF (.NOT.NEWS_WRITE('mode reader')) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - IF (.NOT.NEWS_WRITE('XHDR')) RETURN - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - HEADER_SEEN = .FALSE. - LF_SEEN = .FALSE. - LAST_LF_SEEN = .FALSE. - REAL_LF_SEEN = .FALSE. - LAST_REAL_LF_SEEN = .FALSE. - END IF - - NEWS_LOGIN = .TRUE. - - RETURN - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*8 - DATA HOUR /' '/ - - PARAMETER NZONES = 5 - - COMMON /ZONE/ ZONE,LZONE - CHARACTER*4 ZONE - - CHARACTER ZONES*(NZONES*4) - DATA ZONES /'EST CST MST PST IST'/ - - CHARACTER*8 TIMES(1) - DATA TIMES /'-5:30'/ - - CHARACTER TIME*12 - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM) - - IF (HOUR.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN - IF (INDEX(ZONES,ZONE)/4.LT.4) THEN - HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' - ELSE - HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) - END IF - ELSE - HOUR = '00:00' - END IF - ELSE - HOUR = HOUR(:TRIM(HOUR))//':00' - END IF - ZONE = 'GMT' - IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) - IF (DIFF.GE.5.AND.DIFF.LE.8) THEN -C -C Following computes DST based on US formula -C - IER = SYS$ASCTIM(,TIME,BTIM,) - IER = OTS$CVT_TI_L(TIME(:2),DATE,,%VAL(1)) - CALL LIB$DAY_OF_WEEK(BTIM,DAY) - M = (INDEX(MONTH,TIME(4:6))+2)/3 - IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) - & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN - DIFF = DIFF - 1 - IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) - END IF - END IF - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF - HOUR(3:) = HOUR(INDEX(HOUR,':'):) - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE. - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) - END IF - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IF - - TO_GMT = .FALSE. - - RETURN - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30' - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN - TIMBUF(9:10) = '0'//SEC(:1) - ELSE - TIMBUF(9:10) = SEC - END IF - END IF - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURN - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURN - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - COMMON /NEWS2BULL/ NEWS2BULL - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' ' - SUBJECT_LINE = ' ' - FROM_LINE = ' ' - SENDER_LINE = ' ' - NEWSGROUPS = ' ' - FOLLOWUP = ' ' - LREF = 0 - NEWS2BULL = .FALSE. - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) - LAST_FROM = .FALSE. - - DO WHILE (BUFFER(SB:EB).NE.'.'.OR..NOT.LAST_REAL_LF_SEEN) - IER = NEWS_READ() - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - DO I=SB1,EB - IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126) - & BUFFER(I:I) = ' ' - END DO - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB) - CALL GET_FROM(FROM,BUFFER(SB1:EB),EB-SB1+1) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+6).EQ.'Sender:'.AND.EB.GE.SB+8) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+8:EB))+SB+7 - SENDER_LINE = ': '//BUFFER(SB1:EB) - LAST_FROM = .TRUE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. - & EB.GT.SB+11) THEN - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+11).EQ.'Followup-To:'.AND. - & EB.GT.SB+12) THEN - SB1 = FIRST_ALPHA(BUFFER(SB+13:EB))+SB+12 - FOLLOWUP = BUFFER(SB1:EB) - LAST_FROM = .FALSE. - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = BUFFER(SB+12:EB)//' '// - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES) - LAST_FROM = .FALSE. - ELSE IF (INDEX(BUFFER(SB:), - & 'X-Newsreader: News2bull').EQ.1) THEN - NEWS2BULL = .TRUE. - IF (LPATH.EQ.0) CALL GET_PATHNAME - I = INDEX(BUFFER(SB:),'@') - IF (I.GT.0) THEN - SAMEHOST = STREQ(PATHNAME(2:LPATH),BUFFER(SB+I:EB)) - END IF - ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN - IF (SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = SENDER_LINE(:TRIM(SENDER_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - ELSE - FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// - & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) - CALL GET_FROM(FROM,FROM_LINE(7:),TRIM(FROM_LINE)) - END IF - LAST_FROM = .TRUE. - ELSE - LAST_FROM = .FALSE. - END IF - IF (.NOT.LAST_FROM.AND.SENDER_LINE(:1).EQ.':') THEN - SENDER_LINE = 'From'//SENDER_LINE - END IF - END IF - END DO - - NEWS2BULL = NEWS2BULL.AND.SAMEHOST - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH - ELSE - IER = 2 - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2) - - CHARACTER TIME*20,FIRST*80 - - CHARACTER*8 NUMBER - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THEN - I = NEWS_FIND_SUBSCRIBE() - START = (LAST_NEWS_READ2(2,I).AND.'1FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - START = -1 - CALL NEWNEWS(IN_BTIM,IER) - IF (IER.NE.0) START = IER -C -C The following code makes use of the NNTP command NEWNEWS, but is -C known to be slow and buggy in many servers. -C -C IER = SYS$ASCTIM(,TIME,IN_BTIM,) -C CALL DATE_TIME(TIME) -C SKIP = 0 -C DO WHILE (SKIP.GE.0) -C IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( -C & FOLDER_NAME))//' '//TIME)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C IF (BUFFER(:2).EQ.'23') THEN -C IF (.NOT.NEWS_READ()) CALL EXIT -C DO I=1,SKIP -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (FIRST.EQ.'.') RETURN -C DO WHILE (BUFFER(SB:EB).NE.'.') -C IF (.NOT.NEWS_READ()) CALL EXIT -C END DO -C IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) -C & CALL EXIT -C IF (.NOT.NEWS_READ()) CALL EXIT -C IF (BUFFER(:2).EQ.'22') THEN -C IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN -C I = F_NBULL + 1 -C DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. -C & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) -C & .OR.I.GT.F_NBULL)) -C I = I - 1 -C IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN -C IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN -C IF (.NOT.NEWS_READ()) RETURN -C END DO -C IF (I.GE.F_START) START = I -C ELSE -C IER = OTS$CVT_TI_L(BUFFER(SB+4: -C & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) -C END IF -C RETURN -C END IF -C END IF -C SKIP = SKIP + 1 -C END DO - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2 - IER = IER1 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER) -C -C SUBROUTINE GET_REMOTE_MESSAGE -C -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /HEADER_SEEN/ HEADER_SEEN - COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN - - CHARACTER*256 TEMP - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IF - - ILEN = 128 - IER = 0 - LENGTH = 0 - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THEN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IF - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THEN - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THEN - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILEN - END IF - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0 - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE - IER = NEWS_READ() - IF (IER.AND.(BUFFER(SB:EB).NE.'.' - & .OR..NOT.LAST_REAL_LF_SEEN)) THEN - IER = 0 - LTEMP = EB-SB+1 - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THEN - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF ((INDEX(TEMP,': ').EQ.0.AND. - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255).OR. - & (LTEMP.EQ.254.AND..NOT.LAST_LF_SEEN)) THEN - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IF - ELSE IF (BUFFER(SB:SB).EQ.'.') THEN - TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) - LTEMP = LTEMP - 1 - END IF - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF - ELSE - HEADER_SEEN = .TRUE. - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0 - INPUT = INPUT(:ILEN)//CHAR(0) - ILEN = -128 - ELSE - ILEN = 128 - END IF - END IF - ELSE - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error - IER = 0 - ILEN = 0 - ELSE - CALL SYS_GETMSG(IER1) - LENGTH = 0 - IER1 = IER - CALL DISCONNECT_REMOTE - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ABS(ILEN).EQ.128) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DO - - HEADER_SEEN = .TRUE. - - RETURN - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURN - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -C -C FUNCTION: Connects to folder that is located on other DECNET node. -C - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /READIT/ READIT - - COMMON /NEWS_INIT/ END_READ - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - CHARACTER*64 ALT_SAVE - - DIMENSION DUMMY(4) - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - ALT_SET_SAVE = ALT_SET() - IF (ALT_SET_SAVE) CALL UNSET_ALT - END_READ = 0 - IER = 0 - IF (.NOT.NEWS_LOGIN()) THEN - IER = 2 - IF (.NOT.TEST_ALT(FOLDER1)) RETURN - IER = 1 - END IF - IF (IER.NE.1) CALL NEWS_GROUP(IER) - IF (IER.EQ.1) THEN - IF (TEST_ALT(FOLDER1)) THEN - IER1 = SET_ALT(ALT_FOUND) - IF (IER1) CALL NEWS_GROUP(IER) - IF (.NOT.IER1.OR.IER.NE.0) THEN - CALL UNSET_ALT - IF (ALT_SET_SAVE) IER = SET_ALT(ALT_SAVE) - RETURN - END IF - ALT_SAVE = FOLDER1(INDEX(':',FOLDER1)+1:) - IER = 0 - ELSE IF (ALT_SET_SAVE) THEN - IER = SET_ALT(ALT_SAVE) - END IF - RETURN - END IF - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IF - - REMOTE_UNIT = 31 - REMOTE_UNIT - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1 - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN - IF (.NOT.SAME) THEN - FOLDER1_FILE = FOLDER_FILE - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - REMOTE_SET = REMOTE_SET_SAVE - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' - SYSLOG = .TRUE. - END IF - END IF - IF (.NOT.SYSLOG) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNER - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD - FOLDER_NUMBER_SAVE = FOLDER1_NUMBER - IF (IER.EQ.0) THEN - IF (SYSLOG) THEN - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVE - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - END IF - IER = 2 - ELSE - CLOSE (UNIT=31-REMOTE_UNIT) -C -C If remote folder has returned a last read time for the folder, -C and if in /LOGIN mode, or last selected folder was a different -C folder, or folder specified with "::", then update last read time. -C - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY) - IF (SYSLOG) THEN - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3)) - END IF - END IF - IER = 0 - END IF - - RETURN - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /NEXT/ NEXT - LOGICAL NEXT /.FALSE./ - - COMMON /NEWGROUP/ NEWGROUP - - CHARACTER*8 NUMBER - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF - RETURN - ELSE - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IF - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (ICOUNT.EQ.0) THEN - NBULL = F_NBULL - ICOUNT = 1 - RETURN - ELSE IF (ICOUNT.EQ.-1) THEN - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - IF (BUFFER(:2).NE.'22') THEN - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE. - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IF - END IF - IF (BUFFER(:2).NE.'22') RETURN - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - START = ICOUNT - BULLETIN_NUM = START - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0 - CALL NEWS_HEADER(IER) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBIN - END IF - BLOCK = START - MSG_NUM = START - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I) - END DO - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURN - END - - - - SUBROUTINE NEWS_GROUP(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN - IER = 1 - RETURN - END IF - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)) - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = 1 - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT') - IF (.NOT.IER) RETURN - - IER = NEWS_READ() - IF (.NOT.IER) RETURN - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURN - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INTIME - - CHARACTER*28 TIME - - DIMENSION DIFF(2) - - I = 1 - LTIME = TRIM(INTIME) - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) - I = I + 1 - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - CALL STR$UPCASE(TIME,INTIME(I:)) - - DO J = 1,2 - I = 1 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-' - END DO - - IF (I.EQ.LEN(TIME)) RETURN - - IF (TIME(I+3:I+3).EQ.' ') THEN - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IF - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1 - END DO - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) THEN - CALL SYS_BINTIM('-',BTIM) - RETURN - END IF - - IF (INDEX(TIME(:I-2),'.').GT.0) THEN - CALL SYS_BINTIM(TIME(:INDEX(TIME(:I-2),'.'))//'00',BTIM) - ELSE IF (TIME(I-4:I-4).EQ.':'.AND.TIME(I-7:I-7).EQ.':') THEN - CALL SYS_BINTIM(TIME(:I-2)//'.00',BTIM) - ELSE - CALL SYS_BINTIM(TIME(:I-2)//':00.00',BTIM) - END IF - - IF (TIME(I:I).EQ.'+'.OR.TIME(I:I).EQ.'-') THEN - IER = SYS_BINTIM('0 '//TIME(I+1:I+2)//':'//TIME(I+3:I+4),DIFF) - IF (IER) THEN - IF (TIME(I:I).EQ.'-') THEN - IER = LIB$SUBX(BTIM,DIFF,BTIM) - ELSE - IER = LIB$ADDX(BTIM,DIFF,BTIM) - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE NEWS_LIST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - COMMON /NEWSLIST/ NEWSLIST - - CHARACTER TODAY*24 - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR. - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER)) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - NEWS_FOLDER1_BBOARD = '::' - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14 - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNT - DAMAGED = .FALSE. - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1 - IF (INDEX(BUFFER(SB:),' ').EQ.0) DAMAGED = .TRUE. - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) - IF (IER1.EQ.0) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IF (INDEX(BUFFER(SP:),' ').EQ.0) DAMAGED = .TRUE. - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) - SP = EP + 2 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IF (INDEX(BUFFER(SP:),' ').EQ.0) DAMAGED = .TRUE. - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1 - IF (IER.EQ.0.AND.IER1.EQ.0) - & NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) ! Old bug caused this. - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF ((FLEN.LE.44.OR.FLEN-44+EB-SP+1.LT. - & LEN(NEWS_FOLDER1_DESCRIP)).AND.DAMAGED) THEN - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)// - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - END IF - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - END IF - ELSE - CALL UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - END IF - IF (DAMAGED) THEN - IER = NEWS_READ() - DAMAGED = .FALSE. - END IF - END DO - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - OPEN (UNIT=33,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',READONLY) - - DO WHILE (IER.EQ.0) - READ (33,'(A)',IOSTAT=IER) INPUT - IF (IER.EQ.0) THEN - FLEN = INDEX(INPUT,':')-1 - NEWS_FOLDER1 = INPUT(:FLEN) - IF (SET_ALT(INPUT(FLEN+2:))) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER1) - IF (IER1.NE.0) THEN - FOLDER1_DESCRIP = NEWS_FOLDER1 - IF (FLEN.GT.44) THEN - NEWS_FOLDER1_DESCRIP = INPUT(45:FLEN) - ELSE - NEWS_FOLDER1_DESCRIP = ' ' - END IF - END IF - CALL NEWS_GROUP(IER) - IF (IER.EQ.0) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - IF (IER1.NE.0) THEN - CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - ELSE - CALL UPDATE_NEWS_ENTRY(.FALSE.,LOCAL_UPDATE,FLEN,0) - END IF - END IF - END IF - END IF - IF (IER.NE.0) CLOSE (UNIT=33) - IF (ALT_SET()) THEN - CALL UNSET_ALT - IF (.NOT.NEWS_LOGIN()) RETURN - END IF - END DO - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - LAST = FOLDER1_NUMBER - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops - DELETE (7) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - LAST = FOLDER1_NUMBER - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_START = F1_START - NEWS_F1_COUNT = F1_COUNT - CALL NEWS_GROUP(IER) - IF (IER.EQ.1.AND.TEST_ALT(NEWS_FOLDER1// - & NEWS_FOLDER1_DESCRIP)) THEN - IER = 0 - ELSE IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.F1_START.AND. - & NEWS_F1_FIRST.GT.F1_NBULL) THEN - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE), - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (((F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. - & NEWS_F1_COUNT.NE.F1_COUNT) THEN - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.EQ.1.AND..NOT.BTEST(NEWS_F1_FLAG,8)) THEN - DELETE (UNIT=7) - IER = 0 - ELSE IF (IER.EQ.1) THEN - IF (NEWS_F1_NBULL.LT.NEWS_F1_START - & .OR.NEWS_F1_START.EQ.0) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL OPEN_BULLDIR_SHARED - CALL READDIR(NEWS_F1_START,IER1) - CALL CLOSE_BULLDIR - IER1 = NEWS_F1_START+1.EQ.IER1 - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - IF (.NOT.IER1) DELETE (UNIT=7) - END IF - IER = 0 - END IF - END IF - END DO - END IF - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - NEWSLIST = .FALSE. - - IF (SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED')) CALL RECOUNT - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) - END IF - END DO - - RETURN - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLNEWS.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /FOLLOWUP/ FOLLOWUP - CHARACTER*128 FOLLOWUP - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*4 - - COMMON /LOCALPOST/ LOCAL_POST - DATA LOCAL_POST /.FALSE./ - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - COMMON /SENDER/ SENDER_LINE - CHARACTER*256 SENDER_LINE - - COMMON /TEMP_INPUT/ GROUP_TEMP - CHARACTER GROUP_TEMP*256 - - COMMON /HEADER/ HEADER - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - CHARACTER*(*) FILENAME,SUBJECT - - CHARACTER RESPONSE*4 - - CHARACTER TODAY*24,UNAME*132 - DATA UNAME /'()'/ - - COMMON /POINT/ BULL_POINT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /NEWS2BULL/ NEWS2BULL - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.FILEOPEN) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1) - IF (IER1.NE.0) RETURN - ELSE - REWIND (UNIT=3) - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900 - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3) - END IF - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THEN - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSE - I = INDEX(NEWS_MSGID,'.') - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & NEWS_MSGID(:I-1)// - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256) - IF (IER.NE.0) RETURN - LOCAL_POST = .TRUE. - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1 - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Newsgroups: junk')) GO TO 900 - ELSE IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN - IF (CREATE) THEN - INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) - ELSE IF (NEWS_FEED()) THEN - INPUT = 'Newsgroups: '//FOLDER1_DESCRIP - ELSE IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN - IF (TRIM(FOLLOWUP).EQ.0) THEN - INPUT = 'Newsgroups: '//NEWSGROUPS - IF (INDEX(NEWSGROUPS,',').GT.0) THEN - WRITE (6,'('' Warning: Original message was cross'', - & ''posted to the following news groups:'')') - DO I=1,TRIM(NEWSGROUPS),PAGE_WIDTH - WRITE (6,'(1X,A)') NEWSGROUPS(I: - & I-1+MIN(PAGE_WIDTH,TRIM(NEWSGROUPS(I:)))) - END DO - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Type Y if you want your reply crossposted also, '// - & 'N for no: (default = Y) ') - IF (RESPONSE(:1).EQ.'n'.OR.RESPONSE(:1).EQ.'N') THEN - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - END IF - ELSE - INPUT = 'Newsgroups: '//FOLLOWUP - END IF - ELSE - INPUT = 'Newsgroups: '//FOLDER_NAME - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE.AND. - & .NOT.NEWS_FEED()) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER) - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0 - DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP)) - IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP) - DO WHILE (TRIM(GROUP_TEMP).GT.0) - COMMA = INDEX(GROUP_TEMP,',') - IF (COMMA.GT.0) THEN - FOLDER1_NAME = GROUP_TEMP(1:COMMA-1) - GROUP_TEMP = GROUP_TEMP(COMMA+1:) - ELSE - FOLDER1_NAME = GROUP_TEMP - GROUP_TEMP = ' ' - END IF - CALL LOWERCASE(FOLDER1_NAME) - FLEN = TRIM(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1) - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9) - & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND. - & INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND. - & INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST), - & GROUP_LIST,FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - ELSE - WRITE (6,'(1X,A,'' is not a valid news group.'')') - & FOLDER1_NAME(:FLEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to specify it? (default = Y) ') - IF (RESPONSE(:1).NE.'n'.AND. - & RESPONSE(:1).NE.'N') THEN - INPUT = INPUT(:TRIM(INPUT))// - & ','//FOLDER1_NAME(:FLEN) - END IF - END IF - END DO - END DO - CALL CLOSE_BULLNEWS - END IF - END IF - IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900 - END IF - ATSIGN = INDEX(PATHNAME,'@') - PCSIGN = INDEX(PATHNAME,'%') - CALL LOWERCASE(USERNAME) - IF (FILENAME.EQ.'cancel'.AND.SUBJECT(:6).EQ.'CanceL') THEN - IF (.NOT.NEWS_WRITE('Path: cyberspam!usenet')) GO TO 900 - ELSE - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - END IF - END IF - IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME) - - IF (FILENAME.NE.'cancel') THEN - FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// - & UNAME(:TRIM(UNAME)) - IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - IF (INDEX(INFROM,' ').GT.0) - & INFROM = INFROM(:INDEX(INFROM,' ')-1) - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - ELSE IF (INDEX(INFROM,'@').EQ.0) THEN - INFROM = INFROM(:TRIM(INFROM))//PATHNAME(:LPATH) - END IF - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED').AND. - & SYS_TRNLNM('MX_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED').AND. - & SYS_TRNLNM('PMDF_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE IF (SYS_TRNLNM('MULTINET_ROOT','DEFINED').AND. - & SYS_TRNLNM('MULTINET_SMTP_REPLY_TO',INFROM)) THEN - IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM)))) - & GO TO 900 - IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - CALL STR$UPCASE(FROM_LINE,FROM_LINE) - FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) - CALL STR$UPCASE(USERNAME,USERNAME) - ELSE IF (REMOTE_SET.EQ.3) THEN - IF (SENDER_LINE.NE.' ') THEN - IF (.NOT.NEWS_WRITE(SENDER_LINE(:TRIM(SENDER_LINE)))) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE(FROM_LINE(:TRIM(FROM_LINE)))) - & GO TO 900 - END IF - ELSE - HEADER_SAVE = HEADER - HEADER = .TRUE. - CALL OPEN_BULLFIL_SHARED - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ILEN = TRIM(INPUT) - IF (INPUT(:5).EQ.'From:') THEN - GROUP_TEMP = INPUT - ELSE IF (INPUT(:7).EQ.'Sender:') THEN - GROUP_TEMP = 'From:'//INPUT(8:) - ILEN = 0 - END IF - END DO - ILEN = TRIM(GROUP_TEMP) - IF (ILEN.NE.0) THEN - IF (.NOT.NEWS_WRITE(GROUP_TEMP(:ILEN))) RETURN - END IF - CALL CLOSE_BULLFIL - HEADER = HEADER_SAVE - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Subject: cancel <'// - & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 - ELSE IF (TRIM(SUBJECT).EQ.0) THEN - IF (.NOT.NEWS_WRITE('Subject: (none)')) - & GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - END IF - SUBJECT_LINE = SUBJECT - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) - & GO TO 900 - END IF - - IF (NGROUPS.GT.0) THEN - FROM = USERNAME - DESCRIP = SUBJECT - END IF - - IF (FILENAME.NE.'cancel') THEN - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//PATHNAME(:LPATH)//'>')) GO TO 900 - ELSE - IF (.NOT.NEWS_WRITE('Message-ID: ')) GO TO 900 - END IF - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION) - END IF - LORGAN = TRIM(ORGANIZATION) - END IF - - IF (FILENAME.NE.'cancel'.AND.LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN))) - & GO TO 900 - ELSE IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Organization: cancel')) - & GO TO 900 - END IF - - IF (.NOT.USE_INFROM.OR.COMPARE_DATE(TODAY(:11),DATE).GT.13) THEN - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(8:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & ZONE(:LZONE))) GO TO 900 - ELSE - CALL COPY2(NOW,MSG_BTIM) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - TODAY = DATE(:2)//' '//DATE(4:6)//' '//DATE(8:) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// - & TIME(:8)//' '//ZONE(:LZONE))) GO TO 900 - IER = SYS$ASCTIM(,TODAY,MSG_BTIM,) - DATE = TODAY(:11) - TIME = TODAY(13:20)//'.00' - END IF - - INPUT_HEADER = .FALSE. - - IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel')) THEN - EXPR = NEWS_FEED().OR.USE_INFROM - IF (.NOT.EXPR) EXPR = CLI$PRESENT('EXPIRATION') - IF (EXPR) THEN - CALL SYS_BINTIM(EXDATE//' '//EXTIME,NOW) - CALL CONVERT_TO_GMT(NOW) - IER = SYS$ASCTIM(,TODAY,NOW,) - EXDATE = TODAY(:11) - EXTIME = TODAY(13:20) - I = INDEX(EXDATE,'-') - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE(FIRST_ALPHA(EXDATE):2) - & //' '//EXDATE(I+1:I+3)//' '//EXDATE(I+5:TRIM(EXDATE)) - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) - & GO TO 900 - ELSE IF (REMOTE_SET.EQ.4) THEN - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT) - END IF - EXTIME = '00:00:00.00' - END IF - IF (.NOT.NEWS_FEED()) THEN - IF (CLI$GET_VALUE('FOLLOWUP',GROUP_TEMP)) THEN - CALL LOWERCASE(GROUP_TEMP) - IF (.NOT.NEWS_WRITE('Followup-To: ' - & //GROUP_TEMP(:TRIM(GROUP_TEMP)))) GO TO 900 - END IF - END IF - END IF - - IF (CREATE) THEN - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURN - END IF - - IF (NEWS_FEED().OR.NEWS2BULL) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (.NOT.NEWS_WRITE('X-Newsreader: News2bull')) GO TO 900 - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (.NOT.NEWS_WRITE(' ')) RETURN - IF (.NOT.NEWS_WRITE('cancel <' - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN - IF (SUBJECT(:6).EQ.'CanceL') THEN - IF (SUBJECT.EQ.'CanceL') THEN - WRITE (6,1055) - ILEN = LINE_LENGTH + 1 ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - IF (.NOT.NEWS_WRITE(INPUT(:ILEN))) RETURN - END IF - END DO - ELSE - IF (.NOT.NEWS_WRITE(SUBJECT(7:TRIM(SUBJECT)-6))) RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).EQ.'240') IER = 0 - ELSE - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - CALL STR$UPCASE(USERNAME,USERNAME) - LOCAL_POST = .FALSE. - RETURN - END IF - - IF (.NOT.INPUT_HEADER) THEN - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2 - END IF - IF (IER1.EQ.0) THEN - IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END IF - END DO - - IF (REMOTE_SET.EQ.3) THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).EQ.'240') THEN - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:MIN(79+SB,EB)) - IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN - WRITE (6,'('' Use /INDENT to change indentation'',$)') - WRITE (6,'(''+ character. See Manager for permanent'',$)') - WRITE (6,'(''+ change.'')') - END IF - END IF - ELSE - LENGTH = (LENGTH+127)/128 - GROUP_LIST = GROUP_LIST1 - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - SAVE_BULL_POINT = BULL_POINT - OLD_NBULL = NBULL - DO I=NGROUPS,1,-1 - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1) - FOLDER_NUMBER = -1 - OLD_NBULL = NBULL - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL ADD_LOCAL_NEWS(8) - CALL ADD_TAG(IER,2) - IF (NEWS_FIND_SUBSCRIBE().LT.FOLDER_MAX) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER1) - IF (IER1.EQ.0.OR.IER1.EQ.OLD_NBULL+1) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(OLD_NBULL+1) - END IF - END IF - END IF - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - BULL_POINT = SAVE_BULL_POINT - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IF - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - CALL STR$UPCASE(USERNAME,USERNAME) - - LOCAL_POST = .FALSE. - -1055 FORMAT(' State reason for deleting message not owned by you:') - - RETURN - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN - IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) - IF (.NOT.IER) - & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')') - RETURN - END IF - END IF - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME) - LPATH = TRIM(PATHNAME) - - RETURN - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NAME - - TEST_NEWS = .FALSE. - MAYBE_NEWS = .FALSE. - - DO I=1,LEN(NAME) - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE. - END DO - - TEST_NEWS = MAYBE_NEWS - - RETURN - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM) - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) RETURN - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (NUM.GT.0) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULL - FIRST = F1_START - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - REMOTE_SET = 3 - CALL OPEN_BULLDIR_SHARED - INCMD = 'READ' ! REMOTE_GET_HEADER uses NEXT otherwise - I = F_LAST + 1 - IER = I - 1 - DO WHILE (I.NE.IER.AND.I.LE.LAST) - CALL READDIR(I,IER) - I = I + 1 - END DO - CALL CLOSE_BULLDIR - CALL OTS$CVT_L_TI(I-1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNT - NEW_NEWS_F_END = NEWS_F_END - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - F_LAST = LAST - NEWS_F_FIRST = FIRST - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE NEWS2BULL(RECLAIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLCP_NEWS/ BULLCP_NEWS - DATA BULLCP_NEWS /.FALSE./ - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12 - - CHARACTER*8 NUMBER - - DIMENSION NOW(2) - - BULLCP_NEWS = .TRUE. - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV - - CALL DELETE_EXPIRED_NEWS(RECLAIM) - - IF (RECLAIM) CALL EXIT - - CALL SEND_POST - IF (ALT_SET()) CALL UNSET_ALT - - CALL NEWS_LIST - - CALL UPDATE_LOCAL_NEWS - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - IF (NEWS_FEED()) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARD - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) - IF (IER) THEN - SAVE_LAST = F_LAST - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER) - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN - SAVE_LAST = F_NBULL - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LAST - FOLDER_BBOARD = 'NONEFEED' - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - IF (FOLDER_BBOARD.EQ.'NONEFEED') THEN - CALL SETUSER('SYSTEM') - ELSE - CALL SETUSER(FOLDER_BBOARD) - END IF - REMOTE_SET = 3 - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST) - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/LOCAL/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1) - END IF - CALL CLOSE_BULLFOLDER - CALL SETUSER(USERNAME) - END IF - END IF - END DO - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME) - - IMPLICIT INTEGER (A-Z) - - COMMON /MONTHS/ MONTH - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ - - CHARACTER*(*) TIME - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+ - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)// - & TIME(16:17)//TIME(19:20) - - RETURN - END - - - - SUBROUTINE ALLPRIV - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1 - PROCPRIV(2) = -1 - NEEDPRIV(1) = -1 - NEEDPRIV(2) = -1 - - RETURN - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COM - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_COUNT = NEWS_F_COUNT - REWRITE (7) NEWS_FOLDER1_COM - - RETURN - END - - - - SUBROUTINE SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')') - RETURN - END IF - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSE - WRITE (6,'('' You are now subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IF - - CALL UPDATE_USERINFO - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - LAST_NEWS_READ(2,J) = F_START - 1 - ELSE - LAST_NEWS_READ2(2,J) = 0 - LAST_NEWS_READ(2,J) = F_NBULL - END IF - CALL CLOSE_BULLNEWS - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - CALL UPDATE_USERINFO_NEWS_ALWAYS - RETURN - END IF - END DO - - END - - - - - - SUBROUTINE UNSUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_EXPIRED - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.LE.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Folder is permanent and cannot not be'', - & '' unsubscribed.'')') - RETURN - END IF - - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - CALL UPDATE_USERINFO - - I = NEWS_FIND_SUBSCRIBE() - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - - CALL FREE_TAGS(I) - - IF (NINCLUDE.GT.0) THEN - WRITE (6,'('' Note: Excludes and/or '', - & ''threads exist for this group.'')') - WRITE (6,'('' Type EXCLUDE/DISABLE/ALL to remove them.'')') - END IF - - CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - CALL UPDATE_USERINFO_NEWS_ALWAYS - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (IER.EQ.0) IER = 1 ! None read yet. - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE1() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1) THEN - IER = 0 - RETURN - END IF - - RETURN - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR.(LAST_NEWS_READ(2,I) - & .GT.NEWS_F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0 - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THEN - COUNT = COUNT + 1 - END IF - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT) - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE - SUBNUM = 0 - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES) -C -C SUBROUTINE NEWS_NEW_NOTIFICATION -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - MESSAGES = .FALSE. - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1 - - FOLDER_DESCRIP = ' ' - REORDER = 0 - DO WHILE (SUBNUM.GT.0) - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - FOLDER1_DESCRIP = FOLDER_DESCRIP - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - IF (IER.EQ.0) FOLDER_NUMBER = SUBNUM - UNLOCK 7 - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1 - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - CALL UPDATE_USERINFO - IF (F_START.EQ.0) IER = 1 - ELSE IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR. - & F_START.GT.F_NBULL) THEN - IER = 1 - END IF - END IF - IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (DIFF.GT.0) IER = 1 - END IF - END IF - END IF - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN - WRITE (6,'('' There are new messages in folder '', - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - ELSE - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - CALL OPEN_BULLNEWS_SHARED - END IF - END IF - END DO - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE - - CALL CLOSE_BULLNEWS - - RETURN - END - - - SUBROUTINE REORDER_SUBSCRIBE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0) - I = I + 1 - END DO - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1 - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER) - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1) - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2 - TEMP = LAST_NEWS_READ(L,J) - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K) - LAST_NEWS_READ(L,K) = TEMP - END DO - END IF - END DO - END DO - - RETURN - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15) - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE = I - - RETURN - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE1 = I - - RETURN - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - IP = 1 - DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER - & .AND.IP.LE.FOLDER_MAX-1) - IP = IP + 1 - END DO - - IER = .TRUE. - - IF (IP.EQ.FOLDER_MAX) THEN - PERM = .FALSE. - IP = 1 - ELSE - PERM = .TRUE. - END IF - - IF (NOTIFY.EQ.0) THEN - IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).AND. - & .NOT.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.PERM.AND. - & (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) - & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) - & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (BTEST(INF_REC2(2,IP),14)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - END IF - - IF (BTEST(INF_REC2(2,IP),15)) THEN - LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - ELSE - LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - END IF - END IF - - CALL UPDATE_USERINFO - - RETURN - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE - CHARACTER*12 MSGNUM - - REWIND UNIT - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '// - & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK) - IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN - CALL STORE_BULL(TRIM(SUBJECT_LINE)+6, - & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) - END IF - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1 - SYSTEM = 0 - CALL ADD_ENTRY - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE UPDATE_NEWS_FOLDER -C -C SUBROUTINE UPDATE_NEWS_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1 - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_EX_BTIM_KEY - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE SEND_POST - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /NEWSBULL/ NEWSBULL - DATA NEWSBULL /.FALSE./ - - CHARACTER FILE*132 - - C = 0 - - IF (.NOT.NEWS_LOGIN()) RETURN - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST*',FILE,C)) -50 IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'340') RETURN - - NEWSBULL = .FALSE. - - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN - IF (INPUT(:5).EQ.'From:') BULL_PARAMETER = INPUT(7:) - IF (INDEX(INPUT,'X-Newsreader: News2bull').EQ.1) THEN - NEWSBULL = .TRUE. - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (.NOT.NEWS_WRITE('X-Newsreader: News2bull' - & //' '//PATHNAME(:TRIM(PATHNAME)))) GO TO 100 - ELSE - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IF - END IF - END DO - IF (INPUT.NE.'.') THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - IF (BUFFER(:3).EQ.'441'.AND..NOT.ALT_SET()) THEN - REWIND (UNIT=3) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0.AND.INPUT(:12).EQ.'Newsgroups: ') THEN - CLOSE (UNIT=3) - IF (TEST_ALT(INPUT(13:))) THEN - CALL SET_ALT(ALT_FOUND) - GOTO 50 - END IF - IER = 2 - END IF - END DO - CLOSE (UNIT=3) - END IF - IF (BUFFER(:3).NE.'240') THEN - CLOSE (UNIT=3) - IF (NEWSBULL.AND.INDEX(FILE,'POST_ERROR').EQ.0) THEN - CALL LIB$RENAME_FILE(FILE,'*.POST_ERROR',,,,,,,,,FILE) - CALL SENDMAIL(FILE,'SYSTEM' - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER) - NEWSBULL = .FALSE. - ELSE IF (.NOT.NEWSBULL) THEN - CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER) - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - CLOSE (UNIT=3,STATUS='DELETE') - END IF - ELSE - CLOSE (UNIT=3,STATUS='DELETE') - END IF - IF (ALT_SET()) CALL UNSET_ALT - END DO - -100 CLOSE (UNIT=3) - - RETURN - END - - - - SUBROUTINE GET_UNAME(UNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)' - - CHARACTER*(*) UNAME - - CALL DISABLE_PRIVS - - C = 0 - - STATUS = MAIL$USER_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, - & %LOC(UNAME)) - CALL END_ITMLST(GET_USER_ITMLST) - - STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$USER_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - - IER = SYS_TRNLNM('BULL_PERSONAL_NAME',UNAME) - - IF (UNAME.EQ.'()') THEN - UNAME = ' ' - ELSE IF (TRIM(UNAME).GT.0) THEN - UNAME = ' ('//UNAME(:TRIM(UNAME))//')' - END IF - - RETURN - END - - - - SUBROUTINE RECOUNT -C -C SUBROUTINE RECOUNT -C -C FUNCTION: -C -C Fixes the message count of stored news groups. This may become wrong -C if old copies of some of the database files are used with newer versions. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - REMOTE_SET = 4 - - DO WHILE (IER.EQ.0) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - END DO - - IF (BTEST(NEWS_F_FLAG,8).AND.IER.EQ.0) THEN - CALL NEWS_TO_FOLDER - - CALL OPEN_BULLDIR_SHARED - - NUM = F_START - F_COUNT = 0 - - IF (F_START.GT.0) THEN - CALL READDIR(NUM,IER) - NEXT = .TRUE. - F_START = NUM - DO WHILE (NUM+1.EQ.IER) - F_COUNT = F_COUNT + 1 - NUM = NUM + 1 - IF (NUM.LE.F_NBULL) CALL READDIR(NUM,IER) - END DO - NEXT = .FALSE. - - F_NBULL = NUM - 1 - END IF - - CALL CLOSE_BULLDIR - - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - - CALL DELLNM('BULL_NEWS_RECOUNT') - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - SUBROUTINE DELLNM(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$SYSTEM',LOG,PSL$C_SUPER) - - RETURN - END - - - SUBROUTINE DELLNM_USER(LOG) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PSLDEF)' - - CHARACTER*(*) LOG - - CALL SYS$DELLNM('LNM$PROCESS',LOG,PSL$C_USER) - - RETURN - END - - - SUBROUTINE NEWNEWS(SINCE_BTIM,FOUND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - DIMENSION SINCE_BTIM(2) - - START = F_START - END = F_NBULL - - FOUND = 0 - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).EQ.'22') THEN - IF (.NOT.NEWS_READ()) RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (FOUND.EQ.0) THEN - L = INDEX(BUFFER(SB:EB),' ') - CALL OTS$CVT_TI_L(BUFFER(SB:SB+L-2),IER,,%VAL(1)) - CALL NEWS_TIME(BUFFER(SB+L:EB),MSG_BTIM) - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) - & FOUND = IER - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (FOUND.NE.0) THEN - IF (.NOT.OTS$CVT_L_TI(FOUND,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN - BUFFER(:3) = '500' - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THEN - IER = 0 - END = START - 1 - RETURN - END IF - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - I = START - DO WHILE (IER.EQ.0.AND.I.LE.END.AND.FOUND.EQ.0) - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURN - CALL CONVERT_FROM_GMT(MSG_BTIM) - IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) FOUND = MSG_NUM - I = I + 1 - IF (REMOTE_SET.EQ.3.AND.I.LE.END.AND.FOUND.EQ.0) THEN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0 - RETURN - END IF - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0 - END IF - END DO - IF (FOUND.EQ.0) THEN - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - END IF - - RETURN - END - - - - LOGICAL FUNCTION TEST_ALT(FOLDER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /ALT_FOUND/ ALT_FOUND - CHARACTER*128 ALT_FOUND - - CHARACTER*(*) FOLDER1 - - TEST_ALT = .FALSE. - - OPEN (UNIT=3,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & 'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',READONLY) - - IF (IER.NE.0) RETURN - - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) ALT_FOUND - IF (STREQ(ALT_FOUND(:INDEX(ALT_FOUND,':')-1), - & FOLDER1(:TRIM(FOLDER1)))) THEN - ALT_FOUND = ALT_FOUND(INDEX(ALT_FOUND,':')+1:) - CLOSE (UNIT=3) - TEST_ALT = .TRUE. - RETURN - END IF - END DO - - CLOSE (UNIT=3) - - RETURN - END - - - - LOGICAL FUNCTION SET_ALT(NEWALT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) NEWALT - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - DATA SETALT/.FALSE./ - - SET_ALT = .FALSE. - - IF (SETALT) THEN - IF (NEWALT.EQ.ALT) THEN - SET_ALT = .TRUE. - RETURN - ELSE - CALL UNSET_ALT - END IF - END IF - - CALL NEWS_LOGOUT - - CALL CRELNM('BULL_NEWS_SERVER',NEWALT(:TRIM(NEWALT))) - - IF (NEWS_LOGIN()) THEN - SET_ALT = .TRUE. - SETALT = .TRUE. - ALT = NEWALT - ELSE - CALL DELLNM_USER('BULL_NEWS_SERVER') - SETALT = .FALSE. - END IF - - RETURN - END - - - - SUBROUTINE UNSET_ALT - - IMPLICIT INTEGER (A-Z) - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - CALL DELLNM_USER('BULL_NEWS_SERVER') - - CALL NEWS_LOGOUT - - SETALT = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALT_SET() - - COMMON /ALT/ ALT,SETALT - CHARACTER*64 ALT - LOGICAL SETALT - - ALT_SET = SETALT - - RETURN - END - - - - SUBROUTINE ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION EXPIRED(2) - - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1 - I = FLEN - NEWS_F1_COUNT = NEWS_F_COUNT - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN - NEWS_FOLDER = NEWS_FOLDER(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - NEWS_F_COUNT = NEWS_F1_COUNT - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DO - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT - IF (IER2.EQ.0) THEN - NEWS_F1_FLAG = NEWS_F_FLAG - NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN - NEWS_F1_EXPIRE = NEWS_F_EXPIRE - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1) - IF (BTEST(NEWS_F1_FLAG,8)) THEN - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_LAST = 0 - END IF - - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (BTEST(NEWS_F1_FLAG,8).AND. - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE. - IF (SP.GT.0) THEN - IF (FLEN.GT.44) THEN - IF (NEWS_FOLDER1_DESCRIP.NE. - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IF - ELSE - UPDATE = .TRUE. - END IF - IF (SPECIAL) THEN - IF (UPDATE) THEN - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF - ELSE IF (.NOT.UPDATE) THEN - UPDATE = F1_START.LT.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bulletin11.for b/decus/vmslt98b/bulletin/bulletin11.for deleted file mode 100644 index 9534883..0000000 --- a/decus/vmslt98b/bulletin/bulletin11.for +++ /dev/null @@ -1,3592 +0,0 @@ -C -C BULLETIN11.FOR, Version 10/6/98 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('CURRENT')) THEN - MESSAGE_NUMBER = BULL_POINT - ELSE IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END IF - END DO - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36 - END IF - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - HEADER = .FALSE. - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM) - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DO - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - MESSAGE = MNUM - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUM - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM) - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I) - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND. - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN - IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I) - END IF - END IF - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURN - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - IER = 36 - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM) - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - MESSNUM = I - ELSE - I = I + 1 - END IF - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE. - CALL READDIR(MESSNUM,IER1) - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IF - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM) - ELSE - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IF - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1 - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - IF (.NOT.BULL_NEWS_TAG) RETURN - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0 - END IF - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP)) - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMP - END IF - END DO - END IF - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURN - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z) - - DIMENSION TAGS(1) - - I = (NUM-START)/32 - J = NUM - START - I*32 - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1) - END DO - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)) - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSE - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURN - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*12 BULL_MARK_DIR - CHARACTER*12 TAG_KEY,INPUT_KEY - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - NTRIES = 0 - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1) - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1) - & INPUT_KEY - END DO - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN - MSG_KEY = INPUT_KEY(5:) - CALL SYS$ASCTIM(,DATE,MSG_BTIM,) - IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - DELETE (13) - IER1 = 2 - END IF - END IF - IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN - CLOSE (UNIT=13) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.BULLMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DO - CALL SYS_BINTIM('-',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1) - ELSE - UNLOCK 13 - END IF - END IF - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE. - ELSE - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - BULL_NEWS_TAG = .FALSE. - RETURN - END IF - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),) - IF (IER1.NE.0) THEN - CLOSE (UNIT=23) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - OPEN (UNIT=24,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=128,DISPOSE='DELETE', - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0) THEN - I = NEWS_MARK2(1) - NEWS_MARK2(1) = NEWS_MARK2(2) - NEWS_MARK2(2) = I - WRITE (24,IOSTAT=IER) NEWS_MARK - END IF - END DO - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (24,IOSTAT=IER) NEWS_MARK - CLOSE (UNIT=24,DISPOSE='SAVE') - CLOSE (UNIT=23,DISPOSE='DELETE') - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN - CLOSE (UNIT=23) - IER1 = 1 - DO WHILE (IER1) - IER1 = LIB$DELETE_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME)) - & //'.NEWSMARK;-1') - END DO - CALL CONV$PASS_FILES( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP') - CALL CONV$PASS_OPTIONS() - CALL CONV$CONVERT() - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1') - CALL LIB$RENAME_FILE( - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP', - & BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK') - CALL LIB$DELETE_FILE(BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1') - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - END DO - DO WHILE (REC_LOCK(IER1)) - READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK - END DO - CALL SYS_BINTIM('-',NEWS_MARK(2)) - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - NEWS_MARK(1) = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - END DO - IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23) - ELSE - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - CALL ERRSNS(IDUMMY,IER2) - IF (IER2.NE.RMS$_RNF) SUBNUM = 0 - ELSE - DO I=1,2 - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0 - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1, - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DO - END IF - END IF - END IF - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1 - ELSE - TAG_TYPE = 2 - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM, - & TAG_TYPE) - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IF - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CALL CLOSE_BULLNEWS - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURN - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1), - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IF - - RETURN - END - - - - SUBROUTINE OPEN_NEW_TAG(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - - CHARACTER*12 BULL_MARK_DIR - - DIMENSION BTIM(2) - CHARACTER KEY*8 - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSE - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.0) THEN - CALL SYS_BINTIM('-',BTIM) - CALL GET_MSGKEY(BTIM,KEY) - WRITE (13) TAG_KEY('FFFF'X,KEY,0) - END IF - ELSE - MARKUNIT = 23 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - IF (IER.EQ.0) THEN - NEWS_MARK(1) = 0 - CALL SYS_BINTIM('-',NEWS_MARK(2)) - WRITE (23,IOSTAT=IER) NEWS_MARK - END IF - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot create mark file.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSE - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1 - END IF - - RETURN - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - ELSE - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:)) - - RETURN - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEY - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IF - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 0 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY) - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - RETURN - END IF - - MSG_KEY = BULLDIR_HEADER - - HEADER = .TRUE. - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURN - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - TAG_TYPE = 0 - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) - END IF - END DO - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR. - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND. - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN - IF (IER.EQ.0) UNLOCK 13 - IER = 0 - MESSAGE = MSG_NUM - ELSE - IER = 36 - END IF - - RETURN - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEY - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - IER = 36 - - HEADER = .FALSE. - - TAG_TYPE = 0 - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) - RETURN - END IF - - DO WHILE (IER.NE.0) - I = 0 - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) THEN - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.EQ.0) THEN - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:) - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THEN - I = 2 - END IF - END IF - END IF - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I) - DO WHILE (REC_LOCK(IER)) - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY - END DO - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I) - IER = 0 - RETURN - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - MSG_KEY = NEXT_MSG_KEY - RETURN - ELSE - MSG_KEY = NEXT_MSG_KEY - END IF - END DO - - RETURN - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - DO MESSAGE = MSG_NUM+1,F_NBULL - CALL READDIR(MESSAGE,IER) - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE) - IF (IER.EQ.0) THEN - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END DO - - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2) - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURN - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER) - & INPUT_KEY - END DO - - CLOSE_IT = .FALSE. - - DO WHILE (FOLDER_NUMBER.GT.0) - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - CALL DECREMENT_MSG_KEY - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR_SHARED - CLOSE_IT = .TRUE. - END IF - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13 - MESSAGE = MSG_NUM - IF (HEADER) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER - END IF - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - ELSE - DELETE (UNIT=13) - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER)) - READ (13,IOSTAT=IER) INPUT_KEY - END DO - END IF - END IF - - END DO - - END - - - - SUBROUTINE CLOSE_TAG - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE. - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-1 - DO M=1,2 - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1 - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1 - LIMIT = 256/(NEWS_FORMAT+1) - NEWS_NUMBER = LAST_NEWS_READ2(1,I) - K = 5-NEWS_FORMAT*2 - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THEN - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1 - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IF - SET_LIST = .FALSE. - END IF - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0) - END DO - K = LIMIT + 1 - END IF - IF (K.GT.LIMIT) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2 - NEWS_REC = NEWS_REC + 1 - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - IF (IER.EQ.0) THEN - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF - END DO - END IF - END IF - END DO - END IF - END DO - END DO - CLOSE (UNIT=23) - END IF - - RETURN - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - IF (NEWS_FORMAT.EQ.0) THEN - NEWS_MARK2(I) = J - ELSE - NEWS_MARK(I) = J - END IF - - RETURN - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG) - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUM - NEWS_TAG(I) = 0 - END DO - - RETURN - END - - - - - SUBROUTINE FREE_TAGS(ISUB) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - DO I=1,2 - IF (NEWS_TAG(3,I,ISUB).GT.0) THEN - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB)) - NEWS_TAG(3,I,ISUB) = 0 - NEWS_NUMBER = NEWS_FOLDER_NUMBER - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER)) - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER) - END IF - END DO - IF (IER.EQ.0) UNLOCK 23 - END IF - - DO J=I,FOLDER_MAX-2 - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J)) - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0 - END DO - END DO - - RETURN - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*8 PREV_MSG_KEY - - IER = 36 - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE) - IF (IER.EQ.0) THEN - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THEN - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM) - END IF - IER = 36 - END IF - END IF - END DO - BULL_READ = MSG_NUM - IF (CLOSE_IT) CALL CLOSE_BULLDIR - ELSE - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0 - MSG_KEY = BULLDIR_HEADER - IER = 0 - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM) - IF (MSG_NUM.GT.0) THEN - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IF - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUM - MSG_KEY = PREV_MSG_KEY - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36 - END IF - END IF - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I)) - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1) - I = 9 - ELSE - I = I + 1 - END IF - END DO - - RETURN - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C -C SUBROUTINE SET_GENERIC -C -C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying -C general bulletins continually for a certain amount of days. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - IF (IER.EQ.0) THEN - IF (GENERIC) THEN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSE - NEW_FLAG(2) = ' 7' - END IF - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -C -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSE - NEW_FLAG(2) = 0 - END IF - - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIN -C -C FUNCTION: Enables or disables bulletin display at login. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*24 - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - IF (IER.EQ.0) THEN - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THEN - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')') - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z) - - INTEGER*4 EXBLK(4) - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1 - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - SUBROUTINE SENDMAIL(FILE,TO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE '($MAILDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - COMMON /SENDTO/ SENDTO - CHARACTER*256 SENDTO - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /NEWSBULL/ NEWSBULL - - CHARACTER*(*) FILE,TO,SUBJECT - - EXTERNAL MAIL_ERROR - - CALL SYS$SETAST(%VAL(1)) - - CALL DISABLE_PRIVS - - SENDTO = TO - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))// - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:) - END DO - - IF ((USE_INFROM.OR.NEWSBULL).AND.(SYS_TRNLNM('TWF$TCP','DEFINED').OR. - & SYS_TRNLNM('MULTINET_SOCKET_LIBRARY','DEFINED').OR. - & SYS_TRNLNM('UCX$DEVICE','DEFINED')) - & .AND..NOT.SYS_TRNLNM('BULL_DISABLE_SMTP','DEFINED')) THEN - IER = SYS$ASCTIM(,INPUT,,) - INPUT = INPUT(:2)//INPUT(4:6)//INPUT(10:11)// - & INPUT(13:14)//INPUT(16:17)//INPUT(19:20)// - & INPUT(22:23) - IF (INPUT(:1).EQ.' ') INPUT = INPUT(2:) - OPEN (UNIT=8,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & INPUT(:TRIM(INPUT))//'.SMTP',IOSTAT=IER1, - & STATUS='NEW',RECL=256) - IF (IER1.EQ.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - WRITE (8,'(A)',IOSTAT=IER) 'helo '//PATHNAME(:LPATH) - INPUT = INFROM - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - END IF - WRITE (8,'(A)',IOSTAT=IER) 'MAIL FROM:<'// - & INPUT(:TRIM(INPUT))//'>' - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - WRITE (8,'(A)',IOSTAT=IER) 'RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>' - WRITE (8,'(A)',IOSTAT=IER) 'DATA' - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - WRITE (8,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - IF (NHEAD.EQ.0.AND.TRIM(SUBJECT).GT.0) THEN - WRITE (8,'(A)',IOSTAT=IER) - & 'Subject: '//SUBJECT(:TRIM(SUBJECT)) - WRITE (8,'(A)',IOSTAT=IER) - END IF - IF (NEWSBULL) THEN - WRITE (8,'(A)') 'This message was posted via a folder'// - & ' with a news group associated with it.' - WRITE (8,'(A)') 'It will continue to attempt to be'// - & ' posted to the news group using the file:' - WRITE (8,'(A)') FILE(:TRIM(FILE)) - WRITE (8,'(A)') 'If necessary, you can either'// - & ' delete the file or edit it to fix it.' - WRITE (8,'(A)') 'If you edit it, delete old versions.' - WRITE (8,'(A)') ' ' - END IF - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER) - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.EQ.0) THEN - WRITE (8,'(A)',IOSTAT=IER) INPUT(:L) - END IF - END DO - CLOSE (UNIT=3) - REWIND (UNIT=8,IOSTAT=IER) - IF (IER.NE.0) THEN - CLOSE (UNIT=8,STATUS='DELETE') - IER1 = 2 - END IF - END IF - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('helo '//PATHNAME(2:LPATH)//CRLF)) - & GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - INPUT = INFROM - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ELSE IF (I.EQ.0.AND.INDEX(INPUT,'@').EQ.0) THEN - INPUT = INPUT(:TRIM(INPUT))//PATHNAME(:LPATH) - END IF - IF (.NOT.SMTP_WRITE_PACKET('MAIL FROM:<'//INPUT(:TRIM(INPUT)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - SENDTO = SENDTO(INDEX(SENDTO,'"')+1:) - DO WHILE (INDEX(SENDTO,'"').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)// - & SENDTO(INDEX(SENDTO,'"')+1:) - END DO - IF (.NOT.SMTP_WRITE_PACKET('RCPT TO:<'//SENDTO(:TRIM(SENDTO)) - & //'>'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('DATA'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - HEADER_Q = HEADER_Q1 - DO I=1,NHEAD - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - IF (BTEST(FOLDER_FLAG,15).OR.INPUT(:8).NE.'Subject:') THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:TRIM(INPUT))//CRLF)) - & GOTO 10 - ELSE - IF (.NOT.SMTP_WRITE_PACKET('Subject: '// - & SUBJECT(:TRIM(SUBJECT))//CRLF)) GOTO 10 - END IF - END DO - IF (NHEAD.EQ.0.AND.TRIM(SUBJECT).GT.0) THEN - IF (.NOT.SMTP_WRITE_PACKET('Subject: '// - & SUBJECT(:TRIM(SUBJECT))//CRLF)) GOTO 10 - NHEAD = 1 - END IF - IF (.NOT.SMTP_WRITE_PACKET(CRLF)) GOTO 10 - IF (NEWSBULL) THEN - IF (.NOT.SMTP_WRITE_PACKET('This message was posted via '// - & 'a folder with a news group associated with it.'//CRLF)) - & GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('It will continue to attempt to'// - & ' be posted to the news group using the file:'//CRLF)) - & GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(FILE(:TRIM(FILE))//CRLF)) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('If necessary, you can either'// - & ' delete the file or edit it to fix it.'//CRLF)) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('If you edit it, '// - & 'delete old versions.'//CRLF)) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(CRLF)) GOTO 10 - END IF - OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER2) - DO WHILE (IER2.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER2) L,INPUT - IF (IER2.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) IER2 = 2 - END IF - END DO - CLOSE (UNIT=3) - IF (IER2.EQ.2) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IER2 = 1 - GOTO 20 -10 IER2 = 2 -20 CALL SMTP_DISCONNECT() - IF (IER1.EQ.0) THEN - IF (IER2) THEN - CLOSE (UNIT=8,STATUS='DELETE') - ELSE - CLOSE (UNIT=8) - END IF - END IF - CALL ENABLE_PRIVS - STATUS = 1 - RETURN - END IF - - C = 0 - - CALL LIB$ESTABLISH(MAIL_ERROR) - - IER = SYS_TRNLNM('BULL_PERSONAL_NAME',INPUT) - IF (IER) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(INPUT),MAIL$_SEND_PERS_NAME, - & %LOC(INPUT)) - CALL END_ITMLST(SEND_ITMLST) - STATUS = MAIL$SEND_BEGIN(C,%VAL(SEND_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - ELSE - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) GO TO 100 - END IF - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO)) - I = INDEX(SENDTO(J:),',') - 1 - IF (I.EQ.-1) I = TRIM(SENDTO(J:)) - CALL INIT_ITMLST - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - J = J + I - IF (SENDTO(J:J).EQ.',') J = J + 1 - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO)) - CALL END_ITMLST(ATTRIBUTE_ITMLST) - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_MESSAGE(C,0,0) - IF (.NOT.STATUS) GO TO 100 - - STATUS = MAIL$SEND_END(C,0,0) - IF (.NOT.STATUS) GO TO 100 - -100 CALL ENABLE_PRIVS - CALL LIB$REVERT - - RETURN - END - - - - FUNCTION MAIL_ERROR(SIGARGS,MECHARGS) - - MAIL_ERROR = .TRUE. - - CALL SYS$PUTMSG(SIGARGS,,) - - RETURN - END - - - - - SUBROUTINE SET_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEXT/ NEXT - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DIMENSION EXPIRED(2) - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IF - - ENTRY SHOW_NEWS - - LIMIT = -2 - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1)) - IF (.NOT.IER.OR.LIMIT.LT.-1) THEN - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')') - RETURN - END IF - END IF - - EXPIRE = -1 - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1)) - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN - END IF - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR. - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')') - RETURN - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder file - - IF (CLI$PRESENT('DEFAULT')) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1 - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSE - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - RETURN - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE) - FOLDER1_NUMBER = NEWS_F1_COUNT - FOLDER1 = BULL_PARAMETER - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10) - CALL WRITE_FOLDER_FILE_TEMP(IER) - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMP - REWRITE (7) NEWS_FOLDER1_COM - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER) - END IF - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - END IF - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS') - DEFAULT = CLI$PRESENT('DEFAULT') - ALL = CLI$PRESENT('ALL') - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE') - ENABLE = CLI$PRESENT('ENABLE') - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - - STORED = 0 - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN - WRITE (6,'('' Stored setting was not removed.'')') - CALL CLOSE_BULLNEWS - RETURN - END IF - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'[.BULLNEWS*]*.*;*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_SAVE = FOLDER - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - FOLDER = FOLDER_SAVE - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0 - F1_NBULL = 0 - F1_COUNT = 0 - F1_LAST = 0 - END IF - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IF - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3) - IF (IER.NE.0) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - END IF - CALL RESET_PROTECTION - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IF - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN - NEWS_FLAG_DEFAULT = NEWS_F1_FLAG - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THEN - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')') - ELSE - WRITE (6,'('' Default is not stored.'')') - END IF - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS) THEN - WRITE (6,'('' Expiration is DEFAULT value.'')') - ELSE - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Default expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no default expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')') - ELSE - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,) - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' Expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE - WRITE (6,'('' There is no expiration limit.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IF - NOTIFY_FLAG_NEWS = .FALSE. - SET_FLAG_NEWS = .FALSE. - BRIEF_FLAG_NEWS = .FALSE. - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a default news group.'')') - ELSE - IER1 = 2 - END IF - END IF - NOTIFY_PERM_FLAG_NEWS = .FALSE. - SET_PERM_FLAG_NEWS = .FALSE. - BRIEF_PERM_FLAG_NEWS = .FALSE. - DO WHILE (REC_LOCK(IER2)) - READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC - END DO - IF (IER2.EQ.0) THEN - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - IF (I.LE.FOLDER_MAX-1) THEN - NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13) - SET_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),14) - BRIEF_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),15) - WRITE (6,'('' This is a permanent news group.'')') - END IF - END IF - PERM = .FALSE. - IF (SET_FLAG_NEWS) THEN - IF (BRIEF_FLAG_NEWS) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE IF (BRIEF_FLAG_NEWS) THEN - IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - IF (.NOT.PERM) THEN - IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (BRIEF_PERM_FLAG_NEWS.AND..NOT.SET_PERM_FLAG_NEWS) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (NOTIFY_FLAG_NEWS) THEN - IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE IF (NOTIFY_PERM_FLAG_NEWS) THEN - WRITE (6,'('' NOTIFY is permanent.'')') - ELSE IF (IER1.EQ.0) THEN - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLINF - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP)) - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IF - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER) - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) - END IF - FOUND = .FALSE. - MODALL = INDEX(GROUP,'.').NE.LG - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR. - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.')) - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN - CALL CLOSE_BULLNEWS - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - END IF - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER) - END DO - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER) - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - RETURN - END IF - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - END DO - END IF - - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - END IF - - CALL CLOSE_BULLNEWS - - RETURN - END - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - ALL = CLI$PRESENT('ALL') - FULL = CLI$PRESENT('FULL') - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (CLI$PRESENT('SUBJECT')) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IF - ELSE - INPUT = FROM - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:) - ELSE - INPUT = DESCRIP - END IF - END IF - LEN_P = TRIM(INPUT) - CALL CLOSE_BULLFIL - END IF - - SUB = CLI$PRESENT('SUBJECT') - DISABLE = CLI$PRESENT('DISABLE') - EXC = 0 - - GO TO 5 - - ENTRY INCLUDE_SUBJECT(EXCLUDE) - - IF (REMOTE_SET.GE.3.AND.NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) RETURN - - LEN_P = TRIM(INPUT) - ALL = .FALSE. - DISABLE = .FALSE. - SUB = .TRUE. - EXC = -1 - -5 IF (SUB) THEN - IF (DISABLE) THEN - IF (STREQ(INPUT(:3),'RE:')) INPUT = INPUT(5:) - INPUT = INPUT(:MIN(LEN_P,LEN(DESCRIP))) - LEN_P = TRIM(INPUT) - END IF - INPUT = 'SUBJECT:'//INPUT - LEN_P = LEN_P + 8 - ELSE - INPUT = 'FROM:'//INPUT - LEN_P = LEN_P + 5 - END IF - - IF (EXCLUDE) THEN - INPUT = ':exclude:'//INPUT - LEN_P = LEN_P + 9 - ELSE - INPUT = ':include:'//INPUT - LEN_P = LEN_P + 9 - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - FLEN = TRIM(FOLDER_NAME) - INPUT = FOLDER_NAME(:FLEN)//INPUT - ILEN = FLEN + LEN_P - - IF (EXC.EQ.0) THEN - EXC = -1 - IER = CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P) - IF (IER) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) EXC - IF (EXC.LT.0.OR.EXC.GT.999.OR.IER.NE.0) THEN - WRITE(6,'('' ERROR: Valid limit is 0-999.'')') - RETURN - END IF - END IF - END IF - - CHECK_ONLY = .FALSE. - - GO TO 100 - - ENTRY CHECK_EXCLUDES - - CHECK_ONLY = .TRUE. - DISABLE = .TRUE. - LEN_P = 0 - INPUT = ' ' - ILEN = 1 - -100 IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE.AND.LEN_P.GT.0) THEN - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - CLOSE (UNIT=4,DISPOSE='SAVE') - RETURN - END IF - - IER = 0 - CONVERT = .FALSE. - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - I = STRFIND(OLD_BUFFER,':RE: ') - IF (IER.EQ.0) THEN - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL - & .AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN - I = INDEX(OLD_BUFFER,':kill') - IF (DISABLE.AND.I.GT.0) THEN - IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN - OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:) - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5) - END IF - ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN - OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill' - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5) - FULL = .FALSE. - END IF - ELSE IF ((STREQ(OLD_BUFFER(:ILEN),INPUT(:ILEN)).AND. - & OLD_BUFFER(ILEN+1:ILEN+1).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:OLEN),INPUT(:OLEN))).OR. - & (DISABLE.AND.I.GT.0.AND. - & ((STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:MAX(I+5,ILEN+4)), - & INPUT(:ILEN)).AND.OLD_BUFFER(ILEN+5:ILEN+5).EQ.':').OR. - & (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND. - & STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:OLEN), - & INPUT(:OLEN)))))) THEN - CONTINUE - ELSE IF (.NOT.(ALL.AND.STREQ(INPUT(:FLEN+8), - & OLD_BUFFER(:MIN(FLEN+8,OLEN))))) THEN - IER2 = OLD_BUFFER(:1).EQ.':'.OR. - & INDEX(OLD_BUFFER,':defaults:').GT.0 - IF (.NOT.IER2) THEN - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC1,BLIMIT,BDATE,IER1) - IF (IER1) IER2 = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1) - & ,' ').GT.-EXC1 - CONVERT = .NOT.IER1 - END IF - IF (.NOT.IER1.OR.EXC1.EQ.0.OR.IER2) - & WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN) - END IF - END IF - END DO - - IF (.NOT.DISABLE) THEN - IF (FULL) THEN - WRITE (4,'(A)',IOSTAT=IER) FOLDER_NAME(:FLEN)//':defaults:kill' - ELSE - CALL ADD_EXCL(INPUT,ILEN,EXC) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - - IF (CONVERT) THEN - WRITE (6,'('' NOTE: See help on the new SET EXLIMIT command.'')') - END IF - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - SUBROUTINE UPDATE_EXCLUDE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - DATA SCRATCH_B1/0/,NINCLUDE/0/,EXC_CHANGED/.FALSE./ - - CHARACTER TODAY*24 - - DIMENSION BTIM(2) - - IF (.NOT.EXC_CHANGED) RETURN - EXC_CHANGED = .FALSE. - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - L_TODAY = TRIM(TODAY) - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - WRITE(6,'('' ERROR: Error in opening new custom file.'')') - RETURN - END IF - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (.NOT.(IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ. - & INPUT(:MIN(TRIM(FOLDER_NAME)+1,ILEN)).AND.INPUT(:1).NE.':' - & .AND.INDEX(INPUT,':defaults:').EQ.0)) THEN - IF (IER.EQ.0) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) - WRITE (4,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - END DO - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE SET_CUSTOM(PARAM) -C -C SUBROUTINE SET_CUSTOM -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - CHARACTER*(*) PARAM - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER) - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' - - CALL DISABLE_PRIVS - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IF - - LENP = LEN(PARAM) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0.AND.PARAM(:LENP).NE.INPUT(2:LENP+1)) THEN - WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END DO - - IF (CLI$GET_VALUE('SET_PARAM2',INPUT,ILEN)) THEN - WRITE (4,'(A)',IOSTAT=IER) ':'//PARAM(:LENP)//':'//INPUT(:ILEN) - END IF - - IF (PARAM.EQ.'exclude_limit') - & DECODE(ILEN,'(I)',INPUT(:ILEN)) EXCLUDE_LIMIT - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1') - - CALL CHECK_CUSTOM - - RETURN - END - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /FILE_DIRECTORY/ FILE_DIRECTORY - CHARACTER*64 FILE_DIRECTORY - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - DATA EXCLUDE_LIMIT /0/ - - DIMENSION BTIM(2) - - FILE_DIRECTORY = ' ' - - IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THEN - BULL_USER_CUSTOM = .FALSE. - ELSE - BULL_USER_CUSTOM = .FALSE. - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4) - END IF - - IER = SYS_TRNLNM('BULL_USER_CUSTOM',OLD_BUFFER) - IF (.NOT.IER) OLD_BUFFER = 'SYS$LOGIN:BULL.CUSTOM' - - OPEN(UNIT=17,FILE=OLD_BUFFER(:TRIM(OLD_BUFFER)), - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURN - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IF - - NINCLUDE = 0 - OLD_FORMAT = .FALSE. - FLEN = TRIM(FOLDER_NAME) - DO WHILE (IER.EQ.0) - READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER - IF (IER.EQ.0.AND.STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL LOWERCASE(OLD_BUFFER) - IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults') - & .EQ.1) THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - ELSE - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - OLD_FORMAT = OLD_FORMAT.OR.(.NOT.IER1) - IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXC - & .OR.EXC.EQ.0) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1 - ELSE - EXC_CHANGED = .TRUE. - END IF - END IF - ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THEN - IF (INDEX(OLD_BUFFER,':header').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2) - IF (INDEX(OLD_BUFFER,':kill').GT.0) - & BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) - IF (INDEX(OLD_BUFFER,':file_directory').GT.0) - & FILE_DIRECTORY = OLD_BUFFER(17:) - IF (INDEX(OLD_BUFFER,':exclude_limit').GT.0) THEN - DECODE(OLEN-15,'(I)',OLD_BUFFER(16:),IOSTAT=IER1) - & EXCLUDE_LIMIT - EXCLUDE_LIMIT = MIN(999,EXCLUDE_LIMIT) - END IF - END IF - END DO - - CLOSE (UNIT=17) - - IF (OLD_FORMAT) CALL CHECK_EXCLUDES - - RETURN - END - - - - - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /DIRMODE/ DIRMODE - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - CHARACTER*(*) STRING,STRING1 - CHARACTER*132 ADDRESS - - CHARACTER*12 EXFROM - - INCLUDE_MSG = .TRUE. - IF (BTEST(BULL_USER_CUSTOM,4)) RETURN - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURN - - MATCH_FROM = .FALSE. - SYSTEM = IBCLR(SYSTEM,8) - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - DO I=1,NINCLUDE - OLD_SCRATCH_B = SCRATCH_B - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (DIRMODE) BLIMIT = MIN(BLIMIT,FLEN+17+LEN(DESCRIP)) - MATCH = .FALSE. - IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:')) THEN - CALL GET_FROM(EXFROM,OLD_BUFFER(FLEN+15:), - & TRIM(OLD_BUFFER(FLEN+15:))) - IF (STREQ(ADDRESS(STRING),ADDRESS(OLD_BUFFER(FLEN+15: - & TRIM(OLD_BUFFER(FLEN+15:BLIMIT))+FLEN+14))).OR. - & (DIRMODE.AND.STREQ(FROM,EXFROM))) THEN - MATCH = .TRUE. - MATCH_FROM = .TRUE. - END IF - ELSE IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND. - & STRFIND(STRING1(:TRIM(STRING1)), - & OLD_BUFFER(FLEN+18:BLIMIT)).GT.0) THEN - MATCH = .TRUE. - END IF - IF (MATCH) THEN - CDATE = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ') - IF (CDATE.NE.0.AND.EXC.NE.0) THEN - IF (OLD_BUFFER(BLIMIT+1:BLIMIT+1).EQ.':') EXC = -1 - CALL ADD_EXCL(OLD_BUFFER,BLIMIT,EXC) - CALL WRITE_QUEUE(%VAL(OLD_SCRATCH_B),OLD_SCRATCH_B, - & OLD_BUFFER) - EXC_CHANGED = .TRUE. - END IF - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THEN - SYSTEM = IBSET(SYSTEM,8) - INCLUDE_MSG = .TRUE. - ELSE IF (.NOT.BTEST(SYSTEM,8).OR.MATCH_FROM) THEN -C -C Only "from" matches override threads, but not subject matches. -C - INCLUDE_MSG = .FALSE. - SYSTEM = IBCLR(SYSTEM,8) - IF (MATCH_FROM) RETURN - END IF - END IF - END DO - - RETURN - END - - - - FUNCTION STRFIND(STRING,STRING1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) STRING,STRING1 - - L = LEN(STRING1) - DO I=0,LEN(STRING)-L - J = 1 - DO WHILE (J.LE.L) - DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(STRING1(J:J)) - & .OR..NOT.ALPHA(STRING(I+J:I+J)))) THEN - J = L + 1 - ELSE IF (J.EQ.L) THEN - STRFIND = I + 1 - RETURN - ELSE - J = J + 1 - END IF - END DO - END DO - - STRFIND = 0 - - RETURN - END - - - - - SUBROUTINE SHOW_EXCLUDE(TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (TYPE.EQ.0) WRITE (6,'('' There are no excludes.'')') - IF (TYPE.EQ.1) WRITE (6,'('' There are no threads.'')') - RETURN - END IF - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME) - - FOUND = .FALSE. - - L = 1 - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - OLEN = TRIM(OLD_BUFFER) - IF (STREQ(FOLDER_NAME(:FLEN)//':',OLD_BUFFER(:MIN(FLEN+1,OLEN))) - & .AND.((TYPE.EQ.1.AND.STREQ(OLD_BUFFER(FLEN+2:FLEN+8), - & 'INCLUDE')).OR.(TYPE.EQ.0.AND.STREQ( - & OLD_BUFFER(FLEN+2:FLEN+8),'EXCLUDE')))) THEN - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'Excludes for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'Threads for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - FOUND = .TRUE. - END IF - CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1) - IF (BLIMIT+5-FLEN.GT.PAGE_WIDTH.AND.L+2.GT.PAGE_LENGTH-1) THEN - L = L + 2 - ELSE - IF (L.EQ.0) THEN - WRITE (6,'(''+'',A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - ELSE - WRITE (6,'(1X,A,$)') OLD_BUFFER(FLEN+10: - & MIN(BLIMIT,PAGE_WIDTH+FLEN+9)) - END IF - IF (OLD_BUFFER(BDATE+1:BDATE+1).EQ.'-') - & OLD_BUFFER(BDATE:) = ' '//OLD_BUFFER(BDATE:) - OUTLEN = MIN(BLIMIT,PAGE_WIDTH+FLEN+9)-FLEN-9 - IF (OUTLEN.GT.PAGE_WIDTH-16) THEN - WRITE (6,'(1X,X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 2 - ELSE - WRITE (6,'(''+'',X,A,1X,I3)') - & OLD_BUFFER(BDATE:INDEX(OLD_BUFFER - & (BDATE:),':')+BDATE-2),EXC - L = L + 1 - END IF - END IF - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & INPUT(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - - IF (.NOT.FOUND) THEN - IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'No excludes found for ' - IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'No threads found for ' - WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':' - END IF - - RETURN - END - - - - SUBROUTINE SET_NEWNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - - CHARACTER*12 NEW,OLD - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: No privs to set a new name.'')') - RETURN - END IF - - CALL CLI$GET_VALUE('OLDNAME',OLD,LENO) - CALL CLI$GET_VALUE('NEWNAME',NEW,LENN) - - CALL OPEN_BULLUSER_SHARED - - TEMP_USER = USERNAME - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY - END DO - - IF (IER.EQ.0) THEN - USERNAME = NEW - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER,KEYEQ=NEW) - END DO - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) USER_ENTRY - ELSE - REWRITE (4,IOSTAT=IER) USER_ENTRY - END IF - END IF - - USERNAME = TEMP_USER - DO WHILE (REC_LOCK(IER1)) - READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY - END DO - - CALL CLOSE_BULLUSER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Old name not found.'')') - RETURN - END IF - - CALL OPEN_BULLINF_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO))) - NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN))) - - OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO))) - IF (LENO.GT.1) THEN - OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1))) - ELSE - OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2))) - END IF - NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN))) - IF (LENN.GT.1) THEN - NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1))) - ELSE - NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))) - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST - END DO - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (9,IOSTAT=IER) NEW,LAST - ELSE - REWRITE (9,IOSTAT=IER) NEW,LAST - END IF - ELSE - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=NEW,IOSTAT=IER) - END DO - IF (IER.EQ.0) DELETE (9) - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - SUBROUTINE CHECK_EXCL(BUFFER,L,EXC,BLIMIT,BDATE,IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT - - CHARACTER*(*) BUFFER - - DIMENSION BTIM(2) - - BLIMIT = L - BDATE = L+3 - - IER = BUFFER(L:L).EQ.':' - IF (IER) THEN - I = LAST_INDEX(BUFFER(:L-1),':') - IF (I.GT.0) THEN - J = LAST_INDEX(BUFFER(:I-1),':') - IF (J.GT.0) THEN - IF (J.LT.I-1) THEN - DECODE(I-J-1,'(I)',BUFFER(J+1:I-1),IOSTAT=IER) EXC - IER = IER.EQ.0 - ELSE - EXC = EXCLUDE_LIMIT - END IF - IF (IER) BLIMIT = J - 1 - CALL STR$UPCASE(BUFFER(I+1:L-1),BUFFER(I+1:L-1)) - IF (IER) IER = SYS_BINTIM(BUFFER(I+1:L-1),BTIM) - BDATE = I + 1 - END IF - ELSE - IER = .FALSE. - END IF - END IF - - IF (.NOT.IER) CALL ADD_EXCL(BUFFER,L,-1) - - RETURN - END - - - - SUBROUTINE ADD_EXCL(BUFFER,L,EXC) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2) - - CHARACTER*(*) BUFFER - - CHARACTER TODAY*24 - - IF (EXC.EQ.-1) THEN - BUFFER = BUFFER(:L)//':' - ELSE - BUFFER = BUFFER(:L)//':' - WRITE (BUFFER(L+2:),'(I3)') EXC - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:) - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) - BUFFER = BUFFER(:TRIM(BUFFER))//':'//TODAY(:INDEX(TODAY,' ')-1)//':' - - L = TRIM(BUFFER) - - RETURN - END - - - - - CHARACTER*(*) FUNCTION ADDRESS(INPUT) - - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) INPUT - - ADDRESS = INPUT - - IF (INDEX(INPUT,'@').EQ.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - ADDRESS = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - ELSE - ADDRESS = INPUT(:MINGT0(TRIM(INPUT),INDEX(INPUT,' ')-1)) - IF (INDEX(ADDRESS,'(').GT.0) - & ADDRESS = ADDRESS(:INDEX(ADDRESS,'(')-1) - END IF - - RETURN - END - - - - - SUBROUTINE SEND_MAIL - - IMPLICIT INTEGER (A-Z) - - PARAMETER CRLF = CHAR(13)//CHAR(10) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - C = 0 - DO WHILE (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) - OPEN (UNIT=8,FILE=INPUT(:TRIM(INPUT)),IOSTAT=IER,RECL=256) - IF (IER.NE.0) GOTO 30 - IF (.NOT.SMTP_CONNECT()) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'220') GOTO 10 - DO I=1,3 - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'250') GOTO 10 - END DO - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.NE.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (INPUT(:3).NE.'354') GOTO 10 - DO WHILE (IER.EQ.0) - READ (8,'(Q,A)',IOSTAT=IER) L,INPUT - IF (IER.EQ.0) THEN - IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10 - END IF - END DO - IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10 - IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10 - CLOSE (UNIT=8,STATUS='DELETE') - GOTO 20 -10 CLOSE (UNIT=8) -20 CALL SMTP_DISCONNECT() -30 CONTINUE - END DO - - CALL EXIT - END diff --git a/decus/vmslt98b/bulletin/bulletin2.for b/decus/vmslt98b/bulletin/bulletin2.for deleted file mode 100644 index 3a7577e..0000000 --- a/decus/vmslt98b/bulletin/bulletin2.for +++ /dev/null @@ -1,2679 +0,0 @@ -C -C BULLETIN2.FOR, Version 9/14/98 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'('' WARNING: Account used by other folder.'', - & '' If you specify the same account,'')') - WRITE (6,'('' you must specify the address'', - & '' of the mailing list in the folder description.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Do you still want to make this change? ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN - IF (SHUTDOWN_BTIM(1).EQ.0) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IF - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL READ_PERM - - IF (.NOT.FILE_OPENED) THEN - CALL CLOSE_BULLUSER - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - END IF - - RETURN - END - - - - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command. -C -C NODE_AREA is set to 0 after shutdown messages are deleted. -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted. -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURN - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -C -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')') - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDER - END IF - - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE (6,'('' Cannot set remote node for the default folder.'')') - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THEN - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')') - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '// - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN - FOLDER1 = FOLDER - END IF - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN) - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'( - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE - WRITE (6,'('' Folder has been converted to remote.'')') - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file. - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*' - END IF - REMOTE_SET = REMOTE_SET_SAVE - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0 - CLOSE (UNIT=17) - END IF - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1) - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2) - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSE - WRITE (6,'('' You are not authorized to modify NODE.'')') - END IF - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - END IF - - RETURN - END - - - - - SUBROUTINE RESPOND -C -C SUBROUTINE RESPOND -C -C FUNCTION: Sends a mail message in reply to a posted message. -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIP - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - CHARACTER INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPL') THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSE - BULL_PARAMETER = 'message owner and mailing list.' - END IF - - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IF - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1) - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'Re:'//INDESCRIP(4:) - ELSE - INDESCRIP = 'Re: '//INDESCRIP - END IF - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IF - - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURN - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEN - WRITE(6,'('' Enter subject of message:'')') - CALL GET_LINE(INDESCRIP,LENDES) - IF (LENDES.LE.0) THEN - WRITE(6,'('' ERROR: No subject specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')') - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - EDIT = .TRUE. - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IF - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST') - - ILEN = 0 - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Specified file cannot be opened.'')') - RETURN - END IF - END IF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH+2,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IF - - LENFRO = 0 - DO WHILE (CLI$GET_VALUE('CC',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT)) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.EQ.0) THEN - INFROM = INPUT(:ILEN)//',' - ELSE - INFROM = INFROM(:LENFRO)//INPUT(:ILEN)//',' - END IF - LENFRO = LENFRO + ILEN + 1 - END DO - IF (LENFRO.GT.0.AND..NOT.MSG_OWN) LENFRO = LENFRO - 1 - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (MSG_OWN) THEN - ILEN = TRIM(INPUT) - 6 - INFROM = INFROM(:LENFRO)//INPUT(7:) - IF (INDEX(INFROM,' "').GT.INDEX(INFROM,'@')) THEN - I = INDEX(INFROM,' "') - INFROM = INFROM(:I-1)// - & INFROM(INDEX(INFROM(I+2:),'"')+I+2:) - DO WHILE (INDEX(INFROM,'""').GT.0) - INFROM = INFROM(:INDEX(INFROM,'""'))// - & INFROM(INDEX(INFROM,'""')+2:) - END DO - END IF - CALL ADD_PROTOCOL(INFROM(LENFRO+1:),ILEN) - LENFRO = LENFRO + ILEN - END IF - IF (EDIT.AND.TEXT) THEN - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:TRIM(INPUT)-1) - END IF - WRITE (3,'(A)') 'In a previous article, '// - & INPUT(:TRIM(INPUT))//' wrote:' - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROM - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - LEN_P = 0 - IF (CLI$PRESENT('INDENT').NE.%LOC(CLI$_NEGATED)) THEN - CALL CLI$GET_VALUE('INDENT',BULL_PARAMETER,LEN_P) - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (LEN_P.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSE - WRITE (3,'(A)') BULL_PARAMETER(:LEN_P)//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - IF (FILESPEC) THEN - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - - CALL CLOSE_BULLFIL - END IF - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ICOUNT = ICOUNT + 1 - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3) - END IF - END IF - - IF (LIST.AND.REMOTE_SET.LT.3) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSE - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1) - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF - - I = 1 ! Must change all " to "" in FROM field - DO WHILE (I.LE.LENFRO) - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:) - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1 - END DO - - STATUS = .TRUE. - - IF (EDIT) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THEN - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - IER = 0 - END IF - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')') - END IF - END IF - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (.NOT.FILESPEC) THEN - WRITE (6,'('' Enter message: End with ctrl-z,'', - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DO - ELSE - IER = 0 - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEN - ICOUNT = ICOUNT + 1 - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3) - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IF - CLOSE (UNIT=3) - IF (IER.EQ.0.AND.LENFRO.GT.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - INPUT = INDESCRIP - CALL INCLUDE_SUBJECT(0) - END IF - END IF - END IF - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No message added.'')') - IF (.NOT.STATUS) THEN - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ') - IF (STREQ(INPUT(:1),'Y')) THEN - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR', - & 'SYS$LOGIN:BULL.SAV') - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IF - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C -C SUBROUTINE ADD_SIGNATURE -C -C FUNCTION: Adds signature to message being mailed/posted. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATURE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/ - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURN - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=4,FILE='MX_SIGNATURE',STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - END IF - - IF (IER.NE.0) RETURN - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED') - END IF - - ICOUNT = 0 - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME))) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THEN - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END DO - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IF - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE. - ELSE - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' ' - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - END DO - - CLOSE (UNIT=4) - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,INPUT1 - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.(DIFF.NE.32.OR..NOT.ALPHA(INPUT(I:I)) - & .OR..NOT.ALPHA(INPUT1(I:I)))) RETURN - END DO - - STREQ = .TRUE. - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -C -C SUBROUTINE RESPOND_MAIL -C -C FUNCTION: Sends mail to address. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIL_INFO/ USE_INFROM - DATA USE_INFROM /.FALSE./ - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,MLDESCRIP*(LINE_LENGTH) - - PRIVS = FILE.NE.'SYS$LOGIN:BULL.SCR' - - MLDESCRIP = SUBJECT - LENDES = TRIM(MLDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES) - IF (MLDESCRIP(I:I).EQ.'"') THEN - IF (LENDES.EQ.LINE_LENGTH) THEN - MLDESCRIP(I:I) = '`' - ELSE - MLDESCRIP = MLDESCRIP(:I)//'"' - & //MLDESCRIP(I+1:) - I = I + 1 - LENDES = LENDES + 1 - END IF - END IF - I = I + 1 - END DO - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0 - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0 - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD) - IF (PRIVS) CALL DISABLE_PRIVS - - IF (LISTSERV) THEN - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('MX_REPLY_TO','DEFINED')) - & CALL CRELNM('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IF (.NOT.SYS_TRNLNM('PMDF_REPLY_TO','DEFINED')) - & CALL CRELNM('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - IF (.NOT.SYS_TRNLNM('MULTINET_SMTP_REPLY_TO','DEFINED')) - & CALL CRELNM('MULTINET_SMTP_REPLY_TO', - & USERNAME(:TRIM(USERNAME))) - END IF - END IF - - IF (USE_INFROM) THEN - IF (INDEX(INFROM,'::').GT.0) THEN - IF (LPATH.EQ.0) CALL GET_PATHNAME - IF (LPATH.GT.0) THEN - INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))// - & PATHNAME(:LPATH) - END IF - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - CALL CRELNM('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - CALL CRELNM('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE - CALL CRELNM('MULTINET_SMTP_REPLY_TO',INFROM(:TRIM(INFROM))) - END IF - END IF - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO) - & //'""" """'//MLDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IF - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//MLDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSE - I = INDEX(SENDTO,'%""') + 3 - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THEN - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THEN - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THEN - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & MLDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) -C -C Use the following if you do not have VMS V5.3 or greater. -C -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'// -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//MLDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IF - - IF (PRIVS) CALL ENABLE_PRIVS - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV.OR.USE_INFROM) THEN - USE_INFROM = .FALSE. - CALL DELLNM_USER('MULTINET_SMTP_REPLY_TO') - CALL DELLNM_USER('PMDF_REPLY_TO') - CALL DELLNM_USER('MX_REPLY_TO') - END IF - - RETURN - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C -C FUNCTION CONFIRM_USER -C -C FUNCTION: Confirms that username is valid user. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACE -C -C SUBROUTINE REPLACE -C -C FUNCTION: CHANGE command subroutine. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWER - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IF - -C -C Get the bulletin number to be replaced. -C - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the error - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')') - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - ALL = .TRUE. - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')') - RETURN - END IF - END IF - - LENFROM = 0 - IF (CLI$PRESENT('OWNER')) THEN - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - IER = CLI$GET_VALUE('OWNER',INFROM,LENFROM) - INFROM = 'From: '//INFROM - LENFROM = LENFROM + 6 - END IF - END IF - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURN - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURN - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE. - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'', - & '' permitted for remote folder.'')') - RETURN - END IF - END IF - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to permanent.'')') - RETURN - END IF -C -C Check to see if specified bulletin is present, and if the user -C is permitted to replace the bulletin. -C - - CALL OPEN_BULLDIR_SHARED - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULL - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. - END DO - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out. - RETURN - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF - -C -C If no switches were given, replace the full bulletin -C - - DOALL = .FALSE. - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND. - & (.NOT.CLI$PRESENT('HEADER')).AND. - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.CLI$PRESENT('TEXT')).AND. - & (.NOT.CLI$PRESENT('OWNER')).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND. - & (.NOT.CLI$PRESENT('PERMANENT'))) THEN - DOALL = .TRUE. - END IF - - TEXT = CLI$PRESENT('TEXT').OR.CLI$PRESENT('EDIT') - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')') - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER) - PERMANENT = BTEST(SYSTEM,1) - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11) - INEXTIME = INPUT(13:23) - END IF - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THEN - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - END IF - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIP - LENDES = MIN(LENDES+6,LEN(INDESCRIP)) - END IF - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBER - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')') - & NUMBER_PARAM - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN - END IF - END IF - - REC1 = 0 - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL.OR.LENFROM.GT.0) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (LENFROM.EQ.0) THEN - INFROM = INPUT(:ILEN) - LENFROM = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN) - LENDES = ILEN - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THEN -C -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal. -C - - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with data - REC1 = 1 - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specified - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW', - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST') - CALL OPEN_BULLFIL_SHARED ! Prepare to copy message - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into file - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - END IF - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950 - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THEN - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1 - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input line - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long. - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTH - ELSE IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANK - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIP - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR. - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' ' - NUMBER_PARAM = 0 - IER = 1 - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER) - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIR - CLOSE (UNIT=3,STATUS='SAVE') - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')') - END IF - GO TO 100 - END IF - END IF - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK) - END IF - IF (LENDES.GT.0) THEN - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3) - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.' - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER) - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description header - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT, - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THEN - SYSTEM = IBSET(SYSTEM,0) - ELSE IF (CLI$PRESENT('GENERAL')) THEN - SYSTEM = IBCLR(SYSTEM,0) - END IF - IF (CLI$PRESENT('OWNER')) THEN - CALL GET_FROM(FROM,INFROM(7:),LENFROM-6) - CALL STR$UPCASE(FROM,FROM) - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR. - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN - MSGTYPE = IBSET(MSGTYPE,0) - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,1) - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2) - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THEN - MSGTYPE = IBSET(MSGTYPE,3) - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER) - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - END DO - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3) - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN - -910 WRITE(6,1010) - CLOSE (UNIT=3,ERR=100) - GOTO 100 - -920 WRITE(6,1020) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3) - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c') -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.') -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.') -1100 FORMAT(' Message(s) is not owned by you.', - & ' Are you sure you want to replace it? ',$) -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THEN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER) - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THEN - SYSTEM = IBCLR(SYSTEM,2) - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER) - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2100' - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2100' - NODE_AREA = 0 - IF (INCMD(:4).EQ.'REPL') THEN - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'', - & '' Invalid node name specified.'')') - END IF - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IF - - RETURN - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C -C SUBROUTINE SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*132 SEARCH_STRING - DIMENSION SEARCH_LEN(10) - - CHARACTER GROUP*80,STAT*4 - - EXTERNAL CLI$_ABSENT - - IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SEARCH_LEN(1) = 3 - SEARCH_NUM = 1 - NFOLDER = 1 - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - SEARCH_NUM = 1 - NFOLDER = 1 - INPUT = DESCRIP - CALL INCLUDE_SUBJECT(0) - ELSE IF (CLI$PRESENT('SEARCH_STRING')) THEN - SEARCH_NUM = 1 - J = 1 - DO WHILE (CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING(J:), - & SEARCH_LEN(SEARCH_NUM)).NE.%LOC(CLI$_ABSENT)) - J = J + SEARCH_LEN(SEARCH_NUM) - SEARCH_NUM = SEARCH_NUM + 1 - END DO - IF (SEARCH_NUM.GT.1) SEARCH_NUM = SEARCH_NUM - 1 - NFOLDER = 1 - ELSE - IF (NFOLDER.EQ.0) NFOLDER = 1 - SEARCH_STRING = ' ' - END IF - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - END IF - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME - NFOLDER = NFOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DO - - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - SCRATCH_F = SCRATCH_F1 - NFOLDER = NFOLDER + 1 - END IF - - IF (CLI$PRESENT('GROUP')) THEN - CALL INIT_QUEUE(SCRATCH_F1,GROUP) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0 - NGROUP = 0 - DO WHILE (CLI$GET_VALUE('GROUP',GROUP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - NGROUP = NGROUP + 1 - CALL LOWERCASE(GROUP) - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - END DO - SCRATCH_F = SCRATCH_F1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - FEEDBACK = CLI$PRESENT('FEEDBACK') - NFOLDER = -1000 - OLD_BUFFER = ' ' - END IF - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specified - IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - END IF - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IF - - MATCH_MODE = 0 - IF (CLI$PRESENT('MATCH')) THEN - CALL CLI$GET_VALUE('MATCH',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:LEN_P).EQ.'AND') MATCH_MODE = 1 - IF (BULL_PARAMETER(:LEN_P).EQ.'XOR') MATCH_MODE = 2 - END IF - - IF (NFOLDER.NE.0) FOUND = 0 - - CHANGE = .FALSE. - IF (CLI$PRESENT('REPLY').OR. - & TRIM(SEARCH_STRING).GT.0) THEN - REVERSE = CLI$PRESENT('REVERSE') - ELSE - REVERSE = .FALSE. - END IF - - DO WHILE (NFOLDER.NE.0.AND.FOUND.LE.0.AND.FOUND.GT.-3) - IF ((NFOLDER.GT.0.AND.(.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1)).OR. - & (NFOLDER.LT.0.AND.OLD_BUFFER.NE.' ')) - & CALL GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM, - & SEARCH_LEN,MATCH_MODE,START_BULL, - & REVERSE,CLI$PRESENT('SUBJECT') - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'), - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES'),CHANGE) - IF (FOUND.LE.0.AND.FOUND.GE.-2) THEN - NFOLDER = NFOLDER - 1 - IF (NFOLDER.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F, - & FOLDER1_NAME) - END IF - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - END IF - END DO - ELSE IF (NFOLDER.LT.0) THEN - NFOLDER = NFOLDER + 1 - GFOUND = .FALSE. - CALL DECLARE_CTRLC_AST - DO WHILE (.NOT.GFOUND.AND.NGROUP.GT.0.AND.FLAG.NE.1) - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(-NFOLDER,IER) - IF (IER.EQ.0) - & CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - DO WHILE (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (IER.NE.0) NFOLDER = 0 - DO WHILE (.NOT.GFOUND.AND.NFOLDER.NE.0.AND.FLAG.NE.1) - CALL GET_NEXT_GROUP(.TRUE.,GROUP,GLEN,GFOUND, - & .FALSE.,STAT,IER,.TRUE.) - IF (GFOUND) THEN - START_BULL = 0 - IF (REVERSE) START_BULL = NBULL - 1 - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER1_DESCRIP( - & :INDEX(FOLDER1_DESCRIP,' ')) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - GFOUND = .FALSE. - ELSE - IF (FEEDBACK) WRITE (6,'('' Searching '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - CHANGE = .TRUE. - NFOLDER = -FOLDER_NUMBER - END IF - ELSE - NFOLDER = 0 - END IF - END DO - CALL CLOSE_BULLFOLDER - IF (NFOLDER.EQ.0) NGROUP = NGROUP - 1 - IF (NFOLDER.EQ.0.AND.NGROUP.GT.0) THEN - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,GROUP) - GLEN = TRIM(GROUP) - NFOLDER = -1000 - END IF - END DO - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - NFOLDER = 0 - END IF - CALL CANCEL_CTRLC_AST - END IF - END IF - END DO - - IF (FOUND.EQ.-3) FOUND = 0 - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - IF (CHANGE) THEN - WRITE (6,'('' No matches found in current folder: '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' No matches found.'')') - END IF - ELSE IF (FOUND.EQ.-2) THEN - IF (CHANGE) THEN - WRITE (6,'('' ERROR: No more messages in current folder: '' - & ,A)') FOLDER_NAME(:TRIM(FOLDER_NAME)) - ELSE - WRITE (6,'('' ERROR: No more messages.'')') - END IF - END IF - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,SEARCH_NUM,SEARCH_LEN, - & MATCH_INPUT,START_BULL,REVERSE,SUBJECT,REPLY,FILES,START, - & FROM_SEARCH,NEGATE,CHANGE) -C -C SUBROUTINE GET_SEARCH -C -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SEARCH_STRING - - DIMENSION SEARCH_LEN(1) - DIMENSION MATCH_FOUND(10) - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - COMMON /NEWGROUP/ NEWGROUP - - COMMON /NEXT/ NEXT - LOGICAL NEXT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*4 SAVECMD - - CHARACTER*128 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THEN - IER1 = .FALSE. - ELSE - IER1 = .TRUE. - END IF - - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN - ! If no search string entered - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THEN - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - END IF - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - OLD_MATCH_MODE = MATCH_MODE - - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - OLD_REVERSE = REVERSE - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4 - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - ELSE IF (REPLY) THEN - OLD_REVERSE = REVERSE - NEGATED = NEGATE - MATCH_MODE = MATCH_INPUT - CALL READDIR(BULL_POINT,IER) - IF (BULL_POINT+1.NE.IER) THEN - WRITE (6,'('' ERROR: No message being read.'')') - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - RETURN - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (STREQ(DESCRIP(:4),'RE: ').AND.TRIM(DESCRIP).GE. - & LEN(DESCRIP)-1) THEN - IF (FILES) CALL OPEN_BULLFIL_SHARED - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - SEARCH_STRING = INPUT(11:) - SEARCH_STRING = SEARCH_STRING(:LEN(DESCRIP)) - ELSE - SEARCH_STRING = DESCRIP(5:) - END IF - IF (FILES) CALL CLOSE_BULLFIL - ELSE IF (STREQ(DESCRIP(:4),'RE: ')) THEN - SEARCH_STRING = DESCRIP(5:) - END IF - SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - ELSE - SEARCH_NUM = OLD_SEARCH_NUM - IF (SEARCH_LEN(1).EQ.0) SEARCH_LEN(1) = TRIM(SAVE_STRING) - IF (OLD_REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - OLD_SEARCH_NUM = SEARCH_NUM - - SAVE_STRING = SEARCH_STRING - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.CHANGE.OR. - & MATCH_MODE.NE.OLD_MATCH_MODE.OR.REVERSE.OR.REPLY) THEN - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or last - END IF - IF (REVERSE) THEN - START_BULL = MIN(START_BULL,NBULL-1) - END_BULL = 1 - STEP_BULL = -1 - ELSE - END_BULL = NBULL - STEP_BULL = 1 - START_BULL = MAX(0,START_BULL) - END IF - END IF - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR. - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - SEARCH_STRING = ' ' - RETURN - END IF - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - NEWGROUP = .TRUE. - NEXT = STEP_BULL.EQ.1 - SAVECMD = INCMD(:4) - IF (STEP_BULL.EQ.-1) INCMD(:4) = 'BACK' - - SAVE_BULL_SEARCH = 0 - BULL_SEARCH = START_BULL+1 - DO WHILE ((STEP_BULL.EQ.1.AND.BULL_SEARCH.LE.END_BULL).OR. - & (STEP_BULL.EQ.-1.AND.BULL_SEARCH.GE.MAX(1,F_START))) - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY) - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - ELSE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - IF (IER.EQ.0) THEN - IER = BULL_SEARCH + 1 - ELSE - GO TO 800 - END IF - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - IF (SEARCH_MODE.EQ.4) THEN - CALL STR$UPCASE(DESCRIP1,FROM) - ELSE - IF (LEN(DESCRIP).EQ.TRIM(DESCRIP)) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - DESCRIP1 = INPUT(7:) - END IF - CALL STR$UPCASE(DESCRIP1,DESCRIP1) - ELSE - CALL STR$UPCASE(DESCRIP1,DESCRIP) - END IF - END IF - IF ((SEARCH_MODE.GE.3.AND.MATCH(DESCRIP1,SEARCH_STRING, - & SEARCH_LEN,SEARCH_NUM,MATCH_MODE)).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (TRIM(SEARCH_STRING).EQ.LEN(DESCRIP).AND. - & DESCRIP1(:LEN(DESCRIP)).EQ.SEARCH_STRING).OR. - & (STREQ(DESCRIP1(:4),'RE: ').AND.DESCRIP1(5:).EQ. - & SEARCH_STRING(:MIN(TRIM(SEARCH_STRING),LEN(DESCRIP1)-4)) - & )))) THEN - IF (.NOT.NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - ELSE IF (NEGATED) THEN - FOUND = BULL_SEARCH - GO TO 900 - END IF - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER) - IF (IER.GT.0) GO TO 900 - END IF - END IF - ILEN = LINE_LENGTH + 1 - MATCHES = 0 - DO I=1,SEARCH_NUM - MATCH_FOUND(I) = .FALSE. - END DO - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - J = 1 - DO I=1,SEARCH_NUM - IF (.NOT.MATCH_FOUND(I)) THEN - MATCH_FOUND(I) = INDEX(INPUT, - & SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH_FOUND(I)) MATCHES = MATCHES + 1 - END IF - J = J + SEARCH_LEN(I) - END DO - IF ((MATCHES.GT.0.AND.MATCH_MODE.EQ.0).OR. - & (MATCHES.EQ.SEARCH_NUM.AND.MATCH_MODE.EQ.1)) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - ELSE IF (FLAG.EQ.1) THEN - WRITE (6,'('' Search aborted.'')') - FOUND = -3 - GO TO 900 - END IF - END DO - IF (MATCHES.EQ.1.AND.MATCH_MODE.EQ.2) THEN - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900 - END IF - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE - FOUND = -1 - END IF - END IF - END IF - BULL_SEARCH = BULL_SEARCH + STEP_BULL - END DO - -800 FOUND = 0 - -900 IF (FOUND.LE.0.AND.REMOTE_SET.EQ.3) THEN - NEXT = .FALSE. - CALL READDIR(BULL_POINT,IER) - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - END IF - IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - IF (.NOT.IER1) SEARCH_STRING = ' ' - NEXT = .FALSE. - IF (STEP_BULL.EQ.-1) INCMD(:4) = SAVECMD - - RETURN - END - - - - - LOGICAL FUNCTION MATCH(INPUT,SEARCH_STRING,SEARCH_LEN, - & SEARCH_NUM,MATCH_MODE) - - IMPLICIT INTEGER (A - Z) - - DIMENSION SEARCH_LEN(1) - - CHARACTER*(*) INPUT,SEARCH_STRING - - OLD_MATCH = .FALSE. - - J = 1 - - DO I=1,SEARCH_NUM - MATCH = INDEX(INPUT,SEARCH_STRING(J:J+SEARCH_LEN(I)-1)).GT.0 - IF (MATCH.AND.MATCH_MODE.EQ.0) RETURN - IF (.NOT.MATCH.AND.MATCH_MODE.EQ.1) RETURN - IF (OLD_MATCH.AND.MATCH.AND.MATCH_MODE.EQ.2) THEN - MATCH = .FALSE. - RETURN - END IF - J = J + SEARCH_LEN(I) - END DO - - RETURN - END - - - - SUBROUTINE UNDELETE -C -C SUBROUTINE UNDELETE -C -C FUNCTION: Undeletes deleted message. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - EXTERNAL CLI$_ABSENT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')') - RETURN - END IF -C -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error. - ELSE - BULL_DELETE = BULL_POINT ! Delete the file we are reading - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IF - END IF - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - IF (EXDATE(8:11).LT.'1900') EXDATE(8:9) = '19' - IF (EXDATE(8:11).LT.'1995') EXDATE(8:9) = '20' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'21'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'21'//EXDATE(10:) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - WRITE (6,'('' Message was undeleted.'')') - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - ELSE - WRITE (6,'('' Message was undeleted.'')') - END IF - ELSE - CALL DISCONNECT_REMOTE - END IF - END IF - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010) - GO TO 900 - -920 WRITE(6,1020) - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.') - - END - - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - CHARACTER*256 INPUT_OUT - CHARACTER*128 TEMP - - INPUT_OUT = ' ' - - I = 0 - - DO WHILE (I.LT.TRIM(INPUT)) - INPUT = INPUT(I+1:) - IF (I.GT.0) INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//',' - I = MINGT0(INDEX(INPUT,','),TRIM(INPUT)+1) - IF (INDEX(INPUT,',').EQ.I.AND.INDEX(INPUT(:I),'@').EQ.0) - & I = TRIM(INPUT)+1 - TEMP = INPUT(:I-1) - CALL ADD_PROTOCOL_SUB(TEMP) - INPUT_OUT = INPUT_OUT(:TRIM(INPUT_OUT))//TEMP(:TRIM(TEMP)) - END DO - - INPUT = INPUT_OUT - - IF (ILEN.NE.0) ILEN = TRIM(INPUT) - - RETURN - END - - - - SUBROUTINE ADD_PROTOCOL_SUB(INPUT) - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLNEWS.INC' - - CHARACTER*20 MAIL_PROTOCOL - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - I = INDEX(INPUT,'<') - IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form - INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1) - ! personal-name - END IF - - IF (LMAIL.EQ.0) THEN - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN - MAIL_PROTOCOL = MAILER - END IF - LMAIL = TRIM(MAIL_PROTOCOL) - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%' - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1 - RETURN - END IF - END IF - - I = INDEX(INPUT,'@') - IF (I.GT.0) THEN - INPUT = INPUT(:INDEX(INPUT(I:),' ')+I-2) - IF (INDEX(INPUT(I:),'(').GT.0) - & INPUT = INPUT(:INDEX(INPUT(I:),'(')+I-2) - END IF - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"' - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bulletin3.for b/decus/vmslt98b/bulletin/bulletin3.for deleted file mode 100644 index 3e5d87d..0000000 --- a/decus/vmslt98b/bulletin/bulletin3.for +++ /dev/null @@ -1,2518 +0,0 @@ -C -C BULLETIN3.FOR, Version 11/2/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2100' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (UPDATE_DONE.GE.0) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - END IF - END IF - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2100' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - IF (USERFILE_OPEN.EQ.0) THEN - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM) - IF (DIFF.GT.0) THEN - START = START + 1 - CALL READDIR(START,IER) - ELSE ! SYSTEM bulletin was not seen - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSE - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IF - - CALL CLOSE_BULLDIR - - RETURN - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAY - - DIMENSION EXTIME_BIN(2),NOW(2) - - EXTERNAL CLI$_ABSENT - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - - ILEN = 0 - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN) - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0) - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE. - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIRE - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0) - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULT - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR. - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was set - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date - SYSTEM = SYSTEM.OR.2 ! make permanent - EXPDAT = '5-NOV-2100 00:00:00.00' - ELSE ! Else set expiration - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4) - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4) - ELSE - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2100 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - END IF - END IF - END IF - ELSE - RETURN - END IF - - IF (ILEN.LE.0) THEN - IER = 0 - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND. - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-') - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME_BIN) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - IF (TIMLEN.EQ.16) THEN - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME_BIN,EXTIME_BIN) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME_BIN,) - END IF - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND. - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limit - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23)) - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell user - IER = 0 ! Set error for return value - GO TO 5 ! Re-request date (if prompting) - END IF - - IF (PROMPT) THEN - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT)) - END IF - END IF - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.') -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss') -1040 FORMAT(' ERROR: Invalid date format specified.') -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.') - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUT - DATA MAIL_EDIT /' '/ - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - EXTERNAL ERROR_TRAP - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')') - RETURN - END IF - - IF (MAIL_EDIT.EQ.' ') THEN - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO - CLOSE (UNIT=10) - IF (IER.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - END IF - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IF - - CALL DISABLE_PRIVS - CALL DECLARE_CTRLC_AST - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:) - IF (OUT.EQ.INFILE) THEN - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT)) - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND) - ELSE - IF (TRIM(MAIL_EDIT).EQ.0) MAIL_EDIT = 'CALLABLE_TPU' - -C The string CALLABLE_ was found. Extract the editor name from the -C string and look up the entry point in the shareable image. - - N = INDEX(MAIL_EDIT,'_')+1 - IER = LIB$FIND_IMAGE_SYMBOL( - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'SHR', - & MAIL_EDIT(N:TRIM(MAIL_EDIT))//'$EDIT',ENTRYADDR) - IF (IER) THEN - CONTEXT = 0 - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (MAIL_EDIT.EQ.'CALLABLE_EDT') THEN - IF (.NOT.IER1) THEN - CALL EDT$EDIT('NL:',OUT) - ELSE - CALL EDT$EDIT(INFILE,OUT) - END IF - ELSE - IF (.NOT.IER1) THEN - CALL EDITMESSAGE(%VAL(ENTRYADDR),' ',OUT) - ELSE - CALL EDITMESSAGE(%VAL(ENTRYADDR),INFILE,OUT) - END IF - END IF - CALL LIB$ESTABLISH(ERROR_TRAP) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL LIB$REVERT - ELSE - WRITE(6,'('' Could not activate editor.'')') - END IF - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - SUBROUTINE EDITMESSAGE(EDITOR,INFILE,OUTFILE) - - CHARACTER*(*) INFILE,OUTFILE - - EXTERNAL EDITOR - - CALL EDITOR(INFILE,OUTFILE) - - RETURN - END - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - LOGICAL*1 QUOTA(32) - - DIMENSION IMAGEPRIV(2) - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')') - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')') - CALL EXIT - ELSE IF (.NOT.JUST_STOP.AND. - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV) - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN - WRITE (6,'('' ERROR: This new version of BULLETIN'', - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IF - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXIT - END IF - - CALL DELPRC('BULLCP',IER) - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')') - CALL EXIT - END IF - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP is not presently running.'')') - CALL EXIT - END IF - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY) - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -C -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.) -C - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:' - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1) - - IER = 0 - DO WHILE (IER.EQ.0.OR.IER.EQ.SS$_DUPLNAM) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1) - END IF - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - ELSE - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'', - & '' does not exist.'')') - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IF - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP) - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1 - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - TEST_BULLCP = BULLCP - - RETURN - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIME - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME) - - BULLCP = 2 ! Enable process to do BULLCP functions - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXIT - END IF - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP - - CALL SET_REMOTE_SYSTEM - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - NOW = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - - DO WHILE (NEWS_LOOP.GE.0) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER) - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - IF (.NOT.NOW) NOW = INDEX(NEW_TIME,' 03:').NE.0.AND. - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1 - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - IF (IER) THEN - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.1000.AND.NEMPTY.GT.NBLOCK/10) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IF - END IF - END IF - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IF - CALL SYS$SETAST(%VAL(0)) - CALL REGISTER_BULLCP - IER1 = 1 - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1)) - - BBOARD_LOOP = BBOARD_LOOP + 1 - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & (NEWS_LOOP.EQ.0.OR.NOW)) THEN - IF (NOW) THEN - CALL CREATE_PROCESS('BULLCP NEWS1') - ELSE - CALL CREATE_PROCESS('BULLCP NEWS') - END IF - END IF - CALL SYS$SETAST(%VAL(1)) - - C = 0 - IF (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //'*.SMTP',INPUT,C)) THEN - CALL CREATE_PROCESS('BULLCP SMTP') - END IF - - NOW = .FALSE. - - NEWS_LOOP = NEWS_LOOP + 1 - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIME - CALL HIBER('15') ! Wait for 15 minutes -C -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0)) - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - CALL SYS$SETAST(%VAL(1)) - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURN - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - DIMENSION NEW_SYSTEM_FLAG(FLONG) - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - CALL OPEN_BULLFOLDER_SHARED - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (BTEST(FOLDER_FLAG,2)) - & CALL SET2(NEW_SYSTEM_FLAG,FOLDER_NUMBER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THEN - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER) - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF - CALL SETUSER(USERNAME) - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - FOLDER1_FLAG = FOLDER_FLAG - DO FOLDER_NUMBER=0,FOLDER_MAX-1 - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND..NOT. - & TEST2(NEW_SYSTEM_FLAG,FOLDER_NUMBER)) THEN - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - END DO - FOLDER_FLAG = FOLDER1_FLAG - FOLDER_NUMBER = 0 - - RETURN - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER REGNODE*8 - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,REGNODE,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - - IF (IER.NE.0) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0 - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - CALL CLOSE_BULLUSER - ELSE - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - IF (NODENAME.EQ.REGNODE) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - END DO - IF (TEMP_USER(:1).NE.':'.OR.IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - END IF - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=TEMP_USER(2:LEN(TEMP_USER))//'::"TASK=BULLETIN1"') - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) - & 16,REGNODE,NODENAME - END IF - CLOSE (UNIT=REMOTE_UNIT) - END DO - END IF - - RETURN - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG) - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG) - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER) - - SEEN_FLAG = 0 - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - - SUBROUTINE HIBER(MIN) -C -C SUBROUTINE HIBER -C -C FUNCTION: Waits for specified time period in minutes. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURN - END - - - - SUBROUTINE WAIT_SEC(PARAM) -C -C SUBROUTINE WAIT_SEC -C -C FUNCTION: Waits for specified time period in seconds. -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER PARAM*(*) - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF) - - IER=SYS$BINTIM('0 00:00:'//PARAM//'.00',TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set. - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -C -C SUBROUTINE DELETE_EXPIRED_NEWS -C -C FUNCTION: -C -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - CHARACTER*4 GET_VMS_VERSION - - INTEGER TODAY(2),NEXT_EX_BTIM(2),NO_EXPIRE(2) - - CHARACTER*8 TODAY_KEY,TEMP - CHARACTER ASCTIME*24 - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - IF (NOW) THEN - IER = SYS$SETPRN('BULL NEWS1') - IF (.NOT.IER) CALL EXIT - IER = SYS$SETPRN('BULL NEWS') - IF (.NOT.IER) CALL EXIT - END IF - - FOLDER_NUMBER = 1000 - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) - END DO - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - RETURN - END IF - - CALL SYS_BINTIM('-',TODAY) - - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - REMOTE_SET = 4 - -C -C A bug keeps messing up the last expired date key so that stored -C news groups do not get found. Someday when this is fixed, we can -C add code like this: -C -C INPUT = GET_VMS_VERSION() -C IF (INPUT(:2).EQ.'V5'.OR.INPUT(:2).EQ.'V4') VMSOLD = .TRUE..AND.NOW - - DO WHILE (IER.EQ.0) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER).OR.(NOW.AND.IER.EQ.0.AND. - & (.NOT.BTEST(NEWS_F_FLAG,8).OR. - & COMPARE_BTIM(TODAY,NEWEST_EXBTIM).LT.0))) - IF (NOW) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - ELSE - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END IF - END DO - CALL NEWS_TO_FOLDER - - UNLOCK 7 - - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - GO TO 1000 - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,8)) GO TO 900 - - CALL OPEN_BULLDIR_SHARED - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0 - NDEL = -1 - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM) - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. - IF (NDEL.GT.NEWS_F_END) THEN - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1 - CALL READ_NEXT_EXPIRED(NDEL) - ELSE IF (EXDATE(8:11).LT.'1995') THEN ! Deleted manually? - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) - EXTIME = ASCTIME(13:23) - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0 - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0 - UNLOCK 2 - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER) - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_START - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - IF (I.LE.F_NBULL) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0 - END DO - F_START = I - NEXT = .FALSE. - END IF - CALL READDIR(F_NBULL,IER) - IF (F_START.LT.F_NBULL.AND.(DN.OR.F_NBULL.EQ.IER)) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I) - I = I - 1 - IF (I.GE.F_START) CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = I - END DO - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLDIR - END DO - -900 CALL CLOSE_BULLNEWS - -1000 IF (NOW.OR.IER.EQ.0) THEN - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.*]'//'*.' - INPUT = GET_VMS_VERSION() - CALL LIB$DAY_OF_WEEK(TODAY,DAY) - IF (DAY.NE.7) THEN - IER = SYS_TRNLNM('BULL_NEWS_CLEANUP','DEFINED') - IF (IER) THEN - DAY = 7 - CALL DELLNM('BULL_NEWS_CLEANUP') - END IF - END IF - IF (INPUT(:2).NE.'V5'.AND.INPUT(:2).NE.'V4') THEN - CONTEXT = 0 - DO WHILE (LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT)) - IER = CONV$RECLAIM(INPUT(:TRIM(INPUT))) - END DO - ELSE IF (DAY.EQ.7) THEN - REMOTE_SET = 4 - DIRLIST = .TRUE. - NEWSLIST = .TRUE. - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(1000,IER) - CALL READ_FOLDER_FILE(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NO_EXPIRE) - DO WHILE (IER.EQ.0) - UNLOCK 7 - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE), - & %DESCR(NEWEST_EXBTIM)) - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - C = 0 - IF (LIB$FIND_FILE(BULLNEWSDIR_FILE - & (:TRIM(BULLNEWSDIR_FILE))//';1',INPUT,C)) THEN - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';2') - ELSE - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - END IF - CALL OPEN_BULLDIR_SHARED - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE,SHARED, - & BUFFERCOUNT=127, - & INITIALSIZE=(NEWSDIR_RECORD_LENGTH*F_COUNT)/512, - & STATUS='NEW',FORM='UNFORMATTED',DISPOSE='DELETE', - & RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,IOSTAT=IER, - & ORGANIZATION='INDEXED',RECORDTYPE='FIXED', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - END IF - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (2,IOSTAT=IER) NEWSDIR_ENTRY - END DO - IF (IER.EQ.0) THEN - WRITE (9,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - RETURN - ELSE - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY), - & %DESCR(EX_BTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & CALL COPY2(NEWEST_EXBTIM,EX_BTIM) - END IF - END IF - END DO - CLOSE (UNIT=9,DISPOSE='KEEP') - CALL CLOSE_BULLDIR_DELETE - CALL GET_MSGKEY(NEWEST_EXBTIM,TEMP) - IF (TEMP.NE.NEWS_F_EXPIRED_DATE) THEN - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - NEWS_F_EXPIRED_DATE = TEMP - CALL REWRITE_FOLDER_FILE(IER) - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - END IF - IER = LIB$RENAME_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)),'*.*;1') - ELSE - IF (NO_EXPIRE(1).NE.NEWEST_EXBTIM(1).OR. - & NO_EXPIRE(2).NE.NEWEST_EXBTIM(2)) THEN - CALL GET_MSGKEY(NO_EXPIRE,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL OPEN_BULLDIR - CALL CLOSE_BULLDIR_DELETE - ELSE - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - END IF - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE( - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE))//';') - END DO - END IF - CALL READ_FOLDER_FILE(IER) - END DO - CALL CLOSE_BULLNEWS - END IF - DIRLIST = .FALSE. - NEWSLIST = .TRUE. - CALL COPY2(EX_BTIM,TODAY) - BULLFIL = 0 - IER = .TRUE. - DO WHILE (IER) - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;') - IER = INDEX(FOLDER_FILE,']1JAN').EQ.0 - END DO - J = INDEX(FOLDER_FILE,']') - DECODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) THEN - DO I=1,10 - YEAR = YEAR - 1 - IF (YEAR.EQ.-1) YEAR = 99 - ENCODE(2,'(I2)',FOLDER_FILE(J-2:J-1),IOSTAT=IER) YEAR - IF (IER.EQ.0) IER = LIB$DELETE_FILE(FOLDER_FILE(:J) - & //'*.*;*') - END DO - END IF - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IF - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED -C -C SUBROUTINE DELETE_EXPIRED -C -C FUNCTION: -C -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files, -C they get converted now. The directory file has had it's record size -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed and -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ') - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND. - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER1.LE.0) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to update - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc. - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - END IF - CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE BBOARD -C -C SUBROUTINE BBOARD -C -C FUNCTION: Converts mail to BBOARD into non-system bulletins. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - COMMON /MAIL_INFO/ USE_INFROM - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76 - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX) - - DATA SPAWN_EF/0/ - - CALL SYS$SETAST(%VAL(0)) - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF) - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - CALL SYS$SETAST(%VAL(1)) - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1)) - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0 - -1 POINT_FOLDER = POINT_FOLDER + 1 - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0)) - - FOLDER_Q_SAVE = FOLDER_Q - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1 -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD account - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST') - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV' - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)// - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'READ/NEW' - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL' - WRITE(11,'(A)') 'SELECT/NEW' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - ELSE - CONTEXT = 0 - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - END IF - END IF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM) - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original account - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1)) - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM) - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store username - ELSE IF (INPUT(:5).EQ.'Subj:') THEN - INDESCRIP = INPUT(7:) ! Store subject - ELSE IF (INPUT(:3).EQ.'To:') THEN - INTO = INPUT(5:) ! Store address - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DO - - INTO = INTO(:TRIM(INTO)) - CALL STR$TRIM(INTO,INTO) - CALL STR$UPCASE(INTO,INTO) - FLEN = TRIM(FOLDER_BBOARD) - - IER = 0 - CALL STRIP_HEADER(' ',-1,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.EQ.0) THEN - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP) - IF (STRIP.AND.INPUT(:5).EQ.'From:') INFROM = ' ' - END IF - END DO - -C -C If more than one folder has same BBOARD account, don't use the -C To: line to determine which folder to put the mail message in. -C - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - DUP = .FALSE. - DO WHILE (.NOT.DUP.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - DUP = FOLDER.NE.FOLDER1.AND.FOLDER_BBOARD.EQ.FOLDER1_BBOARD - END DO - IF (DUP.OR..NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - FOUND = .FALSE. - J = 0 - IF (DUP) J = 1 - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM) - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THEN - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - FOUND = INTO.EQ.F_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - END IF - FLEN = TRIM(F_BBOARD) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND) - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DO - END IF - END IF - END DO - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COM - END IF - - NUMHEAD = 0 - IF (NHEAD.GT.0) NUMHEAD = NHEAD + 1 - - IF (NUMHEAD.GT.0) THEN - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5 - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM) - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line - I = I - 1 - END DO - IF (I.GT.0) INFROM = INFROM(:I) - - FOLDER_NAME = FOLDER ! For broadcasts - - SAVE_Q = HEADER_Q - SAVE_Q1 = HEADER_Q1 - NHEAD1 = NHEAD - HEADER_Q1 = 0 - ! INIT_MESSAGE_ADD_BBOARD reinits header so save it - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER) - - ISTART = 0 - NBLANK = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IF - ELSE - ISTART = 1 - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ') - END DO - NBLANK = 0 - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NUMHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - ELSE IF (NUMHEAD.EQ.1) THEN - INPUT = ' ' - LEN_INPUT = 1 - NUMHEAD = NUMHEAD - 1 - ELSE - CALL READ_QUEUE(%VAL(SAVE_Q),SAVE_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NUMHEAD = NUMHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12) - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - END DO - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE - NBLANK = NBLANK + 1 - END IF - END IF - END DO - - USE_INFROM = .TRUE. - - NHEAD = NHEAD1 - HEADER_Q1 = SAVE_Q1 - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1)) - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file - CALL SYS$SETAST(%VAL(1)) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRL - FOLDER_SET = .FALSE. - - IF (NBBOARD_FOLDERS.EQ.0) THEN - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM) - REWRITE (4) USER_HEADER ! Rewrite header - CALL CLOSE_BULLUSER - END IF - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL SYS$SETAST(%VAL(1)) - IF (.NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) - & CALL NEWS2BULL(.FALSE.) - END IF - CALL SYS$SETAST(%VAL(1)) - - RETURN - -910 WRITE (6,1010) - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE. - - LEN_BBOARD = LEN(BBOARD) - 1 - LEN_INPUT = TRIM(INPUT) - - DO I=1,LEN_INPUT-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND. - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND. - & (I.EQ.LEN_INPUT-LEN_BBOARD.OR. - & (INDEX('@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0 - & .AND.(I.EQ.1.OR.(INPUT(I-1:I-1).NE. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).AND. - & (INPUT(I-1:I-1).NE.'('.OR. - & INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1).NE.' ')))))) RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURN - END - - - - LOGICAL FUNCTION ALPHA(IN) - - CHARACTER*(*) IN - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURN - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN - - BBOARD_NAME = FOLDER_DESCRIP(I+1:) - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!') - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DO - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURN - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - LOGICAL*1 QUOTA(32) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY) - - IER = 0 - DO WHILE (IER.EQ.0) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE') - END DO - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - IF (INDEX(IMAGENAME,';').GT.0) ILEN = INDEX(IMAGENAME,';') - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''' - WRITE(11,'(A)') '$EXIT:' - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11) - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0) - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',, - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH)) - IF (.NOT.IER.AND..NOT.DEL) THEN - CALL DELPRC('BULLCP NEWS',DEL) - IER = .NOT.DEL - ELSE - IER = .TRUE. - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI) -C -C SUBROUTINE GETQUOTA -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - LOGICAL*1 QUOTA(32) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL ADD_2_ITMLST(4,JPI$_BYTLM,%LOC(BYTLM)) - CALL ADD_2_ITMLST(4,JPI$_ENQLM,%LOC(ENQLM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI) THEN - IF (CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTA - QUOTA(1) = PQL$_PGFLQUOTA - CALL LIB$MOVC3(4,PGFLQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - END IF - IF (CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF - END IF - QUOTA((I-1)*5+1) = PQL$_WSEXTENT - CALL LIB$MOVC3(4,WSEXTENT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSQUOTA - CALL LIB$MOVC3(4,WSQUOTA,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_WSDEFAULT - CALL LIB$MOVC3(4,WSDEFAULT,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_BYTLM - CALL LIB$MOVC3(4,BYTLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_ENQLM - CALL LIB$MOVC3(4,ENQLM,QUOTA((I-1)*5+2)) - I = I + 1 - QUOTA((I-1)*5+1) = PQL$_LISTEND - CALL LIB$MOVC3(4,0,QUOTA((I-1)*5+2)) - - RETURN - END - - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -C -C FUNCTION: -C To get UIC of process submitting the job. -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UIC -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2) - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - CHARACTER*4 FUNCTION GET_VMS_VERSION -C -C FUNCTION GET_VMS_VERSION -C -C FUNCTION: Gets VMS version -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER VERSION*4 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,SYI$_NODE_SWVERS,%LOC(VERSION)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - GET_VMS_VERSION = VERSION - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR. - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:) - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN - NEW_MAIL(I) = .TRUE. - ELSE - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE. - END IF - END DO - - CLOSE (10) - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN) -C -C FUNCTION: -C To get image name of process. -C OUTPUT: -C IMAGNAME - Image name of process -C ILEN - Length of imagename -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - ELSE - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1 - END IF - END IF - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2) - - CALL OPEN_BULLDIR_SHARED - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1 - CALL READDIR(START,IER) - END DO - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - CALL CLOSE_BULLUSER - CALL CLOSE_BULLDIR - - RETURN - END - - - - - - SUBROUTINE READ_NOTIFY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAM - - DATA OBIO/0/,OCPU/0/,ODIO/0/ - - CHARACTER PRCNAM*16 - - TEST = 'BULLCP NEWS'.EQ.DELNAM - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU)) - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IF - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1 - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM) - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - END IF - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND. - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIO - ODIO = DIO - OCPU = CPU - IER = 0 - RETURN - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IF - RETURN - END diff --git a/decus/vmslt98b/bulletin/bulletin4.for b/decus/vmslt98b/bulletin/bulletin4.for deleted file mode 100644 index dc260ac..0000000 --- a/decus/vmslt98b/bulletin/bulletin4.for +++ /dev/null @@ -1,2346 +0,0 @@ -C -C BULLETIN4.FOR, Version 12/17/97 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9) - READ (9,IOSTAT=IER) USERNAME - END DO - - CALL CLOSE_BULLINF - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USER - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -C -C SUBROUTINE COPY_BULL -C -C FUNCTION: To copy data to the bulletin file. -C -C INPUT: -C INLUN - Input logical unit number -C IBLOCK - Input block number in input file to start at -C OBLOCK - Output block number in output file to start at -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -C -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. The -C bulletin file is assumed to be opened on logical unit 1. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THEN - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)') - END DO - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0 - LENGTH = 0 - DO WHILE (LENGTH.GE.0) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH) - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file. - ILEN = ILEN - 2 - END IF - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THEN - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM' - END IF - END IF - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IF - END DO - IF (NBLANK.GT.0) THEN - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DO - LENGTH = LENGTH + NBLANK*2 - NBLANK = 0 - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DO - -100 LENGTH = (LENGTH+127)/128 - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSE - IER = 0 - END IF - - CALL FLUSH_BULL(OCOUNT) - - RETURN - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /STORE_POINT/ POINT - DATA POINT/-1/ - - CHARACTER INPUT*(*),OUTPUT*255 - - IF (POINT.EQ.-1) THEN - POINT = 0 - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT) - END IF - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN) - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT) - END IF - - RETURN - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINT - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUT - POINT = ILEN + 1 - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN) - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:) - POINT = ILEN - (BRECLEN-1-POINT) - END IF - OCOUNT = OCOUNT + 1 - DO WHILE (POINT.GE.BRECLEN) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSE - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN) - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT) - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1 - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUT - - IF (REMOTE_SET) THEN - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSE - WRITE (1'OCOUNT) OUTPUT - END IF - - RETURN - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFER - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF - CHARACTER*256 REFERENCES - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read? - CALL STRIP_HEADER(' ',-1,IER) - STRIP = .NOT.HEADER - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - READ_HEAD = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zero - ILEN = 0 ! to request next line - END IF - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (ILEN.GE.0) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) THEN ! No more records. - IF (STRIP.AND..NOT.READ_HEAD.AND.NHEAD.GT.0) THEN - IBLOCK = SBLOCK - ILEN = LINE_LENGTH+1 - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - READS = 0 - IF (SEEN_FROM) READS = READS + 1 - IF (SEEN_SUBJ) READS = READS + 1 - IF (MSG_SENT) READS = READS + 1 - IF (READS.GT.0) THEN - DO I=1,READS - ILEN = 0 - DO WHILE (ILEN.EQ.0) - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - END DO - END DO - END IF - STRIP = .FALSE. - ELSE - RETURN - END IF - END IF - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE. - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE. - RETURN - ELSE - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND. - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE. - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN) - END IF - LREF = TRIM(REFERENCES) - END IF - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' ' - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' '.AND..NOT.MAIL_POST()) THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE. - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0 - IF (STRIP.AND.BUFFER(:5).EQ.'From:') READ_HEAD = .TRUE. - IF (.NOT.STRIP.AND..NOT.READ_HEAD.AND.NHEAD.GT.0) THEN - IBLOCK = SBLOCK - ILEN = LINE_LENGTH+1 - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - READS = 0 - IF (SEEN_FROM) READS = READS + 1 - IF (SEEN_SUBJ) READS = READS + 1 - IF (MSG_SENT) READS = READS + 1 - IF (READS.GT.0) THEN - DO I=1,READS - ILEN = 0 - DO WHILE (ILEN.EQ.0) - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - END DO - END DO - END IF - END IF - ELSE - IF (.NOT.HEADER) THEN - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - STRIP = .FALSE. - END IF - IF (TRIM(BUFFER).EQ.0) THEN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 - END IF - RETURN - END IF - ELSE - RETURN - END IF - END DO - - RETURN - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC) - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -C -C FUNCTION: Outputs line from folder file. -C -C INPUT: -C IBLOCK - Input block number in input file to read from. -C -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -C -C NOTE: Since message file is stored as a fixed length (128) record file, -C but message lines are variable, message lines may span one or -C more record. This routine takes a record and outputs as many -C lines as it can from the record. When no more lines can be -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH) - - DATA POINT /1/, LEFT_LEN /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read? - POINT = 1 ! Initialize pointers. - LEFT_LEN = 0 - DTYPE = 0 - END IF - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DO - ELSE IF (REMOTE_SET) THEN ! Remote folder? - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - IER = 0 - ELSE ! Local folder - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DO - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THEN - DTYPE = 1 - POINT = POINT + 1 - END IF - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine. - RETURN - END IF - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1 - LEFT_LEN = 0 - RETURN - END IF - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read. - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSE - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1) - & //TEMP(:LEFT_LEN),BUFFER,OLEN) - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0 - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read. - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message. - ELSE ! Else message line fully read - ILEN = OLEN - IF (DTYPE.EQ.0) THEN - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLEN - ELSE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IF - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record. - ! Returns length of next line. - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length. - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -C -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THEN - CALL READDIR(0,IER) - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IF - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2) - - NEMPTY = NEMPTY + LENGTH - - CALL WRITEDIR(0,IER) - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -C -C FUNCTION: -C To delete a directory entry. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER DUMP_FILE*80 - - IF (BTEST(FOLDER_FLAG,1)) THEN - DUMP_FILE = FOLDER_FILE - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - DO I=1,TRIM(DUMP_FILE) - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (IER.NE.0) RETURN - - IER = SYS$PARSE_ACL('(IDENTIFIER='//FOLDER_OWNER( - & :TRIM(FOLDER_OWNER))//',ACCESS=R+W+E+D+C)',ACLENT,,) - IF (IER) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,DUMP_FILE(:TRIM( - & DUMP_FILE))//'.LOG',%VAL(ACL_ITMLST),,,) - END IF - ELSE - WRITE (3,'(A)') CHAR(12) - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - WRITE(3,1050) INPUT(7:MIN(ILEN,LINE_LENGTH-3)) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IF - -1050 FORMAT('Subject: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11) - - RETURN - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12) - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DO - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - - NUM_DAYS = NDAYS ! Put number of days into buffer variable - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN - ! If expiration date exceeds end of month - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of month - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27 - END IF - END IF - ELSE ! If expiration date is within the month - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exit - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date - - RETURN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT) -C -C SUBROUTINE GET_LINE -C -C FUNCTION: -C Gets line of input from terminal. -C -C OUTPUTS: -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES: -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST. -C - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 DESCRIP(8),DTYPE,CLASS - INTEGER*2 LENGTH - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE) - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/ - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER PROMPT*(*),NULLPROMPT*4 - LOGICAL USE_PROMPT - - USE_PROMPT = .FALSE. - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT) - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1 -C - - CALL DECLARE_CTRLC_AST - - LEN_INPUT = 0 ! Nothing inputted yet - -C -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line. -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt - ELSE - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT(:1)) ! Get line from terminal with no prompt - END IF - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT) - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO - CALL CONVERT_TABS(INPUT,LEN_INPUT) - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSE - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURN - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT) - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHAR - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLY - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...') - CALL SYS$CANEXH() - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXIT - END IF - FLAG = 1 ! to set flag - RETURN - END - - - - SUBROUTINE DECLARE_CTRLC_AST -C -C SUBROUTINE DECLARE_CTRLC_AST -C -C FUNCTION: -C Declares a CTRLC ast. -C NOTES: -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -C - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /CTRLC_FLAG/ FLAG - - FLAG = 0 ! Init CTRL-C flag - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_AST - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -C -C SUBROUTINE GET_INPUT_NOECHO -C -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2) - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./ - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IF - - RETURN - - ENTRY GET_INPUT_NUM(DATA,NLEN) - - DO I=1,LEN(DATA) - DATA(I:I) = ' ' - END DO - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE. - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IF - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM) - END IF - - RETURN - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal - - CALL DECLARE_CTRLC_AST - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THEN - CALL SET_NOKEYPAD - END IF - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9') - MASK(2) = IBCLR(MASK(2),I-32) - END DO - - RETURN - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C -C SUBROUTINE GETPAGSIZ -C -C FUNCTION: -C Gets page size of the terminal. -C -C OUTPUTS: -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1))) - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,) - - PAGE_LENGTH = ZEXT(DEVDEPEND(4)) - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURN - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL -C -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less). -C -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL IO$_SENSEMODE - - COMMON /TERM_CHAN/ TERM_CHAN - - COMMON CHAR_BUF(2) - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)' - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400.AND.IOSB(3).NE.0) THEN - SLOW_TERMINAL = .TRUE. - ELSE - SLOW_TERMINAL = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV -C -C SUBROUTINE SHOW_PRIV -C -C FUNCTION: -C To show privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')') - DO I=0,38 - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR. - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF - END DO - ELSE - WRITE (6,'('' ERROR: Cannot show privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE))) - END IF - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -C -C SUBROUTINE SET_PRIV -C -C FUNCTION: -C To set privileges necessary for managing bulletin board. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVS - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA', - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2) - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER) - END DO - RETURN - END IF - - OFFPRIV(1) = 0 - OFFPRIV(2) = 0 - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1) - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURN - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32) - END IF - ELSE - IF (PRIV_FOUND.LT.32) THEN - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32) - END IF - END IF - END DO - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1)) - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE - WRITE (6,'('' ERROR: Cannot modify privileges.'')') - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER - - RETURN - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -C -C SUBROUTINE ADD_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) THEN - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16) - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - END IF - END IF - END IF - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -C -C SUBROUTINE DEL_ACL -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID. -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /ACL/ ACLENT - CHARACTER ACLENT*256 - - CHARACTER ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - END IF - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM( - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,) - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP) - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IF - - RETURN - END - - - - - SUBROUTINE CREATE_FOLDER -C -C SUBROUTINE CREATE_FOLDER -C -C FUNCTION: Creates a new bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - CHARACTER RESPONSE*4 - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDER - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THEN - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - CALL STR$UPCASE(FOLDER,FOLDER) - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')') - RETURN - END IF - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR. - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')') - RETURN - END IF - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified? - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B) - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDER - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '', - & ''than 40 characters.'')') - END IF - FOLDER1_NUMBER = FOLDER_MAX - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSE IF (CLI$PRESENT('SYSTEM').AND. - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'', - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IF - - LENDES = 0 - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES) - ELSE - WRITE (6,'('' Enter one line description of folder.'')') - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THEN - WRITE (6,'('' Aborting folder creation.'')') - RETURN - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')') - RETURN - END IF - END DO - - CALL OPEN_BULLFOLDER ! Open folder file - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0) - ! See if folder exists - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'', - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - END IF - FOLDER_OWNER = FOLDER1_OWNER - END IF - ELSE - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -C - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')') - GO TO 910 - ELSE - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder directory file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot create folder message file.'')') - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - FOLDER1 = FOLDER ! Save for ADD_ACL - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER) - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1) - LAST_NUMBER = LAST_NUMBER + 1 - END DO - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')') - & FOLDER_MAX - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IF - - IF (.NOT.CLI$PRESENT('NODE')) THEN - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0 - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSE - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name? - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! If so, store name in directory file - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*' - FOLDER1 = FOLDER - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULL - END IF - - FOLDER_NAME = FOLDER - FOLDER_OWNER = FOLDER1_OWNER - - MAILTO = 0 - I = INDEX(FOLDER_DESCRIP,'<') - J = INDEX(FOLDER_DESCRIP,'>') - IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER_DESCRIP(I:),'@').LT.1.OR. - & INDEX(FOLDER_DESCRIP(I:),'@').GT.J-I+1).AND.NEWS_FEED()) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,4) - I = INDEX(FOLDER_DESCRIP,'[') - J = INDEX(FOLDER_DESCRIP,']') - END IF - - IF (I.GT.0.AND.J.GT.I.AND. - & (INDEX(FOLDER_DESCRIP(I:),'@').GT.1.AND. - & INDEX(FOLDER_DESCRIP(I:),'@').LT.J-I+1)) THEN - MAILTO = 1 - END IF - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - IF (I.GT.0.AND.J.GT.I.AND..NOT.NEWS_FEED().AND.MAILTO.EQ.0 - & .AND..NOT.BTEST(FOLDER_FLAG,11) - & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// - & 'an email address in the description? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 - END IF - - IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. - & .NOT.BTEST(FOLDER_FLAG,10)) THEN - WRITE (6,'('' A mailing address has been specified.'')') - CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// - & 'sent to and received from this address? (default=N) ') - IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN - MAILTO = 2 - WRITE (6,'('' SET POST_ONLY will be issued.'')') - ELSE - MAILTO = 3 - WRITE (6,'('' SET ADD_ONLY will be issued.'')') - END IF - END IF - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - - CLOSE (UNIT=1) - CLOSE (UNIT=2) - - NOTIFY = 0 - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THEN - BRIEF = 1 - READNEW = 1 - END IF - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - IF (CLI$GET_VALUE('COPY',FOLDER1,FLEN).NE.%LOC(CLI$_ABSENT)) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Unable to copy folder settings.'')') - ELSE - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - 1 - IF (.NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) THEN - LAST(1,FOLDER1_NUMBER+1) = LAST(1,FOLDER_NUMBER+1) - LAST(2,FOLDER1_NUMBER+1) = LAST(2,FOLDER_NUMBER+1) - REWRITE (9,IOSTAT=IER) TEMP_USER,LAST - END IF - END IF - END DO - CALL CLOSE_BULLINF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(SET_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SET_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - END IF - IF (TEST2(NOTIFY_FLAG,FOLDER1_NUMBER)) THEN - CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - END IF - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - END IF - - GO TO 1000 - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE. - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -C -C Description: -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has read -C access to an object if the object's protection is the ACL. -C - IMPLICIT INTEGER (A-Z) - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))// - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can't - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -C -C SUBROUTINE CREATE_NEWS_FOLDER -C -C FUNCTION: Creates a new newsgroup. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME) - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IF -C -C If file specified in command, read file. -C Else, read from the terminal. -C - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3) - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line entered - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file -2010 FORMAT(A) - ICOUNT = ICOUNT + ILEN - END IF - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER, - & 'Adding newsgroup.') - CLOSE (UNIT=3) - - RETURN - -920 WRITE(6,1020) -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURN - -910 WRITE(6,1010) -1010 FORMAT (' No news group was added.') - CLOSE (UNIT=3) - RETURN - - END - - - - - SUBROUTINE INIT_COMPRESS - - IMPLICIT INTEGER (A-Z) - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127 - DO J=0,127 - A(J,I) = ' ' - END DO - END DO - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DO - - J = 1 - DO I=1,8 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=10,31 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - DO I=127,254 - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I) - END DO - - RETURN - - ENTRY COMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - IF (ICHAR(IN(K:K)).GT.126) IN(K:K) = ' ' - IF (ICHAR(IN(K+1:K+1)).GT.126) IN(K+1:K+1) = ' ' - T(O:O) = A(ICHAR(IN(K:)),ICHAR(IN(K+1:))) - IF (T(O:O).NE.' ') THEN - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND. - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1)) - C = C + 1 - K = K + 1 - END DO - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1) - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0) - O = O + 1 - ELSE - T(O:O) = IN(K:K) - IF (ICHAR(T(O:O)).LT.9.OR.(ICHAR(T(O:O)).GT.9.AND. - & ICHAR(T(O:O)).LT.32)) T(O:O) = ' ' - K = K + 1 - O = O + 1 - END IF - END DO - IF (K.EQ.L) THEN - T(O:O) = IN(K:K) - ELSE - O = O - 1 - END IF - - OUT = T - - RETURN - - ENTRY UNCOMPRESS(IN,OUT,O) - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1 - T(O:O) = IN(I+2:I+2) - END DO - I = I + 3 - ELSE - B = UNMAP(J) - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1 - T(O:O) = IN(I:I) - ELSE - O = O + 2 - T(O-1:O) = B - END IF - I = I + 1 - END IF - END DO - - OUT = T(:O) - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bulletin5.for b/decus/vmslt98b/bulletin/bulletin5.for deleted file mode 100644 index 25192b7..0000000 --- a/decus/vmslt98b/bulletin/bulletin5.for +++ /dev/null @@ -1,2516 +0,0 @@ -C -C BULLETIN5.FOR, Version 3/5/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3) THEN - CALL SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - RETURN - ELSE IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - NODEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (NODEFAULT) THEN - IF (NOTIFY.NE.-1) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) THEN - CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - END IF - REWRITE(4) USER_HEADER - ELSE IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & (FOLDER1_NUMBER.EQ.0.AND.FOLDER1_BBOARD(:2).NE.'::')) THEN - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IF - - TEMP = FOLDER_FILE - FOLDER_FILE = FOLDER1_FILE - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1 - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"') - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIR - END IF - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folder - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away response - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IF - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - FOLDER_FILE = TEMP - FOLDER_SET = TEMPSET - - DELETE (7) - - IF (FOLDER1_NUMBER.NE.0.OR.FOLDER1_BBOARD(:2).NE.'::') THEN - ! Test is due to bug which changes folder number to zero - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBER - TEMP_FLAG = FOLDER_FLAG - IF (BTEST(FOLDER1_FLAG,2)) THEN - FOLDER_FLAG = IBCLR(FOLDER1_FLAG,2) - CALL MODIFY_SYSTEM_LIST(0) - END IF - CALL SET_FOLDER_DEFAULT(0,0,0) - FOLDER_FLAG = TEMP_FLAG - FOLDER_NUMBER = TEMP_NUMBER - END IF - - WRITE (6,'('' Folder removed.'')') - - IF (FOLDER.EQ.FOLDER1) THEN - CALL CLOSE_BULLFOLDER - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - RETURN - ELSE - REMOTE_SET = REMOTE_SET_SAVE - END IF - -1000 CALL CLOSE_BULLFOLDER - - RETURN - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER) -C -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -C -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES: -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote. -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)' - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADER - - COMMON /READIT/ READIT - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./ - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2) - - DATA LAST_NEWS_GROUP/0/ - - CALL UPDATE_EXCLUDE - - CALL UPDATE_USERINFO - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR. - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET').OR.(INCMD(:3).EQ.'SEA') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THEN - FOLDER1 = FOLDER1(:FLEN)//'GENERAL' - END IF - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IF - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0 - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info - FOLDER1_COM = FOLDER_COM - IER = 0 - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8)) REMOTE_SET_NEW = 4 - ELSE - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)) - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1 - CALL NEWS_LIST - CALL OPEN_BULLFOLDER_SHARED - FOLDER1 = FOLDER1_SAVE - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2 - END DO - FOLDER1 = FOLDER1_SAVE - END IF - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000 - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSE - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IF - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - END IF - FOLDER1 = FOLDER1_SAVE - END IF - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THEN - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THEN - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1 - IER = 0 - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER) - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!! - FOLDER1_FLAG = FOLDER1_FLAG.AND.3 - F1_EXPIRE_LIMIT = 0 - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - END IF - - CALL CLOSE_BULLFOLDER - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN - REMOTE_SET_NEW = 4 - CALL SYS_BINTIM('-',EX_BTIM) - END IF - END IF - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IF - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THEN - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1 - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THEN - WRITE (6,'('' Cannot connect to remote NEWS node.'')') - END IF - END IF - RETURN - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'// - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1 - ELSE IF (NEWS) THEN - REMOTE_SET_NEW = 3 - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & (F1_START.GT.0.OR.F_START.LE.F_NBULL)) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM) - F_COUNT = F1_COUNT - IF (F1_START.GT.0) THEN - IF (F1_NBULL.LT.F_NBULL) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER-1.GE.F1_NBULL) THEN - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) - END IF - ELSE - F_NBULL = F1_NBULL - END IF - F_START = F1_START - ELSE - F_START = F_NBULL + 1 - END IF - CALL REWRITE_FOLDER_FILE(IER) - END IF - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0) - END IF - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info - REMOTE_SET_NEW = 1 - END IF - END IF - - IF (IER.EQ.0) THEN ! Folder found - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1) - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')') - ELSE IF (NEWS) THEN - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IF - ELSE IF (OUTPUT) THEN - WRITE(6,'('' You are not allowed to access folder.'')') - WRITE(6,'('' See '',A,'' if you wish to access folder.'')') - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR. - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER) - CALL CLR2(SET_FLAG,FOLDER1_NUMBER) - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0 - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR. - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protected - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THEN - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set so - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THEN - FOLDER_SET = .TRUE. - ELSE - FOLDER_SET = .FALSE. - END IF - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDER - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - IF (COMMAND.AND.INCMD(:3).NE.'REP'.AND. - & INCMD(:3).NE.'DEL') HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IF - - IF (REMOTE_SET.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN - CALL OPEN_BULLFOLDER ! Update local folder information - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER1) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COM - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.IER1.EQ.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IF - END IF - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10) - & .AND..NOT.BTEST(FOLDER_FLAG,11).AND.WRITE_ACCESS) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s news group.'')') - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '', - & ''message to this folder''''s mailing list.'')') - END IF - END IF - END IF - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IF - - IF (OUTPUT) THEN - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP( - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE IF (REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - ELSE - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - ELSE IF (REMOTE_SET.EQ.3.OR.REMOTE_SET.EQ.4) THEN - BULL_POINT = F_START - 1 - END IF - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THEN - WRITE (6,'('' Folder only accessible for reading.'')') - END IF - READ_ONLY = .TRUE. - ELSE - READ_ONLY = .FALSE. - END IF - ELSE - READ_ONLY = .FALSE. - END IF - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THEN - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN - CALL UPDATE ! Need to update - END IF - ELSE - NBULL = 0 - END IF - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IF - END IF - - IF (OUTPUT) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - BULL_PARAMETER = 'MARKED' - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - BULL_PARAMETER = 'SEEN' - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED' - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN' - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THEN - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - WRITE(6,'('' WARNING: No '',A, - & '' messages found.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IF - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IF - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND. - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - BULL_POINT = 0 - END IF - END IF - END IF - END IF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - IF (BTEST(BULL_USER_CUSTOM,2)) HEADER = .TRUE. - ELSE IF (OUTPUT) THEN - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER) - END IF - ELSE ! Folder not found - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0 - END IF - - LAST_FOLDER_NUMBER = FOLDER_NUMBER - - RETURN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -C -C SUBROUTINE UPDATE_FOLDER -C -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - IF (FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_BULLFOLDER_SHARED ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message? - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURN - END - - - - SUBROUTINE SHOW_FOLDER -C -C SUBROUTINE SHOW_FOLDER -C -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IF - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT)) - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: invalid command for remote folder.'')') - RETURN - END IF - - IF (TEST_NEWS(FOLDER1)) THEN - INCMD = 'SET NEWS ' - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL ' - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THEN - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Access is limited.'')') - END IF - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1 - WRITE_ACCESS = 1 - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS) - END IF - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '', - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0) - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '', - & A,''. Remote folder name is '',A,''.'')') - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IF - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN) - END IF - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')') - IF (BTEST(GROUPB1,31)) THEN - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IF - ELSE - WRITE (6,'('' No BBOARD has been defined.'')') - END IF - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIRE - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSE - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,10)) THEN - WRITE (6,'('' POST_ONLY has been set.'')') - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THEN - WRITE (6,'('' COMPRESS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,14)) THEN - WRITE (6,'('' ANONYMOUS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,15)) THEN - WRITE (6,'('' GATEWAY has been set.'')') - END IF - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IF - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE. - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is BRIEF, which is permanent.'')') - ELSE - WRITE (6,'('' Default is BRIEF.'')') - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is READNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is READNEW.'')') - END IF - END IF - ELSE - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')') - ELSE - WRITE (6,'('' Default is SHOWNEW.'')') - END IF - END IF - END IF - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')') - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IF - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - IF (NEWS_FEED()) THEN - WRITE (6,'('' Last message fed by news group was: '',I)') F_LAST - END IF - END IF - - CALL CLOSE_BULLFOLDER - - RETURN - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/, - & ' Description: ',A) -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/, - & ' Description: ',A) - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT) -C -C SUBROUTINE DIRECTORY_FOLDERS -C -C FUNCTION: Display all FOLDER entries. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/ - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' ' - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURN - END IF - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE. - ACTIVE = .FALSE. - STORED = .FALSE. - CLASS = .FALSE. - NEW = .FALSE. - PERM = .FALSE. - DEFA = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counter - NLINE = 1 - START = .FALSE. - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE. - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THEN - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - CALL NEWS_LIST - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - END IF - COUNT = CLI$PRESENT('COUNT') - IF (COUNT) TOTAL_COUNT = 0 - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - NEW = CLI$PRESENT('NEWGROUPS') - CLASS = CLI$PRESENT('CLASS') - PERM = CLI$PRESENT('PERMANENT') - DEFA = CLI$PRESENT('DEFAULT') - IF (CLASS) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLNEWS_SHARED - END IF - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - ELSE IF (PERM) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE IF (DEFA) THEN - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - INUM = 1 - ELSE - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IF - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER) - IF (IER.NE.0) THEN - WRITE (6,'('' There are no folders.'')') - CALL CLOSE_BULLFOLDER - FOLDER_COUNT = -1 - RETURN - ELSE - START = .TRUE. - END IF - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN) - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*' - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0 - FOLDER_COUNT = -1 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN - SUBNUM = -2 - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - END IF - -C -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -C - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1 - - CALL DECLARE_CTRLC_AST - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE. - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1 - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE IF (PERM.OR.DEFA) THEN - IER = 1 - DO WHILE (INUM.LE.FOLDER_MAX.AND.IER.NE.0) - IF (INF_REC2(1,INUM).NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (ZEXT(INF_REC2(1,INUM)),IER) - END IF - INUM = INUM + 1 - END DO - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 2 - NEW_NEWS = FOLDER1_NUMBER - END IF - END DO - IF (IER.EQ.0) THEN - NEW_NEWS = FOLDER1_NUMBER - ELSE - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IF - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP) - IF (CLASS) NEWS_TEST = .FALSE. - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND. - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)), - & USERNAME,READ_ACCESS,-1) - ELSE - READ_ACCESS = 1 - END IF - END IF - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - FSTATUS1 = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (.NOT.NEWS_TEST) THEN - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN - IER1 = 1 - MORE = .TRUE. - END IF - END IF - IF (FLAG.EQ.1) IER1 = 1 - END DO - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1 - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IF - -C -C Folder entries are now in queue. Output queue entries to screen. -C - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THEN - WRITE (6,'(1X,''News group'',X,6X, - & ''First Last Count'', - & /,1X,(''-''))') - ELSE IF (CLASS) THEN - WRITE (6,'(1X,''Class'',/,1X,(''-''))') - ELSE IF (SUBSCRIBE) THEN - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,''Status'',7X, - & ''First Last'',/,1X,(''-''))') - END IF - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1 - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1.AND. - & FLAG.NE.100) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - I = I + 1 - END IF - IF (.NOT.NEWS) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - ELSE - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - ELSE - IF (NEWS_TEST) UNLOCK 7 - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - ELSE - FSTATUS1 = ' ' - END IF - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNT - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0 - END IF - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - IF (NEWS_NEW-1.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1015) '* '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-2), - & F1_START,F1_NBULL,NEWS_NEW-1 - END IF - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - ELSE - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IF - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBER - IF (NEWS_TEST.AND.FLAG.NE.1) THEN - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - CALL GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & FSTATUS1,IER,ACTIVE) - MORE = MORE.AND.FOUND - IF (MORE) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND.AND.FLAG.NE.1) FLAG = 100 - END IF - END DO - - IF (FLAG.EQ.1) THEN - WRITE (6,'('' Listing aborted.'')') - FOLDER_COUNT = -1 - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER - END IF - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNT - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSE - WRITE(6,1100) ! Else say there are more - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF - - RETURN - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10) -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -C -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENT - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THEN - ALL = .TRUE. - ELSE - ALL = .FALSE. - END IF - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE. - ELSE - READONLY = .FALSE. - END IF - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IF - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS.OR.CLI$PRESENT('CLASS')) THEN - IF (.NOT.CLI$PRESENT('CLASS')) THEN - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.' - END IF - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER ! Open folder file - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6, - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSE - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER) - CLOSE (UNIT=3) - CALL RESET_PROTECTION - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')') - RETURN - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0) - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER) - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVE - CALL SET_FOLDER_FILE(0) - END IF - END IF - ELSE - CALL DEL_ACL('*','R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THEN - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Cannot find file '',A)') - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - ELSE - FILE_OPEN = .TRUE. - END IF - ELSE - FILE_OPEN = .FALSE. - END IF - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INDEX(INPUT,'[').EQ.0.AND.INDEX(INPUT,']').GT.0.AND. - & ID(:1).EQ.'[') INPUT = ID(:TRIM(ID))//','//INPUT - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').GT.0) - & COMMA = INDEX(INPUT,']') + 1 - IF (INPUT(:1).EQ.'"'.AND.INDEX(INPUT(2:),'"').GT.0) - & COMMA = INDEX(INPUT(2:),'"') + 2 - IF (INPUT(:1).EQ.'['.AND.INDEX(INPUT,']').EQ.0) COMMA = 0 - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1) - INPUT = INPUT(COMMA+1:) - ILEN = TRIM(ID) - ELSE - ID = INPUT - INPUT = ' ' - ILEN = TRIM(ID) - END IF - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THEN - WRITE (6,'('' ERROR: Cannot modify access'', - & '' for owner of folder.'')') - ELSE IF (ID(:1).NE.'['.OR.INDEX(ID,']').NE.0) THEN - IF (ILEN.EQ.0) THEN - IER = SS$_IVIDENT - ELSE IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER) - ELSE - CALL ADD_ACL(ID,'R+W',IER) - END IF - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN) - CALL SYS_GETMSG(IER) - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN) - END IF - END IF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IF - END DO - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN - IF (NEWS) THEN - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IF - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL CLOSE_BULLFOLDER - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL) -C -C SUBROUTINE CHKACL -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAME - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*256 ACLENT - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THEN - IERACL = SS$_NORMAL.OR.IERACL - END IF - - RETURN - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -C -C FUNCTION: Checks ACL of given file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN - READ_ACCESS = 0 - END IF - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IF - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST)) - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IF - - RETURN - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -C -C FUNCTION: Shows users who are allowed to read private bulletin. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAME - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURN - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_OPEN/ NEWS_OPEN - - ENTRY WRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURN - - ENTRY WRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWS - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER_COM - END IF - - RETURN - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IF - - RETURN - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_TEMP(IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 SAVE_USERNAME - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) USER_ENTRY - END DO - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAME - - RETURN - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) - - SAVE_USERNAME = USERNAME - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY - END DO - - USERNAME = SAVE_USERNAME - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DO - - RETURN - - ENTRY WRITE_USER_FILE_NEW(IER) - - DO I=1,FLONG - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I) - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DO - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER)) - WRITE (4,IOSTAT=IER) USER_ENTRY - END DO - - RETURN - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - NEW_NEWS_ACCESS = - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS' - - RETURN - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_' - END DO - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1) - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C)) - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' ' - ELSE - FILE = FILE(:L) - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - F = LEN(FIND) - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURN - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_GROUP(MATCH,FOLDER_MATCH,MLEN,FOUND,STORED, - & STAT,IER,ACTIVE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($SSDEF)' - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /CTRLC_FLAG/ FLAG - - CHARACTER*(*) STAT,FOLDER_MATCH - - CHARACTER NEWS_ACCESS*132 - - FOUND = .FALSE. - STAR = INDEX(FOLDER_MATCH,'*') - ONE = STAR.EQ.0.AND.TRIM(FOLDER_MATCH).GT.0 - START = .FALSE. - IF (STAR.GT.1) - & START = FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1) - STARTNOW = START - - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND) - IF (ONE) THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER_MATCH(:TRIM(FOLDER_MATCH)),IER) - FOLDER_MATCH = ' ' - ELSE IF (STARTNOW) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP - & (FOLDER_MATCH(:STAR-1),IER) - STARTNOW = .FALSE. - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - END IF - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - STAT(:1) = FOLDER1_DESCRIP(J+1:) - ELSE - STAT = ' ' - J = TRIM(FOLDER1_DESCRIP) + 1 - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(STAT(:1).NE.'x'.AND. - & .NOT.BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (ONE.OR..NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:J-1),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1) - ELSE - FOUND1 = .TRUE. - END IF - END IF - FOUND = FOUND1 - ELSE - FOUND = .TRUE. - END IF - ELSE IF (IER.EQ.0.AND.START) THEN - IF (FOLDER_MATCH(:STAR-1).NE.FOLDER1(:STAR-1)) RETURN - END IF - IF (ONE) RETURN - END DO - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bulletin6.for b/decus/vmslt98b/bulletin/bulletin6.for deleted file mode 100644 index 8c1a401..0000000 --- a/decus/vmslt98b/bulletin/bulletin6.for +++ /dev/null @@ -1,2833 +0,0 @@ -C -C BULLETIN6.FOR, Version 11/2/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - COMMON /NEWSLIST/ NEWSLIST - - COMMON /DIRLIST/ DIRLIST - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - TRY = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.TRY.EQ.0) THEN - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - TRY = 1 - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL_NAME - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER2 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folder - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & BUFFERCOUNT=127, - & ORGANIZATION='INDEXED',IOSTAT=IER) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - END IF - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'( - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT - END IF - - LUN = 0 - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open file: '',A)') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - IF (UNIT.EQ.14) THEN - WRITE (6,'('' Database conversion in progress. Try later.'')') - ELSE - WRITE (6,'('' Please try again later.'')') - END IF - END IF - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($RMSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/ - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - COMMON /NEWSLIST/ NEWSLIST - DATA NEWSLIST/0/ - - COMMON /DIRLIST/ DIRLIST - DATA DIRLIST/0/ - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*44 SAVE_FOLDER - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14) - DATA NAME/2,1,0,3,0,0,4,0,5,0,0,0,0,6/ - - DATA LUN /0/ - - ENTRY OPEN_BULLNEWS_SHARED - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF_SHARED - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - DO WHILE (FILE_LOCK(IER,IER1)) - - IF (DIRLIST) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - ELSE - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN.OR. - & IER.EQ.FOR$IOS_INVKEYSPE) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - LUN = 0 - CALL CONVERT_BULLNEWSDIR - LUN = 2 - NTRIES = 0 - CALL SET_BULLNEWSDIR_FILE(FOLDER_NUMBER) - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR(BULLNEWSDIR_FILE(: - & INDEX(BULLNEWSDIR_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCK - SAVE_FOLDER = FOLDER - CALL GET_REMOTE_MESSAGE(IER) - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL_NAME - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE. - END IF - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (NEWSLIST) THEN - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & BUFFERCOUNT=127, - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - ELSE - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - END IF - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLNEWS(BULLNEWS_FILE) - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.10) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IF - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC) - END DO - END IF - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN) - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) WRITE(6,'(1X,A)') - & BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - END IF - - LUN = 0 - - RETURN - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z) - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - ENTRY SET_PROTECTION - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURN - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER - NEWS_FOLDER_NUMBER = FOLDER_NUMBER - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):) - NEWS_F_NBULL = F_NBULL - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LAST - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURN - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULL - NEWS_F1_COUNT = F1_COUNT - NEWS_F1_START = F1_START - NEWS_F1_LAST = F1_LAST - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1) - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2) - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER - - FOLDER = NEWS_FOLDER - FOLDER_NUMBER = NEWS_FOLDER_NUMBER - FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER))) - & //NEWS_FOLDER_DESCRIP - FOLDER_BBOARD = '::' - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_START - F_LAST = NEWS_F_LAST - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1) - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2) - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - - RETURN - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1 - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER - FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1))) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT - F1_NBULL = NEWS_F1_NBULL - F1_START = NEWS_F1_START - F1_LAST = NEWS_F1_LAST - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMIT - - RETURN - - END - - - - - SUBROUTINE CONVERT_BULLNEWSDIR - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($FORIOSDEF)' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - CHARACTER*180 TEMP - - CHARACTER BUFFER*12,DATETIME*24 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - CALL OPEN_BULLNEWS - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=180/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & BUFFERCOUNT=127,KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR]') - IF (.NOT.IER1) GO TO 900 - - NEW_FOLDER_NUMBER = 0 - - DO WHILE (IER.EQ.0) - READ (2,IOSTAT=IER) TEMP - IF (GET_INTEGER(%REF(TEMP)).NE.NEW_FOLDER_NUMBER) THEN - IF (NEW_FOLDER_NUMBER.NE.0) CLOSE (UNIT=9,DISPOSE='KEEP') - NEW_FOLDER_NUMBER = GET_INTEGER(%REF(TEMP)) - CALL SET_BULLNEWSDIR_FILE(NEW_FOLDER_NUMBER) - OPEN (UNIT=9,FILE=BULLNEWSDIR_FILE, - & STATUS='UNKNOWN',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & BUFFERCOUNT=127, - & KEY=(1:4:INTEGER,5:12:CHARACTER,13:20:CHARACTER, - & 57:64:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) GO TO 900 - END IF - NEWS_MSG_NUM = GET_INTEGER(%REF(TEMP(5:))) - NEWS_MSG_BTIM_KEY = TEMP(13:) - NEWS_EX_BTIM_KEY = TEMP(89:) - NEWS_MSGID = TEMP(21:) - CALL COPY2(MSG_BTIM,%REF(TEMP(97:))) - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL LIB$MOVC3(76,%REF(TEMP(105:)),NEWS_BLOCK) - - WRITE (9,IOSTAT=IER1) NEWSDIR_ENTRY - END DO - - CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - - CALL RESET_PROTECTION - - BULLNEWSDIR_FILE = 'BULLNEWSDIR.DAT' - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - - IER = LIB$RENAME_FILE(BULLNEWSDIR_FILE(:TRIM(BULLNEWSDIR_FILE)) - & ,'BULLNEWSDIR.OLD') - - WRITE (6,'('' BULLNEWSDIR.DAT has been renamed to '', - & '' BULLNEWSDIR.OLD and may now be deleted.'')') - - RETURN - -900 CALL RESET_PROTECTION - - CALL CLOSE_BULLNEWS - - WRITE(6,'('' ERROR: Cannot convert BULLNEWSDIR.DAT'')') - IF (IER.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT - - END - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*116 - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER(:115) - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END IF - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115) - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1 - DESCRIP = BUFFER(:) - FROM = BUFFER(54:) - BULLDIR_ENTRY(81:84) = BUFFER(85:) - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DO - -800 CLOSE (UNIT=9,DISPOSE='KEEP') - CLOSE (UNIT=2) - -900 CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILES -C -C SUBROUTINE CONVERT_BULLFILES -C -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletin -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8) - NEMPTY = 0 - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00' - ICOUNT = 2 - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER - END DO - CALL WRITEDIR(ICOUNT-1,IER1) - ICOUNT = ICOUNT + 1 - END IF - END DO - - CLOSE (UNIT=9) - CLOSE (UNIT=2) - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL RESET_PROTECTION - RETURN - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8) -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -C -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILE - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDER - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER)) - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL' - & ,STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE) - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THEN - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER) - NBLOCK = NBLOCK + 1 - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1 - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK) - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF - - CLOSE (UNIT=10) - CLOSE (UNIT=1) - - CALL CLOSE_BULLDIR - GOTO 100 - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -C -C SUBROUTINE CONVERT_BULLFOLDER -C -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - IF (ASK_SIZE.EQ.184) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST) - ELSE - F_LAST = 0 - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LAST - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0) - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER)) - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IF - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLDIRS - END IF - END DO - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - ELSE - CALL READDIR(0,IER) - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE - NEWEST_TIME = TIME - CALL WRITEDIR(0,IER) - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IF - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0 - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IF - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURN - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -C -C SUBROUTINE CONVERT_BULLNEWS -C -C FUNCTION: Converts bulletin NEWS file to new format. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - INCLUDE '($FORIOSDEF)' - - CHARACTER*(*) FILENAME - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. '' - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')) - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1 - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED', - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER, - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0 - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE) - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0 - NEWS_F_END = 0 - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108) - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:) - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1 - IF (LMOVE.LE.0) THEN - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIP - ELSE - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE)) - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) - END IF - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME) - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE) - - CALL RESET_PROTECTION - - RETURN - END - - - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC' - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME - - WRITE (6,'('' Converting data files to new format. Please wait.'')') - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD' - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - INQUIRE (UNIT=9,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - IF (IER.EQ.0) THEN - CALL SET_PROTECTION - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IF - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - CALL SYS_GETMSG(IER1) - CALL RESET_PROTECTION - CALL ENABLE_CTRL_EXIT - END IF - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0 - SET_FLAG(I) = 0 - END DO - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50 - IER = 0 - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(:12) - LOGIN_DATE = BUFFER(13:23) - LOGIN_TIME = BUFFER(24:31) - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flag - DO WHILE (IER.EQ.0) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM, - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IF - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4) - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -C -C SUBROUTINE READDIR -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS: -C ICOUNT - The last record read by this routine. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXT - - COMMON /KEEPLOCK/ KEEPLOCK - DATA KEEPLOCK/.FALSE./ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - COMMON /THREAD/ THREAD - - CHARACTER*4 CFOLDER_NUMBER - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DO - IF (IER.EQ.0) THEN - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSE - DIR_NUM = 0 - END IF - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURN - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDER - END IF - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0 -C -C Check to see if cleanup of empty file space is necessary, which is -C defined here as being 250 blocks (1000 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -C - IF (NEMPTY.GT.1000.AND.NEMPTY.GT.NBLOCK/10 - & .AND.TEST_BULLCP().EQ.0) THEN - WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP') - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL CLOSE_BULLFIL - CALL OPEN_BULLDIR - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPFIL','*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1') - END DO - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULL*','*.*;1') - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - NEMPTY = 0 - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - CALL OPEN_BULLFIL - END IF - END IF - ELSE - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEYGE=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.NE.0.AND.ICOUNT.EQ.F_START) THEN - READ(2,KEYGT=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - IF (IER.EQ.0) ICOUNT = NEWS_MSG_NUM - END IF - END IF - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START) - ICOUNT = ICOUNT - 1 - READ(2,KEY=ICOUNT - & ,KEYID=0,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND. - & MSG_NUM.GT.F_START) THEN - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER,IER2) - F_START = MSG_NUM - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IF - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THEN - ICOUNT = MSG_NUM - BULLETIN_NUM = ICOUNT - END IF - END IF - ELSE - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 - END IF - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IF (REMOTE_SET.NE.4) CALL STR$UPCASE(FROM,FROM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - END IF - END IF - - IF (IER.EQ.0) THEN - IF (.NOT.REMOTE_SET) THEN - ICOUNT = ICOUNT + 1 - IF (.NOT.KEEPLOCK) UNLOCK 2 - END IF - IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1 - ELSE IF (THREAD) THEN - DUMMY = INCLUDE_MSG(FROM,DESCRIP) - END IF - END IF - END IF - - RETURN - - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM) - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURN - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z) - - INTEGER TEMP - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP) - - TEMP = NUM - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I) - END DO - - RETURN - END - - - SUBROUTINE READDIR_KEYGE(IER) -C -C SUBROUTINE READDIR_KEYGE -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS: -C IER - If 0, no entry found. Else contains message number. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/1/ - - COMMON /KEEPLOCK/ KEEPLOCK - - COMMON /BULLFIL/ BULLFIL - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - -10 IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.2.OR.MSG_NUM.EQ.0) THEN - READ(2,KEYGT=MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THEN - MSG_NUM = NEWS_MSG_NUM - IF (MSG_NUM.GT.F_NBULL) THEN - IF (NEWS_KEYID.EQ.2.AND.MSG_NUM.NE.0) THEN - IF (MSG_NUM.GT.NEWS_F_END) THEN - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36 - UNLOCK 2 - END IF - END IF - END IF - ELSE - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97) - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - IER = 0 - DIR_NUM = -1 - END IF - ELSE - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THEN - IF (BTEST(BULL_USER_CUSTOM,3)) THEN - IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10 - END IF - END IF - - RETURN - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY),%DESCR(EX_BTIM)) - IF (POSTTIME) THEN - CALL GET_MSGKEY(%REF(NEWS_POST_KEY),%DESCR(MSG_BTIM)) - CALL CONVERT_FROM_GMT(MSG_BTIM) ! Assume stored is GMT - END IF - DESCRIP = NEWS_DESCRIP - FROM = NEWS_FROM - BLOCK = NEWS_BLOCK - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IF - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11) - EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) - - DATE = DATETIME(:11) - TIME = DATETIME(13:23) - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -C -C SUBROUTINE WRITEDIR -C -C FUNCTION: Writes the entry for the specified bulletin in the -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1. -C If 0, write the header of the directory file. -C OUTPUTS: -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CONV = .TRUE. - - GO TO 10 - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE. - -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1 - IF (DIR_NUM.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - END IF - END IF - ELSE - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IF (BULLETIN_NUM.NE.NEWS_F_END+1) THEN - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END DO - END IF - ELSE - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IF - IF (REMOTE_SET.EQ.4.AND. - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEN - CALL SPECIAL_NEWSDIR_ENTRY(IER) - ELSE IF (IER.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEN - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF - END IF - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - CHARACTER*140 TEMP - - DIMENSION BTIM(2) - - READ (2,KEYID=3,KEY=NEWS_POST_KEY,IOSTAT=IER) TEMP - DO WHILE (IER.EQ.0.AND.NEWS_POST_KEY.EQ.TEMP(57:64)) - IF (NEWS_MSGID.EQ.TEMP(21:56)) THEN - IER = 2 - RETURN - END IF - READ (2,IOSTAT=IER) TEMP - END DO - -10 IER1 = 0 - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=0,KEYGT=NEWS_F_END, - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - DO WHILE (IER1.EQ.0) - CALL LIB$MOVC3(4,%REF(INPUT),FNUM) - CALL GET_MSGKEY(%REF(INPUT(13:)),%DESCR(BTIM)) - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND. - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IF - F_COUNT = F_COUNT + 1 - CALL LIB$MOVC3(4,%REF(INPUT),NEWS_F_END) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - END DO - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IF - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSE - F_COUNT = F_COUNT + 1 - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - END IF - - RETURN - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - IF (REMOTE_SET.EQ.4) THEN - CALL CONVERT_TO_GMT(MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,MSG_BTIM) - ELSE - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - END IF - - IF (LOCAL_POST) THEN - CALL SYS_BINTIM(DATE//' '//TIME - & (:TRIM(TIME)-2)//'00',MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,NEWS_POST_KEY) - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP - NEWS_FROM = FROM - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH - NEWS_MSG_NUM = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,NEWS_MSG_BTIM_KEY) - CALL GET_MSGKEY(EX_BTIM,NEWS_EX_BTIM_KEY) - ELSE - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - - RETURN - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /KEYID/ NEWS_KEYID - - COMMON /KEEPLOCK/ KEEPLOCK - - EX_BTIM(1) = 0 - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 2 - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - CALL READDIR_KEYGE(NDEL) - KEEPLOCK = .FALSE. - NEWS_KEYID = 1 - - RETURN - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -C -C SUBROUTINE READACL -C -C FUNCTION: Reads the ACL of a file. -C -C PARAMETERS: -C FILENAME - Name of file to check. -C ACLENT - String which will be large enough to hold ACL information. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - BIG = .NOT.IER - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - END IF - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER) - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+ - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))), - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR. - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1 - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII)) - IF (ACLSTR(START_ID:START_ID).NE.','.AND. - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IF - END DO - IF (ASCII) THEN - START_ID = START_ID + 1 - END_ID = END_ID - 1 - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2 - END IF - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'( - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IF - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THEN - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2 - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID) - OUTLEN = 1 - ELSE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IF - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2) - END DO - - RETURN - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-3)/2.GT.FOLDER_MAX) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,) - ELSE - CALL ENABLE_CTRL - CALL SYS$CANEXH() - CALL EXIT - END IF - END IF - - RECL = (RECL-3)/2 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL) - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9) - - RETURN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z) - - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -C -C SUBROUTINE COPY_ACL -C -C FUNCTION: -C Copy ACLs from one file to another file -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILE - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - ! Get length needed to store acl output - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of string - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURN - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -C -C SUBROUTINE COPY_ACL1 -C -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - ! Read input file acl - - IF (.NOT.IER) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENT - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT, - & %LOC(ACLENT)) - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied first - END DO - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT, - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURN - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./ - - IF (CHECKED) RETURN - - CHECKED = .TRUE. - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C) - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORY - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - END IF - - CALL CHECK_DIR(FOLDER_DIRECTORY,.FALSE.) - CALL CHECK_DIR(NEWS_DIRECTORY,.FALSE.) - - CALL ADD_DIRECTORIES - - RETURN - END - - - - SUBROUTINE ADD_DIRECTORIES - - INCLUDE 'BULLFILES.INC' - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE) - - RETURN - END - - - - LOGICAL FUNCTION CHECK_DIR(DIRECTORY,LIBRARY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - CHECK_DIR = PRESENT(BULLUSER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLFOLDER_FILE,DIRECTORY,TEST).AND. - & PRESENT(BULLINF_FILE,DIRECTORY,TEST) - - IF (CHECK_DIR) THEN - IF (SYS_TRNLNM(DIRECTORY,TEST)) DIRECTORY = TEST - RETURN - END IF - - TEST = ' ' - - IF (INDEX(DIRECTORY,']').EQ.0) THEN - CALL SYS_TRNLNM(DIRECTORY,TEST1) - ELSE - TEST1 = DIRECTORY - END IF - - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - - IF (.NOT.LIBRARY.AND.TEST.EQ.' ') THEN - IER = SYS_TRNLNM_SYSTEM(DIRECTORY,TEST) - IF (.NOT.IER.AND.TEST1.EQ.DIRECTORY) RETURN - END IF - - IF (TEST.NE.TEST1) THEN - IF (LIBRARY) THEN - WRITE (6,'('' ERROR: Not a valid library. '')') - RETURN - END IF - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER) - CLOSE(UNIT=3,STATUS='DELETE') - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)') - & TEST1(:TRIM(TEST1)) - CALL EXIT - END IF - DIRECTORY = TEST1 - ELSE - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DO - CHECK_DIR = .TRUE. - END IF - - RETURN - END - - - - - LOGICAL FUNCTION PRESENT(FILE,DIR,TEST) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILE,DIR,TEST - - FILE = FILE(INDEX(FILE,':')+1:) - FILE = FILE(INDEX(FILE,']')+1:) - IF (INDEX(DIR,':').EQ.0.AND.INDEX(DIR,'[').EQ.0.AND. - & INDEX(DIR,'<').EQ.0) DIR = DIR(:TRIM(DIR))//':' - C = 0 - PRESENT = LIB$FIND_FILE(DIR(:TRIM(DIR))//FILE,TEST,C) - - RETURN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:) - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:) - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':' - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURN - END - - - - SUBROUTINE SET_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CALL CLI$GET_VALUE('LIBRARY',BULL_PARAMETER,LEN_P) - - IF (CHECK_DIR(BULL_PARAMETER,.TRUE.)) THEN - FOLDER_DIRECTORY = BULL_PARAMETER - CALL ADD_DIRECTORIES - FOLDER_SET = .FALSE. - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - CALL UPDATE_USERINFO - CALL OPEN_USERINFO - INCMD = 'SHOW' - CALL UPDATE_READ(0) - END IF - - RETURN - END - - - - SUBROUTINE SHOW_LIBRARY - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (CLI$PRESENT('ALL')) THEN - IER = 1 - N = 1 - DO WHILE (IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',BULL_PARAMETER) - IF (IER) THEN - IF (N.EQ.1) THEN - WRITE (6,'('' The following are valid libraries:'')') - N = 0 - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER - END IF - END DO - IF (N.EQ.1) WRITE (6,'('' No libraries are present.'')') - ELSE - WRITE (6,'('' Present library is: '',A)') - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - END IF - - RETURN - END - - - - SUBROUTINE SET_BULLNEWSDIR_FILE(FN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE - CHARACTER*80 BULLNEWSDIR_FILE - - BULLNEWSDIR_FILE = ' ' - - ENCODE(6,'(I6)',BULLNEWSDIR_FILE) FN - BULLNEWSDIR_FILE = BULLNEWSDIR_FILE(FIRST_ALPHA(BULLNEWSDIR_FILE):) - L = TRIM(BULLNEWSDIR_FILE) - - BULLNEWSDIR_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWSDIR.'// - & BULLNEWSDIR_FILE(:L-3)//']'// - & BULLNEWSDIR_FILE(L-2:TRIM(BULLNEWSDIR_FILE))//'.' - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bulletin7.for b/decus/vmslt98b/bulletin/bulletin7.for deleted file mode 100644 index 8f11524..0000000 --- a/decus/vmslt98b/bulletin/bulletin7.for +++ /dev/null @@ -1,2374 +0,0 @@ -C -C BULLETIN7.FOR, Version 11/3/98 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - CHARACTER FOLDER_NAME_SAVE*80 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER_NAME_SAVE.EQ.FOLDER_NAME) THEN - TEMP_USERNAME = ' ' - DO WHILE (TEMP_USERNAME.NE.'*') - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.NE.'*') THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - RETURN - END IF - - FOLDER_NAME_SAVE = FOLDER_NAME - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /LOCALPOST/ LOCAL_POST - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00' - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0 - IF (REMOTE_SET.NE.4) NBLOCK = 0 - SHUTDOWN = 0 - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,TODAY_TIME,,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - IF (.NOT.LOCAL_POST) THEN - DATE = NEWEST_DATE - TIME = NEWEST_TIME - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THEN - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTH - CALL WRITEDIR(NEWS_F_END+1,IER) - ELSE - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IF - - IF (IER.NE.0) RETURN - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1 - NBULL = NEWS_F_END - F_NBULL = NEWS_F_END - ELSE - NBULL = NBULL + 1 - NBLOCK = NBLOCK + LENGTH - END IF - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - - INQUIRE (UNIT=2,OPENED=IER) - IF (IER) CALL CLOSE_BULLDIR - CALL UPDATE_LOGIN(.TRUE.) - IF (IER) CALL OPEN_BULLDIR - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2) -C -C FUNCTION COMPARE_BTIM -C -C FUCTION: Compares times in binary format to see which is farther in future. -C -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal time -C - IMPLICIT INTEGER (A - Z) - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THEN - COMPARE_BTIM = -1 - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1 - END IF - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFF -C -C FUNCTION: Finds difference in minutes between 2 binary times. -C -C - IMPLICIT INTEGER (A-Z) - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1) - CALL LIB$DAY(DAYS2,DATE2,MSECS2) - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000 - - RETURN - END - - - - - - - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2) -C -C FUNCTION COMPARE_DATE -C -C FUCTION: Compares dates to see which is farther in future. -C -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date) -C OUTPUT: -C Returns the difference in days between the two dates. -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -C - IMPLICIT INTEGER (A - Z) - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2) - - CALL SYS_BINTIM(DATE1,USER_TIME) - - CALL VERIFY_DATE(USER_TIME) -C -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -C - CALL LIB$DAY(DAY1,USER_TIME) - - IF (DATE2.NE.' ') THEN - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME) - ELSE - CALL SYS$GETTIM(USER_TIME) - END IF - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2 - - RETURN - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalid - BTIM(1) = TEMP(1) - BTIM(2) = TEMP(2) - END IF - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) -C -C FUNCTION COMPARE_TIME -C -C FUCTION: Compares times to see which is farther in future. -C -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C - - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2 - - IF (TIME2.EQ.' ') THEN - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2 - END IF - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10))) - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THEN - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IF - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word of -C the record. The last word in the record contains the address of the -C next record. Every time a record is written, if that record has a -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -C -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA) - CHARACTER*(*) DATA - INTEGER HEADER - IF (HEADER.NE.0) RETURN ! Queue already initialized - LENGTH = LEN(DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA) - INTEGER RECORD(1) - CHARACTER*(*) DATA - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD))) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXT - RETURN - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA - INTEGER RECORD(1) - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURN - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z) - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LEN - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 0 - RETURN - END - - - - SUBROUTINE DISABLE_PRIVS -C -C SUBROUTINE DISABLE_PRIVS -C -C FUNCTION: Disable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/ - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1) - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURN - END - - - - SUBROUTINE ENABLE_PRIVS -C -C SUBROUTINE ENABLE_PRIVS -C -C FUNCTION: Enable image high privileges. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs - - RETURN - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -C -C SUBROUTINE CHECK_PRIV_IO -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C - - IMPLICIT INTEGER (A-Z) - - COMMON /OUTPUT/ REASSIGNED - LOGICAL REASSIGNED - DATA REASSIGNED /.FALSE./ - - CALL DISABLE_PRIVS ! Disable SYSPRV - - IF (.NOT.REASSIGNED) THEN - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE') - END IF - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200) - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0 - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.') - - RETURN - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAG -C -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./ - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) - IF (IER) THEN - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')') - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR. - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IF - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - END IF - -C -C Find user entry in BULLUSER.DAT to update information. -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER) - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - ELSE - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0 - END DO - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IF - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE. - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSION -C -C SUBROUTINE SET_VERSION -C -C FUNCTION: Sets version number. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - DIMENSION READ_BTIM_SAVE(2) - -C -C Find user entry in BULLUSER.DAT to update information. -C - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - - IF (IER.EQ.0) THEN - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -C -C SUBROUTINE CHECK_NEWUSER -C -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was. -C -C INPUTS: -C USERNAME - Username -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST) - - DISMAIL = 0 ! Set return false - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yep - END IF - END IF - - RETURN ! Return - END ! End - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - IF (INDEX(INPUT,']').GT.0) THEN - SYS_TRNLNM = .FALSE. - RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),, - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN) - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0 - RETURN - END IF - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IF - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX)) - CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1 - - RETURN - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUT - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN)) - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IF - - RETURN - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - FILE_LOCK = 1 - INIT = .FALSE. - IER1 = 0 - ELSE - IF (IER.GT.0) THEN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_FLK) THEN - FILE_LOCK = 1 - CALL WAIT_SEC('01') - ELSE - FILE_LOCK = 0 - INIT = .TRUE. - END IF - ELSE - FILE_LOCK = 0 - IER1 = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODE - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXIT - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IF - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - END IF - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,) - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - END IF - CALL CLOSE_TAG - FOLDER_FLAG = 0 - CALL SET_FOLDER_FILE(0) - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXIT - END IF - QUIT = 0 ! Reinitialize - - RETURN - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z) - - COMMON /CTRLY/ CTRLY - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/ - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -C -C SUBROUTINE CLEANUP_BULLFILE -C -C FUNCTION: Searches for empty space in bulletin file and deletes it. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER BUFFER*128 - - CALL OPEN_BULLDIR - -C -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THEN - - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR;-1') - END DO - - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPFIL;-1') - END DO - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFER - END DO - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100 - END IF - WRITE(11) BUFFER - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFIL - ELSE IF (NEMPTY.EQ.-1) THEN - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULL*','*.*;1') - NEMPTY = 0 - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - CALL CLOSE_BULLDIR - RETURN - END IF - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED', - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = -1 - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULL - CALL READDIR(I,IER) - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0) - END DO - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULL*','*.*;1') - - CALL OPEN_BULLDIR - DO WHILE (REC_LOCK(IER)) - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER - END DO - - IF (NEMPTY.EQ.-1) THEN - NEMPTY = 0 - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IF - - CALL CLOSE_BULLDIR - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY) -C -C SUBROUTINE CLEANUP_DIRFILE -C -C FUNCTION: Reorder directory file after deletions. -C Is called either directly after a deletion, or is -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - CHARACTER*12 DATE_SAVE,EXDATE_SAVE - CHARACTER*12 TIME_SAVE,EXTIME_SAVE - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - DATE_SAVE = DATE - TIME_SAVE = TIME - EXDATE_SAVE = EXDATE - EXTIME_SAVE = EXTIME - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry? - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DO - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER) - RETURN - END IF - LENGTH = -LENGTH ! Indicate starting point by writing - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative length - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progress - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULL - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_Q - BLOCK_SAVE = BLOCK - MSG_NUM_SAVE = MSG_NUM - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN - MOVE_TO = MSG_NUM_SAVE + 1 - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for any - END DO ! of the other entries - END IF - I = I + 1 - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessary - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER) - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1 - END IF - END DO - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of file - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF - - IF (FIRST_DELETE.GT.0) THEN - CALL READDIR(FIRST_DELETE,IER) - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative length - CALL WRITEDIR(FIRST_DELETE,IER) - END IF - END IF - - CALL WRITEDIR(0,IER) - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - DATE = DATE_SAVE - TIME = TIME_SAVE - EXDATE = EXDATE_SAVE - EXTIME = EXTIME_SAVE - - RETURN - END - - - SUBROUTINE SHOW_FLAGS -C -C SUBROUTINE SHOW_FLAGS -C -C FUNCTION: Show user flags. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IF - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - END IF - - IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' NOTIFY is set.'')') - ELSE IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' No flags are set.'')') - END IF - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)) - - RETURN - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL) -C -C FUNCTION GETUSERS -C -C FUNCTION: -C To get names of all users that are logged in. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF *** - PARAMETER PSCAN$_BEGIN = '00000000'X - PARAMETER PSCAN$_ACCOUNT = '00000001'X - PARAMETER PSCAN$_AUTHPRI = '00000002'X - PARAMETER PSCAN$_CURPRIV = '00000003'X - PARAMETER PSCAN$_GRP = '00000004'X - PARAMETER PSCAN$_HW_MODEL = '00000005'X - PARAMETER PSCAN$_HW_NAME = '00000006'X - PARAMETER PSCAN$_JOBPRCCNT = '00000007'X - PARAMETER PSCAN$_JOBTYPE = '00000008'X - PARAMETER PSCAN$_MASTER_PID = '00000009'X - PARAMETER PSCAN$_MEM = '0000000A'X - PARAMETER PSCAN$_MODE = '0000000B'X - PARAMETER PSCAN$_NODE_CSID = '0000000C'X - PARAMETER PSCAN$_NODENAME = '0000000D'X - PARAMETER PSCAN$_OWNER = '0000000E'X - PARAMETER PSCAN$_PRCCNT = '0000000F'X - PARAMETER PSCAN$_PRCNAM = '00000010'X - PARAMETER PSCAN$_PRI = '00000011'X - PARAMETER PSCAN$_PRIB = '00000012'X - PARAMETER PSCAN$_STATE = '00000013'X - PARAMETER PSCAN$_STS = '00000014'X - PARAMETER PSCAN$_TERMINAL = '00000015'X - PARAMETER PSCAN$_UIC = '00000016'X - PARAMETER PSCAN$_USERNAME = '00000017'X - PARAMETER PSCAN$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER PSCAN$_END = '00000019'X - PARAMETER PSCAN$k_type = '00000081'X - PARAMETER PSCAN$M_OR = '00000001'X - PARAMETER PSCAN$M_BIT_ALL = '00000002'X - PARAMETER PSCAN$M_BIT_ANY = '00000004'X - PARAMETER PSCAN$M_GEQ = '00000008'X - PARAMETER PSCAN$M_GTR = '00000010'X - PARAMETER PSCAN$M_LEQ = '00000020'X - PARAMETER PSCAN$M_LSS = '00000040'X - PARAMETER PSCAN$M_PREFIX_MATCH = '00000080'X - PARAMETER PSCAN$M_WILDCARD = '00000100'X - PARAMETER PSCAN$M_CASE_BLIND = '00000200'X - PARAMETER PSCAN$M_EQL = '00000400'X - PARAMETER PSCAN$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER PSCAN$S_OR = 1 - PARAMETER PSCAN$V_OR = 0 - PARAMETER PSCAN$S_BIT_ALL = 1 - PARAMETER PSCAN$V_BIT_ALL = 1 - PARAMETER PSCAN$S_BIT_ANY = 1 - PARAMETER PSCAN$V_BIT_ANY = 2 - PARAMETER PSCAN$S_GEQ = 1 - PARAMETER PSCAN$V_GEQ = 3 - PARAMETER PSCAN$S_GTR = 1 - PARAMETER PSCAN$V_GTR = 4 - PARAMETER PSCAN$S_LEQ = 1 - PARAMETER PSCAN$V_LEQ = 5 - PARAMETER PSCAN$S_LSS = 1 - PARAMETER PSCAN$V_LSS = 6 - PARAMETER PSCAN$S_PREFIX_MATCH = 1 - PARAMETER PSCAN$V_PREFIX_MATCH = 7 - PARAMETER PSCAN$S_WILDCARD = 1 - PARAMETER PSCAN$V_WILDCARD = 8 - PARAMETER PSCAN$S_CASE_BLIND = 1 - PARAMETER PSCAN$V_CASE_BLIND = 9 - PARAMETER PSCAN$S_EQL = 1 - PARAMETER PSCAN$V_EQL = 10 - PARAMETER PSCAN$S_NEQ = 1 - PARAMETER PSCAN$V_NEQ = 11 - BYTE %FILL (2) - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) -C -C Replace all the lines in this subroutine with the following if -C you are running V5.2 or older. -C -C DATA CONTEXT/-1/ -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) -C CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) -C CALL ADD_2_ITMLST(4,JPI$_MODE,%LOC(UJPIMODE)) -C CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist -C IER = 1 -C UJPIMODE = -1 -C TERMINAL(1:1) = CHAR(0) -C DO WHILE (IER.AND.(TERMINAL(1:1).EQ.CHAR(0)).AND.(UJPIMODE.NE. -C * JPI$K_INTERACTIVE)) -C ! Get next interactive process -C IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) -C ! Get next process. -C END DO -C IF (.NOT.IER) CONTEXT = -1 -C GETUSERS = IER - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IF - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0) - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0)) - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process. - END DO - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IER - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFO -C -C SUBROUTINE OPEN_USERINFO -C -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - DATA USERINFO_READ /.FALSE./ - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - CHANGED = .FALSE. - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time warp - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - LAST(1,I) = TODAY_BTIM(1) - LAST(2,I) = TODAY_BTIM(2) - CHANGED = .TRUE. - END IF - END DO - IF (CHANGED) REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - DO I=1,FOLDER_MAX - DO J=1,2 - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - END IF - - IF (IER.NE.0) THEN - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2) - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER) - END IF - CALL CLOSE_BULLUSER - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - LAST_READ_BTIM(1,I) = READ_BTIM(1) - LAST_READ_BTIM(2,I) = READ_BTIM(2) - END DO - END IF - END IF - DO I=1,FOLDER_MAX - DO J=1,2 - LAST(J,I) = LAST_READ_BTIM(J,I) - END DO - END DO - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - DO WHILE (REC_LOCK(IER)) - READ (9,KEY='*DEFAULT',IOSTAT=IER) TEMP_USER,INF_REC - END DO - IF (IER.EQ.0) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - WRITE (9,IOSTAT=IER) USERNAME,INF_REC - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - END IF - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIM - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0 - LAST_SYS_BTIM(2,I) = 0 - END DO - END IF - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINF - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ) - - USERINFO_READ = .TRUE. - - RETURN - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -C -C SUBROUTINE READ_NEWS_USERINFO -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*(*) NAME - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2))) - END IF - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READ - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSE - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF - IF (IER.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IF - - RETURN - END - - - - - SUBROUTINE UPDATE_USERINFO -C -C SUBROUTINE UPDATE_USERINFO -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) - COMMON /USERINFO/ LAST(2,FOLDER_MAX) - EQUIVALENCE (OLD_LAST_NEWS_READ2(1,1),OLD_LAST_NEWS_READ(1,1)) - INTEGER*2 OLD_LAST_NEWS_READ2(4,FOLDER_MAX) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_FOLDER/ LAST_FOLDER_NUMBER - - IF (.NOT.USERINFO_READ) RETURN - - DIFF = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF = (LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_READ_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF1 = .FALSE. - IF (REMOTE_SET.EQ.0.OR.REMOTE_SET.EQ.1) THEN - DIFF1 = (LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(1,LAST_FOLDER_NUMBER+1)).OR. - & (LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1).NE. - & OLD_LAST_SYS_BTIM(2,LAST_FOLDER_NUMBER+1)) - END IF - - DIFF2 = .FALSE. - GO TO 10 - - ENTRY UPDATE_USERINFO_NEWS_ALWAYS - DIFF2 = .TRUE. - -10 IF (.NOT.DIFF2) THEN - DO I=1,FOLDER_MAX - DIFF2 = (LAST_NEWS_READ(1,I).NE. - & OLD_LAST_NEWS_READ(1,I)).OR. - & (LAST_NEWS_READ(2,I).NE. - & OLD_LAST_NEWS_READ(2,I)).OR.DIFF2 - END DO - END IF - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHARED - - IF (DIFF) THEN - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & LAST(J,I) = LAST_READ_BTIM(J,I) - LAST_READ_BTIM(J,I) = LAST(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IF - END IF - - IF (DIFF1) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=1,2 - IF (LAST_FOLDER_NUMBER+1.EQ.I) - & OLD_LAST_SYS_BTIM(J,I) = LAST_SYS_BTIM(J,I) - LAST_SYS_BTIM(J,I) = OLD_LAST_SYS_BTIM(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IF - - IF (DIFF2) THEN - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - IF (IER.EQ.0) THEN - DO I=1,FOLDER_MAX - DO J=2,1,-1 - IF (I.EQ.NEWS_FIND_SUBSCRIBE().OR. - & OLD_LAST_NEWS_READ2(1,I).NE.LAST_NEWS_READ2(1,I)) - & OLD_LAST_NEWS_READ(J,I) = LAST_NEWS_READ(J,I) - LAST_NEWS_READ(J,I) = OLD_LAST_NEWS_READ(J,I) - END DO - END DO - REWRITE (9,IOSTAT=IER) USERNAME,OLD_LAST_NEWS_READ - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IF - - CALL CLOSE_BULLINF - - RETURN - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z) - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - CHARACTER*24 TIME1 - - TIME1 = TIME(FIRST_ALPHA(TIME):) - DO I=TRIM(TIME1),2,-1 - IF (TIME1(I-1:I).EQ.' ') TIME1(I-1:) = TIME1(I:) - END DO - - IF (TIME1.EQ.'-') TIME1 = '-- :' - - IF (TRIM(TIME1).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME1//'.00',BTIM) - ELSE - SYS_BINTIM = SYS$BINTIM(TIME1(:MIN(TRIM(TIME1),23)),BTIM) - END IF - - RETURN - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C FUNCTION: -C -C Update user's last read bulletin date. If new bulletins have been -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READIT - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder info - ELSE IF (.NOT.LOGIN_SWITCH) THEN - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login time - CALL SHOW_NEW_VERSION - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder info - ELSE - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't - END IF ! think it's called via LOGIN - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL SET2(NEW_MSG,FOLDER_NUMBER) - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1 - END IF - END IF - END IF - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND. - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IF - END IF - END DO - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM) - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM) - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time. - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF - END IF - IF (DIFF.LT.0) THEN - WRITE (6,'('' There are new messages in '', - & ''folder '',A)') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - IF (INCMD(:4).EQ.'SHOW') THEN - SAVE_FOLDER_Q1 = 0 - RETURN - END IF - IF (NEW_MESS.OR.NEWS_MESS) THEN - WRITE (6,'('' Type SELECT followed by foldername to'', - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0 - CALL SELECT_FOLDER(.FALSE.,IER) - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM) - ELSE - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1 - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER) - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - ELSE - WRITE (6,'('' There are new messages in folder '' - & ,A)') FOLDER(:TRIM(FOLDER)) - END IF - DIFF = 0 - END IF - END IF - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO - END IF - END IF - END IF - END IF - END IF - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXIT - END IF - - RETURN - END - - - - - SUBROUTINE READ_IN_FOLDERS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - DATA SAVE_FOLDER_Q1/0/ - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM) - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1 - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSION - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -C -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed. -C - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - CALL REWRITE_FOLDER_FILE(IER) - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - INQUIRE (UNIT=4,OPENED=IER) - CALL MODIFY_SYSTEM_LIST(IER) - END IF - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DO - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN - END - - - - - SUBROUTINE DISCONNECT_REMOTE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER)) - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bulletin8.for b/decus/vmslt98b/bulletin/bulletin8.for deleted file mode 100644 index 5b62447..0000000 --- a/decus/vmslt98b/bulletin/bulletin8.for +++ /dev/null @@ -1,2165 +0,0 @@ -C -C BULLETIN8.FOR, Version 10/27/94 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - CHARACTER NAMEDESC*12 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL,LISTEN_AST - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC(:9),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN - IF (NNTP_LISTEN(LISTEN_CHAN)) THEN - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - END IF - END IF - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - - SUBROUTINE LISTEN_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL NEWS_SOCKET_AST - - INTEGER*2 ACCEPT_IOSB(4) - - IF (LISTEN_IOSB(1)) THEN - IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB) - IF (IER) THEN - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) THEN - COUNT = COUNT + 1 - DEVS(UNIT_INDEX) = ACCEPT_CHAN - UNITS(UNIT_INDEX) = ACCEPT_CHAN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - ELSE IF (ACCEPT_CHAN.NE.-1) THEN - CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) - END IF - END IF - - CALL REQUEUE_NNTP_ACCEPT_WAIT() - - RETURN - END - - - - SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT() - - IMPLICIT INTEGER (A-Z) - - COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4) - INTEGER*2 LISTEN_IOSB - - EXTERNAL LISTEN_AST - - CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB) - - RETURN - END - - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - IF (.NOT.IER) CALL EXIT - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*8,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(,%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLK - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND. - & READ_IOSB(2,UNIT_INDEX).EQ.0) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(0, - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX, - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - END IF - - RETURN - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - NUM = WRITE_IOSB(2,UNIT_INDEX) - IF (NUM.GT.0) THEN - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - IF (IER) RETURN - END IF - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(,%VAL(DEVS(UNIT_INDEX)), - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST, - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX) - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(0, - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX) - IF (IER) RETURN - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) - ELSE - CALL DISCONNECT(UNIT_INDEX) - END IF - - RETURN - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 20 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - DATA COUNT /0/ - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - EXTERNAL IO$_ACCESS,IO$M_ABORT - - CHARACTER*(*) USERNAME,FROMNAME,NODENAME - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5) - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC)) - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX') - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THEN - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.0) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNIT - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAME - FROM_SAVE(UNIT_INDEX) = FROMNAME - NODE_SAVE(UNIT_INDEX) = NODENAME - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0 - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IF - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,) - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER) -C -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit number -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_UNIT - Device unit number -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT: -C CHAN - Channel number -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -C -C SUBROUTINE DISCONNECT -C -C FUNCTION: Disconnects channel and remove its entry from the lists. -C - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - END IF - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF - - RETURN - END - - - - SUBROUTINE SET_TIMER(MIN) -C -C SUBROUTINE SET_TIMER -C -C FUNCTION: Wakes up every MIN minutes to check for idle connections -C - IMPLICIT INTEGER (A-Z) - INTEGER TIMADR(2) ! Buffer containing time - ! in desired system format. - CHARACTER MIN*(*) - - EXTERNAL CHECK_CONNECTIONS - - CALL LIB$GET_EF(WAITEFN) - - IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN - END - - - - - SUBROUTINE CHECK_CONNECTIONS - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 20 - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK) - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK - IF (DEVS(UNIT_INDEX).NE.0.AND. - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - END IF - END DO - END IF - - CALL RESET_TIMER - - RETURN - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST) - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THEN - USERNAME = 'DECNET' - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - END IF - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z) - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1 - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF) - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THEN - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IF - IF (NETUAF(65:65).NE.'*') THEN - USERTEMP = NETUAF(65:) - ELSE - USERTEMP = USERNAME - END IF - END IF - END DO - - USERNAME = USERTEMP - - RETURN - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656 - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/ - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100)) - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - FORMAT = 0 - - IF (IER.NE.0) THEN - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:) - NLEN = NLEN - 12 - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64) - SKIP = 4 + ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DO - IF (NLEN.GT.64) THEN - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:) - DO I=65+ULEN,76 - NETUAF(I:I) = ' ' - END DO - ELSE - NETUAF(65:) = 'DECNET' - END IF - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DO - - CLOSE (UNIT=7) - - RETURN - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - PARAMETER MAXLINK = 20 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK) - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2) - - CALL COPY2(BULLCP_PRIV,PROCPRIV) - - ILEN = READ_IOSB(2,UNIT_INDEX) - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER)) - - REMOTE_SET = .FALSE. - REC_SAVE(UNIT_INDEX) = 0 - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THEN - ! Do we need priv info? - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX)) - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_BULLETIN_PRIV(USERNAME) - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV) - END IF - END IF - END IF - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND. - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE - SYSLOG = .FALSE. - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(9:))) - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1) - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IF - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24 - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - END IF - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COM - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1) - IF (IER.AND.IER1) THEN - IF (SYSLOG) THEN - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IF - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message line - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1 - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM) - P = 4 + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - END IF - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - SYSTEM = 0 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IF - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBER - WRITE (EXTIME(7:),'(I4)') NODE_AREA - DO I=1,11 - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFIL - OENTRY = OUT_HEAD(UNIT_INDEX) - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - IF (BROAD) THEN - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (BTEST(FOLDER_FLAG,14)) FROM = 'ANONYMOUS' - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder file - CALL CLOSE_BULLDIR ! Totally finished with add - IF (NEWS_FEED()) THEN - BULL_POINT = NBULL - INCMD = 'COPY/ORIGINAL/LOCAL '// - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1 - & :INDEX(FOLDER_DESCRIP,'>')-1) - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - END IF - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodes - TEMP_USER = ':' - DO WHILE (TEMP_USER(:1).EQ.':') - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node that - END IF ! originated the message - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE. - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000 - END IF - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IDUMMY,INODE) - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR. - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN - DELETE (4) - END IF - ELSE - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IF - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN - CALL READDIR(ICOUNT,IER) - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:))) - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THEN - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THEN - BULLDIR_ENTRY = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER) - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRY - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT) - P = 4 + P - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV() - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR. - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR. - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFIL - NEW_LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX) - DO I=1,NEW_LENGTH - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - WRITE (1'NBLOCK+I) INQUEUE - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1 - END IF - CALL WRITEDIR(ICOUNT,IER) - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), - & BTEST(MSGTYPE,2),EXDATE,EXTIME) - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General? - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + P - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + P - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Cannot find message to undelete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to undelete message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - CALL OPEN_BULLUSER_SHARED - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG - END DO - IF (IER.NE.0) THEN - DO I=1,FLONG - NEW_FLAG (I) = 0 - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSER - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THEN - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IF - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:))) - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THEN - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER) - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER) - END IF - END IF - ELSE IF (CMD_TYPE.EQ.16) THEN ! Change folder nodename - CALL OPEN_BULLFOLDER_SHARED - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ. - & FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN - FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20))) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO - CALL CLOSE_BULLFOLDER - END IF - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - RETURN - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - PARAMETER MAXLINK = 20 - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2) - - USERNAME = USER_SAVE(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN - - CALL OPEN_USERINFO - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IF - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND. - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = -1 - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSE - DIFF1 = 0 - END IF - - IF (DIFF1.LT.0) THEN - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURN - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM) - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1) - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2) - - RETURN - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME) - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS) - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV) - END IF - - RETURN - END - - - - SUBROUTINE GETACC(ACCOUNT) -C -C SUBROUTINE GETACC -C -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS) -C -C SUBROUTINE GETSTS -C -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS: -C STS - Status word of present process. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info - - RETURN - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB) - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUS - - END - - - - INTEGER FUNCTION REC_LOCK(IER) - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - INIT = INIT + 2 - IF (INIT.GT.60) THEN - WRITE (6,'('' Bulletin aborting due to record lock'', - & '' problem. Alert system administrator.'')') - CALL EXIT - END IF - ELSE - REC_LOCK = 0 - INIT = .TRUE. - END IF - END IF - - RETURN - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN - END DO - RETURN - END - - SUBROUTINE SYS_GETMSG(IER) - - IMPLICIT INTEGER (A-Z) - - COMMON /WINDOW/ WINDOW - - CHARACTER*80 MESSAGE - - WINDOW = 1 - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURN - END - - - - SUBROUTINE HELP(LIBRARY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' ' - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURN - END - - - - - SUBROUTINE GET_NODE_INFO -C -C SUBROUTINE GET_NODE_INFO -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -C - - IMPLICIT INTEGER (A-Z) - - EXTERNAL CLI$_ABSENT - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - - COMMON /TEMP_INPUT/ NODE_TEMP - CHARACTER NODE_TEMP*256 - - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,PASSWORD*32,TEMP_USER*12 - - NODE_ERROR = .FALSE. - - LOCAL_NODE_FOUND = .FALSE. - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:) - L_NODE = L_NODE - 1 - END IF - - NODE_NUM = 0 ! Initialize number of nodes - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',') - IF (COMMA.GT.0) THEN - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM)) - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THEN - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN) - POINT_NODE = NODE_NUM - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"', - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - END IF - END DO - END IF - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE. - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE. - RETURN - END IF - END IF - END DO - END DO - ELSE - LOCAL_NODE_FOUND = .TRUE. - END IF - RETURN - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -C -C SUBROUTINE SET_FOLDER_FILE -C -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE, -C if = 1, set FOLDER1_FILE -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - IF (NUM.EQ.0) THEN - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE) - END IF - - RETURN - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -C -C SUBROUTINE SET_FILE -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILE - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE = - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - ELSE - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)// - & '.]' - END IF - - RETURN - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12 - - DATA UPDATE/.FALSE./, JUST_NAME/.FALSE./ - - UPDATE = .TRUE. - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_UPDATE - - UPDATE = .NOT.UPDATE - JUST_NAME = .TRUE. - - ENTRY SET_BULLFIL_NAME - - JUST_NAME = .NOT.JUST_NAME - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATE - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):) - - M = INDEX(FILDATE,'-') - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3) - - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN - FOLDER_FILE = FOLDER1_FILE - IF (JUST_NAME) THEN - JUST_NAME = .FALSE. - RETURN - END IF - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THEN - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHARED - END IF - END IF - - JUST_NAME = .FALSE. - - IF (UPDATE) THEN - READ (1'1) NBLOCK - REWRITE (1) NBLOCK + LENGTH - UPDATE = .FALSE. - END IF - - RETURN - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THEN - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE - MINGT0 = MIN(I,J) - END IF - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bulletin9.for b/decus/vmslt98b/bulletin/bulletin9.for deleted file mode 100644 index fa8759a..0000000 --- a/decus/vmslt98b/bulletin/bulletin9.for +++ /dev/null @@ -1,2475 +0,0 @@ -C -C BULLETIN9.FOR, Version 4/8/98 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C -C Copyright (c) 1990 -C Property of Massachusetts Institute of Technology, Cambridge MA 02139. -C This program cannot be copied or distributed in any form for non-MIT -C use without specific written approval of MIT Plasma Fusion Center -C Management. -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF ((FLAG.EQ.7.OR.FLAG.EQ.14).AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',) - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1) - - RETURN - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z) - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEY - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20 - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURN - END IF - OUT = 8 - END IF - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST) - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1 - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1 - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST) - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase display - END IF - END IF - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE') - RETURN - END IF - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD' - & ,LIBRARY,HLP$M_HELP) - END IF - - RETURN - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z) - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1 - RETURN - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C -C SUBROUTINE OUTPUT_HELP -C -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keys - - DO WHILE (NKEY.GE.0) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screen - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key match - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND. - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2 - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string - KEYL(NKEY) = HELP_INPUT_LEN ! Key length - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1 - END IF - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)), - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10))) - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1 - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match - DO I=OLD_NKEY+1,NKEY ! then don't update - KEYL(I) = 0 ! new keys - END DO - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topic - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN) - ELSE ! If not top level, prompt for subtopic - LPROMPT = 0 ! Create subtopic prompt line - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1 - END DO - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10 - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DO - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL) -C -C FUNCTION PUT_OUTPUT -C -C FUNCTION: -C Output routine for input from LBR$GET_HELP. Displays -C help text on terminal with full screen prompting. -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits. -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT - CHARACTER*20 KEY(10) - DIMENSION KEYL(10) - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFO - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were inputted, as they are - END DO ! not valid, as no match - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND. - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match. - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic. - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired. - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to output - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - HELP_PAGE = 1 ! Increment page counter. - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER VERSION*12,DATE*24 - - INTEGER BTIM(2) - - CALL READ_HEADER(VERSION,DATE) - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURN - - ENTRY SHOW_NEW_VERSION - - CALL READ_HEADER(VERSION,DATE) - - IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM) - IF (.NOT.IER) RETURN - -C IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN -C WRITE (6,'(A)') ' A new BULLETIN executable has been '// -C & 'installed since your last use.' -C WRITE (6,'(A)') -C & ' Type HELP NEW_FEATURES for help on any new features.' -C END IF - - RETURN - END - - - - - SUBROUTINE FULL_DIR -C -C Add INDEX command to BULLETIN, display directories of ALL -C folders. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING - - DATA FOLDER_Q1/0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /COUNT/ - & DIR_COUNT, ! # directory entry to continue bulletin read from - & READ_COUNT, ! # block that bulletin READ is to continue from - & FOLDER_COUNT, ! # folder entry to continue SHOW/ALL folder from - & INDEX_COUNT - - CHARACTER NEWS_ACCESS*132,DATETIME*20 - - EXTERNAL BULLETIN_SUBCOMMANDS - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THEN - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THEN - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET') - NEW = CLI$PRESENT('NEW') - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3) - END IF - - NEW = NEW.AND..NOT.IREAD_TAG - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE') - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER_SHARED - END IF - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from file - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1 - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THEN - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER) - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0 - END IF - END IF - END DO - END IF - IF (IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSE - READ_ACCESS = 1 - END IF - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - END IF - END IF - END DO - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE - WRITE (6,1000) - END IF - IF (.NOT.SUBSCRIBE) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE - WRITE (6,'(1X,''News group'',X,1X, - & ''First Last Last Read'',/,1X,(''-''))') - END IF - NUM_FOLDER = 0 - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42) - DO I = 1,NUM_FOLDERS - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1) - END IF - IF (F1_START.LE.F1_NBULL) THEN - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER - CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW) - WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1), - & F1_START,F1_NBULL,NEWS_NEW-1 - ELSE - WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0 - END IF - ELSE - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE' - END IF - WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, - & FOLDER1_OWNER - END IF - NUM_FOLDER = NUM_FOLDER + 1 - IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH - & .AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND. - & I.NE.NUM_FOLDER))) THEN - NUM_FOLDER = 0 - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1), - & 'HIT any key for next page....') - END IF - END DO - IF (NUM_FOLDERS.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURN - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THEN - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0 - END IF - END DO - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0 - RETURN - END IF - END IF - - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - ELSE IF (INEW) THEN - NEW = INEW - IF (REMOTE_SET.GE.3) THEN - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSE - CALL FIND_NEWEST_BULL - END IF - END IF - - IF (INCMD(:4).NE.'INDE') THEN - IER = CLI$DCL_PARSE('INDEX',BULLETIN_SUBCOMMANDS) - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040) - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURN - -1000 FORMAT (' The following folders are present'/) -1010 FORMAT (' The following folders with new messages are present'/) -1015 FORMAT(1X,A,X,2X,I10,2X,I10,2X,I10) -1030 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12) -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...') -1080 FORMAT(' ',/) - - END - - - - - - SUBROUTINE SHOW_USER -C -C SUBROUTINE SHOW_USER -C -C FUNCTION: Shows information for specified users. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAG - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2) - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL') - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER - - IF (.NOT.ALL) THEN - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - IF (.NOT.IER) TEMP_USER = USERNAME - END IF - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IF - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - - FOLDER_PRESENT = CLI$PRESENT('FOLDER') - - IF (FOLDER_PRESENT) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z') - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME) - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURN - END IF - END IF - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid date specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURN - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURN - END IF - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURN - END IF - ELSE IF (SINCE) THEN - IF (BULL_POINT.EQ.0) THEN - WRITE (6,'('' ERROR: No current message.'')') - RETURN - ELSE IF (NEWS) THEN - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THEN - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSE - STARTMSG = 1 - END IF - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST - IF (FOLDER_PRESENT) THEN - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LAST - END DO - ELSE - IF (NEWS) THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST - END DO - END IF - UNLOCK 9 - IF (IER.EQ.0) THEN - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1 - END DO - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND. - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0 - NEWSMSG = 1 - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DO - IF (NEWSMSG.LE.FOLDER_MAX) THEN - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0 - ELSE - FOUND = .FALSE. - END IF - IF (FOUND.AND.NEWS) THEN - WRITE (6,'(1X,A,'' latest message read '', - & I,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THEN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'', - & '' to specified folder.'')') - END IF - END IF - IF (.NOT.ALL) THEN - IF (IER.NE.0) THEN - WRITE (6,'('' User info does not exist.'')') - END IF - IER = 2 - END IF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IF - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - CALL CLOSE_BULLUSER - ELSE - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - CALL READ_USER_FILE(IER) - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND. - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM) - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEN - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IF - END IF - END DO - CALL CLOSE_BULLUSER - END IF - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRL - - RETURN - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C SUBROUTINE INIT_MESSAGE_ADD -C -C FUNCTION: Opens specified folder in order to add message. -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROM -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - DATA LPRO/0/ - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - DATA SCRTYPE/-1/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocess - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESS - - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - - IER = 1 - DO WHILE (IER.NE.0) - CALL OPEN_BULLFOLDER ! Get folder file - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER) - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THEN - IER1 = 1 - DO WHILE (IER1) - IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY) - IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IF - END DO - IF (IER2) THEN - CALL ADD_DIRECTORIES - ELSE - CALL ERRSNS(IDUMMY,IER) - RETURN - END IF - END IF - END DO - IER = 1 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - LDESCR = 0 - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE. - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folder - FOLDER_SET = .TRUE. ! indicate it - END IF - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCK - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - IF (NEWS_FEED()) THEN - CALL STRIP_HEADER(' ',-1,IER) - END IF - - LEN_FROM = TRIM(IN_FROM) - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IF - - MAIL = BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0 - IF (MAIL) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.MAIL' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0 - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - ELSE IF (NEWS_FEED().OR.LEN_FROM.EQ.0 - & .OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN - SCRTYPE = 0 - SCRNAME = 'SYS$LOGIN:BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - IF (IER1.NE.0) THEN - SCRNAME = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//'BULL.SCR' - OPEN (UNIT=3,DISPOSE='DELETE',FILE=SCRNAME, - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW') - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IF - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - LEN_DESCRP = TRIM(IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - DESCRIP = ' ' - END IF - END IF - - OLD_BUFFER = ' ' - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE. - - RETURN - END - - - - SUBROUTINE WRITEOUT_STORED - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /STORED/ STORED - - CHARACTER*256 BUFFER - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - IF (BTEST(FOLDER_FLAG,5)) RETURN - IF (.NOT.NEWS_FEED().AND. - & .NOT.BTEST(FOLDER_FLAG,11).AND..NOT.STORED) CLOSE (UNIT=3) - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -C -C FUNCTION: Writes one line of message into folder. -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - DATA FIRST_BREAK/.TRUE./ - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - CHARACTER*24 TODAY - - COMMON /STORED/ STORED - DATA STORED /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THEN - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER - RETURN - ELSE IF (BUFFER(:5).EQ.'From:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE. - OLD_BUFFER_FROM = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Reply-To:') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IF - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSE - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - END IF - STORED = .TRUE. - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STORED - STORED = .FALSE. - END IF - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - END IF - IF (BTEST(FOLDER_FLAG,5)) THEN - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE. - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DO - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THEN - IF (.NOT.FIRST_BREAK) THEN - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSE - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3) - END IF - LFROM = 0 - LDESCR = 0 - RETURN - ELSE IF (.NOT.FIRST_BREAK) THEN - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROM - CALL STORE_FROM(INFROM,LFROM) - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IF - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM) - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM) - END IF - END IF - RETURN - END IF - ELSE - IF (LEN_BUFFER.GT.0) THEN - IF (.NOT.TEXT) THEN - IF (.NOT.NEWS_FEED()) THEN - TEXT = .TRUE. - ELSE - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - END IF - END IF - IF (TEXT) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - ELSE - IF (TEXT) WRITE (3,'(A)') ' ' - END IF - RETURN - END IF - END IF - - IF (LEN_BUFFER.EQ.0) THEN ! If empty line - IF (.NOT.STORED.AND. - & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') ' ' - END IF - CALL STORE_BULL(1,' ',NBLOCK) - ELSE - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IF - END IF - IF (.NOT.INEXDATE) THEN - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE. - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DO - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER) - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN - IF (NODATE) THEN - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1 - ELSE - EXDATE(1:2) = BUFFER(I:I+1) - I = I + 2 - END IF - NODATE = .FALSE. - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-') - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2 - ELSE - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IF - END IF - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DO - INEXDATE = .TRUE. - END IF - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - IF (NEWS_FEED().AND..NOT.TEXT) THEN - CALL STRIP_HEADER(BUFFER,TRIM(BUFFER),IER) - TEXT = .NOT.IER - ELSE - TEXT = .TRUE. - END IF - IF (.NOT.STORED.AND. - & ((TEXT.AND.NEWS_FEED()).OR.BTEST(FOLDER_FLAG,11))) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - END IF - END IF - - RETURN - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -C -C SUBROUTINE FINISH_MESSAGE_ADD -C -C FUNCTION: Writes message entry into directory file and closes folder -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /DIGEST/ LDESCR,FIRST_BREAK - - COMMON /SCRTYPE/ SCRTYPE,SCRNAME - CHARACTER*132 SCRNAME - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAY - - CHARACTER USER_SAVE*12,PROC_SAVE*12 - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1 - FIRST_BREAK = .FALSE. - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THEN - CALL GETUSER(FROM) - INFROM = FROM - LEN_FROM = TRIM(INFROM) - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSE - INDESCRIP = ' ' - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IF - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry - IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - SCRTYPE = -1 - END IF - RETURN - END IF - - EXTIME = '00:00:00.00' - IF (INEXDATE) THEN - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date format - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great? - & .OR.IER.LE.0) THEN ! or expiration date not future - INEXDATE = .FALSE. ! Don't use it - END IF - ELSE - INEXDATE = .FALSE. ! Don't use it - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time? - EXDATE = '5-NOV-2100' ! no, so set date far in future - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration date - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0 - END IF - END IF - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - CALL UPDATE_FOLDER - - IF (SCRTYPE.EQ.0.AND.NEWS_FEED()) THEN - FOLDER1_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,'>')-1) - CALL SYS$SETAST(%VAL(1)) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL NEWS_POST('ignore',.TRUE.,IER,INDESCRIP) - IF (TEST_BULLCP().EQ.2) CALL SYS$SETAST(%VAL(0)) - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3) - END IF - - IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.EQ.0) THEN - IF (NEWS_FEED()) THEN - SLIST = INDEX(FOLDER_DESCRIP,'[') - ELSE - SLIST = INDEX(FOLDER_DESCRIP,'<') - END IF - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - IF (NEWS_FEED()) THEN - ILEN = INDEX(INPUT,']') - 1 - ELSE - ILEN = INDEX(INPUT,'>') - 1 - END IF - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL GETUSER(PROC_SAVE) - USER_SAVE = USERNAME - USERNAME = FOLDER - IF (CONFIRM_USER(USERNAME).EQ.0) THEN - CALL SETUSER(USERNAME) - END IF - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - USERNAME = FOLDER_BBOARD - END IF - IF (.NOT.BTEST(FOLDER_FLAG,15)) THEN - CALL RESPOND_MAIL(SCRNAME,INPUT, - & FOLDER(:TRIM(FOLDER))//' folder message: '// - & INDESCRIP(:LEN_DESCRP),STATUS) - ELSE - CALL RESPOND_MAIL(SCRNAME,INPUT, - & INDESCRIP(:LEN_DESCRP),STATUS) - END IF - CALL LIB$DELETE_FILE(SCRNAME(:TRIM(SCRNAME))//';*') - CALL SETUSER(PROC_SAVE) - USERNAME = USER_SAVE - ELSE - CLOSE (UNIT=3) - END IF - ELSE IF (SCRTYPE.EQ.0) THEN - CLOSE (UNIT=3) - END IF - - CALL STRIP_HEADER(' ',-1,IER) - - SCRTYPE = -1 - - RETURN - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1 - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THEN - INFROM(I:I) = '''' - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' ' - END DO - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') - INFROM = INFROM(2:) - LEN_INFROM = LEN_INFROM - 1 - END DO - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1 - TWO_SPACE = INDEX(INFROM,' ') - END DO - -C IF (.NOT.NEWS_FEED()) THEN - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) -C END IF - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(FROM,INFROM,LEN_INFROM) - - RETURN - END - - - SUBROUTINE GET_FROM(FROM,INFROM1,LEN_INFROM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INFROM1,FROM - - CHARACTER*256 INFROM - - INFROM = INFROM1 - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards. - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@')) - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DO - - I = INDEX(INFROM,'<') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'<')+1:) ! personal-name - END IF - - I = INDEX(INFROM,'(') - IF (I.GT.0.AND.INDEX(INFROM(I+1:),'@').GT.0) THEN ! Name may be of form - INFROM = INFROM(INDEX(INFROM,'(')+1:) ! personal-name (net-name) - END IF - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR.INFROM(I:I).LE.' '.OR. - & INFROM(I:I).GE.CHAR(127).OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) - I = I + 1 - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1 - - I = 1 ! Trim username to end at a alpha character - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND.INFROM(I:I).GT.' '.AND. - & INFROM(I:I).LT.CHAR(127).AND. - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''') - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) - END IF - END DO - - RETURN - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.126) - & INDESCRIP(I:I) = ' ' - END DO - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:) - LEN_DESCRP = LEN_DESCRP - 1 - END DO - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN -C IF (LEN_DESCRP.GT.LEN(DESCRIP).AND..NOT.NEWS_FEED()) THEN - ! Is length > allowable subject length? - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '// - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IF - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) - - RETURN - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) -C -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -C -C INPUTS: -C BUFFER - Character string containing input line of message. -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS: -C IER - If true, line should be stripped. Else, end of header. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS - - COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD - DATA HEADER_Q1/0/ - - CHARACTER*(*) BUFFER - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - CALL INIT_QUEUE(HEADER_Q1,INPUT) - IF (BLEN.EQ.-1) THEN - CALL INIT_QUEUE(HEADER_Q1,INPUT) - HEADER_Q = HEADER_Q1 - NHEAD = 0 - END IF - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - END IF - - IER = .TRUE. - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation - & BUFFER(:1).EQ.CHAR(9))) THEN ! of previous header line - IF (LAST_NEWSGROUPS) THEN - NEWSGROUPS = NEWSGROUPS(:TRIM(NEWSGROUPS))//BUFFER(2:) - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - END IF - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuation - LAST_NEWSGROUPS = .FALSE. - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN) - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN - DATE_LINE(TRIM(DATE_LINE)+1:) = '.' - END IF - ELSE IF (BUFFER(:11).EQ.'Newsgroups:') THEN - NEWSGROUPS = BUFFER(13:) - LAST_NEWSGROUPS = .TRUE. - END IF - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,BUFFER) - NHEAD = NHEAD + 1 - RETURN - ELSE - I = I + 1 - END IF - END DO - - IER = .FALSE. - CONT_LINE = .FALSE. - LAST_NEWSGROUPS = .FALSE. - - RETURN - END - - - - - SUBROUTINE SET_NEWS_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_NEWS_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified news group -C Note: If NOTIFY READNEW and BRIEF = 0, it is either news -C group removal or SET SUBSCRIBE command. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*256 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - ALL = .FALSE. - DEFAULT = 1 - NODEFAULT = 0 - SUB = ABS(BRIEF)+ABS(NOTIFY)+ABS(READNEW).EQ.0 - - IF (NOTIFY.EQ.1.AND.REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: /NOTIFY is invalid with non-stored'', - & '' news group.'')') - RETURN - END IF - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - NODEFAULT = CLI$PRESENT('NODEFAULT') - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - IF (CLI$PRESENT('NOPERMANENT').OR.CLI$PRESENT('PERMANENT').OR. - & (SUB.AND.(NODEFAULT.OR.CLI$PRESENT('NOPERMANENT')))) THEN - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (SUB) DEFAULT = 1 - ELSE IF (CLI$PRESENT('NOPERMANENT').OR.NODEFAULT) THEN - IF (NOTIFY.GE.0) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - IF (SUB) - & CALL SET_NEWS_FLAG(IER,-1,-1,-1) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*PERM ',INF_REC - END IF - END IF - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL OPEN_BULLINF_SHARED - END IF - - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - IF (NODEFAULT.AND.SUB) THEN - NOTIFY = -1 - READNEW = -1 - BRIEF = -1 - END IF - IF (DEFAULT.OR.NODEFAULT) THEN - IF (NODEFAULT.AND..NOT.SUB) THEN - IF (NOTIFY.NE.-1) CALL SET_NEWS_FLAG(IER,0,-1,-1) - IF (READNEW.NE.-1.OR.BRIEF.NE.-1) - & CALL SET_NEWS_FLAG(IER,-1,0,0) - ELSE - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - END IF - IF (.NOT.IER) THEN - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - RETURN - END IF - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) '*DEFAULT ',INF_REC - END IF - END IF - IF ((ALL.OR.(SUB.AND.INCMD(:3).NE.'SET')).AND.IER.EQ.0) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY=TEMP_USER,IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - IF (IER1.EQ.0) THEN - REWRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - ELSE - WRITE (9,IOSTAT=IER) TEMP_USER,INF_REC - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - CALL CLOSE_BULLUSER - END IF - - CALL CLOSE_BULLNEWS - CALL CLOSE_BULLINF - - RETURN - END - - - - - SUBROUTINE READ_INF_REC - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CALL OPEN_BULLINF_SHARED - DO WHILE (REC_LOCK(IER1)) - READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC - END DO - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - INF_REC(1,I) = 0 - INF_REC(2,I) = 0 - END DO - END IF - CALL CLOSE_BULLINF - - RETURN - - ENTRY SET_NEWS_FLAG(IER,NOTIFY,READNEW,BRIEF) - - I = 1 - DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & INF_REC2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - IF (I.GT.FOLDER_MAX-1.AND.TEMP_USER(:1).EQ.'*') THEN - WRITE (6,'('' ERROR: You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - IER = 0 - RETURN - END IF - - IF (INF_REC2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IF (NOTIFY+READNEW+BRIEF.EQ.-3) THEN - DO J=I,FOLDER_MAX-2 - CALL COPY2(INF_REC(1,J),INF_REC(1,J+1)) - END DO - END IF - IER = 1 - RETURN - END IF - - IF (NOTIFY+READNEW+BRIEF.EQ.-3) RETURN - - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP( - & ZEXT(INF_REC2(1,J-1)),IER) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(INF_REC(1,J),INF_REC(1,J-1)) - END IF - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN - INF_REC2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THEN - INF_REC2(2,J) = MIN(8191,F_NBULL-(F_START-1)) - INF_REC(2,J) = F_START - 1 - ELSE - INF_REC2(2,J) = 0 - INF_REC(2,J) = F_NBULL - END IF - IF (NOTIFY.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),13) - IF (NOTIFY.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),13) - IF (READNEW.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),14) - IF (READNEW.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),14) - IF (BRIEF.EQ.1) INF_REC2(2,I) = IBSET(INF_REC2(2,I),15) - IF (BRIEF.EQ.0) INF_REC2(2,I) = IBCLR(INF_REC2(2,I),15) - IER = 1 - RETURN - END IF - END DO - - RETURN - END diff --git a/decus/vmslt98b/bulletin/bullfiles.inc b/decus/vmslt98b/bulletin/bullfiles.inc deleted file mode 100644 index af8ee2e..0000000 --- a/decus/vmslt98b/bulletin/bullfiles.inc +++ /dev/null @@ -1,39 +0,0 @@ -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED. -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY, -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR") -C - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORY - COMMON /FILES/ BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME. -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login time - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder data - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group data -C -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY. -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILL -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ diff --git a/decus/vmslt98b/bulletin/bullfolder.inc b/decus/vmslt98b/bulletin/bullfolder.inc deleted file mode 100644 index 117f8fc..0000000 --- a/decus/vmslt98b/bulletin/bullfolder.inc +++ /dev/null @@ -1,84 +0,0 @@ -! -! The following 2 parameters can be modified if desired before compilation. -! - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that - ! BBOARDS can be set to. - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING. - PARAMETER ADDID = .TRUE. ! Allows users who are not in the - ! rights data base to be added - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)' - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE, - & FOLDER_OWNER, - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE, - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT, - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST, - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2) - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COM - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE, - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1, - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT, - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8 - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER, - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST, - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44 - CHARACTER NEWS_FOLDER_DESCRIP*36 - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT, - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_END - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) diff --git a/decus/vmslt98b/bulletin/bullmain.cld b/decus/vmslt98b/bulletin/bullmain.cld deleted file mode 100644 index 32c0642..0000000 --- a/decus/vmslt98b/bulletin/bullmain.cld +++ /dev/null @@ -1,34 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LIBRARY, VALUE(REQUIRED) - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vmslt98b/bulletin/bullnews.inc b/decus/vmslt98b/bulletin/bullnews.inc deleted file mode 100644 index 251895d..0000000 --- a/decus/vmslt98b/bulletin/bullnews.inc +++ /dev/null @@ -1,7 +0,0 @@ - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER - - CHARACTER*132 ORGANIZATION - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ diff --git a/decus/vmslt98b/bulletin/bullstart.com b/decus/vmslt98b/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vmslt98b/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vmslt98b/bulletin/bulluser.inc b/decus/vmslt98b/bulletin/bulluser.inc deleted file mode 100644 index 215a667..0000000 --- a/decus/vmslt98b/bulletin/bulluser.inc +++ /dev/null @@ -1,53 +0,0 @@ -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own. -! - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16 - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)' - PARAMETER USER_HEADER_KEY = ' ' - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12 - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG) - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2) - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder - ! Now NEW_FLAG(2) contains SET GENERIC days - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX) - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX) - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT - - COMMON /INF_REC/ INF_REC(2,FOLDER_MAX) - INTEGER*2 INF_REC2(4,FOLDER_MAX) - EQUIVALENCE (INF_REC2(1,1), INF_REC(1,1)) - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected diff --git a/decus/vmslt98b/bulletin/changes.txt b/decus/vmslt98b/bulletin/changes.txt deleted file mode 100644 index 1f96695..0000000 --- a/decus/vmslt98b/bulletin/changes.txt +++ /dev/null @@ -1,684 +0,0 @@ -V2.5 -Changed behavior of threads and excludes. Only excludes based on FROM will -take precedence over THREADs. 10/1/98 - -Fixed 2 very old bugs. One which would cause one of the databases to be -stuck opened preventing anyone else from using BULLETIN, the other which -caused READNEW behavior when logging in for folders which did not have that -feature enabled. 9/20/98 - -V2.4 -Adding the ability to change one's personal name used in postings to news -groups and mail message by defining the logical name BULL_PERSONAL_NAME. -7/22/98 - -Added the SET GATEWAY command to change the how the subject lines looks in -messages which are sent to an email address associated with a folder. 2/25/98 - -Many bugs were fixed, mainly with respect to the news-email-folder gateway. - -V2.3 - -Added the ability to create a folder that can post and read to a news group, -and can send and read messages via email. See NEWS_TO_FOLDER.TXT for more -info. 4/18/97 - -Added the ability for BULLETIN to see news groups from secondary news groups -(see NEWS.TXT). 4/18/97 - -V 2.25 - -Changes to make it easier to click on news group name to select them: You can -enter a news group name at the prompt and it will select it (without typing -SELECT). News groups displayed without period at end when BULLETIN lists the -ones that have new messages. NEWS/SUBS has space between * and news group -when denoting which ones have new messages. 3/21/96 - -V 2.24 - -When replying to a message in a news group that has been crossposted, give the -user the option of just posting the reply to the news group in which the -message is being read rather than all the news groups in the crosspost. -11/20/95 - -Messages added to folders and stored news groups are now marked as being read -so that the person does not see them when doing a READ/NEW. 11/20/95 - -Removed INCLUDE command and replaced it with the THREAD command. This -allows you to save and easily read new messages in threads via the -READ/THREADS command. 11/13/95 - -V 2.23 - -Update newest read message when switching folders. Previously this was done -only when you exited BULLETIN, which would cause problems if you ran BULLETIN -simultaneously from two different logins. 9/12/95 - -Added /LIMIT to EXCLUDE and also the SET EXLIMIT command. These allow -excludes to be specified so that they expire after a specified amount of -days. The SHOW EXCLUDE now will show the last time a message was found -that matched the exclude. 8/16/95 - -Added /GROUP qualifier to DIRECTORY command to allow specifying groups -to search using wild cards names. 8/3/95 - -Added /GROUP qualifier to SEARCH command to allow specifying groups to -search using wild cards names. 6/20/95 - -V 2.22 - -Added SHOW EXCLUDE and INCLUDE commands. 5/17/95 - -Fixed bugs relating to messages with an expiration year past 1999. 5/17/95 - -Fixed EXCLUDE/FROM as it did not work. Also fixed EXCLUDE/DISABLE/ALL and -INCLUDE/DISABLE/ALL, as in some cases they would not work.3/31/95 - -V 2.21 - -Modified the file format for stored news group to reduce disk space usage. -11/29/94 - -Added SET LIBRARY command and also /LIBRARY qualifier on the command line to -allow switching between different directories which contain different sets of -folders. 11/29/94 - -Added /HEADER to POST when posting to news groups to allow adding headers to -the message. 11/9/94 - -Added /CANCEL to PRINT command which cancels previous print commands. -10/28/94 - -V 2.20 - -Added /FOLLOWUP to the POST command. 10/12/94 - -The FILE command no longer requires a file name, but will create a file -name from the folder's name. 5/25/94 - -Allow logical names to be specified in POST/GROUP. 5/12/94 - -Added SET FILE_DIRECTORY command. 5/12/94 - -Added /PERMANENT and /DEFAULT qualifiers to NEWS command. 4/28/94 - -Added SET SUBSCRIBE command to allow setting default or permanent news groups. -4/26/94 - -Added code to mail rejected posting for a stored news group to poster. 4/6/94 - -Optimized newsgroup list upgrade to reduce disk I/O which greatly reduces -elapsed time for slow or fragmented disks. 4/5/94 - -Modified /EDIT so EDT error no longer shows "no file found" message. 4/5/94 - -Added SET NAME command to copy settings, used if username is changed. 3/28/94 - -Modified SEARCH command to avoid updating new message counter (in order to be -able to follow a thread and still use READ/NEW later). 3/26/94 - -Added /INDENT=string to allow different indentation string. 3/12/94 - -Added ability to allow BULLCP to gateway for NEWS access via TCP (for MULTINET -only). 2/24/94 - -Fix FROM header for news groups messages that have an address which continues -on a 2nd line. 12/17/93 - -V 2.19 - -Add /MATCH qualifier to SEARCH command, and allow more than 1 string to be -specified. 12/2/93 - -Fixed the qualifer /CC when posting or resonding to messages. It was supposed -to be able to send to more than one user, but actually was sending to only the -first user specified. 7/17/93 - -Fixed alpha related problems. 7/16/93 - -Fixed problem with responding to addresses of form: name
. 7/2/93 - -Fixed shutdown bugs. 6/6/93 - -Fixed /PRINT and /EXTRACT in DIRECTORY when used with a remote news group. -5/29/93 - -System messages which have longer lines than the terminal page width will have -their text left justified rather than simply wrapped. 5/28/93 - -Added SET [NO]EXCLUDE command to be able to ignore any excludes or -includes that have been specified for that folder. 5/20/93 - -V 2.18 - -Added /FULL to EXCLUDE and INCLUDE command to make it affect all -commands, such as directory listings. 5/13/93 - -Fixed bug which displayed wrong foldername for notification broadcasts for -messages added to bboard folders with digest set. 5/13/93 - -Fixed bug which caused FOR003.DAT files to appear in DECNET directory due to -BBOARD folder which has digest set. 5/10/93 - -Fixed problem with inserting correct time when posting to news group. 5/5/93 - -Fixed problem with BULL_DIR_LIST usage. 5/5/93 - -Fixed shutdown problems. 5/3/93 - -Fixed new executable message. 5/3/93 - -Fixed bugs which caused FOR00x.DAT files to appear in DECNET directory during -access from remote nodes. 4/29/93 - -V 2.17 - -Modified to work for ALPHA cpus. 4/5/93 - -Speeded up DIRECTORY listing. 3/18/93 - -Fixed FORWARD command from truncating subject lengths > 64. 3/18/93 - -V 2.16 - -Add code which causes nodename of remote folders to automatically be updated -when the bulletin data files of the node containing the remote folders are -moved to a different node. 3/12/93 - -Fix incorrect display of NEWS/SUBSCRIBE/COUNT. 3/6/93 - -In batch mode, paging is now automatically turned off and page width set to 80. -3/5/93 - -Fixed problem with shutdown messages not being deleted. 3/4/93 - -V 2.15 - -Code that converts data files if FOLDER_MAX is increased did not work. 2/27/93 - -NEWS/SUBS now shows last read message. INDEX now shows listing similar to -DIR/FOLDER and NEWS. 2/27/93 - -A user can make /HEADER be made the default for a folder or news group by adding -a line to the user's customization file. (See HELP custom) 2/21/93 - -Personal names which are set in VMS MAIL are now automatically added to the from -address when posting to news groups. 2/15/93 - -Fixed bug which caused only partial storage of specified local news groups. -2/5/93 - -Fixed bug that caused privilege error and crash to occur after a non-privileged -user posted a message to a folder which had an associated mailing list. 2/5/93 - -V 2.14 - -Added SET ANONYMOUS command so that all messages added to a folder will have -the username ANONYMOUS rather than the actual username. 2/1/93 - -Added /EXTRACT qualifie to DIRECTORY command. 1/31/93 - -Added notification of new executable and possible new features. 1/26/93 - -Dump log files are now created with acl for folder owner to be able to delete -it. 1/26/93 - -V 2.13 - -Fixed bug in BBOARD code that corrupts file length. 1/15/93 - -Fixed notification messages that showed wrong folder name. 1/15/93 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -Fixed bug in posting to stored news group by non-privileged users. 12/28/92 - -V 2.12 - -Fixed SET ACCESS /ALL which broke due to changes in V 2.11. 12/28/92 - -Fixed problem with reply posting to stored news group not posting to proper -group. 12/28/92 - -Added code to allow setting access to news group or class of news groups. -Added /PRIVATE switch to SET NEWS. Added /CLASS to SET ACCESS. 12/26/92 - -Fixed bug in code that does copying from news group to folder. 12/26/92 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages based -on subject and address headers. 12/15/92 - -Fixed bug which caused folder corruption. 12/15/92 - -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for the -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit out -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 - -Added /NOW to PRINT command. Messages no longer have to be printed one message -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are found -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large news -group names. 7/31/91 - -Added FIRST command to read first message found in folder. 7/31/91 - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91 - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page, -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the -directory listing of a folder was displayed, and then RETURN is entered to -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91 - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91 - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (via -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually -read. 4/29/91 - -Added capability of controlling the time between updates for BBOARD and NEWS in -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/91 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed -news group folders. 4/25/91 - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the former -for real folders, the latter for news groups). 4/11/91 - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet). - -Changed BBOARD algorithm so that it is now possible to have only one real -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups. - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS. - -Added signature file for POST and RESPOND messages. - -Added capability to specify file name for POST, REPLY, and RESPOND. - -Added the line "In a previous message, wrote:" to the -beginning of a message when /EXTRACT is specified - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by a -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages in -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder which -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL. - -V 1.91 - -Disallow SPAWN command for CAPTIVE account. - -Fix MAIL command to correctly allow passing addresses with quotes, i.e. -IN%"""MRL@NERUS.PFC.MIT.EDU""". - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the message -was broadcasted when added using ADD/BROADCAST. - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages. - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used. - -BULLETIN now will use the editor specified by the SET EDITOR command within -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time. - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typing -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only the -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has been -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessing -a remote node via /NODES (it would have required looking a the sources to find, -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the command -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start where -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the -BULLCP process. - -Added ATTACH command. - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts with -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out of -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is a -remote system folder, when BULLETIN/LOGIN was executed, the same messages might -be displayed on both the local and remote nodes. BULLETIN now will know that -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executing -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder. - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages. - -A major bug was fixed which was introduced in previous mods to speed up -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vmslt98b/bulletin/cmds.mai b/decus/vmslt98b/bulletin/cmds.mai deleted file mode 100644 index 1340739..0000000 --- a/decus/vmslt98b/bulletin/cmds.mai +++ /dev/null @@ -1,22 +0,0 @@ -The address for getting BULLETIN is BULLETIN@PFC.MIT.EDU. - -Valid commands are: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file - (only one file per command). - DIR Lists available files. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -Send those commands in either the text of the message, one command per line, -or send a single command in the subject header. - -BULLETIN is also available via ANONYMOUS FTP from PFC.MIT.EDU, but the account -is set at low priority, so I suggest using it during non-prime hours. - - Mark diff --git a/decus/vmslt98b/bulletin/copyright.txt b/decus/vmslt98b/bulletin/copyright.txt deleted file mode 100644 index ee33a7e..0000000 --- a/decus/vmslt98b/bulletin/copyright.txt +++ /dev/null @@ -1,29 +0,0 @@ -"Bulletin" Z License - -This software is being provided to you, the LICENSEE, by the Massachusetts -Institute of Technology (M.I.T.) under the following license. By -obtaining, using and/or copying this software, you agree that you have -read, understood, and will comply with these terms and conditions: - -Permission to use, copy, modify and distribute without fee for any purpose, -this software and its documentation without fee or royalty is hereby granted, -provided that you agree to comply with the following copyright notice and -statements, including the disclaimer, and that the same appear on ALL copies -of the software and documentation, including modifications that you make for -internal use or for distribution: - -Copyright 1985 by the Massachusetts Institute of Technology. All rights -reserved. - -THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR -WARRANTIES, EXPRESS OR IMPLIED. By way of example, but not limitation, -M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS -FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR -DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, -TRADEMARKS OR OTHER RIGHTS. - -The name of the Massachusetts Institute of Technology or M.I.T. may NOT be -used in advertising or publicity pertaining to distribution of the -software. Title to copyright in this software and any associated -documentation shall at all times remain with M.I.T., and USER agrees to -preserve same. diff --git a/decus/vmslt98b/bulletin/create.com b/decus/vmslt98b/bulletin/create.com deleted file mode 100644 index 5e90fde..0000000 --- a/decus/vmslt98b/bulletin/create.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$ @BULLETIN.LNK diff --git a/decus/vmslt98b/bulletin/createco.com b/decus/vmslt98b/bulletin/createco.com deleted file mode 100644 index 9389ea0..0000000 --- a/decus/vmslt98b/bulletin/createco.com +++ /dev/null @@ -1,57 +0,0 @@ -$ FQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN FQ = "/SEPARATE_COMPILATION" -$ IF F$GETSYI("VP_MASK") .NE. 0 THEN FQ = FQ + "/NOHPO" -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN0 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN1 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN2 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN3 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN4 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN5 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN6 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN7 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN8 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN9 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN10 -$ FORTRAN/NOWARN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)'FQ' BULLETIN11 -$ IF F$GETSYI("HW_MODEL") .LE. 1023 THEN MAC ALLMACS -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN MAC ALLMACS_AXP -$ SET COMMAND/OBJ BULLCOM -$ SET COMMAND/OBJ BULLMAIN -$ CCQ = "" -$ IF F$GETSYI("HW_MODEL") .GT. 1023 THEN CCQ = "/STAN=VAX" -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .NES. "" THEN GOTO MULTI -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],- - TWG$TCP:[NETDIST.INCLUDE.SYS],- - TWG$TCP:[NETDIST.INCLUDE.VMS],- - TWG$TCP:[NETDIST.INCLUDE.NETINET],- - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARY -$ CC'CCQ' BULL_NEWS/DEFINE=(TWG=1) -$ GOTO LINK -$MULTI: -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX -$ CC'CCQ' BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINK -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC'CCQ' BULL_NEWS/DEFINE=(UCX=1) -$ GOTO LINK -$CMU: -$ CC'CCQ' BULL_NEWS -$ GOTO LINK -$DUMMY: -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature." -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ SET NOON -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN- - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .NES. "" THEN DELETE BULL.OLB;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL -$ LIBRARY BULL *.OBJ; -$ DELETE *.OBJ;* -$! @BULLETIN.LNK diff --git a/decus/vmslt98b/bulletin/handout.txt b/decus/vmslt98b/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vmslt98b/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vmslt98b/bulletin/install.com b/decus/vmslt98b/bulletin/install.com deleted file mode 100644 index 758acd4..0000000 --- a/decus/vmslt98b/bulletin/install.com +++ /dev/null @@ -1,25 +0,0 @@ -$ IF F$TRN("BULL_DIR") .EQS. "" -$ THEN -$ WRITE SYS$OUTPUT "ERROR: BULL_DIR has not been defined yet." -$ WRITE SYS$OUTPUT "Assign BULL_DIR as a logical name or modify this" -$ WRITE SYS$OUTPUT "command procedure to point to the appropriate directory." -$ EXIT -$ ENDIF -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vmslt98b/bulletin/instruct.com b/decus/vmslt98b/bulletin/instruct.com deleted file mode 100644 index a9cf299..0000000 --- a/decus/vmslt98b/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT/NOEDIT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT/NOEDIT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vmslt98b/bulletin/instruct.txt b/decus/vmslt98b/bulletin/instruct.txt deleted file mode 100644 index 1309dcc..0000000 --- a/decus/vmslt98b/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vmslt98b/bulletin/login.com b/decus/vmslt98b/bulletin/login.com deleted file mode 100644 index 5c0c2d5..0000000 --- a/decus/vmslt98b/bulletin/login.com +++ /dev/null @@ -1,31 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! If you want to have more than one BULLETIN database, replace BULL_DIR -$! with the actual directory to allow redefining BULL_DIR. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vmslt98b/bulletin/makefile b/decus/vmslt98b/bulletin/makefile deleted file mode 100644 index 964fa04..0000000 --- a/decus/vmslt98b/bulletin/makefile +++ /dev/null @@ -1,82 +0,0 @@ -# Makefile for BULLETIN - -Bulletin : Bulletin.Exe Bull.Hlb - -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel - - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.24" $ - -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.Obj - Purge /Log *.Obj,*.Exe - -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.For - -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \ - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.For - -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.For - -Allmacs.Obj : Allmacs.mar - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.Cld - -Bullmain.Obj : Bullmain.cld - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb : - lib/help/cre $* diff --git a/decus/vmslt98b/bulletin/master.com b/decus/vmslt98b/bulletin/master.com deleted file mode 100644 index 4cd0125..0000000 --- a/decus/vmslt98b/bulletin/master.com +++ /dev/null @@ -1,408 +0,0 @@ -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. diff --git a/decus/vmslt98b/bulletin/mx.com b/decus/vmslt98b/bulletin/mx.com deleted file mode 100644 index 47bd33c..0000000 --- a/decus/vmslt98b/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_SOURCE to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P3 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P3 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p3 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vmslt98b/bulletin/mx.mai b/decus/vmslt98b/bulletin/mx.mai deleted file mode 100644 index ec864aa..0000000 --- a/decus/vmslt98b/bulletin/mx.mai +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_LIBRARY") .eqs. "" -$ then say "BULL_LIBRARY logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_library/LIB,SYS$SYSTEM:SYS.STB/SEL,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADD - * - */ -unsigned long int -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from) -{ - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */ - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status); - } - - /* Loop reading message lines until end-of-file. For each line read, - create a string descriptor for it and call the BULLETIN routine to - add the line. */ - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */ - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - } - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -} - - -/* - * - * Function: scan_for_from_line - * - * Functional description: - * - * The routine scans the message's RFC822 headers for the "From:" line. - * It parses out the address by extracting the
. - * - * This routine was necessary because letting BULLETIN find the "From:" - * line was resulting in a non-RESPONDable address for MX. For example, - * BULLETIN was creating: - * - * From: MX%"Hunter Goatley, WKU " - * - * but MX needs - * - * From: MX%"" - * - * Inputs: - * - * filerab - Address of the message file's RAB - * - * Outputs: - * - * final_from - Address of a character buffer to receive the final address - * - * Returns: - * - * unsigned long int - binary success/failure status - * - * Side effects: - * - * The message file is rewound so that subsequent GETs start at the - * beginning of the message. - * - */ -unsigned long int -scan_for_from_line(struct RAB *filerab, char *final_from) -{ - unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - char whole_from_line[512]; /* The assembled "From:" line */ - char *filebuffer; /* Pointer to the input buffer */ - int i, j, x; /* Work variables */ - - scan_status = SS$_NORMAL; /* Assume success */ - whole_from_line[0] = '\0'; /* Initialize work buffer */ - - /* Loop reading message lines until end-of-file or first null line, - which should signal the end of the RFC822 header. For each line read, - check to see if we've located the "From:" line. - */ - - filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */ - while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */ - ((x = filerab->rab$w_rsz) != 0)){ /* or null record */ - filebuffer[x] = '\0'; /* Set NULL byte */ - if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */ - - /* Found "From:" line */ - tracemsg("Found \042From:\042 line in RFC822 header"); - strcpy(whole_from_line,filebuffer); /* Copy to work buff */ - - /* The "From:" line may actually be split over several lines. - In such cases, the remaining lines are indented by 6 spaces. - To handle this, loop reading records until one is read that - doesn't begin with a blank. As each record is read, it is - trimmed and tacked on to whole_from_line, so we end up with - the entire "From:" line in one buffer. */ - - while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */ - (filebuffer[0] == ' ')){ /* ... line */ - for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */ - strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */ - } - - /* Now have the whole "From:" line in whole_from_line. Since - the real address is enclosed in "<>", look for it by - searching for the last "<" and reading up to the ">". */ - - i = strrchr(whole_from_line,'<'); /* Find last "<" */ - if (i != 0){ /* Found it.... */ - j = strchr(i,'>'); /* Find last ">" */ - j = j-i+1; /* Calc addr length */ - } - else{ - j = strlen(whole_from_line)-6; /* Don't count From: */ - i = &whole_from_line + 6; /* in string length */ - } - if (j < 0){ /* If neg., error */ - tracemsg("Error - unable to locate from address"); - strcpy(final_from,""); /* Return null string */ - scan_status = 0; /* Set error status */ - } - else { - tracemsg("Found sender's address in RFC822 header"); - strncpy(final_from, i, j); /* Copy to caller */ - } - } - } - - SYS$REWIND(filerab); /* Rewind the file to the beginning */ - return(scan_status); /* Return success to caller */ -} - - -/* - * - * Function: forward_to_postmaster - * - * Functional description: - * - * If an error occurs trying to write a message to a BULLETIN folder, - * this routine is called to forward the message to the local - * postmaster. - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - binary status of call to INIT_MESSAGE_ADD - * - * Side effects: - * - * The message file is rewound so that subsequent calls to this routine - * can be made (in case the message is to be written to several folders). - * - */ -unsigned long int -forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status) -{ - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - struct dsc$descriptor_s subject; - char subject_buf[256]; - char postmaster[256]; int postmaster_len; - char status_msg_buf[256]; int status_msg_len; - struct dsc$descriptor_s status_msg; - static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS"); - static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)"); - static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER"); - int send_context = 0; int x; int y; - - static char *error_msgs[] = { - {"Error delivering message to BULLETIN folder. BULLETIN error status:"}, - {""}, - {""}, - {"Original message text follows:"}, - {"--------------------------------------------------"} - }; - - trnlnm_itmlst[0].buffer_length = 255; - trnlnm_itmlst[0].buffer_address = &postmaster; - trnlnm_itmlst[0].return_length_address = &postmaster_len; - - SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst); - if (postmaster_len == 0) /* If logical is not defined, */ - return(SS$_NORMAL); /* then pretend it worked */ - - tracemsg("Forwarding message to local postmaster...."); - subject.dsc$w_length = 255; - subject.dsc$a_pointer = &subject_buf; - SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */ - - address_itmlst[0].buffer_length = postmaster_len; /* To: */ - address_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[0].buffer_length = postmaster_len; /* To: */ - attribute_itmlst[0].buffer_address = &postmaster; /* To: */ - attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */ - attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */ - attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/ - attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/ - - vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_add_address(&send_context, &address_itmlst, - &nulllist)); - vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst, - &nulllist)); - - for (x = 0; x < 5; x++){ - bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]); - bodypart_itmlst[0].buffer_address = error_msgs[x]; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - if (x == 1){ - status_msg.dsc$w_length = 256; - status_msg.dsc$b_dtype = DSC$K_DTYPE_T; - status_msg.dsc$b_class = DSC$K_CLASS_S; - status_msg.dsc$a_pointer = &status_msg_buf; - y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0); - if (!(y & 1)) - sprintf(status_msg_buf,"Error code is %%X%08x",status); - else - status_msg_buf[status_msg.dsc$w_length] = '\0'; - bodypart_itmlst[0].buffer_length = strlen(status_msg_buf); - bodypart_itmlst[0].buffer_address = &status_msg_buf; - vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst, - &nulllist)); - } - } - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */ - bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz; - bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf; - vms_errchk(mail$send_add_bodypart(&send_context, - &bodypart_itmlst, &nulllist)); - } - - vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist)); - vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist)); - - tracemsg("Message forwarded to postmaster...."); -} - - -/* - * - * Function: log_accounting - * - * Functional description: - * - * This routine will write an accounting record for the message. - * - * Inputs: - * - * folder - Address of a string descriptor for the name of the folder - * from - Address of a string descriptor for the "From:" address - * status - Address of longword containing the BULLETIN error code - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status - * - */ -unsigned long int -log_accounting(void *folder, void *from, int bull_status) -{ - struct FAB accfab; - struct RAB accrab; - static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG"); - static $DESCRIPTOR(faostr, - "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL"); - char outbufbuf[256]; - struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S, - &outbufbuf}; - - int status; - static char bullacc[] = "MX_BULLETIN_ACC"; - static char bullaccdef[] = "MX_SITE_DIR:.DAT"; - - status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0); - if (!(status & 1)) - return(SS$_NORMAL); - - tracemsg("Writing accounting information to accounting log...."); - accfab = cc$rms_fab; - accrab = cc$rms_rab; - accfab.fab$b_fns = strlen(bullacc); /* Set filename length */ - accfab.fab$l_fna = &bullacc; /* Set filename address */ - accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */ - accfab.fab$l_dna = &bullaccdef; /* Set filename address */ - accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */ - accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */ - accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */ - accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */ - accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - - status = SYS$OPEN (&accfab); /* Try to open the file */ - if (status & 1) /* Success? */ - accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */ - else /* Couldn't open, so create */ - status = SYS$CREATE (&accfab); /* ... a new one */ - if (status & 1){ /* If either was OK... */ - status = SYS$CONNECT (&accrab); /* Connect the RAB */ - if (status == RMS$_EOF) /* RMS$_EOF status is OK */ - status = RMS$_NORMAL; /* Change it to NORMAL */ - if (!(status & 1)){ /* If any error occurred */ - tracemsg("Unable to open accounting file"); - traceerr(status); - SYS$CLOSE (&accfab); /* Close the file */ - return(status); /* And return the error */ - } - } - else - return(status); - - SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status); - accrab.rab$w_rsz = outbuf.dsc$w_length; - accrab.rab$l_rbf = outbuf.dsc$a_pointer; - SYS$PUT (&accrab); - SYS$CLOSE (&accfab); -} - -/* - * - * Main routine - * - */ -main(int argc, char *argv[]) -{ - struct dsc$descriptor_s folder; /* Descriptor for the folder name */ - struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */ - static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG"); - - char *from_line; /* Pointer to dynamic "From:" buffer */ - char *folder_name; /* Pointer to folder name in rcptbuf */ - char *atsign; /* Pointer to "@" in rcptbuf */ - int x; /* Work variable */ - unsigned long int bull_status; /* Status from add_to_bulletin_folder */ - - --argc; /* Don't count the program name */ - if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */ - exit(LIB$_WRONUMARG); /* ... exit with error status */ - } - - vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0); - if (vms_status & 1) - trace = 1; - else - trace = 0; - - /* Open all input files */ - - tracemsg("Opening message file...."); - vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1])); - tracemsg("Opening recipients file...."); - vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2])); - - if (argc == 2){ - tracemsg("Using sender address from RFC822 headers...."); - scan_for_from_line(&msgrab, &frombuf); - } - else { - tracemsg("Opening sender address file...."); - vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3])); - - tracemsg("Reading sender address from file...."); - rms_get(&fromrab); /* Read the from line */ - if (!(rms_status & 1)) /* Exit if an error occurred */ - err_exit(rms_status); - - /* Set the end of the record read, then initialize the descriptor for it */ - frombuf[fromrab.rab$w_rsz] = 0; - - SYS$CLOSE(&fromfab); - } /* End of "if (argc == 2)"... */ - - /* frombuf now has the sender's address in it */ - - if (strlen(frombuf) == 0) { - tracemsg("Unable to find sender's address, using MX%"); - init_sdesc(&from_user, "MX%"); - } - else{ - - /* Now add the MX% prefix and the double quotes */ - from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */ - - /* Make the string repliable through MX by adding MX%"" to it */ - strcpy(from_line,"MX%\042"); - strcat(from_line,frombuf); - strcat(from_line,"\042"); - if (trace) - printf("MX_BULL: Sender's address is %s\n", from_line); - init_sdesc (&from_user, from_line); /* Create a string descriptor */ - } - /* - Read through all the recipients, writing the message to all BULLETIN - folders (identified by checking for @BULLETIN in the address). - */ - rms_get(&rcptrab); /* Read a recipient */ - while ((rms_status & 1) & (rms_status != RMS$_EOF)){ - tracemsg("Looking for BULLETIN folder...."); - folder_name = &rcptbuf; /* Point to receipt buffer */ - if (folder_name[0] == '<'){ /* If line begins with "<" */ - ++folder_name; /* bump over it and check */ - atsign = strchr(rcptbuf,'@'); /* for a "@" */ - if (atsign != 0){ /* If "@" was found, */ - if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */ - x = atsign - folder_name; /* Length of folder name */ - folder_name[x] = 0; /* Terminate folder name */ - init_sdesc (&folder, folder_name); /* Initialize descriptor */ - str$upcase(&folder, &folder); /* Convert to uppercase */ - if (trace) - printf("MX_BULL: Found BULLETIN folder \042%s\042....\n", - folder_name); - tracemsg("Adding message to BULLETIN folder...."); - bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user); - if (!(bull_status & 1)){ - traceerr(bull_status); - vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user, - bull_status)); - } - log_accounting(&folder, &from_user, bull_status); - SYS$REWIND(&msgrab); /* Rewind the file for next folder */ - - } - } - } - rms_get(&rcptrab); /* Read next recipient */ - } - - - /* Close the RMS files */ - - SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab); - - tracemsg("BULLETIN message processed"); - exit(SS$_NORMAL); /* Always return success */ - -} -$eod -$copy/log sys$input MX_BULL.TXT -$deck - MX_BULL - An MX SITE transport - March 14, 1991 - -MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program -by Mark London at MIT. It is designed to be called as an MX SITE transport, -letting MX write messages into BULLETIN folders as they are processed, instead -of routing the messages to MAIL.MAI files for each folder. - -The following files make up the MX_BULL distribution: - - BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE - MX_BULL.C VAX C source code for MX_BULL - MX_BULL.TXT This file - MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL - -The current version is 01-001. - - -WHAT IS BULLETIN? ------------------ -BULLETIN is a VMS bulletin board written by Mark London at MIT that allows -multiple users to access a common message base. Messages are divided into -folders, which work much like VMS Mail folders. Using MX_BULL, messages can -be routed from Internet/Bitnet mailing lists directly to BULLETIN folders, -allowing all (or some) users on a system to access the mailing lists without -individual subscriptions. This can cut down on the number of incoming -Bitnet/Internet mail messages significantly, since only one copy of a message -need be sent to a site. - -BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the -Fall 1990 tapes. It can also be retrieved by sending a mail message to -BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of -the following commands: - - SEND ALL Sends all bulletin files. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - - -BUILDING MX_BULL.EXE --------------------- -MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM. - -MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The -build procedure for MX_BULL expects the logical BULL_LIBRARY to point to the -BULLETIN library. You must define this logical (or edit the .COM file) -before building MX_BULL. - - -INSTALLING MX_BULL ------------------- -To install MX_BULL, perform the following steps: - -1. Using MCP, define a path named BULLETIN as a SITE transport: - - MCP> DEFINE PATH "BULLETIN" SITE - -2. Using MCP, define a rewrite rule early in the list (this should actually - be done using CONFIG.MCP so that the order is correct): - - MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>" - -3. If you don't have a SITE transport already defined, simply copy - MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM. - - If you do have a SITE transport defined, you'll need to merge the MX_BULL - stuff into the existing MX_EXE:SITE_DELIVER.COM. - -4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and - restarting it. - -Once these steps have been completed, MX_BULL is set up to begin delivering -messages to BULLETIN. - - -ROUTING MESSAGES TO BULLETIN ----------------------------- -Messages are routed to BULLETIN folders by addressing mail to -MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN -folder. For example, the following commands would send a message from VMS -Mail to the BULLETIN folder GENERAL (on the local system): - - $ MAIL - MAIL> SEND - To: MX%"GENERAL@BULLETIN" - Subj: This is a test.... - ..... - -The message is sent to the MX router, which in turn sends it to the MX SITE -agent, since the @BULLETIN path was defined as a SITE path. - -To facilitate the automatic delivery of messages to BULLETIN folders, you -should set up forwarding addresses for each of the BULLETIN folders: - - MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN""" - MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN""" - -Mail addressed to GENERAL or MX-LIST will automatically be forwarded to -BULLETIN via MX_BULL. - -To subscribe to a Bitnet/Internet mailing list and have the messages delivered -to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the -BULLETIN folder. For example, the user to specify would be: - - MLFAKE/USER=MX-LIST .... - -(Alternatively, you could create a dummy account named MX-LIST (or whatever -the list name is) that exists only long enough to send the request via MAIL.) - -Once added to the lists, incoming mail addressed to MX-LIST will get forwarded -to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming -message to my local BULLETIN folder would be addressed to: - - MX-LIST@WKUVX1.bitnet - -Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed -to the BULLETIN folder. - -To try to illustrate the process, assume the node is WKUVX1.bitnet. We've -subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding -has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail -arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message -to the Local agent, which discovers that the mail is forwarded to -MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which -finds that BULLETIN is defined as a SITE path, so the message is passed to -MX->SITE, which in turn calls MX_BULL. - - -MX_BULL ACCOUNTING AND DEBUGGING --------------------------------- -MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE - -This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The -logical MX_BULLETIN_ACC can be defined system-wide to change the name of the -file: - - $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING - -To generate debugging logs in MX_SITE_DIR:, define the system logical -MX_SITE_DEBUG. - - -ERRORS WRITING TO BULLETIN --------------------------- -By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE -agent. This was done to avoid bouncing network mail back to a mailing list. -In order to be notified in case of problems writing the message to BULLETIN, -you can define a system logical MX_BULLETIN_POSTMASTER to be a local -username to receive failed MX_BULL transactions: - - $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - -If BULLETIN returns an error, MX_BULL will forward the message (via the -callable VMS Mail interface) to GOATHUNTER. - - -BULLETIN AND "From:" ADDRESSES ------------------------------- -If you use the return address supplied by the MX SITE agent, the return address -for BULLETIN messages will look something like the following: - - From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET" - -By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address. -If you want to use the MX SITE-supplied address, simply modify the following -line in MX_BULL_SITE_DELIVER.COM: - - $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address - -If the sender's address is ignored (again, the default), MX_BULL will search -the RFC822 headers in the message for the "From:" line. It then pulls out -the sender's address in a format suitable for using the RESPOND command in -BULLETIN. This lets users easily RESPOND to the sender of a message, or -POST a message to the list itself. - -Note: MX_BULL just uses the address it's given. Some addresses are gatewayed -to death, leaving a bad address on the "From:" line. This frequently happens -with messages coming via UUCP through Internet to Bitnet, etc. - - -AUTHOR INFORMATION ------------------- -MX_BULL was written by: - - Hunter Goatley, VMS Systems Programmer, WKU - - E-mail: goathunter@wkuvx1.bitnet - Voice: 502-745-5251 - - U.S. Mail: Academic Computing, STH 226 - Western Kentucky University - Bowling Green, KY 42101 -$eod -$copy/log sys$input MX_BULL_SITE_DELIVER.COM -$deck -$! -$! SITE_DELIVER.COM for MX_BULL -$! -$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet -$! Date: March 11, 1991 -$! -$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers -$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL -$! to use the P4 as the "From:" line, simply set USE_SITE_FROM to 1. -$! -$ USE_SITE_FROM = 0 !Change to 1 to use P4 -$ mxbull :== $mx_exe:mx_bull.exe -$! -$ set noon -$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR: -$ if USE_SITE_FROM !Use P4 as "From:"? -$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file -$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL -$ write tmp p4 !... doesn't mess it up -$ close tmp !... -$ mxbull 'p2' 'p3' mx_site_dir:sitesender.addr -$ delete/nolog mx_site_dir:sitesender.addr; -$ else mxbull 'p2' 'p3' !Just let BULLETIN find "From:" -$ endif -$ exit 1 !Always return success -$eod diff --git a/decus/vmslt98b/bulletin/news.alt b/decus/vmslt98b/bulletin/news.alt deleted file mode 100644 index e33d065..0000000 --- a/decus/vmslt98b/bulletin/news.alt +++ /dev/null @@ -1,254 +0,0 @@ - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales diff --git a/decus/vmslt98b/bulletin/news.com b/decus/vmslt98b/bulletin/news.com deleted file mode 100644 index fb7775e..0000000 --- a/decus/vmslt98b/bulletin/news.com +++ /dev/null @@ -1,679 +0,0 @@ -$set nover -$copy/log sys$input NEWS.ALT -$deck - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales - -From: ccs@aber.ac.uk (Christopher Samuel) -Date: 2-OCT-1992 11:36:37 -Description: Creating a new "alt" group -- guidelines - -Archive-name: alt-config-guide -Version: 1.2 -Last-modified: Wed Sep 2 16:31:55 GMT 1992 - - - - Guidelines for the creation of an "alt" group. - -There are no rules or guidelines for creation of "alt" groups, However -there does appear to be an established procedure which follows. First a -quick bit of common-sense on choosing the name: - -When choosing a name for a group please note the only commandment: Thou -shalt not choose a group name which may cause network harm or harm to a -local machine. - - Examples: - - alt.fan.enya.puke.puke.pukeSender: - - [preceding line to Sender had deleted; also the - trailing : can cause problems in some news systems] - - alt.verylonggroupnamethathasadirectorylongerthanmost\ - machinessupportsotherehaha.very.funny - - alt.[insert300charactershere].very.long.group.name.\ - that.is.too.big.for.newsrc - - alt.*.this.name.has.bad.characters.in.it - - alt..double.dot.group.name - - - Now the Guidelines: - ------------------- - - 1) Propose a new alt group in alt.config. The proposal - should include a charter or purpose for the new group, and - some demonstration of the need for the group. It is best to - make it clear in your subject line that you are proposing a - new group. Be prepared to explain why an existing group cannot - be used for this purpose, and why the group should be in "alt" - rather than in one of the mainstream hierarchies (like - "rec", "sci", etc.). Avoiding the complexity of the - mainstream group creation procedure is not a very good - reason, groups should not be created in "alt" just because - it's easier. Don't forget that mainstream groups can also - be created by the "trial" mechanism. Many sites do not get - any alt groups, so if you are proposing a serious group, it - is worth the effort to try to get it into a mainstream - hierarchy. - - 2) See what the alt.net.opinion of the new group is. Wait a - few days for replies to trickle in from the far corners of - the net. If the consensus (however you determine that) is - that the group should be created, then proceed to step 3. - - (these first two steps are often ignored, which usually - leads to unpleasantness in step 4 below) - - 3) Post a "newgroup" control message. If you don't know - how to do this, check with your news administrator. If you - ARE your news administrator, and you can't figure it out - from the documentation you have (or don't have any - documentation) send me mail and I will help you. NOTE that - many sites do NOT automatically honor "newgroup" and - "rmgroup" control messages, the news software at these sites - will send mail to the news administrator, who will evaluate - your request and decide whether or not to create the group. - It may take a couple of days for the control message to - propagate and be acted upon, so don't expect instant - availability of the new group, particularly if you post the - control message on a Friday night. - - NB: It is good manners to put a description of the new - newsgroup into the newgroup message, along with a - one-line description suitable for inclusion into the - newsgroups file. - - 4) Let the individual site news administrators decide - whether to honor your "newgroup" message. Most admins - prefer that the message come from a verifiable account, - messages which are obviously forged, or have not been - discussed in alt.config and contain no explanation will - probably not be honored by many sites. Persons opposed to - the group, or admins who feel that the newgroup message was - a forgery may send out "rmgroup" messages to try to sabotage - the group. It may take several iterations of this process - to firmly establish the new group. It has been humorously - suggested that only alt groups which get 100 more "newgroup" - than "rmgroup" messages should be established. However, - these "rmgroup wars" are annoying to news administrators, - and reduce the overall acceptance (and distribution) of the - "alt" hierarchy. This is the reason that steps 1 and 2 - above are important. - - -This may sound like a lot of rigamarole, and it is. The purpose is to -discourage creation of alt groups that might be better off as mainstream -groups, or that might be better of left uncreated. - -Don't take this all too seriously, though. The "alt" net is the last -remaining refuge away from the control freaks, namespace purists and -net.cops (like myself) that maintain and enforce the mainstream -newsgroup guidelines. - -There is still some room for spontaneity out here on the "alt" frontier. -Successful groups have been created without following these suggestions. -Almost any non-forged, serious newgroup message will at least be -considered by most news admins. Some groups have been created just on a -whim. The concept behind the group better be good (or a least -entertaining), though! - -[ If you want more information on mainstream group creation see the post - "How to Create a New Newsgroup" posted to news.answers, news.admin and - news.groups. ] - --- - Christopher Samuel, c/o Computer Unit, UCW Aberystwyth, Aberystwyth, WALES - RFC: ccs@aber.ac.uk UUCP: *!mcsun!uknet!aber!ccs JNT: ccs@uk.ac.aber - Deddf Iaith Newydd i Gymru | New Language Act for Wales -$eod -$copy/log sys$input NEWS.CREATE -$deck -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - -$eod -$copy/log sys$input NEWS.MODERATORS -$deck -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com -$eod diff --git a/decus/vmslt98b/bulletin/news.create b/decus/vmslt98b/bulletin/news.create deleted file mode 100644 index dc1c840..0000000 --- a/decus/vmslt98b/bulletin/news.create +++ /dev/null @@ -1,155 +0,0 @@ -From: tale@uunet.uu.net (David C Lawrence) -Date: 19-OCT-1992 00:15:29 -Description: How to Create a New Usenet Newsgroup - -Archive-name: creating-newsgroups/part1 -Original-author: woods@ncar.ucar.edu (Greg Woods) -Last-change: 23 Sep 1992 by spaf@cs.purdue.edu (Gene Spafford) - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@uunet.uu.net. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@uunet.uu.net; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the voters - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - diff --git a/decus/vmslt98b/bulletin/news.moderators b/decus/vmslt98b/bulletin/news.moderators deleted file mode 100644 index b53780f..0000000 --- a/decus/vmslt98b/bulletin/news.moderators +++ /dev/null @@ -1,260 +0,0 @@ -comp.ai.nlang-know-rep nl-kr@cs.rpi.edu -comp.ai.vision vision-list@ads.com -comp.archives comp-archives@msen.com -comp.binaries.acorn cba@acorn.co.nz -comp.binaries.amiga amiga@uunet.uu.net -comp.binaries.atari.st atari-binaries@hyperion.com -comp.binaries.ibm.pc cbip@cs.ulowell.edu -comp.binaries.mac macintosh%felix.uucp@uunet.uu.net -comp.binaries.os2 os2bin@csd4.csd.uwm.edu -comp.bugs.4bsd.ucb-fixes ucb-fixes@okeeffe.berkeley.edu -comp.compilers compilers@iecc.cambridge.ma.us -comp.dcom.telecom telecom@eecs.nwu.edu -comp.doc comp-doc@ucsd.edu -comp.doc.techreports compdoc-techreports@ftp.cse.ucsc.edu -comp.graphics.research graphics@scri1.scri.fsu.edu -comp.internet.library library@axon.cwru.edu -comp.lang.sigplan sigplan@bellcore.com -comp.laser-printers laser-lovers@brillig.umd.edu -comp.mail.maps uucpmap@rutgers.edu -comp.newprod newprod@chg.mcd.mot.com -comp.org.eff.news effnews@eff.org -comp.org.fidonet pozar@hop.toad.com -comp.os.ms-windows.announce infidel+win-announce@pitt.edu -comp.os.research osr@ftp.cse.ucsc.edu -comp.parallel hypercube@hubcap.clemson.edu -comp.patents patents@cs.su.oz.au -comp.protocols.kermit info-kermit@watsun.cc.columbia.edu -comp.research.japan japan@cs.arizona.edu -comp.risks risks@csl.sri.com -comp.simulation simulation@uflorida.cis.ufl.edu -comp.society socicom@auvm.american.edu -comp.society.cu-digest tk0jut2@mvs.cso.niu.edu -comp.society.folklore folklore@snark.thyrsus.com -comp.society.privacy comp-privacy@pica.army.mil -comp.sources.3b1 comp-sources-3b1@galaxia.network23.com -comp.sources.acorn cba@acorn.co.nz -comp.sources.amiga amiga@uunet.uu.net -comp.sources.apple2 jac@paul.rutgers.edu -comp.sources.atari.st atari-sources@hyperion.com -comp.sources.games games@saab.cna.tek.com -comp.sources.hp48 hp48@seq.uncwil.edu -comp.sources.mac macintosh%felix.uucp@uunet.uu.net -comp.sources.misc sources-misc@uunet.uu.net -comp.sources.reviewed csr@calvin.dgbt.doc.ca -comp.sources.sun sun-sources@topaz.rutgers.edu -comp.sources.unix unix-sources-moderator@pa.dec.com -comp.sources.x x-sources@msi.com -comp.std.announce klensin@infoods.mit.edu -comp.std.mumps std-mumps@pfcs.com -comp.std.unix std-unix@uunet.uu.net -comp.sys.acorn.announce announce@acorn.co.uk -comp.sys.amiga.announce announce@cs.ucdavis.edu -comp.sys.amiga.reviews amiga-reviews-submissions@math.uh.edu -comp.sys.concurrent concurrent@bdcsys.suvl.ca.us -comp.sys.ibm.pc.digest info-ibmpc@simtel20.army.mil -comp.sys.m68k.pc info-68k@ucbvax.berkeley.edu -comp.sys.mac.announce csma@rascal.ics.utexas.edu -comp.sys.mac.digest info-mac@sumex-aim.stanford.edu -comp.sys.next.announce csn-announce@liveware.com -comp.sys.sun.announce sun-announce@sunworld.com -comp.theory.info-retrieval ir-l%uccvma.bitnet@berkeley.edu -comp.virus krvw@cert.org -comp.windows.x.announce xannounce@expo.lcs.mit.edu -misc.activism.progressive map@pencil.cs.missouri.edu -misc.handicap handicap@bunker.shel.isc-br.com -misc.news.southasia surekha@nyx.cs.du.edu -news.admin.technical natech@zorch.sf-bay.org -news.announce.conferences nac@tekbspa.tss.com -news.announce.important announce@stargate.com -news.announce.newgroups announce-newgroups@rpi.edu -news.announce.newusers spaf@cs.purdue.edu -news.answers news-answers@mit.edu -news.lists news-lists-request@cs.purdue.edu -news.lists.ps-maps reid@decwrl.dec.com -rec.arts.cinema cinema@zerkalo.harvard.edu -rec.arts.comics.info info_comic@dartmouth.edu -rec.arts.erotica erotica@telly.on.ca -rec.arts.movies.reviews movies@mtgzy.att.com -rec.arts.sf.announce sf-announce@zorch.sf-bay.org -rec.arts.sf.reviews sf-reviews@presto.ig.com -rec.arts.startrek.info trek-info@dweeb.fx.com -rec.audio.high-end info-high-audio@csd4.csd.uwm.edu -rec.food.recipes recipes@mthvax.cs.miami.edu -rec.games.cyber cyberrpg@veritas.com -rec.games.frp.announce rg-frp-announce@magnus.acs.ohio-state.edu -rec.games.frp.archives frp-archives@rpi.edu -rec.games.mud.announce rgm-announce@glia.biostr.washington.edu -rec.guns magnum@flubber.cs.umd.edu -rec.humor.funny funny@clarinet.com -rec.humor.oracle oracle-mod@cs.indiana.edu -rec.hunting hunting@osnome.che.wisc.edu -rec.mag.fsfnet white@duvm.bitnet -rec.music.gaffa love-hounds@uunet.uu.net -rec.music.info rec-music-info@ph.tn.tudelft.nl -rec.music.reviews music_reviews@sco.com -rec.radio.broadcasting rrb@airwaves.chi.il.us -rec.sport.cricket.scores cricket@power.eee.ndsu.nodak.edu -sci.astro.hubble sah@wfpc3.la.asu.edu -sci.math.research sci-math-research@uiuc.edu -sci.med.aids aids@cs.ucla.edu -sci.military military@att.att.com -sci.nanotech nanotech@aramis.rutgers.edu -sci.psychology.digest psyc@phoenix.princeton.edu -sci.space.news sci-space-news@news.arc.nasa.gov -sci.virtual-worlds virtual-worlds@milton.u.washington.edu -soc.feminism feminism@ncar.ucar.edu -soc.politics poli-sci@rutgers.edu -soc.politics.arms-d arms-d@xx.lcs.mit.edu -soc.religion.bahai srb@oneworld.wa.com -soc.religion.christian christian@aramis.rutgers.edu -soc.religion.eastern sre@cse.ogi.edu -soc.religion.islam religion-islam@ncar.ucar.edu -alt.atheism.moderated atheism@mantis.co.uk -alt.binaries.pictures.fine-art.d artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.digitized artcomp@uxa.ecn.bgu.edu -alt.binaries.pictures.fine-art.graphics artcomp@uxa.ecn.bgu.edu -alt.comp.acad-freedom.news caf-news@eff.org -alt.dev.null /dev/null -alt.gourmand recipes@decwrl.dec.com -alt.hackers /dev/null -alt.hindu editor@rbhatnagar.csm.uc.edu -alt.politics.democrats news-submit@dc.clinton-gore.org -alt.politics.democrats.clinton news-submit@dc.clinton-gore.org -alt.politics.democrats.governors news-submit@dc.clinton-gore.org -alt.politics.democrats.house news-submit@dc.clinton-gore.org -alt.politics.democrats.senate news-submit@dc.clinton-gore.org -alt.security.index kyle@uunet.uu.net -alt.society.ati gzero@tronsbox.xei.com -alt.society.cu-digest tk0jut2@mvs.cso.niu.edu -alt.sources.index kyle@uunet.uu.net -austin.eff eff-austin-moderator@tic.com -ba.announce ba-announce@zorch.sf-bay.org -bionet.announce biosci-announce-moderator@genbank.bio.net -bionet.biology.computational comp-bio-moderator@genbank.bio.net -bionet.molbio.ddbj.updates ddbj-updates@genbank.bio.net -bionet.molbio.embldatabank.updates embl-updates@genbank.bio.net -bionet.molbio.genbank.updates lear@genbank.bio.net -bionet.software.sources software-sources@genbank.bio.net -bit.listserv.big-lan big-req@suvm.acs.syr.edu -bit.listserv.edtech 21765EDT%MSU@CUNYVM.CUNY.EDU -bit.listserv.gaynet gaynet@athena.mit.edu -bit.listserv.hellas sda106@psuvm.psu.edu -bit.listserv.l-hcap wtm@bunker.shel.isc-br.com -bit.listserv.libres librk329@KentVMS.Kent.edu -bit.listserv.new-list NU021172@VM1.NoDak.EDU -bit.listserv.pacs-l LIBPACS%UHUPVM1@CUNYVM.CUNY.EDU -bit.listserv.valert-l krvw@cert.org -biz.dec.decnews decnews@mr4dec.enet.dec.com -biz.sco.announce scoannmod@xenitec.on.ca -biz.sco.binaries sl@wimsey.bc.ca -biz.sco.sources kd1hz@anomaly.sbs.risc.net -biz.zeos.announce kgermann@zeos.com -can.canet.d canet-d@canet.ca -can.uucp.maps pathadmin@cs.toronto.edu -comp.protocols.iso.x400.gateway ifip-gtwy-usenet@ics.uci.edu -comp.security.announce cert@cert.org -ddn.mgt-bulletin nic@nic.ddn.mil -ddn.newsletter nic@nic.ddn.mil -de.admin.lists de-admin-lists@hactar.hanse.de -de.admin.submaps maps@flatlin.ka.sub.org -de.comp.sources.amiga agnus@amylnd.stgt.sub.org -de.comp.sources.misc sources@watzman.quest.sub.org -de.comp.sources.os9 fkk@stasys.sta.sub.org -de.comp.sources.st sources-st@watzman.quest.sub.org -de.comp.sources.unix de-comp-sources-unix@germany.sun.com -de.mag.chalisti ccc@sol.ccc.de -de.newusers newusers@jattmp.nbg.sub.org -de.org.dfn org-dfn@dfn.de -de.org.eunet news@germany.eu.net -de.org.sub vorstand@smurf.sub.org -de.sci.ki hein@damon.irf.uni-dortmund.de -de.sci.ki.mod.ki hein@damon.irf.uni-dortmund.de -fj.announce fj-announce@junet.ad.jp -fj.binaries fj-binaries@junet.ad.jp -fj.binaries.x68000 fj-binaries-x68000@junet.ad.jp -fj.guide.admin fj-guide-admin@junet.ad.jp -fj.guide.general fj-guide-general@junet.ad.jp -fj.guide.newusers fj-guide-newusers@junet.ad.jp -fj.map fj-map@junet.ad.jp -gnu.announce info-gnu@prep.ai.mit.edu -gnu.bash.bug bug-bash@prep.ai.mit.edu -gnu.emacs.announce info-gnu-emacs@prep.ai.mit.edu -gnu.emacs.bug bug-gnu-emacs@prep.ai.mit.edu -gnu.g++.announce info-g++@prep.ai.mit.edu -gnu.g++.bug bug-g++@prep.ai.mit.edu -gnu.g++.lib.bug bug-lib-g++@prep.ai.mit.edu -gnu.gcc.announce info-gcc@prep.ai.mit.edu -gnu.gcc.bug bug-gcc@prep.ai.mit.edu -gnu.gdb.bug bug-gdb@prep.ai.mit.edu -gnu.ghostscript.bug bug-ghostscript@prep.ai.mit.edu -gnu.groff.bug bug-groff@prep.ai.mit.edu -gnu.smalltalk.bug bug-gnu-smalltalk@prep.ai.mit.edu -gnu.utils.bug bug-gnu-utils@prep.ai.mit.edu -houston.weather weather-monitor@tmc.edu -ieee.tcos tcos@cse.ucsc.edu -info.academic.freedom caf-talk@eff.org -info.admin usenet@ux1.cso.uiuc.edu -info.bind bind@arpa.berkeley.edu -info.brl.cad cad@brl.mil -info.bytecounters bytecounters@venera.isi.edu -info.cmu.tek.tcp cmu-tek-tcp@cs.cmu.edu -info.convex info-convex@pemrac.space.swri.edu -info.firearms firearms@cs.cmu.edu -info.firearms.politics firearms-politics@cs.cmu.edu -info.gated gated-people@devvax.tn.cornell.edu -info.ietf ietf@venera.isi.edu -info.ietf.hosts ietf-hosts@nnsc.nsf.net -info.ietf.isoc isoc-interest@relay.sgi.com -info.ietf.njm njm@merit.edu -info.ietf.smtp ietf-smtp@dimacs.rutgers.edu -info.isode isode@nic.ddn.mil -info.jethro.tull jtull@remus.rutgers.edu -info.labmgr labmgr@ukcc.uky.edu -info.mach info-mach@cs.cmu.edu -info.mh.workers mh-workers@ics.uci.edu -info.nets info-nets@think.com -info.nsf.grants grants@note.nsf.gov -info.nsfnet.cert nsfnet-cert@merit.edu -info.nysersnmp nysersnmp@nisc.nyser.net -info.osf roma@uiuc.edu -info.pem.dev pem-dev@tis.com -info.ph info-ph@uxc.cso.uiuc.edu -info.rfc rfc-request@nic.ddn.mil -info.snmp snmp@nisc.nyser.net -info.sun.managers sun-managers@rice.edu -info.sun.nets sun-nets@umiacs.umd.edu -info.theorynt theorynt@vm1.nodak.edu -info.unix.sw unix-sw-request@wsmr-simtel20.army.mil -mi.map uucpmap@rel.mi.org -opinions.supreme-court opinions@uunet.uu.net -relcom.infomarket.quote relcom-infomarket-quote@news.ussr.eu.net -relcom.infomarket.talk relcom-infomarket-talk@news.ussr.eu.net -relcom.jusinf relcom-jusinf@news.ussr.eu.net -relcom.postmasters relcom-postmasters@news.ussr.eu.net -relcom.renews relcom-renews@news.ussr.eu.net -resif.oracle oracle@grasp1.univ-lyon1.fr -sfnet.atk.flpf.tiedotukset flpf@nic.funet.fi -sfnet.csc.tiedotukset netmgr@csc.fi -sfnet.funet.tiedotukset toimitus@funet.fi -sfnet.fuug.tiedotukset sfnet-fuug-tiedotukset@fuug.fi -sfnet.harrastus.astronomia pvtmakela@cc.helsinki.fi -sfnet.harrastus.mensa jau@cs.tut.fi -sfnet.lists.sunflash flash@sunvice.East.Sun.COM -sfnet.opiskelu.ymp.kurssit hoffren@cc.Helsinki.FI -sfnet.tiede.tilastotiede.jatkokoulutus til_tied@cc.helsinki.fi -sura.announce sura-announce@darwin.sura.net -sura.noc.status sura-noc-status@darwin.sura.net -sura.security sura-security@darwin.sura.net -tamu.religion.christian shetler@eemips.tamu.edu -tx-thenet-managers themgr-moderator@nic.the.net -tx.maps texas-uucpmaps@tmc.edu -uiuc.org.men uiuc-men-ml@ux1.cso.uiuc.edu -uunet.alternet asp@uunet.uu.net,postman@uunet.uu.net -uunet.announce postman@uunet.uu.net -uunet.products postman@uunet.uu.net -uunet.status postman@uunet.uu.net -uunet.tech postman@uunet.uu.net -vmsnet.announce vmsnet-announce@mccall.com -vmsnet.announce.newusers vmsnet-announce-newusers@mccall.com -vmsnet.sources vmsnet-sources@mvb.saic.com diff --git a/decus/vmslt98b/bulletin/news.txt b/decus/vmslt98b/bulletin/news.txt deleted file mode 100644 index f52d95e..0000000 --- a/decus/vmslt98b/bulletin/news.txt +++ /dev/null @@ -1,150 +0,0 @@ -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when a -user accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. It is also possible to -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) When the POST and -ADD commands are used with this folder, the messages will be posted to the news -group, rather than actually being added to the folder. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. diff --git a/decus/vmslt98b/bulletin/nonsystem.txt b/decus/vmslt98b/bulletin/nonsystem.txt deleted file mode 100644 index dd6deec..0000000 --- a/decus/vmslt98b/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vmslt98b/bulletin/optimize_rms.com b/decus/vmslt98b/bulletin/optimize_rms.com deleted file mode 100644 index 4f42e3e..0000000 --- a/decus/vmslt98b/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = "Y" -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vmslt98b/bulletin/pmdf.com b/decus/vmslt98b/bulletin/pmdf.com deleted file mode 100644 index 732bcf2..0000000 --- a/decus/vmslt98b/bulletin/pmdf.com +++ /dev/null @@ -1,1031 +0,0 @@ -$set nover -$copy/log sys$input BULLETIN_MASTER.PAS -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (output, outbound, - %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC', - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.bitnet) *) -(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *) -(* 8/18/88 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR - %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' - - outbound : text; - - (* Place to store the channel we are servicing *) - mail_channel : mm_channel_ptr := nil; - - (* MM status control flag *) - - mm_status : (uninitialized, initialized, sending) := uninitialized; - - filename : vstring; - - (* Place to store the protocol that we are providing/servicing *) - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln; - os_write_datetime (output); - writeln (message); - END; (* warn_master *) - - (* abort program. *) - - PROCEDURE abort_master (message : varying [len1] of char); - - BEGIN (* abort_master *) - warn_master (message); - halt; - END; (* abort_master *) - -(* activate_mm fires up the MM package and performs related startup chores. *) - -function activate_mm (is_master : boolean) : rp_replyval; - -var - mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode; - stat : integer; - -begin (* activate_mm *) - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%'; - mm_status := initialized; - mm_init_reply := mm_init; - mail_chan_text := ' '; - stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text); - if (not odd (stat)) or (stat = SS$_NOTRAN) then - mail_chan_text := 'l '; - if rp_isgood (mm_init_reply) then begin - mail_channel := mm_lookup_channel (mail_chan_text); - if mail_channel = nil then mail_channel := mm_local_channel; - end else mail_channel := mm_local_channel; - activate_mm := mm_init_reply; -end; (* activate_mm *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i : integer; - - BEGIN (* init *) - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (activate_mm (false)) THEN - abort_master ('Can''t initialize MM_ routines'); - IF rp_isbad (qu_init) THEN - abort_master ('Can''t initialize QU_ routines'); - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - abort_master ('Can''t open outbound file'); - END; (* init *) - - -procedure return_bad_messages (var bad_address : vstring); - -label - 100; - -var - line : vstring; - bigline : bigvstring; result : rp_bufstruct; - pmdfenvelopefrom : vstring; - temp_line : vstringlptr; - - procedure try_something (rp_error : integer; routine : string); - - begin (* try_something *) - if rp_isbad (rp_error) then begin - mm_wkill; mm_status := initialized; goto 100; - end; - end; (* try_something *) - -begin (* return_bad_messages *) - if mm_status = uninitialized then - try_something (activate_mm (false), 'mm_init'); - mm_status := sending; - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit'); - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (mail_channel^.official_hostname, - line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: Postmaster ', 14); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable mail ', 27); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_cnvtdate (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (qu_rkill, 'qu_rkill'); - try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit'); - while rp_isgood (qu_radr (line)) do begin end; - while rp_isgood (qu_rtxt (bigline)) do - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - mm_status := initialized; - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); -100: -end; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR fromaddr, toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - FOR i := 1 TO fromaddr.length DO - fromaddr.body[i] := upper_case (fromaddr.body[i]); - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name,' ', ier); -(* The parameter with 'IN%', causes bulletin to search for the From line: *) -(* substr (fromaddr.body, 1, fromaddr.length), *) - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages(tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - if done then qu_rend else qu_rkill; - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input BULLETIN_MASTER.PAS_V32 -$deck -%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC' -PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC' - outbound); - -(*******************************************************************) -(* *) -(* Authors: Ned Freed (ned@ymir.claremont.edu) *) -(* Mark London (mrl@nerus.pfc.mit.edu) *) -(* 12/28/90 *) -(* *) -(*******************************************************************) - - CONST - %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC' - - TYPE - %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC' - - string = varying [alfa_size] of char; - - VAR -(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *) - %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC' -(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *) -(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *) - - outbound : text; - fromaddr, filename : vstring; - bull_chan : mm_channel_ptr; - bull_chan_text : ch_chancode; - protocol_name : varying [10] of char; - - %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC' - %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC' - - (* Declare interface routines to BULLETIN *) - - procedure INIT_MESSAGE_ADD ( - in_folder : [class_s] packed array [l1..u1 : integer] of char; - in_from : [class_s] packed array [l2..u2 : integer] of char; - in_descrip : [class_s] packed array [l3..u3 : integer] of char; - var ier : boolean); extern; - - procedure WRITE_MESSAGE_LINE ( - in_line : [class_s] packed array [l1..u1 : integer] of char); extern; - - procedure FINISH_MESSAGE_ADD; extern; - - PROCEDURE warn_master (message : varying [len1] of char); - - BEGIN (* warn_master *) - writeln (os_output_file^); - os_write_datetime (os_output_file^); - writeln (os_output_file^, message); - END; (* warn_master *) - - (* initialize outbound, mm_ and qu_ *) - - PROCEDURE init; - - VAR fnam : vstring; - i, stat : integer; - - BEGIN (* init *) - os_insure_open_output; - os_jacket_access := true; - (* Initialize subroutine packages *) - IF rp_isbad (mm_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize MM_ ', 20, true); - IF rp_isbad (qu_init) THEN - mm_abort_program (os_output_file^, - 'Can''t initialize QU_ ', 20, false); - bull_chan := mm_my_channel (bull_chan_text); - (* Set up the name of the protocol we are servicing/providing *) - stat := $TRNLOG (lognam := 'PMDF_PROTOCOL', - rslbuf := protocol_name.body, - rsllen := protocol_name.length); - IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%'; - fnam.length := 0; - IF NOT os_open_file (outbound, fnam, exclusive_read) THEN - mm_abort_program (os_output_file^, - 'Can''t open outbound file ', 24, false); - END; (* init *) - - PROCEDURE return_bad_messages (var bad_address : vstring); - - LABEL - 100; - - VAR - line, errorsto : vstring; - bigline : bigvstring; result : rp_bufstruct; - header : he_header; - i : integer; - - PROCEDURE try_something (rp_error : integer; routine : string); - - BEGIN (* try_something *) - IF rp_isbad (rp_error) THEN BEGIN - warn_master ('Routine ' + routine + ' failed while returning message.'); - mm_wkill; goto 100; - END; (* if *) - end; (* try_something *) - - BEGIN (* return_bad_messages *) - he_init_header (header); - try_something (mm_sbinit, 'mm_sbinit'); - initstring (line, 'postmaster@ ', 11); - catvstring (line, mm_local_channel^.official_hostname); - try_something (mm_winit (bull_chan_text, line), 'mm_winit'); - try_something (qu_rbtxt, 'qu_rbtxt'); - try_something (he_read_header (header, qu_rtxt), 'he_read_header'); - errorsto.length := 0; - IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO - IF ltext.length <= ALFA_SIZE THEN BEGIN - errorsto.length := ltext.length; - FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i]; - END; (* if *) - IF errorsto.length > 0 THEN BEGIN - try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto), - 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END - ELSE result.rp_val := RP_NO; - IF rp_isbad (result.rp_val) THEN BEGIN - copyvstring (errorsto, fromaddr); - try_something (mm_wadr (mm_local_channel^.official_hostname, - fromaddr), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - END; (* if *) - IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN - initstring (line, - 'postmaster ', 10); - try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - END; (* if *) - try_something (mm_waend, 'mm_waend'); - initstring (line, 'From: PMDF Mail Server '); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'To: ', 4); - catvstring (line, errorsto); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Subject: Undeliverable bulletin ', 31); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Date: ', 6); - os_catdatetime (line); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'The message could not be delivered to: ', 38); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Addressee: ', 11); - catvstring (line, bad_address); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, 'Reason: No such bulletin folder. ', 32); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - initstring (line, '----------------------------------------', 40); - catchar (line, chr (chr_lf)); - catchar (line, chr (chr_lf)); - try_something (mm_wtxt (line), 'mm_wtxt'); - try_something (he_write_header (header, mm_bigwtxt), 'he_write_header'); - line.length := 1; line.body[1] := chr (chr_lf); - try_something (mm_wtxt (line), 'mm_wtxt'); - WHILE rp_isgood (qu_rtxt (bigline)) DO - try_something (mm_bigwtxt (bigline), 'mm_wtxt'); - try_something (mm_wtend, 'mm_wtend'); - try_something (mm_rrply (result), 'mm_rrply'); - try_something (result.rp_val, 'mm_rrply structure return'); - 100: - END; (* return_bad_messages *) - - (* submit messages to BULLETIN *) - - PROCEDURE dosubmit; - - VAR toaddr, tombox, name : vstring; - retval : rp_replyval; - line : bigvstring; - ier, done : boolean; - i : integer; - chan_dummy : mm_channel_ptr; - - BEGIN (* dosubmit *) - WHILE NOT eof (outbound) DO BEGIN - readvstring (outbound, filename, 0); - IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN - done := false; - IF rp_isgood (qu_radr (toaddr)) THEN BEGIN - REPEAT - retval := qu_radr (name); - UNTIL rp_isbad (retval); - chan_dummy := mm_parse_address (toaddr, name, tombox, - TRUE, FALSE, 0, 0); - FOR i := 1 TO tombox.length DO - tombox.body[i] := upper_case (tombox.body[i]); - INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length), - protocol_name, ' ', ier); - IF ier THEN BEGIN - WHILE rp_isgood (qu_rtxt (line)) DO BEGIN - IF line.length > 0 THEN line.length := pred (line.length); - WRITE_MESSAGE_LINE (substr (line.body, 1, line.length)); - END; (* while *) - FINISH_MESSAGE_ADD; - done := true; - END - ELSE BEGIN - warn_master ('Error opening folder ' + - substr (tombox.body, 1, tombox.length)); - return_bad_messages (tombox); - done := true; - END; - END - ELSE warn_master ('Can''t read To: address in file ' + - substr (filename.body, 1, filename.length)); - IF done THEN qu_rend ELSE qu_rkill (true); - END - ELSE warn_master ('Can''t open queue file ' + - substr (filename.body, 1, filename.length)); - END; (* while *) - END; (* dosubmit *) - - BEGIN (* bulletin_master *) - init; - dosubmit; - mm_end (true); - qu_end; - END. (* bulletin_master *) -$eod -$copy/log sys$input MASTER.COM -$deck -$ ! MASTER.COM - Initiate delivery of messages queued on a channel -$ ! -$ ! Modification history and parameter definitions are at the end of this file. -$ ! -$ set noon -$ ! -$ ! Clean up and set up channel name, if on hold just exit -$ ! -$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE") -$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + "," -$ if f$locate("," + channel_name + ",", hold_list) .lt. - - f$length(hold_list) then exit -$ define/process pmdf_channel "''channel_name'" -$ ! -$ ! Save state information, set up environment properly -$ ! -$ save_directory = f$environment("DEFAULT") -$ set default pmdf_root:[queue] -$ save_protection = f$environment("PROTECTION") -$ set protection=(s:rwed,o:rwed,g,w)/default -$ save_privileges = f$setprv("NOSHARE") -$ ! -$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out -$ ! -$ ! Create listing of messages queued on this channel. -$ ! -$ if p3 .eqs. "" then p3 = "1-JAN-1970" -$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + - - F$GETJPI ("", "PID") + ".tmp" -$ define/process outbound 'dirlst_file' -$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' - - pmdf_root:[queue]'channel_name'_*.%%;* -$ ! -$ ! Determine whether or not connection should really be made -$ ! -$ if p2 .nes. "POLL" .and. - - f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1 -$ ! -$ ! Handle various channels specially -$ ! -$ if channel_name .eqs. "l" then goto local_channel -$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel -$ if channel_name .eqs. "directory" then goto dir_channel -$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel -$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel -$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel -$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel -$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel -$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel -$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel -$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel -$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel -$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel -$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel -$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel -$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel -$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel -$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel -$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel -$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel -$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel -$ ! -$ ! This must be a PhoneNet channel (the default); set up and use MASTER -$ ! Read the list of valid connection types for each channel. -$ ! -$ cnt = f$integer("0") -$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat -$ list_loop: -$ read/end=eof_list pmdf_data line -$ ! Ignore comment lines. -$ if (f$extract (0, 1, line) .eqs. "!") then - - goto list_loop -$ line = f$edit (line, "COMPRESS,LOWERCASE") -$ ! Get the channel name from the line read. -$ chan = f$extract (0, f$locate(" ", line), line) -$ if (chan .nes. channel_name) then - -$ goto list_loop -$ ! Get the connection name -$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE") -$ ! If none, then ignore the line -$ if name .eqs. "" then - - goto list_loop -$ ! Found at least one to try. -$ cnt = cnt + 1 -$ @pmdf_root:[exe]all_master.com 'name' -$ define PMDF_DEVICE TT -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table.'channel_name']'name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ ! This check attempts to verify that we are in fact the owner process of -$ ! the device, TT. If the device is sharable, then we ignore the -$ ! owner. -$ ! -$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. - - (f$getdvi("TT","shr") .eqs. "FALSE") then - - goto list_loop -$ ! -$ ! Run master to deliver the mail -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ ! If master does not exit normally, then try a different connection. -$ ! -$ if exit_stat .ne. 1 then goto list_loop -$ eof_list: -$ close pmdf_data -$ ! -$ ! If we found at least one connection type for this channel, then skip -$ ! the attempt to use the conventional mechanism. -$ ! -$ if cnt .gt. 0 then goto out_phonenet -$ ! -$ regular_master: -$ @pmdf_root:[exe]'channel_name'_master.com -$ define PMDF_DEVICE TT -$ ! -$ ! Define logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ ! -$ run pmdf_root:[exe]master -$ exit_stat = $status -$ ! -$ ! Activate optional cleanup script to reset terminal/modem -$ ! -$ if f$search("''channel_name'_cleanup.com") .nes. "" then - - @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat' -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ ! -$ out_phonenet: -$ if P4 .eqs. "POST" then wait 00:00:30 -$ goto out1 -$ ! -$ ! Directory channel -$ ! -$ dir_channel: -$ ! -$ run pmdf_root:[exe]dir_master -$ goto out1 -$ ! -$ ! This is a DECnet channel; set up and use DN_MASTER -$ ! -$ DECnet_channel: -$ ! -$ ! Define other logical names -$ ! -$ node_name = f$edit(channel_name - "dn_", "UPCASE") -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn -$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log -$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log -$ define/user pmdf_node "''node_name'::""PMDF=""" -$ ! -$ run pmdf_root:[exe]dn_master -$ goto out1 -$ ! -$ ! This is a BITNET channel; use BN_MASTER -$ ! -$ BITNET_channel: -$ ! -$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway -$ run pmdf_root:[exe]bn_master -$ goto out1 -$ ! -$ ! This is the BITNET gateway channel; use BN_GATEWAY -$ ! -$ BITNET_gateway: -$ ! -$ run pmdf_root:[exe]bn_gateway -$ goto out1 -$ ! -$ ! This is a BULLETIN channel; use BULLETIN_MASTER -$ ! -$ BULLETIN_channel: -$ ! -$ run pmdf_root:[exe]bulletin_master -$ goto out1 -$ ! -$ ! This is a Tektronix TCP channel; use TCP_MASTER -$ ! -$ TCP_channel: -$ ! -$ run pmdf_root:[exe]tcp_master -$ goto out1 -$ ! -$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER -$ ! -$ CTCP_channel: -$ ! -$ run pmdf_root:[exe]ctcp_master -$ goto out1 -$ ! -$ ! This is a Wollongong TCP channel; use WTCP_MASTER -$ ! -$ WTCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ run pmdf_root:[exe]wtcp_master -$ goto out1 -$ ! -$ ! This is a MultiNet TCP channel; use MTCP_MASTER -$ ! -$ MTCP_channel: -$ ! -$ run pmdf_root:[exe]mtcp_master -$ goto out1 -$ ! -$ ! This is a Excelan TCP channel; use ETCP_MASTER -$ ! -$ ETCP_channel: -$ ! -$ run pmdf_root:[exe]etcp_master -$ goto out1 -$ ! -$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER -$ ! -$ FTCP_channel: -$ ! -$ run pmdf_root:[exe]ftcp_master -$ goto out1 -$ ! -$ CN_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user script pmdf_root:[table]'channel_name'_script. -$ ! following may vary: should point to cnio's group -$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277 -$ ! -$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master -$ goto out1 -$ ! -$ KER_channel: -$ ! -$ ! kermit protocol is slave only. If we get here there has been a mistake. -$ ! however we will just exit and no harm done. -$ goto out1 -$ ! -$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER -$ ! -$ PX25_channel: -$ ! -$ ! Define other logical names -$ ! -$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user option_file pmdf_root:[table]'channel_name'_option. -$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn -$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log -$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log -$ ! -$ run pmdf_root:[exe]PX25_master -$ goto out1 -$ ! -$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER -$ ! -$ UUCP_channel: -$ ! -$ ! Define other logical names -$ ! -$ uucp_to_host = channel_name - "uucp_" -$ define/user uucp_to_host "''uucp_to_host'" -$ define/user uucp_current_message - - pmdf_root:[log]'channel_name'_master_curmsg.tmp -$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile -$ ! -$ run pmdf_root:[exe]UUCP_master -$ uupoll = "$shell$:[usr.lib.uucp]uupoll" -$ uupoll 'uucp_to_host' -$ goto out1 -$ ! -$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER -$ ! -$ XSMTP_channel: -$ ! -$ run pmdf_root:[exe]xsmtp_master -$ goto out1 -$ ! -$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER -$ ! -$ DSMTP_channel: -$ ! -$ run pmdf_root:[exe]dsmtp_master -$ goto out1 -$ ! -$ ! Handle delivery on the local channel, MAIL_ channels, and -$ ! the DECnet compatibility channel -$ ! -$ MAIL_channel: -$ local_channel: -$ DECnet_compatibility_channel: -$ open/read queue_file 'dirlst_file' -$ local_loop: -$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process -$ priv_list = f$setprv("SYSPRV, DETACH") -$ mail/protocol=pmdf_mailshr 'file_to_process' -$ priv_list = f$setprv(priv_list) -$ goto local_loop -$ ! -$ exit_local_loop: -$ close queue_file -$ goto out1 -$ ! -$ ! This is a SMTP test channel, use TEST_SMTP_MASTER -$ ! -$ TEST_channel: -$ ! -$ ! Typically some form of redirection is needed here... -$ deassign sys$input -$ run pmdf_root:[exe]test_smtp_master -$ goto out1 -$ ! -$ out1: -$ delete 'dirlst_file';* -$ ! -$ ! Common exit point - clean up things first -$ ! -$ out: -$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound -$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel -$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data -$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore -$ deallocate TT -$ deassign TT -$ deassign PMDF_DEVICE -$ restore: -$ ! -$ ! Restore saved stuff -$ ! -$ set protection=('save_protection')/default -$ set default 'save_directory' -$ set process/priv=('save_privileges') -$ ! -$ exit -$ ! -$ ! Modification history: -$ ! -$ ! This version by Ned Freed, 20-Jul-1986 -$ ! -$ ! Modified by Gregg Wonderly to allow multiple connections for each channel -$ ! 10-Oct-1986. -$ ! Some additions by Ned Freed 30-Oct-86. -$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987 -$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987 -$ ! Added directory save/restore /Ned Freed 1-Jun-1987 -$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987 -$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987 -$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87 -$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87 -$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988 -$ ! Added a variant of Randy McGee's code to put a list of channels on hold -$ ! /Ned Freed 9-Feb-1988 -$ ! Made this procedure save and restore a little more state information -$ ! than it used to, including default protection and privileges. Also -$ ! moved a bunch of the logical name assignments around to eliminate -$ ! redundant code all over the place. /Ned Freed 10-Feb-1988 -$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988 -$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988 -$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988 -$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over -$ ! DECnet channels. /Ned Freed 26-May-1988 -$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988 -$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988 -$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988 -$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988 -$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988 -$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT -$ ! file when aborting. /Ned Freed 13-Dec-1988 -$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to -$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988 -$ ! -$ ! Parameters: -$ ! -$ ! P1 - Name of the channel whose messages are to be delivered. -$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection -$ ! unconditionally, otherwise only establish the connection if -$ ! messages are waiting in the queue. -$ ! P3 - Earliest possible date/time for message(s). Messages older than -$ ! this time are not processed. -$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the -$ ! POST.COM procedure or some other procedure that invokes MASTER -$ ! more than once. This parameter is used to insert delays before -$ ! returning if hardware needs time to reset. -$ ! P5 - Parameter reserved for channel-specific uses. -$eod -$copy/log sys$input PMDF.TXT -$deck -This describes the procedure necessary to use BULLETIN with PMDF. You must -be using at least PMDF V3.1. If using V3.2 you will instead have to use -BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but -there is a small bug in it. If you are using V4.0 or later, use the command -procedure PMDF_ROOT:[SRC]PMDF_BULLETIN.COM and ignore the files that are -distributed with BULLETIN. - -BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN -channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use -the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as -follows. This might result in undefined reference errors. You can ignore them, -as these are routines that are used for connecting to USENET NEWS, and are not -used by the BULLETIN_MASTER executable. - -For V3.1: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, - - PMDF_ROOT:[EXE]VAXC/OPT - -For V3.2: - - LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER - - BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, - - [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT - -If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check your -MASTER.COM, as the latest version of PMDF contains the code necessary to check -for bulletin mail. However, it will not necessary have the latest copy of -BULLETIN_MASTER.PAS. - -You then need a channel definition like the following in your configuration -file PMDF.CNF: - - bull_local single logging - BULLETIN-DAEMON - -And a rewrite rule of the form: - - BULLETIN $U%BULLETIN@BULLETIN-DAEMON - -Then you put an alias in your ALIASES. file for each mailing list you want to -process this way. I have the following: - - info-vax: info-vax@bulletin - tex-hax: tex-hax@bulletin - xmailer-list: xmailer@bulletin - mail-l: mail-l@bulletin - jnet-l: jnet-l@bulletin - policy-l: policy-l@bulletin - future-l: future-l@bulletin - mon-l: mon-l@bulletin - ug-l: ug-l@bulletin - -Then mail sent to info-vax@localhost will be routed to a folder called -info-vax. In general, an alias of the form - - a : b@bulletin - -will route mail sent to a@localhost to folder b in BULLETIN. - -NOTE: If you have BBOARD set for a folder that you convert to be delivered -directly to PMDF, remember to do a SET NOBBOARD for that folders (unless -using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After -doing so, restart BULLCP using BULLETIN/START. -$eod diff --git a/decus/vmslt98b/bulletin/restart.com b/decus/vmslt98b/bulletin/restart.com deleted file mode 100644 index 502bfa8..0000000 --- a/decus/vmslt98b/bulletin/restart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEM -$ BULL/START diff --git a/decus/vmslt98b/bulletin/setuser.mar b/decus/vmslt98b/bulletin/setuser.mar deleted file mode 100644 index 153cb7b..0000000 --- a/decus/vmslt98b/bulletin/setuser.mar +++ /dev/null @@ -1,125 +0,0 @@ - .Title SETUSER -; -; Program Setuser -; -; This program will change the username and UIC of the running process -; -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ - $PCBDEF ;define PCB offsets - $JIBDEF ;define JIB offsets - $UAFDEF ;define user authorization file offsets -INFAB: $FAB FAC=GET - ;only gets on input file - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffix - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this file - ROP=NLK - ;don't lock read records - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of buffer -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in username -PROMPTD:.ASCID /Username: / ;prompt string -COMMLDS:.WORD 0 ;space for number of bytes typed in -FAODESC:.LONG 80 - .LONG FAOBUF -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1 - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/ -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12 -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME) -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND IT - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear error - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear error - $GET RAB=INRAB ;read a record - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok? - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2) - CLRL ITEND(R2) - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format string - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group number - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytes - P5=#OLDUSER,- ;address of old username - P6=UAF$L_UIC+2(R7),- ;UIC, group number - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command - BLBC R0,ERROR ;low bit clear error -EXIT: - $CLOSE FAB=INFAB - ;close file - ERR=ERROR -ERROR: $EXIT_S R0 ;exit with error if any - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PID - MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status - RET ;end of exec mode code - .END START ;end of program diff --git a/decus/vmslt98b/bulletin/update.fil b/decus/vmslt98b/bulletin/update.fil deleted file mode 100644 index ec06ffd..0000000 --- a/decus/vmslt98b/bulletin/update.fil +++ /dev/null @@ -1,11 +0,0 @@ -$ if p1 .nes. "" then FS 'P1' -$ COPY 'FM' [MRL.BULLETIN.SEND]/LOG -$ COPY 'FM' CMODA::IR:[BULLETIN]/LOG -$ TAB2SP 'FM' -$ RENAME 'FM' [MRL.NET] -$ PUR [MRL.BULLETIN.SEND]'FM' -$ PUR [MRL.NET]'FM' -$ IF FM .EQS. "CHMAIL.MAI" THEN P3 = "AAAREADME." -$ IF P2 .EQS. "" THEN COPY 'FM' [ANONYMOUS.BULLETIN]'P3' -$ IF P3 .EQS. "" THEN PUR [ANONYMOUS.BULLETIN]'FM' -$ IF P3 .NES. "" THEN PUR [ANONYMOUS.BULLETIN]'p3' diff --git a/decus/vmslt98b/bulletin/upgrade.com b/decus/vmslt98b/bulletin/upgrade.com deleted file mode 100644 index a2d77c4..0000000 --- a/decus/vmslt98b/bulletin/upgrade.com +++ /dev/null @@ -1,53 +0,0 @@ -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should run -$! the following procedure. -$! -$! This is a sample upgrade procedure. You will have to modify references -$! to the directory where the new executables are stored, which are marked -$! with ***. You will also have to change the references to the procedures -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure -$! with a parameter (i.e. @UPGRADE LINK), it will call those linking -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace the -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient. -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remote -$! folders, you can run restart.com immediately after upgrade.com rather -$! than waiting to install the new version on all nodes. Otherwise, you -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALL -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE") -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;* -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE") -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;* -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE" -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! *** -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE diff --git a/decus/vmslt98b/bulletin/writemsg.txt b/decus/vmslt98b/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vmslt98b/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C -- GitLab

R;itWqS_GUkvxzd{jG(QK59Z<|RH2ii~V)&-( z_Sh!V{eIXh8wObhLCBF9zqSP(mu;3kUKY?F_^)75zIN%HrEIF;Gj(_wZr%xdwWE38 z+AD>iQ(MFtHg@x{TfMmLH5WAN1KQp7bB*%H0t;}S=VjQ~y(do9qQKwaW7Sk1u$Ur) zpo3c6`lje7U$qn_oOm5tRPZh>&>a+c6R)rS13H^mn~Nba=2a-z z707ECC7#SCqetpc5R!!Xf)LW$Co1GWc`fXV=7(EWKlCv-t&QA=`3NJS(s!^6i6 zDz^MZ1)w6N6mrMYH0d1&8WzZd&PcO(0vdl12c1gN+$r&e*;8GO)8W$RUrHb&a=_yi z$}I*h3QKJ-UatahuMd>>xfv#=fKKp9 zxb*fJsPw~qh6g{SZM80wxkA^cgHZ~k8gzaKxIFfosx^1MfH7o@nv>yYK*EGA-O5~& z;1Oh2(9Um1(5bqW;8URfG)brmGb9QWsPbN(`s_96;Hmki{5xhUg7%g|`xxIqb9CU_ zgLM;oQ$;+``CiilMg~=o4$y8S!s|P*w=9TlCxFT^+SKycTO5L* z+BKnX!vW!hH-^i8_|=y+GJxWS7Ht9^NUOoXX&NZGfqY6@D`5*O0|WlH0;t^rnF-40 zUvTsbv&pg+1?X--XshEFqg1dHxbB9!=3FeFd&vwfkZVBYIw%h^e`kqwIwJxu*Wo2E zs47*0oTMkUO#5v4Pfo+*H+{JBC+aIci_~#|hh?5uuWQ?3u2PRDpacvlD=vX{u<>{p9Gfn%`O4})M_<@_cUbZ{IOMpT zvl0dEg1(b7TcB8`p`k+AYSQW6q%T50g_88#KzqC4wgXV}HCOhPT0yHVDJoRkHb-DH7 zoP73*&o}~&Kx1xOSs6fe5x6zEG)~n5bW-^_xJc`|(sEGIco=SrIK-DATbQ-kk6e4< z^U&VsBxr9wKLf;V44_b97drPBG*bid)ela?3XMkR2KnYIt6A7*lXuut;y5o%cS{HrU-pc@LHv+~_J z5;<5I9{%qr6ar;tKpuNiAC0*0xmLF3Dod5!!*JRO| zp?c)bc~%C70D15dJ#L1FpIIfU%NxLHng_DyAztvOP*R$LI0Gk-$25WBo>HU7r;df{ z$2V*&2PX#5+y`jiW)XPS?F8Hm(C{;~Em#E_nd9+LJ8%PZz@GqUjB%Ru4w=M8b%+Qb z11A&z8PU1xKuv=7e+Q&N?LB6_J}|fL|4eSjU}>4%~BksC>*-50omOad6u(9=j)- zAkVNJwEy?*GX>B{WQ&0bs3c;(5vOXwrpf`$&&_JE5>5z`M*@Skvr$tIZ*Zyg86;J zUat@343A6x-jxI8Jy;055Lv`^*74ZNes2{9P^)=LuG1O8MJ%A2;}f;2-?KpFpRBh%s$BUTXr!>ktDDTk$g+#Ig%>0FI_V1acwIDGhMi z2y=Krb8v}L>4KtA2}AP4_b-VIe$Jx z*~=W4=#~?7S;M2_#rS z4wTO}DKPA0Wnci=Fj?|UPN0eS;#LU9`{srC%^x;#F?7l^Z<4fXaI1(EVbDx+P)j(d zqxekX^-1BM4L7{O=W}byZ9Kp~;hb$`yNs*0ztb7RYbRAW88qdhWpX~2S4S|gGH5Ct zbIoB8VnC>z4=NC6wKBogg~o%`wHTx@a5HEw;*~uh3+aJDa?c?K0g&zBL^j38PJlmV zxe};dCeqI=c19?vZ{s|hiToY5n?4jhfAV61$MfJNyK3baH0A2cp=0(d1!dV@Cm5(d z_uOsZv%hVjUSPT~gQnaH?QPZ;2?t$V+8Gz6e2V$1!k`3o<$|d_d@>gk8y>hMfqVqY?@FM& zSqiHhnrG_j`RKWEa~d9xP&b~oY2lW%hpCDp44v{IQ?E_(z6MJ9$#c^zQ@J=9I_1Hk zd$k^%f9n7G_11;%Uz&S*NVHYa{gFqV#Xm1x2KPay* zn=EnLLj-Owhlh z;>%k?*F4Hz@PkH@g`hJHb9OGeyj6A0#5Wh@L4C(W6{NnU4hw(7fgdiGuXSUW*exr1 zDzDnmQhHS@VTwAa!iqTj5cEc@rI1<`9_7+sICpGewa0qUm8{yI7%8+?lbs}K`I zMk6J?OYD6+P;Ur(KaMs%Ov*-#G5cfu(Dici!u?_|4=FM1W@TUq0pC+t&w$!51J6X+ zbh-4u4>jV1jE)`tqU8>1MS;iC*xzw3yRte3w1)~>0w1t-1T~LABaezmZSl} z#Oh4Pbve*ztgJAoq$gv{3fx}8I$8yurJQBfaQ#q=!~#Wd8l447hoBiW1ODXeuhVv~ zy)qHB4>q1b95(8lncZug8JnU!#Wy0bTOT}%6VCwJowrMpxv7rFyFd8xgvAnjnN(s0 z7B38zIVLE;sDGK2A>AXj1T(L<77I4>ZRo=%5z)fc*l8ezYuT zjN9<0jM^@R^Gx>O>vo%6cWr1h{FpIO?+SPXl;=c^)}AxjGPfD+m0hN<5Lw~6Ll(4$ ztq(GztYNz7aDr@4;k+%}hreV?yb>x^U{C|e^T{*pVP#+t6g2w9KcPbG2V<7$qQec0 zyi+F&@A=TU)H{SnoD-x&UkwyjyFPbcRE3_CUuhWi335%rOk*o8_4cVfO#3)qR)Wgp zly$*>vq7__dkXs*7WY|8ZuE{_)YP^1#=;fKVhj)E)w%yLfXCm8Gv?%Nk9zjNysQ9H zYkz^ZG{hJlK86j#rSbJ%ej9dL=Fc%cHAu??be0tCrZ~`EnQ77$AS0zftvw~s$Zdb3 zB&)SR6VJv?ihIr+pQ+>K$f_q%dgo+EEEf;sF=b_jhst6<81E=}Jo%we({#z|pc;M9h$QIl!-6l>Dq9%?dy5zFFLJbX6JOcCQl`iM z3V5bR0-BPI5A8dasLIxJVQOrOGLLwmnJH-e1vI;IBcOq~BzXqXN$AWBg-W2=ViktH zp!GlC(J4?m1Yzji#d+Xnc4K&_>yx-wp++E=U>m0+Weg5;g)uj5^h)gTY8mi+kpM&l zIcKLFe5D*T*k0ND*)HwgkySHKFMqBG+U*K% z8G(8}hgYqQtPeNsy*$tA$ANa8;7){^9UOm0SO{Jj27sAfrK(2(y}d zg5{?dtqectsPsK({UrUVi`_u=-oxZ>=7c%x_TLs3V|d8iaR)SD%;55FX`Jd0>xRNz z|MK`DDbovd%OPZCoZag0szv%=wIl^WIcM3G)d_1ROA1K4p9QsLdBEcU2G>qrQDknA z5CQGZEaf>drAoA?)QCALc`vBu7lo)vTbNgJV$JoCQ%mDmlf_=KF$jX%yVWZ}9g-7! zuYhJZ*g>o2atb#bz5kX|7|kr^hL|2c24RMOcaHQki_HmIFEoGKvxF~cT>9Lg9#f1w z!#-99hF75m*A_dc?fsIqH0D*PLE6GR&`1*}!$cH&)ZzAo)lZce5@m1Z>$M zX&ZcAr8Gn3&Kc*{gM#bSVN*V@Cgz9A8`Td_g50Vs3CgJuFDHM^bBP043#V>)P!aRk`dQ?fGPsi6ulIZ%BBag73K9d?J~`q@qL zwxBTX^?%=cHz z=TAW%XJ?vk%sMyssx|nIKNZkG*N!Wz6PUnJEgzP9R{q?igA5=uKXbA z)qRU+HG?j%lsT6BB5Yc)nX3N-_Z4-q%?p2cD1cVysW5W;tqkvczv5ZM-tq%YprYaO zwU{taSpkb(Xwb-B{nNM$;@hq@4i?+P?GUl1glcE`*@G`;9L?Z+{Gy>-;a8uMe(-`i zWzY^LsBQky#RgUE5cidzZPh@eR;XQjv;R5VtvP?STj6YD<|dAeQ+pLIr#L>hMcAl< zVq@G_(79?R?S)^JJc<)$=}dZ1>A37!jF`wzm+yIWFO4;UYvDtz)vLzJQi(=FFe402GH{Lpy{F4pP|tL6u-Z`$aW z1{qEV&Hkx?im16~8g3lAmNNGhO!np`zoW7Y|L(wLFCokB&EDh(x>FNLK4SeztEu2o zaF}@(S)2SySB4*qP&ZaEW7q*&^_B=J?`A^6iW^cpfQt~&Ua9$@`RVRtbE$UGBZ&?1 zcXfosB$!2(H%SF(vv@k}_ON3Bl}(`gSAOU`bqp0D+|(IBtsJ=gQe^qH<-U4u>Y$yOaQTgKle;f!g6A9HVue?p zB$Z4Dm-mlPu`wuv=BH77#KT~@$E%=VW%xnQDhcpO{G1GxJKK&LnDol=F(@!3@_2l& z76lJ17)QsG8(M*GxBTD@QqpV(bbpD`mlL2{BO1 zsB!_HCGWxIEDA3xYXyHYd#am(XR1Ic08~4H2EJRbS!i(bwe%mE$Kx$@K~Ja>v~QH> z1W1eLn#q!@%auPpVoepTlz(KP`2sS4l?*!f5M=#HNDal$kSNmtno;L- zxb%5al+hVby#VbiF@U|OsIU=y3lt=jL>L4e@<3zlN-~S}4eu~|p3m0Wqa(qv^4Lbn zU(cSM@SiJnRsVD(Xl+=2UZ1$VIH->S?z2B|_XiJ`@4q-xYhp|%=v3xAkXa-Tu=o{F&m;TiEqX2*7SpGr_>6CM#oguLb%F5HTkp7>*9Kjs0-8Zqg!S@gFf#f^vgNbR zFVzWUpSPE1(Kn|L3?8b6s>-1GXQVZS3Jfn!nJK1yQ+Im7_*Us4SE6>O?S+`IFxgXf zulMjYu``IMF}yf+?Z_V&hBZgdPMkiGWlJ}Uc1y0y#<|H1DUc&m_Fb$Fa0bm_A4IH( zQ(<`FW%pb7U|Ew5hu{2CG3{`NiK2%rZOmK`b&B~JufrSse2$loLC`_S)^VDEF)w&Yx&*_@!kqL)&m99cu6@VV!sK>P`GCXwn(vYF z9H8DKquSj(KW>IZCG}%d?tnO;dwM}L9jXk6Ss56R_lSXRG%^wfpRlIH#gGV^+AV7L zNl`@A4NggiK=IE3x{=dh-{twrpgDSF20@2ImWIowbR$oGc0GG?<6OF|x96LS8w7VV zLT>9qntNTV(6Q$H%*oX=XE84N7OrZ@I{)iVP@9DXR4?&MLi5-Uoz#OzTnwW;IxLS_ z%`8k+{sdYrng|;}V@~S609tutrX?8sA#!;^gBIu%C1Fd$Wl#7(?z8M!%p73+drh;9 zLRg=YP_;?Ukvz~o_hg5vDNM6O_HSCgNG$M9=*d)Qg3Gu(o?=K7| zwB|1dO~qPzt?HDN0If=X$Iz>(x=8(o>;gm8v*(XY)xCY_w3H}A=Vks2GlG<=n(i`6 z1z)OJkXLfz<`K|XI{H1n;CV;zXhsJI1L&r1cssfcv~!@)2~sLRLKw7nfQ#Yc9Eso} z@bnRA916KqWo9U6C}$90U|7q*z{tSBkYW&ci0{x;1``IW7u?Uye_I7bukoHItR%Hq zvign1-?yK_y`D9Qi7*@io&PrPcIk{MTYEyQIf{41u6_~_>7)>2xj`r_60&Bmroz8m!_{W>yw z(%x)*{AK&;c+Hv2Q9Dj3GuSg!pZssqaXd#WO)$!E*2d#~m+$MaDSP-Y#QWr<7`L~w^nmV+3t1>7s{JWpSFyZNIHQ6&6*LNo7 zH9nPscqVdaeNj$2>U(2LE@=jcLOE-K zFW7sr$F^+Fzp|g&s>Kf6;*}B%2VQGL_*%`lxUTr{JtoWJFU!^nHC-0$SS1MxH}|^f zHtH@WZpPnk6#lyXbp4bwjJkI~s}j}06BBjNKuBc}289%7Z0SaY!;*>p*CloDZw% z(Hy~V6>~2hdYks-2LmI+dIn{NTW_>mr=I#46Vdy3xnoW4L)VPyp=%FG-#hK{`0MuH zfAlIlLFM#)1{H>*yPmw&iS6x?V0s<4;-s$1(F<*kC6cFk&a=gJy=DJ$<=|lp9VG^a zZ#>P4g1c96v0OJTZ_Ct8CboyfvP4Q6W*yP|W_nV|RAgc(=OOoe)b6tp)?=&(w~B%MVk zwCX{J+*m3uLQR28$_!Er8&!^cbod;6QA1pU$zct{;mP2mO0?=HD~L0!JaSG)>M4`+ zrVsXeK3sUs68kec$W>zvg8;+IZvhk4nZzZ84sX`jbm}>i2*XB|C4Vfrtxj+m*tl-~ zV82J;DZi>D!$x2IT?;^_f{zwAkzY0^@NvkwL$g&F=JIyiuQO{L8jL;W&TMDkVfgp||Nr(bMLyp* zi$M34Z6xe$EmGNO!P^qfH;E@$NZCRU=S8JXC!!cF{ zhTIDW**jvj{!4Tm7Z85x_hRGBLr1+2HzkQVzDPXqMU$c0lJya5iILSj1%@?qL?ul` zChE8ae&}9uM@wK$`{G2^SC**_YTZ6|iVUg@3}&U>b6i*dd0c+ddqvR4<&y$@OSu=c zcCEdmt+)O53W@D$MA7d7w9Iy`wVKJ__`~TartnAl=>5fjYXn1 zH7bs*g1%>G+TB-kk|FLLy1UF7I35nu$R4mAdkRhiKhg11t` zSWZtfGc~(X&mT~EBH_V>BYLYgNcc~0X4be-SD>!RP&{k3!Ai45{}?`2oy==XU;7|Z z#PRQUhN;}AB|eJ!6fG*;bClaxap_D@3SN4m^H&qI#uner%UMjya!W*cS8ra+xxH0< zVXTo2x2Ux1nv4d)^q(_S7`8KTZObgX+b$#~s^YkGjgMI4c9gseQWp%~L$izO6R0Ssg7jb5Vu5d0BJ3c2yQX1H(JV+{lw3#q>>Dr=&?4 zGJwu|&|r98b}KtxWZK8ZjcY<~9O}NHx3}lMYQAkx6UU;tzo!-_O#}xmuYxjzRE1fJ zLBQ8Vp$o*m8*y`fGP+pO>7Y?Bti^eC%EL&JmtnP045|#Vo-#^K{TGa9L~aS_&*av3 z+I{9yFaH@{EB9+joYDIaSBK|xg3iNUv53*l=gql@Epl!Pb@y<*T~sx5#q3YpRk}5d z*!WtGFWZo1$DqV;X@QtJr`ALrt_98gT-{8s4lVq;^47!ZnFl6pinyqiAhM}OmEpS~ z7sJIH>%QF*jw)Hj6(jG)7<546(B!*1TkYN*6I5an=Y1up$DqNm`DphAy}%<~Y!dDz z@*A&uD}G(_SgS~>#ZB5__nv;slL@9Llk%M>*r+h9h`3lKaSId})sp+Y?`^vBgJGq~ zMiz*FS2wluA3flx&LF_Xte=y0sZ>x@O!jI=?4}UiY!Qv;Q$r?fs8KP9V0H6j5zWy0 zpw6JiuwoJ8v5AXV7k}VqJ5jXu5Q|i4qA0I+;8gL9R9EJn88_w{iU#z5P+@pw;KOv~ zj$K`dh1r{lE}9DY6BjUvA3boUE8(Wl?6%O$D&2uHstnu3HFd&F4n)*V-}BXLbwkBX zF3}aCXJi>pfX;tev0;U-?Ft7)E-xYHFQ8V{D+3-oZEe@!f0_bov{tyjxuhL>#69AH zd0C7O1LT}>aM>ygO*Y#ib~=e{eZ<+%GC!(&+I`i2Q-=~+h|2=bY;b9=>H$U8rPDuR zKTTV@CZnM+r>oX?lg25RLIo8DhGz^FEe-x_7k%9QWFwnF`=llhp2-U`Jy&!mAC~i+ z!t_bZQb8W!%U!G&x_nlu@Chz-f5FvaSg>pXlW8F6T(9>GY7DpDbU%y~k^Jr7ydo@g z;qpIgbJ#k?79{k}D-+uO;mpDlc!{xrGzWk{1mg?12XqMi1%QXZqXhFE(Xi@CqHqOoZ05e$H`zA7Q0k{ z;Up^q!{1fgPB=1fG5iY`<+>QuzU_n}sGd+}NO1CfEIF@tQI3xMN2g7jGR|hlGU=>V zS+-=+&sZUg`$~;MAq;8^M|Y|0$m(X{>ONw?8BqNDN8mI^XTj!~$Jo)K&AH8cm`#L6>&xC?})$rJA2Xn_>6$eXqi{o(cW%;Uibco5{Db<5jw?-mkt< zC=!eH75 zaaEITtM`7JdZWIV<^9|!p_dP zTGFJ1Q&95EmJjwJfolb97@FGj6c;fa-0kYgnc&x|zz52`P3|l9e!VA?cxT~BPzj>L zV3o1?14mYjqV~@zC6ko|xw3C9XKzT|aUwnU@0HNdm6tr3Zn-KM{o@MQ7$~E~utF(f z+mU5zb2a~@&o2$w==tP5Gn18ssq-79mZJ-nrG1M$J|p|$1?>{8twx}>_(A29d$SkM z4PTIaL6q$yQ+K2P+C5CN%}fjVE_Jl1Ht^YL`4-3ym zg8;<=aH5kfYC@<1qeW>Px0{6L_xwAhCiEzZl zd8}(@h_356V!$c4uuSUyg?k`BgKnKZ%?i3R5F8gX{&9qT`s7q3%W~tBvr3!i1(Dl< z3;!ga*$QgJt{3S&V!)}zpvmxk?ZYK3FPL|!Ca-J#|FE@vk>-DidRCFhr~GUk>6>O` zJP3dA=Gwh`%-ReZ3|nVrBuFqXy%^!hBG}_3%e;1zeFOKz?-v#tT<~iBw466<`A6Qj zZ!dt;x)vlwa4cLm`CiGJNmCUb%<|f}B&N*x*{alDrl%qtAGDPYyT+-%IMxxW$Pml^ zUQ+Pocvq7E59{YTigCE`8gt#j|2jTXW&v zDr*z)PB2J1;i&+n6Oj4JPD&<;jI#CzrYMx%-P_~nEXcyo0IBay+<3IEa0}QlIF&9} zQDo2p#Z8jbv8TJv-e@cI%b94YeAMf9a9*Bl@mOZX0Y@J+!B$fP~7EF>+{skI73uUO_pJWlS8m!hDOr^#)Qxh z9~Mf?SeED$aQNtt)^BAQpx)tn2573d92K!AdI~6Nr+jLr!^*Q;nGSE(;A2o@h>dpVXr3AN zUVcju3i!<92nn$;jFvvH!w7K3~vCiYfy~P{M=O7fN3Z zr~W>(AXNNF*Z$}Zmj{b9)hB5(+P#r%Vs}_0V#}bzaOr?XKt#aDi>wl|Wpb0T| z0*9{%!&z1ah6t5U-x(S2c12z@Z~eb!(hMc7G{G9LU7n6t;@EgyMamQybQlDV2|0dw zRdemJQGZ%8T9`p4ryM;2bThaFvHeTE(zAIU_}F#MJ6JTXC2((d>CAo zXfkLljcdxD^M%LZsd01Iv6!biHfBf57X3Wq^9XbbLjL+ChZb%7a)t4LF@rKg?81h? zgfm<70*WhI4*Gy@uL)xpNM3ieOP^=yLW%tn^9kw<&lz9$>^v1&k<<0|#@QL% zb%Jf(E|1@AJ6qAYLSOT(;IHau{!3Uodw~Tn z!wRJ*?+*t`b$#qEY<~tG8`6f9mtOoA{(b9_5)aIAXJz4UkSNxa7HsSO;=W}&OQ(pK z=&=JcgAQouGpI9MI-|6rfy*Q;$nnspi3b)e>@XD95@k5Y%D}KKBcM@@>G}6I9>Zr+ z@)D1A;xwf=PrFaLa$e&8W`lPZWI(A|2b7vY z`9Cl^{e$)f2^Ri_7Wbb9ToX0~EV-dnGDU8|-?xHhUyYA_*Xgk~0i_0TDG1iF{+b~3 zvi(vg^h0^Gn;<<^lp8TGH=T1ytxL(HhY6i zL`pdMw{q$WpIycBP<7>e!+n;9?=D1u$}crYC`M&@MVyf+JIZ@wigUu7^Yc|!v|N%t zaJ+AE-LW6fj)2p&J%bd;uZ#F!Oq+9eo20&Dppb5N4t zOjZh{UJ+y-lXmLNP1CuTY+LR-;p-&p zO8-U&Z`nn4#~@h=yfOz`GiJ@6|iB@S*av)C_(MV6)vY0 zuR~NAVwoHobnR7iIOG_nIXX||lCzt?4Sb%!`CBc&Bp*j5-dXq)8N~v1LLEmF$o?a4eGl2x1vNL%2EB6HD!7k)r)L0m41L6O0jS87+wgVYJeJ!_`FH1Snra!yix z!lNv_D6=QO&)^;SWN&*0T~NF(iocr`^6DtK1=ix)t7_=eq~6@7v~`V+&Xy}8AKvD0 zTr@fMU9tyUlhrfmLee2Pj<4_toEJ~h$}C&y>Q&9cv13_Klwo&*P3(%Ww(d2c5j_@d z24RM$a?uZN?-ViU5&+pgRiZqj4BR&d#jBQ!4LC+s!7h1k_~ww&?kl(0?nb^03=x=i zw5vbE&d1XE1A_>|1y;RxC;yC3sPrfg^ zvM}#Q@T_AymKC-iL&^ainq>_Rkj7cr;xB9;HeUMXF6wqJVVT{6XrpIAW=e;Q+}0?m zFbI5LfV6ZsL>&#%QaB#CTFX}Wo2=vZ6xIFaO8=jEGz!=%GN^B4X1R69`$O9+=3S~G zH4^^eD|y6cCb4r&y<~Ds_A#F?_|#Q+ysUWwDjzd6f{Yz(;yW@*8fLkK_kHjd(luq> zv-DW)_6Z`+(q*92K`)(AlJFN_HT9v=?CO21G<=iq7{0rZ0cvGvfWw0$YmSP#xZ}>- z|5iBFvGKa9sEa4Mp17YrUvf*8Bny8-iTuX5;tWTvUVCrd4j$kDMX}dqa6KdjZsTi0 z&52QLZc~~xxx3-zdbUs8UnMx?7#xoZw5yc`igLV`ek#IzP>Vql)RSq*PhZS2r%=n_ zg7yBc!*NM9#Vv*HYz&MHq6`;V85s1TwRMjjs8rHpc+SIedfG?LmujiCZLR67P2Y+= zCoNZAeD`#Nyu+~;@4jq?-`Ct39CmJ(JrZXi2t|cZShq;ca$EZm%s4^@+Fu|->&}izD;7h(;+Z?MiS35WyOA1xIX)o8N!KP-x zEZjO1v>s_agC;noD?M)D?v}dhuB)BFExMVbZu%ZkF;Rvm4i`VGfd|cXbUsvrN+aW5 ze@}DGR|@>`hTRF~$?LxM7Iif$96GQ-!0dW{JwNF52N_6+yIisW zbyzDa9aT6Mu50$>WMJI(=LL9uh6-3kM_omLLWhN!+Iz9iB`gYJEA^-Gq&4}k%~+}V z;P%Z4V3k^s@a5=eo?Gpp4sZ0mCf+}2oMkiKYHr%6NSC{W48zdW|%3wUL zRbHS#Z_5=C3ufU|C(gAUN*}r_mZpn>#=L`MD+HPjy~t+}VK{0v^;QUb)0!_DS{$dF z+Rq;-AyDujp3`xFlS+2yC3OqU%soRf{r%Iw+@Y$a?n4 z@nqgzrVO<$XL@(;&Iss#&U27iL5Tl3tf4psG{S3^xRj}h-JxfHlVQ0y?;o!j3;C9Q9yF&6xvO)zz#NBqGX&Dc~ z5AoQ>GcvG(>}~*^$Pe#lcV5tOQ7T|F?iJ+L2J4uiuG($2}Ifim6AP zR?=a3Uc%TX%hjXb+8#2YXTGvRviC*R!<&zFC`w(qawed^@c|=4;63+-6@O2nFJ_jUyJazu2#Fe zDkvQZfl_Hw@%ibSK|@fQ0vRiv6+!x?!Qz1qzCj_U>{*+pi%$|_V9NQa2o|M6|iAQG6|1kHRxdf6%9&=CgNp41#PDPyH(@{vQUES$QUKrvs>z|K&7`JCmx z*RU`Gk7I!AP>K4~_0ud(SMiI!TB`cF{Q={I4FN7UI~Lqo8N#5>@HFVJp`^=SVSx|Y z8zyljKk(5^5J|betRXOrp+Jq9_3XN4S>Gw7s&eO{u>#!NK21+qpVP#-g5tcadgNvfLD3=5)8}CvjHHMCMZqR*G z>nw`QruA2Ja?~v2UI?0q4be!LvP9-afQ!nf?~SY)49oSlrX4d#tl#6!#_OtOuwp|- z#c>YP=PJzy6P77(UDeWw70~{tSEaztuwrA)5$~21aL+{*lw0P6FGx<<`^4{_@U)G~ zqr(N}Z|JeTyQ}F(1*_GuQm(+(GoXgA=kJCFzus4i`Q*0-nW?Uy_E70u-d>+)C)o-X zf_CaXXAN5$wUvVbZM>6p-tw^A&u(Ca)pa~13`q+|L*}em(l5}oC~%#F1arC< z6|LCZ=q$YZiYk{M8?WoJKdKux3CXnmms?O2vcK+h8z>FEX8@1bEO>Rx#O(yQt?_tu z>bhr#esi^WrW?)UWt`TvDuQdO6c>2DQl8IAo|oXjyGBbfjmCR z4;(6TPEDK=m-gH7l-b$PIN_UTgSM^-Trg*Y&2pX#JPMi&#%I&h^qKc7{kpQ(F+x)( zODAN(wbLsU5`TK=>$)ffpUb=5GyOo&3ZA(Pnhf8!ioV*E%0GPuCCIp>2Pk9n9aE3Fma#^m zDWfMM!WFClG}KfCDiw7ZmNO{CZCi9qRBHDOrxsPIw`aOQIm%-d$3|%dPKFwFE$~pF5V&sCU?|VXo^xL{ zKT`iDt7DBynv6E2bSDaPTmD0BP!PA z(Zpre8X9cMeB^U$0An5NQJq7F{s*{j?Sd#|&<3g87O|5Fr1Fpe!*x~$h9sqe585x3 z?yXK;*VN9>lbpf&_>2+A6ww_TYe~w(3pKQfOgX$S<~1U(E%y z(}$ly2VQ%~lsK;Wv3q(T`}@wjkF=846^Y3Sigo^}b#S=Oy7AF_Gnu7_RX}Y5ZH8*k z0tK6-ua1vC#=3rxFcGPgZgNR6e7jYji@PRE^z31VMBxsQIf1u9VI7;uGe>iU!{%10 z)_pvTnm6}L*0YM*)Erxu_g3W5kw&W2~`9 z0+=L6rR^ea%JvGwq;OZSP^9M<-`O%!4r39N6E;oJtXA&^Eg=j#2f~3 zrHi2H?j&u7EWssr`{X2zramb@8T~9|UH6saA*x%w<5q?* zZY?XC$#}t7DqU7n;6bP{Yv4@UW1t$FDO} zmpbT+#~TMRNldv~a?WVt2CD{%W0CGU@(hZgH5&@xd9$*%;4qenjs+K6mYkQ-YE}Ks zyhA{;Z{0-jm>CpdF&BhOQwBD?UW3 zGi_&jkeIq7gu#pRS1Q zqr0uVr=&S4e)9`uRfbDq^OOqao6dQYRw4FBjp@3o)+te5*tWz|r(K#KFfzD;Z!!aq z)Gq4hD4i=Z4LXpLA;fT#m4U%)HWRb{5l}UH{BQthJ&L-H7W?^oo2T39F~lxpzrKql zqN>GC=}PG(Eyq|fB)IaG2IX}F8@}O!PvKBR%GLXLtKf{ zfqXd{Of5Rg_I_LX$ahU=bjSQhiwrMBv9=vJ`F>J3gB*j@AJG*uHr&z%PUceD9SWl4FuXFDR2u2J7(5p=g(3J2L!(NY=Le53pw=9;o$VLwur%rD-a`u(c1T^7SDM8X zv^OjfRF2%d(Z|Kw!{og(M2mre?c9`Bz1{->2UbkyN&B?>$;P-itT%+Fgtg(3NYk0WcA)6dvXVp?`Q=b84#)VL_@ zQDZRX{lleIu$Ir~qCy43lc{mCAqxVTB<8http#1Wck?W`9QNm9_=Ny5mZKiw4^=@G#Cs&}qI)J6s;TsR&48 zy>RgP?cfBDLrqm9y zf?=ybwWeaTe`4ehM#gj-1`Swzvb0`pJlpj9Opu^O2#ct*%&Z%(sTI>eGc!z%yZA2f zq-lXdc9HHC4Tvw|nhvefe7ycaY16tUJ)6l#R|Fi;FnA`#%zj8&B$16_smFu^0vZAg zw^D(^8$%+jo|lG1WN>J1IK;I01HaqH-A`1Rz$Uq@j%7Wz&)DX4 z#V)lVrWyr=Ec)T zhZijT5m^1!`>f?xoeR2Q>lo_zg%}j7E`qDo*0u>u+=)^QcUT!1gl}|(Ffl09f%>vM z3Kc}%*~<-#8I)n_{9M<0+@5|?A=3RcwpusS2^5It^6JBlowMN-;=QOVQrH7orD_mM4 zS~*P?U3Hr7mf&zy;GT*+SY^$%i4jwb*2KBBp10Cpe2l3nvqIC~tbzNj$aMxWhIztj z3>bh*lVRTEWYBuvV_#NYVCC}rsLq)o&Uwg5@W)Z-?zXsvs{_-PW?16O7 zUOXW2!RTVmHG!#f?`F*eU9+t&)!g)a^Rm-MAfH}lP=toqjJ8Sq0hhm}8hMp{j8qdU zV>oCM<9F%tW*?OU46w8?qirKR>}D9WPkN;Qi^CZm>n5wfOwtKZ%8gfBtg`UKN6WgF zPX{0Pfx^8-*1;l3TbUQC>c$(R&#D;;@YHmpCs#rn?wSmT>t-!D;#di4LdG?vMwLq- z7YlL8&wuQ$AJ0b5`#)dsuU?jQZf@v=HHv0k9&=(l++Q>)^4K^VOYLyx^doC)PAYRSyzs9MVp6El z!@YkFzFQ7_XD?{?7%@BQU}`|O*QtQ-t>cB<{p)(~af0!edeGU^^BIJ}=e674^-wd} zudF&hs6b!ox*h{RL*OF)w#~+y=iHw-$zO9uA$U~>WRD)|ZNQKd>iZAeE#YN)7X}(# zyw4y7Hgmp9mZAQ{Ue`8f1{X8wl3Zs7m;Octeg^Of_S0V&2G5_AXTIA3yb1+k^7-sX zekYI2+7YbC$Z($laysk$;EAiVl^!MU@N>-r?SBTlE0)7r@S|bOa;5Egpiv#jDMRv2 zfgALAnbv(SFVW%#+rr2a^Zfmb5U>s6U^nG6W(mb!X3P@0wsIBoU6Ug5a76|lu-Znx zfXN&Dre=Wl+Ve0JcDLN;KjEuX5X{y%z^cl2_V?2c9QE^_zLy>>+7*5^{j6=N`*=&yOBa^`DWCR5b~iWd}>S!0EK?ZlD9S%sE9+U@MN+%Gn zK5$GixG0|e$j>UJWS5Gk$xqPO8$Z~e=LO{t8>;Fa>s`Xk0NoR*arotqi6sX>;Ux)< z-Pqa3!1wF+EH&P&Ci!uf;he%%HQ;!LgeU)tW!Wrue_V_`woeIsPOrm-UirJJZ%TtN zy-gDb?HsCSkcZor$>-<%@DjsSx#gA?yo!@pyB1km@Fs%ht1otZUk!2(M1>l+Nb71_ zyL|~$I~ioqbSpGuPV+4;kaAkG@Cma5)ZH&;woT%1Z~(a*k|L&K+&m3Ef9m2+Kga7) zGk<0=OS|9?0b&_hFbZ?RtRJ~dNx`Zx)3v`dH!?WOzaML54sZh6xYNweB!| zFqJ=)sS>NmAkR>#sx0`?@X3P)*5wmRN|=^BODOS~`^xRoF$R_+#{xm~zV!^k5S^+5 zZ4#EUz2%oZzNwlkfc6R=Z_qLSaP~-E$c>JV>blF7!t-5^950yL6;r5{CK_kP!|>0( zk)6TlkKBQhh)x+W?+{e=+iQziu61?vKeQ6v`6%R!0zX6I9giqJ$?}uYMN98^SS)61LEhF^sRAfmgfN!IQsA6DBdb}dC>ZFH96yM$y6_wm8lVInD zt1w70JOs`EGQiGLVq^Gu;O-?u4N#njFl-F3p7ZR135!(=Ofa=FF?dm{dy@7{nQVGF;Y~jilU^#o(;a8_?MLe+D_wE@1}Ae@D{3S+8n+)K}-{ z;*${Tvd;DnxFA+i0Np1beuP=yO@E@c4CtJfqtZXpz&9G_cIdt4($^LMoflKY91qEg zoQF;?QUIR<4Z8p7QTfSe#S7fLKQELzo-i^y$QAVN@RTJ7ts&a#(w10nIfO49G0z>AVn3oSfpJ*@-pS#&dWesSX*`%o| z)yd`s)26DdNKgfxDW?j$OV4}S(cZR;+NB>~2nKhX8g_lFadLnB$M#E_w=#qh%a#ou>_Hd!4>a`9WsvS67WN93_(H_kaV1We&HRfxO5s(4z^a;s2- zm5K(#3;*r@Cz7;P8G4Mn*MgO+d6%v}=cK~4+-WaI&?FtFqi!!fo;NBpyg0w0K5p*x z&Sjtr8=|LG6`RQgt>c*UF}$J6xA&E^XK?g<22F++{ACx_bWS8Jc(q8gUKqN4Vw1$g zU~Nf;N30ACj4MtCWld6^Rvas^sYe|&8~j4wC{;5gXT^WH1+zRjH$?1Y3ds?98Rk3P z9^@NP29qEpGU>I$5hYNmrosjtaYWLg}+4qnqL4R))LZPb_VUS~7rsJ~sb za%b&(E$0ubXCGB$kOSZN`eW5Mi?ataJtiCgUE;o3uQJA5YU7LdQ>7F{7*>M4Ar{=& z9aR&!>ZHP}`47}VqZSgNeeUL~3Mbn=+_Og{2y|Og$5GIQXlr=jd*7di8G>(B^{@c9 z8uWTWM@1=vjz$$_cql9=f4Eeu=(3`cUEAxBCzn8nhJbFTPws9Gjj7*$9CEH2mR;sD z43DAt|BH+?gP`d3jnby)CYOPRk{Wc_&nhK0-q#2}+gfhHzzucDiWvzdA`D6liEAEN zZ4o}m8DSs;ZnK2fw9Mm1aL$;DgHPE4DG#ZL6vK4miWwqTc)`2hIfNl6CV!i!05!`a z_MA}FP*f!v~2#uFeE8d7pOUa;h`d%5KA641fZXA)!N zFX-xC>2p(gasV`T3OX0gK)hzJBKO)tV}m0}f9_3CoCaFnTLv;o5p0qe!xL5p2C#W$ z+@FIZ!z*U?A6A_s%2B(`z@9a7g=}vKg9@nhZ0WqaVuRpg|5JI1by}yv6+Y;0+TJ;H z)ZcPRuwMNm#Q?g$A`;XRcu?2-zDnu(<4=0VZLD%UY3n3FCM0lv&RLT>8wum8ZXsS7nYd>DMIe;tMS@(@>kZK<)C#d z;KBDRdP$h3f>wh%Dk7VjYtTOFlvPRBVGHO6$4NIPFVtWFo$K?#e+KvhU+G1scO5!y z1v(X#iQk2pxoWRsxe~G&NB1hG$39H8<6FH<=jr#hJC~hOSPw8Oi$UtK`#zA{pf5pd z`{kf^QOGt~&7V`6ss;UnAEpXQF+3EmU|4$my7Zw69#UESOt+P*1COi`uwnG5(#5hqaZL7YL*VVA0i^U(~y zXI1?UjV>#H6gl*8>1%^dbGCBuJ!BR79&~|=J1F#@EStD{M@hzu$)H+E5|o}~HiY^2$Jmr4zo)6bAL-@*!!NA*F(|MbXXA{qbFsNwp`>N-V!E%9=ZQ7r&|w zX!gEFK^}VFbUrwzT`kfo`U=Vz%w9rsw61NPYCi?kvir{oYO#K2Saw)Sn&IDnP8$I= zv5J!(Cv}3QJlzYX+vH6*6O?}}3o3v9*(b%Ypz6_LW%y_B#NiBX4PvxyloS{qK6blQ zbi!9T;aA^r&fFs1D=fufpo+mGLSs|ae-3RKQ0g!+WjfaTFk;E=vv$8rdS*BNPM2Gm zA8c5p zbwU*jl2u-0usb!d2{5e8nj^P=J=5Yo>sE&k3?CLlQqw;0IS`;$fDprr^OMU;86r(O z{2K*8b9ap@pwoFl@c_>8He53~bbStLAoZ4o6+p5w$nD)AmBw|sN<8IDo&?bQ+=_p^d)|q!JNC3$gRYJauI$V) zdvU7`)~59UyH6aHGH)E|WAs`SCB*sdl=qhzFJX6i<%3SJn&S3Ak%`Y@}%UtjQ@$I0a)GVGl(v+pe5!v#7mril5yf9rHsIry!mpj)KR94J3) z_{u>$j7j@z1M8{$4}9zlox&9kZ+>P$>#aASlVg-y44yCufZQ=n8rHxNh%*D-JA8mS z_u>bkjShh`WC9vYxIi}oq)neCz&*v81LP{^r1Rn2tPBs8Atz6R&L0J>pUDS}AStRc z$TK`=WdO(H2ki~3CWsohOjWb~vT84jYToR+8i9gEC$21782%#c%pV2N-H!UR4oukN z13J7yv4SC`M}mt*!g3;$+sOh@dH}^N_{`uazmxjEyre;VkhliJi~hG?ytkGw1xv>xtr1`6ws~TWv2uRr>X~ee1=+$>__IU zFOj+J=nC3E@Nj*=#(gkw}cG~D&4d?et^BV7h1hMxyY1*MlJZ+N`wX5gaTyE$aG{#eAq7_K7=v`$jej^Aj!Gmr#_&uP5#PLH z)6tmCA2vxNnS61XA@ssN&qBl9S2#d-3MYbW*di!?{r=m9;F=A5T9zQgM(O2B=CV7~ zIo!c5SW!^EGW2!LvtqgU@x*CJ`*%8@k)P|jf|V{}d{Ffak3*g;+rRo3XdI6n+7bty zbXd>8kCI|qrmHgWfNBN>CA+rj<4&J7AuVhXP@YgrI2e1XP%tFPH)f=+^XI3F|s1eN8CClbWK7P;F(afygBpwgC*9~-c^~`wCO&y@p?(us*Uq~s;7%Uj82=SX3sP|x+r#1cO z(HAq0zQ|L_<#BMxagpO;-~^4@dT6eiEaL4ysu zCvGuhICw_Pwb*c%w5K$)fH&m&1JFGRATumkVkT-ob-Tm}DM?uvlo=jAK5w?HlQqsL z$msMGw@ZR|RQoTRmK`}>v7TG9Ztkjlu`J|8whW zgZgctlHMyDR6wb;c@{w0N~#Qr5MK-IemQklf^awUGNoOsJ`@!fc3C<=u|LTfyw}zpiu%)oJyrEdq_|Fn7c#9#6=YF;-Zxa)DCm0#WV8sVZ%r z0g5spUzaH>B`K$ugj7f{ykccwm}%bkcFlvx6A`;S7#<7j*~@}z5%3BN2XiGQGofP^ zpbQRL57ZbI_(7LJkl`WtrV;%d0p`zzUz80QyOooa8$owhgH`n> z3T~WeY^Am5%<+w~DLSk@OcL`8eky|QuV>;1+p@y&%q+V$*CTFCbLJe8;|;v$+OYW=5>4lDD};kJPaGW5KPhJ9_EUcOA{2BN zYa-8yKS?Dapp-V#Z`~AWPwAh}dJ2n|w)cbA*L?z=e3Qt;59@>7vdvdIRnfboxA93| z;k+%)@tnpghCWSv;B+PpDi2I1nXye`PCD%M=*p9%Em`iY z&(n&+k!+A0E5Yy(;tGkJ-sVY{*MXP6Tz&LGsFIW6VROT4c$^t0M}VpbM@24%hmWDv zfGVW)5CHoY)Kc)^2hE4@9DPwMCXLlVs4Z2@sW!4_apz1x!1yRT4Ljdi3hDEAZcT!+ofXyMGiS1>#`rF+MT-?-`&o~ z@X%1f){D`%%XqW9Sll;G22Ux^(~8sgED&elVDS71+T0&za+v4yT(6zH>4>|=bTxs(|=mT zd(O$T2fHBB{nW-2(?2mhOpWAXc(^{(SxDH4an~n^y($b3{e>Ccure?_U}TBe{-K?H zUH1)-7VDrsS1YM!Pc}4x^V=03fvx|QSs6esV?wv_jZ50b4@UWO6pWND?8QJXYY=!< zp;559FhI!dqb)yk)<;)nB;SBs`KIvAr$eXr6e{)E{#N7$>A7%CTl8hwW+e>Md3DZ! zR4!^{eDDWsx&SZFi(>}ArJhR)u2c$Hq?s^fxeOw#z^321${`l_tXKHXRR^ta%JK{k z9l=cz<|A&87c5a?<6I(N&mqU4nI@>A_CCUli$MhBf`*3IV*fsX6m}N4pW5ibAdPA& zt6PG2oF4D7mlB)@eky|UJ*UkDL!m9L_R+ncdpw@kie`OuZDv4o%TbO4dV9`DF9&5V z!{3V1pfr&vY|W<8nI&+TrQNSEBj$ec4R9agKLh9#XO=|pi1*W__x6GO-G5>F73n_= zG7O#{9po7|NHj|wUh@)^BUE|{izogFNES8dvQY%3AuBfMa7eBc~-`h3!AMVxO<|4`PupU}SL#hI|$Ip~LHa=i{0J?MeBxfQABrQpT(=a&Wzi@Lo z;&v$GPK=73fDOYRSgN)HwZ*{on%kvgpqM%slCarNl>u~O_K`y6%wz>i1+$RuD=ggl zpO4K9Zv3najv0gHOxv^OJn+2@YKtan{+|rJgAA1C7+8+9ahbgi(Lgan<+Sg9P(i)% zx%M}R8K5!Us}@3XrP^tNpu^I4qov4$9NEl%Rt`UUPyR@g_4;NsLcpzBS6Da zC&mfv=LT<)-=MM*mgXJ#pgwpgbBIH^=Yul3KSUYcu`)0exMT6nM&tcypip^x=KVKC z9*_$TxCQ?3tN-TcAcC4ZHhNz*dL5#G91GhP2>3=;%ry7g9di4UGCN531-;NR(2bn1 zGyp0wH@boY?AD@(bN_|YXMg3_GHpkx`)A9z6HlY$zm zFZSq6vU?q3KFN$tLBVX^(L<+g)!k1kiT+kp0=XWogjk^=k}NYth3(3fGb@gY^PWO; zud4nF@wjKbpFcTmvRtARe>WT~x{nWT`p03Akjf!h&j(=&43M%w z6kSg9_@YGtuySA(a;^cT0mUg-K%t;8rK<6>G8Z_k172P2O=LsLrC@a}X`sx(u6U(1 z4N|*7>(}L8%auTL0w0bua{rT<#y)A@_5Gm3`B!|{gs5vJAa3ITl~ar@0oPYTYP2Q{ z*Bp2YcFlol@>?r7z^(zs9GY8vAr({b8-|DP6!}1^W+bt5oCSx415$i}+kgCv(vAgKzTA4@UWSu5d(bviMV5krY9-6mcVBE;c1FDwHr=}b$ z5M%fNy2i3bfWh-)LKaJp^x=&k=Kg!L*n(?(_W4Q1jZ;;?HFvOQoYKLcid+mQU0?%nq6{y$@ai2c2~~(wie=U7 zYRoLPY%T}w$9o8BYN|l&V^>hv7IGF;mqYL<4U9&xOIBTP%^?I62RJ zxftAyTP%?sDGjmr$?**bnh&yW+*D~;)e__|`4RXMP>>z#Gn>5)V?{Z3X8IU1-#0xz zK|+lYx`p3MYL7BzIGO4}BG4pq!IF>C{0xn3UF^Y$NsUdd@4uwGGJwoPclX*Idp;P+ zn@@F#-ss@@SeXx@$931;H65t&28xTsRnWMwQ@xv_YsbI`4jCJ-U7m|S2s3HhLcjT77H|{K{oMw4#W(qE6 zXM4?hQTeHo0aWrNXd&$5n0N2O=S|N*Be)o$xFEh_X8&xjMQbm7e)1VbC&<2om!+%X zu2rDv1lcJ1`8_0|eVNG}_(q*U49$-ZX2hL|;rLsD&6j8Qi^n~Cylhg2v$6Q18=(H9 z=SP@(LAJ_V?w-lLP#%k|N4Lj7vfjo}u4BA*4B}|EI@sCn3*|cYHj@F1y=(J#LIOAX zz833aHhUyDOE7$5WnfsY0kZwX^5fgR4(_l;O+nz4!29k#G_M@|c&?5?mcf&Ob2fMy zjJss|#_RG{TW5lKkMk>EgnR(cg&yIAv~*V%Cr|v+?w1RmN(sF;=UlJrrFaE4hJSaC zJWRC~Wa#9ynZae=_Vi-xv3d7q?M-85U|~4f+dYFHA`@Toval<9^Yt81?Q)Vcu>&>D zu`4K;g@DS}!eGxMd@T%f?By69_V2fbb(Ooa*q!*!oj(Mhu;k@o@MPHOx~{NI1qu;&HGB2SwKIJdK*<@V5o4 zc0(fXHZS8jeIA$&P+sRi&9mTgkk|YM=n(vsDz^%5HwrX-RtA^spgaM&txb~ELjfrl zNilq8Wnd5iAA0}zE!!`s-n@c6o9*$(asdgkECdTna4a(|xS4IHfDy}F3?|iQ*&rc@ z8Oz(Y?FH40A(!3+b&E{b$M3djB)APV1x|X=*}wpD18NH760#K(fTcj>@Dl;ojE~oD zgJ$g2dRsjTf8uxD7D`;Fz=hp)F3>cGCFBGSLh4b00^g-OYEa!K#qfodfdM@S@1Vei zio&2(R%khxOUO255uWhV1@-zsRWa+1WkE4^sBT1e-7*SX*GXddflB;D#Ry2*J3Ti2 z5P_6;hyu4MI%7|HDIBnn!&0{AI)R2eKy}LO2_WYYD4Qpsxlf$oD=Py7@g?-67lcC) zt^QC@*tWv}+yYj$Yzo|v_W^W&0;t}TX$sun2QK*(&}uDkNw$_7+W3g(cRRT2pgOeO z0@ej8{W?(dA*d$!wh3HRsuWe#XU>=$D-P(EY$;vScrl;j2}T`_eiY)uwA}W zp#@)v-+O)D;!UqXH+h5Hh|mifph7Fp6%@7=xPS(mW_x||uzh7_2WcPmD1BYA`or9R zYdBC{2)1dhBE*d@(UYsLQ{d+O5LwE4%r6loP%-f9$RkY!LsF$dgAINO`>@M%#|u;-SY zD^EPlV0U6Tr_UgTWCo}WXtHd2@Wj&>`C1s>c%Zrk?1~GLG2nLDrHir0=0RKm38OzR z^pekmv`vKc+|!)ZBR!lnv_0FoSy9Ahp7NLUXcoOpbj59kkG(si~JX zy~{dyuLbuh9?*ClQVIp70?>E_*o-YA)Aut7GMwzHxGN!6VQ@n>jfdMt;>;WdE{IrJ zyX0XWP@RuDbIi@~vLms&540Zs%mW5N5U-KF`L3Z9!*^B&2IV+&@IoyG27ZvgA^kv) z?XzpYX`6zqAAQ;>uQbZj5BD7X{5X3OY%w0*&X} zC&e6Z@PP~)Zo4+A;MAehf9Fr0t;;zbbkN>!Wd>e`fB#wJ&P;3JzP>VO!#fl`9F_{( z%GRDabo#Hoy7~ITOU9t{dLH~^;D+b{9~;VnJ_dY(IRP}LbDIY;1`Hk>xWOaAIRR~K z;Kc4Fpzihdo2k#rf5XPjKr3`O9MDFUPb71fJxsl~zOpu0a<a}!_ub6x^y7Iz&}QiuV=4^{>S@FF|#x@OQ!HRRSIZiawE znf-@&Ul?622KCMZxGvmXT)@1l<&Md+4N*!qAmAqjjZBj`?9&}#2` z@HrcxbzJ%PcE5E>icG$ zpjGrz;c>_lE>+O#N65`dpjGaet_HarggGIuKX*|ca+?_!?B4Rl_6ne#Ut$a|&exb( z*L(1Nsazx$Kjn~}RNZC@#P zEhHq&*>wU!l4oq)a+1mQtHsgyxs8{lo8meZpu3P{b2+M1Ib!yMQkDqV99htf)Cvx_ zr|Dd3Rd9#~=Rs+R%<}~-OyRK(#`h%7S%ms66>&@85ZGY{wo4RaUsV7r1Na2*deBOh zlHZpmZUFDZ5EZ@qrQMHl*T==Xd-e((eW4)B@Gs_n{2@puJEY{Ye0bSq?b3s4V(cM| z3{j%sRfbaF6~ExMz9HRL#4pPq&G@Lo@QW36T+54ZoQF;;DKaGbO2>4)T;*`WH`y!0 z^a$JHw2oM@MQLfEvji@j1@&xM84?9tt|8wT2U@N9>B8I3Nn0wI@B6%wSfH|Mh1g2{ zW%A&;oq~j;86Vm9LB*m>x*68Ls>hLnm25}dn&Rde55SpCgutFi2*oyzMa zL1hr+mO@Z2zVO`T$dx4DJGU(E+9{qE%zh;1b+S|;3A`Gbm%;M$(yhr_PoA#LGid_t z2eM}nVAz?s$57`(!UpRzpc-<9A}3hn4WDtFBsi6`F>LIPQ9QnYkzqfB5L%eTKTK5= zWk{?8jg=;ppXimXx*E5lY?<>c2Tzy32WP9~C^B65J>U z9&CNAFfn`bV^(IRdVgMqe|Nqx-cV==N}l*|f()nzx|4Fy;gNM*R}$+Tx9KcJSxXN_ zoM^lkX0d>^RXT%lD<~KK2d&crt$#Gq+M@$nRUusAkhjM7o5*&Cx?{gZK(&N$g~3gi zK&Kzd^NTnc9)eaN6!CfeMOk&g3tc64{jKIAKW5Nv1o;fS;5GXUQ>40i*njN?o%oy2 zAj9w*y#GIuiQk56y|Ry{p?2vqB_o+leXeu5Bqcy=2|z3O&m@(U>y+qODr{@mSD>Q5 zM@JmA#^^y{g>0f%XXHv_(TNWyl}0_-cco=_~ zZF<{Fug|e}HeT=)HJ%1)F(@B%od%k*h07JS&+^)tyl}Es8hB1Zxy4`#P8WexB(@0H zx`XRf9tMurdcqY7F{$fs2b+P@sSv295QL|qs|i{+v;x+B*aS)&f9}Hfbb*DD+Mhh2 z`1xWfXt*`cB=Nc^D4dH>GS7a{J>l{U53?qTHZE4v(x^ zjuj~}fbQM>(m1=kWWyVi3mhfM(oe3iYRg<`I>fuBA&MEi+5$8p3^k=>(@KZ_z9}_c z2MZ^h*y_p2+^NX$hn0chy@14NP5fpFvoSn;{JzhzoSorevKDwv4L5w<6{{f^gBSy+ zK!NJ@m%Dtv*4V}wD0~Xu*mb>B$CMMa_VrJbglOD11`&qNWQVq{UYVp2U+EaBW!h)U zPr8WlFm!@UWDnjL_-nVV0C;`uC4<<^ecje#Rx6X(SQ$851llga_iu19JQQAcX=$uX zpq8>I!^6+uWx%_g^WcRDixMc`fL1`UzvJB02lB5717y_*c;=LepTjmO>u$!OrowOK4H@*LP&y!ZZ34{{%WDlSRjA+(&H-{mR%Q(K%Iki+R0*zm6aI&-PzFM3ohh) zS-oB@43?2Pp0cTG9YVQdb`N95;BrF8D1HbUJEx{w38$8VyOw=^c^}srv4Xzm$uQp!AvV;Yz!c& z>Jeyd!(>*kf;Voad2D6eu~LnVo0=7&D|1B{5+^{s=KGiR&n^kR^>UGP?}Mm^sdfm5 zdx(K{M8e#C^o5mFyLXJ(pHux9?%n{M!RM4__{Yk?02#`^*(*5X0hhiuFT=yxIsr|| zn;d?Yo|=0fnsXqxIYV}lsK8x(HR$;6oeG|C^4HH!AR zy(jR3YT!;#$?!O3qFzb6%+r`T-JLF~Q2*&c)a|*~m90myCrq3vXaQ;p zI$CgQap8_5sR!5p!H9_hNEs~-DqZL;5J%v5~m5 zSJ6r$BEwQ6Q$Y??s;71Eu^r<}3IUfSj+w{7Q=Sg2QYPJ?^?c%6&VEJc`x*yK*4V=eQofb3mdLx#arIe zf}oZ}T1THb?^Jeund!xwOSGYN5Kmjf6y~1yU!E6$OP(Z9$)m_1&A`CM0N!oIJ!QYd z+jTPDl?|Z9Q?gsGdV4>6FDQ1J=j~H%1qK07d&P#!-CBU@ipO!Kcfm%`b?5N9E()|- zdydWr<{iz}Vpa3og;*L+2hrFg(yZA=ke_^|VpFshf<1D6i{|8PhP+^>L5{@q$v%4x7yykW`nudXZxCm?mN6sR_tG(+If3#%-d zDRXwYp3~~o)DQrz;!yzWw&6&S&@d7zZoU1mU?Wg%~Tr zJrE{_3`IrIj*}_%pgQ}IS6|&k3AKX@4U;tfw>$-1rW)9--^B?!6{f#MSa%NSWb&+! zt}AD_cBrY;K67XS?Z*J`7f}H1T!!|&!WplqtO;J~T>;vsSL?7HJQ)ea!==5UC;vWE*58yW?*Dv0JY^8#IABOUxn!J98mxC2Q&{2Z8?J4pQdFmLaP_v zn#q^Rru#RQ~RA3tIeVhW z8}dhQH*S`$4r)1aI1yC4B|EqsWm&B6)$7_O`~=k6o#S=)mKdaO0BOnp{WI50Q$}>X z)77b!%18=0vfx zJv#YoP4bQq&~Dup0o%g0QrqXZKAy+aD6}Tyd*pn6hQh~9(cnf~nCz)j{{=uhOm&yX zWQx0sOm1mBQr`QevCZYiGN#z%_PDL$tLDC(pjMy+YH^l`@MSnYWQ%gp4QDXpSa2mG z#lq2#Z#qM*=Kq$|gNNAW&Bt{k58Ed`}fdeL_? zWDa=Uk*Sni&6hg=D`;hKqR&ycml8RqelHl`Dm5NCtp2g!q%^2E2&iX{?j7uMZmX6 zb(>SmbJe97IDMrj%~;0;8kC)}(D`Qi-2A-0KUYpZ__)>_N13X8^ZmSIlULxH$n_Qw7{Q)@f=e#D8r1A!mcXg7=t}6&V7ejy3Rz zN?RU*7P*(q`uI+z=N|kKRKc;#{!n!SsD+&bx;?O-fs^59K*EGA-O5~&;L$E_hK-_| zmTQ!IGuPreTJYLIuN-4?11od$QV%E7}=^AoXPR@k3UkJ56M} zEkxJ<)L{4*GyhEN!^g^T;Qeh6o(OQ9e$6s>alC*H!-Fpzp+YT7y*Ah`d!h)cV>~+D zSUitAu`BeatXcnI6R5m{w%1%ic>%QgPxE4j!pn#k3{M^(0(C=q7#@CZ)yZ_SI`G4< z{v4!C$v`br9K3oP3?-P_x-Oc#96o&h#flG`I2jV>G*1#^U}0lmuzpgpUlrVY^?>Y| zy%n)wNgQZa_TQZkg?wJ`9>`3&RFiS9Ieg>i_Q}mbwMzDxF2rt8cEAxtOOuIIN(qh4dab zFyOb3_3rWsQ4t)V_7Kdzu7f$1Hx=;OW}C201T;?|!H~!>v6|28-3;V#(4TNa88lX< zz>rv_r+-|D&AH*<9z`iRxiqPs>^Bvss?`jAm|9pxSI7%6JbWxO<<3D%jiruC-({wl zq=3$(l?Jy-g`P$nN$4n0w295!$9DGyTl!0_bB>&#dGd$J4!cz0O)~}tNrsijHp+(N ze7!X3XLSp>rM#&1|H4Gj$4#W6Dr@9@G+2lyAXdOZO* zLj@I)?386-Wn*AKv6;`|(&tHzN)3))pb;0)n9ozxksfh|hw>~jo`*|fmsRbP)0YtV zxiaGDYpZEm3<3lrhMHdnH)>`Yz(dk}gT;erF+&t;#Jg zEEQyt+==2s$C5SaDWEf+9yT{kW~1hU?=8m4`81(4k1p z7hDXS44mM8(%DP7U{hNRLO}Dz%?l1FfGRB`aK5!=hvZu;P@7VgK@gE|AMw^qJ;cFt z@obwH*qD_y45ADxrQ8oK&J+9m@*9_EM!-hhKm7V{KsRBp2hFiLOq1TRSkNGkXLHk` z)8M@|kTECoRfQ!1ToSIJ=AnQp0~;Fy1NX$Ne108K=vY)DXot=69D!+9A^SqW{RQx- zlo;aluPev+rnE7DXP{cx_!u^t^FHLeBYbD60h4n^0}sQ-bmKYi z#SaCbnZtT;&OOopaMveZ#^naudvv%M9vUY{JUEz8-eAEEV&9n8Y{oL@kP2w8yl@5b z=?Eg=el`aysGr?u3+?lR?nuiA?FQyKQKPj-2eeLFxZ*;Q*S>jz-%QW_=1|+v;(BvI zH;aK?pgt(K$}l{<+_>cV-szz3fsqG`fyJ?xh4UZX+2}p>$P{&PhKI^xKNua1BOkCc zY(F;f!|}O2HuzF*sd+T}A8#2MJxK&8q< z;R*x6<~Z~6%K{HC9e(lVoDcsCZucTp$OtowgJ#bGfy{u*0<%sF{@rWDd+3G9Md7el zCltWr@Ogp<1QzQX-eL4SpRKh=haYtAKy#XP6S*_JE%M0um!MpM=D#(HI^0Vtx11moq zDzx10T`ui@;IsRNNg;xZL_uLB#_*82gNNNJO3TbkVd7hm_cXqgS5IPM$Y2y@cyT@) ze3#`#&@Oc`W3$q3nM8GPN&~mBrb+KmNbwZjBe54UPqi^4pHt}9VhLH$o|YCJ^ACcc zt$eSi^dvU2H+NsW$fYkW1=@dV!{xtaI}7Kw7Slla>Vc^_1LDkoT zUE==B^Nk`559OIR-8ok&Gk*2O9%J>s3kSbSo8x7yP0b zJm+75PX6>V0pHvi84=JJC1}x_T9croz2E$a-BlHa7yVYwN7D>1E@1Lyc{hj(tpSe;fO4NSDEB>h@!cbfc@Z>K zE(YDtz;{gj6=)v%Jp&)Z!(`}?{Ta~KSXt2SV*v{nmlH2OvYJm%;Ea)v|Bwcnm^84~ zFan*=`R|U1{p4nmrUxHYjitePhL_dC!MyFJdEQ~^87m?}JEn3;us*E^uRfRvKB3~k z`U63y)YgF7jZ0isaJ(`UuwghOJg2eqRJ*OTa@&CkA}qN42j?+T5tNq9`}NZ4@oYN$nD}S68SvF;BhtNld+V*we2EC2GHH?f)3FB z3T*g85j;XgaNZoTx`m&C!#UIcHf&Ddp$ceCNchW3dVLyd7kb|c%QJAXF)*+)urWmT zD6X4(1GIuckb$H4)w@h-q4&!s?zRwI=n<~Kz{L<~qwu9;W$9wh-N$e87~A;J4GS*Xas#bBA+>}{yn^8KU(Cqp1q{|Pkx!VDa%uYg=3BJ9Kw z%L?w)^B~zLgr;7DAwcQ7#vO&FLQIc9*U&bIG72W_=nzq2al7O)srApahe|;m0upz> zsfj>WK?P|oY;JnMD3Gj|s=TdNiXq_8T1zf-kCmW~w^_-|r!A>Hb2zjvoOov`!w_)j zcaccmgdona2}K`PhTc!U5qYsgB5s+!bBeSqLqJyv#Ok8UGj3f-ohCfZJU!}%d|bz; z_8bKU8HRwakY`}0!Q{nKnL&3dFa4t^tHN5N8ND1Xam$#QVa_;5pW1D<{pEWX7P(5O8SGZuf_5no}pt zJ|@q=&BnlRCFI2E+2E5GBe=LbGVjmC~<44e#ec3Hd)+`+iil7WX|&aR2?z-cB{NhFocv4|9ljvXz;Z5DACi+Ma!j?JuOIO=MA?d`S3e>Z)Q+9c0BJ|} zCCzxzbT{!#W84MFi-`tjrt@%vPmrvr*Wyrmoy`C$m*g2XKIN7xX*h8}+@|LkXWYk% zxvi{Um#8-VD2Zd_XjBCCST;W84vS>(;Hf#NS3pt{K2~WGQWysF`tA8 z0kW3Ne$n1M&TN&fGy2UEdsBF4pD2(3pN>rGdM=1*xXxM@0lPzXfk>Vd6U(|_)|{U= zn;3XOaSxiopC)YqIap1vBnz}rP>G}I#4jaKyz(*x+GJR&#vgy-G?z^Zlqx`{-Tc&G zE!phIXYjJDSb>XS=VFhYFWya14k-hrKz`_{KSj*)3q>xRZQ}xs*MP?qFEKxO5X3&m zpBpqf*W94J(=WlZ!DW%G>nYdwpp{7Ws-Uw4O57(FU94XD?Z*!x?Sk5x&bY2G7LE+E z47}j-AGF4$9W=|soIly(nrKeipl%>oN@aUe!Q?K0?kN&E0 zGIze8@Z2dgDxzXfg2R*dq7A%GTIYQ<89<{yB|fZGMl5@ce802IR(vsaR$LZ~{Y0O( zqaR*Odj6z)mM3ULh68eD@QM$cSQ!%k+%FbYkv$@o9foCvE?pc{ue{Ke)A)k%+e7KB-CHZDXu6X33 z$HnmQxEOo%pS$aJ{Dbt+-66BSf0`shFSAX5ZXT=n?$g(bgAFJALFeZFyHj${>Y$pD zjM4sov8{$o<=vnvfA>)XWytIkVtf&F8s~}|$9k3uge6MO-sO7k&;e#Y2Jk-S|0f+Z zY#n~z-n_wPHG}Ai&V$yVkw4H%6UeyY73OV!a$YONT~=iHcV|n#idAhQ=b|}H+jd@F zdNN4&u&aabsjHT!U6^LbpHv2|V&?JSzwv4F+3;;Mw(OL!Wy<+^^O?5v`J{)brx^?w z_}CagtD~}SJpi@8nnafbtQFbf+oK`1M;Wwp9W?fMtCJPnd+rbikH~=3J<c03BgW4Ksq9 zX&3Il1%iJ;}Zj(qPTG+a&=faVY$D}iROA)>M# zRdMQIGr+BISPS;8rZu<*gz=3JLHr^QX`#l7b}-i-;&NK?T7`wbK|)XH?5|}Xxh{66%0LBU}Y{Zry`?F?W)DS%rxd?klX^f^kWJyWgqnc7r(`*nniLzkJi z$@4|uRY2$HraYFJ4bvCk1F9=1}frH`2`c%bek<3q`3@=WZgnn`}Ze*Df)3r_z+(7;V z?!AM@GqHs#q%|^M+BY!t(9+7~UiUJVoO&tRCU!ex$th46-)9hE0Npgve?WS9*L^m| z{5e{cizk9=)BEtyZ#&@-^96eE2`Cpq!uh2|+L}ZY_KzEdCG3n1Kxd`H!kjC&Nsgm? zaj3BM|XAR7b2W$n_1!K(RN5*0z}AmOgpb%}Z5d+znl5|3>%m*;rRi#z7`Ael`K zRK}=+W1+9N>k{)uE`cf6Zph4rEB9Dis-XVd(|UCmC|}QK5M=myKpNz+CkqZ+hkkNX zW>;Vkf{86TWwi(7j-XTpe6a+o2?W7=7aD)&l>GyBC&EDSg&LwC!KFF=5ana2WLI<0 z=F#1D(c}kXp$o`lXvyv>cRG0Se{E3D09N`NR+R=r?wEn9x$_o&R}H8HHEUgX)J)2f z<;aYqFTiGcOl3|AsfYyk(xd!NUN_tou)Oh_`MJqub;n;UweomcAHfeQwG|$O*9*7bN~rPjk^z65K*JUq z{*nwk3wOP6GnTbuZdwFN8$})mK7|yYww|j5sps!w_CBEdjLt3g_>yt)zP2ei&n@JJ z=j4emctCkO5s{NcpgH;A`aH49nX`8Oxq4@xyAnJvZ<1nok;VC|dMUrk?U>cGUFYd@ z$1O|Kt2f>Lej<494`_Y@)t8{uE)Q!ZK>Y$rOORb3#s*H;*#7Pnx^s+CqHTL*R=A(g z1wA3qYM^+M^06|we20~t8$k0bDqkET=5+syiv$&(-T&fNYBCVa#s6TrSc^dzRR5nO zE-&Ls0iawYgh&Od6Kedm{}whWg6a}}25fCEc+F81B>p!Z6n69BJ9!YfP5_i!85pm> z_gtIhwd?L1CPj!%pb`=Dz8cUfd?PlNRM15>Q!z;!PRl*{eajt2wYzzJSXw7+ z3_B;Udv`+_aflE2q|@woN_iVXkk|Gk^>=EjN>lV@=(RsQn* zl+^6x%dQjEmx9VwkG0I8{X>ZY1%KyVc?3S38l2aDf&8e>5U6tha*_M4{}u}uCVja# zZ;I;z&}H|jbBk(P0xya;5DGF{iB3ZC^9h%l^jcoAYPo8fll?Z3w@ZCw}F`JYk> zNZ1r2`S?_Z$l`Xz2JGdlE`tag0|R2mo&du?^YyN}{(0L}Vs`jVZ7Nj<>BAm}kb8^7 zr?M=cCK)j4LCAJjNR0*Ab!O~0Rcmg?4+&7*g8H_C4u?GUEuZRPqP0gy1=O~L?K8^S zrV=BjWoEj{-o>z6VM2}n>6OhkbBw_~2eh3=+@M=mK>LAqU2FmEUx{ZBV%Vq@R}8j% z2eXD}!K&Lz0-$l&BG0DayJ8a+-Bdp$fDa8~2KBl@DFiyA`mLisF&4CjAAC|dY{lRy zxsQfA+DdkAOE$~^t;SG#lzc+5{CdcuFp}ixSA^{nH0jrzwA)LKF_9Lu)B~( zSFJ%g6OzwZ82-6;1c1UHgn6JbbB-}etVIzdLRzc{fZGw%4VJS^jFdh$N61AFbjOn{ zgD4vV))ELBiz}{HF84aP3$(W?o&gblSBqAOthpUt5eZuV!2~~CH%!9LdNwD2e>V=G{LugHRwK7 zM6O!&#o@*8L$3vnS@_@5oIPpz^o_zlW;B9QS3ZL}xc`51V_;yFLKtJyC6ELBoF5(0 z*=T7NE3%Z`36vivM7?H!#uG_yitBziBW@-4TrJk@UD2WpiXc}*b2>gZ$)mXmob>~% z6u#6xEah0al@Gci)(Di_g~9D9K9h(P`pi(uBg{)WS{ISqS|8rNfX>wl3-9~5CgCO#ho^>rA1KcgJIan z-{KE0)!q{lyd#un{z=M8NCUN-@Q?f<`qr@8Ku@ja!HfS~;66V7aW~KkTF`vu>d%QH z2PB)=9h3?txr!|O!tge~Utrp+mYI(K;xZR{D}T@h-KNCJu%9V?dmNj^!VOlepo=lv zK~?a(&D-MCdZqi`fo{|6eDPnK;f24+!=&cVzjm+cdnBYP66UKLwyr_xM1)dDg3j@y zDR(6FgY>|2sT)9NH@(Q;Sd_Ycnq^mu`%eQd0o7i%-=U4*b_S?*Aj<&0&#p5~dh&~k zo;gR;%6t|*p2*pJQ$g*bpc81PpFIQa@l7G{xFXW{rfW4bsAPcbgoTf7>fe$E4K{&H z1Km$3==uq_MACx$b4{9YK;N2wqgYX!(-45WBW4J8y=C2yna^7Jp9+W1s*0> z9(7NWW)Np%U|0%1X&p4~mcpHOt@6Mbt774zjhQ=cn1sZ6ect^<_wwq72{AYKo&wE3 z?d#-Ww_5dF!!+*_`v;$!EuvXjY4c09u3m(+AEg-*!8Ylj*#xmeis9d#CB7$)E_;}C zIiOPW?E6XEebzHM6{UXHYL{Y2gqR&ZQ_B1$bH%cpLtLh&o6lQKeboZ48NoZVKxw%O zbmg6+fQW?3+eaPXu#{(jt&c??TVMg*trQ>$9X$nYNGvfy*-FR&I)NOvm!cZ96R^1f zw)z!3d@8!SBKCNYB4`x{cqc}nqd??+$js#l@Z2V3C*#VyVXrz+O9Ov>4)7Yw^u)rN=qk|sE04zwiN=*5HZg!_<_&HJ z`uy;4_WaDqCHB^I*{l-Az@KF6j!luPDK1^(z^o&_V=T^3l z>BNT@dQabpRR@nEBU}qMCwpxvY}ZAH1ja@YsfmOl8ohi4t_w#6x$!= z&I-)cxK!<2vdE*EK?pkIG3f=T8AwF9r>}^g;o)N5iys7J!0Z0@-xdb1iW8iF;2dw()Si+;M}74;0n*h4--l+fYhZh3Cf=Wl}Mah z6s-bTiok*_eLsXGukeCqg_MuE1~3Sq>(b)_iGb9fa1n#-_6h;bz$})1WL4n5L6XVu ztN<_nPSBk9!(<0D=L0Jx7d=$;&*7UGx?7=r2I~>AgD(%AR+0mm0(VVAu(8Ww=Xn;6 ze1^NP6s*kmR)m;*1+e6@8juULS_j-D+LI%}zzJII|8kWB zcqZRfcF%Gqw?>|KKlyl|>rTKfd(6tfDd2J~9JGTFbgu#A*m=L}=c#$ia8FEk{r-%r|}n<4W4<7$mH zvzpl7f1JDYfq0-ok0AH#84St{q72e(3=FYmiAz~t?9q=>tYC1s@+?YFQ)h+5qt<{s z%ino7Ds~=NDEE*-g+bs0!v?L29|1f*r`%eE6lQ(M=~y4a*P%m;#Q zY-CVli1n0Fa_YZOdM}(~s@gP%*4Fm1~Tu3EUL7iM#2C2hZe$!#1G0QJLZBt|x1`V!TrJriinA zT)D?V`|GY-h0{(is6V*;+9Fo|dym6GE9*VDyPO#4d%fKeA2i4WeQ{L?<4UQD9JG_x-ty?z&}UHL94Il z+NR?5*se77Xu#xiTk?3e1Tpmpa^F^D&;-Yk4y$rsS>nrSISbt!St~xs-Pe`6XXq5M zXzO2vsbwpjK0L6k3sqpyV0e5`;nnnhh-bmD*lZi!9v~lc*ZnV#T1s@DzN@lt2@E zgRUdb<#}7L&%59>-7TTTgOell!8KOJ(;gRnGq zxrICY?}`h9ddsQ|RuMf)lXMn!ga~qN6zDvlSiunS)yknbvemWKHTNaw`8I}=T%h!L zHE`=A>!2H{+MdRdJxXekE`ly;Sw=TpQx%08rIp3PyaG-#C^JYY$VElIDy|S#(pfKD z@U>k__u$|o7r8Om?4yi^lB5^u4Q$xU#wj$2^InJ8BM3CB`4 zbazcvDll-^6Ot=?TAe|XA$IXE=a$qSiA4zu&hZ=xzH+d7)0O8R)ZTz@{EBDLVCb3Q zv*NhJ(qFM9nJjE9{0!cS0t~Wj3=A)uB0e5}tf*RbdE@NWk2o~7*mzx6hA1*@59he} zJz-9y-r>zE>gILR_lSx;H9z-Yt%B4KQHe>pt?dko3=D2OkR`f-Qv}xV{ozvSUgVQ} zL_n8?pCMZ6s;g^1C>P(n_qaMSRbk$uC58IJyx@c;dTPE|hciPR>m*l$b2{o(3JgjN zPm?;Fg?BGuS+Vm&UzmP#l@Es;!?s5pnycbwc5z9xzIv*w%5dp`hD+&kl`UqA{xN*4 zirkVg#j3sVjghzW2ZjyT%-2dgcWiLsXHaFRu|Dl`$R_Cif`-6Jw_>!FTBk}C{a)JE zr5NYY^?l{>FrtEtFdO*rjUvm z3~CHMHXZz0SLG)=Ua@Cn+^-bnAu#o=?LKbr#w*ji0t}BV?2P@kX$lh;!-|FCat`uM z>U4H_AsD8r!Y~Q8 zRD7CHKthM_CJ9&2QhpWf;7G@SzE^^!af}|K8Vpa97&dkqw@HmoiypF*uVBw z>`$)La;-e7Dc8i_P?^TOBR~OCQoBBA+W^$Ib_u`w{X2C0FTd4UU%0GCx9tp*tyO;Q5-pt7;)5~ziyhMXeToZKgNd=juE4vRm11F{HZ?0b4l+MbP+_*K;xwT&}drX|=6b6xH1{ z@t}{^0=b7gpz^~5bYQsW%??@6Xr4MldB)}0eRpFRHJ5eid+iHi2;B3kOL@tP6@j(f z2bm9WX?IQ1a#9TZ$DqcrJ^V=Awar|*C7CQ?lW#oipRg@pF~?V@>Rn!(XB8Rt?}~KU z)bS`lg(23CYlT~jYb%r6-X$ynmn>Y~Zaozrq4eQF_=!s@V*S?zgDN@{KrY#!$+&ig zVq_#s9OGgY-qp)Q-8}-oo@g+4f6?>vvI;{@HprZ%zaw~kRi#+?8v+C~jG#!wy^)Us#$ixk+p>9%f{#W_hgmQL495P9h7xuz-Vnnr+~I>UDJXH}BkhYw4S>@eY9q@5t5 zA-_pHkmIoHln(FD3RXX^o@Mg$3W#S=W#~A5xZV5kY$+iIc{T!K>888=VAQL~TN}^?38M1nz3pCpJzL zZj3*<1!U%V5i!lKw!XTT#^kUTamMbI_j^6G@C`!}oz_*cNy&1HJ?{7qe^z6Wmv z6|>|uZB*D9Vue;S)Ts)CTj;8w`Zssd(JKKiD^G{qSTIE;D(jSlA*+~h@2f+1RNO-X z^tUX3t;nFtu+*b#A#eB6E3dPTNBTvqnf}J;@X?vG8Wk@_Tx3vIE8`TMyw*XVfrCNd z*rlBg)*e?l80MUtExR_NbB{cO$E#J$Ya=*CC%oD!rn}$!9%w7rrYT>ASfdrEXoJhU zOP~uqI~<)S9z7)*kn;7Ppqx~%sEa^%*mE6W&gT<+lFtzns#w%6rgn8zvK&Pe^6td2E5V?UX7CJM=b zN`*-p46h7)n$p>LT}8ws;<-L{+0;$nlPb!fz{bF!DbZSQaLC!Lfm=}FfIEZEF^w88 z4Th}uzv7Jrb20-o_Iuwmvf*}Hm}h2Up!CXV`K2R52Yv`eyFLJ2S{9_lz#ygFp|A>6 zXtOp=ieMEwtdik1`;d_1mscJ~-oVWd;d|8=|gElS|(or^bD;TtssAuC2j0Ua~RFS;zk(ELw?S z`E&WWFc!bwr!S_vgRd!4H}q*zKb(5<{iN+Y=cD%4CkQYY^YSFCiExC;axt%Uy22yQ z&M;>kXoiE0fs0|?{{<#CGN0 zpqfJkY`$6Zb|!GhXCK`RxqFSx_$KJ8toDhx}POU;mD6n(s+PUxkMs4vK1 znclarPRmT3w-i)^*!XyUR%6)8FMCRIo^Mir+lmJTH8s%vzs^4}S)+R>&kYA-Y z%c@~Y{hYg1k^)>U8KC8F;Mr6ThB@ol4caHY>QZA+|HU8|R-mUoaXNhNp4@A}_<{Ugz8uUR4^<=oE5VeC5V@ zp$%MDY+N^ks#m*G`6?wPhNqE7-e>GpbQaSNcbIstviHP3G1ap^+c-B}TD(Gm>3R7{ zZDocPQ(l?s2wLop%&JMySsflEw3YTzcw07`NGJiE3fZsKRyXJ`20*0Q3Rj2Dch(&uV{S5K>fb6=Q= z;!ET3w!&)@nHF*<9ld|GLnGxXB;V*CO1hQpZ>Pbql<`AAOje$}z1Flz5my@oS|j#% zyFB=#SGi_-R(>Rx+e7&t0TJUj3hE5Tz8=5MgnsDnU+SPQ9&a4PEt{ z?>%CiOT4%l_St=mQkl?UB*vi3#=yY*0W`mdEze3le(AI|>TWGxzP7-kkJZj?S3v6| z&_^Jayp}%(8iC+pIFqL=slhHVrL6IBv06PoBEeQjp2-+d;BG%Mb-|NkFIfVo73Ae6{K~hql>2I znMQphlc0W{@E}D^balK&ui3RzBPW;`HFpFB&0vmC$yg#Mx$a1lAcH!FTBqU&&C^Xw zCQ7m%-1S6N zwrOdss=je)zc4F45}WPcQlw@zVPN- zFU-qRp!6s?L=ZF%>S zZwv+07+(1A4w)&!T+u0eD$OC@N%@oJOSPqpr4G_6@^hFCEoG+j=QS^q)n$0mZ`N>F zS%qoeZP~cz!IylylxN)Vn7F9cWr^95;=TltH6k+N^DISbSq>!e%wf=Cc(Goz{rb-- zC6gahr_ugeW$Xb+1g-btDWY7Vbe$#kpWp4^udt2D zCU>5+^d%ZkeXaD>Fm!5`%8HZV6;%fn!D|TK2OnJe^KM__%aE-{H-N83mRJUj^uy4KeZ3%w{TFb>K z2DkaX;jR*`>)P)m_J*+k>XJZ+zm=Hg_q6Kh-M)uGvM;oi5Wcv-a!NT!M@Uw%>{DY3>HA~MVkJb&%|qR1f5uu>{qVS(J?n?K zo3V6eaGP?~O}Dw`y>1ktdw$>R&g(y ztIXAL((u50UdcmztX}73lP4%DLR@9}>-j0hW97e$+Y9+}Lhd)k3rdOvMg(k()T{!{ zJ*<>6H&O`O^h&7Fp)~)HlVGZH7=s|gN~z_1laeA@S@WD3q;|EWfJVC3GiX6foN1`D zm3;zVq~^5MbE+-{`-k}2YVW!r92)#s@8!z$)TTdrnU$(?aJ51XPNz10KYPmJZL@Kg z!a9~SU-$GZi)Um2-K_>$ac0`adA8?a9%vJ9!FCC;xbAnF;QhrVM>g0@__F6-QiPkQ zxnv~IX^k6=0#`J_bGTbr=5i>_TkDqS@aEtVH!Fo_kR2xlJF2f+cqnqn#V8(N-$Kit0f%UFk#ZKDJ8paw$3;sp$3{gIo&0} zpw7m?paM?mb0rTS%DyNW;wyGoa`~y1?84G78!qhh6FbZl$H^3aS4k13>e5Pw2dlWn z4u5jE^m)%S5X;DG*U3){Ux98Uk7p2L_^9E2_>snR`NKwDyF3pE7-h~$;A2$~MHOdW zlya#;MT-S|S`T!+!-wM=JQz45Pxd4VPE_VcsK1*O;i8fZRtZ^4YALA%<{^F0dywP7M8gk&pzas zay37zGT1ngZb5T)-%vpffvs?^HPmajqSCHKlq!VuWb;5N~hp!_5Ou1EA&ZZ`DE*mC8j#Jjjx zIiRg$cZ|hAJDMh1NrTf?m42yNTk4dO$$?VB5b@Iw-^J>eP6Kb6e_Fu64-S*4S32yF z{pT}5yPFs3x5?_3nzb4GP332h1^W}sf7-a@dF9%mr%#riJGP-`Qr@PT6;>nJJHHpbVv1d@3~94z$Hf?B-cm1(g}6oa{Tb4DO8OQ;orB<=V;BBNATC$O!#86 zK6KTbJy&i@Y=h=lSq4ou1_sbtvv>w+WH*Dd&XPopnO}m^S2`KAgKmC?=4wzVfn^y3 zjb1K27o;jA3Q8Z)IuSJ_q6H@^Gl(FYd%JSwX2Tp;7bEogFeK{|xIW}(Fx1x4cwT<; zaapGDN5gx&8MqlLUwG&3?p*LA_LCHYFvCd~yQK-wMSB@!7?TT3L8mmUF>o-v{N!_^ zyf3|<3&OHfy_=%I31QdepNM6Ug|H7D`V->M(AQwtk(pSxYI$yteWi;f(-zPO4A=yg zyRQTwDjhtVf|Wtn(Ckx!n%^8j%efqcEdw`ll4; z9T)rx#TXQlm>AH(f(A_n1*>hB<9;Xk%;$<-@Ia(~k~D)B8v{c_*+c~$k;ZtNEg3IF zcS)s&buGJW(pvEqGyK&S8()jR2^;JAbl>TzRZI*DcF?fAY+weBk;?&} z7_)92`w`s!&gh$q%;f@0P&4kg7A$;(p9KWPLUjpWER~0Z;bc~?CAmHJf=jeBB%U@O zoLf>deWUs#nUzyPX9j>{a`r~vgtp^!Z?9b!(9#ive3CA|v=*-(##40k8Mbsr? zjfd-=PPV}FD;BN&`rlUY|M*da zchS5+=j*H{C7hKEx(o_d;3@57P17geyq7XT%Kwn_k*K1hdO$LQs8+88ghc1V!e96UP+;-G&j>k@=f-+-{yq=y5lJi^(KY-O{sFXi8s}pr) z_w7933LZ*1ka#+bwTG#*eRGhWD3=6lmIjl`M+SWcg+M$cihTy4)29^n@xj}KWs9umSbv7D)0`QezD(J^ z?WkW#eYma2^;OSn7(lg|G(>go1y?2ykK;;*8~awp+`T_DJpGf?RyziHnC#MT43`wO zeM5W&&OLHJes$)a&3rq&qv8}9gkdULMW?q;W_dZ`<^Pn2V3U==b%pq`)Q^`6OnQ`_ zE-IffDeuzp=`WTFu=ML2I{Dwph=-&th?*@c3;Kg?f2r&2K36^G)kRieWc{}uRIEI{ zQZ5#DXNlXyqKn323_5HK3@d)gGgJysiv6HJA7sAxnxZOA7SMq%mdam_^t%0f#RIyN z3any1*os|W!_yzMq+YM=54Hud6J9Y0K}~>KbNAP3V*}8NKS{6~>}6w1oNh1JAAW7= zt;dhO*BtozQB@7xcHS~k$<|L-^j%?AMA_W$7F*3N;$9UtsX<+7yrM|@%XhC75vb`7 zTaOLRWe93th7*fXRo~w zwB)$vDxFT-3ofQppG>T}^7@i~ErTk=46wicT$Q|GX(`Wm`_(xvM&C$KIlbj-Y-7Ly z4SfbRh&ugvkSjqqz&w3Y!;-VwTARfr)$xGo)JN|o#??it$PD$c2( zDBI1Wp3$r~@d{htg;vq&k_^5eAq%!s#vo=-z7H{SPPBpXR;%g=!-EgDRNQEKMk1rwh{IL#2gCkl32~S+O zBv?;vO={aP>Hfw38C!!_`j!SLLehc$N@IwAww1w5*H=Ic0G)@yF*SV--vL#LC4QWD zZapa7Bq3%UxJ(x2)7jnz9&?3uY&~es61jt=`HE&^_8kEc2I6c6&0hONe|li^l4VjYg&H_918@k)8b;d=`q*w+M${V(ET!?Rl+|7BBATHK)C@$U!aJX3tu}Y zNFQX~EM$EbNF50CL-wZjO|$Y$bbL}ULjgQGjjmD(*(IHBr7DMB^ICSwe_@%&rHspD zNw^++20b?^~ zj__A8`7eF#HXqcI#I6(Jn|i*JcbURKD)*zTYXg}N!;qFOG<;p(iEYpV`Gpr0x=Q8T z5mpDlXQ6}YPW14AnIMYk(uF!dLAK5Zoo2L1zs=adY1(`Z(5iZ(%up?e)$DW8@U8>J z1DR$7PC4n65H~a86KK4hcr%0;{v8+8Du1^5=1+0m(nT7RS-Ze}GB$>P?2ak5ir}3> z3Fv86Ww8!8tqL%3EbL0SX|&*B^!!IM*7GK+OF~5)ykr>k*%%luF5Ui}_e$HUB|TDB z-3D=QLF-ug88{g@7A9@!|K=YA3N?NPb(k)N9YO*6J2Dp=Dzk($y?QDlba0cZ314hg zd0YLSlNDR-88ir~+%9rccK@Az|=Pt}rb3RiZosM@%2GsokrbqtIQ{0w3YOBp)^6gWA;^h;!7pYtg^ z_Y`?$V{IeEaOObclIM44+*mJu=Ye3!-h^}Fpjm5H29AgNw?J{s&%h1}MYHcUp#5t6 z3?fjQ7wmk?k>GaK`*vi@#~vGy9Xt$675&ePZK|H`%NS6{!*DODH9btm>*QdwyU!+%xf#D0Ob{Buz7DBW=LvS zzy9ty`|-)O6PBlQ-`sn88H2$iQRbPKC-8x4H3K%#&ieHX!eBpchbBn}@m1hcN^d|7L)&#dsev{sEo6_9Q*@q0K)AHikQM z-60hQYj|M6WrF~Lz0!tUb>n7qUmlouc-C;Xk@Se($Sb6*`4=iCfWaaQ7)> zbSpD(GbpfbSo$Jw;|{*>pwdd8ffpoy_)U{C$E|PaH3|&u3@hpmtZ00r%)rT@pnH|E zN9x25dj>`ZeFlh01{F6R@~g-&Ffl09BJwCN!_8*By`jgQ>Lzv^Ewy7%1oPMS+>#S! z;QR4Wa}GQE;)K|4g(eQA4lprKodFWUe;FWppIZNvDD4L6Wn#E9ALLU|8UvT3liC{R z9QKL?)gSx}Lg3H@gmNqtc^{Y9iNM9cx$Tk3bg|NN${^oE?10252gqknnOHx7 zWw=28PPUl6#^I16$S=$ck%vJ$Ko~bX_uQRvqgeyASF*Eh+N_|7qIwMS42&C|dwA(D zuH8~UDWq0Zk->3X_XvK%5jeQQURL++NOg^v7z|Rob;+g!EY3bD)K_%N6 z&Z~pR`H)>A!eAJ2?DWGxHEt`7`+I|4r+#4ZsG2Gb?ifM3M6u(&9u%VMx@F)pp6a2ewTKSv+ z5b@&DZ9RF`E4p7K59Al{$n9CWhhtIE-M%bI24gk`h8)dZ(GAZ*BPWR`7Fd=v%vv%- zpMxPW+56&MxpT{z88-g(X249vpp=%*pvu6wLH$Q(Kp>-sCaCf%oVD9~yVE?mt}aLC ziGK5w6v9lBANZ&uWxbi+)Zk3Go>0d=5L{pNpNoiV%guF8wXH;N3_4FBdIRk_x;^b^xOhlfs9 zk9Obvk!QZ|cJKSu!f{8kFCU%vK`Bo9O4*_AirhKZeJcdl=Uy+}v`)(RG}BXc1`~#V z^{h_c(zX6FU+J-2&75`YvHP^6DjHiCvK?wX#=9?3;knkW0Op5vuU4%J(aeSf&1Or6 zhhn0}eY@;S)6Ml&)w-#)>w zUxVXHU-4)=eFk<0Mc%><-QR2&I2axto3>~-YlWQEyHC%clPC6bryzy%N75F%Q$e(5@xvR46=J7 z*ZDq41`{?0hOSGlJB!bPat)%?;AcCaEY)40WzGnRAC(xAt7hJD^Vqcv>85a9W z-?Dfnm$v6A?tWapKIKAyicW{s4;ST)hvna}F@R(C4=84p!MPwor{rbs^nRvSVpgl- z3YyvTHT9cT#B5(I72Wkt>_H_skL%w`hLi^2wv##}Mf9}l?S1sy^0kMvU%Zicp1UM_`3s%KOE0Z$v>6hw`6oqKSai0|X@8a? zzghFZx>cu)-@Ui!Y>oMqQ?kfX<5Y?x`_tXwP513Ud$Evhb4;4SvQ-IeS7h)HH7o05 zg3mUot@W%2*|(>+p(ef2;< zDq=CH{@1$x_JYBLV!sFf;-;V7!LVf7>#~pqe?YfFa>rJkF8^fsO04@eDA$8aQYIUF zkpI2mJ^|-QaOxIexLIt)cgbPydcAGd7M(^H=3F`Psa66es( zURur2wu$K`vnI9>oFF6?_}KL=C{;1tyL7p50^6(U9H8(^d{>(Z?jL+m>QKNDemV^Q z_P6ToMQ?P?eO|-WxCnGJUih9Bd-aM1T?8Ci1dRk3R%V^FjX#rdZa=4bO*qTN&%6wY zNa0_@0IkU|!XH!~VWuV}Pdm<6m9O>q6Q1VYeY$XQ-PU90yNc_;?MYHnpc!)bm5DLgYoC+(@Hp7QWwDizpyKAe zdd2QG4O6$5PH*q~^|YZ&(*5q@Q@ajpDoQduL`#bkKBJbOkCDnxTq#VJ!JLhO4(W`N z6lRDTLJZ*GS<>QqWx~z4={uF>4xGBZ>$J1`-$T(=piJ~vNKuhNk^w!X!9wRJIREM2 z5@z6pwBI~U;O$RDDT6(2fZKP?0fJl$EEGsBX+S1I>P%3JY58qY(X7vcdJNZ6+wHl% zS^REJv2ogvrB%|YC3WHBu6?472H=*}@+C7*hOs>|Jo3eB;>y-HefJwTuL=9f?VYmf zvg70%M+LsIg4%eD8*eWkgAyAh-o zZUMQ&6ds~t3>It*47rG^q2rEjf>PX-xam7Nlpg3VJtuQPLGHwtCfB*Ml{yqal{7Qx zM#{FvImJxhzwgR9#;UM2X8U5Mr~Rn84tuEw8WTa3dNK_E%-PPloDT@IX#LW(_|z`v z@&cjM1(u49)svF!BvE9QMd!(iF6}OQK1+RmJ%a>;p;i?NJ~kJ3u(4gK2&|5MrquC3r}5ClXTC}b!V4FA zKiwq@I)xI8d;8@WEWzjhAeWff;|^5!f?9_l8kB}GOHM^l$=Mtr*mduK(hA+z3oNwH zDZt9F>w^5UrOOl;aF?9(NG>@+t{5yiN(DJSkVv za#pXz?*+X&!^r!n(MLbx%1%wtXaahh2UJ4QKCj3#Sg|oMke*|7aQIhIg7vkO(e2kp zbnm14WG8X`*b02{~XnT3MD>@&kPJ3J<|$xhU9v@E8+lEF~1w`DL;Jo$~`8OOTrl>DOb5gWC!!F{ax@ z?&==+%pd@%RStf>A=A;o7mwuvQ;bzwj{J6mH;Pyv9FwYx2C$j12cdZM*7a%~GG$9{q-P_2=1v zQ%TF03U&sRniAI7-*B73?dmOmXu-g6bB4L#{r4ujsvNZV^!Lg#ScCR|f!2yzRnP0Z zV8_vX$W>tK>#_q9nB^O^c>xMn{aeLk*rv(A%diq;k3ti;D=`Cf6DN8piewA!vPK6b zEb|fsuS_cqm?N4FZxX!jXz%;QdUM9SvNOesin!Wqo3CB%eVJKXKkqZR^g)EA0XQ{4 zyG=;>`Hfja;MQ-#XbDn5`toE6hLuq>et-69`Q|7gq6exeVcl6scztFd-AqxanJj`X zpg0MEq{(=23kHTeW6-(^X#4Eo>}op(SRUdB z`wcYOIfvEZr))526%4){Bm#;@l)m7kj5+Fvkw8WU9Y}tS1<%Z_{A#p6`JPM7{>v|3 zF|M@O^F_$?neUPB*1Wt7eZ|F9w)&8`gpN#rM^m&R`VZ>PUgH3E6F6_Wh4XtHeYkY` z3d4M*efKjn7z*ahzWf?7vH|rQ*0v`T!=3-=b9pTe@|QvL&RPs-&gmq|Z{`!@bctMc z;NXTlGsm2Y^%vuo@3^$aT-xI3RI@vqJkQnqjQymgLxfr$23s};2B;3EAVqB=^gvb5 z@nImw2B_*u-;_yFeT^j5FG*5;k|fnXNm6~26xDMckfNIDGbyU)EKwpRyd@ay5b-}J zN0E!+jNk5xzU>tYGu`$l zr=Jo!y!9LAYpW67_jSwt_hoA(@UE<)+X5G@&Pyk^9rlV8Q|UdUuxN_Nvje*g(;E6$ z?z|xd8j(s|s>40WElnWMi>vs-T?yk&hu7^}x$}TDHaVl?b~}D8dj{Hv^6&qDbe*46 z{TK22pJfHD6UUS-vYdE9DY%#sGroXmiV+Q@Hn)M~k6kkr~%?Ra-va;<|#6{ ztUY}C=|O?%6Xf122%)%i>)z+whuKlwnep-?6Ei1F)jdT92?l#M285lz*cr|o;C}GD z;|+s0!b+3uktfgn_yuv{*5``2S~4MG!=ZcaIHCIl)i*M? zY>Qa4Sl)2^fv*$uHf{HaI?1#<0UT(Pt}2Nz%B zHc-9BrjZT-h#iLF4Lp|8OYaIE}gJKU0Hu>4r_@C(OL9j7k}3LsSn*Q-1|QCGpXf?-LQ{voC& zt8T}m%hW8BEX6|uj(|-&$ir}k?|{IJhK6n#Qw?PvhBH1J9?VcQU}O~Eprg-lrtd9- z1e35pfuO;=5KTpgE4wr%ho0ZNHJH(WMNL7J!GVo|;enDv09(uw2ZqPp8ybTCmHcK< z#Hug-h|U8Yi!=@&hXY3)8RQZ6x|(lN)^sp;PGDlvd%yy5>8S$@VD|~Cf&9TJVN`v7 z(Zn0w=U=5R`pI*p?UW{C7=z945*dfBT{rwUMmK_Hp3j}sRq^;4o!A&?d_=GMeB80V zZm=1;N?^NI@QS*vWHCMbx>b?c(Xevw51mLJ&6%xWzdEQ2Gn`r1ntsnzt@GfLzk++> zYNqM5)i7`}oMCW#)0UCdc9KDa;Y?o7jeq+k%Z}W0HCyyYc&5yi|B7H6Zh}h7lQXw; zvP@~x`2NzOAuCj2g~H+j-(@%Y3N>XI*0%*u(KJfc6y3IK!eSkHP(6II*H&}UAH}R2 zw>KL~9R2R1ytshZFvf+|Qks){5ucq_jsLCCpT%O!L8<e_CwHXVyKwOmoZz|_*VL_=Up!?(+ee}52wM-Kxi z9E_8u877RH+AF@itcy+ZPss%xg|4?c zEF7+uko@2p?5EOv*YQX7%!~;K{n^hdP3v0r$CBH^b@MNsE7G8p7O6GsQ~bY=1wl+M z!j_#ILQInVyM8=-76M6)kz5RCj9nfsnAdtdM+XuX$g#k&a_+1dCmsJ@R>BzzJ%YOx zXU%FKj)kTPw^nw}l(}NB3)2mc1s27vdZ$AEec}0W{5iv-Z!q1kctDAP<1!3q z_`K|xH18FSh45aqMNUr z`ZmqksO~zYUP(Yr78LfbpCwoDS_*lJE))pa|L)KtCrj>riRvJipP)5?XU@HJ1%(+X zk8YIpXEaE0J9J)PcSE`-;C&c-*a~B@zwH5NaDtK6!!i9&;01$x)*+5IBzG+uVD$= z;b^1F!Ena!#r3N-X^`A_T^;0h&bW^ib6q!IZIwy2O!n{6_}}8%S|lbH_^%*{$)iH4 zsd(WZMFts=%F=t{YZoz2F6(L#QkbCCy8$>5T8Yt8HqzF!kQxUf8T+WC5q zew3^7M)CPq)7f&BG#T%8eo^WW0Q>K3fvX&}j&d-x=~fEsdS<*?oWYrmfnmC4y|#`) zR@;qKaK*!*3i4$wTb8rwMJJV24Mr_p3*-b68D;GcOlkP0R9H4sT_X0;QP4?+XU@H> zWoI~Zscd5JO$!EghBJPLcFp=^52|fJ{(_dmPrfNKNJIQJG0;PuQLukjn9c`9-M*DU z84DTuK5;RyGMwqV@i`Qu)=fFgeFfC-;bq{ke7mxF{(nt@KYEprRb65XM?*fku3QVc zoQS98`0;R8fv*RcXY+y9DhYz+3?eZTxJP`9xRAKmcJ^aGV zSZzh-tG@)~_>Z(}?bBd8^!Q;>_RF`H&h3X@tH`xm@-oQ zJ%*zpAP208ivGFk$0CWho9C?W(qFZGW$m=jp&wlrKe?4|87~?ilD}%p`A=;h6g3(C z*@O7+S8q9Av`=f_ihH4%^PhtJxOdGZyVD>ussfkRPLn>godKqHJxpyJOzqaSP_=a%mv14Y@b}OH?FU+KH!r&uDj-+C1LRX}NSNPB z-?{Bm=toz>Nvc0qb$l?-WMldeYB({)SfF8j7e~UB95yD2L+YTtvHw4Z2JV}5)`4N4 zR#$b-C7vanAbTf2RaATB{6o@k!TJXecxHk;EOGLZGROv9unk|$ww^D_eY*Nl_p4m5 zX%AK>DVbm;yPNsa^Iu7&-+vl>lS zN;24Cv7>7Cq^0WM7}EjU0*V-jM;1Q;`DBL2Ca@ta23}^&j6YUs#Gg!4Xi%&XVIba) zz@n3vKr_+y44_o;(e>*xuirY?!@#i|;)%~ISZ#TT!zaP2k)WN8a9j2vYzarUMeu-z zD1$3#{tpyxi)x_3Mv`6eXm+hb*cA%03mO|Wp;OjFQ$YP>aJUJB!wnX9M{UhA*)C0C zz~Q5CG+Q>oZHWs5*#a{LBMFe?mq;{Q79nh*V(bK>*|G~^3rg%z=9gGBTUH@#0mln8 z#3UHpK==PqW>+YxU01ik?Yc$1*vX29*#apA7B9JCcY5p8^s!LNi_i3q3$^n%$ zuo6Y7A#jrua z@*5mBvQig8et{If>qM$V80_A@%!-OXcu>-)I6?VCNrubImO4-gC8A`JT^Z*a!VV0keaR6lTNDer#iuL?T3Nf@NMA}eVNxV%*QaOKFGV=Ebu)k`wC zvoSE7{<(_7#?)~3KkzMyiXdGswjU0x0tN2^qgQi_zaC)L-KW)bYDIb2Qn`u+6%2;R z^}`pZsd^V4tyb!&de9j9IaDyjZEx{9xrzldo~%|{(NmQk`l^w=OPzraQgiInYFfcA zccWwqC&P)=$6m9niHcqay7B(IWJb*5eGY|}3#Q5|)?>B=xF&&H0vrrymfl^+bm+9R zB*U3k1-B$vSFLW<+v^(IZe+i_@b|+t#@kPTZgxLY^ZTzPgBZh^yn}}?OS9>_U6nQB zdYRTOzL<+`hY~Zx8HIlgN(^Tds+z>r7*E+JF5D)cVLzvI!nx;ZhC3A0M7Ym$vF!Jb zV*{zI1FhK3J6N9U%yT4IY}c1<-xfMID#|gOIhWLx*LKHK#+yw?>~%-R7A}o~DXhol zYN@hx+)~$LIHPweuzUno&KOhypmqexn6Np@m-`Y-~J6h=B_-+oO!qTqC|YB;BNMl&B+OZIw{=@YDJ6Wwv{bYq|16;d5J<=V~6kM zJUDiQ7&sgy{*-KyKWD|TsQY%P(!WQF%nT9_r5TtR_2q;uM47{Lr>4-z9<#`(h zF_8G7f+gM#4}XTd-@TjnF4IS)l0WJo^*6PS9?sJCZ)2M$7;ww;@|=J}pBcm%_$=OD zWlZte@ni?vhWuIL}+Lj>kFb!VG*CY>U5X)obg_-mJ*f20E{91~?Sh zA!d|rk>?X_e!Yk7V~`)?AJz*8qdDXluI+H|*s#K&`{31s9YP@>yS#TZ&R>+U;ohP{ zztlQ!e-~+N4*bEc?9JMlD9qr=#=s!7;Mup2i<{CKLsc30EYjrtwg|nAH~f;^ac!$> z9oOnmk!c-wCsl;tl^lpc0*9|ULTVHuHEJZ zMZ3I`x@@FCvYwOvNO~)-IV99um%vo|;O1$Ki#ZGvthqsQjy@VO8?4O_L2PRAPrKl1v)A&dHG9}BAB^8RuF zA{*eaZ%(1+>`CFTQ>SE@F`Ss7peCYs`A}g8KMs$8)S$xH^N1sXD_lZgvSk*DPjH6x&E6rthTMBf& z1r1}Y0G%YN^Yzg&0l81RpM-*AKmB3k>j)9vDTm(i&Y81r(hQ|dL7+g^6bNBh)V#02 z?|Y=Pq9OyIMUwig6P_;MJ>DxpC!V*zNz;@l{o~%TA;3kH!HbQ7q4kqJg9<1{KiJF6 zx^Xn%P4={)eeWGy9;87NK@(RDXc3Z#EiVI~h1&+rN-pn|Reu&v0jEWG29Pb~rJw^4 zL8XvtzqWqMrRfP53JRPaGtL!irdc@r0lea>PN zP&`yKXoAx?%)lFp?<8HVo|`6tZVOu6(%U;VLFC^-g${lr4IO2$|I)#!O}E_Y*Ceq6 zdd*WA{C_`O<1H5+$D!Uhm%V(3e4-jyoh}1Es3cf+;K0Jp*i|zOLpdS(FN0mo-G4h& zDX+w6Ljk9aas!K@uhsg)CNqMQ_!D2;EL9aS0p-)Vj`D)9BdSAQxR`bqZE2hA=sdAh zCj^w@7*aXB62G(gol^(-UNR@CYlTAxTL<5-LzZ{bc?0JinYLENCh)}5sUaG9E#E;Y zO>#T?R!&fKFlyOl@wG^0YYMX5__TOh*Jhd2;7=*MpdB)N7IF;Up!R>+NpBXgA8sPt zx_xqEtM>y*MwO0Cp|<8sgXKr$4qY%l5cH`;n*&r5`sD;q+5!quT?Q5gJ_%(d&}_6U zgT%t)JS?ZD1tu?)3pm16S*39*h{;1o$|0RsLK!q$E6>0U-7PiO?x>|510R$(zfq0h z`+{%EJaB$m!MBBQp2f8LH_&&SHf7%?eLJ}2Kz&vL6l*8Ly&{% zqsw8}`n!|8Bb0A0ynkRWXkQIne0`>K^dYH}$EFCqvtbZNs6QWb@#QU{YaV4U%nP1_ zc24eRPypNb*@~O9=|z@zqT`i=>YH?z9C~i(AR|#2#gx#a0XolG0leeu+zRdE1!6+w zr!|+(-n~vHjUnhY=nBDrchiD()xj$GeC}tqImxQ5VPH`Xn5S4K|0VMXmxIA^(1Mz7 z(S`)jjwl1L%5!2ZrwkYSPj&J$@DtlB!91JY>8Szpgjp{e7B#)JJ{z#2S&+epje#LW zj$`U!9*3-TpV9Ogs7MR6Fg?BLv;yQ1!16+9Cu$+>C98}B!Mt7pAgc;U2C6My>N+{~b=_NTk&u&gx_I;YHF2~*Gi%cLmG ztw~4ix6tm(tJJDBzHI7va5yqQn#HERMYQ3{r6tN&`%01-4s5BJK6yc?+ab_i8qlfj zpcn*&CsW)izuK*!F}s^wph5SExr!2nTbPe^fKP{(1Fx*{X}!p8UH9FQg;3oa4N|Q&VHd*+i;~yvZGn#q_S2*j|Ky>DsD(3yM0A!m#4hK*0^Vp ztdrbB4oDb+_pd91_qcsfe&BHFbDqx;vExA!43TZz7qjCo`RfFPNF_13|Fi+`FH`}i zl0MlR?7b2Ur*?h+tk1twkKY2M*_69re`jG4w zG8vOWvNu7cj}|C|nHUuQ@`88NUYYUWiOspQAHOhggZX7l+)N7@{xR?}+*`hOh2g=I zl^MaGcGNNmg7~1lI`-$zZnWB>S$W5fft}%wtp1+9qrlkdx{% zVZK}Xjv@6*W9@|wMP^x04-#}E8AOE=!@NzJl`@|jYcDvI&$V{2yeeh&HYl}n(uWK0 z7v5*t5Y%9(B+3xkr8l8$<)$NwocmwApK8k6z~;X!g@KbH(qsd_lwnGO7lSH;oTx#$ zOvQn-?B5*07CsHhezC=S>Qm1{&infns^`n7f#O00$*k!NLPm=iFFZIo1=%DOhIvZO z1|K@^)hIIfu`w_t$eUb~99F0E$QZb(AiM1Ri+;_kCJa(G zGmRL;kZf5W9ylY&mwCa#$(oAD>X&E7GWje4TaWO`14RaAhB(om;5~V;P*h@wn_%6U ztoe-j_kzZER^<&vt4vGmonDoj=r@Am5){)yAR7f1RC*p){E{?_&7oO6*bMF~6jPZP zqV+-j2uS^_4DK<2+u=!n{bzla`|6*6=_|+;d_RnFw$U}ft+gvV*h}xt30%3ssRu(VII3<4yR5yAv za4_)QNN(e6bxj2ElfnIw?vRsn-ndv?SPp7cZhRGxX2oI)GNt=YqUFubf(8C3FQ0Zv zzPgadip3VxA7PUh-f|B~yhloSjt#gi?fu`fyP<`-)@xpz+N@8{b%dswr+aB}W@~|a zAl?j|4171Tefed%x(|Wt_iP4920jb#(`%NoNa(KC)DdOyXJcSEk?^2(!;DY;OYhC; zl?AJV=xm|DJcI-qmj1Qmjsma06lSO^aL`;J z^)XZXwfU=4iEIj{;C;sR42leO2Ue^~3A0wY!4MG6x9W`BO4E`v5r;GQ9trop6c7QW zd9a#y8`hM0Y+zilPG)lI;ww^CkPFZ|*{oPtC6u)oG#Ki_rk=^2Xfo6Hs%n5}Ab5|Z z)30K&E$Z1X(h|b|&2ing(~_x2P*EA7@;l>-F3G-6&vh8)T)S}gz`8${-5RqesVDU8 zU{FPVAsrR7b>SL;k$SFHH)l)n+k&-vbq^M(qMIq`X;Rsx%yC` z-yzW5a|@gm%wTM%&QNzvcG_(v2Hn~3m;+M7tk-DG>ltqxu4smTTRq9L^peyrv3WBWY5r$Oc41Iqr~~any;BNm zeMGIheK9cm#f?5tgTF$$$)!Rnx=W8S*+m+>k}jy|I=GfuH#y3gU9HQdRkYy>)3FYa zdl0rf&tvqy`JV6e%E{L*aK^RUcSGV>i9vy(F4_Cy(kJV*+a(*W#Hep=!wS5e z@$zzs4tY@NQVq(ZX!%_MZnIPWZ;|JDPO|%yreqf`=06a0&9p~~A&`xM;hBP*Hbg(9 zCC|#Rd2Q(tQwCLr73&&}cV1+l5TWRQ9(jfG6zSRvlT{QLrnhbI1)UA7@K>Fou3NfR zK;+|JKWFBK$9H5b!#XbPIm(qdyI@mW9$VSPn&RS^odyzy3_1vvi+8mgT=Vnz^9%P~ z(vMr@E5}-Q&%Aaav9-T{snZpn^;--i47HI}voIaAll=wSp6Nd0^eh+dOy0Q{`fE2` z;c{p>5hc+h!JvkudNuo!M<0Y_v|DmLqnw|wefxpi+eEu1_pvyeavNxGJ`+RqeB@Lh zjz|T)3B}0|4)W;idm$&<1KPKUuciQnaQcPko~)pTqbuuv?|WJaA_4DI`nPqlxt;Ye zS62d!i)@SibZrOw)}u!^s;-&%=7N0S<+g1trjvR#uP$LR1&wrB9PjeGK5c{BCg*z4 zNpgHYj)VKm<=~}8o}eDo(hVxh_bpx!D!WhV&>^Tf{~HuRF;@;&8(FgK!+cqXD^|QA zvtv%bpS1nZrao81_{s_geNZ}^D#$cJc&_H3_R3xE(hNat3=9lKi;P2ycAftf02&35 z{o-oTpzy;gNcyVU^-sH>tlh9CSr9SGpmjkRREK~}*{jmyt> zNdKUb9q<3Ch}y0B0po;E?56}uIIKXuRqy7&FE)aFUqIt0qG24-rN2N)wNZd~mTR2a zEYK-lpphx>*{*JWklN0z6_(`!6kM2H*lQoo@w+)?4v12NSB>N?jSAO- z9bUe_lO`NkF}*8t&k5bX%Ra~l6s?YC0re_h+kn)`K+5_*dLS?9UVr=Iamd<*$`5`j z&jqy=_`qd+-p^Qwjz7!{byAF@8mnBPbJPdHGP@>bjln9mPZc`bUrxxUw*l12?N{l$Oi>Af*&3+ zgZyj25cy00bgp2-G~e%xY6mZO>AZz(~!S80s-Z zK9RDREM0qxUDhdeiQL+UA^$er5o64_St6exWV80tNhvF<7tOcoF1&1ZYA}4Hz+jmR z9X^P0Y7dZH>7IRSa+LFP2l=T5x*bbe#sO zVL>4;#!%<@hA+(RgHqFSc84jw9UDXpPVxSqs!m_z{kpuu zKXIZwLkJrKgN+`jE(g_&pq>qS>sb_0E`FEE?&q4jA}z4*8YHLTt|7tg=h9=gD>nDF zYDuy1Gc4e7)O>UAz{!_dotlf76r~ibUT{AznQtlrDnB1(mny9MI?r`+j@LYma?nx~ z*0qZmeW&}LO!iu>1j=`h!6jVzRZxq(XJ^2FTZg9__fDSuZgk<)`$^kRF)d;Q6+!3J zL8E)=(Z^?GpNVIRiu7a+S*35BaJqk&j{D6iHliH2)^{02GWERDT7TFWT1D}QLmsaJs*C$5ZIdDkzLl1+{5ffq43z<8)O?+e=jFM>aPG1Bs2y5-6Q>fLYX`Mcb) zW|8J>?bP5;au5^58A90@u#|?N8Vjj3Y}%xzwY{$W`@8@C+fIjsF$CFz-F%#Zhk@_L z?1#tL%(&kjUSt3=b2cQNN(F2fg8ps1a^na40Vfrv?fU{jJ*dwbx7LI)*aXLXQQ!y7 zZKQwdOZ^HSQg=8AHjy1m>8ir8^!TmCPU@>7rz|#gKq*@%H8AMp7BhrwJ|P0?<0F@; z+xxbrgZdDW&gL(fmxLL1AAr`F`k;{r(#lkIhPp`&2>}IFA)7VavlG?{ty=eb!nF&D zrBl`?OcHb`xgdV-rQK^#K2!jyWYBrb-(q;MGcAjE?)Ghmy#=OatbvThFeJN3G1Of< zpC%A$eNo`$ged3h1&-5igBH@|FebZzaI@UUO$gND}IViTjBpL=B8pZL{! zk9tCnhB`wX8|!j+&;T*pvt2jdO^CeiTD|Pr1;b?C#g-lYA4@E=di z*)JG)`ZgbU_(SQzQFc&|PmLk*Wt&dIu}T^XXxG8qz-?o5B$qR9N)V(r3e788-| zH=cqABtFVBME(NVe=?UL<~iTY(%3EOt4vFbH!Qx-_|%xoz)gffAGAkk&4g}+z1#U- zf|R}#1s5fp?SFb-?d!iRWo71E)(shK-(3nyJ)koKg%}cTOVp|v7%n=-TP***hPg*j zQIjDNQUWjH`^F&QbXQ*ZBlk++**IwHw1aCqWIos(oXhP5Raa;P}3%Ecn`16VV z(2NHz-i>bY+GB$giN2JXApTMaV)+%~FBd<)9ma7N0ou>TTnPrcj4H zIbS1Zt0*u$OlDhq-&LjhY_Li4f?20uZQdp#rhP)Zsc8AayoWnxrzkQ!JnXfE>0rO` zOq*IOA%<`^28MG+ZaQm@%@djbprB^2)if#PHjWlW1{H>fuf-gU7pC?leVX)8Nh_d9 zG}hH}l2Ff_6E`L+>6p5`nQ&J}UYX$`_o0Q20Zc3fvi%iHH%N%gk-MsM>Y|h%x8P%@ zWQIB24})|WBpDudvmHAg((qz|{v1$fTw3ki%jq`>)U#t`c+a5AkjVCz@zt|+;KA=D z`*oH-X;BnlXZK^#|EK@`#F~Z8la3fXdz0$(>yRL*hL&OAP4>pe9~_u!FK~=SeS0AD!*xu7GC)o<0mX_c zC{{`?xU=%l&*0&bgT>C86j))=G3#O1AJDn@54+QP)=cp|IeBS9PeQC~1ZPJH`--_Q zE*BmU#(6+z)toqu8#+j@&H;ff7tpp`fNzlnpe`gjRn$XxEytVCI3O|Fj zpNK0{kKjTEIfj>FyOUc3jxLj7h+t!2*l6E;Z{f4aQO@a?xPEL%ci;t#{S>RXsa7vyl&6c@8dC^tdEfQ=z>L-(|E6>1O@InG8e4uTeww>&#b zJhESu?7nKG{_(@iFRjW6JsJuOnSp71;mllq{aIp9Gv@BUe1R{Mcka|Mj_6vjxw9bV zf?dC^hq+h!hec@iiyM5eJfAol{1pU^Oeip9<|mbJFlrK4eehGcfknpXH0SB%w?n!j zSyF>P&6s#zS&<>rpJQukvtll&Ce&BVdJ1dxWN2LDO4J7BDM^OR^BcdNVOVm_(86Qw z!r6_oKHw<_P>O`O0qi%k1%H&`_LXj6KcLktl;&}BicKUZctXxE+|y^L;(XA3ZJGWj zT%*h+ElDa`uhAF*iRj6KPbjL9yLQH{Gvvf1ZBvow>hU2r_P^u?uLviE``RQkCa z43luR-6Rlgx9M$D+8*^bvO8;OCp?{K1FEZy8DtqE*%)w+fr5HwN$#Bqzm)gzIx2B3 z3Rrt6Nnze1rY3fWLyMa3tLBRuyz*rLk8Px9-D$R(Hp!-s!@F@xn-Zw&;1RLtXG!%U z1}+9Zi(`5qOH(F+Y&|}Jy+cs{wwh_euYJ&Qn9rHgPc)q%3l!?6?_s?x@2K=;56G3( z;8qc7eMnGvp|_ftCPe8gSFYIr>(a4<+c_k+oF>~W;_^<(y3_ni0W>0XEJ@H+VCKm> z&rRl_>ERX#D|ifBQ$+>zqeTt63S1RHzQER7HD$P@uykQX@`HmDP6;zau`w`k zMO3Qb@3bE6UUQ$zAxjTD)>BJb>q!i~|GGAx>wn{$LSax_X~RCvKkRo7%s4Se>wL`h zhyNL5K%xPsK~CCk89Hz0y5{r0u5MxqlRH^C=edm%NOl9$gjvlok}KJcxjYN0e71|v z?)7%4(DBN1$`Tm%F)Vqe5bk!8SqrsqJR!wD?1Z*U``=scKVmc;;x+OJJ^{1x6On7{I9L$KfoIA7{(B^c+Q>WDxh;VyP~$< zS^39qD|KCx3}5C+Nk2s1>3#($8mir{(vkAan;PU_M_ zMzFhN8R{J0sq`(K!T+Y2%_{bd)_c$_*__$R?x9n)tZhJ}^H}6FfgZ;~M|ZvZXJLN))rDnGUKaGHvaYe2^x5J(Xm+;i2@lO4duG2_N z)b3Yt4ZNc|UtN@;?)B_L^%kc0AiKID;ZVaMjSw&S+7KcW*K`;>JW{}%{L79(A5_L$ z&DoH?(0j6Nq@w=LrJ!*cue_J$t^XT>7#F{ow`QSnWLDwDHThisL6cqJu-9a$JGJad z;Th0;-(0=2sox>9mlGF564_%L^^I~?Yf>hFYDEofYPV=sTHQ$ox!%PXu2h?$u8Zf; z0p+UCjkWv?F>DMB7aW#%$3C@Hv#{(hE`G8C79E~z+WE94RY0|+7Lp!>YW`fWd3@g^ z!Va8LzUTu}++l#CmVN8mPjbR@=73J6%-EkacjYnYZhD*6uNR=L0z<4i+Raq`+rMdF zo0+u-x*gxecuo7cCHgX;7Mn4Op5v9V@X$%F4gSHu9N8LQtKc8}!hI5k3?|rhfx_vU zdF%fI6sy1kW-|(obb$IXx(s#E0$Rs=>_WK?&dFl0%aqJxo3SVQ#nRLriW|gDnZ5EV zH7@aJ?0mY=!#JS|9OLNf+s(E+&z^K#7D>-^-;_k!c*}miN#TgcgHe8W; za;oD>#qx!W2MY80WI{vdz5Ku+k1P`ydnn=BpU1^7@)vDRp0j=8y17Sd801h@Ffk_2 z=lknhQr4qv08S`HNSXg9%dth78abz)Y6&wXWehJ|J2K4m!}PCu3( z;d02DcjpqMDpA_Gl+oj?~1pF*Vt3zE*33-&W@RTX?oR&z{}bu=DW&X3nZi$vloX zu4fw_t<^(V4^Fq4zfU<&Ogr#p5BP+~(@1Sw(#Bmiu%|Ilii8dxsPQuRwEUKp)5NY4 zlo~baBlEf$w&d*MH{hHXc3+u+@)U_^tLtIr%M%q03?lHrnG`M8Wdbb>X3SH^Qfj10 zn2Evj0VLH=x$`MtiKKz;d~m5R2djm^FHiut zS<5ln?V$E9^=58p+cp;k^+M3+cfLYah+u0at1^7Q>T7Fr;_yYb*~_m9GDk>Be7zL5 zR+(*s$>xfQUl)rpo?%$>Oo;(B?#Ksjan5`xAW|wY^^BW7FPJY`!qH_FF|9Wa)c!%9 zlR4MExzEYKl&dFGk;86I>B+~6Go)CLDfrmwGYF%$Cc!P#*$h?;J6jdXSYo!wpR2lU zlsqHXy~KHr!adKZYrKViS5BRYpVarF&BAfd?(y-uOiph*a?DK z%pc_LC7&`b{yl;(;8{pzni9C2{A_k< zYp@EK2`Vz9)Oi><^WGk=_K7^U=hDMs(8@m!P@9$&v{XX|;&K(n#;7Cg6K|KkV`zGC zIC8p;T+_vkeEN#Wva{dne1ga?OnM=2_;4lPl$D1;`{L>uG(qZCmim+_e6^k>Zj#6F z@p#d3>Q(7#` zzxIlwTwhq2=oO_hO`TT?{O+s$?|OhU6oVi`-75vHnOFHZ%^0psZPwa+F`Pkwq3%^e zBy`b9-^ooEFKa+l&EA-57CPM_)TMNdz{1MY@0IL2J}d!^C~DWAQ@VdghVfX3DnjL5 z_61sL7I$8WeRMps45sSTvL~Dp%5n_a2z8;;4R(lM-RRWvOm~0xkA%&0r~1Lxn?MF! zlt8HnYc&g3TE(q%;*z5XS;Uc?R^UFk>||K-9e*?4TehUC~76kXYhUGnDXMzWhpBwkF}x` zBta{vE?Ok?%mA%rd6f{ESF<%|7r(>Q$hQT%`4&yOsj;<wUKt&9ck|60w;;Pgx&+8BOzUGrqj#6PTJall=ogZ1CS-e|1pyf3S zlqx>XytW0jq9IWcG88SvP`9Cb8sDmG7dY=t-5d4n-kkI;0u!~ISS6J66hSArU9nQL zzQD^Np0-RQfXDS6$r{Ln=n4Tede zI|zguz-H`>J`m*e-YQ}m$PD25$$k;Y#NL2e4XWHI9(N51ofIu4MVrQjpoV!O^19s2al2b`lmEsy@WhZiJg z_u_JgXv3A5=Z6`j84@SUW`w^Ks=DqNVzk^Zi+ApY^{YFV{Q(V`Gsr;BnNMO>Fum@% zc46@XUWw=~Jy+(-@{AJ7N}#baZ)kgh6%@|j6d1T6IejD3gjugaD@E-=D@rEIBKNMg z^1nBWgl!5Zua@Am) zVvu?Mtm2nETprwnFgspd(cih?n04bq$7((UKZuX; z;W=dnZ0k$7K)VCx%`$oCSPLGTxeT4_5@is$a_8G`O%V>z`Rkf@>Bv zhI?F|s>Q@hD?O8O_w500Ja*J|du9gfg3DyiT#$z4Y=<1H@bS19ONaLL= z_g(Yc-4-TB=w1PEic@B|2U@fw&&V#$kj%!wFlk5S7e}=X69e zSZr-O7k&GoDu*}YVurIyVNxq~pWBKh^l&JGRh3U%+F+%ARmv(qw|%;TjzifMEA8GZ z(>}{_gJxw!8RmU8cd=T6G({$p&{M&n%^)Wez_r4y=GLiSf!z#g3_-=SO-m-*Ib?}$ z<~a52*nwurh?+km)~AH&9bvyf7YzxbkPespv8U+ z#tie0E}1PY!ol;PMKLsWr~9raY^+So7Kt8Ti&#%ZIv+1Pv{+%%F1HE!)Y$+x7={d3bX-iABBA4PC6E1WJU60ETZ;rZLLWP2uq$p;$-K9HL#6+-xo z8CE{sCF{ZtY7@>&e*c4kg+cDkB3mfG-~+gf6J&_v-zzq6=9P#r*;A+Pvw_?Pnxm3n zhy$<5-_xNnuQF1xf?>%Y#Xynrlg||m!LBh}EX<@U({l!UQi5i zlbBgtq!@Bc=lK(-6+N4JUn;gTJzd>+>y)iNgA|IHy?;OH*{%N6?gAPcDK~+difSI? zl5H|vspn3zPPkQ+WT`IhkafDUA7bRgJ$~;hL2X%HhIvO-%ryig9;{laWnagj#_+G{ zhU}W22d=u|SzAvnZ~#r-Z{|R(WfFk+Lz>~=wT<6aT<8SNCh!Kl5YS4VR$R1nrmIx2 z6=)CXytX|IY@iV1)v%X_o9XiL%;~JDj-c&YTJ_L2fDyw#*v5vYlV>XXe=RqExvE9) ztj?#2mg?cNB2)6f)DlD6B>@X+On0xFTy4k5@Si~rX6n(sDjPRMr3Ng>@tW5a*#Zp{ zbvcHAZn2hanL}LbVatDw>ltUsKW41N3FMU=WB43H4QCJY9G@1z(~ z*%%n&pZ6U+_#5OKeujT)))&?pIZjU#`*~uH73c=2d2LHpnU=7)95~J3h=`>6&0Zp$ z25u^#yQZWW;`n0?yG_JGYC;}#rA>9@G+vV9HE&IdIjF7xr9@#+{DKw)wx)<>`gn$) zb!hyg%%H?@b2c=VOJ+W8S*nu&)hg%zVdd0suRYe**hw(JSJuSNiWE5-pWVeZ0^6jT1KlJ2 zj@&CWyja&)v^?jK*YDCLVQaa&K|w6R@GlHJ>on8VGU{-v!VjyYRnm__wCDE=gJiC@ zu${)|$u=3IHuzVt8-n5bUM%Dj%?wKaAep!5LR4x^;XU|6=P-ATWj!*0&k zZKljTUNaOyTemcQz20xAnJz2}T8wb(GlLexzctwpeDc09s+44=1@csX4KnO5+Oo_x z(iwa)3w)szL$V7f%xXaE@A>N)lo;v)_!-hb<-df|x4!O9DeYO{Z7Y>V0{m+sGdNcw z>Zb2eQedcK?NK`QFT(Co>w-I;zhtkja*$|Biv2Wg>Y_k1)qd?sEDUl6ZYpvN_aM8M zN*Gq^s!t0B7490IJX$?}Kk5BzFjP`unCJL^33OZ2=~C+_yPiN6>J}Xm=xAnEZxa9i z{;|3YEJwN8vK?m(S^TPb^cjmV;Lr7&;wKJCWxcu*Q4d% z3(%s)n9Kx`yOT{zn!;`3(i0nv_pJC;bK_1^q_`%lGv8#g|Z9}Atn4#>o1(( z$qCTHH&`^QGiWh9T;a-K%&@XlW41Iie_Fyv*Y7J5L{v&RrW&5M+zD|TD7CwOw-E%n zrneEYst~lk{J1}Z00XDv8@m^mPrO%Z04)W7eq5J<6Fwq40X_o;nrM<*=)9sQ^4!U( zY;Jp>co}ym-B@j|$iU68l4li)FUEtL(?BJTR^pcd7h9}R8l`}!LEGYkga_=4n zP>Bn|0t|8d;FdJoBZZ}ZbQ3_k2;&)K8SbU9-wIWGA)uw)b7tjZ-?9aj<;3~RjaIelR8IQzEx=;}|E@(gl4PO>VI?0gYB&Q@HKvSK%T z^3B_Hn@DWb{=?Ov`EgKL%fxWUo|WNDg+ih#gE+Q*{!hH!R>61rb20q;|NnpeE&lYm zxbcgRdHZ{1V(wIJ8rsv3j$v`I5~yb_u4YO7W~cObjG#dOeq zWvdrWiaa(qj-Fy*WbkKDV6cOqPH|XM--qeS9lN@aLr%H&7a*r9s7Nr_flo(RWyOB6 zbNdA0uM;_Z8yEa7xOS5tBJ;%CO>6D$tW|%`GsuBO`c_E%GIV);ONl@F=!Jg8sOw^! zTr40n)If7t!VDg-JQV)^xP7Smf?i}+!|hNd@GUr?^|1a7Tns&a9&ZBv2r^`{F)-*= z`h90(m;ssv?9yTYo!;raa>HMR)~K4mMN9&&5*^0{grE9VJ56Uch=@=xb14k-gf?5v&h?(d$}ZBIkxT$(tg{%`JO5ZKZExsCI)qes}l?R1&-=4 z8SBOBujglC+gRRlEBEWn#H+5an3;A#XFxgTGpIAfF0NX8CBn09!-R&g588{ugAx~d zD;u=9%I;a7A+YuKE91kb3QjVERIYGpSn=_C*lX#hBG3C`rvyZpsz$0bMsBaUsO{R^ zrl(jTseQ=e_Iw5%hNA)o9eejolbpV;yyF)4LFNNdA_3xjYnvN{b+tb2@w>3sN@)4p zI5*IOe`V0Ug90LvPxW=QbgUe2GB7f{XV3tL;Yp<~5x$1-AV%I;rw>LKUohP9xY_n1 zEzyqk!d;t4L7nJCQCm$0t2gG?-YKs6&3fT(OH%w~oginyg(q$Z={eXm6>UEy5T>P& zr4O3AZD#<-jHRO2++zaE_s9P8Iw^C3sa_hmscxaD)TTH z`!cSK)9y?ZvJr`cq=$dzsz*M4FlXlR&(g{I=(_TcuM&eKLlzqYs3l^qy5x^#w;3~! z|3#fY{Q53GofV}R{ykqVzVu%{o5Z}3A7|dAF8XQkv`1=rk=Q*IIfj4Nml-!=SX-*bjFf%cq(Q&|HO11xVdf0Rht zbji#`eV&lRrVb^c!{6Nl-X)0qJGfx#{L4E)hnhq`;b#DiHL8J2gN7aHB0qCXPPz7pp#AhS1;J$~sMo^H@O)#Uzv1L>ha=OK8Q38?NaGuW6oZG?kuEj~ z@81vCl&_3?w}9^=sCbAH>~Ty4l?KWT0e-pbu6WJfb|?7xo<6QpgQm2`54)e}J`G9~ zYvxXJ+W5i161+cBl)=zD+U{M+7uDyg5*!{I^(y@eH%kbB+x}V%b3(5?^IE$l^R#X0 zxz{TU%#`LC*;yGhIbDdXFch78uNV5 zG3V~KxP_A~-l~K4i-Dpg5O%i2h79{T8LGGTC%rf>ur|B<&rYx_v>EDhmhb(xG&<)PCD8 zyw>G+IL}{+MWwkD?LqUmS`3?4X=uEBx9DPB-W_GZz;_RVwR3M7u`q>{w7xQ5w# z?Yjpthnx&6SALc{(w(c$z{Mc&fnmd;N98BIT|o6D2=g;kXH}kAqPk{ci-^qh`>N|1 zI3a0;fuW&^L6(7Io*cupLq_iem2@DDC#6$!H)&R0;R>v7ZD℘Mmu9#fy2djQ%y% z^P0kvYnWW5B%Zcy4l&6PtDKp^~tI*e|mQ?EZ1f#-k8de+rEprbSt zj_Mrx)@&`uz~T2+bXvwAy~@?%3^{BJ3=M$~CjMgcTqbgM`R&!Mdc6mH>TiH@92-OA zyDi>RbvYOeqgUm=UFM=7%&=2i^2y~o*_C%SzTOQ3wP2qrGVn8OeBm?IV$G~gQ@9k{ zgFmPs z0(AJzyHo)ihBdHi!T;^nQIFPCp!1|fQpUK0~$?- zz`M-VpnjWl#%W8^rW}{_+qx_B7yPvfS{?S*ZRPuITA(n`x@xC|u1@;#VUx+tOTa31 zoA@vL@QG}Qm~OLtMd)u(j!*-I^3oiyIKjk^9<|Nx7wTrD6;0qdALJ>cE89cmFY8TH*QsC_7vSVV~IQ_cO<4a%p0(Y;qGY)17 z`S78W?I81kS9{n#a%nT@Fc^#N_r5pvf%&cVZHjNV%6=0PpBBotV#B^bzruGnmTp`b z{p8J5jTb^~6Q*~{$%E}LTrZ#x{fDAgq$;#(HAt|SGJ?{pawx_l?(2|50072bM%pT{1il}aHYFYMB1T9i&` z=ReD|@UOwyCkm>PO^yK#6_pIy48~{E(=x<1J_%ysb6aS%CQki@T`p^~rJh=1WU7Nn za`5&OH^s6@OZUxdN%x53#b4vdluFFP@NX?)+- ze1jW&5~V)F@&Z@6Z7Uu;TnzT8s7Izo7f1KE*B;18!AAsCE$f)R6AWYEVlakexrRU^ zNC#_df*&U52Ii zHI_?oIJGKS|ESruw<&(_k);oPc^|nXcDntxba}h&*BOUr0$alyr?e&A&|}bN=xFaw zN{G69aHj}IjMTj=3cEI}F*=Z!c(G1)rL8`1ewILaSE(pN9vcJ0$zm_js|iMmS>lQe zdJM5YB#%U&TJ}U#P)rZ3OakJ2aRY82r67}A=N%n?PF%njzZNt%%%{X)JS~HPCvUyT z0e02qHl^4P0xjZ!EP7HdZ&Oz?Y4W-XK1|dGmtgazx0#!EfP1}5yADB$gurE?|5nu9 zZB>=h(69#;3rj&`$d|`Gd;SMVa`=|~V&I*Zqnjyr?qX-}R6nJ3K<395*78)DhC z8Rvb2Om40WOgPhG{g(q=HmNgstkOKZSw-C(RKc~luHq1V+wOeyf_+jR)UZFH?0$(~ z6&chSzF)0rKnL%_ z>n)834B8Aw1DVv?`}zbW6%32IOR9T+xE?TO)~;^B#65vg3d{l#SGbXdj$NLtoh#=*dGGbV(}n1 zmHpAH1YHQcVhYDH`+ZCP7F=t57|9wW)ztxVQ>NS%4Htd}NrqPyM9rAu(|-$asaoD85kHe^t2eBm)**ae_(#G zN7r@w6yKAVfAOs5cHG$w4oyGCnt-mf9L-%za=h*-%Q0M1fUI9_NUgZG{Bc9H$A+7) ziW7dg1Usy{9%l?nI~oj@FSy-rtykV^-E$#xA*1RP?is9VoF2jq1#AoqRUvCSEgiBm zGh05?F>XGfa_S4Hgu)fSkS0$OV`#*p$kc#CJesp7xhpY1UEK4MoBNNN)Z6E2hAq|K zjo0Y4Y|^Z>(Uq!d<&)$Ii8WzeQkCm2#PEG>vg+IR&G0U)LItR|pvVyU&MYI?uw<`S z0Z-Y5ssPW3Z^B|fdcPH~h7Nwpf%BOr!}Bt@-RjivYPW;O$$5 zuQ=US);&v))!KwH=rR~j^E>q8qIuQpt*%OP59PHm&B_fhQ4=|>^NR%y*On2 zOMyY1L23s_6MKWI;khhsQ!Z(#d#5LK?0uYcsK@*I?hQXUB#y)dH0knsy#Sw&#K<7c zPzYZC!^KcO)8|-W=0mpU`mlb?1JK!Ac5_M-&ZH{HIr~hRZU8C~6c{WeBX+RN6Le^r zk+$e9yJm5ACQDeQd~tf}i=}KZffU2Xg78r5j7E9zcFAmp-`Ct39CmJ(JrZXj z!eF`m93%g4{Uu0eDLR8voGe4+q4~l}w}P!-{P!s{JJ`%{kh{OhY@!<5s#BHEK<7EH z43_9C;nc91|Ejip`@(32xR$>EA`F_*ODiIBpPsyMz?jL)I&+q=SH(Zb*iWq_O$3OeQUALx`%g{sZaQ58qX=nF`ujzI%-QfQx!n&Q*{DG3jSD%==2lV)`u z;8#dKqh!vb)9ts?|dStZN*d-mK3TAQ|Ce5c6c3o%0rBxBdK6O=|BJbyo2 z!+dzN({#`(?!-t{57ACG_=b{+>bfAcVc@ckwTa8&+av=n!=nV1Ca)9~5qUCxh=MZRK74Q?SLxB2B|a=Z=j9o0#Jc zk$(yxQ~rU@d(SIvKXpTa!2snf)Oj}wm1-9#+DvV>4)rQqSsJ+PT;<%8eZnu9c^g3| zRyzOhI0?F|AqkS%PaVFRvD56Hf!|JWfw=khdInwa*{K&Iw47K^HXmLhy!W8Tl=m;5 z7-_6r=DTpF<@U`23MmTnlD2=>(b1anUy(tN;f!VGx!wORx28KZe8r|`rI4$Tn2T)9 zwdISZpHY)$IAh6uB$#Q9zNto#?^KORd5k8)QO^WyZt|Y1VBljoV<@&}HRlGonpMlZ zM3j{o&KS zo8Qm9ubMxVl>xMw@VPSd1lVR#$Qi4<4a;v#xUGNnMo>xSU%vOYpix!u`Ksu*ggxPM zz6v@mAAUxzvKV^mk9u|C+5rX?Sh^QxC}v{-xAlb?tX^=t-)E7XztH0Y!?RrJ8xs0D z4B`w2UTZ{zhIV>JcI&=TBw;K=YiNyD)#@($ZlmC9{Wtb)8e&-KB5IuVBIjv|&;71yrFIq9nd1uh;a_$QzY z8U;{duv=5Mctb<`n;Y4=t`D>-egyFNJlK$`T*7s&p<(lsD_5_{sW3zZcugu=sdvV= z$YrU6hQihC)TJ3qx&+q7v3-?TaXc+2T{&ApoxzxQ!X<{LmPeu69W^~c!q0;WPfpO< zr`2@T#4m9n@1(Cu0-!r1)EInPK-P(JtUm3qn%B#76)W%T!t+`k3QYIUxvt{a*!^h< zOUI=@8Vs=!0UIOr*#r{8nB<~AkPCBMS1@K&7Y+j}i6B4ibVD#OzKhpWSLuFlxsq8qlZK}mF_fz1+@fJ-|z zu8e+iX2C*_iEmdNa%NCtxa6>^f5q%sw~zO4l2g<R4xM&U&{1I!DB0A;5w@F=|K`T)w}K+ph&OYvlr9X`Qw`E>n<`KmuvRJ3 zmW`q2xANOXDxj1K!ki2quU>qsJm9_?v=_&pL7O4qgrb32Y4;paj@Sa{pJu)pT>ugB9V7>U6cwguHe2J26mce1K&M; z25p9YQ6FvB3zvjB*_z$F_%?@Q>&`Hj^;=$~NScVOeDLrxE0=Qs)BUTPn!+A}T@12< z;r=)s`P;y}kM~k95!#+`m2>~puv4@=B3X5=TU9;e- zQxH#XgpR0KNRDao&u+Jejvd?AG=f51wU_z+IX5=oAjbY9v(22%@Odd>foN;QiX3gHz#c=?oOeQ&(;6TJ~(&m6|a9#Z0dZ4{R?Ej4=V72Jm%P{Pen&alaVU8TRQ_ z9B|)l+_j8b?!!era4Eo8^1(-+b#>{c`_Tehr;GM>JY4#pK?xMflV$IoYxDMM$jHj` zI-9;VVkgt=u&VQmUdAktow{nPtQNyQjfm={edY_J_DxV{N?)0GwIGP`Ylp02a^w$r zK1NgX)Pr0X%S9Yh4jBtE*nN1sVbQNr@oAz5r^p6bI#g(Y+K!qGyHhHS-o#A#yYB9? zHCG$^0@rHkUr18*G}6mj$~4RM(58KRU4x5*!!{~0XfW7$9#G!sRfeW7eC8XhoC*wB#w+@$NRxt5IpuYxOk!NhU!`V7JhcCD^^*OkqA>heZbeDaAYn=~s`z~i873?8p? z)*H)$W&ku80!~akz_B}H*8@iRw?TV%JXGx77|p8J)wr@)wN^^7F_`hI#Dm*ABkWWd z_8A&EUC*3#$XRPaqzk74XN5{Ygvc63#`KpxQy9utA8<7+c%T4@=az%fjwTOo@06J5 zDhSF+0Zb8RoQ^E$c&K?ui@`1>KvL8?Ajt7k1nZ%&wI`jv$hz_|l(R7~WJL-p>8v=e zmX&pa(bD9Ya-OxcrlYDFgPm$`br|E1GP5cc@c7b(t^=;0Pc)c^gNExO8!vzol(~gE zgWVH`jYXn1H5zQoKxGfJa>UwA5j&Z>6rOW!eYNL@bysT{bMO}h21N!t3FbJpS>U7- zqMyg1>R>YM_qMC2S144jVM<(mEoBmeDk$$h*~rzhHfk~`p=dXyp7y9{N^o_aC--KN zmVnkHWt~a32B3TJ?hyjUDd)tsdG%_2QkVTXBHYE&8aRlSsU z?%1&A-GdmWTc@>r76gKZ1j8Z(wuW2Z3u0QJ6unh#KZ6p(z71DoI84O^8@n%Av_74> zC^CTM;z=pL#K^k`cWO-Bq*>{&!mv*-prC6%$0Cjx6E1$Inx36mk%Eh6xN>kW`gUuT zX=I|pmlukv4Er{OR97$KlRIY4wpdSF=c0$)YKI%EOe4AYoowbzd3`zTR4ThNsBHH3 ztY~t&0J=$Tqg0;4f@nsKmZ^&-+JrT32+iIkBG>XGDM+rqv+YKvGCbFkf3TR`Nyugz*M z+t^=AK_PS^LaAd_yP5{WKE1y|^8y52Qalm_VoXeT^PP8jdhCzthN_tv+p>HEC0sUG z8LWEEq^`uUPcN|Zfa~Va?2J(TJdVSg6L=!l#4x&sF>oa=%~0tNU9epX6o->JGk?xn zaC?<$q@YFXe8-wN%~@-sgb)03VAoG<6PUXuc=Bw4X(wuUK;{|RbSnw*iw!1qH+&mkUoYLagYB+=Qp%%lw>78!SELXKOBQ0dttl66qrbfsHoz;>(8p_|L zaPLipK~(P5S$t{?`wZ(j*MKT&TvIJMw7wr z!`qmwyi-k$OF8CnMQ>deamvf|xt{;}6m~DKhOQqR-6`ioZmcqO1f_kuZ>HW?z3)pn zwJe=BbtMB!Q%%tI(?<_m#W6f|7GS7kV_NGiag3=YF ziJbgDQ=mT}A}dl*E@+*9w5GV$VFq;uJ8c$|jo#CoQl6#qNOej4_VWymJuv6?DpSP= z1vRkPj5y4|!(ivVSEQ}m?S&kNz9gu$)@In8vi04IC2ON5FO6O0q^ff<=jtqmYwT7P zjSnM*_@AHnW;HqVbeBM4C)?LU44Mr4m>fMHAL~$F`bPZVCeg5KXTHhZZ)Ke$yXYI2 zw@LI?wT7>ad~qd9SwuliWM_6?2HpqD#WzRx;$)RZp?(ZQ7bify>Vp6KIfxu6BX3HbY12b zoR)soySuHtC!jc3j7Rl|;)c-dQ%Qzh3ZOcrv;BQ((>jNawi~-6R_)Z}4imK49qH9- zn5=oLrBN^~K(<1l>Clffbp|_7$)zbE=jeFb#aI;FC}HJW@ZhTB<`YSVV!0DEls*8ayl*SP*hb&vCZ^R?V5N4bA$YZzqI;WK?gBBY*H-lYgJNLqv=&fp#UBET4E`!X; zB95G^v%s}e5C4VNEU}FX4lUaD1>|B-jJ6ada5^t24@;b=tI zW<^U->BG+8@yfxop3?xl7D$yL;6$Tpw_8$0?M82X;j>|D7l!WL@o*uiOype9EUxe_ zQdhfM4wRDDMg=oTEDUCHaXu6q`gSR(C|7m(mVD)P*73+?qO)4R8iDf79|e%wjsHzL z+*??`-f;2dwNz+7R&gXZU0JmO+_tH)mbPVDR2E&Ec0(Q1cH1CfBGL&ev;-Nd*%%ns zsq}{`C9-hn~%V5`a(t6s|gFY8?u1ZDq{`5{*3Od^;IJTlG zfp;CqezbnfUH6>S3jr!pSF8_j)~fiiLV?q1-UkB(2D{Ebwab6#~OEy;EIM!nRLWK~dK zhePRB!Jqoj({n-uwfNdJ-p#HE6McMrua8M0b6Ca;p{D6KU(HI+xjO5Q3aCv2jxi0L zFs)Blh2q>+acs0!77gg%@is=~TS^3n9E0N*S=X?iAG8?ueJ>EX-I=Cd7rk|vf>Yyk zxrJKC)~^=-TEoz>G+?8mj)p7qzPYE9o_eWrGT4RWh)mRSN(9x`_6(W~n^O`?!G;Rh zFeFuoxrY5*e8;u9DreEMHkk>|q6{@`3=GLOkG5?VG+NQKOdV8?9d%_+K5*J4c@6K{ zS4Vk28fmS$|8TGNwyf3HSORm@rLH7{I)gu#X@JX;*7ij=SD7-d;V=2nbo7+y8Y2hL zvZxaIjiDyTZe3UvcSqpiLTd&)|D<%giE0jl3p9^TT-JKUQQ5l51>f&>>QvD;ew># z3uc{AN~lsWBxJcqE7o7|3FcjnpYo01J5YAoY!Ws<9wYJ zrv_?lxFlY^^85pv!0s!$4PshmS6fAQZMbr03afMKg#Z>)g*ZC~P6oTjKe$hat>yFr zy9t!)AfwT$p!=v$@2rY?C2)VSwKZ%!4m55C8Ht->cKXApBB%!>jzq6iFG9I zfh~gq_K~;*f!4;KXHZ5Oja#%Ovh91RjKkK6!VI-+3=Hx|-;{YQ+ag)O zdExczbE*tR49KH$3QwYTDBZSgDYZW(yY#Hlp7oCzR`veTNZamgwDfF)cSBr!`MdWv zpjjqGhJTd;2X;z$O-K?04T{ZM>*nafeE4U$5Z9xOrL}oX#-LrE{}~h+9*CJ75xtB{tArA$A{j;Vxj+!ZptwrH}d^fQG)XbECUhr*3WK!qn;ezU z7N-M@A}-6a^5pHcI`&nwxZGcuwAjN{i^p+i@L~@YhNUH4n{>_}6ghN?`PLc6W!8k)mzOqVV&NY#$9TK?mN4E6mytnH(WS6 zaoG_D(7YE2YcP0txvb(46+N)MxN<44SEt9@t@<6+-{x@rcNC~!_?ji$I~%>-JuN|I9rw;V*00G2Wk*3auVnZd(51oDtgVdmpjb<#!}GiwiJW$w5y7u z9}~CdF`6vgkaa3(uH8`w0g-UqZ7Co(sxc%uy>&}m`RyBzP0I1OY~fW;+qneH8vPBp zrZTFkIzUGy>r@yzjvsDMN-z@WS6sFsU`fRCfJP&i#L{CYxc)G#(-Ccqe%d{8zB)s! zrNfT~0k1FMP@V5r;L0qpTcmOG$ z-HP;L{b1}Q@%!CUeGY~i{q|6nqOKR9aXn22k5?=YGZbF!=<;q0`DiK8dTN7~KtO*Z zDA|~G9njPfxg6%WL*V^G(5~NdrWMCQgFu@)l!9C}TtW_davHetOxbOi)b%1&so?c& zleoS^uO2g~GBCLL2wtlUWU^Vkz#;alQSz~%ErAh>d^nESxB6OcNV#}G;=`rm44Mqa zz5;z=oJo3#KlvHzLHGYCz7Bp8WRiSDBysNa>78sf*5cj=8Fs6gbMb33zDZzEVOTNc zNh23mFh_Ifo3uZoQ_NrMUX&2A0i~tFuD3UM6C=VdGOIJZ67hfZuIEjfW{QH%p(<|^ z=_!+1R&=(xXnAjx-CfGPVCDs*bo0}owf##?zHr4puWdDmacO;Y%ph;Ui>%O)Ww^9}PfH#P z*w`o*mMmxdu=Mi|$)-Rl&8;68*B`#9I7I>6XVrnsrt_Sf1a6yw%77)`ZcRUWO7wul z-w>sOw_Ei^ZE8X|&bKviv?yvYthn<0zz6YN8xE{^eDvsv%~xAvIv_(93M)QjYO6Mg z&MEg@DQ><-m0|150|FgwS62!Kp2&(*lllM|ffeNR7jWPR$$1!fAn~-?Dh30FgdFy^ zcHs##+jzGy>u>Hm8N{?8iMxN(2YVSNq1%lQAF?c&a`MhC!((+n)7<#DR`Y8z7|-Kn z?4GLaaMW$$QLgiL%@sB*?V0{rYrfqQPyVH|^w4>}NO?(lh3o4L7xz(lw>49x@6tG_Wx+e9>gIV{hAk zp_Nr;TTd6)i3LVl(OWgFKV5py&QQb7|06?Om;sb-)fhaoL|a+iRu)Sf*ITv0Wf_lD z*A~zUjJq<^bc#Uv_h!ekIV| zxhleFVXB{R(UBrQ)(>xE;xe0qCMgvNIaUa6y*|%|K^^4(K=6vvAh88aEv2R%9?Eql zZajh(AKu1rv54~gQrB7Stn-UOn_>6$c?vetOa~%C1JCO_Ry1kEXKvdhJ;%HHZRZ!I zBYAJP>fc>8ZRb_RG6M!Ruz$KV1VRj6@CSOXSf;b|5Le{tjVq(ASr0we2)GGK6bq6z zXfqtYGv(@vhAN&9Z)0?p?ftg2shwXdDCMrKV*h&{amM@S+ypH^qh7~iyA&8C8Db~P zY@9Rs2D9(0Cia>w-ujp0s+&IKbS#3b3j(c;cq1kf8}dG~`Yq?7&58$tyuJioIDaam zT2i$sa0O3PV}80%5YvsbpAC)zS6TV;#}yY_No`V9x%oWhIJhPsmNMi>-c4^ zVx-Wt)~nGhhZwXNd~(utTCZ{*y2w>yJsq@sD4>yB)Um>``?^!(h7DCbTckiGwV8&h zsWeEfGh~@_@DE>AuOv|gfrXL`jiB@2ytk_`?Q{V5PQ)O21=Oq-cp_M`;yB0oHU`xb z$3W{=)EEq%`a5dR25op5dV!V8?;|^C0pC%bCMoS%>7ot!&xPjkUKD9G5MqejvQX~B z$-b+fT|pCL={{9oKr50|84N4DBGx8pf+{)5-7}n8mhSz=^6;jBZD9Jvo>-qZi`INj z`l$dqYe-_@f!WNU5#w!Hfn`rpA;YB5!26-yP?#8y@Kb@G;pXkdAv_(PjRK9#_s@C$ z1(yaY492ODkP?*<0Ojk5`*IVWwxl~dG%jFzWeDzW-vF;t&|u*31J4M@9E%NO(VO)l zhhxK(SBLJXxQB4DJk}JEIJS(t&EP|VxUf3Itv7!?HaEz(hel{@IwcS`aV5A!_~KB( zXf%yu(Os*~C+#m%a)lT)86Fs{;ImmEGIP@u$AXJ24>M9L!k+7!iCvESy~yC2(RRD3 z-);%NbQN#}ts{TWz|F8RfluD}Vd)O{ax-vgCB)EEX2W{UwG}i@l{Y z21`zh#L}$1Q(8(k(o9?}km-zwuD3Tn8Z2=+?`f$p^+QgFog!#Yy(zm>Z!g!ByK%=> zHANlKTPbsXk>g~Msna(;UIaR~R1Rd8sYHP=LlYYV1NXz5r%Mhp+ud6F?UuMi>7Vq( zNLiuK0B{&7K~;i_m*VwX95p@PZq=XITUG|@Be@rDohm8}s;R|5>MU8V9lvXFL-i?_ zw{EtG2K(7VDj+#Ekes9EBacAIC&d$2e#qgFP*yI13nDl)b)orD*q|CLXQDi$H~TQ0AoCi8{K)uOH{hSTM*lD2jqcH<)Uy#VvfQv)0$H zeDH8F6KH~^NAPs0<|GD227Lx4h6G88PivZ@!Y+t$c?uz!Q&NZe0_r>bTYK~SomofSCx}m!cW)j{br}|YR%qnuA4Xl+3OWl8J5bIKTZ%= zo#M>!r$+$foHs!%=YoW~gWUc|>U~FNk6ZKY-OQ8#LM6TTX?FmTj@jFvknHQ#6G>gpk zW6cl~TlD@)fQ!Z^yLZO~%}jINGT4D8p8_Q3DKUU%l^1tdRY-_4wFD?~xNBcYHr`ge z@lkf*s|xQ{rDdHT$=Su2*Ym@?>rYCt#XQ**iI---kI=ddSdLzjY*b5qw34KtqJ z;DxttG1ll*Zkqk^s*!u4f-FPqI{)ZewvQZ7yV%UQKb-M;%$yv#QUKymVPy2RDxFJ7Xr!}b)rOq>5`2Jx=1&zTFZRZ~|R~+VD_Gv|WIqg^hvX;YDQzO@pwynM}ZI4AsD^yhWP| zwm5C}08f8?7VmD@JY@<4Xa<^f^(IU9j};nK3K}3&M1Pd&wWSBTtm0^0aK}}+WpU_H zRp(VdVzzF-#wyGe@-1~^(NZOK2IJIKsi_yIoVDz52X)L>Z&)BVd&Npc_9qu4`ggp| znUccMaqBeSGElo|TE+y&R1?QSFK50JjCr6@ki<(xM>PJvb31wTe0vZRsF4mH98px% zW_a+fG~kdB@2n*&_V5_3=y7VuPd^-7{kA(LbLQl%?1(UhVsMWw>@=4SgBpYJg_icq z+Milj-TYW;tdm7$Z+EVW@B+1Uc*Fw}-z0Gf&f~qfTprYe&BWX_Ptb^p76XUhr5r@cV+aVTh&j$L}iH7({fCg2{EWV4{$ zv;fe8x+jX73`pX)A2(GXBa?nJVxHi+_8R&D6s z$Dqb=e3MekqeYR7AKs)UG*oD|uj!BA1dYI+{xoNz5W}3<>bIO?bN#d!R)9;19H}t( zg%8S7mV#z^c+M~K(A9R@6J+vx`_0n_7(NE^Man-{0F}4u3|0|NCQn^9-SsOt@k^w# zEA31?(`u%Ld%v+jCwE)f3wLC+=rd?Ce7~CP-rZ$W#=W3$>cgQy+Es8QMVm|F0h4;BpLSYtfjT z0J2|)p**r%wd2|InI|L+T_c{S^0-xqiD@^bp5AhO9z%_Fa*#>vuXm}d_HNZ{_>ic< zuwu$1Edi6WjlEkPH9a5PzWHGZOU8OzM$k~p;msOGvle~iD4ig3_?sFio-bTbWzjcw z^AWttEjBmlLIBI0R8d|~$(}h0q(!f7Ifo|0*0~Fq?S-agG!<-#y1(RO(d3 zy*o~P(CO-Vc)h>f;W)oRuBa`j*DJL#b#-=M^u>k@i1h}K1v&y&Zd??|&i@#cOO>@< z`5Dw0WGr2LSM5mgn0mTuCTM)+{ye2fUzT-E?fgd%h&&N2xw~lEJ|VwIcd2F?s+={}(vg`xGn7_| z>sTE$)?ip6ZE#l#rl@>)+q2ZslC@*1^HF!J<^6@%LnmsoD1~U5YC(JM zH($-_`DCPZeDmKP!QcP|P?}g*wf#j(<7S>MU2HYh$wH+GnheH`&R^!LtZ>;0w(_$t zsFzgD^xuPA0`u!>o=W5Ha|y|6*DlK?*drzqg00<5uq1 znUU%VYdHnwlt8 zO%wH;vCvgr16((=Gc4boF0#f1v}PUI^+FwOF^4tocJ_u^3F*$Jr+jg96i9Z(Z!L z5r~__G!@iy42eFx$q2L+&@xCxa2O9&!IX6~NabxtD&1znURd8k!r;@;w zTiGCc7U*$2(*MJt3FVX#=xB&}y7*5zIVSb@db3TI{ zWIW;lcp1vXbHBOxCG{3L6(*OwoX#cc3|p~4Xy1n0)c1whHsd2b#e|X!&%b>yFp{lo9?!-#>rxjwL(ndwqL03EY(hgCF2>~r% zQ$D;loVq%dHTR{wvrVY1@5gz_?ug&StAyOGs&Kpg)rPd$I8|r-m~mQP^9Lp4?6a*=e>wa zYYv)pVEg8YQ;&6M7X8<^I(U*#O`YLYgmF+z^;^ze4_1opHg;k=^t|yy(}tV?uSvYT zJsrC?bX}TvOWOw2veaG;Y3pK^-*iz3Es&3;WtNBEFUrc_QWQgP2@0=SZz? zYCrFHU&7F}VpFp}A483PLz>g+Ih${rEsk2s0UA5vW%zkPzNcBt&Vr?&|6LAv+#9sd zN2*u!fa0I+Q&ZMgc7YoFO{$S5X1C3?)^z>W=5S|T=rhfZL7kyu)#^Qb>Z+TbPc8#> zD2f^)EKi>FP0`X3EqN&Eym4*@s4n^eTJ7*EBI=onSijaMm*C>ytbdR}Ii-R!8=i$p z!Hj=;1k9#=QSQ2AqrxEYCHA?#S)$}@8|8zuH|SWs35ozUZyhrDbRtc(8RqTv`SJzQ z@8Adott$bwP>h^|Ts!VcuG|os?Pb^<0GZqaRT6(dqZSE#-;FNvgilMkcq8Y&i*U>0 z#tSkLn=%r3DrROh6_{*Tawu%=%Lp}4FD|72i#D;+fUs%{)oY zfua0*JZOAh1~jnBybrSW*Fi%8bpIpk#1q>BCME~|-No%~!ZF)HVmcR(h_Mc+(1Et2 z&Vcqty$WeLv~0nX9RIZ-7o7^y%6Yi-&Z-^zCp3QOJP=x)9lL?YKafG2p+>)Q?t`zLB%k9URY7SCrs?9Te(ZI9=bMnwi?1_mkZ1r_S%fl}dj z3Qp$FY+N||%z24M@7FDS$rvoESf=*5L+3@?OZByGWa9Bo&tWiu1Ow8HVKJ{TF zhl@z4gJe)*kB=?;NrWH32GC9Fe}5&3g0A9&2^tagQ47W<>loP98OOe z9zI+GnyttX19da!?vG%3sy9nPW-TaefIF6C_8mB7KwUuI~s#_wiK z=|7L%#;ZE)9rnaYF<*6IeJ(UjhM}8{fdP~_1sT-9HL#DyHsPg($tf*-mVOrl7*Fh- z#3gjTDvs^!Asg4sIUlbYB}y<{ov3hL&}nB=!Io9uuI)+?g9NNIBoC3Jb~^>aTQWos-X;uEUyc1L`ME)0naJ)`}&I zHn=b^4v^deX{%}M0hO-I3@c@i3aShjI~+vBBuf9dcWemx@ZqJ>*PCJ2Q>JWKvEc>F6vfWOj$IjFUw}^cF+6mW zg`epF|APR~NRd4Q3xoQhOV-K^k#iE$m8U+wX{BxVNI+m7@5PFs3uc^dvi}8@bVO}x zc6rn$fbLC+h@BjGXwjiX!U1h6ZHliJT~%JOnNyCXLH@u((0b2!24)7($v*0E^KOK< z+?X5aI%m^uBY$pg{?o!e`mzf;S?x4x{XYkP0Hx5Iy8|mC<|TMH3xPtCg+XKKJw*ku z{>4?Y3wEwKw8>G^)2o5k%TsFi45tNg8UEs{dX+%6APa-K)KmpIuv(DYoxUxa`qXaI z6b9~_-C@_f%MR+b9eSlK&tMp_Z1S}YXM}Sy13a3Pmhy=)^sq57Ok2C5EA5T8)0<~r z4--3;z%j?d;8FHl9b&uk)W?w(W-h@j@0LdR80hhEX>qnzut-=O&ht~zWQfdYyr9|f z>6#nAqLhE~^@jK7Jf1!{_^u~QJ6_yq?GH7sK;!1bGb%Mo45|!~FCJ*}omVO2+-9O7 zB5R_`#Lj%gII@QeG+$xW5UO?M^xWSE7*rS{f30;05L&$eJS!_4*(1yE{NQ+^sF+0Q zo*fdEAwRBsyYyd!!SF_lQwh_;;6NsZiD^em%>p~Rjc)cn%8FhQTGL#UlYiecw!<7W+%L_zD%PK3GHUY!R@hYxQG^r|p2>}OzRDF1HC zpv-VH``gm!t48fr4l4v&7KcWFuDfHbu@=|1d^h(~PsgjXN30l>7&eA(&X}**S{n)NCKi%008h=L(mgy@q>|D*f#7a8kHE8$9(dRm? zU2FMlszLpq;E1^jGW-m^Yzz#%M{cv(GpH~aMu6s!X0K5C$MCU=6SPgAs|B?2W%m~& zp~C`SC3nv_q@@lHOAgb+l1t=Htb86UU>9iq;Py=o%YJs(-0N1FNBTwPI7Pey@71u> z6z1JD^{UZCgG1W60bVScjAB9{UFw@I>UllZs`#4BX6B4pvJ9#Wmfjm#4HBHT23gK)%uiQ7>>98!$8~P# zkG^){Qnvk@*D~Ed_lyxVf6(yuzz4@ZBqwPwPI&AnDJ^tkOV@$G4bRQBbcAf>84SxJ zCw5F>xY#2Y+;Tz6M-4o2d75phifiVahnhhQ$_$1UD+AN^x_Yi@0?*a%Wcj$i_d=#{ z`yO`z!OSb1#?CkN7?c?-SEdL&NrZH&xE9^;tA5*USPR;ZCp_<|v_Spo<1_3)u7ZTG z#;Qdd7AT1>;81m#IIp+gY~h}*;bLN^*jATqUd0#)9(9*tkZxbT@l*3`A;YLGO)JmF zuqXdeU3BQq=fms0n}w7ZcCNk)Do#(OYU-@G@#?_l>5f-ioRvgD6Vr*Ny{jKQrwi^`@ilpurl0~V7Qb5 zPVw9f)s{zR-8EeGWcwW_7F(jANa7jOIPRaq*f2ZZUNAQ^Ml(vL#nf54g9anJi6t&+v)!mZwTqovT6)-(4nR4-@P3RGMg*bi5d8TH!%@Zf~#P4O$Vwjpg`?5on)%-2m zE>kR|BBJ(pYl#0SGn3jqBSUmrXx5^2HanV@M^$)oYN;}84Qt$`&|#&c&9r>OjnAID zt6KCbDvTHsm$tI3WaeKD8eA({$e_yL@#-Z@hu^hnhlJ+(xg<`MP&>G=wd1ai>PC&; z(2l4J!H1G~@)s~@GE_M12`ObP_Ip~fj0rRX*?lGHQSz2ole!WVg+QynPb#^{)-1Yw zQkj91Ve7sXpWSb{dOiV<+p#m0-{kjiTLfD7SI?jho>>D8-+51btKna^dCI2yD|D2Y zuE+gu>dLLX(`&q2Gh=qh0(AyehS)piAAMTOYz|I;VDL6m@nG6&Ln9~l_7C^NgqXR{ zMRe7k{h=KS+S}~FK3{jw6lvb>EiSCFyb4dk8o^-=YLc$m&|}Fk57fu*RN!S;acTQ< zjzzAUWj5Klf_9>>XV7H0^+t%HpN)Z`JLRm$(oR*-p!RB|+kx{A^n>;;2&-=7I>;8XthtEa%cWnGJ!{TPe+z7&1bZGOOWe$@i*^CG^M z6Lk!pC@^R4d zt=uQFxPy_wo`HvKl)rk!tms9%!En4ZXB2uVj41u?!7a0HFB`pgkDJ6g7gOT*dJe3@L= zG9iWupz+`6*G;Jv(^3@oUyZA7Qjp=*(PT_$s8H*!(*U(zQ=CrExvTRPJc$KLtw|Nr zf&_J}TqCEcYk`IrI}f;K+Nm+DXwcFD_1c-hRr=i!@p%e?5wAXI&YEyIkgxIU@%pg# z{#$-33=Gfo6DPTf7|vVLsSvdA#5ck9d>k7EUWRQwbCBVqkMieZHw!yKJI&P?sx8Hj zZ3^1K%n-kh;Ponx71bCR*pzKRg;CCvF7QZcD~qxt zXxPYmWwT982UC0yQ-o%ff)2y?tyg~>=y_8i!DO#&UvHFk5@dPqKpf)p3R>D zGdrNxv79;>B8HungqNe4#*!-2lw%=?J#tT(2z}hsHwsb%hZy3bhF2s zlN-7^OT0qQC|!B-@3h1n&%)~iBaEZw<4-ASEcvuo~=BYIvM?G7N3@aPr2GeAqG ze6E5H4%88~(|hJF^8Se&0}q4oO|hVeed!6ahnGsUN-2)c%d&&zR%2;n$%K#_eK zPgvtb;mVmW6qOkgukHqQ3#UDdWP7Bkb>&2d;)2iax8@2i`nOuO|2>cFX*Wd%@a(kZ zhK*rI|AvCrfQN#{gwu74MVN!Pzv}t>Q(*yUf%#F8X|En6#&C2)I_WB$Pj`EVO)=8( zzY+=Rj(I0)E_)aQI_*AjW#BR=@tB_(s)juO;ygVcUwf})YMy$~VH1NEC=4uFnhXj~ zOkEoGUS82ncumCu?KHtfD^rhD%>=pi87F9cjr(my6^6u%ps?XMx@GFCLz8=bFFFRs zR&1(L6$NScJR0!4e+y`SBcDN#q2t#=CIz24f`^U?r61GenWl&wKBqqF%-XcmY4Zut zp1@0Mt)^ImO=$F0VGw4R#Kypo$hP{*CbveTIV;||?wJ(Yz9~se5!6cqZTw?8zz`Pt zJ3>*AAyMe?gUwoLf{PsY2H$B9WYB4#3XI@L25(n}fzm#a!LfXYb_=3(fO5NuTi=dXSLKr19P!0VGz zcZ7=kp12;ioYf<=W7!-JHW%5Q&qAuJ1>|l$P5i2;#qjEc>GE5*n?I~P(AuT*M?dQ7 zBmb7=>7p(Ip&tU)@*GL-&@{Tbme=aX0!?*>t8+sy`H1*FaG297^MKP-(LJ$rUg&~_ zd8@@zcd!X+>SV0}Exj>k&;pGOcYXrRyllAI8gsf_f3d-%D)3@XHdn2RA0Y`5pt*&& z6-`eR#XvK}ur*SUP94+zb8Rf3u`(5g@*5GLbgpxF^Q#Xpr%o|h_u2i{(hWAN6TntF zg3_D4D#MBy8lbk`;-(|3*0kL`9ijiUAmp34OV-gv8+rttO&;8qoGfR{AOWh49)4P| z2sD&i5*Czr@k5{Bf$hd&f{YBp43pUy7|t_*RwRPb+J<8%IOZOTI6X&7n<>28e&=RZ zr^M0*#vUHQlDYPm^fbdOG#FGFq&|c#05ydk=xDE05@~vr6@8*$V#cu!O(*c+!F=Y! z>Q#CSn&8>UO}Du|cvo(kq0##~Y^zVeCg~rH8BT{^fh~(ue{taE)U%zS`*D|kxU22j zoW`iG>M-S4<7V#euR^T1U7P1PF@SeWt3YO7Ky5ZtOA#&hI)?CRT--mJe`x&f<>FU= z+7x)ayL+N?fWEVm&E6na8yj^7W6*IAA@EL<`?amT)BHAc9mXj9V* z(5Te$JNu4bR-VGRv54!I+N_&}B9Jj07QQ2lM!(mVHs;A5wcfe$wiDk6IR-6;6${1X z9N1M=8}15p1h_tU)i|e$=X}umYl6-T9ZqaBic#TeV?V?#X8Z6n55v>!65ikM)`_*J zdv<_UP=PQj^weBthH{2-1_1_!wV)Fi7#LEnJ--S%y+IvxzKm{2O~`{Tw<7aRdykhV zN-DE~#;ct{Ckukc0JdBa(OwBU+vZh*c>Re50!PJ?Q}`YUH+HYm(CJuGxaGfd$hCVcPbWtalG|25H(jXCsr`N?Qj zC-4b9{5s%$_F>rxOPbpGl`>3|%1YVVHeXMhQhPDl8cLal-gVu$h;4oDV{S}twVGpOq&7EGU zUa{{))yt}Ot}9U;E)U+Qee|-`X1FR?`azEM)J>;er{~)%ExUAgbu@OJow092iMNu# zlquRw=4PeY%h!lb&Q%AkedT?%k#*nP-nfvuWHNVt{FG5dyc|Oj{yTAIUiW=wB^a0H^ZVz9;cW<>QudXR;4L`$FHU5^Nl(itXpD|O8v0gan-s&IC+NPqT%`oqvr1!@4 zkzSzX3#MFCgyobp87|#vSg>?iLw>sQYh5h{MgyZx>;0hf^{#kxPvnR(;Q*a=x#_{f zjnf#|7`86es|cP7YEx-5Jf3)(ol*VM?kBn@mAVe-A1V;M@kQ&#ozJEdzg_(2=~Bg_ zXnU{Kbd%4`*9r`p495%ia&MR<%^2tQsMEyC!B=U8gM_kJ*p@4bS(glTY_tXDg$5k| zs(0W#g9^i|2p7RrxARpZ1$CmA{n2eb>eXbQ zsr-sxVEuIPBGKrkuC-0={VSBW8Q63yJy?1}3zXufg|fMPp2PJ&vN2)1iZcf{kHGnm z(^9NlCCSQ)!{B6+`0n{&rZ8BximP$BsL{C%aRH(zMe5aQmD`od9 zPp~@q`79^|jK#WEY=9km)|xgkN=9z&A*R`JtZ%ofZ;0D<&lZ#&+`acIGpI5=Wop&f zmTc}_S~pvK3iwc<5B4FkCUb=urm-_;zOz~m(tBOF--ubmJm{V)&IfCw^K;n1AMs0uoz z>&-RLE*Vh%@{$VI&-;<0Y8}vJbkq0ezQdblFAcfCm^G<|O9V8|20AtQIZu`Pgbg)I zruT6Fx$pKutK!EVs}&B(7Xpq1d8O8rLOAmML~yw;Tg}=SNfIUqM#+o8oai- zCM3dSPjZW^yJ=Fn+uN<*nN!19`R9KyPyy}y=;G35kn8e3`}VQBD${k#^}3LNe0#`g zV#b>3>%_mQF+7D7T^h3|Ex*pWE4+(MG-DDEqv(pAU%W1QMA!+rJkYB6p{&XfE554t zLZp7|`zr^lTMoUlS zfh~9)F{qZ-;9U?4TBmXpRJ=K!C|bmrzq0VYsJlmCL6=eBnGI_gDlVLQ&%4u~ftR7i zdcE-3_H9wGSdi0vG=}ti_yoOqDs7$&U6Rv88Tg}q?o~8S0FQpbPXmOeeJ%zKR_8ymb6HqcUgqxu zoiGH-1CSF6mrk3iSivwueZTiTC))?X5f1v|@)sk(bzG5H!N z8@VdFG(@PqRbkGhUbEHoSRb`4{B!zF=g1x7`QZtr**yEa($nM z&iW-yd;ybHLKbu$h~yG&2F;0XRqgxW9aN;;ury%f)y8!F#Z4_wl^Y$MCvpif%wS_+ zi19iiSmzl8y2+!{$^f*YexHWUs|U7OuHL>koq9p$bzF)2trWQh9CD(OjTYS+;fyQy z1zLc|xilI6)jcWsqN>}#>U99-GT8}z?_PgfGEtO+`KtGIZlkVTFF9jS=>2EVXXu%s z$Z2u20zpeUwd(Y|E9zb_2W5OYgpFkq;9 zvZc~P+{{X`>gtl(E%id@xVM@u3is`QAo@b$Jea+#X!7M}im^9dw7ht#BQFNZLxP}{ z+d&5pvpe{4Z(PK9Y@=u(sErO93tABQBy~}xNXFKt*duz8r@9hu3MDSh(CXBzn3<8W zQjS3Ljnl}n~|xh4IWaLkrTMyx}8;bUtP?v6vNeu7T# zdllg_kt^VjaMy-=LT8=)uCy10FE+Sv%BwElOZL^WKDoxC>z3~~?PZW=Fg^$#wjk7@pT>leV+TSFo zGDuZSd-BAs)t`}9fAO)dG@dz{D~^l(C^Or1Z_%OUw^!>4a)f-J$DqZKaP4CMjIHKN z`Bw6^C`6d1R)jIg)`T&B+$37mHc@n19^>L0*L6hCzGku4U@(@L#1WJ7D%hdo~iN}O7qZ08QRERDNk zP@Dov0a^?P;@MSo=5KSd-F9GmvE$|q$Ntp_T<{cK_#ps1?@;Q!NK@fzw(!e~%9;#6 zy3Ho8Vf%W6>Haylw)BNbi%+~dAaQEq)(EEk;7FXbbV*l0#fs>|4D68G464t9XSNg> z&YU|~cTJgn`dvT4*Ph%L&v;GU63p_aukOg2y_%&Sr2(MTXXhDY7=%9jzHugU<)pH% z2B8Hy3bTroZl=pNw<&Sgy;SC6sAN4Q$jY!}fl&`9LoAa=lh+$DIU@#cnD~~*e?cn) z>KWJ>JhGNOkmo-Q-XEjRaK`URqm@scyM5BNdsD2ISa~3r7v7e2@yr6-cmsT@o*qLv zsP%sHY!GOZfT9v;tJ!1bD@ETY&G3pUGT7qU6uyaB_35VB4FLb-oAfF;4r#lvtV_xY zZTir}^6^TS*W-=rPp>+#fXUR4jd!V%7Q-uxogEoq7mJ-d$t#+d!KnFNfy|1e8xN$Cc`w3`*P=QN zh8pYlo4V3Kw|dmPvirhyR;kYYiq?TkvW-_NH4iWvwT1?_rF;6lQv{v#3d*Jt56rbn z8k>Uutn{ot(cOG-!9vi$SHks&GeZ`wv{aX@QI%$h6`u4sDQP=s-&d+4sD~^hF=@jA zjX%wTpcU8P`h8#8%BX7^0e%tCDqGa1CZJ!Jg`YuNM?{k^aj$Eup^>0E_{{x15+7|Z zLJC`O!rypL$d_^P0?36JzrK_+Y*b<}WVpJM`7ERGO$I#|2j+(r0e2=dCx!*S$?m9j z6V$GK<*#s)JCO5PJD1ayGdfG%zP4{*V=!be_Fe8@`0mEsiM$V-SU4`7S-8QukR!oC z#kfs2LqUeWtGY^JEgZ{gG=xM4N1^BRiKrO zx3c54Dt>5W#+U{^xfP%HI&-{u`e>snJHyIVM$A)Y)H1LzFz3l| zYBC6dn&fwdLUI;N@8)lQV5XtkIjzdK%!ViMuI3jG*;gA|A223JnoI%pk76TUeGqlr zcp)#ri8ae<>$21Xvz1HAjGz6Ix!1yRnr*3z$}1hFbj^@91~rE7TU`ZuQ}kVOU#PLS z^?$ttJrjQok5t!z{4L(1EvZu(FD7e)&UW8$D5;ep@bP-yr=8PgH9cTV08N#K{k-ke z+f=sFNOR4yLN0IFeMzbeS`1gAmLFUmrUf1goKq=$Q0T3ikqqdxx{hkL{eg|sW*NEp zRBD6!ogNX#IuyCmRze0+PUcNp1wL#rwMQajrDpO2AMsu6hqyyPt>dS08UEK@yc$-_ zN(@|oO|U(bmH(=i&MT*_g1baFgN`##m;~uh>3Xl#JF2Q9(iqRO=o!o0sY<~@Wgpvl zxYVT&w07K8=|0vGss;8{oTuj+rjP|UoqCzBotWT$fiX*HIcVSX2kYBR-rZd`;5tKD zlVPi5R2J8dGBYme4OI$z64Zq>X6aQt7VE1%wk+?h$RdXbL*9<1+k_bAvN14x2m(MGrcMk2Tts8<8Lz_M@f!dOi^{iPT@^825KYYlb&%ofuv*k*55L1bF zz{bWnJ-fJPS5N+9&~pK=a}HUs#WRPoYUhs%$&e>Y4Ps0L8T1*X-t3 zZ&>T8T`ZaSYsRUAwR3mv$ei(TsaEnWc9ZG95atE{T3d>V9vz?UN52^(<0nfSt=A#UMM^{1}h= zbSBxyLC*yQ{CydFtuMTijM$~AB*Bn;>szLS?!Fgtk#d}q&N#O-dA)xq%Wkn#4s@%P z|K!idW;}cnv>-X=l?>CPm6{6*r@yfmk2G!}QdB9J#n`*Y!&R)bR;pFEaZ zw4zhwqVhk+(+VPBwbFdYO68BKtpnW-_Mbl@4b|4443zi{o3B9g1}qHoPTX7}!|?C& zlRbuM7CS{=NKChCZ>Y%P%E&mmb>ilScSRJXvB@e#siYs?ttrHSRqq{Dh3=DApD?}-Pl(=AbuNr&8ufCF<^CpLe!TBua!Ef zb+pqu-GoePPVdmrSuNDUmCmZ8%pl2N=kk_;#qsd=TU;BP6f%A=O|WX*rubsl4R&zr zSqP;2TC-@wl}R@yCyFyHU}Inq)n;QntpHj_sKp?c)GFC<<=^!%&ZLNSi6-nHD^Bcc zyC`$y@xsuy4V+ohOzlsl+=>PI!@)PM@-oEzEEfBFD{Hk$OYTX?_@D~N2AKPnJv%cy zLeS#zBJgpEe9|59Qx!riv=byH8RE{)G#6}`;d(0z5}g5u%Jh{vJwBU)cT`9*%u{>b zYk2tNQitO^u2`}h2@ZB}_Fm_>y);+_n;i4SthT(@%Q&#fJ=T+K0Le*WF_XDmp-@js& z%l?liwod&zOTp^SX%D7LHF^wn*Y-Nrc747SHfweB#(o)wg=`EAhxfdGwWH5nh(oBKQ=mYJ?EmsdwWzA&Z>(r)J4Z~Y-7oFJ=!6B)|SuhtVj8|e$Xh0AjI`c zGo7OkNu4}4C1#c~gCRrRwZ9jwh;jbALW3-~UB#f=cIrXl1PY0xF&AIn61wJ5_QL$| z!4;A(&w<7+;~7*K=9RA!iPEr0uK0f9lgETP6%0$(Zrc^GFeYui0PEX?q4@6kjTn~TyuSCTxyb@ekFP#y!x z`+z1D2CuADKD z33O;rXtH>4hbRO8QP)WZ!c02Kpn6V?;Zlx6Q*01a(@lTAO*TSXL`9YTOu}$SJ&2D zFmuskwK`VH71%n>k3pQ_-~as+4cNVW;MC1~G`tb037n|DBe5 zKWl^To~}r$E|?I($g!-dY=c6E6vJXR28JKk8rOwS;S989aJ=wg?KZ`Zsf+XY8x%5rbk#CQGsyKYZs;}x zI|OEIHK>9Kf3uiDlwsa3g&VFHm7_DHn<5O$dGCny9OC0=5MZci)7C?Z{X3x20$g*I z@-DXQIA2|HoRLp4?1CfbgEwOGvJI)Av6grSZdi_bEtLWqE1u85$53~BgLYTs!nNDH zoNr9C;bQogZhSfHT6R-L9VlOLL-SSSbv7Mk&`p+mk2+q8z5bEAuHwVITWu_r0uA;r4 z@-qArJ-TMi|2s07(nb~)45|$O3>(Zm@(VA_{Vex&zRKqheatdiU6J}tfv*xOxgNdr z6+Er8M+ekuL2=K!vor4|{pmEO<;ZU=%wMw#I_Xsy_>X^VE7UwGTr z!`?9U*-NJdyYBMkdd-8>*oUMUmas7}fJ)f&46F>_3!ilXOZMU>|6Qe)LGsvYfF1?nieTwPS^tKJUg~|Vfu7xSH9yl=L--PAto75SE8RB?< zZtwf}WA*2oI!@8KQ`*@@+R-e zxl9Re^-ET32p@gItH2=7@J}&JB60D&Bw2842A-F@nC;VUcCza;urkycv}xxv2r$U? zJnZsr;a*fQ!(+out_U^Ic$zSz?8?j0+*QqdH}6CRL&O0i2GAY$3Sl!CJ=QYwoi^=x zrXVNy6l7POqX?fcr&+YBIkcqZ^yJgcoz#TIG$k401X>Tf zG@T7Qnb}&I8Oy9Hd6w(*rCrB9SAtq0rMwEprI|0?pST7iEMu0^=WfJ#kJHvk9D_nITS_w z=9_}t)*5)d!cLz-h+!#s{%;=4)^s6;fB#S3Il&cCsq*Ll|N2dt>gSbJkWDNMQ?R_s z=OAEGGco3=JJ(@XW`ilB9h)1}!FM>^hZ9cR^ zB>BeopA1?IaMw?kxgg%Rhe?+C?aIAr4ox4JF7({ePIx*|=DYgrRpFZR)m0eg5fOrX z4D(Vhad33z@~ZE2KKp#J2!ijK<1s18x}U?#R$mt3`pj0rCacXywk`9Wba9P=Q$RW> zY~_&Lbtd+tLS^>)hN-YaB zm#vaH`5bgp65Iy}7w2P|EzGctje!Bx-4aMP#9Rs70P36jn`N%3iQ{Lu7cJ9b_J`-K zi|WR;ndkpAVD$sRkWpf|m(Kh1{Mm`y6sz68M>^kQEWYZH8+%&-?$+mum~KUOC1|$_ zBG%8u%Chh`c)Nr2^QYgx}&!2Ri@!J3Y z|NYJ0@;*-oxeA_-L$=>u=zH?9)qjvEG}Xbw!S+8Pw<4zp880FCuF#TzYwwk=Jn9Z& zT&(i<ae?xA8UB<6ABL* zxNkgv>Fzt(TGgaFGdlmHuilm5Rp;%sQDi$~qn&;gixsR={C~|*uD;Z6w(BxaqwV(| z&AtIHx#bw|sgX@ks_NM^6}}7*?<`FbG3hYiRWysKo{vEx7Y*S*dgrdxI$GmRY80;1wc#(01C6 zytVmJ<|phx{Vo}BOD#=t_NO3;3(NM1^ocO|wWLjiwj6{Q{+VwJcoVhtst2P1>*9iK zvBJOk82){aT)tL=TO(fT(6%Rqd<_56z4c31`$Y#DK5{9pLu%{Ufm$?t(6(M_cJ1X| zyb)?*4F62?wA`gtBqq!RH=I(Y%{$%x%2bTupSjzc@=T6s)tT+(G7kcN7K;@~RoE#p z{5#$-ktxCNn55#QFVQu^ySKG`d9L#yQl^* zoO9Oa_JqF=c63FaSmyD6r{$vO3aSkM>W}KA1TQH+5M#Qcu^`v^0gt|V(_T-HG{xCU zdzqiDa^!8Pv15>B_$SZo#?@dcncm`YDgUEy8tbO@jJaHQx%8*=UtP_>&hW2Zz)95E zmO+%^-~V1+k=N`Z2G%oql zZl>yg^Lm5XQ&kggi&kaU2H}T(^}fq)ug!c=DaP=xKCRHqIM?}G^J6Y|E{4^Ao|Us=si(}m23|e!g;e4o_q$iQ0rr4 zK>d5Zzmp>FYbZ{rmDOZe^NDZ9>y%>ONAXUQUZ?%|G)ps zjkB>OMQoGiCF_K|MYW*Fas74v>`PU~(=pr(|LS=*s2(`|)cI={cy!z}Ps==r;mk=3 zWtT~H-T77l>Cam)^#Gfldk=*DAhm*xC8*B3S*)uQj|3|Ngsk7{@5has1D4dIJL= z!@vJCwXI?yp^|39!|?Ba>1w~*6BPKFKK$om_*dT|kQDRW`74(=!$ae?@_wCumX#|W z{8Zj!slS@Zt@s+Ko0&n;sf9t2;h((WI+%rTqB0wI8YUg^V)MK? z#U^s)ALYsal|gCp|Nr{e(yA;%mn0Zgu`w{r-`uc=`I*`+_owG09YB$3`=3FQ;otnD zC9D0WoV=;KPm}F{-YtvWN6mKz_;0LdU}5+tujnMp@Xx*Hb4|v^91L}Lqwa6Xn_$bsP}d=9%yVMj6UQyj z6*(B{&gFePYY_8OfT6A>V-klubXuk%RROZ@niq7lA?g|2u=yUNUK0y@VrG2QQD%IE zitkAn&xzqG>G7WH>|kTcYVvN<-{nmULF0zF=5L@gJRGv1JcBty1fAbm!oUrZe{Z|z zF~iLB!3>}Xt@w#nX&eT6HFIXadvYiOGmqieEbmnKVu8ffeUbFL3M<0FSv_pw+bik!om(o(u$GO1VWHF3OEO+J-leKAW`ahmLGx^befH(? zk#5j@PY0fvnU0}6Gee&_85xFkYzz!oCYIXE4)zqBH%#ae+L&keJQkA znnw$MUs%|%_+Mj3jhzIhjua&peui70Ve=;Nd7FQrGLjl&&b**8=Z-Ljb>NA&Kj3;8 zb=+AH2)>&a)>i2lt<67l6v;`3$TKat+D}H$dap)*m0-1fR{p!T?(HAiz*J z-*isGFXhgqYaufw@(guTSf@n6``1T6SMGu)^q7->InR?jVaLGBAjYr(wElbQ5s@vS zs)~tvF?MwIv&8k7p zjz1k`Xa2dngT3^hpPK8oeuEeDH!gjlr_I98aKcVs0F)0BTY9UyN*^58vHtkrFE<0U z?{Jji^brO@hJObo*6l!^8~}%`2(SIA=@(`>RxXDp?1(XAlcV(Qd#nh z8BHvyNv~AXxBpniT*~G%spkt+T$jv-Rf0j*vi^imp=!sQZalW z>~gl?UvV*uiNvEDWf^X*D~~*U`e|X+UC`F}^o|Ggo@ zzjU#5WagTZHn_1vf4iL%~;K5Dj;hI${mnC z;ZcUuIt(HVbvz9(`&HPU*_*r9y<(G()01BnuFLQbn!KjY36n@?opkwB;C6Ngj0p*0 zpL!L;f|;P%{r~^}pUeo8NO%1KD!&lALGujW?|ynSOjcPOX;{nEYC2yX)Vmc_vJhja zJF+A1Ogz(bZPo(@v8%T!1|%_l&bE_gsN<2)WO%mcO&e%7<6JmbL*gzqLvUEAg2KXc z&bJ(I=Nnp%f%Phe0$OQ`vz@;GQ76*Pp!qYQH>R|(IS<=JDtdOkwNcXeY9outm&--nI9{C*x;@Lx({1x14#&9 zXgm?_AC--YLJXVP7#N_w*h7jhiUQpa{`&v_zx~Z63qMuzGt}i53i#aWjNRN)SOCOO-H7*+~ z&3hrKwoJis=8P)NjY$WXnj8Ys52&2HS|LtXFeQ@zj?JD_PK z#5B=M%Rdat$R#UJgo6Obt22}0xiz+;%qB}9+`e4Y&4Z^MG>0@n;#=)Lq*lXn(8T(S zN!9;^4yZt;(G$-;S7cB}=>7gjwP0Tm1J7mC4WKGdhG8ok14AuWYhJ63t;p1kOJ8K! z>ob5>fXv|$VW?{{IIMc8SJ$;Xf5B~DNqz=y(E5ma22y5)#6hz{+|0M8Ob3l@cV5uB z6c)WyF~{2uRLf8_BP7c3Po49Y^q)DYj}S{;7ybmd{P^fTQ-pt}N1LLVo=FS#9y}kZ zwl0?=i8WI}^Y236lfmCi7x-3ko@MfT=)w443aG{gRVh0z$4`D)mMz7=Yx5t+?2j^H z_J^@poM9Uq0|PZ?e?&mNHTdk0r`o2I(_YMDN1m^V0`>U*561Z#R)&B71(ke2>qP61 z>^Rr{%2XWZtPOZXfB)BBA*P$xK~pv0d7?lI(2SYA`SR~@E0kS-`sV1GU>=2IrRVZMbKaXb=~oK8{RwK*$}2Wu z&e%vXY-eL&7#j07qUif{-l`PjPE>~P(NSkObM9oOdSiAsi^9Pk)1DP2am^K)-;F>A zj%96_@kv?rXQ2W_Jv+mhywdhlH$W@o&YXMMt_;%8`BzwQPPb4(Df@FJPN{vZX^iUK zl}o!40^Yur>~WISf!M{Vz;MP-$fSm`Bl3xcmCZ4QuM$&~644=Yef$!z6?Z+ilJa+wlW%p&m4ht5mW08|8d*`sQ$ex=Vd~K~>^*ZXsq5XoykLgdIW0T(PiEnbXGjwJ36ky9YT7A#wn1>l{sV#&nnW1> zb-nv{XO5nu=8W4Hc_dtCiZJY8V_--Sd6gi?aAsX`9P{js+uuW+|E*0#j<7e*eD@Ac_3JsK3Hp{A%duc&V-6^YH9-q&=XTVt&iZ^0BsNUR*z zV}OL*E`D1TJ-)`ikLoIWIVQ6no2#YD(h((|TBX`)E6FtBg5D{Xx-*~TEWlyVEeDSG zI;9XhrG-uA>wM-DhEMKi`AGLlzF#f9;M(80D&Sy0ai8&^<23gosUDEB+VABG zte_Qwo;TfGUp7WOS#+zjf#*nV@0$J0K~Lo(`0wd6NFrkKi`>0Jh7&I!Ht>h=F<61@ zyK+24BEHku!{_4p@T4QR1Q~X+F))b#&6%OGo8SCR_5Kwn8ZF|O?=&oGV}2~pFU!Tk zTRXAk0%+`2Xo8X=cx|WDWw+#Gr?zugFfCXXeBlGDLK>rqEN8^iYk}-fK&NP*IrnnA zJSdD_ew_N{rNkal8zwEYPT7A6)5WyI4cy#bXf&O$fyBT|QBVwI&5^kwF z)CY(6ZE=u|TN%ARJkBXq{61YJ_QG(9WN@yXQ2PvQJC*ccd~u5(CkasbDtqc$|vX5L=>9;{E$v=6i#JPgHU81@9Jo9Ht9iUT># z)kj$zWRVJr|1oU%ac{T#eSJ{&TEzU~9yiz$1qNee-#APbW&zD=8FEK87B2VVWIXhJ z_q6GJ4f`Mw^PY`irvfMlP(uyFZ3p#zxuJoexM(7G(}IWETqthC&@oYMStjF!@8D#n zrraANz``3Z2n{!Ah+)J{=7H0l`@sHTnv&uuU{d3XKV}*il)(aQcZeX!QJ|gTpi&8H z1BR;_Crn?)>TnA%>yHlC5)&Rw2|YaW#HZEjXIm)@v~6Gw?I)W@A7O zZ44jHTnGvT*O>?UBR9C|f%I{ph5?3cGbb|lK~menh6GR=Sb{&CcYb{fOEsy^hpVBn ziC@n}hD9J}f#asv5EeJ4$UebHH%twevMXOQyx0xOZQi2uq!^xn_Q!!&yq`JuvKy59 zPbOX!c{DH3g;oFc61GK5Z&Vx)Z{L)E+48gt(~QSqpW z0%z0H^fzBMJwD;aL;f<&AIGCvnR@1QsAT+TN&%Nl%>oQ({IY)cEpq-kOF>G!G`O7|#6reWpRabk2?xX@)cZ{!1%w`=8$?yOGVv)ZKWs;{UK@13`}YUlken zL8W2x&|?d$!Pz|;v;Ci%)kG?*A$D$$|ZZ}WLq#gx~DXh#(FJgp3twcGKKNA*<%xO7xxWbm5_mrK-g#1tD;_Sg*KJ z&}9_qAUZ9>?zOTo$ehg*CfyC-;$_h_ko6d$0M==Ili8v0{*le$>N<`gp$a@8os)0v zbI$txFV9~d#FK7HhBjv&Y1%NvDl_yv0SFpz{Ma0Qt^7u^^aU7J@yGAUY2V@ zW5H?UwIIk{FF#h!O&5h6a&ZXM3qN!2Q-sn#`^2Dt@kH23LQpOO(mO-p;~Ej$tJzY23;}Df5p$o{O(Vz^z^eU-xP5lip2~Rxp6uaI5QT;9Z0N|6pF) zvp(;@Mp5lAR;;|B_N&9?iBBgk*}rQpLWiD_$>R6#?(diSlyADM_gK&OtGo}aja=5l zTOpBhp1)S#o(m4scyRl^Jv4YyT{+}HtyFG(x2vuXdb$rKEmhL*e)eC6K(hz&hWV{PHc|2B{8B z?gcM7Di%%HxLeW^?0F`awcSRIA`EH_|Joi%KqISyi{HW5Cz8R}{eW<5&)u^eMwb=_ zu%F{`kUPoAaAw`)o?X7I*;g6B>>nBngs!b(5CDn)&{!}jd_nRb#>D|#5V!mU_wpGbHsQt)i2mJB`;ILwV9Xa9IW874AiF7ah-XMH>*#b0c6w3Znuew7k(dN+TZDx^s&OOthn_U!{`@m!Ek~Dp2Z*eIP! z&ELhp*J<+yWrzzdYr^xOAj5t(1_q3h#laU=v{-!>d45infwWR(c$Oz*+atLhIJH-;DpoNjA;8DdiPb1|`p4)_pe63amX$+q@zp#rIL7&#Sc-rrqpFDRfZV!Y&mhVrma_i_ve*%%n`*QToQ(gIX0b}+rQ zS1=Wr?C?@>GlSGY|Ee8Fa*isp2bl@Z?l`Z-Ra?63}tUKkC7Ch9xb}+wY`eKHLAOll~{}Oo_&Vbz{ z4LT2%6I!C`N@CQ$SC`%dDfy?2k)o0Oz59tSD4V=~U|u)fCQrRl670uBZiX}G-cLF% z$if?c0a_BL^1i7dSF8~N&*O^Y^8KEMO@jWWX_ z@cz#;eA(d6P*WP%1y3a~{9|mQ%dp92k~%!cL-VH^JQf8mJ$CiPuupl}#O}E)X^=5g zkk9-eBLm_l(6Cd+wCh#NGFFFa?w`=@LX-s=I~=mAqY%EjEOGh7Q9mX~=>keO>kOBH zJNewRAZ>=_xXS{}kd<Hm1Kd|rI?_}>__STtLxgOy(IwQ7J(scs z#aBx)eRb&wuJGexIOBK4qG`cHSiD%`ju%8Lg>d@>oH9fwyxQvYl(H&K8hTOj}_>s=~XdLYm+!bp|NlJzO|sUai&F``FQwwX;Wy+TM6-kvZ-2uQ@LV9 zm?v|cFmzz&S7nd|r8w}FSP3ya=U09E#^bgy&x;{s3DcE@(WWAZbmI!K57d?bmt-Ly zHu+^KXdPI`Wf^J(PNJ~!3-S5Es(p|=DaLRFJpS_%lwQwupI<2i8r+1|pXYJM4Sm{! zhLAYJ)xXSw_Y`^E+D?4(xMW+z3>pQ5_DQkyFOk}{LE2#;E%A5j^pR}A=wGgQ3G2X` zOGql6R`#qfh1GPJ>7IFhuqq#@kVM1^w3Gz*x4^mi0^<)}vAsIT5puSz?K`+o2FD;M zCh}n8V9;9cFz%R;WjMq4?shZ-n_SPrHE$+B=6)DC6}Io&%j)nSJWd4(52hXY`HT`3 z25p-@@q6%oxwL&d1CNaq!%;Q{1_|fLhYu^nVc`H)Dd6zyTN{eQn= zyMkz-o>sOLbhtECa3}k<$BOWNI#_?-tG1ut!9!Bm#vNX+&ztcdQZmP5hGSGlg}!)7 zrHVd-0?2o#o7OOM6l?w#`l0&qoArc$Y-V-8zlllQ|Fua$^`9_Ah0f0D`}VRXJUA$E zimU$*BK%ufKy!UF!D9j7@LzFAOMhyf83VM~hUN)h@NgigSOu#G)$;4O{COF`!>f+Q zkaE=@G^d2xo?y_}3mS{o>3^b#uoD{Rh?)^}%)N;;LkehA5Yc+AH)lXCS^YpFtcdoj zxfH0(LFv=i><0~Df+`I3l3W#3PJrh>Ak&^+pySvlvGB%kSQ5L6Ll)Fxdg{rk#Q+{f za9zy&;+}Qq!)6(VV{8lz99zEs08LN2Lj38<&2YvKG91l43v^TJnRl1pGJ=M`FX({u zL)zJm51T>yKtsu(nnwyYrpcDRox@_0`(JmrcojvH2P^6qC~+}>P3W`oi`it(aAu!j z((nIiHw3e}N*}o2m3y$_@sYEjanK{PoMe9lZfCc6WuXlw@PxX(3%VyZM1WFd&2+7O!GjdRHuJy*&^R+oMw}3 z{r82(Mj|Nh{%$P>afUOfCRF>d751eaXkg%h^kXi+W$d%^vjL|8P+tZ#cJgP%ZDtwJ zh%01lKnm)z`H1+2mh|8{2%N@d@G=;wJn<1SsW~Y0hmE;uC8L8LqNf6?5ty4GjXSVS z&5*jjwO_ibB~Q_j>&nB_V+KL;Zze4b;MZ6bz^)Rt>@W5eY!7}YJv=B)_vaB)w9pTDFd|GLYmWRxB{o6F(Hub~ zLMe1EI*iT6#y05OmxJrR{ocRXN96#6FvFR=Qt%vi3Y(41UQlBr6m*u!nY_~Q;@|iF zcAijZ+iLXS;me7W9Ix0P42RBDhOjXJ^9KDXeONl$)85RCD!;SX@h4 zXOTO*!;CL%HX)(nt3RzhaN}{+Gw3>pL|vHv)&+MejZAi4EeH&7y3p#{`--`chv5Vp z1A}V9I`^b@`x~yI3I|SfdVuGKz_xA|4(oi})zD+RE`3!IIDMZjU<))ee6wiLor{bD zYI_+2_v(R_`1~{u1K6KpTZsDqD7# zx|oPue$Zla5ntKA@=jAb`?iHLo4<%MBwmsh*gf}??u*-xPhDINGm(XJ{W*OxNL%*4*F3n1 zEyXjY@}-48))9=@~P~z1I-_T zLWkw7*Mpfn%VQ5oNrD!dOg-tv>Xno_Xo_I~-Pto-t-2WBLTiQ4ruK2k`IWLyyu8qj@% zR{@k;Pl`LHnE!BXX`BGQCwcB>AC)!FeB|Fu5?Y`JT8P0}nBY875j>vS&eP()!hyHr z#A(9jnkSdlwihiVgmc2)1bBUXU?5m4yvR*FMM$2g!*^Y zyn`kdwLaf=6xA|->w8eTou0Uy<-?{ER~y6DxNtxfmK|DE!~F}a4(8exmyAP7m1{B# z6lO>R`Ch|~w~%bHP9K(oT+XgLY#g}rtEAXGQ4T)7 zo=HBxxEc&z@^(B-g5-&vc98Vu=vkm(!{l~WfIC)zJ=2A&<=6~2y%!3g1u;;=SI7lx zGfX}v7rss(oKir!Nc@PS)I_F(?;-7z7HCEe-I;XDQ9!LaW@nuaDCcng6_#Xt&U9Hm z@eSu8?G_;hHYG-h%wq>NuJE=@*s$){Z?*Nuo*W2eHwCZE3IAs}!}I9_N9l=>s7OjT zSlMmg1PTnWX_gn%+wR63{NgTA-Si>I4>afD!11FOI>m4*@?wWX99#C%4+h{6Uhekw zqNm$kwX&B}r+7Sl@DQ3HHok@#`WMn>S`HesIa#@Rv8cA72(%ww30@)gTvT?#0%pBW zMi)W3UUJG+g$jlUF7F79OO?EjM9UPwv*{8MCeaKoiZ2pk5_c^^A8W$20&2{N2!V_>jc4LZNPq?0MkfycA4 z;Q=E z8&D@#IL@4NG(){{?oy3qYgPJ{yCPd&fc6ERId}5^o;?quRaWe*{jIKif zeOxTmxcN~w`-f>|LNhcOApV=M(M4ddQaeYOFDPZROlyjFiCB|Sdad%KzUWaNYfx+O z+{yo-!|m4SEMpS+TpJO<|3gG#(uSU$r&B?#!E+~{r%q(%%rD!Lq$*LY%F(YO0BQvL zi2pyV$WZ621X?#(p^%sgY8AdJxFx~5YIUpLUf0leqxBBQb81d{n1WQ){QfJ+pw8g2 zYNg-&B!w^&P!TA4rJg@v=Y|9MfAlI(7YKrsgYLe5Bxk_@x{dC~6|chkM~v4y98Z|- zcJ+YfHs<+JxtCXbDtfzBzbze910!u5LAu|>yDdX>o>ExVN+FCzBiN>;RR zC`SroXvCEWePLh5m2tPP%P_<;9mrnNke1`*JSda4XZ zcL_6`VPjx`+M(&i0A5n*kl4BG&)RRd#IGil0(0a@l5Jl-!i$GBksq) zjnN^loC2x8a<*)q{mGm`o8c1Zj5kcYwDfmTU`erqG1NguXsd4vX*0?@FGzN0i{h5-C~$XK9O{s{e(u*+9v3D} z1rdh2IOrJ!Aa%tZ8FlJ+*MfFNazgCWS}&vqK8Kl*jam$Kb)YLo^eXT8F_kw!4ncP5 zoZ8T@c)_r%PiaO`Xl8loxK?=qUb+f$Ju++@iJt1cI>e(gXE!Ij>Yni;N-}?B9 zU5Gm2z=Gtd8O|=BtzYJ;g7=O}Fq~y$U@%~K4oXP@{2c}Ys{+M%Um0$hd|<09lXfMm z)v=}L6cxPIu+)SI-eS0=`lYV??N)Vt4F(Ri#_VpFpmiB`K9;u+bzjf}Cjo_x?6X!Z zn#jTXYCrpmm|1=mbDS$Sdblh@;9{hhY4|Lm$^WX0bQ&&HDD15eEGhJx;+qhrc zh}__82);cG^>Voy!_R)=!;!E8AaT<0?i)qa*KZ?Ev@|FMfu)D@qSm++OXP`|{_Nz4yx)xWRE4c2#y(+^=6?-wQI7 zXE29INDKN)%FmtNxy<1$P4Gk9bz z`*v%(RI1mKXD3pZe!C@Xp|&eXLh0#zCPp_umcZR>?ToY6*BUOjfaTr5@e_=h*7@2fc3a(5lk;Am8&y& zWU0Bl-FhlMVvQC<#Km><%E8xsO_iMIIa@0qrb=AZ-IoD68@8T7fkCR`+75TeD{-s;w7P!%{d<>f zW=d+JW`amSR@kTAPgIpaXLo8bXh84CTiVp#@9$}@xq3H~V=I%JBg?wI-&~VER?KZ} zRhoNUAudr>lcC1_6*JSW4Hc|b-#n8Q5}X94<#loedv5U!xa8~ADA1^#AQIRlv21TT zgC4{7;MExnPaH0OUS=-4TOy0CZA)g)gq14uC*=h}gqav6yF*zE94$AAdD}@c)abWg zb!xaUgZaVC`_e`%c3VH~ezK9xpnV>wUa3$>bY(!ln?hu<+jY?06x<_^?k? zx+uxO#31{Rn?W|I>df5G8I4QV*?>gqlo@1;!hNsKv0j}}F->KKiqwy*XO+Afc-{9- z?@X&n&{;j}_IEk3N@0*nrBmSsCpY{rS{}P)-Aa!VH3n%0*`U+1LJa5G7#JFgcCPgJ zqIa_}sgdbXvNK>bj8zPv?UQAR>S5{JD?!J`DsH?&t#t>;Y ziodpJ9pC=h>hL^i4Sm+XvEM+qSwyaT zs&d2ef7sg}WpV6vtXiH%2)Vn`s;#@w!^IZOT0Z5K9y~qyMQ@8 zaxdsw>QDB{3@?A|U^x2d$UV=5D4C8ucRTk^X6V?r*yH&gH;wC%%MSS%G#FmajB7|L zOgi4l%EeK!iaE7Z;gjs7TfK)aS)O(|vol;m7_4DWU@ zUAggQm)qCCoQ-1KDYp+Z$TK|OSk!TOf6aRV-gak`c}w{m87FSP{7_&DlcEu;Y?B^? z62r+1!=*;nX-D$2p1yK;@>c4DN#5#gqpqb*^)`pRrda=&sxHiM@}i)GuYlb{npGdbH18Z421G^=c>Nyquq0m)61kBc!}0H6PJR4B=; zzWCrR@yiKob}6n~8C#m%BrL)at29B2L7w47$9IMjcKczA z?L-X$kgU3p+K1WP*Y?d|YhD%23lh<6t1CWu%ecr|o`HkGP<)N8^7hXMjTo%BxO4wK zQ{{YpZN2&w-TbDw>f=qzyP=1gl{z}Iw$*lI)s*>_>pBZDctkPo zuk<{$>udG_J{R4TZaq5%h76_2VF&Wx*(s#_J(LgebIX$RF`i9r`3o0%pHSvuc)rJL z`TaZMHf!U59Fk(_Fk&qco|o{pJJVu)(C#3a?;;%h%s;N4eWU=E>$~(eUoWD1@3qfv z5W{SE9+>4QNi$5E-PUnApP5DJO1{*$t&`arFR8gav8|qYF@%o+bgm*lgMeg5=;GP? zcS6jzV-SFdaEm#E#J)zIR|l1R(hQM&GPSPUahY!$7VBHec`+!kpVT?GSi@GJ3f!YS zaB=_1t}U~;ug#lyyK?c|c_#`M2s2y+-T!5`MJL7klWyAa#e@&$4EpKk;_Y z#dkFtjU0zmtwOoNxZX~cQULAG0IA?vn+NsI?%j35*AKN%Yt8Yjb2`JL!2mYlO<3{4 zTd%jyGrx8B>+Bt3b|wuInjSYXY+#@KdFp&lkDCiJ6ciyU9j?sgz81Is>z<2!{VA~x zR>r0vrAjRfCmg4O#yLT@iEsyV?zs9cWQLc_S_6@gGmk1xZV!5{%ntJNU4cWZ89*&s zNd`mqAZY=yGYdI1S@>lqlr3fa@Fq3u+}x|y42lefl4V@amkI8#)L#)h-S_0>(-QuI ziHzyyZah=YYY6eTD>BG})ZELO)pf_I_U*15uX%CHo*nuf#t~imOXPW86;yte;Qp2C zAtsc7#GN7z-1Ov`yr7CfgCTH_{)Wu!E$K0~Mt|H|qZ#%+bKbXmucZ8f0~2c4vYekD zVmjxSG=s%dl3}B%*oM{fnH%z?l%#Im4VRyCSH;G$;bs3m24RNCz7@gGAjQqa3+u|x zh5Q4Z+k{Jp9jGMkJ9n39+5%^jc^iv5+R9#SI6Qyq|3=)l*fEGQMD7dJ6l1u=#=!8m zJ;NsXsQ~X=h8~F!iRz#=3{nh%o-wb_Gfuhp_`!jR^XszN6a2dzj)qwr_^T++u(9<- zo~g#K#SczqnG2sdJV9!8!-0@r77QZDx)`~)N8i56SMpn!VPmQ2#t*aGI@)ec?bdOb zbN5zrDfr${S%!`4)?QuqSyOD;q^NC9w{t@-Egfr}wfS}AX8 zqd^Umqzou@0;?3hWH##T;al{L^U22BD^%WxXhvvm30IO~u)G|9CF}A}5$<45-ROmH zzcC0hn;a z!OTtptS+`lNaM2e^u>DT+vb?=xcQd#dgy~&1y_vqj+IoXFhurEbGTK_uEZ6_mG~yu zx|C(ALbICAg2$z`+B%GHJ&xyEcqwo)th`mq$*_M{qzr=uQri0V_T6g!Q+Y!36b^iG z*B1l1J7wZV&(od@-b@kyyLXc?!(}!GhIKhUraS&4%kp&U|Ef-ny*Wc`_Ae=h$aRM~ zZ_gKdF{?H0wusm+^V7FIo1^Y|=m zttSK?*_LP+Feos*JQn2QbIBqxc#qlX+jp;r9Se4e&}uqpZtfoU45WmY;iQVu<}P2~ zv!8D99s!-uc#@?*@uyGY;=G>XtZCa-0LAr^cV08H5>59+Bc% zeIq36dTQ{eFGe3$&ps-NCzklZX~K5S2Fca;eH9QCVRn)R4J$M|aK^ z5GyDXI;^rn4P5SUTG>2)HSuA4YbE#1pk3HX9n6#=!f=I+fdQI6&a*NIRqtb12QE*_ zraqA4yI3*JiiOqXo}cWR)tdj6*%?me=Tz^>lwbhWTF3rO_kQzphS(pOZDkc)rN%KV z%j}zuYGi^=R0WsAm2miD)}+QIrp4x({|oS-M8-~QcrLL2GI8^y2T($zM-QH&`YdCj-ffHPg#`ZkdFkxT^mpy+izc4T}{G6c0V8kH( zQO5Si*;lgbZm@&~mk4P%gDtR;E^?YLEeFn>pQeR~uIyVN1Zwyno+teRVz16PPmlSo_^r;0gXS*6C9NVtF{R;7_u+A*JP=)R(2kvesJ-- QHTR&s8L)w)#1IJq0Bx|!n*aa+ diff --git a/decus/vax92a/bulletin/bullstart.com b/decus/vax92a/bulletin/bullstart.com deleted file mode 100644 index 54a4b38..0000000 --- a/decus/vax92a/bulletin/bullstart.com +++ /dev/null @@ -1,6 +0,0 @@ -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP diff --git a/decus/vax92a/bulletin/dclremote.com b/decus/vax92a/bulletin/dclremote.com deleted file mode 100644 index 35eab05..0000000 --- a/decus/vax92a/bulletin/dclremote.com +++ /dev/null @@ -1,32 +0,0 @@ -$! DCL procedure to execute DCL commands passed over Decnet on a remote system. -$! Commands sent by the command procedure REMOTE.COM on the local system are -$! are received by this procedure on the remote node. -$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and -$! normally resides in the default DECNET account. To install as an object, -$! enter NCP, and then use the command: -$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0 -$! where file-spec includes the disk, directory, and file name of the file. -$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can -$! be defined to point at it. -$! -$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's -$! proxy login on the remote system. -$! -$! WARNING: An EXIT command must not be passed as a command to execute at this -$! procedure level or the link will hang. -$! -$ SET NOON -$ N = 0 -$AGAIN: -$ N = N + 1 -$ IF N .GE. 5 THEN GOTO DONE -$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET -$ DEFINE /NOLOG SYS$OUTPUT NET -$ DEFINE /NOLOG SYS$ERROR NET -$NEXT_CMD: -$ READ /ERR=DONE NET COMMAND -$ 'COMMAND' -$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'" -$ GOTO NEXT_CMD -$DONE: -$ CLOSE NET diff --git a/decus/vax92a/bulletin/extract_tlb.com b/decus/vax92a/bulletin/extract_tlb.com deleted file mode 100644 index 376e1b4..0000000 --- a/decus/vax92a/bulletin/extract_tlb.com +++ /dev/null @@ -1,75 +0,0 @@ -$ ! The following lines comprise the command file EXTRACT_TLB.COM -$ ! -$ wo := "WRITE SYS$OUTPUT " -$ ! -$ ! Get the library name, either from the command line, or from the -$ ! user. Append a ".TLB" if not already there. -$ ! -$ Lib_Name = p1 -$get_Lib_Name: -$ If Lib_Name .eqs. "" then inquire Lib_Name "Name for .TLB file" -$ If Lib_Name .eqs. "" then Goto get_Lib_Name -$ Lib_Name = f$Parse(Lib_Name, ".TLB") -$ ! -$ ! List out the contents of the library and start looking thru it for -$ ! some files to extract out of it. -$ !O -$ Library/Text/List=Contents.Lis 'Lib_Name' -$ Open/Read File Contents.Lisi -$read_next:o -$ read/end=finished file this_file -$ ! -$ ! First, try looking for a '^'. If we found one, then this is a variable -$ ! record file. Just replace the '^' with a '.' to make a legal filename -$ ! and extract it -$ !L -$ file_name = f$element (0,"^",this_file)T -$ If file_name .eqs. this_file then Goto try_fixed -$ file_type = f$element (1,"^",this_file)f -$ If file_type .eqs. "^" then file_type = "" -$ file_out = file_name + "." + file_type -$ wo "Extracting: " + File_Out + " (variable)" -$ Library/Text/Extract='This_file'/Output='File_out' 'Lib_Name'a -$ Goto read_next -$ !n -$ ! Next, let's see if there's a '#' in the module name. If so, then -$ ! the first element of the module name is the filename, the second -$ ! is the filetype, and the third is the record lengthi -$ ! -$try_fixed: -$ file_name = f$element (0,"#",this_file) -$ If file_name .eqs. this_file then Goto read_next -$ file_type = f$element (1,"#",this_file)" -$ If file_type .eqs. "#" then file_type = "" -$ file_out = file_name + "." + file_type -$ Rec_Size = f$element (2, "#", this_file) -$ wo "Extracting: " + file_out + " (fixed, ''rec_size')" -$ Library/Text/Extract='This_file'/Output='File_out' 'Lib_Name'a -$ ! -$ ! Build a .FDL file, so that we can convert the variable record file thatt -$ ! the librarian created back to a fixed record file -$ !f -$ Open/Write List Extract_Tlb.FDLa -$ Write List "RECORD"$ -$ Write List " Carriage_Control None". -$ Write List " Format Fixed" -$ Write List " Size " + f$String(Rec_Size) -$ Close list -$ ! -$ ! Convert the variable record file to a fixed file, and clean up by' -$ ! deleting the .FDL and the variable record file.F -$ !, -$ Convert/FDL=Extract_Tlb.FDL 'File_Out' 'File_Out' -$ Delete 'File_out';-1 -$ Delete Extract_TLB.FDL; -$ Goto Read_Next -$ !s -$ ! OK, Now clean up by deleting the contents listing, and ourself.e -$ ! Since EXTRACT_TLB will be in the list of files to extract from the -$ ! library, so there's no need to keep two copies, eh?S -$ ! -$finished: -$ close file -$ Delete Contents.Lis; -$ Delete 'f$Environment("PROCEDURE")' -$ EXIT diff --git a/decus/vax92a/bulletin/handout.txt b/decus/vax92a/bulletin/handout.txt deleted file mode 100644 index 1d48f1a..0000000 --- a/decus/vax92a/bulletin/handout.txt +++ /dev/null @@ -1,268 +0,0 @@ - Introduction to BULLETIN on the Vax - 2/88 AW - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT. - - The BULLETIN utility permits a user to create messages for -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particular -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject line -and the text of the message. BULLETIN will prompt the user for -these things when a message is being added. - - Several different folders are currently defined to -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, it -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages on -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post to -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the public - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as: -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers. -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL, -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or from -within the BULLETIN program itself by typing the word 'HELP'. To -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing: - - BULLETIN> directory/folders - -will make a display like: - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER - NETMONTH BITNET - *VAX_SIG BBEYER - -An asterisk (*) next to the folder name indicates you have unread -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the following -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond: - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folder -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORY -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may type -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquired -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, it -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond: - -Message number: 1 PUBLIC_ANNOUNCEMENTS -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message..... - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently being -read. - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff. - - If the user sees something which he/she wants a copy of, -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will be -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ******** - -A person could then type -BULLETIN> extract -file: FV.TXT -BULLETIN> - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'. - If the file to which the user is writing already exists, -BULLETIN will append the message to the file. The user can -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to -your PC, perhaps using a BITNET journal message as a reference in -a paper. Once the file is saved, you can transfer it to a PC by -following the instructions in the handout 'Transferring files -from the PC to the VAX of from the VAX to a PC". - -Adding messages - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (see -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subject -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may also -use the EDT text editor by issuing the command with the -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD -EXPIRE: ENTER ABsolute TIME: - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The message -will be deleted automatically on the 20th of July as requested -by the user adding the message. - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when new -messages are in a folder, he should use the 'READNEW' option. -This command does not force the reader to reading new messages, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set to -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTS -folder has been set to PUBLIC_ANNOUNCEMENTS -BULLETIN> SET READNEW - -Alternately, you may type SET SHOWNEW. This will just display a -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send, -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too. - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. diff --git a/decus/vax92a/bulletin/install.com b/decus/vax92a/bulletin/install.com deleted file mode 100644 index 263ed60..0000000 --- a/decus/vax92a/bulletin/install.com +++ /dev/null @@ -1,18 +0,0 @@ -$ COPY BULLETIN.EXE BULL_DIR: -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DEL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and -$! define the logical name BULL_HELP to be the help library directory, i.e. -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY] -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot. -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN diff --git a/decus/vax92a/bulletin/install_remote.com b/decus/vax92a/bulletin/install_remote.com deleted file mode 100644 index 5e9e9aa..0000000 --- a/decus/vax92a/bulletin/install_remote.com +++ /dev/null @@ -1,130 +0,0 @@ -$! -$! INSTALL_REMOTE.COM -$! VERSION 5/25/88 -$! -$! DESCRIPTION: -$! Command procedure to easily install BULLETIN.EXE on several nodes. -$! -$! INPUTS: -$! The following parameters can be added to the command line. They -$! should be placed on the command line which executes this command -$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST -$! -$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier. -$! COPY - Specifies that the executable is to be copied to the nodes. -$! TEST - Specifies that all the nodes are to be checked to see if they -$! are up before beginning the intallation. -$! -$! NOTES: -$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS*** -$! This calls REMOTE.COM which is also included with the installation. -$! -$! DCLREMOTE.COM must be properly installed on all nodes. -$! See comments at the beginning of that file for instructions. -$! Also, you need to have a proxy login with privileges on those nodes. -$! This procedure assumes that the BULLETIN executable on each node is -$! located in the BULL_DIR directory. The new executable should be copied -$! to that directory before running this procedure, or the COPY option -$! should be used. -$! -$! If the present version of BULLETIN is 1.51 or earlier, it does not have -$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should -$! use the OLD parameter when running this procedure. -$! -$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE: -$! Place the nodes where bulletin is to be reinstalled in variable NODES. -$! Place the nodes where the executable is to be copied to in COPY_NODES. -$! Place nodes where BULLCP is running in BULLCP_NODES. -$! -$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +- -",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS" -$ COPY_NODES = "NERUS,LAURIE,ARVON" -$ BULLCP_NODES = "NERUS,LAURIE,ARVON" -$! -$ NODES = NODES + "," -$ COPY_NODES = COPY_NODES + "," -$ BULLCP_NODES = BULLCP_NODES + "," -$! -$! Check for any parameters passed to the command procedure. -$! -$ PARAMETER = P1 + P2 + P3 -$ OLD = 0 -$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1 -$ TEST = 0 -$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1 -$ COPYB = 0 -$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1 -$! -$! If TEST requested, see if nodes are accessible. -$! -$ IF .NOT. TEST THEN GOTO END_TEST -$BEGIN_TEST: -$ NODES1 = NODES -$TEST: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' END -$ GOTO TEST -$END_TEST: -$! -$! If COPY requested, copy executable to nodes. -$! -$ IF .NOT. COPYB THEN GOTO END_COPY -$COPY: -$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY -$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES) -$ COPY_NODES = COPY_NODES - NODE - "," -$ COPY BULLETIN.EXE 'NODE'::BULL_DIR: -$ GOTO COPY -$END_COPY: -$! -$! The procedure now goes to each node and disables bulletin and kills -$! the BULLCP process if present. NOTE: If version is < 1.51, we assume -$! that BULLCP is running under SYSTEM account. This is not necessary -$! for older versions where the BULLETIN/STOP command can be used. -$! If BULLCP is not running under the SYSTEM account for version 1.51 -$! or less, you will have to kill them manually before running this! -$! -$BEGIN_DISABLE: -$ NODES1 = NODES -$DISABLE: -$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP -$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP -$SKIP_STOP_BULLCP: -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE -$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE -$ GOTO DISABLE -$END_DISABLE: -$! -$! The procedure now installs the new BULLETIN. -$! -$ NODES1 = NODES -$INSTALL: -$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT -$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1) -$ NODES1 = NODES1 - NODE - "," -$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL -$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN -$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR- -/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE -$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE -$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. - - F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP -$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM] -$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN" -$ @REMOTE 'NODE' CONTINUE BULLETIN/START -$SKIP_START_BULLCP: -$ @REMOTE 'NODE' END CONTINUE -$ GOTO INSTALL diff --git a/decus/vax92a/bulletin/instruct.com b/decus/vax92a/bulletin/instruct.com deleted file mode 100644 index 49627f6..0000000 --- a/decus/vax92a/bulletin/instruct.com +++ /dev/null @@ -1,6 +0,0 @@ -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXT -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT diff --git a/decus/vax92a/bulletin/instruct.txt b/decus/vax92a/bulletin/instruct.txt deleted file mode 100644 index 8bc83c3..0000000 --- a/decus/vax92a/bulletin/instruct.txt +++ /dev/null @@ -1,8 +0,0 @@ -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayed -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can be -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). diff --git a/decus/vax92a/bulletin/login.com b/decus/vax92a/bulletin/login.com deleted file mode 100644 index 565ea46..0000000 --- a/decus/vax92a/bulletin/login.com +++ /dev/null @@ -1,31 +0,0 @@ -$! -$! The following line defines the BULLETIN command. -$! -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$! -$! Note: The command prompt when executing the utility is named after -$! the executable image. Thus, as it is presently set up, the prompt -$! will be "BULLETIN>". DO NOT make the command that executes the -$! image different from the image name, or certain things will break. -$! -$! If you would rather define the BULLETIN command using CDU rather than -$! defining it using a symbol, use the BULLETIN.CLD file to do so. -$! -$! If you want to have more than one BULLETIN database, replace BULL_DIR -$! with the actual directory to allow redefining BULL_DIR. -$! -$! The following line causes new messages to be displayed upon logging in. -$! -$ BULLETIN/LOGIN/REVERSE -$! -$! If you wish bulletins to be displayed starting with -$! the newest rather the oldest, omit the /REVERSE qualifier. -$! Note that for totally new users, only permanent system messages and -$! the first non-system general message is displayed (which, if you ran -$! INSTURCT.COM, would describe what a non-system message is). -$! This is done so as to avoid overwhelming a new user with lots of -$! messages upon logging in for the first time. -$! Users who have DISMAIL enabled in the authorzation table will automatically -$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this -$! feature, add /ALL to the /LOGIN command. -$! diff --git a/decus/vax92a/bulletin/news.com b/decus/vax92a/bulletin/news.com deleted file mode 100644 index 2ba1d16..0000000 --- a/decus/vax92a/bulletin/news.com +++ /dev/null @@ -1,568 +0,0 @@ -$set nover -$copy/log sys$input NEWS.CREATE -$deck - -From: lear@turbo.bio.net -Date: 25-JUL-1991 23:16:18 -Description: How to Create a New Newsgroup - -Original-from: woods@ncar.ucar.edu (Greg Woods) -[Most recent change: 19 May 1991 by tale@rpi.edu (David C Lawrence)] - - GUIDELINES FOR USENET GROUP CREATION - -REQUIREMENTS FOR GROUP CREATION: - - These are guidelines that have been generally agreed upon across -USENET as appropriate for following in the creating of new newsgroups in -the "standard" USENET newsgroup hierarchy. They are NOT intended as -guidelines for setting USENET policy other than group creations, and they -are not intended to apply to "alternate" or local news hierarchies. The -part of the namespace affected is comp, news, sci, misc, soc, talk, rec, -which are the most widely-distributed areas of the USENET hierarchy. - Any group creation request which follows these guidelines to a -successful result should be honored, and any request which fails to -follow these procedures or to obtain a successful result from doing so -should be dropped, except under extraordinary circumstances. The -reason these are called guidelines and not absolute rules is that it is -not possible to predict in advance what "extraordinary circumstances" -are or how they might arise. - It should be pointed out here that, as always, the decision whether or not -to create a newsgroup on a given machine rests with the administrator of that -machine. These guidelines are intended merely as an aid in making those -decisions. - - -The Discussion - -1) A request for discussion on creation of a new newsgroup should be posted to - news.announce.newgroups, and also to any other groups or mailing lists at - all related to the proposed topic if desired. The group is moderated, and - the Followup-to: header will be set so that the actual discussion takes - place only in news.groups. Users on sites which have difficulty posting to - moderated groups may mail submissions intended for news.announce.newgroups - to announce-newgroups@rpi.edu. - - The article should be cross-posted among the newsgroups, including - news.announce.newgroups, rather than posted as separate articles. Note that - standard behaviour for posting software is to not present the articles in - any groups when cross-posted to a moderated group; the moderator will handle - that for you. - -2) The name and charter of the proposed group and whether it will be moderated - or unmoderated (and if the former, who the moderator(s) will be) should be - determined during the discussion period. If there is no general agreement on - these points among the proponents of a new group at the end of 30 days of - discussion, the discussion should be taken offline (into mail instead of - news.groups) and the proponents should iron out the details among - themselves. Once that is done, a new, more specific proposal may be made, - going back to step 1) above. - -3) Group advocates seeking help in choosing a name to suit the proposed - charter, or looking for any other guidance in the creation procedure, can - send a message to group-advice@rpi.edu; a few seasoned news administrators - are available through this address. - -The Vote - -1) AFTER the discussion period, if it has been determined that a new group is - really desired, a name and charter are agreed upon, and it has been - determined whether the group will be moderated and if so who will - moderate it, a call for votes may be posted to news.announce.newgroups and - any other groups or mailing lists that the original request for discussion - might have been posted to. There should be minimal delay between the - end of the discussion period and the issuing of a call for votes. - The call for votes should include clear instructions for how to cast - a vote. It must be as clearly explained and as easy to do to cast a - vote for creation as against it, and vice versa. It is explicitly - permitted to set up two separate addresses to mail yes and no votes - to provided that they are on the same machine, to set up an address - different than that the article was posted from to mail votes to, or - to just accept replies to the call for votes article, as long as it - is clearly and explicitly stated in the call for votes article how - to cast a vote. If two addresses are used for a vote, the reply - address must process and accept both yes and no votes OR reject - them both. - -2) The voting period should last for at least 21 days and no more than 31 - days, no matter what the preliminary results of the vote are. The exact - date that the voting period will end should be stated in the call for - votes. Only votes that arrive on the vote-taker's machine prior to this - date will be counted. - -3) A couple of repeats of the call for votes may be posted during the vote, - provided that they contain similar clear, unbiased instructions for - casting a vote as the original, and provided that it is really a repeat - of the call for votes on the SAME proposal (see #5 below). Partial vote - results should NOT be included; only a statement of the specific new - group proposal, that a vote is in progress on it, and how to cast a vote. - It is permitted to post a "mass acknowledgement" in which all the names - of those from whom votes have been received are posted, as long as no - indication is made of which way anybody voted until the voting period - is officially over. - -4) ONLY votes MAILED to the vote-taker will count. Votes posted to the net - for any reason (including inability to get mail to the vote-taker) and - proxy votes (such as having a mailing list maintainer claim a vote for - each member of the list) will not be counted. - -5) Votes may not be transferred to other, similar proposals. A vote shall - count only for the EXACT proposal that it is a response to. In particular, - a vote for or against a newsgroup under one name shall NOT be counted as - a vote for or against a newsgroup with a different name or charter, - a different moderated/unmoderated status or (if moderated) a different - moderator or set of moderators. - -6) Votes MUST be explicit; they should be of the form "I vote for the - group foo.bar as proposed" or "I vote against the group foo.bar - as proposed". The wording doesn't have to be exact, it just needs to - be unambiguous. In particular, statements of the form "I would vote - for this group if..." should be considered comments only and not - counted as votes. - -7) A vote should be run only for a single group proposal. Attempts to create - multiple groups should be handled by running multiple parallel votes rather - than one vote to create all of the groups. - -The Result - -1) At the completion of the voting period, the vote taker must post the - vote tally and the E-mail addresses and (if available) names of the votes - received to news.announce.newgroups and any other groups or mailing lists - to which the original call for votes was posted. The tally should include - a statement of which way each voter voted so that the results can be - verified. - -2) AFTER the vote result is posted, there will be a 5 day waiting period, - beginning when the voting results actually appear in - news.announce.newgroups, during which the net will have a chance to - correct any errors in the voter list or the voting procedure. - -3) AFTER the waiting period, and if there were no serious objections that might - invalidate the vote, and if 100 more valid YES/create votes are received - than NO/don't create AND at least 2/3 of the total number of valid votes - received are in favor of creation, a newgroup control message may be sent - out. If the 100 vote margin or 2/3 percentage is not met, the group should - not be created. - -4) The newgroup message will be sent by the news.announce.newgroups moderator - at the end of the waiting period of a successful vote. If the new group is - moderated, the vote-taker should send a message during the waiting period to - Gene Spafford and David C. Lawrence with - both the moderator's contact address and the group's submission address. - -5) A proposal which has failed under point (3) above should not again be - brought up for discussion until at least six months have passed from the - close of the vote. This limitation does not apply to proposals which never - went to vote. - - -$eod -$copy/log sys$input NEWS.TRIAL -$deck - -From: brad@looking.on.ca -Date: 25-JUL-1991 23:16:19 -Description: How to Create a New Trial Newsgroup - -Original-from: brad@looking.on.ca (Brad Templeton) -[Most recent change: 04 Oct 1990 by brad@looking.on.ca (Brad Templeton)] - - GUIDELINES FOR USENET GROUP CREATION (Trial Method) - -(Note: This note describes a way of creating newsgroups that is -somewhat different from the generally-accepted proposal/vote method. -This method has not been universally accepted as a valid means of -creating a group, nor do all sites carry the "trial" hierarchy. -Groups created under this procedure may or may not be honored by all -site administrators, and may not be listed in the monthly newsgroup -list postings despite "approval" by this method. --spaf) - - -To create a group on USENET, you must objectively demonstrate to most -USENET admins that the group under consideration is worth carrying on -their machines, and thus by default to all of USENET. - -One common method of performing this demonstration is to conduct a -survey/vote. Another regular posting in this group describes that method. - -Another method is to give the group a trial run in a smaller section of the -to see how it does. This is described below. - -(These are just guidelines. Other methods exist, and these guidelines -have been written to be flexible. The real goal is that sentence -above -- an objective demonstation that it's worth feeding the group, -by default, to all of the many thousands of machines on USENET. What -you see below is just one way that many people think is a good way of -doing that.) - -The trial.* hierarchy exists for new newsgroups that are being tried out. -A new group can be created there, and read by readers of that subnet. The -readership and other forms of response are then measured. At the end of -the trial (up to 5 months) the readership of the group is evaluated, and it -is calculated where it would fit into the whole of USENET. If it meets the -criterion, it is moved into the USENET mainstream. If it doesn't it is -simply deleted with a few weeks notice. Readers of the group may elect to -form a mailing list or find another method of distribution. - - JUDGING THE SUITABILITY OF THE TOPIC - -If you wish to create a group, you should ensure that you have a topic that -is likely to experience varied discussion for a long and indefinite period -of time. The purpose of the group should be clear -- not too general -(like, "the IBM PC") and not too specific (like, "squid recipes"). The -topic should not be short lived, unless all you want is a 5 month run in -the trial hierarchy. A general topic should be broken down until you have -something that is important and likely to generate a moderate volume of -discussion. - -There are exceptions to this which you can only learn fully through -experience with USENET. - -Next check to see if there isn't already a group on USENET that covers your -topic. If you find a close match, read that group for a while to see if -your topic gets discussed there. Bring it up yourself it you don't see it -discussed for a while. (This is a strong requirement. You should not -propose a new group if you have no familiarity with groups that might well -already contain discussion of your topic.) - -If it turns out your topic is an offshoot of an existing group, and it is -in fact already heavily discussed in that group, you may wish to split that -group. The trial group system has no mechanism for splitting regular USENET -groups. You must arrange another means to do that. - -If you have a truly new topic and: - - a) It is either different enough from all the other group topics that - it needs its own newsgroup, or - - b) There is a group related to your topic, but the relationship is - marginal, and the volume of discussion your topic would engender is - too high for that group; - -then you may indeed have a suitable topic for a new newsgroup. - -Make sure as well that the topic is appropriate for world wide distribution. -You're going to be sending this discussion over more than 15,000 machines. -(In part, this is what the trial will decide if you aren't sure yourself.) - - STARTING THE TRIAL - -Write up a proposal, listing: - - o) The proposed topic for the newsgroup. If it's an obscure topic, - provide a bit of information about the nature of it. - - o) What sort of discussion you expect to see there. - - o) What hierarchy on USENET you think it might belong in. - - o) A suggestion as to possible names. - - o) Reasons why this topic really doesn't belong in other groups. - - o) Whether or not you plan to moderate a group. (You can't suggest - a moderated group unless you have a moderator ready.) - -(See other postings to trial.newgroups for a model proposal.) - -The name and USENET hierarchy won't be chosen by you, but you can make -suggestions. A good suggestion that is consistent with other existing -names is more likely to be chosen. Note that a good name must be -meaningful to outsiders who are unfamiliar with the topic, so stay away -from acronyms or terms known only to insiders. Unless you want to be -ultra-specific about what takes place in the group, a well understood name -is better than an extremely precise one. - -E-mail the proposal to trialgroup@uunet.uu.net. This will send it to all -of the volunteer trial group moderators, or "judges." In addition, the -software will randomly pick one of these people to be the judge for your -trial group. The judge will be a person with long experience with USENET, -and he or she will offer you help if there is room for improvement in your -proposal. Some further names may also be suggested. Joke proposals will -not be accepted -- a trial newsgroup involves a fair bit of effort and -expense by a lot of people, and no matter how funny a joke is, it won't be -as long lived as the effort in running a trial group. - -[ Don't use the 'trialgroup' address other than to get a judge assigned -to your group. That judge will reply to you -- correspond with him or -her directly thereafter. If you really *have* to mail to all the trial -judges, and not the one(s) involved in your group, you can mail to -trial-judges@uunet.uu.net. ] - -Once a trial name has been decided upon and the proposal finalized, the -trial group will be created by the trial hierarchy judges. You should -then post the finalized proposal to news.announce.newgroups (or mail it -to the moderator at announce-newgroups@ncar.ucar.edu) and trial.newgroups. -(Due to the nature of moderated groups, you can't crosspost; you must post -twice, once to each group.) If there is a group with a related topic, -you should also post the announcement of the new group there. - -Now start using your group. Write a more detailed description of the -group, and post it there. Welcome new users and start discussion. While -(unless you're moderator) you won't own or control the group after creating -it, you might see fit to act as a sort of custodian for the group, helping -new users, preparing lists of frequently asked questions or an introduction -to the group that gets posted every month or two. If you stop reading your -group sometime in the future, you should find another volunteer for that -position. - -Many sites in the trial hierarchy will send in readership reports. If your -site does not do this, look for the "arbitron" program and instructions -posted at the start of every month in news.admin, and get your site -involved. The arbitron results will be posted on the 1st of every month. - -For the first 1-2 months, the results for your group will be artificiallyC -low, since it takes time for results to come in from a wide enough range ofi -sites. Don't be concerned about those early figures.w - -After the 5th readership report to include your group, the day of judgemente -is at hand. All USENET groups, and your group, will be ranked accordingU -to the number of readers per site which gets the group. (Your group willr -only go to the trial subnet, so both numbers will be reduced, keeping then -ratio valid.) "USENET groups" means all the accepted groups in thee -7 main hierarchies of USENET, less those that have been truly dormant foru -several months, in the judge's opinion.t - -If your group ranks among the top 3/4 of USENET groups in readers per site,f -it gets promoted to a USENET group. Right now (May/90) this means ad -readership value of about 1 reader for every 3 sites getting the group, but -that may change as USENET grows. If your group can't find a reader on 2/3 -of the sites it goes to, it's probably not an appropriate topic fora -full-net distribution. - -Either way, pass or fail, mail a reminder of the results to your judge. - -FAILURE: - -An announcement will be made (by you, or failing that, a trial hierarchy -judge) indicating that the group failed the test. This gives you time -to wrap up affairs, or consider the creation of a mailing list devoted toi -the topic. After 2-3 weeks the group will be deleted (rmgrouped). Any -attempts to post to it will result in mail to the poster and the USENET -admin at the poster's site.e - -SUCCESS: - -If the group passes the test, it gets renamed. That means that a USENET -group with an appropriate name will be created. Many sites will alias the -old name to the new name. You should tell all readers of the trial group -about the new name, and get them to switch over. You may crosspost betweent -the two groups for the first week, but after that, you should actively -discourage any crossposting between the groups. After a few more weeks, -the trial group will be deleted, with a few days notice. - -Post once again to news.announce.newgroups, indicating that the group passed -and has now been created within USENET proper. - -Do the same thing in the USENET group that you did in the trial group. -Tell people about the group, and post any standard introductory postings -that you may have written. Welcome the new readers. Then participate in. -the group. - - FAST PROMOTION: - -If a group ever ranks in the top 50% of USENET groups in readers/site, it -can, at your discretion, move over to USENET immediately. Mail to -your judge and request the immediate move. This can happen at any -time, but the group must get this ranking in the top 50% with -results from at least half the trial hierarchy. (ie. if you only get 6a -sites reporting in the first month, and they all have 10 readers, it -doesn't qualify.)t - - REFUSAL OF A TRIALs - -In rather unusual cases, the judges can refuse a serious trial. For -example, an illegal group might cause this to happen. If the judges -can't convince the proponent of the group that it's not a good idea, theye -may decide to register opposition to the trial. At the start of thes -trial -- prior to the group's creation, a vote from 2/3 of the judges -(5 of the 7) can refuse the trial. At the end of the trial, a vote -from 3/4 of the judges (6 of the 7) can stop the group's promotion.d - -Is this a horrible autocratic power? Not at all. If a trial or -promotion is refused by the above veto, the proponent of the group -is still free to use the old discussion/survey method of group creation -- -ie. things fall back to the method we had before the trial hierarchy was -created. Refusing a trial is a very serious move that judges will -do only very rarely -- not simply because they don't like a group, but -rather because they feel it could cause serious damage to the net. To -get 5 or 6 judges to agree to a refusal will mean there's a real -problem, indeed. - - - NAMING - -As described above, a trial name will be decided by the trial judges ine -conjunction with you, the group's "champion." They get the final say. If -there is real feeling that the name is inappropriate, you can discuss this -in your trial group. Proposals for a new name can then be put to theo -trial judges. This may result in a new name if the group is promoted to -full distribution. The final decision, however, remains up to the trial -judges. If they really miss the boat on a couple of names, they won't -be trusted as trial judges for much longer.a - - HIERARCHY - -You can suggest a hierarchy to the trial judges, but the decision is upu -to them. Here are the existing hierarchies: - -COMP - Computer related technical discussion. In general, groups in - COMP are expected to have direct value to a site's commercial ord - academic goals. - -SCI) - Groups about scientific topics, again expected to have direct - value to a site's commercial or academic goals. - -RECu - Groups about recreation, hobbies, sports, entertainment, leisure, - the arts, etc.r - -NEWS - Groups pertaining to USENET and USENET related networking. - -SOC - Groups about social issues and social interaction. The - humanities, etc. (excluding the recreational arts.) - -TALK - Groups about topics that often engender heated or emotional - debate. Politics, religion, abortion, philosophy, text editors,h - discrimination etc. Note that even if a topic seems a perfect - fit for another hierarchy, if it's going to experience a lot of - heated debate and "flaming," then it belongs here. "Social club" - groups, which exist more to talk to friends than to address a - specific topic, also belong here. - -MISC - The rest, including most business related topics. - -ALTn - You don't need a trial to start a group in ALT. Go ahead.t - But the more people "go ahead" without following the guidelines - suggested above (or in the other group creation guidelines) the - more sites that will ignore ALT groups. - -BIZ - The "biz" hierarchy is not part of USENET. The trial.biz - hierarchy, however, exists for the creation of commerce related - groups. Some people love these groups (misc.jobs.offered is oned - of the most popular on USENET) and some people think they have no - place here. "trial.biz" is a place to try out such groups. We'reo - not talking about groups with nothing but hype, but useful groups - (like misc.jobs.offered and misc.forsale) that benefit both the - posters and the readers. When moved into USENET they will - be put into another hierarchy (usually MISC or COMP) dependings - on what's appropriate. If you want to use the top level BIZ - hierarchy, there are no hard and fast rules. Post to biz.config. - -GNU,VMSNET,UNIX-PC,BIONET,CLARI,etc. - These hierarchies are not part of mainstream USENET. They have - their own rules for group creation which you must investigate.o - - NOTES: - -Risky business: - -As noted, any serious group proposal will be created as a trial. You mays -get some advice not to do so from the trial group judges, but if you -insist, it will be done. Some sites, however, will refuse to carryl -quasi-illegal material, such as groups relating to sex, drugs, porn ande -other activities that are illegal or discouraged in some parts of the net. -Their machines are theirs to command, so it is considered polite to warn -everybody about a group with potential danger so that they can make theire -own decisions. - -Appeals: - -If your group fails, it is advised that you not suggest it again for -at least a year, unless something really unusual comes up. It would -take very rare circumstances for the trial judges to restart a trial -in less than six months. - -You can, after a trial fails, go through another group creation process, -such as a discussion/survey. Nobody knows what will happen the first time -somebody tries this. I predict that people won't take kindly to this, but -who knows. (Some people may hate the trial system and support you only fore -that reason.)h - -Autonomous admins: - -Even after your group has a good trial, news administrators on their -own machines are not bound to create, carry or propagate your group. -The fact that it does well makes it pretty likely, but not assured, -particularly at the leafs. This is true in any group creation system. - -Cheating:A - -Deliberate attempts to bias the arbitron statistics are likely to getb -discovered. If you're caught and exposed, it's likely to do you more harm thane -good. If there's proof, the judges will cancel your trial, and even if -there isn't it is likely that you will anger site admins enough that theyr -ignore the group even if it appears to pass the test. A suspect passing -result can be worse than a failed one -- so don't even risk it.e - -Running around making sure reader sites send in their honest readershipl -reports will bias the results somewhat. This is accounted for, and in the -long run, it's good, because those reports will keep coming, and they report -on all trial groups, not just yours. - -The Judges: - -The rules above are deliberately vague to give the judges room to breathe, -and to stop control freaks from pointing out nitpicking technicalt -violations. A technical violation of this procedure is tough, because -things are left open.i - -If you don't like the judges and how they rule, you can always use the -discussion/survey group creation method. - -The only rules the judges must follow are: - o) The current success/fail criteria must be announced in advance.g - o) If there's a conflict of interest, a judge dealing with - a particular group should pass the decision on to anotheru - judge. - o) Decisions can be appealed to a tribunal, where each of the - 3 judges will write a public decision, majority winning. - o) All serious proposals that haven't been done recently should be - accepted if the group's champion insists, but judges are freed - to put a dissenting comment on any such proposal.l - o) A tribunal is selected randomly from the pool of judges, excepting - the judge being appealed. No appeal on a tribunal's decision. - -Other "good ideas" are: - o) Decisions about the final name should be done by a tribunal, - where possible, based on input from the trial group and e-mailed - comments from the net at large.a - o) No simultaneous creation by both methods. Users who do both - may get their trial group summarily deleted for annoying the - judges and giving them extra work to make the user's life easier., - - -Who are the judges?h - -There are 7. I, Brad Templeton, am the first "chief justice." The, -chief justice has no special powers, other than having written this document,w -but hey, the title sounds neat. The other 6 volunteers are all system -admins, from a variety of areas on USENET, who have had several yearsI -experience with USENET and USENET groups. - -All judges will pass on any decision to other volunteer judges -if they have a conflict of interest. (ie. plan to read the group, orm -participate actively in a similar group.)a - -The judges really aren't all that powerful. The *real* decision as to -whether a group gets created belongs with the readers. If they like the -group, it stays, if they don't, it goes. The judges only get final -say on the name, and they get to interpret the minor guidelines. - -Their primary goal is to give advice, as experienced netters, on how -to make a group creation go smoothly. They aren't there to hinder the -process, or fight against it. They get the title "judge" because it soundss -important, and it means that people will avoid arguing with them over silly -nitpicky points. - - -$eod diff --git a/decus/vax92a/bulletin/news.txt b/decus/vax92a/bulletin/news.txt deleted file mode 100644 index 56cc695..0000000 --- a/decus/vax92a/bulletin/news.txt +++ /dev/null @@ -1,150 +0,0 @@ -BULLETIN now has the capability to read and post messages to USENET NEWS in a -client mode. I realize that there are many NEWS readers, some with much more -elegant interfaces. However, I elected to modify BULLETIN for the following -reason: We have many decnet nodes, but only several are internet nodes. Our -only access to a news server was via internet. In order for those -non-internet nodes to read USENET, the only method that seemed available was to -run a NEWS server program on one of our own internet nodes so that it could -be accessible via decnet. I did not want to do that, as that requires storing -the news groups on disk, and I do not have the room for that. I thus added the -ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between -decnet and tcp for NEWS. This method does not require spawning any processes, -since the detached process BULLCP is always present, so the access is very -fast. Also, since BULLETIN uses a shared database to store info on the NEWS -groups and periodically updates it, there is no need for that to be done when a -user accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up. It is also possible to -feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved -on disk. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packages -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS - -BULLETIN decides to use DECNET rather than TCP access based on the node name. -If it does not have any periods in it, then it assumes it is a DECNET node. - -In our cluster, we usually have one node which is an internet node, and the -rest non-internet nodes. If you have a similar situation, you'll have to -create a startup procedure that defines BULL_NEWS_SERVER to be the internet -news server address only on the node (or nodes) on the cluster that have -actually internet access. The other nodes will have BULL_NEWS_SERVER defined -as the decnet node name that BULLCP is running on in the cluster. (Of course, -BULLCP will have to be running on a node with internet access.) - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be allowed -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET access -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP: - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME, -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), but -you are accessing NEWS via DECNET, you can specify the hostname as follows: - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message. -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by defining -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for a -list of all the news groups. Because this is the first time it is executed, it -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. For this reason, it is highly recommeded -that BULLCP be installed. BULLCP will update NEWS every hour. If you want to -change this frequency, define the logical name BULL_NEWS_UPDATE to the number -of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30 -minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the -update. You can watch how long it takes for this to run in order to determine -if you want to change the update period). - -Due to long news group names recently created, you must do the following, or -else those news groups will not be seen. After BULLNEWS.DAT is created, do -the following: - -$ ANAL/RMS/FDL/OUT=FIX.FDL BULL_DIR:BULLNEWS.DAT - -Edit FIX.FDL and find the first line which says - DUPLICATES no -and change it to - DUPLICATES yes - -Then type: - -$ CONVERT BULL_DIR:BULLNEWS.DAT BULL_DIR:BULLNEWS.DAT/FDL=FIX.FDL - -Also, it is suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the -file to be compressed and will allow updates to run much faster (factor of 5 or -more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will cause -subscribed users to be subscribed to the wrong news groups. - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed -NEWS group when entering BULLETIN. If you experience this problem, try -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause -the update to use a different algorithm which should eliminate the problem, -although it requires much more time to execute. - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surrounded -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".) When the POST and -ADD commands are used with this folder, the messages will be posted to the news -group, rather than actually being added to the folder. - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS reader -package to read them. However, it is possible to read NEWS remotely over a -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can read -messages on another node via TCP or DECNET. This is useful, since the number -of NEWS groups total over 1000, the disk space required for storage is very -high. If you are interested in finding a server node that would allow you to -read NEWS, and do not know of one (i.e. a USENET node), I know of no official -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a -USENET node near you to contact. diff --git a/decus/vax92a/bulletin/nonsystem.txt b/decus/vax92a/bulletin/nonsystem.txt deleted file mode 100644 index d0ca2a8..0000000 --- a/decus/vax92a/bulletin/nonsystem.txt +++ /dev/null @@ -1,16 +0,0 @@ -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but only -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have the -subdirectory [.BULL] created, BULLETIN will use that directory as the default -directory to write the file into. - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEW -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages. diff --git a/decus/vax92a/bulletin/optimize_rms.com b/decus/vax92a/bulletin/optimize_rms.com deleted file mode 100644 index fc0b91d..0000000 --- a/decus/vax92a/bulletin/optimize_rms.com +++ /dev/null @@ -1,134 +0,0 @@ -$ SET NOON -$ EXIT_STATUS = 1 -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed" -$ GOTO GET_FILE -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT: -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OK -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME) -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292 -$ GOTO DONE -$! -$FILE_EXISTS: -$ NAME = F$PARSE(FILENAME,,,"NAME") -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN- - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024 -$ GOTO DONE -$! -$TYPE_OK: -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OK -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060 -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK") -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = P4 -$ FDL_NAME = F$PARSE(".FDL;0",SPEC) -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM" -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'" -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT" -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO: -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC" -$ WRITE OUT "NO" -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +- - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO" -$ ENDIF -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC" -$ WRITE OUT "NO" -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP -$! -$CLOSE_FILE: -$ WRITE OUT "E" -$ CLOSE OUT -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;* -$ WRITE SYS$OUTPUT "" -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "" -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUS diff --git a/decus/vax92a/bulletin/remote.com b/decus/vax92a/bulletin/remote.com deleted file mode 100644 index b3c09c7..0000000 --- a/decus/vax92a/bulletin/remote.com +++ /dev/null @@ -1,48 +0,0 @@ -$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK -$! DCL procedure to execute DCL commands on a remote decnet node. -$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0 -$! object on the remote node or the file must be in the login directory -$! of the account used on the remote system. Or the logical name DCLREMOTE -$! can be defined to point at the object. -$! -$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ... -$! -$! P1 - Node name commands are to be executed on, including any access control. -$! If no access control is specified then a proxy login is attempted. -$! The you do not have an account on the remote system then the default -$! DECNET account is used. -$! P2 - DCL command to execute on the remote system. Optional. -$! P3-P8 Additional parameters passed to the command (so quotes aren't needed) -$ -$ ON WARNING THEN GOTO ERROR -$ ON CONTROL_Y THEN GOTO ERROR -$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' -$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE" -$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END" -$ NEXT_CMD = "NEXT_CMD" -$ IF P2 .NES. "" THEN NEXT_CMD = "DONE" -$ P1 = P1 - "::" -$ -$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK -$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD -$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD -$OPEN_LINK: -$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..." -$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE" -$ -$NEXT_CMD: -$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND -$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE -$ WRITE NET COMMAND -$LOOP: -$ READ/ERR=ERROR/TIME_OUT=10 NET LINE -$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD' -$ WRITE SYS$OUTPUT LINE -$ GOTO LOOP -$DONE: -$ IF P2 .EQS. "CONTINUE" THEN EXIT -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ EXIT -$ERROR: -$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET -$ STOP diff --git a/decus/vax92a/bulletin/writemsg.txt b/decus/vax92a/bulletin/writemsg.txt deleted file mode 100644 index 7bb5da4..0000000 --- a/decus/vax92a/bulletin/writemsg.txt +++ /dev/null @@ -1,36 +0,0 @@ -BULLETIN contains subroutines for writing a message directly to a folder. This -would be useful for someone who is using the BBOARD feature, but wants to avoid -the extra overhead of having the message sent to an account as MAIL, and then -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead. - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition. - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -C -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found. -C - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message. -C - - CALL FINISH_MESSAGE_ADD -C -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -C diff --git a/decus/vax92b/bulletin/aaareadme.txt b/decus/vax92b/bulletin/aaareadme.txt deleted file mode 100644 index 87345a1..0000000 --- a/decus/vax92b/bulletin/aaareadme.txt +++ /dev/null @@ -1,60 +0,0 @@ - BULLETIN V2.12 (From Mark London) -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals). - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added. - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. diff --git a/decus/vax92b/bulletin/allmacs.mar b/decus/vax92b/bulletin/allmacs.mar deleted file mode 100644 index 8d0e891..0000000 --- a/decus/vax92b/bulletin/allmacs.mar +++ /dev/null @@ -1,377 +0,0 @@ -; -; Name: SETACC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the account name of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETACC(account) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; account - Character string containing account name -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETACC - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT DATA,NOEXE - -NEWACC: .BLKB 12 ; Contains new account name -; -; Executable: -; - .PSECT CODE,EXE,NOWRT ; Executable code - - .ENTRY SETACC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R6 ; Get number of arguments - CMPL R6,#1 ; Correct number of arguments? - BNEQ 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler -; MOVL @#CTL$GL_PCB,R6 ; Address of current process -; MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block - MOVL PCB$L_JIB(R4),R6 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB - MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUIC.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: May 31, 1983 -; -; Purpose: To set the UIC of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUIC(group number, user number) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; group number - longword containing UIC group number -; user number - longword containing UIC user number -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUIC Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF -; -; Executable: -; - .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUIC,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R2 ; Get number of arguments - CMPL R2,#2 ; Are there 2 arguments - BNEQ 5$ ; If not, return - MOVL @4(AP),R3 ; Group number into R3 - ROTL #16,R3,R3 ; Move to upper half of R3 - ADDL2 @8(AP),R3 ; User number to top half of R3 - $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler -; MOVL @#CTL$GL_PCB,R2 ; Address of current process -; MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified - MOVL R3,PCB$L_UIC(R4) ; Set UIC to specified - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -; -; Name: SETUSER.MAR -; -; Type: Integer*4 Function (MACRO) -; -; Author: M. R. London -; -; Date: Jan 26, 1983 -; -; Purpose: To set the Username of the current process (which turns out -; to be the process running this program.) -; -; Usage: -; status = SETUSER(username) -; -; status - $CMKRNL status return. 0 if arguments wrong. -; username - Character string containing username -; -; NOTES: -; Must link with SS:SYS.STB -; - - .Title SETUSER Set uic - .IDENT /830531/ -; -; Libraries: -; - .LIBRARY /SYS$LIBRARY:LIB.MLB/ -; -; Global variables: -; - $PCBDEF - $JIBDEF -; -; local variables: -; - - .PSECT SETUSER_DATA,NOEXE - -NEWUSE: .BLKB 12 ; Contains new username -OLDUSE: .BLKB 12 ; Contains old username -; -; Executable: -; - .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code - - .ENTRY SETUSER,^M - CLRL R0 ; 0 is error code - MOVZBL (AP),R8 ; Get number of arguments - CMPL R8,#1 ; Correct number of arguments - BLSS 5$ ; If not, return - MOVZBL @4(AP),R6 ; Get size of string - MOVL 4(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string - CMPL R8,#2 ; Old username given? - BLSS 2$ ; No - MOVZBL @8(AP),R6 ; Get size of string - MOVL 8(AP),R7 ; Get address of descriptor - MOVL 4(R7),R7 ; Get address of string - MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string - $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode - TSTL R0 ; If old username is checks with - BEQL 2$ ; present process name, change - MOVL #2,R0 ; to new username, else flag - RET ; error and return -2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode -5$: RET -10$: .WORD ^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler -; MOVL @#CTL$GL_PCB,R7 ; Address of current process -; MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: MOVC destroys r0-r5 - MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB - MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 - MOVZWL #SS$_NORMAL,R0 ; Normal ending - RET -20$: .WORD ^M ; Entry mask - MOVAB KMODE_EHAND,(FP) ; Exception handler -; MOVL @#CTL$GL_PCB,R7 ; Address of current process -; MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block - MOVL PCB$L_JIB(R4),R7 ; Address of Job Info Block - ; NOTE: CMPC destroys r0-r5 - CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB - RET - - .SBTTL KMODE error handler - -; This error handler should prevent those embarrasing crashes when you woof -; in kernel mode. It doesn't try to fix anything, it just unwinds the stack -; and saves the error signal status. Good for little things like division -; by zero or access violations etc. If you destroy an important system data -; structure this handler wont be able to fix it and the system will eventually -; crash. -; -; Written by Anthony C. McCracken, Northern Arizona University. -; 25-SEP-1992 -; -; I was tired of rebooting the machine after silly coding errors. :) -; - .ENTRY KMODE_EHAND,^M - MOVL 4(AP),R5 ; Get the signal array - CMPL 4(R5),#SS$_UNWIND - BNEQ 10$ ; Just return if were already - RET ; unwinding -10$: MOVL 8(AP),R6 ; Get the mechanism array - MOVL 4(R5),12(R6) ; Stash the error code - $UNWIND_S ; and unwind back out - RET - - - .TITLE READ_HEADER - Read Image Header - .IDENT /1-001/ - -; This subroutine returns the image identification and link time. -; -; Format: -; -; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] ) -; -; Parameters: -; -; ident The image identification text. -; -; time The image link time (text format). - - -; Date By Comments -; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 - -; obtained from April 87 DECUS L&T Sig Newsletter - .LIBRARY "SYS$LIBRARY:LIB" - - $DSCDEF - $IHDDEF - $IHIDEF - $SSDEF - -; Argument pointer offsets - - $OFFSET 4,POSITIVE, - - .PSECT READ_HEADER, RD, NOWRT, EXE, LONG - .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 > - - CMPL (AP),#1 ; Make sure that there is at least - BGEQ ENOUGH_ARGUMENTS ; one argument to this routine - MOVL #SS$_INSFARG, R0 - RET - -ENOUGH_ARGUMENTS: - -; Get the identification of the image. - - MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer - MOVL (R11), R6 ; R6 - Address of image header - - CVTWL IHD$W_IMGIDOFF(R6), R7 - MOVAB (R6)[R7], R7 ; R7 - Address of ID Block - - CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string - MOVL IDENT(AP), R8 - MOVC5 R0, (R7), #32, - - DSC$W_LENGTH(R8), @DSC$A_POINTER(R8) - - CMPL (AP), #2 - BGEQ RETURN_TIME - MOVZBL #1, R0 - RET - -RETURN_TIME: - -; Get the time the image was linked and convert it to ASCII - - $ASCTIM_S - - TIMBUF=@TIME(AP), - - TIMADR=IHI$Q_LINKTIME(R7) - - RET - - .MACRO M$$DEFERRED_CALL, IMAGE, NAME, NAME1 -; -; Defer image activation on this routine -; - .PSECT $LOCAL,PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG - IMAGE_'NAME: .ASCID /IMAGE/ - SYMBOL_'NAME: .ASCID /NAME1/ - ADDRESS_'NAME: .BLKL 1 - FIND_'NAME: .LONG 3e - .ADDRESS IMAGE_'NAMEu - .ADDRESS SYMBOL_'NAME - .ADDRESS ADDRESS_'NAME - .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONGt - .ENTRY 'NAME,^M - CALLG G^FIND_'NAME',G^LIB$FIND_IMAGE_SYMBOL - ADDL3 #2,G^ADDRESS_'NAME,R2 - JMP (R2). - .ENDM M$$DEFERRED_CALLC - - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY gethostbyname1 gethostbyname - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY htons1 htons - M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY gethostname1 gethostname - - .ENDo -.title Get_AP - Obtains the callers argument pointer -; -; Function: -;E -; Returns the address of the argument list for the preceeding Stack Framee -; as a Function Value and loads its only Formal Argument with the value; -; stored at that location, the number of argument pointers in the list.A -;R -; Example:e -; -; program Test_AP -; Ca -; C The following is a FORTRAN example of use of the Get_AP subroutine. -; C# -; call Test( 1, 2, 3, 4 )e -; end$ -;R -; subroutine Testt -; implicit integer (A-Z) -; Pointer = Get_AP( Count ) -; call List_AP( %val(Pointer) ) -; write(6,10)Count -; return -; 10 format(1X,I2,' arguments were passed to me.') -; endd -;s -; subroutine List_AP( Pointer )4 -; integer Pointer(*) -; write(6,10)Pointer(1)d -; return -; 10 format(1X,I2,' arguments were passed to my caller.')3 -; endC -;T -; Author: -;n -; Chris Hume 7-Sep-1982S -;N -$SFDEF ; Stack Frame definitions - -Arg_Pointer = 4 ; Pointer to get argument list adr - -.entry Get_AP,^m<> - - moval @SF$L_Save_AP(fp),r0 ; Get AP for previous Frame. - tstl (ap) ; Check for presence of Our Formal. - beqlu 10$ ; Exit if not present,s - moval @Arg_Pointer(ap),r1 ; or if the Address is Null.r - beqlu 10$ - movzbl (r0),(r1) ; Copy argument count.0 -10$: ret - -.end diff --git a/decus/vax92b/bulletin/bull_news.c b/decus/vax92b/bulletin/bull_news.c deleted file mode 100644 index 96b9f9b..0000000 --- a/decus/vax92b/bulletin/bull_news.c +++ /dev/null @@ -1,414 +0,0 @@ -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h" -#include "multinet_root:[multinet.include.netinet]in.h" -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#if UCX - -#include - -struct sockaddr { - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8]; - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2]; -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs; - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev); - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#else - -#if TWG - -#include -#include -#include -#include -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet); - -#else - -#define CMU 1 -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip); - -#endif - -#endif - -#endif - -static char task[20]; -$DESCRIPTOR(task_d,task); - -static int s; - -static struct iosb { - short status; - short size; - int info; -} iosb; - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -news_get_chan() -{return(s);} - -news_set_chan(i) -int *i; -{s = *i;} - -news_disconnect() -{ -#if UCX - sys$cancel(s); - sys$qiow(0,s,IO$_DEACCESS,0,0,0,0,0,0,0,0,0); -#endif - sys$dassgn(s); -} - -#if MULTINET || TWG - -static struct hostent *hp; -static struct sockaddr_in sin; - -#endif - -int *node; - -news_gethost() -{ - /* - * Get the IP address of the NEWS host. - * As of MULTINET 3.0, cannot be done at AST level - * so can't do in NEWS_ASSIGN(), as BULLCP calls it at - * AST level if the decnet gateway feature is used. - */ -#if TWG || (MULTINET && defined(__GNUC__)) - struct hostent *gethostbyname(); -#else -#if MULTINET - struct hostent *GETHOSTBYNAME1(); -#endif -#endif - - node = getenv("BULL_NEWS_SERVER"); - if (!node) return(0); - if (!strchr(node,'.')) return(1); - -#if TWG || (MULTINET && defined(__GNUC__)) - hp = gethostbyname(node); -#else -#if MULTINET - hp = GETHOSTBYNAME1(node); -#endif -#endif - return(1); -} - -news_assign() -{ - int n; - - if (!strchr(node,'.')) { - strcpy(&task[0],node); - n = strlen(node); - strcpy(&task[n],"::\"TASK=NNTP\""); - task_d.dsc$w_length = 13 + n; - if (!(sys$assign(&task_d,&s,0,0) & 1)) return(0); - mode = DECNET; - return(1); - } -#if MULTINET || TWG - /* - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()). - */ - - if (!hp) { - int h[4],i; - if (sscanf(node,"%d.%d.%d.%d",&h[0],&h[1],&h[2],&h[3]) == 4) { - for (i=0;i<4;i++) if (h[i] < 0 || h[i] > 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0); - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length); - } -#if TWG || (MULTINET && defined(__GNUC__)) - sin.sin_port = htons(119); -#else - sin.sin_port = HTONS1(119); -#endif - - /* - * Create an IP-family socket on which to make the connection - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#else -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0); - { - short retlen; - struct dsc$descriptor host_name - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor command - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm}; - struct dsc$descriptor host_ad - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb; - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0, - &command,&host_name,&retlen,&host_ad,0,0) & 1) - || !(nam_iosb.status & 1)) { - sys$dassgn(s); - return(0); - } - } -#else - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1); -} - -news_socket() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#endif - - return(1); -} - -news_socket_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0); -#else -#if UCX - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET; - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host; - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0); -#else - return(-1); -#endif -#endif - - return(1); -} - -news_create() -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1) - || !(iosb.status & 1)) { - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0, - UCX$C_DSC_ALL,0,0); - sys$dassgn(s); - return(0); - } -#else - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1) - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1); -} - -news_create_bullcp(efn,biosb,astadr,astprm) -int *biosb,*astadr,*astprm,*efn; -{ - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0); -#else -#if UCX - remote_host.inet_family = INET$C_AF_INET; - remote_host.inet_port = htons(119); - remote_host.inet_adrs = addr_buff; - rhst_adrs.lgth = sizeof remote_host; - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node, - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1); -} - -news_connect() -{ - if (!news_gethost()) return(0); - if (!news_assign()) return(0); - if (!news_socket()) return(0); - return(news_create()); -} - -news_write_packet(buf) - -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; -#if CMU - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#else - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1); -} - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len) -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{ -#if CMU - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,!mode,0,0) & 1)) return(0); -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0); -#endif - - return(1); -} - -news_read_packet(buf) -struct dsc$descriptor_s *buf; -{ - static int n,len; - - len = buf->dsc$w_length; - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size; - - return(n); -} - -news_gethostname(buf) - -struct dsc$descriptor_s *buf; -{ - if (mode == DECNET) return (-1); -#if TWG || (MULTINET && defined(__GNUC__)) - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#else -#if MULTINET - return(GETHOSTNAME1(buf->dsc$a_pointer, buf->dsc$w_length)); -#else - return(-1); -#endif -#endif -} diff --git a/decus/vax92b/bulletin/bull_newsdummy.for b/decus/vax92b/bulletin/bull_newsdummy.for deleted file mode 100644 index 8aeb717..0000000 --- a/decus/vax92b/bulletin/bull_newsdummy.for +++ /dev/null @@ -1,83 +0,0 @@ - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURN - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURN - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - RETURN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L) - - RETURN - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N) - - RETURN - END - - - SUBROUTINE NEWS_DISCONNECT - - RETURN - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE. - - RETURN - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - RETURN - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF) - - CHARACTER*(*) BUF - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF) - - CHARACTER*(*) BUF - - RETURN - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - RETURN - END diff --git a/decus/vax92b/bulletin/bullcom.cld b/decus/vax92b/bulletin/bullcom.cld deleted file mode 100644 index 3c01f45..0000000 --- a/decus/vax92b/bulletin/bullcom.cld +++ /dev/null @@ -1,641 +0,0 @@ -! -! BULLCOM.CLD -! -! VERSION 12/6/92 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDIT - DISALLOW SYSTEM AND GENERAL - DISALLOW PERMANENT AND SHUTDOWN - DISALLOW PERMANENT AND EXPIRATION - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER - DEFINE VERB COPY - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGE - QUALIFIER ORIGINAL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATE - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLE - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -! -! Make the following qualifier DEFAULT if you want CREATE to be -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLE - QUALIFIER PRIVATE, NONNEGATABLE - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLE - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE) - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER) - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEGATED - DISALLOW NEGATED AND - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY) - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES) - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES) - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) AND - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER FOLDER - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULT - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command. - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED), - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULT - QUALIFIER NEW, NONNEGATABLE - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALL - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW, DEFAULT - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULT - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAIL - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST) - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULT - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTION - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNER - DEFINE VERB MOVE - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGE - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER COUNT - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBE - QUALIFIER NEWGROUPS - QUALIFIER ALL - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED) - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE - DEFINE VERB NEXT - QUALIFIER EDIT, NEGATABLE - DEFINE VERB POST - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULT - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULT - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOW - QUALIFIER ALL - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUIT - DEFINE VERB READ - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PAGE, DEFAULT - QUALIFIER POST, DEFAULT - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME) - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER NOSIGNATURE - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER NOSIGNATURE - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCH - PARAMETER P1, LABEL=SEARCH_STRING - QUALIFIER EDIT - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED) - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER REVERSE - QUALIFIER FROM - QUALIFIER SUBJECT - QUALIFIER NEGATED - DISALLOW SEARCH_STRING AND REPLY - DEFINE VERB SEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECT - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODE - KEYWORD NONODE, SYNTAX = SET_NONODE - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERIC - KEYWORD NOGENERIC, SYNTAX=SET_GENERIC - KEYWORD LOGIN, SYNTAX=SET_LOGIN - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARD - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS - KEYWORD BRIEF, SYNTAX=SET_FLAGS - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS - KEYWORD SHOWNEW, SYNTAX=SET_FLAGS - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGS - KEYWORD ACCESS, SYNTAX=SET_ACCESS - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDER - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIRE - KEYWORD NOPROMPT_EXPIRE - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE - KEYWORD STRIP - KEYWORD NOSTRIP - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLY - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - DEFINE SYNTAX SET_NODE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED) - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER PERMANENT - QUALIFIER NOPERMANENT - QUALIFIER ALL, NONNEGATABLE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_BBOARD - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAME - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER) - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLE - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLY - DEFINE SYNTAX SET_NEWS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED) - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, - TYPE=$NUMBER) - QUALIFIER PRIVATE - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE) - DEFINE SYNTAX SET_ACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGES - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges" - VALUE (REQUIRED,LIST) - DEFINE SYNTAX SET_DEFAULT_EXPIRE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOW - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) -! -! The following are defined to allow qualifiers to be specified -! directly after the SHOW command, i.e. SHOW/FULL FOLDER. -! Otherwise, the CLI routines will reject the command, because it -! first attempts to process the qualifier before process the parameter, -! so it has no information the qualifiers are valid. -! - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE - QUALIFIER ALL, SYNTAX=SHOW_USER - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER - QUALIFIER LOGIN, SYNTAX=SHOW_USER - QUALIFIER NOLOGIN, SYNTAX=SHOW_USER - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USER - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONS - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGS - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINT - DISALLOW PRINT AND SHOW_KEY - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALL - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN - QUALIFIER NOLOGIN - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWN - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARK - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE diff --git a/decus/vax92b/bulletin/bullcoms1.hlp b/decus/vax92b/bulletin/bullcoms1.hlp deleted file mode 100644 index 478433b..0000000 --- a/decus/vax92b/bulletin/bullcoms1.hlp +++ /dev/null @@ -1,1047 +0,0 @@ -1 ADD -Adds a message to the specified folder. A file can be specified which -contains the message. Otherwise, BULLETIN will prompt for the text. -BULLETIN will ask for an expiration date and a header to contain the -topic of the message. - - Format: - ADD [file-name] -2 /ALL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, all terminals are sent the -message. Otherwise, only users are sent the message. -2 /BELL -This option is restricted to privileged users. It is used in conjunction -with the /BROADCAST qualifier. If specified, the bell is rung on the -terminals when the message is broadcasted. -2 /BROADCAST -This option is restricted to privileged users and SYSTEM folders. If -specified, a message is both stored and broadcasted to all users logged -in at the time. If the folder is remote, a message will be broadcast on -all nodes which are connected to that folder, unless /LOCAL is specified. -A node which does not have BULLCP running cannot have a message -broadcasted to it, (even though it is able to create a remote folder). - -See also /ALL and /BELL. -2 /CLUSTER - /[NO]CLUSTER - -This option specifies that broadcasted messages should be sent to all -nodes in the cluster. /CLUSTER is the default. -2 /EDIT - /[NO]EDIT -Determines whether or not the editor is invoked to edit the message -you are adding. /EDIT is the default if you have added /EDIT to your -BULLETIN command line. -2 /EXPIRATION - /EXPIRATION=time - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. -2 /EXTRACT -Specifies that the text of the previously read message should be included -at the beginning of the new message. The previous message must be in the -same folder. This qualifier is valid only when used with /EDIT. The -text is indented with > at the beginning of each line. This can be -suppressed with /NOINDENT. -2 /FOLDER - /FOLDER=(foldername,[...]) - -Specifies the foldername into which the message is to be added. Does -not change the current selected folder. Folders can be either local or -remote folders. Thus, a nodename can precede the foldername (this -assumes that the remote node is capable of supporting this feature, i.e. -the BULLCP process is running on that node. If it is not, you will -receive an error message). If the the foldername is specified with only -a nodename, i.e. FOO::, the foldername is assumed to be the default -folder. NOTE: Specifying remote nodes is only possible if that remote -node is running a special BULLCP process. If it isn't, the only way to -add messages to that remote node is via the /NODE command. /FOLDER, -however, is a much quicker method, and much more versatile. - -You can specify logical names which translate to one or more folder -names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify -ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required. - -When using /FOLDER for remote nodes, proxy logins are used to determine -if privileged options are allowed. If they are not allowed, the message -will still be added, but without the privileged settings. -2 /LOCAL -Specifies that when /BROADCAST is specified for a remote folder, the -message is broadcasted ONLY on the local node. -2 /NODES - /NODES=(nodes[,...]) - -Specifies to send the message to the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. (See -installation notes). You can specify a different username to use at the -other nodes by either using the USERNAME qualifier, or by specifying the -nodename with 2 semi-colons followed by the username, i.e. -nodename::username. If you specify a username, you will be prompted for -the password of the account on the other nodes. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then -specify /NODES=ALL_NODES. Note that the quotation marks are required. - -NOTE: It is preferable to use /FOLDER instead of /NODE if possible, -since adding messages via /FOLDER is much quicker. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /PERMANENT -If specified, message will be a permanent message and will never expire. -If an expiration limit is set, then permament is not allowed unless -user has privileges. -2 /SUBJECT - /SUBJECT=description - -Specifies the subject of the message to be added. -2 /SHUTDOWN - /SHUTDOWN[=nodename] -This option is restricted to privileged users. If specified, message -will be automatically deleted after a computer shutdown has occurred. -This option is restricted to SYSTEM folders. - -If the bulletin files are shared between cluster nodes, the message -will be deleted after the node on which the message was submitted from -is rebooted. If you wish the message to be deleted after a different -node reboots, you have the option of specifying that node name. - -NOTE: If the folder is a remote folder, the message will be deleted -after the remote node reboots, not the node from which the message was -added. The nodename cannot be specified with a remote folder. -2 /SYSTEM -This option is restricted to privileged users. If specified, message -is both saved in the folder and displayed in full as a system message -when a user logs in. System messages should be as brief as possible to -avoid the possibility that system messages could scroll off the screen. -This option is restricted to SYSTEM folders. -2 /USERNAME -Specifies username to be used at remote DECNET nodes when adding messages -to DECNET nodes via the /NODE qualifier. -1 ATTACH -Permits you to switch control of your terminal from your current -process to another process in your job. - -The ATTACH command allows you to move quickly between processes that -you have created with the SPAWN command. For example, while you are -editing a file, you can SPAWN a subprocess to read a new message. -Enter the ATTACH command to get back to back to the editing session. -If you want to read another new message, you can use the ATTACH command -to get back to the BULLETN subprocess you already created. - - Format: - - ATTACH [/PARENT] [process-name] -2 Parameters - - process-name - - Indicates the name of the subprocess to which the connection is to - be made. Only the /PARENT qualifier or a process-name may be specified. - -2 Qualifiers - -/PARENT - - Allows you to attach to your process' parent process. - If there is no parent process an error message is printed. - - -2 Examples - - 1. - $ SPAWN BULLETIN - %DCL-S-SPAWNED, process MAGNANI_3 spawned - %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3 - BULLETIN> ATTACH MAGNANI_2 - %DCL-S-RETURNED, control returned to process MAGNANI_2 - $ ATTACH MAGNANI_3 - BULLETIN> - - - This example shows how to spawn subprocesses (MAGNANI_2 and - MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH - command allows you to transfer control between subprocesses. - - - NOTE - - You always SPAWN a new process and ATTACH to a process that - already exists. -1 BACK -Displays the message preceding the current message. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -1 BULLETIN -The BULLETIN utility permits a user to create a message for reading by -all users. Users are notified upon logging in that new messages haveo -been added, and what the topic of the messages are. Actual reading of -the messages is optional. (See the command SET READNEW for info on -automatic reading.) Messages are automatically deleted when their -expiration date has passed.g -1 CHANGE -Replaces or modifies existing stored message. This is for changing part -or all of a message without causing users who have already seen theS -message to be notified of it a second time. You can select qualifiers sos -that either the message text, expiration date, or the header are to be -changed. If no qualifier is added, the default is that all these parameters -are to be changed. If the text of the message is to be changed, a file cane -be specified which contains the text. If the editor is used for changingn -the text, the old message text will be extracted. This can be suppressedt -by the qualifier /NEW. - - Format:( - CHANGE [file-name] -2 /ALL -Makes the changes to all the messages in the folder. Only the expiration -date and message headers can be changed if this qualifier is specified. -2 /EDITt - /[NO]EDIT -Determines whether or not the editor is invoked to edit the messageo -you are replacing. The old message text is read into the editor unlessi -a file-name or /NEW is specified. /EDIT is the default if you have. -added /EDIT to your BULLETIN command line. -2 /EXPIRATIONa - /EXPIRATION[=time]s - -Specifies the time at which the message is to expire. Either absolute -time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be -used. If no time is specified, you will be prompted for the time. -2 /GENERAL -Specifies that the message is to be converted from a SYSTEM message to -a GENERAL message. -2 /HEADERt -Specifies that the message header is to be replaced. You will ben -prompted for the new message description.. -2 /NEW -If the editor is to be used for replacing the text of the message, -NEW specifies not to read in the old message text, and that a totallye -new text is to be read in. -2 /NUMBERa - /NUMBER=message_number[-message_number1]a - -Specifies the message or messages to be replaced. If this qualifier is -omitted, the message that is presently being read will be replaced.a -A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration -date and message headers can be changed if a range is specified. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /PERMANENT -Specifies that the message is to be made permanent.t -2 /SHUTDOWN[=nodename] -Specifies that the message is to expire after the next computer, -shutdown. This option is restricted to SYSTEM folders.e -2 /SUBJECT - /SUBJECT=descriptione - -Specifies the subject of the message to be added., -2 /SYSTEM -Specifies that the message is to be made a SYSTEM message. This is am -privileged command and is restricted to SYSTEM folders., -2 /TEXTg -Specifies that the message text is to be replaced. -1 COPY -Copies a message to another folder without deleting it from the -current folder.e - - Format: - - COPY folder-name [message_number][-message_number1]o - -The folder-name is the name of the folder to which the message is to beN -copied to. Optionally, a range of messages which are to be copied can bed -specified following the folder name, i.e. COPY NEWFOLDER 2-5.p - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to copy all the messages in the old folder.w -2 /GROUPSe - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message tol -the specified NEWS group(s) in addition to the selected NEWS group. -2 /HEADERy - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied.S -The default is /NOHEADER.m -2 /MERGE -Specifies that the original date and time of the copied messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large. -2 /ORIGINALs -Specifies that the owner of the copied message will be the original ownere -of the message. The default is that the copied message will be owned by -the person copying the message.u -1 CREATE -Creates a folder of messages. This is similar to the folders in the VMS -MAIL utility. Folders are often created so that messages of a similar -topic are grouped separately, or to restrict reading of certain messages -to specified users. Once created, that message is automatically -selected (see information on SELECT command). The commands that can be -used to modify the folder's characteristics are: MODIFY, REMOVE, SET -ACCESS, SET BBOARD, SET NODE, and SET SYSTEM.S - - Format: - CREATE folder-name - -The folder-name is limited to 25 letters and must not include spaces or -characters that are also invalid in filenames (this is because the -folder is stored in a file name created with the folder name). - -NOTE: Creation of folders may be a restricted command if the installer -has elected to install it as such. This is done by modifying -BULLCOM.CLD. -2 /ALWAYSm -Specifies that the folder has the ALWAYS attribute. This causes -messages in the folder to be displayed differently when logging in. -SYSTEM messages will be displayed every time a user logs in, rather than -just once. Non-SYSTEM message will also be displayed every time (in -whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the -user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read. -2 /ADD_ONLYe -Specifies that the folder has the ADD_ONLY attribute. If a mailingy -address is present (see /DESCRIPTION), when messages are added to them -folder, they will also be mailed to the address. Users are preventedd -from using the POST command. Instead, the ADD command will be used if -the POST command is entered. One use for this is a local board which is -also distributed to non-local users. -2 /BRIEF -Specifies that all users automatically have BRIEF set for this folder. -Only a privileged user can use this qualifier. (See HELP SET BRIEF for -more information.) -2 /DESCRIPTION - /DESCRIPTION=descriptions - -Specifies the description of the folder, which is displayed using the -SHOW FOLDER command. If omitted, you are prompted for a description.s - -If this folder is to receive messages from a network mailing listy -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in theE -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST - -If a mailer protocol is needs to be added to the network address inN -order for it to be sent by VMS MAIL, i.e. protocol%"address", the -appropriate protocol can be specified by either hardcoding it into the -file BULLNEWS.INC before compiling BULLETIN, or by defining the system -logical name BULL_NEWS_MAILER (it is the same protocol used by the NEWS -feature in order to respond to NEWS messages). The default protocol is -IN%. If desired, you can specify the protocol with the address, i.e. - - INFOVAX MAILING LIST -2 /IDs -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presentlyi -assigned to it. Any process which has that identifier assigned to itp -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NODEA - /NODE=nodeT - -Specifies that the folder is a remote folder at the specified node. -A remote folder is a folder in which the messages are actually storedv -on a folder at a remote DECNET node. The specified node is checked to -see if a folder of the same name is located on that node. If so, the -folder will then be modified to point to that folder. For example ifi -there was a folder on node A with name INFO, and you issued the command: - CREATE INFO/NODE=A -from node B, then if INFO is selected on node B, you will actually -obtain the folder INFO on node A. In this manner, a folder can be sharede -between more than one node. This capability is only present if the BULLCP -process is running on the remote node via the BULL/STARTUP command.r -If the remote folder name is different from the local folder name, the -remote folder name is specified using the /REMOTENAME qualifier. - -NOTE: If a message is added to a remote node, the message is storeda -immediately. However, a user logging into another node might not be -immediately alerted that the message is present. That information is -only updated every 15 minutes (same algorithm for updating BBOARDi -messages), or if a user accesses that folder. Thus, if the folder is -located on node A, and the message is added from node B, and a user logs -in to node C, the BULLETIN login notification might not notify the usere -of the message. However, if the message is added with /BROADCAST, the -message will be broadcasted immediately to all nodes. -2 /NOTIFYh -Specifies that all users automatically have NOTIFY set for this folder.- -Only a privileged user can use this qualifier. (See HELP SET NOTIFY for -more information.) -2 /OWNER - /OWNER=username -Specifies the owner of the folder. This is a privileged command.S -See also /ID.o -2 /POST_ONLY -Specifies that the folder has the POST_ONLY attribute. This causes -the ADD command to mail the message to the mailing address if it is -present (see /DESCRIPTION), rather than add to the folder. -2 /PRIVATE -Specifies that the folder can only be accessed by users who have beene -granted access via the SET ACCESS command. Note: This option uses ACLs1 -and users who are granted access must be entered into the Rights Data Base. -If the RDB does not exist on your system, a privileged user will have to -create it. If a user is not in the RDB, this program will automatically -enter the user into it (unless this feature was disabled during the -compilation of this program). NOTE: See HELP SET ACCESS for more info.a -2 /READNEW -Specifies that all users automatically have READNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET READNEW for -more information.) -2 /REMOTENAME - /REMOTENAME=foldernameo -Valid only if /NODE is present, i.e. that the folder is a remote folder. -Specifies the name of the remote folder name. If not specified, it is -assumed that the remote name is the same as the local name.s -2 /SHOWNEW -Specifies that all users automatically have SHOWNEW set for this folder. -Only a privileged user can use this qualifier. (See HELP SET SHOWNEW fore -more information.) -2 /SEMIPRIVATE -Similar to /PRIVATE, except that the folder is restricted only witha -respect to adding or modifying messages. All users can read the folder. -2 /SYSTEMo -Specifies that the folder is a SYSTEM folder. A SYSTEM folder iss -allowed to have SYSTEM and SHUTDOWN messages added to it. This is a -privileged command.D - i -If this is a remote folder, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder. -1 Ctrl-C -Except for when BULLETIN is awaiting input from the terminal, a -CTRL-C will cause BULLETIN to abort the execution of any command. If -BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN -to return to the BULLETIN> prompt. If for some reason the user wishes -to suspend BULLETIN, CTRL-Y will usually do so. However, this is nott -always true, as BULLETIN will ignore the CTRL-Y if it has a data filef -opened at the time. (Otherwise it would be possible to put the files -in a state such that they would be inaccessible by other users.) -1 CURRENTf -Displays the beginning of the message you are currently reading. If -you are reading a long message and want to display the first part -of the message again, you can enter the CURRENT command. - - Format:i - - CURRENT -2 /EDITn -Specifies that the editor is to be used to read the message. This iss -useful for scanning a long message.A -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commandt -is set for the folder, it will change the default to be /HEADER. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -1 DELETE -Deletes the specified message. If no message is specified, the current -message is deleted. Only the original owner or a privileged user can -delete a message. Note that the message is not deleted immediately, but -its expiration is set 15 minutes in the future. This is to allow a user -to recover the message using the UNDELETE command. If you want theg -message deleted immediately, use the /IMMEDIATE qualifier. - - Format: - DELETE [message_number][-message_number1]f - -The message's relative number is found by the DIRECTORY command. It isb -possible to delete a range of messages by specifying two numbers -separated by a dash, i.e. DELETE 1-5. However, a range cannot ber -specified if the folder is remote. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to delete all the messages in the folder. Note: This willp -not work for remote folders. Only one message can be deleted from a -remote folder at a time. -2 /IMMEDIATE -Specifies that the message is to be deleted immediately. Not applicable -to news groups that are stored on disk.e -2 /LOCAL -Only used with news groups stored on disk. Only the local message wille -be deleted. No delete message will be sent to the Usenet network to -delete the message at other nodes. -2 /NODES - /NODES=(nodes[,...])v - -Specifies to delete the message at the listed DECNET nodes. The BULLETIN -utility must be installed properly on the other nodes. You can specifyO -a different username to use at the other nodes by either using the -USERNAME qualifier, or by specifying the nodename with 2 semi-colons -followed by the username, i.e. nodename::username. If you specify a -username, you will be prompted for the password of the account on the -other nodes. The /SUBJECT must be specified to identify the specificd -message that is to be deleted. - -Additionally, you can specify logical names which translate to one or -more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and thenO -specify /NODES=ALL_NODES. Note that the quotation marks are required. -2 /SUBJECT - /SUBJECT=subjectt - -Specifies the subject of the bulletin to be deleted at a remote DECNET -node. The DECNET node must be specified with the /NODE qualifier. -The specified subject need not be the exact subject of the message.B -It can be a substring of the subject. This is in case you have forgottenr -the exact subject that was specified. Case is not critical either.s -You will be notified if the deletion was successful. -See also /NEGATED. -2 /USERNAMEL -Specifies username to be used at remote DECNET nodes when deleting messagesi -on other DECNET nodes via the /NODE qualifier. -1 DIRECTORYp -Lists a summary of the messages. The message number, submitter's name,w -date, and subject of each message is displayed. - - Format:o - - DIRECTORY [folder] - -If a folder is specified, that folder is selected before the directory -is listed. Unless otherwise specified, listing starts with the first -newest message. If there are no new messages, listing will start at the -first message, or if a message has already been read, it will start at -that message.y -2 /ALL -Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN, -or /UNSEEN were previously specified. -2 /DESCRIBE -Valid when used with /FOLDERS. Specifies to include description ofd -folder. -2 /EXPIRATIONr -Shows the message's expiration date rather than the creation date. -2 /END - /END=message_number - -Indicates the last message number you want to display. -2 /FOLDERS -Lists the available message folders. Shows last message date and number -of messages in folder. An asterisk (*) next to foldername indicates -that there are unread messages in that folder. This will not show -newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS. -2 /FROMm - /FROM=[string]l - -Specifies that only messages whose username contains the specified stringi -are to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.t -See also /NEGATED. -2 /NEGATED -Used with /SUBJECT, /FROM, & /SEARCH. If specified, messages who don'tg -match the specified search command are displayed.d -2 /MARKEDi -Lists messages that have been marked (indicated by an asterisk). -This is equivalent to selecting the folder with /MARKED, i.e. only -marked messages will be shown and be able to be read. To see alls -messages, use either /ALL, or reselect the folder. r -2 /UNMARKEDe -Lists messages that have not been marked (marked messages are indicatedy -by an asterisk). Using /UNMARKED is equivalent to selecting the folderu -with /UNMARKED, i.e. only unmarked messages will be shown and be ableE -to be read. To see all messages, use either /ALL, or reselect the -folder. -2 /SEENo -Lists messages that have been seen (indicated by a greater than sign). t -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlye -seen messages will be shown and be able to be read. To see allf -messages, use either /ALL, or reselect the folder. n -2 /UNSEENs -Lists messages that have not been seen (seen message are indicated by ao -greater than sign). Using /UNSEEN is equivalent to selecting the folderr -with /UNSEEN, i.e. only unseen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. , -2 /NEW -Specifies to start the listing of messages with the first unread -message. -2 /NEWSe -Lists the available news groups. This does the same thing as the NEWS -command. See that command for qualifiers which apply. -2 /PRINT -Specifies that the text of the messages which are found by the -DIRECTORY command are to be printed. All qualifiers which are valid -for the PRINT command are valid in conjunction with /PRINT. The list -of messages to be printed will be displayed on the terminal (ine -nopaging format). -2 /REPLY -Specifies that only messages which are replies to the current messageO -are to be displayed. This cannot be used in conjunction with /MARKED. -2 /NOREPLIES -Specifies that only messages which are not replies (i.e. whose subject -do not start with RE:) are to be displayed. This cannot be used in -conjunction with /MARKED.w -2 /SEARCHc - /SEARCH=[string]f - -Specifies that only messages which contain the specified string areh -to be displayed. This cannot be used in conjunction with /MARKED. -If no string is specified, the previously specified string is used.c -See also /NEGATED. -2 /SINCE - /SINCE=date - -Displays a listing of all the messages created on or after the -specified date. If no date is specified, the default is TODAY.S -2 /START - /START=message_number - -Indicates the first message number you want to display. For example, -to display all the messages beginning with number three, enter the -command line DIRECTORY/START=3. Not valid with /FOLDER. -2 /SUBJECT - /SUBJECT=[string] - -Specifies that only messages which contain the specified string in it'sy -subject header are to be displayed. This cannot be used in conjunctionC -with /MARKED. If no string is specified, the previously specified strings -is used. -1 EXCLUDEs -Specifies to exclude reading messages based on the message owner or theR -subject. If it is determined that a message is to be excluded, then -the message is skipped when a user tries to read a message by typing -NEXT or BACK, or by hitting the return key. - - Format:n - EXCLUDE [string] - -If a string is specified, then the message is excluded if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all EXCLUDEs. -2 /DISABLE -Specifies to permanently disable the EXCLUDE.t -2 /FROMf -Specifies to exclude the message based on the message owner. This isp -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /SUBJECT -Specifies to exclude the message based on the message subject. /FROM -and /SUBJECT cannot be specified at the same time. e -2 Storing_EXCLUDEs -EXCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:EXCLUDE:FROM(or SUBJECT):stringu -1 EXIT -Exits the BULLETIN program.l -1 EXTRACT/ -Synonym for FILE command.o -1 FILE -Copies the current message to the named file. The file-name parameter -is required. If the file exists, the message is appended to the file, -unless the /NEW qualifier is specified.e - - Format: - FILE filename [message_number][-message_number1],[...] - -A range of messages to be copied can optionally be specified, i.e. -FILE 2-5.e - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Copies all the messages in the current folder. -2 /FFn -Specifies that a form feed is placed between messages in the file. -2 /HEADERp - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the file. The default is to write the header. -2 /NEW - -Specifies that a new file is to be created. Otherwise, if the specified -file exists, the file would be appended to that file.. -1 FIRSTS -Specifies that the first message in the folder is to be read.t -1 FORWARDE -Synonym for MAIL command. -1 Folderst -All messages are divided into separate folders. New folders can ber -created by any user. As an example, the following creates a folder fori -GAMES related messages: - r -BULLETIN> CREATE GAMES -Enter a one line description of folder.i -GAMESr - -To see the list of available folders, use DIRECTORY/FOLDERS. To selectm -a specific folder, use the SELECT command. - -If a user selects a folder and enters the SET READNEW command, thata -user will be alerted of topics of new messages at login time, and will S -then be given the option of reading them. Similar to READNEW is SHOWNEW,a -which displays the topics but doesn't prompt to read them. Even less is -SET BRIEF, which will cause only a one line output indicating that there -are new messages in the folder. There also is the SET NOTIFY option,c -which will cause a message to be broadcast to a user's terminal alerting -the user that a new message has been added. Any of these options can be -the default for the folder by using the /DEFAULT switch on the command.h - -A folder can be restricted to only certain users, if desired. This is r -done by specifying CREATE/PRIVATE. Afterwards, access to the folder is -controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATEm -rather than /PRIVATE is specified, all users can read the messages in the -folder, but only those give access can add messages. - -A folder can be converted into a remote folder using CREATE/NODE or SETd -NODE. A remote folder is one which points to a folder on a remote DECNET -node. Messages added to a remote node are actually stored on the folder -on the remote node. The BULLCP process (created by BULLETIN/STARTUP)s -must be running on the remote node for this option to be used. - -A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/i -SHUTDOWN/BROADCAST messages can be added. One use for this is to create -a remote SYSTEM folder which is shared by all nodes, so that the default -folder is used for messages pertaining only to the local host, while the -remote folder is used for messages pertaining to all nodes. Another -use is to create a folder for posting SYSTEM messages only meant for a -certain UIC group. This is done by creating a PRIVATE SYSTEM folder, ande -giving access to that UIC group. Only users in that UIC group will seeu -the messages in that folder when they log in. -1 HELP -To obtain help on any topic, type: - - HELP topicg -1 INCLUDEe -Specifies to include reading messages based on the message owner or thee -subject. If it is determined that a message is to be included, then -the message is read when a user tries to read a message by typingD -NEXT or BACK, or by hitting the return key. Otherwise, it is skipped. - - Format: - INCLUDE [string] - -If a string is specified, then the message is included if the owner or -the subject contains that string, depending on whether /FROM or /SUBJECT -is specified. Otherwise, if no string is specified, then the owner name -or subject of the current message is used. More than one INCLUDE may be -specified per folder.a - -Note: EXCLUDEs take precedence over INCLUDEs. -2 /ALL -Used with /DISABLE to specify to disable all INCLUDEs. -2 /DISABLE -Specifies to permanently disable the INCLUDE. -2 /FROMh -Specifies to include the message based on the message owner. This is -the default. /FROM and /SUBJECT cannot be specified at the same time. -2 /SUBJECT -Specifies to include the message based on the message subject. /FROMe -and /SUBJECT cannot be specified at the same time. -2 Storing_INCLUDEs -INCLUDEs are stored in the file SYS$LOGIN:BULL.CUSTOM or in the file -pointed to by the logical name BULL_USER_CUSTOM. The format is: - -folder_name:INCLUDE:FROM(or SUBJECT):string -1 INDEXs -Gives directory listing of all folders or subscribed groups in -alphabetical order. Useful for scanning your folders or news groups for -new messages without having to manually select them. If the INDEX -command is re-entered while the INDEX scan is in progress, the scan will -skip to the next folder. This is useful for skipping past a folder. It -also can be used to continue the scan from where one left off after onec -has read a message. /RESTART must be specified to start from the firstm -folder if a scan is in progress. All other qualifiers are ignored while n -a scan is in progress. - - Format:T - INDEX - -When a directory is displayed, you can read the first message in the g -list by typing READ. - -NOTE: /NEW and /SET are the defaults. This was not the case for older -versions of BULLETIN.c -2 /MARKEDe -Lists messages that have been marked (marked messages are indicated by -an asterisk). This is equivalent to selecting the folder with /MARKED,t -i.e. only marked messages will be shown and be able to be read. -2 /UNMARKEDc -Lists messages that have not been marked (marked messages are indicatede -by an asterisk). Using /UNMARKED is equivalent to selecting the folderw -with /UNMARKED, i.e. only unmarked messages will be shown and be ableg -to be read.e -2 /SEENE -Lists messages that have been seen (indicated by a greater than sign). c -Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. onlya -seen messages will be shown and be able to be read.n -2 /UNSEEN -Lists messages that have not been seen (seen message are indicated by al -greater than sign). Using /UNSEEN is equivalent to selecting the folderO -with /UNSEEN, i.e. only unseen messages will be shown and be able to bep -read. -2 /NEW - /[NO]NEWw - -Specifies to list only those folders or groups that have new unreads -messages, and to start the listing with the first unread message.s -Otherwise, the listing will start with the first message. /NEW is the -default. Is ignored if /[UN]SEEN or /[UN]MARKED are specified.n -2 /RESTART -If specified, causes the listing to be reinitialized and start from the -first folder.p -2 /SET - /[NO]SETs - -Specifies that only folders that have READNEW, BRIEF, or SHOWNEW set are -to be shown. SET is the default. Ignored if /SUBSCRIBE is specified. -2 /SUBSCRIBE -If specified, lists only news groups which have been subscribed to. -1 KEYPAD - +--------+--------+--------+--------+ - | PF1 | PF2 | PF3 | PF4 | - | GOLD | HELP | EXTRACT|SHOW KEY| - | |ST NOKEY| FILE |SH KY/PR| - |--------|--------|--------|--------| - | 7 | 8 | 9 | -- | - | ADD | REPLY | MAIL |READ/NEW| - | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW| - |--------|--------|--------|--------| - | 4 | 5 | 6 | , | - | CURRENT| RESPOND| LAST | DIR/NEW| - |CURR/EDI|RS/ED/EX| | INDEX | - |--------|--------|--------|--------| - | 1 | 2 | 3 |ENTER | - | BACK | PRINT | DIR | | - | NEXT |P/NONOTI|DIR/FOLD| | - |--------+--------|--------| ENTER | - | 0 | . | SELECT | - | SHOW FOLDER/FULL| DELETE | | - | SHOW FLAGS | UNDELE | | - +-----------------+--------+--------+ -1 LAST - -Displays the last message in the current folder. - - Format:m - LAST -2 /EDITn -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message.g -2 /HEADERe - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commands -is set for the folder, it will change the default to be /HEADER. -2 /ROTATEp -Specifies to decode the message using ROT-13 coding. -1 MAIL -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message -which you are reading to the specified recipients. - - Format:d - - MAIL recipient-name[s] - -The input for the recipient name is exactly the same format as used by -the MAIL command at DCL level. Note that this means when specifying anc -address that has quotes, in order to pass the quotes you must specify -triple quotes. I.e. a network address of the form xxx%"address" mustr -be specified as xxx%"""address""". -2 /EDIT -Specifies that the editor is to be used to edit the message before -mailing it.t -2 /HEADERo - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is written in the mail. The default is to write the header. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of mores -than one word, enclose the text in quotation marks (").w - -If you omit this qualifier, the description of the message will be used -as the subject.e -1 MARK -Sets the current or message-id message as marked. Marked messages are -displayed with an asterisk in the left hand column of the directoryd -listing. A marked message can serve as a reminder of importantn -information. The UNMARK command sets the current or message-id messagen -as unmarked. - - Format: - - MARK [message-number or numbers]V - UNMARK [message-number or numbers] - -NOTE: The list of marked messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to by. -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGINo -will be used. -1 MODIFY -Modifies the database information for the current folder. Only thea -owner of the folder or a user with privileges can use this command. - - Format:T - - MODIFY -2 /DESCRIPTION -Specifies a new description for the folder. You will be prompted fort -the text of the description. - -NOTE: If this folder is to receive messages from a network mailing listT -via the BBOARD feature, and you wish to use the POST and RESPOND/LIST -commands, the address of the mailing list should be included in thes -description. This is done by enclosing the address using <> and -placing it at the end of the description, i.e. - - INFOVAX MAILING LIST s -2 /IDn -Designates that the name specified as the owner name is a rights -identifier. The creator's process must have the identifier presentlyi -assigned to it. Any process which has that identifier assigned to itn -will be able to control the folder as if it were the folder's owner. -This is used to allow more than one use to control a folder. - -Note: This feature will not work during remote access to the folder. -2 /NAMEn - /NAME=foldernamee - -Specifies a new name for the folder. -2 /OWNER - /OWNER=username - -Specifies a new owner for the folder. If the owner does not have -privileges, BULLETIN will prompt for the password of the new owner -account in order to okay the modification. See also /ID.t -1 MOVE -Moves a message to another folder and deletes it from the current -folder.i - - Format:e - - MOVE folder-name [message_number][-message_number1]s - -The folder-name is the name of the folder to which the message is to beU -be moved to. Optionally, a range of messages which are to be moved can be -specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,I -if the old folder is remote, they will be copied but not deleted, as -only one message can be delted from a remote folder at a time. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. -2 /ALL -Specifies to move all the messages from the old folder. Note: If the -old folder is remote, they will be copied but not deleted, as only one -message can be deleted from a remote folder at a time. -2 /GROUPSU - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message tod -the specified NEWS group(s) in addition to the selected NEWS group.g -2 /HEADERh - /[NO]HEADER - -Valid only if destination folder is a news group. Specifies that header -of message is to be included with the text when the text is copied.l -The default is /NOHEADER.. -2 /MERGE -Specifies that the original date and time of the moved messages are -saved and that the messages are placed in correct chronological order -in the new folder. This operation is lengthy if the new folder is large.n -2 /ORIGINALn -Specifies that the owner of the moved message will be the original owner -of the message. The default is that the moved message will be owned byE -the person moving the message. -1 NEWS -Displays the list of available news groups.c - -Format:e - - NEWS [string] - -If the string is specified, lists news groups whose name contains that -string. If the string contains an asterisk, a wild card match will be -applied. I.e. if ALT* is specified, all groups starting with ALT will -be displayed.b - -The status column of the display shows the status of the news group. -"y" means the news group is available. "m" means the news group is -moderated, and posting may or may not be allowable. "=" means the -newsgroup has been renamed. The new name is shown on the display line -immediately following the old name. - -Only those news groups which are enabled are shown. Adding /ALL will -show both enabled and disabled groups. If this is done, the status will -show "x" if the group has been deactived by the news server feed, and -"n" if the group has been deactived locally. -2 /ALL -If specified, all news groups will be shown, including those that have -been disabled. -2 /CLASS -If specified, will show news group classes. For more info on classes, -see help for SET NEWS/CLASS. -2 /COUNT -If specified, will show number of messages in the news group instead -of the status. -2 /NEWGROUPi -If specified, will list new news groups that have been added since the -last time that a user has accessed a news group. If there are new -groups, a user will see a message indicating that there are new groups -when the user accesses a news group. -2 /START - /START=string - -If specified, the list will start with the first group which follows -alphabetically after that string. I.e. if /START=B is specified, the -list will start with groups whose name starts with a B. -2 /STORED3 -If specified, only those news groups which are stored on disk are shown. -2 /SUBSCRIBE -If specified, lists only those news folders which have been subscribed to. -An asterisk before the group indicates that new messages are present for -that folder. -1 NEXT -Skips to the next message and displays it. This is useful when paging -through the messages and you encounter a particularly long message -that you would like to skip over. -2 /EDIT| -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message.- -2 /HEADER| - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP commandO -is set for the folder, it will change the default to be /HEADER. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. diff --git a/decus/vax92b/bulletin/bullcoms2.hlp b/decus/vax92b/bulletin/bullcoms2.hlp deleted file mode 100644 index 4ad9c7c..0000000 --- a/decus/vax92b/bulletin/bullcoms2.hlp +++ /dev/null @@ -1,1338 +0,0 @@ -1 POST -If a NEWS group is selected, posts a message to that group. If a normal -folder is selected, sends a message via MAIL to the network mailing list -which is associated with the selected folder. The address of the -mailing list must be stored using either CREATE/DESCRIPTION or -MODIFY/DESCRIPTION. See help on those commands for more information. - - Format: - POST [file-name] -2 /CC - /CC=user[s] -Specifies additional users that should receive the mail message. -2 /EDIT -Specifies that the editor is to be used for creating the mail message. -2 /EXTRACT -Specifies that the text of the message that is being read should be -included in the mail message. This qualifier is valid only when used -with /EDIT. The text of the message is indented with > at the -beginning of each line. This can be suppressed with /NOINDENT. -2 /GROUPS - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected. Specifies to send the message to -the specified NEWS group(s) in addition to the selected NEWS group. -2 /NOINDENT -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of more -than one word, enclose the text in quotation marks ("). - -If you omit this qualifier, you will prompted for the subject. -2 Signature_file -It is possibly to have the contents of a file be automatically appended -to the end of a message added with the POST and/or the RESPOND command. -This file is known as a signature file, and it typically contains one's -name, address, or perhaps a favorite quote. The name of the file should -be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. In -order to specify a different file to use, define the logical name -BULL_SIGNATURE to point to the desired file. - -It is possible to specify that portions or all of the signature file are -to be included only for specific folders or news groups. Simply surround -the exclusive text starting with the line "START " and ending -with the line "END", i.e. - -START INFOVAX -This line will only appear in the INFOVAX folder. -END -START MISC.TEST -This line will only appear in the news folder MISC.TEST. -END -This line will appear in all postings. - -Note that an empty line is automatically created to separate the text of -the message and the contents of the signature file. -1 PRINT -Queues a copy of the message you are currently reading (or have -just read) for printing. The file created by the PRINT command -is not released to the print queue until you exit, unless you add -the qualifier /NOW or change one of the print job's qualifiers. -Multiple messages are concatenated into one print job. - - Format: - - PRINT [message_number][-message_number1],[...] - -A range of messages to be printed can optionally be specified, i.e. -PRINT 2-5. - -The key words CURRENT and LAST can also be specified in the range, -in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc. - -NOTE: The qualifier /PRINT is present on the DIRECTORY command. This -provides more flexibility than is present with the PRINT command. For -example, if you want to print all messages with a particular string in -it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it. -2 /ALL -Prints all the messages in the current folder. -2 /FORM -Specifies the name or number of the form that you want for the print -job. Codes for form types are installation-defined. You can use the -SHOW QUEUE/FORM command at DCL level to find out the form types -available for your system. Use the SHOW QUEUE/FULL command at DCL -level to find out the name of the mounted form and the default form for -a particular queue. If you specify a form whose stock is different -from the stock of the form mounted on the queue, your job is placed in -a pending state until the stock of the mounted form of the queue is -set equal to the stock of the form associated with the job. (In order -to have your job print, the system manager should stop the queue, -physically change the paper stock on the output device, and restart the -queue specifying the new form type as the mounted form.) -2 /HEADER - /[NO]HEADER - -Controls whether a header containing the owner, subject, and date of the -message is printed at the beginning. The default is to write the header. -2 /NOTIFY - /[NO]NOTIFY - -Indicates that you will be notified by a broadcast message when the -file or files have been printed. If /NONOTIFY is specified, there -is no notification. The default is /NOTIFY. -2 /NOW -Sends all messages that have been queued for printing with the PRINT -command during this session to the printer. -2 /QUEUE - /QUEUE=queue_name - -The name of the queue to which a message is to be sent. If the /QUEUE -qualifier is not specified, the message is queued to SYS$PRINT. -1 READ -Displays the specified message. If you do not specify a message, then -the first time you enter the command, the first message in the folder -will be displayed. However, if there are new messages, the first new -message will be displayed. Each time you enter the command, the next -page, or if there are no more pages, the next message will be displayed. - - Format: - READ [message-number] - -The message's relative number is found by the DIRECTORY command. -If you specify a number greater than the number of messages in the -folder, the last message in the folder will be displayed. - -NOTE: The READ command can be abbreviated by omitting the READ command, -i.e. typing the command "2" is equivalent to "READ 2", and simply -hitting the key is equivalent to "READ". - -BULLETIN normally stores only the latest message that has been read per -folder. It can optionally store and display which messages have been -read in a folder on a per message basis. For information on this, see -the help on the SEEN command. -2 /ALL -Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN, -or /UNSEEN had been specified. -2 /EDIT -Specifies that the editor is to be used to read the message. This is -useful for scanning a long message. -2 /HEADER - /[NO]HEADER - -Specifies that if a message header exists, the header will be shown. -If /HEADER or /NOHEADER is specified, the setting will apply for all -further reads in the selected folder. The default is /HEADER for non- -NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command -is set for the folder, it will change the default to be /HEADER. -2 /MARKED -Specifies to read only messages that have been marked (marked messages -are indicated by an asterisk). Using /MARKED is equivalent to -selecting the folder with /MARKED, i.e. only marked messages will be -shown and be able to be read. To see all messages, use either /ALL, -or reselect the folder. -2 /UNMARKED -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). Using /UNMARKED is equivalent -to selecting the folder with /UNMARKED, i.e. only unmarked messages -will be shown and be able to be read. To see all messages, either -reselect the folder or specify /ALL. -2 /ROTATE -Specifies to decode the message using ROT-13 coding. -2 /SEEN -Specifies to read only messages that have been seen (indicated by a -greater than sign). Using /SEEN is equivalent to selecting the folder -with /SEEN, i.e. only seen messages will be shown and be able to be -read. To see all messages, use either /ALL, or reselect the folder. -2 /UNSEEN -Specifies to read only messages that have not been seen (seen message -are indicated by a greater than sign). Using /UNSEEN is equivalent to -selecting the folder with /UNSEEN, i.e. only unseen messages will be -shown and be able to be read. To see all messages, use either /ALL, or -reselect the folder. -2 /NEW -Specifies to read the first unread message.s -2 /PAGEp - /[NO]PAGE - -Specifies that the display of the message will pause when it reaches the -end of the page. If /NOPAGE is specified, the whole message will be -displayed. This is useful for terminals that can store more than oneg -screenful at a time, and that have a remote printer that can then printe -the contents of the terminal's memory. -2 /SINCE - /SINCE=date - -Specifies to read the first message created on or after the specifiede -date. If no date is specified, the default is TODAY. -1 REMOVE -Removes a folder. Only the owner of a folder or a privileged user can -remove the folder. - - Format:h - REMOVE folder-name -1 REPLYs -Adds message with subject of message being the subject of the currently -read message with "RE:" preceeding it. Format and qualifiers is exactly -the same as the ADD command except for /NOINDENT and /EXTRACT. - - Format: - REPLY [file-name] -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line.a -This can be suppressed with /NOINDENT. -2 /NOINDENTs -See /EXTRACT for information on this qualifier.o -1 RESPOND -Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mailS -message to the owner of the currently read message.e - - Format:. - RESPOND [file-name]m - -If you wish to use another method for sending the mail, define BULL_MAILER -to point to a command procedure. This procedure will then be executed in -place of MAIL, and the parameters passed to it are the username and subjectd -of the message.e -2 /CCt - /CC=user[s] -Specifies additional users that should receive the reply.i -2 /EDITt -Specifies that the editor is to be used for creating the reply maile -message. -2 /EXTRACT -Specifies that the text of the message should be included in the reply -mail message. This qualifier is valid only when used with /EDIT. The -text of the message is indented with > at the beginning of each line.e -This can be suppressed with /NOINDENT. -2 /GROUPSi - /GROUPS=(newsgroup,[...]) - -Valid only if a NEWS group is selected and /LIST is present. Specifiess -to send the message to the specified NEWS group(s) in addition to theE -selected NEWS group. -2 /LISTh -Specifies that the reply should also be sent to the network mailing list -associated with the folder. The mailing list address should be stored -in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION -for more informaton. -2 /NOINDENTh -See /EXTRACT for information on this qualifier. -2 /NOSIGNATURE -Specifies to suppress the automatically appended signature, if one exists. -Signatures are appended for postings to mailing lists and to responds. -See the help topic POST Signature_file for signature information. -2 /SUBJECT - /SUBJECT=text - -Specifies the subject of the mail message. If the text consists of moreo -than one word, enclose the text in quotation marks (").e - -If you omit this qualifier, the description of the message will be usedc -as the subject preceeded by "RE: ".o -1 RESETN -Resets the new message counter for the selected folder or news group.u -The new message counter stores the latest read message, and is used to -determine if there are new messages to be read.d - - Format:b - RESET [message-number] - -If no number is specified, the last message in used. This is useful -when you want to simply ignore any new messages without having to read them. -(Note: Reading the last message does the same thing, but RESET does it -without having to read it.)b -1 QUIT -Exits the BULLETIN program.p -1 SEARCH -Searches the currently selected folder for the message containing the -first occurrence of the specified text string. - - Format: - - SEARCH [search-string] - -The search starts from the first message in the current folder. The -search includes both the text of the message, and the description header.m -If a "search-string" is not specified, a search is made using theh -previously specified string, starting with the message following the -one you are currently reading (or have just read). Once started, as -search can be aborted by typing a CTRL-C.o -2 /EDITi -Specifies that the editor is to be used for reading the message. -2 /FOLDERt - /FOLDER=(folder,[...])n - -Specifies a list of folders to be searched. The search will start by -selecting the first folder in the list and searching the messages forn -a match. If, during a search, no more matches or messages are found,e -the next folder in the list is automatically selected. The presently -selected folder can be included in the search by specifying "" as thei -first folder in the list./ -2 /FROMi -Specifies that only the username of the messages are to be searched. -2 /NEGATED -If specified, messages that don't match the specified search string -command are displayed. Does not work with /NOREPLIES. -2 /NOREPLIES -Specifies to find messages which are not replies (i.e. whose subject -do not start with RE:).c -2 /REPLY -Specifies that messages are to be searched for that are replies to the -currently read message, or the message specified by /START. Replies are -messages which have subject of the original message prefaced by "Re:". -2 /REVERSE -Specifies that the messages are to be searched in reverse order. If -no starting message is specified, the search is started from the lasta -message. -2 /START - /START=message_number - -Specifies the message number to start the search at. -2 /SUBJECT -Specifies that only the subject of the messages are to be searched.e -1 SEEN -Sets the current or message-id message as seen. This allows you to keep -track of messages on a per message basis. Seen messages are displayed -with a greater than sign in the left hand column of the directoryE -listing. Once you have used the SEEN command once, messages will be -automatically be set as being SEEN when they are read. The UNSEEN -command sets the current or message-id message as unseen. - - Format: - - SEEN [message-number or numbers]i - UNSEEN [message-number or numbers]o - -Keeping track of seen messages requires very little overhead for NEWS -folders. However, there is a moderate overhead for regular non-NEWS -folders. If you have used the SEEN command and wish to disable the -automatic marking of messages in regular folders as SEEN when they are -read, type the command SEEN/NOREAD. To reenable, simply use the SEENE -command again. - -If a specified message is newer than the newest read message, then the -newest read message counter will be updated. The newest read message -counter is used to determine if there are new messages to be read. -You are alerted of this when entering BULLETIN or selecting a folder -or news group. If you simply want to reset this counter and don't care -about marking which messages have been seen or not, use the RESET command. - -NOTE: The list of SEEN messages for non-NEWS folders are stored in a -file username.BULLMARK, and NEWS folders are stored in -username.NEWSMARK. The files are created in the directory pointed to bym -the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGINK -will be used. -1 SELECT -Selects a folder of messages. See HELP Folders for a description of a -folder. Once a folder has been selected, all commands, i.e. DIRECTORY, -READ, etc. will apply only to those messages. Use the CREATE command to -create a folder. Use the DIRECTORY/FOLDER command to see the list of -folders that have been created.g - - Format: - - SELECT [node-name::][folder-name] - -The complete folder name need not be specified. BULLETIN will try to -find the closest matching name. I.e. INFOV can be used for INFOVAX. - -Omitting the folder name will select the default folder. - -The node name can be specified only if the remote node has the special -BULLCP process running (invoked by BULLETIN/STARTUP command.)u - -After selecting a folder, the user will notified of the number of unread -messages, and the message pointer will be placed at the first unread -message. - -BULLETIN automatically determines if the selcted name is a NEWS group by -detecting if a period is present in the name being specified, as most -NEWS groups contain a period, whereas a real folder cannot. A few -special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If -desired, you can select these groups by enclosing them in double quotes -("), and typing the name in lower case. - -A useful way to scan through folders or subscribed news group without -having to select them manually is to use the INDEX command.r -2 /MARKED -Selects only messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will have -to be reselected.t -2 /UNMARKEDe -Specifies to read only messages that have not been marked (marked -messages are indicated by an asterisk). e - -After using, in order to see all messages, the folder will have -to be reselected.f -2 /SEENt -Specifies to read only messages that have been seen (indicated by a -greater than sign).l - -After using, in order to see all messages, the folder will have -to be reselected.n -2 /UNSEEN -Specifies to read only messages that have not been seen (seen messageA -are indicated by a greater than sign). - -After using, in order to see all messages, the folder will have -to be reselected.s -1 SETt -The SET command is used with other commands to define or change -characteristics of the BULLETIN Utility. - - Format: - - SET option -2 ACCESS -Controls access to a private folder. A private folder can only be -selected by users who have been granted access. Only the owner of that -folder is allowed to grant access. - - Format:p - - SET [NO]ACCESS id-name [folder-name] - -The id-name can be one or more ids from the system Rights Database for -which access is being modified. It can also be a file name which -contains a list of ids. For more information concerning usage of -private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via -ACLs. If a user's process privileges are set to override ACLs, that -user will be able to access the folder even if access has not been -granted. - -It is suggested that if you plan on granting access to many users, that -you create an id using the AUTHORIZE utility and then use the SET ACCESS -command to grant access to that id. Then, you can use the GRANT/ID -command in AUTHORIZE to grant the id to users, and this will give those -users access to the folder. This is preferred because of problems with -running into system quota when checking for acls on a file with a large -amount of acls. It is also means that you don't have to remember to -remove the access for that user from a folder if that user is removed -from the system. - -A user with BULLETIN privileges (see HELP SET PRIV) will be able to -select a protected folder regardless of the access settings. However, a -user without explicit access will not receive login notifications of new -messages, and thus will not be able to set any login flags. (NOTE: If -such a user selects such a folder and then uses SET ACCESS to grant him -or herself access, the user must reselect the folder in order for the -new access to take affect in order to be able to set login flags.) -3 id -The id-name can be one or more ids contained in the system Rights -Database. This includes usernames and UICs. A UIC that contains a -comma must be enclosed in quotes. UICs can contain wildcards, i.e. -"[130,*]". Note that by default, a process is given the process rights -id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by -specifing this id, a folder can be restricted to a specific node, which -is useful when the folder is shared among nodes in a cluster. - -Alternatively, the id-name can be a filename which contains a list of -ids. The filename should be preceeded by a "@". If the suffix is not -specified, it will be assumed that the suffix is ".DIS" .e -3 /ALL -Specifies that access to the folder is granted to all users. If /READ -is not specified, the folder will no longer be private. If /READ is -specified, all users will have read access, but only privileged users -will have write access (of course non-privileged users can gain access -via a later SET ACCESS command.) - -Format:t - - SET ACCESS /ALL [folder-name]c -3 /CLASS -Specifies that the specified folder is a news group class. -3 /READa -Specifies that access to the folder will be limited to being able to -read the messages. -3 Warningt -If a user logs in after a private folder has been created but before -being given access, and then is given access, any defaults that the -folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that -user. This is because if the id is not a username, it becomes an -extremely lengthy operation to check each user to see if have that id -assigned to them. The alternative is to set the defaults for all users -after every SET ACCESS, but that might cause problems with users who -have manually reset those defaults. The correct solution requires a -large programming modification, which will be done in a later version. -2 ALWAYS -Specifies that the selected folder has the ALWAYS attribute. This -causes messages in the folder to be displayed differently when logging -in. SYSTEM messages will be displayed every time a user logs in, rather -than just once. Non-SYSTEM message will also be displayed every time -(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until -the user actually reads that message (or a later one). This feature is -meant for messages which are very important, and thus you want to make -sure they are read.t - - Format:h - - SET [NO]ALWAYS -2 ADD_ONLY -Specifies that the selected folder has the ADD_ONLY attribute. If a -mailing address is present (see /DESCRIPTION), when messages are added -to the folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be -used if the POST command is entered. One use for this is a local board -which is also distributed to non-local users. - - Format:h - - SET [NO]ADD_ONLY -2 BBOARD -Specifies a username to be used as a BBOARD destination. Mail which is -sent to that user are converted into messages. This command will apply -to the selected folder, and each folder can have its own BBOARD. Only -privileged users or owners of the folders can set BBOARD. Note: The -specified account must have the DISUSER flag specified in the system -authorization file, and it either must be given SYSPRV privileges, or -the scratch bboard_directory (specified when compiling BULLETIN) must -have world rwed protection. Also, certain system parameters which -affect detached subprocesses are usually too low for the subprocess -which is spawned to read the mail. The parameters and the suggested -values are: PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, and PQL_DFILLM -= 30. If you are not using the BULLCP process, the subprocess limit for -users must be at least 2.d - - Format: - - SET BBOARD [username]e - -BBOARD cannot be set for remote folders. See also the commands SET -STRIP and SET DIGEST for options on formatting BBOARD messages., - -If BULLCP is running, BBOARD is updated every 15 minutes. If you want -to length this period, define BULL_BBOARD_UPDATE to be the number of -minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30"- -will cause the updates to be don every 30 minutes. - -NOTE: If you want to control the expiration date on a per message basis, -you can do so by adding a special header line to the message. The forme -is Expires: or X-Expires: followed by the date in the form DD MMM YYYY.r -The time will always be 00:00, even if the time is specified on the line.R -3 /EXPIRATION - /EXPIRATION=days - /NOEXPIRATION - -Specifies the number of days the message created by the BBOARD is to be -retained. The default is 14 days. The highest limit that can be -specified is 30 days. This can be overridden by a user with privileges. -If /NOEXPIRATION is specified, messages will become permanent. - -NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE. -If one is changed, the other will change also. -3 /SPECIAL -Specifies that the input should be processed using a special command -procedure, and not to use the simple VMS MAIL to message conversion. -Specifying a username is optional. To remove this feature, you must -either SET NOBBOARD, or SET BBOARD and specify a username. See -installation notes for exactly how to use this feature.E -3 /VMSMAIL -Used in conjunction with /SPECIAL. If /SPECIAL and a username is -specified, and the conversion still takes its input from VMS MAIL, then -the VMS system mail file is checked to see if new mail exists for the -specified user before running the command procedure. This saves time -and avoids creating subprocesses. (Useful if input is digest format.) -3 Listserv -For a LISTSERV mailing list, only a subscribed user can post to it. If -the BBOARD account is subscribed to the list in order for BULLETIN to -receive the list, only the BBOARD account will be able to post to it. -This problem is solved by placing the word LISTSERV in the folder -description line. Then, messages sent to the mailing list by the POST -command will be sent from the BBOARD account rather than from the user's -account. For example, the folder description might be:o - -FAKE MAILING LIST LISTSERV. - -If you have PMDF or MX installed, the corresponding logical name -PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add -a REPLY-TO: line to the message header to display the real user's -address. - -Users who use the method described in HELP SET BBOARD MORE_INFORMATION -should note the following: When using this LISTSERV feature, the BBOARD -account must be a real account, not simply a VMS MAIL forwarding entry. -Mail can only be sent from a real account. However, if mail forwarding -is set for that the account, the account does not need a real directory -or a unique uic, since it will not need space to store mail. - -In order to be able to send LISTSERV commands from the BBOARD account -without having to actually login to the BBOARD account, there is a -utility included with BULLETIN called SETUSER. This requires privileges -to use. After compiling it, use the link command: - - LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT - -When you run it, it will prompt for a username. After verifying that -the given username is a valid account, it will then change your -process's username. You can then send mail from that account. - -If you are using PMDF or MX, and wish to use this feature, you can still -do so by setting BBOARD. As long as the BBOARD account is not a real -account, it will work properly, even though the mail feed is not really -coming from the BBOARD account.n - -In order to find out if the LISTSERV mailing list will accept posts only -from subscribed users, send the command 'REV listname'. This will -retrieve the file listname.LIST. It begins with a list of keywords. If -the keyword 'send' is set to 'public', you don't need to set the -LISTSERV switch. If it's set to 'private', you do. For a description -of the keywords and the meaning of their settings, send any LISTSERV the -command 'INFO KEY'. Note that the 'listname.LIST' files include a list -of owners and subscribers. If 'send' is set to 'owners', then neither -the public nor the subscribers can post to the list. - -Note: It has been found that some servers don't accept the mail as being -from the bboard account if the reply-to: line is added. This might be -due to it being run on VMS, where the Reply-to: line is converted to the -From: line. In this case, specify VMSSERV instead of LISTSERV.e -3 More_information -If more than one folder is to have a BBOARD setting, only one of the -BBOARD names need be a real account. All other names could be names -whose mail is forwarded to the real account. BULLETIN will then -determine from the mail header which folder the mail is to be sent to. -Forwarding can be enabled for any name within MAIL by the command: - - MAIL> SET FORWARD/USER=from_name to_name - -Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only -TO_NAME need be a real account. For example, if you have INFOVAX and -LASER-LOVERS folders, you need create only a INFOVAX account, and then -forward LASER-LOVERS mail to INFOVAX within mail using the command SET -FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD -INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the -LASER-LOVERS folder. This method will speed up the BBOARD conversion, -since mail need be read only from one account. NOTE: Folders that have -the /SPECIAL set on their BBOARD accounts cannot have their mail -forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of -the same type, i.e. that use the same /SPECIAL command procedure, must -be grouped separately. - -The BBOARD account must match the mailing list name. If you prefer not -to have them match, then you must include the actual address of the -mailing list in the folder description in the format described under -HELP CREATE /DESCRIPTION.j -2 BRIEF -Controls whether you will be alerted upon logging that there are new -messages in the currently selected folder. A new message is defined as -one that has been created since the last time you logged in or accessed -BULLETIN. Note the difference between BRIEF and READNEW. The latter -causes a listing of the description of the new messages to be displayed -and prompts the user to read the messages. Setting BRIEF will clear a -READNEW setting (and visa versa).s - - Format:o - - SET [NO]BRIEFl -3 /ALL -Specifies that the SET [NO]BRIEF option is the default for all users for -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]BRIEF option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newc -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernamea - -Specifies the folder for which the option is to modified. If notl -specified, the selected folder is modified. Valid only with NOBRIEF. -3 /PERMANENT - /[NO]PERMANENT - -Specifies that BRIEF is a permanent flag and cannot be changed by they -individual, except if changing to SHOWNEW or READNEW. This is a -privileged qualifier.t -2 COMPRESS -Specifies that messages added to the folder will be in compressed format.t -Data stored in this way will be 60-65% the size of normal folders. -The compression algorithm is optimized for English text files and requires e -very little cpu overhead.r - - Format:s - - SET [NO]COMPRESS - -This command is only valid with folders. Local news groups are always -stored in compressed format. Messages already stored in the folder -can not presently be changed to compressed format. r -2 CONTINUOUS_BRIEF -Specifies that if BRIEF is set for a folder, and there are new messages, -the notification message "there are new messages" will be displayed everyi -time when logging in, until the new messages are read. Normally, ther -BRIEF setting causes notification only at the first time that new messages -are detected.S - - Format:O - - SET [NO]CONTINUOUS_BRIEF - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for thee -same user. -2 DEFAULT_EXPIRE -Specifies the number of days the message created by BBOARD (or direct -PMDF path) is to be retained. The default is 14 days. The highest -limit that can be specified is 30 days. This can be overridden by a -user with privileges.O - -This also specifies the default expiration date when adding a message. -If no expiration date is entered when prompted for a date, or if -prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be -used.d - - Format: - - SET DEFAULT_EXPIRE daysI - -If -1 is specified, messages will become permanent. If 0 is specified, -no default expiration date will be present. The latter should never be -specified for a folder with a BBOARD, or else the messages will -disappear. - -NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies. -If one is changed, the other will change also. -2 DIGEST -Affect only messages which are added via either the BBOARD option, or -written directly from a network mailing program (i.e. PMDF). Several -mailing lists use digest format to send their messages, i.e. the -messages are concatenated into one long message. If DIGEST is set, the -messages will be separated into individual BULLETIN messages.h - - Format:i - - SET [NO]DIGEST - -The command SHOW FOLDER/FULL will show if DIGEST has been set. - -2 DUMP -Specifies that messages deleted from the selected folder are written -into a dump (or log) file. The name of the log file is foldername.LOG, -and it is located in the folder directory. - - Format:e - - SET [NO]DUMP - -The command SHOW FOLDER/FULL will show if dump has been set. (NOTE: -SHOW FOLDER/FULL is a privileged command.) -2 EXPIRE_LIMIT -Specifies expiration limit that is allowed for messages. Non-privileged -users cannot specify an expiration that exceeds the number of days -specified. Privileged users can exceed the limit. - - SET [NO]EXPIRE_LIMIT [days]E - -The command SHOW FOLDER/FULL will show the expiration limit, if one -exists. (NOTE: SHOW FOLDER/FULL is a privileged command.) Y -2 FOLDER -Select a folder of messages. Identical to the SELECT command. See help -on that command for more information.e - - Format: - - SET FOLDER [node-name::][folder-name]b -3 /MARKEDS -Selects messages that have been marked (indicated by an asterisk). -After using /MARKED, in order to see all messages, the folder will havem -to be reselected.a -2 GENERIC. -Specifies that the given account is a "generic" account, i.e used by -many different people. If an account is specified as GENERIC, new -messages placed in the default folder will be displayed upon logging in -for a specific number of days, rather than only once. The default -period is 7 days. This command is a privileged command. - - Format:t - - SET [NO]GENERIC username - -NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for thel -same user. -3 /DAYS - /DAYS=number_of_daysE - -Specifies the number days that new messages will be displayed for upon -logging in. -2 KEYPAD -Controls whether the keypad has been enabled such that the keys on the -keypad correspond to command definitions. These definitions can be seen -via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD -qualifier has been added to the BULLETIN command line. - - Format:r - - SET [NO]KEYPAD - -The default settings for the keypad are shown via SHOW KEYPAD or HELP -KEYPAD. Settings can be changed by using an initialization file with -DEFINE/KEY commands. BULLETIN looks first for the file pointed to bye -the logical name BULL_INIT and then for the file SYS$LOGIN:BULL.INI. -2 LOGINs -Controls whether the specified user will be alerted of any messages, -whether system or non-system, upon logging in. If an account has the -DISMAIL flag set, SET NOLOGIN is automatically applied to that account -during the first time that the account logs in. However, this will not -occur if DISMAIL is set for an old account. Additionally, removing the -DISMAIL flag will not automatically enable LOGIN. (The reason for the -above was to avoid extra overhead for constant checking for the DISMAIL -flag.) This command is a privileged command.i - - Format:n - - SET [NO]LOGIN username -2 NEWS -Changes attributes of the specified news group or class of news groups.E -This command requires privileges.h - - Format: - - SET NEWS [news-group] - -If no attributes are specified, the present values of the attributes are -shown. -3 /ALL - /ALLa - /NOALLa - -If specified with /CLASS or /DEFAULT, all groups that are presentlyt -available will have their attributes changed,in addition to any that are -created in the future. If /NOALL is specified, the attributes of anyR -news group that was individually changed will not be modified. I.e., if -you set the attributes for misc.test, and then change the defaulta -attributes (using /DEFAULT) with /NOALL, the attributes for misc.testt -will not be changed. This also applies when specifying the attributes -for a class of news groups with /CLASS, but only if the value for /CLASS -is a primary class, i.e. it has a no period in the classname such as -CLASS=rec. Otherwise, /NOALL is not allowed with /CLASS. The default -is /ALL. c -3 /CLASS - /CLASS=classnamen - -Specifies to modify attributes for a class of news groups rather than a -single group, i.e. /CLASS=rec, or /CLASS=sci.med . Attributes ofa -existing groups which are in the class are modified, and any groupsu -created in the future will automatically have those attributes.l -3 /DEFAULT -Specifies default attributes which are applied to all news groups. -3 /DELETEh -When used with /CLASS, specifies that the class attributes are to be -deleted. -3 /DISABLE -Specifies that the news group is disabled and can not be accessed. -3 /ENABLE -Specifies that the news group is enabled and can be accessed. This isn -the default. -3 /EXPIRATIONy - /EXPIRATION=daysn - -Specifies the default expiration time for messages if none is specified. -The default is 7.s -3 /LIMIT - /LIMIT=days - -Specifies the expiration limit for messages. If the value specified is --1, there will be no limit. If the value is 0, the default limit will -be applied, or of any class that is applicable. This is the default.d -It is suggested that the limit be set a no lower than 31 days, as many -groups have a FAQ (frequently asked question) message which is postedf -every month with an expiration date of one month in the future.e -3 /PRIVATE - /PRIVATEo - /NOPRIVATEt - -Specifies that the news group or class can have it's access modified bya -the SET ACCESS command. To accomplish this, a file is created in/ -NEWS_DIRECTORY specified in BULLFILES.INC and ACLs are set on that file. -Note: If you set access for a class, the best way to grant all access l -to news groups in that class is to set /NOPRIVATE, as then time won't be E -wasted checking a file for ACLs. -3 /STOREDn - /STORED - /NOSTORED - -Specifies that the news group are stored on disk rather then accesseds -via the network from the server node. This results in faster access,o -but requires the available disk space. Messages from the news group -are not immediately transferred as the result of this command, but are -tranferred by the separate BULLCP process at regular intervals. The -default is /NOSTORED. -2 NODE -Modifies the selected folder from a local folder to a remote folder. A -remote folder is a folder in which the messages are actually stored on a -folder at a remote DECNET node. The SET NODE command specifies the name -of the remote node, and optionally the name of the remote folder. If -the remote folder name is not included, it is assumed to be the same as -the local folder. When the command is executed, the selected folder -will then point to the remote folder. If there were messages in the -local folder, they will be deleted. This feature is present only if the -BULLCP process is running on the remote node. - - Format: - SET NODE nodename [remotename] - SET NONODE - -NOTE: If one node adds a message to a remote node, other nodes connected -to the same folder will not immediately be aware of the new message. -This info is updated every 15 minutes, or if a user accesses that -folder. -3 /FOLDERo - /FOLDER=foldername - -Specifies the folder for which the node information is to modified.e -If not specified, the selected folder is modified. -2 NOTIFY -Specifies whether you will be notified via a broadcast message when a -message is added to the selected folder. - - Format: - - SET [NO]NOTIFY - -In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that -bit 1 is set, users will be notified no matter which node they are loggedo -in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS -so that bit 1 is cleared.T -3 /ALL -Specifies that the SET [NO]NOTIFY option is the default for all users forn -the specified folder. This is a privileged qualifier. -3 /DEFAULT -Specifies that the [NO]NOTIFY option is the default for the specifieda -folder. This is a privileged qualifier. It will only affect brand newe -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERe - /FOLDER=foldernameu - -Specifies the folder for which the option is to modified. If notm -specified, the selected folder is modified. Valid only with NONOTIFY.f -3 /PERMANENT - /[NO]PERMANENTe - -Specifies that NOTIFY is a permanent flag and cannot be changed by the -individual. /DEFAULT must be specified. This is a privileged qualifier.r -2 PAGE -Specifies whether any directory listing or message reading output will -pause when it reaches the end of the page or not. Setting NOPAGE is -useful for terminals that can store more than one screenful at a time, -and that have a remote printer that can then print the contents of the -terminal's memory. The default is PAGE, unless the default was changed -by specifying /NOPAGE on the command line to invoke BULLETIN.w - - Format: - - SET [NO]PAGE -2 POST_ONLYs -Specifies that the selected folder has the POST_ONLY attribute. Thise -causes the ADD command to mail the message to the mailing address if itt -is present (see /DESCRIPTION), rather than add to the folder. R - - Format:] - - SET [NO]POST_ONLYS -2 PRIVILEGES -Specifies either process privileges or rights identifiers that are -necessary to use privileged commands. Use the SHOW PRIVILEGES command -to see what is presently set. This is a privileged command. - - Format:i - - SET PRIVILEGES parameters. - -The parameters are one or more privileges separated by commas. To -remove a privilege, specify the privilege preceeded by "NO". If /ID is -specified, the parameters are rights identifiers.e -3 /ID - /[NO]ID - -If specified, then the rights identifier which is specified as the -parameter will allow users holding that rights identifier to execute -privileged commands. If /NOID is specified, the identifier is removed.e -2 PROMPT_EXPIRE -Specifies that a user will be prompted for an expiration date when -adding a message. If NOPROMPT_EXPIRE is specified, the user will not be -prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE -or SET BBOARD/EXPIRATION) will be used. If the value specified is -greater than the expiration limit, and the user does not have -privileges, then the expiration limit will be used as the default -expiration. (If there is no expiration limit, and the user doesn't have -privileges, then an error will result.) PROMPT_EXPIRE is the default. - - Format:o - - SET [NO]PROMPT_EXPIRE -2 READNEWa -Controls whether you will be prompted upon logging in if you wish to -read new non-system or folder messages (if any exist). A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN. The default setting for READNEW is dependent on how -the folder was created by the owner. - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET READNEW command. - - Format:t - - SET [NO]READNEW - -NOTE: If you have several folders with READNEW enabled, each folder's -messages will be displayed separately. However, if you EXIT the READNEW -mode before all the folders have been displayed, you will not be alerted -of the new messages in the undisplayed folders the next time you login. -However, if you enter BULLETIN, you will be told that new messages are -present in those other folders. Also, it is not possible to EXIT the -READNEW mode if there are SYSTEM folders which have new messages. Typing -the EXIT command will cause you to skip to those folders. (See HELP SET -SYSTEM for a description of a SYSTEM folder).e -3 /ALL -Specifies that the SET [NO]READNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new users. -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]READNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newe -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDER - /FOLDER=foldernameS - -Specifies the folder for which the option is to modified. If noto -specified, the selected folder is modified. Valid only with NOREADNEW. -3 /PERMANENT - /[NO]PERMANENTg - -Specifies that READNEW is a permanent flag and cannot be changed by thee -individual. This is a privileged qualifier. -2 SHOWNEWF -Controls whether a directory listing of new messages for the current -folder will be displayed when logging in. This is similar to READNEW, -except you will not be prompted to read the messages. The default is -dependent on how the folder was created by the owner. A new message is -defined as one that has been added since the last login, or since -accessing BULLETIN.e - -In order to apply this to a specific folder, first select the folder -(using the SELECT command), and then enter the SET SHOWNEW command. - - Format:t - - SET [NO]SHOWNEW -3 /ALL -Specifies that the SET [NO]SHOWNEW option is the default for all users for -the specified folder. This is a privileged qualifier. The difference -between this and /DEFAULT is that the latter will only apply to new usersA -(i.e. any users which have never executed BULLETIN). -3 /DEFAULT -Specifies that the [NO]SHOWNEW option is the default for the specified -folder. This is a privileged qualifier. It will only affect brand newv -users (or those that have never logged in). Use /ALL to modify all users. -3 /FOLDERt - /FOLDER=foldernames - -Specifies the folder for which the option is to modified. If not -specified, the selected folder is modified. Valid only with NOSHOWNEW. -3 /PERMANENT - /[NO]PERMANENTO - -Specifies that SHOWNEW is a permanent flag and cannot be changed by theE -individual, except if changing to READNEW. This is a privileged qualifier. -2 STRIPe -Affect only messages which are added via either the BBOARD option, orn -written directly from a network mailing program (i.e. PMDF). If -STRIP is set, the header of the mail message will be stripped off -before it is stored as a BULLETIN message. - - Format:C - - SET [NO]STRIPi - -The command SHOW FOLDER/FULL will show if STRIP has been set.c -2 SYSTEM -Specifies that the selected folder is a SYSTEM folder. A SYSTEM foldern -is allowed to have SYSTEM and SHUTDOWN messages added to it. This is ao -privileged command.m - - Format: - - SET [NO]SYSTEM - -If the selected folder is remote, /SYSTEM cannot be specified unless the -folder at the other node is also a SYSTEM folder.a -1 SHOW -The SHOW command displays information about certain characteristics. -2 FLAGSt -Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for thea -currently selected folder. -2 FOLDER -Shows information about a folder of messages. Owner and description are -shown. If the folder name is omitted, and a folder has been selected viaO -the SELECT command, information about that folder is shown.c - - Format:t - - SHOW FOLDER [folder-name]l -3 /FULLe -Control whether all information of the folder is displayed. Thise -includes DUMP & SYSTEM settings, the access list if the folder isl -private, and BBOARD information. This information is only those who -have access to that folder. -2 KEYPAD -Displays the keypad command definitions. - - Format: - - SHOW KEYPAD [key-name] - -If the keypad has been enabled by either the SET KEYPAD COMMAND, ort -if /KEYPAD is specified on the command line, the keypad keys will be -defined as commands. The default settings for the keypad are shown viat -SHOW KEYPAD or HELP KEYPAD. Settings can be changed by using an -initialization file with DEFINE/KEY commands. BULLETIN looks first forL -the file pointed to by the logical name BULL_INIT and then for the fileo -SYS$LOGIN:BULL.INI.d - -NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD. -3 /PRINT -Prints the keypad definitions on the default printer (SYS$PRINT).e -3 /STATE - /STATE=(state,state,...)n - -Specifies the name of a state for which the specified key definitionsl -are to be displayed. If you select more than one state name, separate -them with commas and enclose the list in parentheses. Only works when r -a key name has been specified. -2 NEW -Shows folders which have new unread messages for which BRIEF or READNEWf -have been set. (Note: If you enter BULLETIN but do not read new unread -messages, you will not be notified about them the next time you enterr -BULLETIN. This is a design "feature" and cannot easily be changed.) -2 PRIVILEGES -Shows the privileges necessary to use privileged commands. Also shows -any rights identifiers that would also give a user privileges. (The -latter are ACLs which are set on the BULLUSER.DAT file.) -2 USER -Shows the last time that a user logged in, or if /FOLDER is specified, -the latest message which a user has read in the folder. If NOLOGIN is -set for a user, this information will be displayed. This is a -privileged command. Non-privileged users will only be able to display -the information for their own account. - - Format:a - SHOW USER [username] - -The username is optional. If omitted, the process's username is used. -The username should not be included if /ALL or /[NO]LOGIN is specified. - -NOTE: The last logged in time displayed is that which is stored when the -BULLETIN/LOGIN command is executed, not that which VMS stores. Some -sites make BULLETIN/LOGIN an optional command for users to store in -their own LOGIN.COM, so this command can be used to show which users -have done this.e -3 /ALL -Specifies that information for all users is to be displayed. This is a -privileged command.r -3 /LOGIN - /[NO]LOGINt - -Specifies that only those users which do not have NOLOGIN set are to ber -displayed. If negated, only those users with NOLOGIN set are displayed. -This is a privileged command. The qualifier /ALL need not be specified. -3 /FOLDERh - /FOLDER=[foldername] - -Specifies to display the latest message that was read by the user(s) for -the specified foldername. A newsgroup can be specified, but the info -can only be shown if the user has subscribed to the newsgroup. If the -foldername is not specified, the selected folder will be used. -3 /SINCE - /SINCE=[date] - -Specifies to display only those users whose latest read message date is -the same date or later than the specified date. If no date is -specified, the date of the current message is used. Only valid for -folders or with /LOGIN. Use /START for newsgroups.l -3 /START - /START=[number] - -Specifies to display only those users whose latest read message number -is equal to or greather than the specified number. If no number is -specified, the message number of the current message is used. Only -valid for newsgroups. Use /SINCE for folders and with /LOGIN. -2 VERSIONf -Shows the version of BULLETIN and the date that the executable was -linked.S -1 SPAWNW -Creates a subprocess of the current process. To return to BULLETIN, -type LOGOUT. - - Format: - SPAWN [command-string] - -NOTE: BULLETIN disables the use of CONTROL-C, so that you must use -CONTROL-Y if you wish to break out of a spawned command. -1 SUBSCRIBEt -Used only for NEWS folders. Specifies that BULLETIN will keep track of -the newest message that has been read for that NEWS folder. When the -NEWS folder is selected, the message pointer will automatically point to -the next newest message that has not been read. To see a list of theh -subscribed groups, type NEWS/SUBSCRIBE. To automatically read news -groups with new messages, use INDEX/SUBSCRIBE. -1 UNDELETE -Undeletes he specified message if the message was deleted using the -DELETE command. Deleted messages are not actually deleted but have -their expiration date set to 15 minutes in the future and are deleted -then. Undeleting the message will reset the expiration date back to its -original value. Deleted messages will be indicated as such by the -string (DELETED) when either reading or doing a directory listing. - - Format:t - UNDELETE [message-number]L -1 UNSUBSCRIBE -Used only for NEWS folders. Specifies that BULLETIN will no longer keep -track of the newest message that has been read for that NEWS folder. See thei -SUBSCRIBE command for further info. -1 Usenet_news] -BULLETIN can also read USENET NEWS if your system has network access toa -a node which carries it. USENET NEWS is a global bulletin board system. -It is split into news groups. Use the NEWS command to see the list of o -groups which are available. These are similar to BULLETIN's folders, -except that the SUBSCRIBE command must be used to subscribe to a group ine -order to keep track of which messages you have read in that group. Most -of the other BULLETIN commands can also be used when reading NEWS. - -To see a list of the subscribed groups, type NEWS/SUBSCRIBE. To -automatically read news groups with new messages, use INDEX/SUBSCRIBE. e -1 New_features -Here is a list of new features which may be of interest to the general -BULLETIN user. If you find a bug or have a good suggestion for a new -feature, send mail to MRL@PFC.MIT.EDU. - --------------------------------------------------------------------------n -V 2.13 - -Added /[NO]HEADER and /ROTATE to NEXT (help said they were there, but they -weren't). 1/15/93 - -Added RESET command. 1/9/93 - -V 2.12 - -Added INCLUDE and EXCLUDE commands which allow avoiding reading messages -based on subject and address headers. 12/15/92d - -V 2.11 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and -now only shows folders or groups that have new messages. /SET added to show -only folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the -default. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92, - -Added /ROTATE for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -V 2.09 - -Added /FROM, /NOREPLIES, & /NEGATED to SEARCH and DIRECTORY commands. -3/18/92s - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Display time when reading news messages in local rather than GMT time. -12/8/91n - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91n - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for thef -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91 - -Fixed error in POST & RESPOND command. If a file was specified on the -command line, and /EDIT was specified, the file would be sent even if the -user quit out of the edit, rather than exitting (i.e. outputting a file). -10/21/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message -basis. Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91l - -Added /NOW to PRINT command. Messages no longer have to be printed one -message at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91 - -Added /PRINT to DIRECTORY command to allow printing of messages which are -found by using the DIRECTORY command. 7/31/91t - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large -news group names. 7/31/91e - -Added FIRST command to read first message found in folder. 7/31/91e - -Modified code to correctly store subject headers from BBOARD mail which are -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91h - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more -than one folder at a time. 6/13/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -V2.04d - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91 diff --git a/decus/vax92b/bulletin/bullet1.com b/decus/vax92b/bulletin/bullet1.com deleted file mode 100644 index 8815e7a..0000000 --- a/decus/vax92b/bulletin/bullet1.com +++ /dev/null @@ -1,1519 +0,0 @@ -$set nover -$copy/log sys$input AAAREADME.TXT -$deck -The following are instructions for creating and installing the BULLETIN -utility. None of the command procedures included here are sophisticated, so it -is likely that several modifications will have to be made by the installer. -The installer should enable all privileges before installation. - -Once installation is complete, it is suggested that the installer enter -BULLETIN and read HELP FOLDERS to see the options available when creating -or modifying folders. BULLETIN creates a default folder called GENERAL -which is a SYSTEM folder (allows messages to be posted which are displayed -in full when people login.) This folder can be modified (name changed, -SYSTEM setting removed, etc.), but it will remain the default folder -which is selected when BULLETIN is entered, and it cannot be deleted. - -One of the main uses of BULLETIN, besides storage of messages that are manually -entered by users, is storage of messages from network mailing lists. This is -done by using the BBOARD feature, which is enabled using the SET BBOARD command -inside BULLETIN. The alternative method is for mail messages to be written -directly by a mailing program by calling internal BULLETIN routines. Such a -a program has been written for the popular mail utilities PMDF and MX. If you -wish to do so for another utility, read the text file WRITEMSG.TXT. I would be -glad to include any such programs with my distribution if you think such a -program would be of use to other users. - -Responding to mail which is added via the BBOARD feature is done using -VMS MAIL. The name of the mail protocol to use for responding by mail -can be either hardcoded by putting in BULLNEWS.INC, or by defining the -system logical name BULL_NEWS_MAILER, i.e. DEFINE BULL_NEWS_MAILER "MX%". - -If for some reason this is inappropriate, you can define BULL_MAILER -to point to a command procedure, and which will be run instead of VMS MAIL. -The parameters passed to this procedure are P1 = username and P2 = subject. - -1) CREATE.COM - This will compile and link the BULLETIN sources. Also, there are several - INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's - data files in the directory pointed to by the logical name BULL_DIR. If you - elect not to use this definition, BULLFILES.INC should be modified. - Note that after this procedure compiles the sources, it puts the objects - into an object library, and then deletes all the OBJ files in the directory. - - NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN, - read NEWS.TXT for installation instructions before compiling. - - NOTE 2: The maximum number of folders for this distribution is 96 folders. - If you wish to increase this, modify BULLUSER.INC and recompile the sources. - When the new executable is run, it will create a new BULLUSER.DAT data file - and rename the old one to BULLUSER.OLD. You cannot reduce the number of - folders. - -2) INSTALL.COM - The following procedure copies the executable image to BULL_DIR and - installs it with certain privileges. It also installs the necessary - help files in SYS$HELP. (BULLETIN help file is installed into the - system help library HELPLIB.HLB. If you don't wish this done, delete - or modify the appropriate line in the procedure. Also, the help - library for the BULLETIN program, BULL.HLB, can be moved to a different - directory other than SYS$HELP. If this is done, the system logical name - BULL_HELP should be defined to be the directory where the library is - to be found.) - -3) LOGIN.COM - This contains the commands that should be executed at login time - by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands. - It also executes the command BULLETIN/LOGIN in order to notify - the user of new messages. NOTE: If you wish the utility to be a - different name than BULLETIN, you should modify this procedure. - The prompt which the utility uses is named after image executable. - If you want messages displayed upon logging in starting from - oldest to newest (rather than newest to oldest), add /REVERSE to - the BULLETIN/LOGIN command. Note that users with the DISMAIL - flag setting in the authorization file will not be notified of - new messages. See help on the SET LOGIN command within the BULLETIN - utility for more information on this. Also, please note that when - a brand new user to the system logins, to avoid overwhelming the new - user with lots of messages, only PERMANENT SYSTEM messages are displayed. - - If you want SYSTEM messages, i.e. messages which are displayed in full - when logging in, to be continually displayed for a period of time rather - than just once, you should add the /SYSTEM= qualifier. This is documented - in BULLETIN.HLP, although there it is referred to only with respect to - a user wanting to review system messages. It can be added with /LOGIN. - - DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are - executed twice, once before the terminal is actually created, while - SYS$OUTPUT is still a mailbox, the other time after the terminal is - created. To avoid this, place the following code in both procedure. - It causes them to execute only when the output is a terminal. This code - also helps to allow programs to be placed in LOGIN.COM that prompt for - terminal input. BULLETIN does this if you select READNEW mode for - displaying messages when logging in, as READNEW mode will ask you if - you want to display the messages text. Attempts to read terminal input - under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM - creation to fail. (This problem is fixed under MOTIF). - - $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START - $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START - $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START - $ GOTO FINISH - $START: - . - . - body of SYLOGIN.COM (including BULLETIN command) - . - . - $FINISH: - $ EXIT - -4) BULLSTART.COM - This procedure contains the commands that should be executed after - a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM. - It installs the BULLETIN utility with correct privileges. It also - includes the command BULLETIN/STARTUP. This starts up a detached process - with the name BULLCP. It periodically checks for expire messages,cleanups - empty space in files, and converts BBOARD mail to messages. It also allows - other DECNET nodes to share it's folders. If you don't want this feature - and don't plan on having multiple folders or make use of BBOARD, you could - eliminate this command if you like. However, it is highly recommended that - you create this process to avoid extra overhead when users login. NOTE: - BULLCP normally is created so it is owned by the DECNET account. If that - account does not exist, BULLCP will be owned by the account that issues - the BULLETIN/START command. In that case, access via other DECNET nodes - will not be available. - - If you are installing BULLETIN on a cluster and plan to have the bulletin - files be shared between all of the cluster nodes, you only need to have - this process running on one node. On all other nodes, the system logical - name BULL_BULLCP should be defined (to anything you want) so as to notify - BULLETIN that BULLCP is running. (On the local node where BULLCP is running, - this logical name is automatically defined.) - - The system logical name BULL_CUSTOM can be defined to enable several - features. It is equated to a hex number string. - Bit 0 set = need privileges to create folder. - 1 set = captive account can write files. - 2 set = captive account can use editor. - - If you want to have more than one database, you can do so by redefining - BULL_DIR to another directory. However, only directories that are - defined in the list of equivalence names pointed to by the system logical v - name BULL_DIR_LIST are allowed. For example: - - DEFINE/SYSTEM BULL_DIR_LIST SITE$ROOT:[SYSEXE],USER1:[MRL]L - - Then BULL_DIR can be defined as SITE$ROOT:[SYSEXE] or USER1:[MRL]. a - BULL_DIR_LIST must be defined on all nodes in a cluster. - d - The use of the MARK command to mark messages require that a file be - created for each user which saves the marked info. That file file is - stored in the directory pointed to by the logical name BULL_MARK. You canh - either let users who want to use this command define it themselves, ore - you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN. - -5) INSTRUCT.COMf - This procedure adds 2 permanent messages which give a very brief - description about the BULLETIN utility, and how to turn off optionalc - prompting of non-system messages (via SET NOREADNEW). - -6) BOARD_SPECIAL.COM - This command procedure describes and illustrates how to use the - SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD - where the input does not come from VMS MAIL. For example, this could - be used in the case where mail from a non-DEC network is not stored - in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file - takes mail messages from "digest" type mailing lists and splits themr - into separate BULLETIN messages for easier reading. - - To use this feature, place the special command procedure into the - bulletin file directory using the name BOARD_SPECIAL.COM. If you want - to have several different special procedure, you should name the command - procedure after the username specified by the SET BBOARD command. - -7) UPGRADE.COM - This procedure is used to upgrade to a new version of BULLETIN. - See comments for instructions.m - -8) MASTER.COMR - If you are using PMDF, and want to use the BBOARD option, a set ofa - routines are included which will allow PMDF to write message directly - into folders, which is a much more effecient way of doing it than - the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how - to do this. - -9) OPTIMIZE_RMS.COMN - This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM - followed by the filename. If you omit the filename, it will prompt - you to allow you to turn off or on several different types of RMS - compression. The default is to turn on all types of compression. - The optimization will cause the file to be compressed.e - - If you use the NEWS feature, it is suggest that you run this procedurer - on BULLNEWS.DAT after it is created. Compressing that file greatly speedsf - up the NEWS update process. If you are tight on space, and have been - running BULLETIN for a long time, it might also be useful to compress - BULLINF.DAT if that file is very large. However, compressing that (ori - the other BULLETIN data files) don't appear to save any execution time, - unlike BULLNEWS.DAT.a -$eod m -$copy/log sys$input BULLDIR.INCo -$deckt - PARAMETER DIR_RECORD_LENGTH = (100/4)*4 - - COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIMe - & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM - & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY - & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIMEH - & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME - CHARACTER*56 DESCRIPn - CHARACTER*12 FROM - LOGICAL SYSTEMl - - CHARACTER*12 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATEt - CHARACTER*12 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIMEg - - INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2) - INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2) - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY - EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY)$ - - CHARACTER*52 BULLDIR_HEADER - EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER)e - - DATA HEADER_BTIM/0,0/,HEADER_NUM/0/ - - CHARACTER MSG_KEY*8 - - EQUIVALENCE (MSG_BTIM,MSG_KEY)h - - PARAMETER LINE_LENGTH=255 - PARAMETER INPUT_LENGTH=256o - - COMMON /INPUT_BUFFER/ INPUT - CHARACTER INPUT*(INPUT_LENGTH)i - - PARAMETER NEWSDIR_RECORD_LENGTH = 180 - - COMMON /NEWS_DIR/ NEWS_MSG_KEY,NEWS_MSG_BTIM_KEY,NEWS_MSGID - & ,NEWS_EX_BTIM_KEY,NEWS_POST_BTIM,NEWS_BLOCK,NEWS_LENGTHt - & ,NEWS_DESCRIP,NEWS_FROMt - & ,NEWS_HEADER_KEY,NEWS_NEWEST_MSG_BTIM_KEYa - & ,NEWS_HEADER_FOLDER,NEWS_NEWEST_EX_BTIM_KEY,NEWS_HEADER_NUMp - & ,NEWS_NBULL - CHARACTER*64 NEWS_MSGID - CHARACTER*56 NEWS_DESCRIP - CHARACTER*12 NEWS_FROMa - CHARACTER*8 NEWS_MSG_KEY,NEWS_HEADER_KEYt - - CHARACTER*12 NEWS_MSG_BTIM_KEY,NEWS_EX_BTIM_KEY - CHARACTER*12 NEWS_NEWEST_MSG_BTIM_KEY,NEWS_NEWEST_EX_BTIM_KEY - INTEGER NEWS_POST_BTIM(2) - - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_ENTRY - EQUIVALENCE (NEWS_MSG_KEY,NEWSDIR_ENTRY)a - - CHARACTER*64 NEWS_HEADER_FOLDER - CHARACTER*(NEWSDIR_RECORD_LENGTH) NEWSDIR_HEADERE - EQUIVALENCE (NEWS_HEADER_KEY,NEWSDIR_HEADER)T -$eod -$copy/log sys$input BULLETIN.HLP -$deckh -1 BULLETIN -Invokes the PFC BULLETIN Utility. This utility is used for reading, -adding and deleting message. Users are notified at login time that newI -messages have been added and the topics of those messages are displayed. -Reading of those messages is optional. (Use the command SET READNEW -while in BULLETIN for setting automatic reading.) Privileged users can -add system bulletins that are displayed in full at login time. These -messages are also saved, and can be read by BULLETIN. Messages are -automatically deleted after a specified expiration date, or they can -manually be deleted by either the submitter of the message or a -privileged user. - - Format: - - BULLETIN [foldername or bulletin interactive command]C - -BULLETIN has an interactive help available while using the utility. -Type HELP after invoking the BULLETIN command. - -If so configured, BULLETIN can also read USENET NEWS.E -2 Description - -The BULLETIN utility is a utility to display messages to users when -logging in. Users are notified of messages only once. They're not -forced into reading them every time they log in. Submitting and reading -messages is easy to do via a utility similar to the VMS MAIL utility. -Privileged users can create messages which are displayed in full. (known -as SYSTEM messages). Non-privileged users may be able to create -non-SYSTEM messages (unless your system manager has disabled the -feature), but only topics are displayed at login. - -Folders can be created so that messages pertaining to a single topic can -be placed together. Folders can be made private so that reading and -writing is limited to only users or groups who are granted access. -Alternatively, folders can be made semi-private in that everyone is -allowed to read them but write access is limited. - -When new non-system messages are displayed, an optional feature which a -user may enable will cause BULLETIN to ask whether the user wishes to -read the new bulletins. The user can then read the messages (with the -ability to write any of the messages to a file). A user can enable the -notification and prompting of new messages feature on a folder per -folder basis. However, the exception is messages submitted to the -default GENERAL folder. Users are always notified at login of new -bulletins in this folder, but can disable the prompting. This is to -give non-privileged users some ability to force a notification of an -important message. - -Messages have expiration dates and times, and are deleted automatically. -Expiration dates and times can be specified in absolute or delta -notation. Privileged users can specify "SHUTDOWN" messages, i.e. -messages that get deleted after a system shutdown has occurred. -"PERMANENT" messages can also be created which never expire. - -Privileged users can broadcast their message (to either all users or all -terminals).o - -A user can select, on a folder per folder basis, to have a message -broadcast to their terminal immediately notifying them when a new -message has been added.h - -An optional "Bulletin Board" feature allows messages to be created by -users of other systems connected via networks. A username can be -assigned to a folder, and any mail sent to that user is converted to -messages and stored in that folder. This feature originally was -designed to duplicate the message board feature that exists on some -Arpanet sites. However, with the addition of folders, another possible -use is to assign an Arpanet mailing list to a folder. For example, one -could have an INFOVAX folder associated with an INFOVAX username, and -have INFO-VAX mail sent to INFOVAX. Users could then read the mailing -list in that folder, rather than having INFO-VAX sent to each user. -Optionally, the input for the bulletin board can be directed to be taken -from any source other than VMS MAIL. This might be useful if incoming -mail is stored in a different place other than VMS MAIL. - -Messages can be either sent to a file, to a print queue, or mailed to -another user. - -BULLETIN can also act a USENET NEWS reader if the appropriate network -software is available to interact with. See the installation notes for -more detail. -2 Parameters -The parameter following the BULLETIN command is interpreted as the -folder name which should be selected, rather than the default GENERAL -folder. If the parameter is specified with quotes ("parameter"), the -parameter is interpreted as an interactive BULLETIN command, i.e. -commands which are entered once BULLETIN is executed, i.e. "DIRECTORY", -"ADD", etc. BULLETIN will exit immediately after entering that command, -rather than prompting for another command. More than one command can be -specified by separating the commands with semi-colons, i.e. "SELECT -DATA;DIR". If the last command ends with a semi-colon, then BULLETIN -will not exit, but instead will enter the standard interactive mode and -prompt the user for commands.h - -NOTE: Depending on how the BULLETIN command is defined, triple quotes -rather than single quotes may be required. -2 /EDITt -Specifies that all ADD or REPLACE commands within BULLETIN will select -the editor for inputting text. -2 /KEYPADy - /[NO]KEYPAD -Specifies that keypad mode is to be set on, such that the keypad keys -correspond to BULLETIN commands. The default is /KEYPAD.T -2 /PAGEt - /[NO]PAGE - -Specifies whether BULLETIN will stop outputting when it displays a full -screen or not. /PAGE is the default. If /NOPAGE is specified, any -output will continue until it finishes. This is useful if you have a -terminal which can store several screenfuls of display in its memory.t -2 /PGFLQUOTA - /PGFLQUOTA=pagesg - -Used if you want to specify the page file quota for the BULLCP process.D -2 /STARTUP -Starts up a detached process which will periodically check for expired -messages, cleanup empty space in files, and convert BBOARD mail to -messages. This is recommended to avoid delays when invoking BULLETIN. -It will create a process with the name BULLCP. For clusters, this -need be done only on one node. On all other nodes, the system logical -name BULL_BULLCP should be defined (to anything) in order that BULLETINN -is aware that it is running on another node. (On the local node whereM -BULLCP is running, this logical name is automatically defined.) -2 /STOPR -Stops the BULLCP process without restarting a new one. (See /STARTUPE -for information on the BULLCP process.)N -2 /SYSTEMA - /SYSTEM=[days]M - -Displays system messages that have been recently added. The default is2 -to show the messages that were added during the last 7 days. This can -be modified by specifying the number of days as the parameter. -This command is useful for easily redisplaying system messages thatV -might have been missed upon logging in (or were broadcasted but were -erased from the screen.) -2 /WIDTH - /WIDTH=page_width - -Specifies the terminal width for display purposes. This is used if your -startup procedure is configured such that BULLETIN/LOGIN is executed beforeD -the terminal type is known, and the default width is larger than what theE -terminal type actually is. I.e. the default width might be 132, but the -real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN. -2 /WSEXTENT - /WSEXTENT=pages - -Used if you want to specify the working set limit for the BULLCP process.T -$eod E -$copy/log sys$input BULLETIN.LNK -$deckA -$ ULIB = "NONE"O -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK -$ ULIB = "PROCESS" -$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET_ -$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC -$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET -$LINK: -$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL-D - /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT -SYS$SHARE:VAXCRTL/SHAREA -ID="V2.13" -$eod D -$copy/log sys$input BULLFILES.INCU -$deckH -C -C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT -C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION, -C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED -C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND). -C -C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING -C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED.e -C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY,r -C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE -C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SUREt -C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE -C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES: -C PQL_DPGFLQUOTA = 15000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30. -C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING -C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR")a -Ce - COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY - COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE,NEWS_DIRECTORYt - COMMON /FILES/ BULLNEWSDIR_FILE,BULLNEWS_FILE - CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/ - CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/ -C -C NOTE: THE FOLLOWING FILE ARE STORED IN THE FOLDER_DIRECTORY BY DEFAULT. -C YOU CAN CHANGE THIS BY ADDING A DIRECTORY NAME TO THE FILE NAME.l -C - CHARACTER*80 BULLUSER_FILE /'BULLUSER.DAT'/ ! Stores user login timer - ! & folder flag settings - CHARACTER*80 BULLFOLDER_FILE /'BULLFOLDER.DAT'/ ! Stores folder datal - CHARACTER*80 BULLINF_FILE /'BULLINF.DAT'/ ! Stores times of last - ! read messages of users - CHARACTER*80 BULLNEWS_FILE /'BULLNEWS.DAT'/ ! Stores news group datae - CHARACTER*80 BULLNEWSDIR_FILE /'BULLNEWSDIR.DAT'/ - ! Directory listing for LOCAL news groupsn -Cw -C THE FOLLOWING IS THE DIRECTORY THAT IS USED TO STORE LOCAL NEWS GROUPS, -C I.E. NEWS GROUPS THAT ARE COPIED FROM THE NEWS SERVER AND SAVED LOCALLY.b -C BULLETIN WILL CREATE SUBDIRECTORIES IN THIS DIRECTORY AND THE FILES WILLe -C BE STORED IN THOSE SUBDIRECTORIES. -C - CHARACTER*80 NEWS_DIRECTORY /'BULL_DIR:'/ -$eod a -$copy/log sys$input BULLFOLDER.INC -$decka -!. -! The following 2 parameters can be modified if desired before compilation. -!r - PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days thatt - ! BBOARDS can be set to.h - PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks - ! for new BBOARD mail. (Note: Check - ! only occurs via BULLETIN/LOGIN. - ! Check is forced via BULLETIN/BBOARD). - ! NOT APPLICABLE IF BULLCP IS RUNNING.f - PARAMETER ADDID = .TRUE. ! Allows users who are not in thec - ! rights data base to be added. - ! according to uic number. - - PARAMETER FOLDER_FMT = '(A44,A4,A8,A12,A80,A12,3A4,A8,10A4)'c - PARAMETER FOLDER_RECORD = 220 ! Must be multiple of 4 - - COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_CREATED_DATE,l - & FOLDER_OWNER,c - & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE,e - & USERB,GROUPB,ACCOUNTB, - & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT,n - & F_NEWEST_NOSYS_BTIM,F_START,F_COUNT,F_LAST,w - & FOLDER_FILE,FOLDER_SET,FOLDER_NAME - INTEGER F_NEWEST_BTIM(2)i - INTEGER F_NEWEST_NOSYS_BTIM(2) - LOGICAL FOLDER_SET - DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/ - CHARACTER FOLDER_OWNER*12,FOLDER*44,ACCOUNTB*8,FOLDER_NAME*80 - CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12 - CHARACTER FOLDER_CREATED_DATE*8 - - CHARACTER*(FOLDER_RECORD) FOLDER_COMl - EQUIVALENCE (FOLDER,FOLDER_COM) - - COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_CREATED_DATE,h - & FOLDER1_OWNER, - & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE, - & USERB1,GROUPB1,ACCOUNTB1,e - & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT,i - & F1_NEWEST_NOSYS_BTIM,F1_START,F1_COUNT,F1_LAST, - & FOLDER1_FILE,FOLDER1_SET,FOLDER1_NAME - CHARACTER FOLDER1_OWNER*12,FOLDER1*44,ACCOUNTB1*8,FOLDER1_NAME*80 - CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12 - CHARACTER FOLDER1_CREATED_DATE*8l - INTEGER F1_NEWEST_BTIM(2) - INTEGER F1_NEWEST_NOSYS_BTIM(2) - - CHARACTER*(FOLDER_RECORD) FOLDER1_COM - EQUIVALENCE (FOLDER1,FOLDER1_COM) - - PARAMETER NEWS_FOLDER_FMT = '(A44,A4,2A8,A36,11A4)' - PARAMETER NEWS_FOLDER_RECORD = 144 ! Must be multiple of 4 - - COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER,m - & NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE, - & NEWS_FOLDER_DESCRIP,NEWS_F_START,NEWS_F_COUNT, - & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM,NEWS_F_LAST, - & NEWS_F_FLAG,NEWS_F_EXPIRE,NEWS_F_FIRST,. - & NEWS_F_EXPIRE_LIMIT,NEWS_F_END I - INTEGER NEWS_F_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER*44l - CHARACTER NEWS_FOLDER_DESCRIP*36a - CHARACTER*8 NEWS_F_CREATED_DATE,NEWS_F_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COMt - EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM) - - COMMON /NEWS_FOLDER_DEFAULT/ NEWS_FLAG_DEFAULT,c - & NEWS_EXPIRE_DEFAULT,NEWS_EXPIRE_LIMIT_DEFAULT - - COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER, - & NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE, - & NEWS_FOLDER1_DESCRIP,NEWS_F1_START,NEWS_F1_COUNT, - & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM,NEWS_F1_LAST, - & NEWS_F1_FLAG,NEWS_F1_EXPIRE,NEWS_F1_FIRST, - & NEWS_F1_EXPIRE_LIMIT,NEWS_F1_ENDf - INTEGER NEWS_F1_NEWEST_BTIM(2) - CHARACTER NEWS_FOLDER1*44 - CHARACTER NEWS_FOLDER1_DESCRIP*36 - CHARACTER*8 NEWS_F1_CREATED_DATE,NEWS_F1_EXPIRED_DATE - - CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM - EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM) -$eod t -$copy/log sys$input BULLNEWS.INC -$deckp - COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILERi - - CHARACTER*132 ORGANIZATIONl - DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/ - - CHARACTER*12 MAILER - DATA MAILER /'IN%'/ -$eod s -$copy/log sys$input BULLUSER.INC -$decku -! -! The parameter FOLDER_MAX should be changed to increase the maximum number -! of folders available. Due to storage via longwords, the maximum number -! available is always a multiple of 32. Thus, it will probably make sense -! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be -! the capacity. Note that the default general folder counts as a folder also, -! so that if you specify 64, you will be able to create 63 folders on your own.a -!t - PARAMETER FOLDER_MAX = 96 - PARAMETER FLONG = (FOLDER_MAX + 31)/ 32 - - PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16i - PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)'t - PARAMETER USER_HEADER_KEY = ' 'o - - COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV - COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEFt - COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF - CHARACTER TEMP_USER*12d - DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG) - DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG) - DIMENSION NOTIFY_FLAG_DEF(FLONG)s - - COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM, - & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - CHARACTER*12 USERNAME - DIMENSION LOGIN_BTIM(2),READ_BTIM(2)m - DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folderr - ! Now NEW_FLAG(2) contains SET GENERIC daysb - DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folderw - DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set - DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast - ! notification when new bulletin is added. - - CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER - EQUIVALENCE (USER_ENTRY,USERNAME) - EQUIVALENCE (USER_HEADER,TEMP_USER) - - COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX)" - ! Must start with 0 to store info for folder specified with :: - COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX) - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DATT - COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX)U - INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX) - EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1)): - ! Last read times for each folder as stored in BULL_DIR:BULLINF.DATd - - COMMON /NEW_MESSAGES/ NEW_MSG - DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected -$eod -$copy/log sys$input BULL_NEWS.CO -$deckY -#include -#include "sys$library:iodef.h" - -#if MULTINET - -#include "multinet_root:[multinet.include.sys]types.h" -#include "multinet_root:[multinet.include.sys]socket.h"E -#include "multinet_root:[multinet.include.netinet]in.h"F -#include "multinet_root:[multinet.include]netdb.h" -#include "multinet_root:[multinet.include]errno.h" -#include "multinet_root:[multinet.include.vms]inetiodef.h" - -static char inet[7] = "INET0:";R -$DESCRIPTOR(inet_d,inet);L - -#elseB - -#if UCXK - -#include - -struct sockaddr {E - short inet_family; - short inet_port; - int inet_adrs; - char bklb[8];A - }; - -struct itlist { int lgth; struct sockaddr *hst; }; - -static short sck_parm[2];& -static struct sockaddr local_host, remote_host; -struct itlist lhst_adrs, rhst_adrs;N - -static char ucxdev[11] = "UCX$DEVICE"; -$DESCRIPTOR(ucxdev_d,ucxdev);e - -static int addr_buff; - -#define htons(x) ((unsigned short)((x<<8)|(x>>8))) - -#elseM - -#if TWG - -#include -#include -#include -#include N -#include - -static char inet[6] = "INET:"; -$DESCRIPTOR(inet_d,inet);Y - -#elseI - -#define CMU 1: -static char ip[4] = "IP:"; -$DESCRIPTOR(ip_d,ip);O - -#endif - -#endif - -#endif - -static char task[20];C -$DESCRIPTOR(task_d,task);l - -static int s;8 - -static struct iosb { - short status; - short size; - int info; -} iosb;e - -#define TCP 0 -#define DECNET 1 - -static int mode = TCP; - -news_get_chan()r -{return(s);} - -news_set_chan(i) -int *i;F -{s = *i;}o - -news_disconnect() -{ -#if UCXe - sys$cancel(s); - sys$qiow(0,s,IO$_DEACCESS,0,0,0,0,0,0,0,0,0); -#endif - sys$dassgn(s);C -}A - -#if MULTINET || TWGE - -static struct hostent *hp; -static struct sockaddr_in sin; - -#endif - -int *node; - -news_gethost() -{ - /*I - * Get the IP address of the NEWS host. - * As of MULTINET 3.0, cannot be done at AST level - * so can't do in NEWS_ASSIGN(), as BULLCP calls it at - * AST level if the decnet gateway feature is used.S - */ -#if TWG || (MULTINET && defined(__GNUC__)) - struct hostent *gethostbyname(); -#elseu -#if MULTINET - struct hostent *GETHOSTBYNAME1(); -#endif -#endif - - node = getenv("BULL_NEWS_SERVER");. - if (!node) return(0); - if (!strchr(node,'.')) return(1); - -#if TWG || (MULTINET && defined(__GNUC__)) - hp = gethostbyname(node); -#elser -#if MULTINET - hp = GETHOSTBYNAME1(node);B -#endif -#endif - return(1); -}o - -news_assign()L -{I - int n; - - if (!strchr(node,'.')) {L - strcpy(&task[0],node); - n = strlen(node);R - strcpy(&task[n],"::\"TASK=NNTP\"");o - task_d.dsc$w_length = 13 + n;! - if (!(sys$assign(&task_d,&s,0,0) & 1)) return(0); - mode = DECNET; - return(1); - } -#if MULTINET || TWGA - /*1 - * Create a "sockaddr_in" structure which describes the remote - * IP address we want to send to (from gethostbyname()). - */ - - if (!hp) { - int h[4],i;P - if (sscanf(node,"%d.%d.%d.%d",&h[0],&h[1],&h[2],&h[3]) == 4) { - for (i=0;i<4;i++) if (h[i] < 0 || h[i] > 255) return(0); - sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]); - } else - return(0);_ - sin.sin_family = AF_INET; - } - else { - sin.sin_family = hp->h_addrtype; - memcpy(&sin.sin_addr, hp->h_addr, hp->h_length);F - }C -#if TWG || (MULTINET && defined(__GNUC__)) - sin.sin_port = htons(119);R -#else* - sin.sin_port = HTONS1(119); -#endif - - /*A - * Create an IP-family socket on which to make the connection) - */ - - if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0); -#elseA -#if UCX - if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0);L - { - short retlen; - struct dsc$descriptor host_nameL - = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node}; - int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME; - struct dsc$descriptor commandA - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm};F - struct dsc$descriptor host_adF - = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff}; - struct iosb nam_iosb;* - - if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0,) - &command,&host_name,&retlen,&host_ad,0,0) & 1)R - || !(nam_iosb.status & 1)) {A - sys$dassgn(s); - return(0); - }u - } -#elsep - if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0); -#endif -#endif - return(1);S -}C - -news_socket()F -{P - if (mode == DECNET) return (1); - -#if MULTINET || TWG_ - if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#if UCXE - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET;E - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host;F - if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) {N - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0,E - UCX$C_DSC_ALL,0,0);, - sys$dassgn(s); - return(0); - } -#endif - - return(1); -}& - -news_socket_bullcp(efn,biosb,astadr,astprm)T -int *biosb,*astadr,*astprm,*efn; -{R - if (mode == DECNET) return (1); - -#if MULTINET || TWGS - if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family, - SOCK_STREAM,0,0,0,0) & 1) ) return(0);R -#else_ -#if UCXD - sck_parm[0] = INET$C_TCP; - sck_parm[1] = INET_PROTYP$C_STREAM; - local_host.inet_family = INET$C_AF_INET;W - local_host.inet_port = 0; - local_host.inet_adrs = INET$C_INADDR_ANY; - lhst_adrs.lgth = sizeof local_host; - lhst_adrs.hst = &local_host;l - if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0, - &lhst_adrs,0,0,0) & 1) ) return(0);c -#else - return(-1); -#endif -#endif - - return(1);a -}e - -news_create()l -{e - if (mode == DECNET) return (1); - -#if MULTINET || TWGa - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok). - */ - - if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1) - || !(iosb.status & 1)) {e - sys$dassgn(s); - return(0); - } -#elseP -#if UCX - remote_host.inet_family = INET$C_AF_INET;) - remote_host.inet_port = htons(119);F - remote_host.inet_adrs = addr_buff;, - rhst_adrs.lgth = sizeof remote_host;R - rhst_adrs.hst = &remote_host; - if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1)H - || !(iosb.status & 1)) {F - sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0,R - UCX$C_DSC_ALL,0,0);M - sys$dassgn(s); - return(0); - } -#elseS - if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1)F - || !(iosb.status & 1)) { - sys$dassgn(s); - return(0); - } -#endif -#endif - - return(1);T -}_ - -news_create_bullcp(efn,biosb,astadr,astprm)B -int *biosb,*astadr,*astprm,*efn; -{F - if (mode == DECNET) return (1); - -#if MULTINET || TWG - - /* - * Do a psuedo-connect to that address. This tells the kernel that - * anything written on this socket gets sent to this destination. It - * also binds us to a local port number (random, but that is ok).O - */ - - if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr - ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0);C -#elseG -#if UCXE - remote_host.inet_family = INET$C_AF_INET;) - remote_host.inet_port = htons(119);M - remote_host.inet_adrs = addr_buff;: - rhst_adrs.lgth = sizeof remote_host;o - rhst_adrs.hst = &remote_host; - if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0, - 0,&rhst_adrs,0,0,0) & 1)) return(0); -#elses - if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node,E - 119,0,1,0,300) & 1)) - return(0); -#endif -#endif - - return(1);V -}N - -news_connect() -{, - if (!news_gethost()) return(0); - if (!news_assign()) return(0);s - if (!news_socket()) return(0); - return(news_create());W -}G - -news_write_packet(buf) - -struct dsc$descriptor_s *buf;e -{t - static int n,len; - - len = buf->dsc$w_length;c -#if CMUu - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,!mode,0,0) & 1) - || !(iosb.status & 1)) return(0); -#elser - if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer,l - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); -#endif - - return(1);u -}" - -news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len)r -int *biosb,*astadr,*astprm,*efn,*buf,*len; -{c -#if CMUt - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf,C - *len,0,!mode,0,0) & 1)) return(0);s -#else - if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf, - *len,0,0,0,0) & 1)) return(0);s -#endif - - return(1);c -}d - -news_read_packet(buf)t -struct dsc$descriptor_s *buf;o -{d - static int n,len; - - len = buf->dsc$w_length;a - if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer, - len,0,0,0,0) & 1) - || !(iosb.status & 1)) return(0); - n = iosb.size;e - - return(n);| -}> - -news_gethostname(buf) - -struct dsc$descriptor_s *buf;< -{k - if (mode == DECNET) return (-1);e -#if TWG || (MULTINET && defined(__GNUC__)) - return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length)); -#elsen -#if MULTINET - return(GETHOSTNAME1(buf->dsc$a_pointer, buf->dsc$w_length));d -#elsee - return(-1); -#endif -#endif -}D -$eod O -$copy/log sys$input HANDOUT.TXT8 -$deckt - Introduction to BULLETIN on the Vax - 2/88 AWt - -PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE( -COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY. - -BULLETIN was written for the Public Domain by Mark London at MIT.0 - - The BULLETIN utility permits a user to create messages fors -reading by other users. Users may be notified upon logging on -that new messages have been added, and what the topic of the -messages are. Actual reading of the messages is optional. (See -the command SET READNEW for info on automatic reading.) Messages -are automatically deleted when their expiration data has passed. - The program runs like VAX mail. The different interest -groups or BULLETIN boards are implemented in the form of -'Folders', just like a filing cabinet. A Folder contain various -messages on the same general topic. A message is a piece of text -written by a user or staff person and added to a particularm -folder. All users are not permitted to submit messages to all -folders. - - A message consists of an expiration date, a subject linec -and the text of the message. BULLETIN will prompt the user for) -these things when a message is being added. - - Several different folders are currently defined toa -BULLETIN. The General Folders will be used by Computer Center -Staff to post messages of general interest concerning the VAX to -the user community. If something is of an important nature, itn -will be posted in the General folder as a 'System' message. -This is a special message type. It will be displayed to each0 -user as they log in the first time after that message was -posted. This will be done automatically by BULLETIN on login. -Once a particular system message has been displayed, it will not -be displayed for that user on subsequent logins. - -Folders - - Different folders have been created to contain messages ond -different topics. Folders may be public, semi-private, or -private. The majority of the folders will be public. However a -few will be semi-private, which will mean that all users may -read messages in the folder but not all will be able to post toi -it. Currently, there are several folders defined: - -GENERAL -- system messages - -PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages -of interest to the publicm - -On Beta: -AIDE STATION -- Private folder for Computer Center Employees - -In addition on Alpha there are folders that receive electronic -magazines, such as:A -NETMONTH -- The monthly magazine of BITNET information. -RISKS -- Identifying the risks involved in using computers., -INFOIBMPC -- Information about the IBM personal computers. -INFOVAX -- Information on the Digital VAX. -PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and, -Prolog journals -watch for new ones being added. - -Using BULLETIN - - BULLETIN is invoked by type the command 'BULLETIN' (or BULL,s -for short) at the '$' prompt. BULLETIN will display its prompt -'BULLETIN>'. Help is available from DCL command level ($) or fromU -within the BULLETIN program itself by typing the word 'HELP'. Tom -leave the BULLETIN program, type 'EXIT'. - -To see what is there - - In order to see message and folders, on can use the -'Directory' command. Upon entering BULLETIN, the user is place -in the General folder. If the user wishes to see which folders -exist, the directory/folders command is used. for example: -typing:e - - BULLETIN> directory/folders - -will make a display like:, - - Folder Owner - *GENERAL SYSTEM - *PUBLIC_ANNOUNCEMENTS BBEYER$ - NETMONTH BITNETS - *VAX_SIG BBEYERn - -An asterisk (*) next to the folder name indicates you have unreada -messages in that folder. - -The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all availableU -folders, along with a brief description of each. - - To switch from one folder to another folder, the user may -execute the 'SELECT' command. For example, the followingC -command would show what a user would do to switch to the folder -called PUBLIC_ANNOUNCEMENTS: - -BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS - -and BULLETIN would respond:l - Folder has been set to PUBLIC_ANNOUNCEMENTS - - Now the user may get a list of the messages in this folderr -by issuing the directory command with no qualifiers. -This command, for example: -BULLETIN> DIRECTORYe -would have bulletin respond: - - # Description From Date - 1 CHRISTMAS PARTY oleksiak 26-JUN-88 - 2 Learning about BULLETIN oleksiak 26-JUN-87 - 3 VAX MAIL LLLOYD 01-Jan-87 - - The command 'DIR/NEW' will list just unread messages. - - -Reading messages - - In order to read messages in a folder, the user may typee -the read command or he/she may simply type the number of the -message he wishes to read. The message numbers can be acquiredF -by doing the 'DIRECTORY' command. If the user hits a carriage -return with no input whatsoever, BULLETIN will type the first -message in the folder, or if there are new messages present, ito -will type the first new message in the folder. - - If a folder contains the above messages (as seen by the -'Directory' command) then these messages can be read by: - -BULLETIN> READ -and BULLETIN would respond:, - -Message number: 1 PUBLIC_ANNOUNCEMENTS; -Description: CHRISTMAS PARTY -Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40 - -...Body of message.....* - - Should the user only wish to see message number 3, he can -enter the 'READ' command with the message number as a parameter. -for example: - -BULLETIN> READ 3 - - There are three other useful commands that can be used at -the 'BULLETIN>' prompt when reading messages. These are: - -BACK - Read the message preceding the message currently beinga -read.* - -CURRENT - Start reading the current message at the top. This is -useful for someone who is reading a message and wishes to reread -it from the beginning. - -NEXT - Start reading from the beginning of the next message. -This is handy if the user is reading a very long message and -wants to skip to the next one. - -Saving the interesting stuff.s - - If the user sees something which he/she wants a copy of,E -the extract command can be use to write an ASCII copy of the -message into a file. This command works on the current message -being read. It requires the name of the file into which to save -the message. If the file name is not given, the user will beG -prompted for it. For example: - -BULLETIN> Read 2 - -********** Message on Screen ********b - -A person could then type -BULLETIN> extract, -file: FV.TXT, -BULLETIN>u - -BULLETIN has now saved the contents of message number 2 into the -file name 'FV.txt'.e - If the file to which the user is writing already exists,i -BULLETIN will append the message to the file. The user cane -force BULLETIN to write a new file containing only the message -being saved by using the '/new' qualifier in the 'extract' -command. These messages can then be sent to other users, or -downloaded for use in Wordperfect. (See "Mail on the Vax", or -"Transferring a file between a PC and the VAX"). - -This command may be useful if you wish to transfer the message to) -your PC, perhaps using a BITNET journal message as a reference inc -a paper. Once the file is saved, you can transfer it to a PC by_ -following the instructions in the handout 'Transferring files_ -from the PC to the VAX of from the VAX to a PC". - -Adding messages0 - A user may add a message to a folder by selecting the -folder and then using the 'ADD' command. This is provided that) -the user is adding the message to a public folder. The user has -the option of giving the 'ADD' command and typing a message using -the VAX editor or uploading a message from your PC (sees -documentation), or add a message you have extracted from VAX -mail. BULLETIN will prompt for the expiration date and subjecto -line. It will then add the text of the file as the body of the -message. To add a message that is stored in a file (from MAIL or -from your PC, for example) type: - - ADD filename - -If the user does not specify a file name, he/she will be -prompted to enter the body of the message. The user may alsoe -use the EDT text editor by issuing the command with thee -'/EDIT'option. - -For example: -BULLETIN> sel PUBLIC_ANNOUNCEMENTS - folder has been set to PUBLIC_ANNOUNCEMENTSt -BULLETIN> ADD MESS.TXT - -IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULDi -EXPIRE: ENTER ABsolute TIME: l - -The above session adds the text in the file 'mess.txt' as the -next message in the PUBLIC_ANNOUNCEMENTS Folder. The messagen -will be deleted automatically on the 20th of July as requested -by the user adding the message.i - -Asking BULLETIN to notify you of new messages upon logging in. - - If the user wishes to get notification on login when newt -messages are in a folder, he should use the 'READNEW' option.A -This command does not force the reader to reading new messages,, -only gives notification. To do this, 'SELECT' each folder you -are interested in and do a 'SET READNEW' command while set toc -that folder. - -Example: - -BULLETIN> Select PUBLIC_ANNOUNCEMENTSt -folder has been set to PUBLIC_ANNOUNCEMENTST -BULLETIN> SET READNEWr - -Alternately, you may type SET SHOWNEW. This will just display ad -message notifying you that there are new messages. - -Mailing a BULLETIN message - - A user may directly mail another user a message found in the -BULLETIN. While reading the message that he/she desires to send,l -at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom -you wish to send the information too.t - -Check the BULLETIN DISCUSSION folder on ALPHA for new additions. -If you have comments or questions about BULLETIN, leave them -there. -$eod C -$copy/log sys$input INSTRUCT.TXT -$decke -This message is being displayed by the BULLETIN facility. This is a non-DEC -facility, so it is not described in the manuals. Messages can be submitted by -using the BULLETIN command. System messages, such as this one, are displayedT -in full, but can only be entered by privileged users. Non-system messages can -be entered by anyone, but only their topics will be displayed at login time, -and will be prompted to optionally read them. (This prompting feature can bel -disabled). All bulletins can be reread at any time unless they are deleted or -expire. For more information, see the on-line help (via HELP BULLETIN). h -$eod -$copy/log sys$input NEWS.TXT -$decky -BULLETIN has the capability to read and post messages to USENET NEWS in af -client mode. News groups can also be stored on disk. Selected groups ore -set of groups which are commonly read can be selected to be stored, thus makingo -reading of such groups much faster than having to access them over a network.L -Note that since the number of groups is well over 2000 makes it unreasonable at -most sites to store them all.f - -BULLETIN (actually BULLCP) can act as as a gateway between decnet and tcp fors -NEWS, which allows decnet nodes without tcp access to be able to access a tcp -news server. This method does not require spawning any processes, since the -detached process BULLCP is always present, so the access is very fast. - -Since BULLETIN uses a shared database to store info on the NEWS groups and -periodically updates it, there is no need for that to be done when a userS -accesses the NEWS groups. Several other NEWS readers do this when you run -them, which is why they take a long time to start up.d - -It is also possible to feed NEWS groups into a "real" BULLETIN folder. - -Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP -packages (and of course DECNET) for reading NEWS. Support for other packagesw -can be added if I can find sites willing to beta test the interface for me. -The source for the TCP interface is in C rather than FORTRAN because the -MULTINET include files are in C. However, if you do not have C, I will be glad -to send the object for it (or to even possibly rewrite the code in FORTRAN). - -The instructions for installation are as follows. Define BULL_NEWS_SERVER -to be a system logical name pointing to either your internet or decnet NEWS -node. If it is decnet, simply specify the decnet node name, i.e. - - $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUSd - -BULLETIN decides to use DECNET rather than TCP access based on the node name.h -If it does not have any periods in it, then it assumes it is a DECNET node.e - -If you have a cluster where one node is an internet node, and the rest -non-internet nodes, you'll have to create a startup procedure that defines -BULL_NEWS_SERVER to be the internet news server address only on the node (or -nodes) on the cluster that have actually internet access. The other nodes will -have BULL_NEWS_SERVER defined as the decnet node name that BULLCP is running onn -in the cluster. (Of course, BULLCP will have to be running on a node with -internet access.)g - -NOTE: If you want to disable the gateway feature, then before starting BULLCP, -define the logical name: - - $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE" - -Defining this will only shut off the gateway. BULLETIN will still be alloweda -to read NEWS from the local node as long as BULL_NEWS_SERVER is defined. - -You can also specify that BULLCP is only to act as a NEWS gateway. This is to -allow adding the news gateway to an INTERNET site that you have DECNET accessn -to, but which does not want to make use of any of the other BULLETIN features. -You would specify the following command before starting BULLCP:e - - $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE" - -In order to post messages, BULLETIN needs to know the internet nodename of -the local host. This is done automatically for nodes running MULTINET. For -other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME,s -INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not -on INTERNET (and is not part of a cluster which has an INTERNET address), butd -you are accessing NEWS via DECNET, you can specify the hostname as follows:f - - $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address" - -Where "localhost" is your local decnet hostname, and "internet-address" is the -internet address of the gateway node.. - -The local time zone is detected by looking at the following logical names: -LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is -defined if you have LISP installed.) - -The name of the organization is included in the header of the NEWS message.c -This can be anything, but usually is the company or university name. This -can be hardcoded into the source by putting in BULLNEWS.INC, or by definingn -the system logical name BULL_NEWS_ORGANIZATION. - -The name of the mail protocol to use for responding by mail to NEWS messages -can also be either hardcoded by putting in BULLNEWS.INC, or by defining theT -system logical name BULL_NEWS_MAILER. - -After installing the new BULLETIN, execute the command NEWS, which asks for an -list of all the news groups. Because this is the first time it is executed, ite -will cause a load of all the remote news groups into a local data base -(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only -time that this load will be done interactively. Afterwards, BULLCP will -periodically update the data base. BULLCP will update NEWS every hour. If you -want to change this frequency, define the logical name BULL_NEWS_UPDATE to the -number of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" -for 30 minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does -the update. You can watch how long it takes for this to run in order to -determine if you want to change the update period). If you ever want to force -NEWS to be updated, simply restart BULLCP. - -It is suggested that you run OPTIMIZE_RMS.COM on BULLNEWS.DAT, as it will causes -the file to be compressed and will allow updates to run much faster (factor of -5 or more). - -Never delete BULLNEWS.DAT. There is no reason to ever do so, and it will causeA -subscribed users to be subscribed to the wrong news groups.: - -WARNING: One user discovered that his server (using bnews?) had a bug which -caused the updates to cause bogus "new messages" notifications for subscribed: -NEWS group when entering BULLETIN. If you experience this problem, tryo -defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will causes -the update to use a different algorithm which should eliminate the problem,d -although it requires much more time to execute.m - -News groups can be specified as being stored on disk via the SET NEWS command. a -See the online help for more info. After converting such groups, when BULLCPg -wakes up, it will start the storing process. This can take a long time if you -have a lot of groups. An index file pointing to the stored messages is createds -and called BULL_DIR:BULLNEWSDIR.DAT. After the storage process is complete youe -should consider running OPTIMIZE_RMS.COM on it (and anytime after you convert ae -sizable amount of groups). - -It is possible to automatically have news messages to be fed into a real -folder. Place the name of the news group into the folder description surroundedE -by <>, i.e. . It must be in lower case. (Other text is allowed in -the description, i.e. "THIS IS A TEST FOLDER ".)i - -If you have any problems or questions, please let me know. - MRL -P.s. - If you do not know what USENET NEWS, it's basically news messages which -are passed between nodes. Originally it was limited to USENET, but that is no -longer the case. Unlike internet mailing lists which use MAIL to send the -messages to individuals, NEWS messages are not sent via MAIL. They are passed -between nodes using a special protocol, NNTP. Users must use a NEWS readern -package to read them. However, it is possible to read NEWS remotely over am -network, and therefore avoiding having to actually store the messages. -BULLETIN is setup to be used mainly in this client mode, i.e. it can readn -messages on another node via TCP or DECNET. This is useful, since the numbera -of NEWS groups total over 1000, the disk space required for storage is veryp -high. If you are interested in finding a server node that would allow you tos -read NEWS, and do not know of one (i.e. a USENET node), I know of no officialH -way of doing so. However, one suggestion was to try connecting to BBN.COM via -ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find as -USENET node near you to contact. -$eod e -$copy/log sys$input NONSYSTEM.TXTr -$deckn -Non-system bulletins (such as this) can be submitted by any user. Users are -alerted at login time that new non-system bulletins have been added, but onlyr -their topics are listed. Optionally, users can be prompted at login time to -see if they wish to read the bulletins. When reading the bulletins in this -manner, the bulletins can optionally be written to a file. If you have theo -subdirectory [.BULL] created, BULLETIN will use that directory as the defaulte -directory to write the file into.C - -A user can disable this prompting featuring by using BULLETIN as follows: - -$ BULLETIN -BULLETIN> SET NOREADNEWr -BULLETIN> EXIT - -Afterwords, the user will only be alerted of the bulletins, and will have to -use the BULLETIN utility in order to read the messages.y -$eod -$copy/log sys$input WRITEMSG.TXT -$deckt -BULLETIN contains subroutines for writing a message directly to a folder. Thisl -would be useful for someone who is using the BBOARD feature, but wants to avoidP -the extra overhead of having the message sent to an account as MAIL, and thenw -have BULLCP read the mail. It is better if the network mail could be written -directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead.T - -Call INIT_MESSAGE_ADD to initiate a message addition. -Call WRITE_MESSAGE_LINE to write individual message lines. -Call FINISH_MESSAGE_ADD to complete a message addition.i - -Calling formats: - - CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -Co -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the default is the owner of the process. -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found.L -CW - - CALL WRITE_MESSAGE_LINE(BUFFER) -C -C INPUTS: -C BUFFER - Character string containing line to be put into message.c -Cs - - CALL FINISH_MESSAGE_ADD -CB -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -Cg -$eod n diff --git a/decus/vax92b/bulletin/bullet2.com b/decus/vax92b/bulletin/bullet2.com deleted file mode 100644 index 8bf55f7..0000000 --- a/decus/vax92b/bulletin/bullet2.com +++ /dev/null @@ -1,1515 +0,0 @@ -$set nover -$copy/log sys$input BOARD_DIGEST.COM -$deck -$! -$! BOARD_DIGEST.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. It will convert "digest" mail and -$! split it into separate messages. This type of mail is used in -$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC. -$! -$ FF[0,8] = 12 ! Define a form feed character -$ SET PROTECT=(W:RWED)/DEFAULT -$ SET PROC/PRIV=SYSPRV -$ USER := 'F$GETJPI("","USERNAME") -$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT" -$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER' -$ MAIL -READ -EXTRACT EXTRACT_FILE -DELETE -$ OPEN/READ INPUT 'EXTRACT_FILE' -$ OPEN/WRITE OUTPUT 'EXTRACT_FILE' -$ READ INPUT FROM_USER -$AGAIN: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP -$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER) -$ GOTO AGAIN1 -$SKIP: -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN -$AGAIN1: -$ READ/END=ERROR INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1 -$ FROM = " " -$ SUBJ = " " -$NEXT: -$ READ/END=EXIT INPUT BUFFER -$FROM: -$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT -$ FROM = BUFFER -$ GOTO NEXT -$SUBJECT: -$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT -$ SUBJ = BUFFER - "Subject:" -$F2: -$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE -$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE -$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ) -$ GOTO F2 -$WRITE: -$ WRITE OUTPUT FROM_USER - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USER - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF FROM .NES. " " THEN WRITE OUTPUT FROM -$READ: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1 -$ WRITE OUTPUT BUFFER -$ GOTO READ -$READ1: -$ READ/END=EXIT/ERR=EXIT INPUT BUFFER -$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1 -$ WRITE OUTPUT FF -$ FROM = " " -$ SUBJ = " " -$ GOTO FROM -$EXIT: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ PUR 'EXTRACT_FILE' -$ EXIT -$ERROR: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE 'EXTRACT_FILE'; -$eod -$copy/log sys$input BOARD_SPECIAL.COM -$deck -$! -$! BOARD_SPECIAL.COM -$! -$! Command file invoked by folder associated with a BBOARD which is -$! is specified with /SPECIAL. This can be used to convert data to -$! a message via a different means than the VMS mail. This is done by -$! converting the data to look like output created by the MAIL utility, -$! which appears as follows: -$! -$! First line is 0 length line. -$! Second line is "From:" followed by TAB followed by incoming username -$! Third line is "To:" followed by TAB followed by BBOARD username -$! Fourth line is "Subj:" followed by TAB followed by subject -$! The message text then follows. -$! Message is ended by a line containing a FORM FEED. -$! -$! This command file should be put in the BBOARD_DIRECTORY as specified -$! in BULLFILES.INC. You can also have several different types of special -$! procedures. To accomplish this, rename the file to the BBOARD username. -$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file -$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM. -$! -$! The following routine is the one we use to convert mail from a non-DEC -$! mail network. The output from this mail is written into a file which -$! is slightly different from the type outputted by MAIL. -$! -$! (NOTE: A username in the SET BBOARD command need only be specified if -$! the process which reads the mail requires that the process be owned by -$! a specific user, which is the case for this sample, and for that matter -$! when reading VMS MAIL. If this is not required, you do not have to -$! specify a username.) -$! -$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces -$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT -$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory -$ SET PROTECT=(W:RWED)/DEFAULT -$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN - - DELETE MFEMSG.MAI;* ! Delete any leftover output files. -$ MSG := $MFE_TELL: MESSAGE -$ DEFINE/USER SYS$COMMAND SYS$INPUT -$ MSG ! Read MFENET mail -copy * MFEMSG -delete * -exit -$ FF[0,8] = 12 ! Define a form feed character -$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI -$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT -$ OPEN/WRITE OUTPUT 'OUTNAME' -$ READ/END=END INPUT DATA ! Skip first line in MSG output -$HEADER: -$ FROM = "" -$ SUBJ = "" -$ MFEMAIL = "T" -$NEXTHEADER: -$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER -$ READ/END=END INPUT DATA ! Read header line in MSG output -$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ?? -$ IF FROM .NES. "" THEN GOTO SKIPFROM -$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$10$: -$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$ -$ MFEMAIL = "F" -$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$20$: -$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM -$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPFROM: -$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ -$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ -$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA) -$ GOTO NEXTHEADER -$SKIPSUBJ: -$ GOTO NEXTHEADER -$SKIPHEADER: -$ WRITE OUTPUT "From: " + FROM - ! Write From: + TAB + USERNAME -$ WRITE OUTPUT "To: " + USERNAME - ! Write To: + TAB + BBOARDUSERNAME -$ WRITE OUTPUT "Subj: " + SUBJ - ! Write Subject: + TAB + mail subject -$ WRITE OUTPUT "" ! Write one blank line -$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS -$50$: -$ READ/END=END INPUT DATA ! Skip rest of main header -$ IF DATA .NES. "" THEN GOTO 50$ -$60$: -$ READ/END=END INPUT DATA ! Skip all of secondary header -$ IF DATA .NES. "" THEN GOTO 60$ -$SKIPBLANKS: -$ READ/END=END INPUT DATA ! Skip all blanks -$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS -$NEXT: ! Read and write message text -$ WRITE OUTPUT DATA -$ IF DATA .EQS. FF THEN GOTO HEADER - ! Multiple messages are seperated by form feeds -$ READ/END=END INPUT DATA -$ GOTO NEXT -$END: -$ CLOSE INPUT -$ CLOSE OUTPUT -$ DELETE MFEMSG.MAI; -$EXIT: -$ EXIT -$eod -$copy/log sys$input BULLCOM.CLD -$deck -! -! BULLCOM.CLD -! -! VERSION 1/14/93 -! - MODULE BULLETIN_SUBCOMMANDS - - DEFINE VERB ADD - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELL - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER EXTRACT, NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - QUALIFIER LIST,DEFAULT - QUALIFIER LOCAL, NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER NOSIGNATURE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB ATTACH - PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE) - QUALIFIER PARENT - DISALLOW NOT PARENT AND NOT PROCESS - DISALLOW PARENT AND PROCESS - DEFINE VERB BACK - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB CHANGE - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER ALL - QUALIFIER EDIT, NEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE - QUALIFIER GENERAL, NONNEGATABLE - QUALIFIER HEADER, NONNEGATABLE - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER NEW,NONNEGATABLE - QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED) - QUALIFIER PERMANENT, NONNEGATABLED - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE - QUALIFIER SYSTEM,NONNEGATABLE - QUALIFIER TEXT, NONNEGATABLE - DISALLOW ALL AND NUMBER - DISALLOW NEW AND NOT EDITm - DISALLOW SYSTEM AND GENERALd - DISALLOW PERMANENT AND SHUTDOWND - DISALLOW PERMANENT AND EXPIRATIONR - DISALLOW SHUTDOWN AND EXPIRATION - DISALLOW SUBJECT AND HEADER( - DEFINE VERB COPYX - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER ALL - QUALIFIER MERGES - QUALIFIER ORIGINAL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUEF - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB CREATEL - QUALIFIER ADD_ONLY, NONNEGATABLE - QUALIFIER ALWAYS, NONNEGATABLE - QUALIFIER BRIEF, NONNEGATABLET - QUALIFIER COMPRESS, NONNEGATABLE - QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER EDIT, NEGATABLE - QUALIFIER ID, NONNEGATABLE -!: -! Make the following qualifier DEFAULT if you want CREATE to be) -! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DATB -! has the following protection: (RWED,RWED,,) -! - QUALIFIER NEEDPRIV, NONNEGATABLE - QUALIFIER NEWS - QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED)E - QUALIFIER NOTIFY, NONNEGATABLE - QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER POST_ONLY, NONNEGATABLEP - QUALIFIER PRIVATE, NONNEGATABLEA - QUALIFIER READNEW, NONNEGATABLE - QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SEMIPRIVATE, NONNEGATABLEj - QUALIFIER SHOWNEW, NONNEGATABLE - QUALIFIER SYSTEM, NONNEGATABLE - PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=FILESPEC, VALUE(TYPE=$FILE)S - DISALLOW ID AND NOT OWNER - DISALLOW PRIVATE AND SEMIPRIVATE - DISALLOW BRIEF AND READNEW - DISALLOW SHOWNEW AND READNEW - DISALLOW BRIEF AND SHOWNEW - DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE) - DISALLOW REMOTENAME AND NOT NODE - DISALLOW POST_ONLY AND ADD_ONLY - DEFINE VERB CURRENT - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB DELETEE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALLE - QUALIFIER IMMEDIATE,NONNEGATABLE - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST) - QUALIFIER LOCALs - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - QUALIFIER SUBJECT, VALUE(REQUIRED) - DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER)p - DISALLOW NODES AND SELECT_FOLDER - DEFINE VERB DIRECTORY - PARAMETER P1, LABEL=SELECT_FOLDERe - QUALIFIER ALLe - QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLEm - QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE - QUALIFIER EXPIRATION - QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLEe - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE - QUALIFIER NEW - QUALIFIER PRINT - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULTf - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLEr - QUALIFIER FORM, VALUE, NONNEGATABLEh - QUALIFIER NOWl - QUALIFIER POST, DEFAULT - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLEh - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)O - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER REPLY, NONNEGATABLEi - QUALIFIER NOREPLIES, NONNEGATABLE - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLEe - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLEh - QUALIFIER NEGATEDi - DISALLOW NEGATED AND l - NOT (SUBJECT OR SEARCH OR FROM OR NOREPLIES) - DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY)y - DISALLOW (FROM AND SUBJECT) OR (FROM AND NOREPLIES)E - DISALLOW (NOREPLIES AND SUBJECT) OR (REPLY AND NOREPLIES)I - DISALLOW (REPLY AND SUBJECT) OR (REPLY AND FROM) - DISALLOW (REPLY OR SUBJECT OR SEARCH OR FROM) ANDi - (MARKED OR SEEN OR UNMARKED OR UNSEEN) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN)N - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DEFINE SYNTAX DIRECTORY_NEWSm - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER NEWS, DEFAULT, NONNEGATABLE - QUALIFIER SUBSCRIBEA - QUALIFIER FOLDER - QUALIFIER NEWGROUPSs - QUALIFIER ALLp - QUALIFIER STORED - QUALIFIER CLASS - QUALIFIER COUNT - DEFINE SYNTAX DIRECTORY_FOLDER. - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER DESCRIBE - QUALIFIER FOLDER, DEFAULTH - QUALIFIER NEWS, NONNEGATABLE - DEFINE VERB E ! EXIT command.F - DEFINE VERB EX ! EXIT command. - DEFINE VERB EXIT ! EXIT command. - DEFINE VERB EXCLUDE - PARAMETER P1 - QUALIFIER ALLH - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER SUBJECT - DISALLOW ALL AND NOT DISABLE - DEFINE VERB EXTRACT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED),F - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULTI - QUALIFIER NEW, NONNEGATABLE, - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FILE$ - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED),X - PROMPT="File" - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER ALL - QUALIFIER FF - QUALIFIER HEADER, DEFAULTA - QUALIFIER NEW, NONNEGATABLEP - QUALIFIER ROTATE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB FIRST - QUALIFIER EDIT, NEGATABLE - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB FORWARD - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST)5 - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULTy - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB HELP - PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB INCLUDE - PARAMETER P1 - QUALIFIER ALLs - QUALIFIER DISABLE - QUALIFIER FROM - QUALIFIER SUBJECTO - DISALLOW ALL AND NOT DISABLE - DEFINE VERB INDEX - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER EXPIRATION - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLEO - QUALIFIER NEW, DEFAULT - QUALIFIER REPLY, NONNEGATABLEM - QUALIFIER NOREPLIES, NONNEGATABLEE - QUALIFIER RESTART - QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER SET , DEFAULTE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SUBSCRIBET - QUALIFIER NEGATED - QUALIFIER FROM, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLEN - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)L - DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB LAST - QUALIFIER EDIT, NEGATABLEA - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB MAILT - PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients" - VALUE(REQUIRED,IMPCAT,LIST)L - QUALIFIER EDIT, NONNEGATABLE - QUALIFIER HEADER, DEFAULTR - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB MARKE - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB MODIFY - QUALIFIER DESCRIPTIONA - QUALIFIER ID, NONNEGATABLE - QUALIFIER NAME, VALUE(REQUIRED) - QUALIFIER OWNER, VALUE(REQUIRED) - DISALLOW ID AND NOT OWNERC - DEFINE VERB MOVEB - PARAMETER P1, LABEL=FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - QUALIFIER ALLI - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER HEADER - QUALIFIER MERGEN - QUALIFIER NODES - QUALIFIER ORIGINAL - QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT - DISALLOW ALL AND BULLETIN_NUMBER - DISALLOW FOLDER AND NODES - DEFINE VERB NEWS - PARAMETER P1, LABEL=MATCH_FOLDER - QUALIFIER NEWS, DEFAULT, NONNEGATABLEA - QUALIFIER COUNTH - QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE - QUALIFIER SUBSCRIBEE - QUALIFIER NEWGROUPS - QUALIFIER ALLN - QUALIFIER STORED - QUALIFIER CLASS - DISALLOW CLASS AND (SUBSCRIBE OR START OR ALL OR STORED) - DISALLOW NEWGROUPS AND (SUBSCRIBE OR START OR ALL OR STORED) - DEFINE VERB N - QUALIFIER EDIT, NEGATABLE( - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB NEXTV - QUALIFIER EDIT, NEGATABLE2 - QUALIFIER HEADER - QUALIFIER ROTATE - DEFINE VERB POSTT - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE) - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EDIT - QUALIFIER EXPIRATION, NONNEGATABLE, VALUEA - QUALIFIER EXTRACTD - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST, DEFAULTL - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACTS - QUALIFIER NOSIGNATUREE - QUALIFIER SUBJECT, VALUE(REQUIRED) - DEFINE VERB PRINT - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE,LIST)f - QUALIFIER HEADER, DEFAULT - QUALIFIER NOTIFY, DEFAULTr - QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLEA - QUALIFIER FORM, VALUE, NONNEGATABLE - QUALIFIER NOWD - QUALIFIER ALLE - DISALLOW ALL AND BULLETIN_NUMBER - DEFINE VERB QUITU - DEFINE VERB READL - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER) - QUALIFIER ALL - QUALIFIER EDIT - QUALIFIER HEADER - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER NEWO - QUALIFIER PAGE, DEFAULT( - QUALIFIER POST, DEFAULTI - QUALIFIER ROTATE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)e - DISALLOW NEW AND SINCE - DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE) - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB REPLY - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)T - QUALIFIER ALL, NONNEGATABLE - QUALIFIER BELL, NONNEGATABLE - QUALIFIER BROADCAST, NONNEGATABLE - DISALLOW NOT BROADCAST AND ALL - DISALLOW NOT BROADCAST AND BELLF - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER CLUSTER, DEFAULT - QUALIFIER EDIT, NEGATABLEL - QUALIFIER EXPIRATION, NONNEGATABLE, VALUEE - QUALIFIER EXTRACT, NONNEGATABLEF - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)O - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST,DEFAULT - QUALIFIER LOCALW - QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST) - NONNEGATABLE - DISALLOW LOCAL AND NOT BROADCAST - DISALLOW NODES AND SELECT_FOLDER - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACT - QUALIFIER NOSIGNATUREQ - QUALIFIER PERMANENT, NONNEGATABLE - QUALIFIER SHUTDOWN, NONNEGATABLE, VALUEX - DISALLOW PERMANENT AND SHUTDOWN - QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED) - QUALIFIER SYSTEM, NONNEGATABLE - DEFINE VERB REMOVE - PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder" - VALUE(REQUIRED) - DEFINE VERB RESET - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE)U - DEFINE VERB RESPOND - PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)E - QUALIFIER CC, VALUE(LIST,REQUIRED) - QUALIFIER EXPIRATION, NONNEGATABLE, VALUEL - QUALIFIER EXTRACTI - QUALIFIER GROUPS, VALUE(LIST,REQUIRED) - QUALIFIER LIST - QUALIFIER SUBJECT, VALUE(REQUIRED) - QUALIFIER NOINDENT, NONNEGATABLE - DISALLOW NOINDENT AND NOT EXTRACTU - QUALIFIER NOSIGNATUREe - DISALLOW GROUPS AND NOT LIST - QUALIFIER EDIT - DEFINE VERB SEARCHU - PARAMETER P1, LABEL=SEARCH_STRINGN - QUALIFIER EDIT - QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)F - QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED)D - QUALIFIER REPLY, NONNEGATABLE - QUALIFIER NOREPLIES, NONNEGATABLEC - QUALIFIER REVERSER - QUALIFIER FROM - QUALIFIER SUBJECTB - QUALIFIER NEGATEDI - DISALLOW SEARCH_STRING AND REPLY - DEFINE VERB SEENI - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - QUALIFIER READ - DISALLOW (NUMBER AND (NEG READ OR READ)) - DEFINE VERB SELECTE - PARAMETER P1, LABEL=SELECT_FOLDERS - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE VERB SET - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER ID - DEFINE TYPE SET_OPTIONS - KEYWORD NODE, SYNTAX=SET_NODEE - KEYWORD NONODE, SYNTAX = SET_NONODEF - KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE - KEYWORD NOEXPIRE_LIMIT - KEYWORD GENERIC, SYNTAX=SET_GENERICA - KEYWORD NOGENERIC, SYNTAX=SET_GENERICI - KEYWORD LOGIN, SYNTAX=SET_LOGINC - KEYWORD NOLOGIN, SYNTAX=SET_LOGIN - KEYWORD NOBBOARD - KEYWORD BBOARD, SYNTAX=SET_BBOARDm - KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGSn - KEYWORD BRIEF, SYNTAX=SET_FLAGSa - KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS1 - KEYWORD SHOWNEW, SYNTAX=SET_FLAGSL - KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS - KEYWORD READNEW, SYNTAX=SET_FLAGSF - KEYWORD ACCESS, SYNTAX=SET_ACCESSE - KEYWORD NOACCESS, SYNTAX=SET_NOACCESS - KEYWORD FOLDER, SYNTAX=SET_FOLDERE - KEYWORD NOTIFY, SYNTAX=SET_FLAGS - KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS - KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGESE - KEYWORD DUMP - KEYWORD NODUMP - KEYWORD PAGE - KEYWORD NOPAGE - KEYWORD SYSTEM - KEYWORD NOSYSTEM - KEYWORD KEYPAD - KEYWORD NOKEYPAD - KEYWORD PROMPT_EXPIREl - KEYWORD NOPROMPT_EXPIREU - KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIREL - KEYWORD STRIPF - KEYWORD NOSTRIPR - KEYWORD DIGEST - KEYWORD NODIGEST - KEYWORD CONTINUOUS_BRIEF - KEYWORD NOCONTINUOUS_BRIEF - KEYWORD ALWAYS - KEYWORD NOALWAYS - KEYWORD COMPRESS - KEYWORD NOCOMPRESS - KEYWORD POST_ONLY - KEYWORD NOPOST_ONLYE - KEYWORD ADD_ONLY - KEYWORD NOADD_ONLY - KEYWORD NEWS, SYNTAX=SET_NEWS - DEFINE SYNTAX SET_NODEG - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED)T - PARAMETER P3, LABEL=REMOTENAME - QUALIFIER FOLDER, VALUE(REQUIRED)L - DEFINE SYNTAX SET_NONODE - QUALIFIER FOLDER, VALUE(REQUIRED) - DEFINE SYNTAX SET_EXPIREB - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE SYNTAX SET_GENERIC - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED)U - QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT - DEFINE SYNTAX SET_LOGIN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"U - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED) - DEFINE SYNTAX SET_FLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLEL - QUALIFIER ALL, NONNEGATABLEA - QUALIFIER PERMANENTI - QUALIFIER NOPERMANENT - QUALIFIER FOLDER, VALUE(REQUIRED)N - DEFINE SYNTAX SET_NOFLAGS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - QUALIFIER DEFAULT, NONNEGATABLET - QUALIFIER PERMANENTE - QUALIFIER NOPERMANENTA - QUALIFIER ALL, NONNEGATABLEE - QUALIFIER FOLDER, VALUE(REQUIRED)i - DEFINE SYNTAX SET_BBOARDI - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"U - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=BB_USERNAMEE - QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER)( - LABEL=EXPIRATION, DEFAULT - QUALIFIER SPECIAL, NONNEGATABLE - QUALIFIER VMSMAIL, NONNEGATABLEL - DISALLOW VMSMAIL AND NOT SPECIAL - DISALLOW VMSMAIL AND NOT BB_USERNAME - DEFINE SYNTAX SET_FOLDER - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SELECT_FOLDERT - QUALIFIER MARKED, NONNEGATABLE - QUALIFIER UNMARKED, NONNEGATABLE - QUALIFIER SEEN, NONNEGATABLE - QUALIFIER UNSEEN, NONNEGATABLE - DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR - (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN) - DEFINE SYNTAX SET_NOACCESS - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDER - QUALIFIER ALL, NONNEGATABLEP - QUALIFIER CLASS, NONNEGATABLE - QUALIFIER READONLY, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DISALLOW ALL AND NOT READONLYS - DEFINE SYNTAX SET_NEWSO - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"T - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=SHOW_FOLDERN - QUALIFIER ALL, DEFAULT - QUALIFIER CLASS,VALUE(REQUIRED)R - QUALIFIER DEFAULT, NONNEGATABLE - QUALIFIER DELETE, NONNEGATABLE - QUALIFIER DISABLE, NONNEGATABLE - QUALIFIER ENABLE, NONNEGATABLE - QUALIFIER EXPIRATION, NONNEGATABLE, VALUE(REQUIRED,B - TYPE=$NUMBER)F - QUALIFIER FULL - QUALIFIER LIMIT, NONNEGATABLE, VALUE(REQUIRED, I - TYPE=$NUMBER) - QUALIFIER PRIVATEG - QUALIFIER STORED - DISALLOW (DEFAULT AND CLASS) OR (DELETE AND NOT CLASS) - DISALLOW DEFAULT AND (DISABLE OR ENABLE OR PRIVATE)E - DEFINE SYNTAX SET_ACCESSE - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"E - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST) - PARAMETER P3, LABEL=ACCESS_FOLDERE - QUALIFIER READONLY, NONNEGATABLE - QUALIFIER CLASS, NONNEGATABLEI - QUALIFIER ALL, NONNEGATABLE - DISALLOW NOT ALL AND NOT ACCESS_ID - DEFINE SYNTAX SET_PRIVILEGESN - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges"O - VALUE (REQUIRED,LIST)E - DEFINE SYNTAX SET_DEFAULT_EXPIREU - PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"L - VALUE(REQUIRED, TYPE=SET_OPTIONS) - PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED) - DEFINE VERB SHOWL - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)D -!D -! The following are defined to allow qualifiers to be specifiedA -! directly after the SHOW command, i.e. SHOW/FULL FOLDER.= -! Otherwise, the CLI routines will reject the command, because itL -! first attempts to process the qualifier before process the parameter,W -! so it has no information the qualifiers are valid. -!F - QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLEE - QUALIFIER ALL, SYNTAX=SHOW_USERA - QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USERA - QUALIFIER LOGIN, SYNTAX=SHOW_USERL - QUALIFIER NOLOGIN, SYNTAX=SHOW_USERL - QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINTS - QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER - QUALIFIER START, SYNTAX=SHOW_USERD - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFINE TYPE SHOW_OPTIONSN - KEYWORD FOLDER, SYNTAX=SHOW_FOLDER - KEYWORD NEW, SYNTAX=SHOW_FLAGS - KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGSI - KEYWORD FLAGS, SYNTAX=SHOW_FLAGS - KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD - KEYWORD USER, SYNTAX=SHOW_USER - KEYWORD VERSION - DEFINE SYNTAX SHOW_FLAGSA - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)E - DEFINE SYNTAX SHOW_KEYPAD - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)U - PARAMETER P2, LABEL=SHOW_KEY - QUALIFIER PRINTP - DISALLOW PRINT AND SHOW_KEYF - QUALIFIER STATE, VALUE(LIST,DEFAULT=DEFAULT), NONNEGATABLE - DEFAULT - DEFINE SYNTAX SHOW_KEYPAD_PRINT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS) - QUALIFIER PRINT,DEFAULTT - DEFINE SYNTAX SHOW_FOLDER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)T - PARAMETER P2, LABEL=SHOW_FOLDER - DEFINE SYNTAX SHOW_USER - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)F - PARAMETER P2, LABEL=USERNAME - QUALIFIER ALLF - QUALIFIER FOLDER, VALUE - QUALIFIER LOGIN, - QUALIFIER NOLOGINL - QUALIFIER SINCE, VALUE(TYPE=$DATETIME) - QUALIFIER START, VALUE - DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAMED - DISALLOW (LOGIN AND NOLOGIN) - DISALLOW (LOGIN OR NOLOGIN) AND FOLDER - DEFINE SYNTAX SHOW_FOLDER_FULLL - QUALIFIER FULL, DEFAULT - PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What" - VALUE(REQUIRED, TYPE=SHOW_OPTIONS)O - PARAMETER P2, LABEL=SHOW_FOLDERO - DEFINE VERB SUBSCRIBE - DEFINE VERB SPAWNF - PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE) - DEFINE VERB UNMARKR - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNDELETEE - PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE) - DEFINE VERB UNSEEN - PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST) - DEFINE VERB UNSUBSCRIBE -$eod O -$copy/log sys$input BULLETIN.CLD -$deckI -!L -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table.W -! The alternative is to define a symbol to execute BULLETIN.I -! Either way will work, and it is up to the user's to decide whichR -! method to work. (If you don't know which, you probably should useE -! the default symbol method.) -!1 - -Define Verb BULLETIN - Image BULL_DIR:BULLETINO - Parameter P1, Label = SELECT_FOLDER - Qualifier ALLE - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required)N - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LOGINY - Qualifier MARKED - Qualifier PAGE, DefaultN - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required)E - Qualifier PROMPT, Value (Default = "BULLETIN"), DefaultA - Qualifier READNEW - Qualifier REVERSE - !R - ! The following line causes a line to be outputted separating system notices.U - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired oneW - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - !R - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP" - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required)N - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP -$eod A -$copy/log sys$input BULLMAIN.CLD -$deckT - MODULE BULLETIN_MAINCOMMANDS2 - DEFINE VERB BULLETINU - PARAMETER P1, LABEL=SELECT_FOLDERT - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED)E - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULTL - QUALIFIER LOGINP - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULTS - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEWE - QUALIFIER REVERSE -!A -! The following line causes a line to be outputted separating system notices.E -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired oneE -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!)) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUPF - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED)U - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP -$eod O -$copy/log sys$input BULLSTART.COMN -$deckL -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT -$ BULL*ETIN :== $BULL_DIR:BULLETIN -$ BULLETIN/STARTUP -$eod h -$copy/log sys$input BULL_NEWSDUMMY.FOR -$deckA - INTEGER FUNCTION NEWS_ASSIGN() - - NEWS_ASSIGN = 0 - - RETURNE - END - - INTEGER FUNCTION NEWS_GET_CHAN(I) - - RETURN - END - - - SUBROUTINE NEWS_SET_CHAN(I) - - RETURNI - END - - INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L) - - RETURNN - END - - - INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L)C - - RETURNA - END - - - INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N)= - - RETURN) - END - - - SUBROUTINE NEWS_DISCONNECTE - - RETURNA - END - - - - INTEGER FUNCTION NEWS_CONNECT - - NEWS_CONNECT = .FALSE.L - - RETURN, - END - - - - INTEGER FUNCTION NEWS_WRITE_PACKET(BUF) - - CHARACTER*(*) BUF - - RETURND - END - - - - INTEGER FUNCTION NEWS_READ_PACKET(BUF)T - - CHARACTER*(*) BUF - - RETURN_ - END - - - - INTEGER FUNCTION NEWS_GETHOSTNAME(BUF)P - - CHARACTER*(*) BUF - - RETURNW - END - - - - INTEGER FUNCTION NEWS_GETHOST() - - RETURNU - END -$eod -$copy/log sys$input CREATE.COM -$deckU -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETINU -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN0 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN1 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN2 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN3 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN4 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN5 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN6 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN7 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN8 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN9 -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN10E -$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN11s -$ MAC ALLMACSQ -$ SET COMMAND/OBJ BULLCOMX -$ SET COMMAND/OBJ BULLMAIN -$ ON WARNING THEN GOTO DUMMY -$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI -$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],-U - TWG$TCP:[NETDIST.INCLUDE.SYS],-E - TWG$TCP:[NETDIST.INCLUDE.VMS],-H - TWG$TCP:[NETDIST.INCLUDE.NETINET],-i - TWG$TCP:[NETDIST.INCLUDE.ARPA],- - SYS$LIBRARYw -$ CC BULL_NEWS/DEFINE=(TWG=1)c -$ GOTO LINK, -$MULTI:i -$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCXp -$ CC BULL_NEWS/DEFINE=(MULTINET=1) -$ GOTO LINKi -$UCX: -$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU -$ CC BULL_NEWS/DEFINE=(UCX=1)L -$ GOTO LINKW -$CMU: -$ CC BULL_NEWS -$ GOTO LINKN -$DUMMY:U -$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software." -$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature."V -$ FORTRAN BULL_NEWSDUMMY -$LINK: -$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN-T - DELETE BULL_DIR:READ_BOARD.COM;* -$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULLT -$ LIBRARY BULL *.OBJ;R -$ DELETE *.OBJ;* -$ @BULLETIN.LNK -$eod G -$copy/log sys$input INSTALL.COM -$deckS -$ COPY BULLETIN.EXE BULL_DIR:P -$ RUN SYS$SYSTEM:INSTALL -BULL_DIR:BULLETIN/DELO -BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/- -PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM) -/EXIT= -$! -$! NOTE: BULLETIN requires a separate help library. If you do not wish -$! the library to be placed in SYS$HELP, modify the following lines and= -$! define the logical name BULL_HELP to be the help library directory, i.e.N -$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY]T -$! The above line should be placed in BULLSTART.COM to be executed after -$! every system reboot.E -$! -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL -$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL -$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2 -$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN -$eod Y -$copy/log sys$input INSTRUCT.COM -$deckW -$ BULLETIN -ADD/PERMANENT/SYSTEM INSTRUCT.TXT= -INFO ON HOW TO USE THE BULLETIN UTILITY. -ADD/PERMANENT NONSYSTEM.TXTL -INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS. -EXIT -$eod U -$copy/log sys$input MAKEFILE.T -$deck -# Makefile for BULLETIN - A -Bulletin : Bulletin.Exe Bull.Hlb - E -Bulletin.Exe : Bull.Olb - Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel -_ - /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt - ID="V2.13 " $ - M -Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \ - Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \ - Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \ - Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj - Library /Create Bull.Olb *.ObjE - Purge /Log *.Obj,*.ExeE - V -Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \ - Bulluser.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin.ForN - D -Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \e - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin0.For - t -Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \w - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin1.For - w -Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \i - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin2.For - u -Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \, - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin3.For - -Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \( - Bulldir.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin4.For - -Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \c - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin5.For - -Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \- - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin6.For - -Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \f - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin7.For - -Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \E - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin8.For - f -Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \, - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin9.For - ) -Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \$ - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin10.ForA - E -Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \F - Bullfiles.Inc Bullnews.Inc - Fortran /Extend /NoList Bulletin11.ForU - F -Allmacs.Obj : Allmacs.marL - Macro /NoList Allmacs.Mar - -Bullcom.Obj : Bullcom.cld - Set Command /Obj Bullcom.CldN - E -Bullmain.Obj : Bullmain.cldD - Set Command /Obj Bullmain.Cld - -Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp - Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp - Purge Bull.Hlb -*.hlb :- - lib/help/cre $*- -$eod - -$copy/log sys$input OPTIMIZE_RMS.COM -$deckn -$ SET NOON -$ EXIT_STATUS = 1s -$ IF P1 .NES. "" THEN GOTO BATCH -$! -$GET_FILE: -$ INQUIRE P1 "File to be optimized (^Y to quit)" -$! -$ FILENAME = P1t -$ SPEC = F$SEARCH(FILENAME) -$! -$GOT_NAME_INTERACTIVE: -$ NAME = F$PARSE(FILENAME,,,"NAME")A -$! -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN-L - GOTO INTERACTIVE_CHECK_ADDS -$ WRITE SYS$OUTPUT "File not indexed"L -$ GOTO GET_FILEU -$INTERACTIVE_CHECK_ADDS: -$ INQUIRE P2 "Number of records to add after initial load" -$ IF P2 .EQS. "" THEN P2 = 0 -$! -$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ GOTO GOT_NAME_INTERACTIVE -$! -$INTERACTIVE_CHECK_CONVERT:- -$ INQUIRE P3 "Turn OFF Data and Key compression? (N)" -$ INQUIRE P4 "Turn OFF Index compression? (N)" -$! -$ GOTO ADD_OKd -$! -$BATCH: -$GOT_NAME: -$ FILENAME = P1 -$ SPEC = F$SEARCH(FILENAME)S -$! -$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS -$ WRITE SYS$OUTPUT "File does not exist" -$ EXIT_STATUS = %X18292B -$ GOTO DONES -$! -$FILE_EXISTS:R -$ NAME = F$PARSE(FILENAME,,,"NAME")C -$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN-T - GOTO TYPE_OK -$ WRITE SYS$OUTPUT "File not indexed" -$ EXIT_STATUS = 1000024I -$ GOTO DONEL -$! -$TYPE_OK:= -$ IF P2 .EQS. "" THEN P2 = 0 -$ IF P2 .GE. 0 THEN GOTO ADD_OKA -$! -$ WRITE SYS$OUTPUT "Added records must be >= 0 " -$ EXIT_STATUS = %X38060T -$ GOTO DONE -$! -$ADD_OK: -$ ADD_RECORDS = P2 -$! -$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK")I -$ TURN_DATA_COMPRESSION_OFF = P3 -$ TURN_INDEX_COMPRESSION_OFF = P4R -$ FDL_NAME = F$PARSE(".FDL;0",SPEC)S -$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM"F -$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT"y -$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'"O -$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT"E -$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE" -$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT 'ADD_RECORDS -$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZEROI -$ WRITE OUT "" -$ WRITE OUT "" -$SKIP_NON_ZERO:N -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF( -$ THEN -$ WRITE OUT "IC"O -$ WRITE OUT "NO" -$ ENDIF/ -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "RC"6 -$ WRITE OUT "NO"C -$ WRITE OUT "KC"F -$ WRITE OUT "NO"H -$ ENDIFI -$ WRITE OUT "FD" -$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +-C - " ''A DD_RECORDS' ADDED RECORDS" -$ WRITE OUT "" -$ WRITE OUT "" -$LOOP: -$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILEE -$ WRITE OUT "" -$ WRITE OUT "" -$ WRITE OUT "" -$ IF TURN_INDEX_COMPRESSION_OFF -$ THEN -$ WRITE OUT "IC" -$ WRITE OUT "NO"M -$ ENDIFU -$ IF TURN_DATA_COMPRESSION_OFF -$ THEN -$ WRITE OUT "KC"P -$ WRITE OUT "NO"T -$ ENDIF -$ WRITE OUT "FD" -$ WRITE OUT "" -$ WRITE OUT "" -$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1 -$ GOTO LOOP, -$! -$CLOSE_FILE: -$ WRITE OUT "E"N -$ CLOSE OUTE -$! -$ @'TEMP_FILE -$ DELETE 'TEMP_FILE;*T -$ WRITE SYS$OUTPUT ""i -$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'" -$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME -$ WRITE SYS$OUTPUT "", -$ GOTO DONE -$OPEN_ERROR: -$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'" -$DONE: -$ EXIT 'EXIT_STATUSE -$eod -$copy/log sys$input RESTART.COM( -$deckV -$ SET PROCESS/PRIVILEGE=ALL -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL -DO DEASSIGN BULL_DISABLE/SYSTEMN -$ BULL/START -$eod -$copy/log sys$input SETUSER.MARr -$deckb - .Title SETUSERo -;a -; Program SetuserU -;T -; This program will change the username and UIC of the running process -;M -; To assemble: $ MACRO SETUSER -; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT -;L - .LIBRARY /SYS$LIBRARY:LIB.MLB/A - $PCBDEF ;define PCB offsetsR - $JIBDEF ;define JIB offsets* - $UAFDEF ;define user authorization file offsetsc -INFAB: $FAB FAC=GET - ;only gets on input fileL - FNM= - ;SYSUAF may be defined as logical name - DNM= - ;These are default directory & suffixR - SHR= ;allow full sharing -INRAB: $RAB FAB=INFAB - ;FAB for this RAB - KBF=COMMLD+8 - ;key value is typed in by user - KRF=0 - ;primary key - KSZ=12 - ;username is 12 bytes long - RAC=KEY - ;key access on this filel - ROP=NLK - ;don't lock read records/ - UBF=BUFFER - ;address of buffer for I/O - USZ=2048 ;size of bufferd -BUFFER: .BLKB 2048 ;buffer for data -COMMLD: .ASCID / / ;space for typed in usernameB -PROMPTD:.ASCID /Username: / ;prompt stringL -COMMLDS:.WORD 0 ;space for number of bytes typed inN -FAODESC:.LONG 80 - .LONG FAOBUFL -FAOBUF: .BLKB 80 -FAOLEN: .BLKW 1C - .BLKW 1 -FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/ -TT: .ASCID /SYS$OUTPUT/M -CHANTT: .WORD 0 ;space for terminal channel number -IOSB: .QUAD 0 -OLDUSER:.BLKB 12 ;space for old username -OLDUIC: .BLKL 1 ;space for old uic -ERRORB: JMP ERROR ;for branch out of range - -JPIUSER: .BLKB 12A -JPIUSER_LEN: .BLKL 1 - - $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI -$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER -$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME)a -$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER -$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED -$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LISTt -$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK - $DEFEND ITe - - .ENTRY START,^M<> ;start of program - PUSHAW COMMLDS ;address of word to get read byte count1 - PUSHAL PROMPTD ;address of prompt string descriptor - PUSHAL COMMLD ;address of descriptor to get command - CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command - BLBC R0,ERRORB ;low bit clear error - $OPEN FAB=INFAB ;open file - BLBC R0,ERRORB ;low bit clear errore - $CONNECT RAB=INRAB ;connect file - BLBC R0,ERRORB ;low bit clear errorl - $GET RAB=INRAB ;read a recordi - CMPL R0,#RMS$_RNF ;record not found? - BEQL errorb ;that's all folks - CMPL R0,#RMS$_NORMAL ;ok?i - BNEQ ERRORB ;no so quit - - SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST - MOVL SP,R2 ;POINT TO IT - MOVW #12,ITL(R2) ;SET UP ITEM LIST - MOVW #JPI$_USERNAME,ITM(R2) - MOVAB JPIUSER,ITA(R2) - MOVAW JPIUSER_LEN,ITAL(R2)i - CLRL ITEND(R2)I - $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME - ADDL #ITSIZE,SP ;RESTORE STACK POINTER - - MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7 - MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want - $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC - ;and username - BLBC R0,ERROR ;low bit clear error - ADDL3 #UAF$S_USERNAME,R7,R8 - ADDL3 #UAF$T_USERNAME,R7,R9 - $FAO_S CTRSTR=FORSTR,- ;format stringo - OUTBUF=FAODESC,- ;char descript for formatted output - OUTLEN=FAOLEN,- ;long word to hold length of output - P1=R9,- ;PID - P2=OLDUIC+2,- ;old UIC, group numberi - P3=OLDUIC,- ;old UIC, member number - P4=#12,- ;usernames are 12 bytesI - P5=#OLDUSER,- ;address of old usernamer - P6=UAF$L_UIC+2(R7),- ;UIC, group number. - P7=UAF$L_UIC(R7),- ;UIC, member number - P8=R8,- ;usernames are 12 bytes - P9=R9 ;address of username - BLBC R0,ERROR ;low bit clear error - MOVL FAOLEN,FAODESC - PUSHAL FAODESC ;address of descriptor to get command - CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get commandt - BLBC R0,ERROR ;low bit clear error -EXIT:I - $CLOSE FAB=INFAB - ;close file - ERR=ERROR. -ERROR: $EXIT_S R0 ;exit with error if anyB - .ENTRY TWEAK,^M<> ;beginning of kernel mode code - MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11 - MOVL PCB$L_PID(R11),R9 ;save PIDr - MOVL PCB$L_UIC(R11),OLDUIC ;save old UICu - MOVL R8,PCB$L_UIC(R11) ;change our UIC - MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10 - ;MOVC blats R0-R5 - MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old usernamea - CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER - BEQL GOOD - CLRL R0 - RET -GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIBC - MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1 -EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit statusc - RET ;end of exec mode code - .END START ;end of program- -$eod - -$copy/log sys$input UPGRADE.COMS -$deckd -$! -$! Normally, new versions of BULLETIN don't require any special -$! installation except to link and install the new executable (and! -$! possibly relink PMDF or MX interfaces if any changes affect them). -$! However, when there is a change to the data file format, you should runE -$! the following procedure. R -$! -$! This is a sample upgrade procedure. You will have to modify referencesT -$! to the directory where the new executables are stored, which are markeda -$! with ***. You will also have to change the references to the proceduresE -$! that link either PMDF or MX. These procedures usually replace the old -$! executable, but that should not be done until BULLETIN has been disabled -$! (by defining the logical name BULL_DISABLE). If you run this procedure! -$! with a parameter (i.e. @UPGRADE LINK), it will call those linkingF -$! procedures. Alternatively, you could define BULL_DISABLE and run those -$! procedures manually. Or, you could change them so they don't replace theL -$! old procedures and run them manually, and simply have this procedure -$! replace them. Whatever you find more convenient.T -$! -$! This procedure should be run on all stand alone nodes or boot nodes of -$! clusters on which bulletin is installed. After running upgrade.com, run -$! restart.com to restart bulletin. If you don't make use of remoteT -$! folders, you can run restart.com immediately after upgrade.com ratherF -$! than waiting to install the new version on all nodes. Otherwise, youI -$! should try to run this procedure simultaneously on all clusters and then -$! wait until it finishes on all nodes before running restart.com. -$! Otherwise, remote folder access attempts will fail. -$! -$ SET PROCESS/PRIVILEGE=ALLN -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULLETIN.EXE BULL_DIR: ! *** N -$ COPY ALCVAX::USER1:[MRL.BULLETIN]BULL.HLB SITE$ROOT:[SYSHLP] ! *** L -$ PMDF = F$TRNLNM("PMDF_ROOT") -$ MX = F$TRNLNM("MX_EXE")" -$ BULL/STOP -$ IF PMDF .NES. "" THEN PMDF = F$SEARCH("PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE") -$ IF PMDF .NES. "" THEN DELETE/NOCONFIRM PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE;*" -$ IF MX .NES. "" THEN MX = F$SEARCH("MX_EXE:MX_BULL.EXE")C -$ IF MX .NES. "" THEN DELETE/NOCONFIRM MX_EXE:MX_BULL.EXE;*O -$ MCR SYSMAN -SET ENV/CL -SET PROF/PRIV=ALL" -DO DEFINE BULL_DISABLE/SYSTEM "DISABLE"O -DO MCR INSTALL BULL_DIR:BULLETIN/REPLACE -$ IF P1 .NES. "" .AND. PMDF .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_PMDF ! *** -$ IF P1 .NES. "" .AND. MX .NES. "" THEN @USER1:[MRL.BULLETIN]LINK_MX ! ***K -$ DEFINE BULL_DISABLE "ENABLE" ! Enable it just for this process. -$ BULLETIN -$ IF F$TRNLNM("BULL_NEWS_SERVER") .NES. "" THEN BULLETIN MISC.TEST -$ IF PMDF .NES. "" THEN- - COPY ALCVAX::PMDF_ROOT:[EXE]BULLETIN_MASTER.EXE PMDF_ROOT:[EXE] ! *** -$ IF MX .NES. "" THEN- - COPY ALCVAX::MX_EXE:MX_BULL.EXE MX_EXE: ! *** -$ DEASSIGN BULL_DISABLE, -$eod C diff --git a/decus/vax92b/bulletin/bulletin.announce b/decus/vax92b/bulletin/bulletin.announce deleted file mode 100644 index fc3f66d..0000000 --- a/decus/vax92b/bulletin/bulletin.announce +++ /dev/null @@ -1,84 +0,0 @@ -From: MERC::"uunet!ORYANA.PFC.MIT.EDU!BULLETIN" 18-JAN-1993 20:39:58.41 -To: galaxy::gleeve -CC: -Subj: BULLETIN utility. - -You are about to receive version 2.13 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -If you are running a version of BULLETIN older than 2.11, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. NOTE: -Problems can occur if the old version of BULLETIN is run after the -data files have been modified. Such a situation is possible on a -cluster where each node has installed the executable separately. To -help installation, a new command procedure UPGRADE.COM has been -included. Read the comments in the file for information on how to use -it. - -As of V2.0, BULLETIN is able to read USENET NEWS via TCP/IP using either -CMU, MULTINET, UCX, TWG, or via DECNET. It can also serve as a NEWS -gateway for DECNET nodes without direct access to the NEWS server, i.e. a -DECNET node without Internet access will be able to read NEWS. - -NOTE: The following commands can be sent to BULLETIN@ORYANA.PFC.MIT.EDU: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. (This does not describe the NEWS reader -feature, however.) - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -You will be receiving 21 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) BULLETIN10.FOR - 13) BULLETIN11.FOR - 14) ALLMACS.MAR - 15) BULLCOMS1.HLP - 16) BULLCOMS2.HLP - 17) BULLET1.COM - 18) BULLET2.COM - 19) PMDF.COM - 20) MX.COM - 21) NEWS.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. However, this only applies -to PMDF V3.2 or earlier, as later versions of PMDF have the necessary -interface code for BULLETIN included in it. In that case, or in case -you don't have PMDF, you can delete it. The same applies to MX. Then, -read AAAREADME.TXT for BULLETN installation instructions. If you are -using the news feature, NEWS.COM contains files which pertain to news. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@NERUS.PFC.MIT.EDU diff --git a/decus/vax92b/bulletin/bulletin.cld b/decus/vax92b/bulletin/bulletin.cld deleted file mode 100644 index ae9f5d5..0000000 --- a/decus/vax92b/bulletin/bulletin.cld +++ /dev/null @@ -1,43 +0,0 @@ -! -! This file is the CLD file used to define a command to execute -! BULLETIN by using CDU, which adds the command to the command table. -! The alternative is to define a symbol to execute BULLETIN. -! Either way will work, and it is up to the user's to decide which -! method to work. (If you don't know which, you probably should use -! the default symbol method.) -! - -Define Verb BULLETIN - Image BULL_DIR:BULLETIN - Parameter P1, Label = SELECT_FOLDER - Qualifier ALL - Qualifier BBOARD - Qualifier BULLCP - Qualifier CLEANUP, Value (Required) - Qualifier EDIT - Qualifier KEYPAD, Default - Qualifier LOGIN - Qualifier MARKED - Qualifier PAGE, Default - Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required) - Qualifier PROMPT, Value (Default = "BULLETIN"), Default - Qualifier READNEW - Qualifier REVERSE - ! - ! The following line causes a line to be outputted separating system notices. - ! The line consists of a line of all "-"s, i.e.: - !-------------------------------------------------------------------------- - ! If you want a different character to be used, simply put in the desired one - ! in the following line. If you want to disable the feature, remove the - ! Default at the end of the line. (Don't remove the whole line!) - ! - Qualifier SEPARATE, Value (Default = "-"), Default - Qualifier SEEN - Qualifier STARTUP - Qualifier STOP - Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7") - Qualifier UNMARKED - Qualifier UNSEEN - Qualifier WIDTH, Value (Type = $NUMBER, Required) - Qualifier WSEXTENT, Value (Type = $NUMBER, Required) - Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP diff --git a/decus/vax92b/bulletin/bulletin.for b/decus/vax92b/bulletin/bulletin.for deleted file mode 100644 index 8ada65b..0000000 --- a/decus/vax92b/bulletin/bulletin.for +++ /dev/null @@ -1,1871 +0,0 @@ -C -C BULLETIN.FOR, Version 1/9/93 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POINT/ BULL_POINT - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING /.FALSE./ - - COMMON /CTRLY/ CTRLY - - COMMON /PROMPT/ COMMAND_PROMPT - CHARACTER*40 COMMAND_PROMPT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - EXTERNAL ERROR_TRAP - EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT - EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT - EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED - - PARAMETER PCB$M_BATCH = '4000'X - PARAMETER PCB$M_NETWRK = '200000'X - PARAMETER LIB$M_CLI_CTRLY = '2000000'X - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*44 - - COMMON /EDIT/ EDIT_DEFAULT - DATA EDIT_DEFAULT/.FALSE./ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - COMMON /BULL_CUSTOM/ BULL_CUSTOM - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM - - CHARACTER DCL_CMD*132 - - IER = SYS_TRNLNM_SYSTEM('BULL_CUSTOM',BULL_PARAMETER) - IF (IER) IER = OTS$CVT_TZ_L(BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - & ,BULL_CUSTOM,,,%VAL(1)) - - CALL LIB$GET_FOREIGN(INCMD) - DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"' - - CALL LIB$ESTABLISH(ERROR_TRAP) - IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN - CALL LIB$REVERT - CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN) - INCMD = 'BULLETIN '//INCMD - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (DCL_COMMAND) THEN - IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP) - IF (LENP.GT.0) THEN - IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1) - IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:) - END IF - END IF - - READIT = 0 - - LOGIN_SWITCH = CLI$PRESENT('LOGIN') - SYSTEM_SWITCH = CLI$PRESENT('SYSTEM') - REVERSE_SWITCH = CLI$PRESENT('REVERSE') - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP') - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') THEN - IF (.NOT.LOGIN_SWITCH) THEN - WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')') - END IF - CALL EXIT - END IF - - CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT) - ! Save original default protection in case it gets changed - - CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler - -C -C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y. -C Disabling and enabling CONTROL Y is done so that a person can not break -C while one of the data files is opened, as that would not allow anyone -C else to modify the files. However, if CONTROL Y is already disabled, -C this is not necessary, and should not be done! -C - - CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C - CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY - CALL GETPRIV ! Check privileges - CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O - CALL CHECK_DIR_ACCESS() ! Check access to directories - CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C - - IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit - - CALL GETUSER(USERNAME) ! Get the process's username - IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME) - ! Check if has bulletin privileges - - I = 1 ! Strip off folder name if specified - DO WHILE (I.LE.ILEN) - IF (COMMAND_PROMPT(I:I).EQ.' ') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - I = ILEN + 1 - ELSE - I = I + 1 - END IF - END DO - ILEN = 1 ! Get executable name to use as prompt - DO WHILE (ILEN.GT.0) - ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']')) - IF (ILEN.GT.0) THEN - COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:) - ELSE - DO I=TRIM(COMMAND_PROMPT),1,-1 - IF (COMMAND_PROMPT(I:I).LT.'A'.OR. - & COMMAND_PROMPT(I:I).GT.'Z') THEN - COMMAND_PROMPT = COMMAND_PROMPT(:I-1) - END IF - END DO - END IF - END DO - COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> ' - IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR. - & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> ' - - CALL INIT_COMPRESS - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER - - CALL CLI$GET_VALUE('SEPARATE',SEPARATE) - - IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test - - CALL FIND_BULLCP ! See if BULLCP is running - - IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch - CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder # - READ (BULL_PARAMETER,'(I)') FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - CALL EXIT ! all done with cleanup - ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch - CALL BBOARD ! look for BBOARD mail - CALL EXIT ! all done with BBOARD - ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control - & CLI$PRESENT('STOP')) THEN - CALL CREATE_BULLCP - ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start - IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER', - & BULL_PARAMETER,LENP)) THEN - CALL RUN_BULLCP ! doing what BULLCP does! - ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN - CALL NEWS2BULL - END IF - END IF - - CALL GETSTS(STS) ! Get process status word - - IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM - IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit - CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal - END IF - - IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN - DECNET_PROC = .FALSE. - ERROR_UNIT = 6 - - CALL ASSIGN_TERMINAL ! Assign terminal - - CALL LIB$ESTABLISH(ERROR_TRAP) ! Do again due to possible - IF (.NOT.CLI$PRESENT('PROMPT')) THEN ! KEYPAD init file. - CALL LIB$REVERT - CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS) - ELSE - CALL LIB$REVERT - END IF - - IF (.NOT.LOGIN_SWITCH) THEN - INCMD = 'SELECT' ! Causes nearest folder name to be selected - CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder - IF (.NOT.IER) RETURN ! If can't access, exit - - IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED - ! Delete expired messages - END IF - -C -C Get page size for the terminal. -C - - CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) - - IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) PAGE_WIDTH - END IF - - IF (CLI$PRESENT('PAGE')) PAGING = .TRUE. - - IF (SYSTEM_SWITCH) THEN - IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified? - CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')') - CALL EXIT - END IF - END IF - IF (.NOT.LOGIN_SWITCH) THEN - CALL MODIFY_SYSTEM_LIST(0) - CALL READ_IN_FOLDERS - FOLDER_Q = SAVE_FOLDER_Q1 - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - CALL SHOW_SYSTEM - END IF - END DO - END IFo - END IF - -Cd -C Get user info stored in SYS$LOGIN. Currently, this simply stores -C the time of the latest message read for each folder.I -CI - - CALL OPEN_USERINFO - -CE -C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins.I -CU - - IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present? - CALL LOGIN ! Display SYSTEM bulletins - IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit - END IF - -CG -C If new bulletins have been added since the last time bulletins have been -C read, position bulletin pointer so that next bulletin read is the first new -C bulletin, and alert user. If READNEW set and no new bulletins, just exit.L -CC - - IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATIONS - - CALL OPEN_OLD_TAG - - ELSE - IF (TEST_BULLCP()) CALL EXIT - DECNET_PROC = .TRUE. - ERROR_UNIT = 5 - END IF - -CM -C The MAIN loop for processing bulletin commands. -C2 - - DIR_COUNT = 0 ! # directory entry to continue bulletin read fromD - READ_COUNT = 0 ! # block that bulletin READ is to continue from - FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from. - INDEX_COUNT = 0 - - IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY) - IF (IER.NE.1) THENS - HELP_DIRECTORY = 'SYS$HELP:' - HLEN = 9 - ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND. - & HELP_DIRECTORY(HLEN:HLEN).NE.']') THENP - HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':' - HLEN = HLEN + 1T - END IFO - - LPROMPT = TRIM(COMMAND_PROMPT)C - PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' 'S - LPROMPT = LPROMPT + 2 - - DO WHILE (1)R - - IF (.NOT.DCL_COMMAND) THEN - CALL COMMAND_INPUT(IER) - ELSE - IF (INDEX(DCL_CMD,';').GT.0) THEN - INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1) - DCL_COMMAND = DCL_CMD(INDEX(DCL_CMD,';'):).NE.';'E - DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:) - ELSE. - INCMD = DCL_CMD( - DCL_CMD = ' '( - END IFL - IER = TRIM(INCMD) - END IF - - IF (IER.EQ.-2) THENT - IER = RMS$_EOFE - ELSE IF (IER.LE.0) THENT - IER = %LOC(CLI$_NOCOMD) - ELSE - DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ')M - INCMD = INCMD(2:IER) - IER = IER - 1 - END DON - IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THENR - INCMD = 'READ '//INCMDE - END IF - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - END IF - - IF (IER.EQ.RMS$_EOF) THEND - CALL EXIT ! If no command, exit - ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered' - INCMD = ' ' ! Make sure there is noneE - LEN_P = 0 ! Indicate no parameter in commandA - IF (DIR_COUNT.GT.0) THEN ! If still more dir entries - CALL DIRECTORY(DIR_COUNT) ! continue outputting them' - ELSE IF (INDEX_COUNT.GT.0) THEN - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them - ELSE ! Else try to read next bulletinL - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one - DIR_COUNT = 0L - FOLDER_COUNT = 0 - INDEX_COUNT = 0D - END IFa - GO TO 100 ! Loop to read new command - ELSE IF (.NOT.IER) THEN ! If command has errort - GO TO 100 ! ask for new commandf - END IF - - IER = MINGT0(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/')) - IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiersY - CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command.R - - IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN - DIR_COUNT = -1i - CALL DIRECTORY(DIR_COUNT) - INCMD = ' ' -C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THENn -C FOLDER_COUNT = -1E -C CALL DIRECTORY_FOLDERS(FOLDER_COUNT) -C INCMD = ' 'E - ELSE - DIR_COUNT = 0 ! Reinit display pointers - READ_COUNT = 0E - FOLDER_COUNT = 0! - INDEX_COUNT = 0 - END IF - - IF_ADD = INCMD(:3).EQ.'ADD' - IF (IF_ADD) IF_ADD = .NOT.CLI$PRESENT('SELECT_FOLDER') - IF (READ_ONLY.AND.(IF_ADD.OR.INCMD(:3).EQ.'DEL'R - & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN - ! FOLDER can only be read? - WRITE (6,'('' ERROR: Access to folder limited to reading.'')') - ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD? - IF (NEWS_FEED().OR.REMOTE_SET.GE.3) THEN - INCMD = 'POST '//INCMD(4:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT) - CALL RESPOND - ELSE - CALL ADDD - END IF - ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH?P - CALL ATTACH - ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK? - IF (BULL_POINT.LE.1) THENM - WRITE(6,1060) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previousP - END IF - ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE? - CALL REPLACE ! Replace old bulletin - ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY?P - CALL MOVE(.FALSE.) - ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE?w - CALL CREATE_FOLDER ! Go create the folders - ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT? - READ_COUNT = -1 ! Reread current message from beginning.E - CALL READ_MSG(READ_COUNT,BULL_POINT) - ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE?C - CALL DELETE_MSG ! Go delete bulletin - ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY? - IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified?O - & CLI$PRESENT('NEWS')) THEN ! or /NEWS?B - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all foldersn - ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified? - CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folderE - IF (IER) THEN ! If successful) - CALL DIRECTORY(DIR_COUNT) ! Show messages - END IF - ELSE - CALL DIRECTORY(DIR_COUNT) ! Show messagesU - END IF - ELSE IF (INCMD(:4).EQ.'FILE'.OR. - & INCMD(:4).EQ.'EXTR') THEN ! FILE? - CALL FILE ! Copy bulletin to fileE - ELSE IF (INCMD(:4).EQ.'EXCL') THEN ! EXCLUDE? - CALL INCLUDE(.TRUE.) - ELSE IF (INCMD(:1).EQ.'E'.OR. - & INCMD(:4).EQ.'QUIT') THEN ! EXIT? - CALL EXIT ! Exit from program - ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST? - READ_COUNT = -1W - BULL_READ = 1E - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP? - CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help - ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX?' - INDEX_COUNT = 1i - CALL FULL_DIR(INDEX_COUNT) - ELSE IF (INCMD(:4).EQ.'INCL') THEN ! INCLUDE? - CALL INCLUDE(.FALSE.)S - ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST?D - READ_COUNT = -1G - BULL_READ = 9999999C - CALL READ_MSG(READ_COUNT,BULL_READ)t - ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK?, - CALL TAG(.TRUE.,1) - ELSE IF (INCMD(:4).EQ.'MAIL'.OR. - & INCMD(:4).EQ.'FORW') THEN ! MAIL? - CALL MAILE - ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY? - CALL MODIFY_FOLDER - ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE?G - CALL MOVE(.TRUE.) - ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS - CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders_ - ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT?R - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST?N - IF (BTEST(FOLDER_FLAG,11)) THEN - INCMD = 'ADD '//INCMD(5:) - IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT)T - CALL ADDR - ELSEp - CALL RESPONDE - END IF - ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT? - CALL PRINT(0,.TRUE.) ! Printout bulletin - ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ?R - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified? - DECODE(LEN_P,'(I)',BULL_PARAMETER) BULL_READ ! Yes - READ_COUNT = -1 - CALL READ_MSG(READ_COUNT,BULL_READ) - ELSE - CALL READ_MSG(READ_COUNT,BULL_POINT+1) - END IF - ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE? - CALL REMOVE_FOLDER - ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY? - IF (REMOTE_SET.GE.3.OR.b - & INDEX(FOLDER_DESCRIP,'<').GT.0) THENW - CALL RESPOND - ELSE - CALL REPLY - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THEN ! RESPOND? - CALL RESPOND - ELSE IF (INCMD(:4).EQ.'RESE') THEN ! RESET? - CALL RESET - ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH? - CALL SEARCH(READ_COUNT)n - ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN? - CALL TAG(.TRUE.,2) - ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET?O - CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER)T - IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER? - CALL SELECT_FOLDER(.TRUE.,IER) - ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS? - CALL SET_PRIVe - ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE? - PAGING = .TRUE. - WRITE (6,'('' PAGE has been set.'')')t - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD?T - CALL SET_KEYPADL - ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD?$ - CALL SET_NOKEYPAD - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE?I - PAGING = .FALSE. - WRITE (6,'('' NOPAGE has been set.'')')E - ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN - WRITE (6,'('' ERROR: Invalid command for remote folder.'')')/ - ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM? - CALL SET_SYSTEM(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM? - CALL SET_SYSTEM(.FALSE.)M - ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD? - CALL SET_BBOARD(.TRUE.) - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD? - CALL SET_BBOARD(.FALSE.) - ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP? - CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP?% - CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP') - ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP? - CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP? - CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP') - ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST? - CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST?C - CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST') - ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS? - CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS? - CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS') - ELSE IF (BULL_PARAMETER(:2).EQ.'CO') THEN ! SET COMPRESS? - CALL SET_FOLDER_FLAG(.TRUE.,12,'COMPRESS') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOCO') THEN ! SET NOCOMPRESS? - CALL SET_FOLDER_FLAG(.FALSE.,12,'COMPRESS')! - ELSE IF (BULL_PARAMETER(:2).EQ.'PO') THEN ! SET POST_ONLY? - CALL SET_FOLDER_FLAG(.TRUE.,10,'POST_ONLY') - IF (BTEST(FOLDER_FLAG,11)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - END IFc - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPO') THEN ! SET NOPOST_ONLY?O - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY') - ELSE IF (BULL_PARAMETER(:2).EQ.'AD') THEN ! SET ADD_ONLY?) - CALL SET_FOLDER_FLAG(.TRUE.,11,'ADD_ONLY') - IF (BTEST(FOLDER_FLAG,10)) THEN - CALL SET_FOLDER_FLAG(.FALSE.,10,'POST_ONLY')M - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOAD') THEN ! SET NOADD_ONLY? - CALL SET_FOLDER_FLAG(.FALSE.,11,'ADD_ONLY') - ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY?D - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(1,-1,-1)O - ELSE - CALL SET_USER_FLAG(1,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE? - IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)D - IF (LEN_P.LE.3) THEN - READ (BULL_PARAMETER,'(I)') LIMIT - CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT) - ELSE - WRITE (6,'('' ERROR: Invalid expiration specified.'')') - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE?_ - CALL SET_NODE(.TRUE.) - ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE?M - CALL SET_NODE(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE? - CALL SET_FOLDER_EXPIRE_LIMIT(0)A - ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))! - & THEN - CALL SET_FOLDER_DEFAULT(0,-1,-1): - ELSE - CALL SET_USER_FLAG(0,-1,-1) - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))a - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,1) - ELSE - CALL SET_USER_FLAG(-1,0,1)a - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW?) - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')). - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0)C - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))T - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,0) - ELSE - CALL SET_USER_FLAG(-1,1,0)D - END IF - ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW?E - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT')) - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0) - END IF - ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))N - & THEN - CALL SET_FOLDER_DEFAULT(-1,1,1) - ELSE - CALL SET_USER_FLAG(-1,1,1)D - END IF - ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF? - IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR. - & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))L - & THEN - CALL SET_FOLDER_DEFAULT(-1,0,0) - ELSE - CALL SET_USER_FLAG(-1,0,0)A - END IF - ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS?T - CALL SET_ACCESS(.TRUE.)9 - ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS? - CALL SET_ACCESS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF - CALL SET_BRIEF_CONTINUOUS(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF? - CALL SET_BRIEF_CONTINUOUS(.FALSE.) - ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC? - CALL SET_GENERIC(.TRUE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC?S - CALL SET_GENERIC(.FALSE.) - ELSE IF (BULL_PARAMETER(:3).EQ.'LOG') THEN ! SET LOGIN? - CALL SET_LOGIN(.TRUE.) - ELSE IF (BULL_PARAMETER(:5).EQ.'NOLOG') THEN ! SET NOLOGIN?S - CALL SET_LOGIN(.FALSE.)I - ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE')O - ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE? - CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE') - ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE? - CALL SET_DEFAULT_EXPIREE - ELSE IF (BULL_PARAMETER(:2).EQ.'NE') THEN ! SET NEWS?_ - CALL SET_NEWSM - END IF - ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW?t - CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P) - IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS? - CALL SHOW_FLAGSD - ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER? - CALL SHOW_FOLDER: - ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD - CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB') - ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW? - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - SAVE_FOLDER = FOLDER - CALL NEW_MESSAGE_NOTIFICATIONE - FOLDER1 = SAVE_FOLDER? - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES? - CALL SHOW_PRIV - ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER? - CALL SHOW_USER - ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION? - CALL SHOW_VERSION - END IF - ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command? - CALL SPAWN_PROCESSR - ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command? - CALL SUBSCRIBE. - ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE? - CALL UNDELETEE - ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK? - CALL TAG(.FALSE.,1)s - ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN?. - CALL TAG(.FALSE.,2)T - ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command? - CALL UNSUBSCRIBE - END IF - -100 CONTINUE4 - - IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXITR - - END DO - -1010 FORMAT(Q,A) -1060 FORMAT(' ERROR: There are no more preceding messages.') - - END - - - - SUBROUTINE COMMAND_INPUT(IER) - - IMPLICIT INTEGER (A - Z)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT - CHARACTER*44 PROMPT - - CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT)) - - RETURN. - - END - - - - - - SUBROUTINE ADDE -C( -C SUBROUTINE ADD! -CT -C FUNCTION: Adds bulletin to bulletin file. -CI - IMPLICIT INTEGER (A - Z)O - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE4 - CHARACTER*32 NODES(10)O - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT2 - LOGICAL DECNET_PROC - - COMMON /EDIT/ EDIT_DEFAULTG - DATA EDIT_DEFAULT/.FALSE./E - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'D - - INCLUDE 'BULLFOLDER.INC'_ - - COMMON /INDESCRIP/ INDESCRIPE - CHARACTER*(INPUT_LENGTH) INDESCRIP. - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8Y - - CHARACTER INEXDATE*12,INEXTIME*12 - - CHARACTER INLINE*80,OLD_FOLDER*44,LOCAL_NODE*8L - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THENE - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - RETURN - END IFS - - IF (EDITIT.AND..NOT.CLI$PRESENT('EXTRACT')) - & .AND..NOT.CLI$PRESENT('FILESPEC')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -CE - - ALLOW = SETPRV_PRIV() - - OLD_FOLDER_NUMBER = FOLDER_NUMBER - OLD_FOLDER = FOLDER - - LEN_P = 0 - - IF (CLI$PRESENT('EXTRACT')) THENS - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'A - LEN_P = TRIM(BULL_PARAMETER) - OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER, - & RECL=LINE_LENGTH,) - & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED')T - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)L - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)T - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THEN - WRITE (3,'(A)') INPUT(:ILEN) - ELSEL - WRITE (3,'(A)') '>'//INPUT(:ILEN)_ - END IFI - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - -90 CALL CLOSE_BULLFIL - END IFE - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - IF (.NOT.CLI$PRESENT('EXTRACT')) THEN( - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',T - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - ELSE - OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',$ - & READONLY,SHARED,ERR=920,FORM='FORMATTED')& - IER = 0 - ICOUNT = 0L - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUTU - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' ' - ICOUNT = ICOUNT + 1( - WRITE (3,'(A)') INPUT(:ILEN) - END IFS - END DOO - CLOSE (UNIT=4). - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR' - LEN_P = TRIM(BULL_PARAMETER) - END IF - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - END IFF - - SELECT_FOLDERS = .FALSE. - IF (CLI$PRESENT('SELECT_FOLDER')) THENN - CALL GET_FOLDER_INFO(IER)R - IF (.NOT.IER) GO TO 910N - SELECT_FOLDERS = .TRUE.$ - ELSE( - NODE_NUM = 1 - NODES(1) = OLD_FOLDER - END IF - - IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and - & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')') - GO TO 910( - END IF. - - IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND. - & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present? - & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present?A - & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present? - WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')') - GO TO 910( - END IFE - - IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present? - IF (.NOT.ALLOW) THEN ! If no privilegesF - WRITE(ERROR_UNIT,1070) ! Tell user - GO TO 910 ! and abortR - END IF - SYSTEM = 1 ! Set system bit - ELSE - SYSTEM = 0 ! Clear system bit - END IFA - - IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?E - IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges - WRITE(ERROR_UNIT,1080) ! Tell user - GO TO 910 ! and abort) - ELSE IF (CLI$PRESENT('CLUSTER')) THEN$ - SYSTEM = SYSTEM.OR.8R - END IF - END IFL - - IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?C - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(ERROR_UNIT,1083)3 - GO TO 910 - ELSE - SYSTEM = SYSTEM.OR.2 ! Set permanent bit - INEXDATE = '5-NOV-2000' - INEXTIME = '00:00:00.00'T - END IF - END IFU - - IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present?U - IF (.NOT.ALLOW) THEN ! If no privileges) - WRITE(ERROR_UNIT,1082) ! Tell user - GO TO 910 ! and abortG - ELSE - IER = CLI$GET_VALUE('SHUTDOWN',INLINE)' - IF (IER.NE.%LOC(CLI$_ABSENT)) THENC - IF (REMOTE_SET) THEN ! Can't specify node name if - WRITE (6,1090) ! remote folder, as no code - GO TO 910 ! present to send the name.S - END IFS - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE) - IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name - ELSE' - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)' - END IFE - SYSTEM = SYSTEM.OR.4 ! Set shutdown bit, - INEXDATE = '5-NOV-2000' - WRITE (INEXTIME(1:),'(I2)') NODE_NUMBER/60 - WRITE (INEXTIME(3:),'(I2)') MOD(NODE_NUMBER,60). - WRITE (INEXTIME(7:),'(I2)') NODE_AREA/60 - WRITE (INEXTIME(9:),'(I2)') MOD(NODE_AREA,60)A - DO I=1,11 - IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0' - END DOE - INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'// - & INEXTIME(7:8)//'.'//INEXTIME(9:10) - END IF - END IFH - - SELECT_NODES = .FALSE.B - IF (CLI$PRESENT('NODES')) THENS - CALL GET_NODE_INFO - IF (NODE_ERROR) GO TO 940L - SELECT_NODES = .TRUE.E - END IF_ - - IF ((SYSTEM.AND.7).LE.1.AND.(CLI$PRESENT('SELECT_FOLDER').OR. - & CLI$PRESENT('NODES').OR..NOT.BTEST(FOLDER_FLAG,10))) THEN - CALL GET_EXPIRED(INPUT,IER) ! Not permanent or shutdown S - IF (.NOT.IER) GO TO 910 - INEXDATE = INPUT(:11)( - INEXTIME = INPUT(13:23)L - END IF - - IF (INCMD(:3).EQ.'REP') THEN ! REPLY?E - LENDES = TRIM(INDESCRIP) ! filled in by main subroutine - ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified - CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES) - ELSEM - WRITE(6,1050) ! Request header for bulletin - CALL GET_LINE(INDESCRIP,LENDES) ! Get input line - IF (LENDES.LE.0) GO TO 910 - END IFR - - LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: "E - -CD -C If file specified in ADD command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.S -C1 - - IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specifiedA - IF (LEN_P.EQ.0) THEN ! If no file param specifiedU - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3): - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - IF (CLI$PRESENT('EXTRACT')) THENA - CONTEXT = 0A - CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THENR - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')N - END IF - END IFl - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',M - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')M - END IF - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'D - LEN_P = TRIM(BULL_PARAMETER) - END IF - - ICOUNT = 0 ! Line count for bulletin - - END = 0 - BLENGTH = 35L - IF (CLI$PRESENT('BELL')) BLENGTH = 37 - IF (LEN_P.GT.0) THEN ! If file param in ADD command - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950_ - ICOUNT = ICOUNT + 1 + MIN(ILEN,80)T - BLENGTH = BLENGTH + ILEN - 1 + 2U - IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line withC - END DO ! 1 space for blank line - ELSE ! If no input file - BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'D - LEN_P = TRIM(BULL_PARAMETER) - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & STATUS='NEW',S - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal - ILEN = LINE_LENGTH + 1 ! Length of input line - ICOUNT = 0 ! Character count counter - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTHE - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredR - ICOUNT = ICOUNT + ILEN ! Update counterC - BLENGTH = BLENGTH + ILEN - 1 + 2 - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch fileE - END IFI - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - BRDCST = .FALSE.M - - IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN - WRITE (6,'('' Message is too long for broadcasting.'', - & '' A truncated message will be broadcast.'')') - CALL GET_INPUT_PROMPT(INPUT,ILEN,N - & 'Type C to continue, A to only ADD message, or Q to Quit: ')F - IF (STREQ(INPUT(:1),'Q')) THEN - GO TO 910 - ELSE IF (STREQ(INPUT(:1),'A')) THEN) - BRDCST = .TRUE. - END IF - END IFC - - IF (SELECT_NODES.AND.NODE_NUM.GT.0) THENT - INLINE = 'ADD' - IF (CLI$PRESENT('SYSTEM')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM' - IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST)H - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST'I - IF (CLI$PRESENT('PERMANENT')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT' - IF (CLI$PRESENT('SHUTDOWN')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN' - IF (CLI$PRESENT('BELL')) - & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL' - - LEN_INLINE = STR$POSITION(INLINE,' ') - 1A - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodesL - INLINE = INLINE(:LEN_INLINE) - - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - IF ((SYSTEM.AND.7).LE.1)I - ! If not permanent or shutdown specify date - & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME - WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES) - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT - ILEN = MIN(ILEN,LINE_LENGTH) - IF (IER.EQ.0) THENE - WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN)I - END IFF - END DOT - WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26) - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT - IF (INPUT.EQ.'END') THENl - WRITE (6,'('' Message successfully sent to node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while sending message to node '',A)') - & NODES(POINT_NODE)D - WRITE (6,'(A)') INPUT(:80)& - GO TO 940 - END IF. - REWIND (UNIT=3) - END DO - END IFI - - IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95A - ! Exit if local node not specified. - - IF (.NOT.SELECT_FOLDERS) THEN - NODE_NUM = 1 ! No folders specified so just - NODES(1) = FOLDER ! add to select folder - END IFY - - IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE) - LNODE = TRIM(LOCAL_NODE) - LUSER = TRIM(USERNAME) - -CE -C Add bulletin to bulletin file and directory entry for to directory file. -C - - DO I = 1,NODE_NUM - - IF (FOLDER.NE.NODES(I)) THEN - FOLDER_NUMBER = -1A - FOLDER1 = NODES(I)C - CALL SELECT_FOLDER(.FALSE.,IER) - ELSE - IER = 1 - END IF - - IF (IER.AND..NOT.BTEST(FOLDER_FLAG,10)) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entry - - DESCRIP=INDESCRIP(:LENDES) ! Description header - EXDATE=INEXDATE ! Expiration date - EXTIME=INEXTIME - FROM = USERNAME ! Username - - CALL OPEN_BULLFIL ! Prepare to add bulletin - - CALL READDIR(0,IER1) ! Get NBLOCKE - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - - REWIND (UNIT=3) - OBLOCK = NBLOCK+1 - CALL STORE_BULL(LNODE+LUSER+6,'From: '//2 - & LOCAL_NODE(:LNODE)//USERNAME(:LUSER),OBLOCK)D - IF (LENDES.GT.LEN(DESCRIP)) THENN - CALL STORE_BULL(LENDES+6, - & 'Subj: '//INDESCRIP(:LENDES),OBLOCK) - END IFU - CALL COPY_BULL(3,1,OBLOCK,IER1) ! Add the new bulletinL - IF (IER1.NE.0) GO TO 930 ! Error in creating bulletinI - LENGTH = OCOUNT - (NBLOCK+1) + 1M - - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL')) - END IFU - - CALL ADD_ENTRY ! Add the new directory entryA - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF (FOLDER_NUMBER.GE.0) THEND - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update info in folder file -C/ -C If user is adding message, an no new messages, update last read time for -C folder, so user is not alerted of new message which is owned by user. -C: - IF (DIFF.GE.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)' - END IF - END IF' - - CALL CLOSE_BULLDIR ! Totally finished with add -CL -C Broadcast the bulletin if requested. -CA - IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND. - & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN - BRDCST = .TRUE. - IF (.NOT.CLI$PRESENT('LOCAL')) THENE - CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'),R - & CLI$PRESENT('CLUSTER')) - END IFt -Cn -C If the folder is remote, and local node is not the node which BULLCP is -C on, don't broadcast, as it will be broadcasted by BULLCP. The remote -C node will distribute the broadcast to nodes that are running BULLCP,R -C but not if the node that originated the message matches. However, it -C has no way of knowing that the originating node is in the same clusterl -C as that of the BULLCP node. -C, - IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME) - & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET)o - & CALL BROADCAST( - & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER')). - END IF - ELSE IF (.NOT.IER) THENl - WRITE (6,'('' ERROR: Unable to add message to '',A)') - & NODES(I) - END IF - IF (IER.AND.(BTEST(FOLDER_FLAG,10).OR.L - & BTEST(FOLDER_FLAG,11)).AND.REMOTE_SET.LT.3) THENY - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THENM - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1L - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - INPUT = INPUT(:ILEN) - CALL ADD_PROTOCOL(INPUT,ILEN) - CLOSE (UNIT=3,STATUS='SAVE') - CALL DISABLE_PRIVS - CALL RESPOND_MAIL(BULL_PARAMETER(:LEN_P),INPUT,S - & INDESCRIP(:LENDES),STATUS)$ - CALL ENABLE_PRIVS - IF (BULL_PARAMETER.EQ.'SYS$LOGIN:BULL.SCR') THEN - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',' - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')R - ELSE - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=910,FORM='FORMATTED') - END IF - END IFN - END IF - END DOG - -95 CLOSE (UNIT=3) ! Close the input file - IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - DO I=10,NODE_NUM+9E - CLOSE (UNIT=I) - END DON - - IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THENB - FOLDER_NUMBER = OLD_FOLDER_NUMBER. - FOLDER1 = OLD_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - - IF (CLI$PRESENT('EXTRACT')) THENn - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - RETURNR - -910 WRITE(ERROR_UNIT,1010) - CLOSE (UNIT=3,ERR=100)I - GOTO 100I - -920 WRITE(ERROR_UNIT,1020) - CALL ENABLE_PRIVS - GOTO 100' - -930 WRITE (ERROR_UNIT,1025)t - CALL CLOSE_BULLFILR - CALL CLOSE_BULLDIRe - CLOSE (UNIT=3)m - GO TO 100 - -940 WRITE (6,1015) NODES(POINT_NODE) - WRITE (6,1018)= - CLOSE (UNIT=3) - GO TO 100 - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)e - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')_ -1010 FORMAT (' No message was added.') -1015 FORMAT (' ERROR: Unable to reach node ',A) -1018 FORMAT (' Try using /FOLDER instead of /NODE.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1025 FORMAT (' ERROR: Unable to add message to file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')r -1050 FORMAT (' Enter description header.') -1070 FORMAT (' ERROR: SETPRV privileges are needed for systemF - & messages.') -1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast - & messages.') -1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown - & messages.') -1083 FORMAT (' ERROR: Folder has expiration limit.') -1090 FORMAT (' ERROR: Nodename cannot be specified for shutdownG - & if folder is remote.') -2010 FORMAT(A) -2020 FORMAT(1X,A)l - - END - - - SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER)) - - IMPLICIT INTEGER (A-Z) - - CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*24 - - INTEGER BTIM(2),TODAY_BTIM(2) - - IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM)T - IF (.NOT.IER) RETURN - - BTIM(1) = -BTIM(1) ! Convert to negative delta timeE - BTIM(2) = -BTIM(2)-1 - - IER = SYS$ASCTIM(TLEN,TODAY_DATE,,) - CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM) - - CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM) - - RETURNT - END - - - - SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER) - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'' - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2I - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8O - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER LOCALNODE*8,RESPONSE*4 - - IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURNE - - CALL OPEN_BULLUSER_SHARED - - REMOTE_FOUND = .FALSE.A - TEMP_USER = ':' - - DO WHILE (.NOT.REMOTE_FOUND)e - DO WHILE (REC_LOCK(IER)) N - READ (4,KEYGT=TEMP_USER,IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAGC - END DO - IF (TEMP_USER(:1).NE.':') THEN - CALL CLOSE_BULLUSER - RETURNI - END IFT - REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER) - END DO - - CALL CLOSE_BULLUSER - -100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, - & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THEN= - IER = 0I - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (17,'(4A)',IOSTAT=IER)o - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127)) - I = I + 128 - END DO - IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER) - & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER: - ELSE - WRITE (6,'('' BULLCP not responding to request to'', - & '' broadcast to other nodes.'')') - CALL GET_INPUT_PROMPT(RESPONSE,LEN,d - & 'Want to try again? (Y/N with Y as default): ')O - IF (RESPONSE(:1).NE.'n'.AND.RESPONSE(:1).NE.'N') THEN= - WRITE (6,'('' Trying again...'')') - GO TO 100 - ELSE - WRITE (6,'('' Broadcast aborting. '', - & ''Continuing with message addition.'')')i - END IF - END IFy - - CLOSE (UNIT=17) - - RETURN - END - - - - - INTEGER FUNCTION ERROR_TRAP - - ERROR_TRAP = 1F - - RETURNR - END - - - - SUBROUTINE REPLYI - - IMPLICIT INTEGER (A - Z)( - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'F - - COMMON /INDESCRIP/ INDESCRIP - CHARACTER*(INPUT_LENGTH) INDESCRIPn - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been readr - WRITE(6,'('' ERROR: You have not read any message.'')')N - RETURN ! And returnA - END IFe - - CALL OPEN_BULLDIR_SHAREDL - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletinG - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Bulletin was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF& - - CALL OPEN_BULLFIL_SHAREDM - - ILEN = LINE_LENGTH + 1I - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)L - END IFL - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INDESCRIP = INPUT(7:) - ELSEr - INDESCRIP = DESCRIP - END IFT - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR. - - WRITE (6,'('' Adding REPLY message with the subject:'')') - IF (STREQ(INDESCRIP(:3),'RE:')) THENC - INDESCRIP = 'RE:'//INDESCRIP(4:) - ELSE) - INDESCRIP = 'RE: '//INDESCRIP_ - END IF - WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP))_ - - CALL ADDn - - RETURNg - END - - - - - SUBROUTINE CRELNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z)B - - INCLUDE '($PSLDEF)' - - INCLUDE '($LNMDEF)' - - CHARACTER*(*) INPUT,OUTPUT - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT)) - CALL END_ITMLST(CRELNM_ITMLST)l - - IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER, - & %VAL(CRELNM_ITMLST)) - - RETURN: - END - - - - SUBROUTINE GETPRIV -C -C SUBROUTINE GETPRIV( -CO -C FUNCTION: -C To get process privileges. -C OUTPUTS:D -C PROCPRIV - Returned privileges -CT - - IMPLICIT INTEGER (A-Z) - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /REALPROC/ REALPROCPRIV(2) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoC - - REALPROCPRIV(1) = PROCPRIV(1) - REALPROCPRIV(2) = PROCPRIV(2) - - RETURNI - END - - - - - LOGICAL FUNCTION SETPRV_PRIV - IMPLICIT INTEGER (A-Z)h - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - DATA NEEDPRIV/0,0/C - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC's - - INCLUDE 'BULLFILES.INC' - - IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - CALL READ_USER_FILE_HEADER(IER)s - CALL CLOSE_BULLUSERo - NEEDPRIV(1) = USERPRIV(1)( - NEEDPRIV(2) = USERPRIV(2)E - END IFD - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR.R - & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN( - SETPRV_PRIV = .TRUE. - ELSE$ - SETPRV_PRIV = .FALSE. - END IF - - RETURN - END - - - - LOGICAL FUNCTION OPER_PRIVR - IMPLICIT INTEGER (A-Z) - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - INCLUDE '($PRVDEF)' - OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER) - RETURNG - END - - - O - SUBROUTINE GETUSER(USERNAME)T -CI -C SUBROUTINE GETUSER) -C -C FUNCTION: -C To get username of present process.D -C OUTPUTS:1 -C USERNAME - Username owner of present process. -C( - - IMPLICIT INTEGER (A-Z)U - - INCLUDE '($PRVDEF)' - - CHARACTER*(*) USERNAME ! Limit is 12 charactersI - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistB - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info' - - RETURN - END - - - - - LOGICAL FUNCTION CAPTIVE(FLAG)P - - IMPLICIT INTEGER (A - Z) - - INCLUDE '($UAIDEF)' - - INCLUDE 'BULLUSER.INC' - - DATA READ_UAI/.FALSE./E - - COMMON /BULL_CUSTOM/ BULL_CUSTOM, - - IF (BTEST(BULL_CUSTOM,FLAG)) THEN , - CAPTIVE = .FALSE.R - RETURN - END IFN - - TYPE = 1E - - IF (.NOT.READ_UAI) THEN - CALL INIT_ITMLST - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))( - CALL END_ITMLST(GETUAI_ITMLST) - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - READ_UAI = .TRUE.I - END IFD - - CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0 - & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1) - - RETURNA - END - - - - - SUBROUTINE SPAWN_PROCESS - - IMPLICIT INTEGER (A - Z)T - - COMMON /KEYPAD/ KEYPAD_MODE - - CHARACTER*256 COMMAND - - IF (CAPTIVE(-1)) THEN - WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')')L - RETURN - END IF - - CALL DISABLE_PRIVSR - - SAVE_KEYPAD_MODE = KEYPAD_MODE - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (CLI$PRESENT('COMMAND')) THENS - CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN) - COMMAND = '$'//COMMAND(:CLEN)L - CALL LIB$SPAWN(COMMAND(:CLEN+1)) - ELSE0 - CALL LIB$SPAWN()n - END IFr - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPADs - - CALL ENABLE_PRIVS - - RETURNE - ENDt - - - SUBROUTINE ATTACH - - IMPLICIT INTEGER (A - Z)o - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /TERM_CHAN/ TERM_CHAN) - - INCLUDE '($JPIDEF)' - - CHARACTER*15 PROCESSf - - IF (CLI$PRESENT('PROCESS')) THENn - CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN) - - CALL INIT_ITMLST ! Initialize item listR - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,)R - ELSEV - CALL INIT_ITMLST ! Initialize item lists - CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)R - END IF0 - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - SAVE_KEYPAD_MODE = KEYPAD_MODEI - IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD - - IF (IER) IER = LIB$ATTACH(PROCESS_ID) - IF (.NOT.IER) CALL SYS_GETMSG(IER) - - IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD. - - RETURNT - END( - - - - - - SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL) - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - -C, -C The largest message that can be broadcasted is dependent on system, -C and user quotas. The following limit is 12 lines of ( 80 characters +E -C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts -C shouldn't be too large anyway.B -CD - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7)R - - PARAMETER BRDCST_LIMIT = 82*12 + 2 + 2N - CHARACTER*(BRDCST_LIMIT) BROADD - - COMMON /BROAD_MESSAGE/ BROAD,BLENGTHL - - IF (RING_BELL) THEN ! Include BELL in message?R - BROAD(:36) = ! Say who the bulletin is from - & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROMO - BLENGTH = 37 ! Start adding next line here - ELSE - BROAD(:34) = ! Say who the bulletin is fromU - & CR//LF//LF//'NEW BULLETIN FROM: '//FROM - BLENGTH = 35 ! Start adding next line here - END IFR - - IF (REMOTE_SET) REWIND (UNIT=3) - - END = 0 - ILEN = LINE_LENGTH + 1N - I = 0 - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (REMOTE_SET) THEN - READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUTO - IF (IER.NE.0) RETURN' - ELSE - CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN)E - END IF - IF (ILEN.GT.0) I = I + 1 - IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND. - & INPUT(:6).NE.'Subj: '))) THEN - END = BLENGTH + ILEN - 1 + 2 ! Check how long string will beG - IF (END.GT.BRDCST_LIMIT) RETURN ! String too long?6 - BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input - BLENGTH = END + 1 ! Reset pointer - END IF - END DOE - - RETURN - - ENTRY BROADCAST(ALL,CLUSTER) - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - IF (ALL) THEN ! Should we broadcast to ALL?. - IF (CLUSTER) THEN1 - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLTERMS),,,,,%VAL(5),,) - END IF - ELSE ! Else just broadcast to users. - IF (CLUSTER) THENE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,%VAL(5),,) - ELSE - CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,, - & %VAL(BRK$C_ALLUSERS),,,,,%VAL(5),,)e - END IF - END IF, - - CALL SYS$SETRWM(%VAL(0)) - - RETURN. - END - - - SUBROUTINE GET_FOLDER_INFO(IER) -C -C SUBROUTINE GET_FOLDER_INFOC -C -C FUNCTION: Obtains & verifies folder names from command line. -CR - - IMPLICIT INTEGER (A-Z)s - - INCLUDE 'BULLFOLDER.INC', - - EXTERNAL CLI$_ABSENTn - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10)M - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - CHARACTER NODE_TEMP*256 - - NODE_NUM = 0 ! Initialize number of nodesU - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',NODE_TEMP)S - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP)I - DO WHILE (TRIM(NODE_TEMP).GT.0)( - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',')R - IF (COMMA.GT.0) THENE - NODES(NODE_NUM) = NODE_TEMP(:COMMA-1) - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSE( - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IF - NLEN = TRIM(NODES(NODE_NUM))T - IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THENS - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL' - END IF - FOLDER_NUMBER = -1T - FOLDER1 = NODES(NODE_NUM) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THENN - WRITE (6,'('' Unable to access folder '',A)') - & NODES(NODE_NUM) - RETURNO - ELSE IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No write access for folder '',A)') - & NODES(NODE_NUM)t - IER = 0 - RETURN - END IFE - END DO - END DOP - - IER = 1 - - RETURNN - END diff --git a/decus/vax92b/bulletin/bulletin0.for b/decus/vax92b/bulletin/bulletin0.for deleted file mode 100644 index e981400..0000000 --- a/decus/vax92b/bulletin/bulletin0.for +++ /dev/null @@ -1,1896 +0,0 @@ -C -C BULLETIN0.FOR, Version 11/24/92 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE DELETE_MSG -C -C SUBROUTINE DELETE_MSG -C -C FUNCTION: Deletes a bulletin entry from the bulletin file. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - COMMON /DECNET/ DECNET_PROC,ERROR_UNIT - LOGICAL DECNET_PROC - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER ANSWER*4,REMOTE_USER*12,SUBJECT*56 - - INTEGER NOW(2) - - IMMEDIATE = 0 - IF (CLI$PRESENT('IMMEDIATE')) THEN - IF (REMOTE_SET.EQ.4) THEN - WRITE (6,'('' IMMEDIATE not valid for news group.'')') - RETURN - ELSE - IMMEDIATE = 1 - END IF - END IF - - IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node? - CALL DELETE_NODE ! Yes... - RETURN - ELSE IF (DECNET_PROC) THEN ! Is this from remote node? - IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN) - CALL STR$UPCASE(SUBJECT,SUBJECT) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - DEL_BULL = 0 - IER = 1 - DO WHILE (DEL_BULL+1.EQ.IER) - DEL_BULL = DEL_BULL + 1 - CALL READDIR(DEL_BULL,IER) - CALL STR$UPCASE(DESCRIP,DESCRIP) - IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM - & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN - CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE) - CALL CLOSE_BULLDIR - WRITE (5,'(''END'')') ! Tell DECNET that delete went ok. - RETURN - END IF - END DO - CALL CLOSE_BULLDIR ! Specified message not found, - WRITE(ERROR_UNIT,1030) ! so error out. - RETURN - END IF - -C -C Get the bulletin number to be deleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE - SBULL = BULL_POINT ! Delete the file we are reading - EBULL = SBULL - IER = 0 - END IF - - IF (SBULL.LE.0.OR.IER.NE.0) THEN - WRITE (6,1020) - RETURN - ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND. - & SBULL.NE.EBULL) THEN - WRITE (6,'('' Last message specified > number in folder.'')') - WRITE (6,'('' Do you want to delete to end of folder? '',$)') - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') THEN - WRITE (6,'('' Deletion aborted.'')') - RETURN - ELSE - EBULL = F_NBULL - END IF - END IF - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -C - - IF (REMOTE_SET) THEN - IF (SBULL.NE.EBULL) THEN - WRITE (6,1025) - RETURN - END IF - IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER) - CALL REMOTE_DELETE(SBULL,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,) - NEWEST_EXDATE = INPUT(:11) - NEWEST_EXTIME = INPUT(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE IF (IER.NE.0) THEN - CALL DISCONNECT_REMOTE - END IF - RETURN - END IF - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - BULL_DELETE = SBULL - 1 - DO WHILE (BULL_DELETE.LT.EBULL) - BULL_DELETE = BULL_DELETE + 1 - DO WHILE (BULL_DELETE+1.NE.IER) - CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - IF (REMOTE_SET.EQ.4) THEN - BULL_DELETE = BULL_DELETE + 1 - IF (BULL_DELETE.GT.EBULL) THEN - CALL CLOSE_BULLDIR - RETURN - END IF - ELSE - IF (.NOT.CLI$PRESENT('ALL')) WRITE(6,1030) - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - END IF - END DO - - IF (USERNAME.NE.FROM.OR.(REMOTE_SET.EQ.4.AND. - & .NOT.TEST_NEWS_OWNER())) THEN ! If not owner of message - CALL STR$UPCASE(REMOTE_USER,FROM) - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges? - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN - WRITE(6,1040) ! No, then error out. - CALL CLOSE_BULLDIR - RETURN - ELSE IF (SBULL.EQ.EBULL) THEN - IF (TRIM(FROM).EQ.1) THEN - CALL OPEN_BULLFIL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - CALL CLOSE_BULLFIL - ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: ' - ELSE - ASK = REMOTE_USER.EQ.FROM - END IF - IF (ASK) THEN - CALL CLOSE_BULLDIR - WRITE (6,1050) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER - CALL STR$UPCASE(ANSWER,ANSWER) - IF (ANSWER(:1).NE.'Y') RETURN - CALL OPEN_BULLDIR - CALL READDIR(BULL_DELETE,IER) - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found? - WRITE(6,1030) ! If not, then error out - CALL CLOSE_BULLDIR - RETURN - END IF - END IF - END IF - END IF - -C -C Delete the bulletin directory entry. -C - CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - IF (REMOTE_SET.EQ.4) THEN - IF (.NOT.CLI$PRESENT('LOCAL').AND.TEST_NEWS_OWNER()) THEN - CALL REMOTE_DELETE - & (BULL_DELETE,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER) - END IF - END IF - END DO - - CALL CLOSE_BULLDIR - RETURN - -1010 FORMAT(' ERROR: You are not reading any message.') -1020 FORMAT(' ERROR: Specified message number has incorrect format.') -1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.') -1030 FORMAT(' ERROR: Specified message was not found.') -1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.') -1050 FORMAT(' Message is not owned by you.', - & ' Are you sure you want to delete it? ',$) - - END - - - - SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INTEGER NOW(2) - - IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately - - CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry - - IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin? - SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count - END IF - ELSE ! Delete it eventually -C -C Change year of expiration date of message to 100 years less, -C to indicate that message is to be deleted. Then, set expiration date -C in header of folder to 15 minutes from now. Thus, the folder will be -C checked in 15 minutes (or more), and will delete the messages then. -C -C NOTE: If some comic set their expiration date to > 1999, then -C the deleted date will be set to 1899 since can't specify date <1859. -C - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'18'//EXDATE(10:) - IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99' - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'19'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - END IF - END IF - - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date - - IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from nows - IER = SYS$GETTIM(NOW)r - IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM)r - IER = SYS$ASCTIM(,INPUT,EX_BTIM,) - - END IF - - IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN - CALL READDIR(0,IER) ! Get header - - NEWEST_EXDATE = INPUT(:11) ! and store new expiration date - NEWEST_EXTIME = INPUT(13:23) - - CALL WRITEDIR(0,IER) - IF (REMOTE_SET.EQ.4) THENO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS - END IF - ELSE IF (BULL_DELETE.EQ.EBULL) THEN - IF (REMOTE_SET.NE.4) CALL CLEANUP_DIRFILE(SBULL) - ! Reorder directory file - - CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest - ! bulletin and expired dates.M - - IF (REMOTE_SET.NE.4.AND.SBULL.LE.BULL_POINT) THENW - IF (BULL_POINT.GT.EBULL) THEN - BULL_POINT = BULL_POINT - (EBULL - SBULL + 1)A - ELSEN - BULL_POINT = SBULL - 1P - END IF) - END IF ! Readjust where which bulletin to read next - ! if deletion causes messages to be moved. - END IF - - RETURNm - END - - - - - - SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER) - - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLFOLDER.INC'I - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) INPUT - - DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-'))L - - IF (DELIM.EQ.0) THEN - DECODE(ILEN,'(I)',INPUT,IOSTAT=IER) SVAL - EVAL = SVALP - ELSE - DECODE(DELIM-1,'(I)',INPUT,IOSTAT=IER) SVAL - CALL STR$UPCASE(INPUT,INPUT) - IF (IER.NE.0) THEN - IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN - SVAL = BULL_POINT - IER = 0 - END IFE - END IF - IF (IER.EQ.0) THEN - ILEN = ILEN - DELIM - DECODE(ILEN,'(I)',INPUT(DELIM+1:),IOSTAT=IER) EVALo - IF (IER.NE.0) THENN - IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THENl - EVAL = F_NBULL - IER = 0I - ELSE IF (INDEX('CURRENT', - & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN - EVAL = BULL_POINTL - IER = 0I - END IFN - END IF - END IF - IF (EVAL.LT.SVAL) IER = 2E - END IFE - - RETURNL - END - - ) - - SUBROUTINE DIRECTORY(DIR_COUNT) -Ci -C SUBROUTINE DIRECTORYN -Ct -C FUNCTION: Display directory of messages.U -CP - IMPLICIT INTEGER (A - Z)a - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'. - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGU - - DATA SCRATCH_D1/0/A - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILESU - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /POST/ POSTTIME - - COMMON /NEXT/ NEXTL - - COMMON /NEW_DIR/ NEWL - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILESe - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER DATETIME*24,SEARCH_STRING*80,HEADLINE*132 - - INTEGER TODAY(2) - - CHARACTER*9 EXPIRES,DIR_TYPEW - - CHARACTER TIMBUF*13 - DATA TIMBUF/'0 00:00:05.00'/ - - INTEGER TIMADR(2) ! Buffer containing time - - DATA WAITEFN /0/ - - NEXT = .TRUE. - - IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN)D - IER=SYS$BINTIM(TIMBUF,TIMADR)T - N - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (INCMD(:3).EQ.'DIR') THENM - IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN. - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED')) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - ELSE IF (CLI$PRESENT('UNSEEN')) THENE - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)T - ELSE IF (CLI$PRESENT('ALL')) THEN - READ_TAG = IBSET(0,1) + IBSET(0,2)) - IF (REMOTE_SET.GE.3) THEN - BULL_POINT = F_START - 1 - ELSEu - BULL_POINT = 0 - END IFO - END IF - IF (READ_TAG) THENE - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.GE.3)) THEN - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')'). - READ_TAG = IBSET(0,1) + IBSET(0,2) - GO TO 9999 - END IF - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT) - END IF - END IF - IF (.NOT.READ_TAG) THENA - SUBJECT = CLI$PRESENT('SUBJECT').OR.CLI$PRESENT('NOREPLIES')) - REPLY = CLI$PRESENT('REPLY') - REPLY_FIRST = REPLY - SEARCH = CLI$PRESENT('SEARCH')) - FROM_SEARCH = CLI$PRESENT('FROM') - ANY_SEARCH = SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH - END IF - PRINTING = CLI$PRESENT('PRINT')( - POSTTIME = CLI$PRESENT('POST') - NEW = CLI$PRESENT('NEW') - ELSE - PRINTING = .FALSE. - POSTTIME = .TRUE.I - END IFQ - -CH -C Directory listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C directory file, and to avoid the possibility of the user holding the screen, -C and thus causing the directory file to stay open. The temporary memory -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.E -CS - - CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY) - SCRATCH_D = SCRATCH_D1C - - CALL OPEN_BULLDIR_SHARED ! Get directory fileL - - CALL READDIR(0,IER) ! Does directory header exist?a - START = .FALSE. - IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages? - IF (DIR_COUNT.EQ.0) THEN - EXPIRATION = CLI$PRESENT('EXPIRATION') - IF (CLI$PRESENT('START')) THEN ! Start number specified?t - START = .TRUE. - IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) - DECODE(LEN_P,'(I)',BULL_PARAMETER) DIR_COUNTL - IF (DIR_COUNT.LT.1) THEN - WRITE (6,'('' ERROR: Invalid starting message.'')')E - CALL CLOSE_BULLDIR - DIR_COUNT = 0E - GO TO 9999 - END IF - ELSE IF (CLI$PRESENT('SINCE').OR.NEW) THENR - IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified? - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default.i - IER = SYS$BINTIM('-- 00:00:00.00',TODAY)a - CALL GET_MSGKEY(TODAY,MSG_KEY)O - ELSEw - CALL SYS_BINTIM(DATETIME,MSG_BTIM)F - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE IF (NEW) THEN ! was /NEW specified?E - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER)) - CALL CLOSE_BULLDIRT - GO TO 9999! - ELSEi - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1),r - & MSG_KEY) - END IF - CALL READDIR_KEYGE(IER) - ELSE - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THENi - WRITE (6,'('' No new messages are present in'', - & '' folder '',A,''.'')')e - & FOLDER_NAME(:TRIM(FOLDER_NAME))d - GO TO 9999 - END IF - END IFe - END IFd - - IF (IER.EQ.0) THEN - WRITE (6,'('' No messages past specified date.'')')m - CALL CLOSE_BULLDIR - GO TO 9999 - ELSEd - DIR_COUNT = IER - END IFc - ELSEf - DIR_COUNT = BULL_POINT - IF (DIR_COUNT.EQ.0) DIR_COUNT = 1 - END IF - - NEGATED = CLI$PRESENT('NEGATED') - IF (CLI$PRESENT('SEARCH')) THEN - IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('FROM')) THEN - IER1 = CLI$GET_VALUE('FROM',SEARCH_STRING,SLEN) - ELSE IF (CLI$PRESENT('REPLY')) THEN - SEARCH_STRING = ' ' - ELSE IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - NEGATED = .TRUE.r - END IF$ - - IF (READ_TAG) THENE - IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.FROM_SEARCH) THEN - WRITE (6,'('' ERROR: Qualifier not valid when '', - & ''displaying only tagged messages.'')') - SUBJECT = .FALSE. - REPLY = .FALSE. - FROM_SEARCH = .FALSE. - CALL CLOSE_BULLDIR - GO TO 9999 - END IFE - IF (.NOT.(CLI$PRESENT('SINCE').OR.NEWT - & .OR.START)) THENF - DIR_COUNT = 1 - END IFD - CALL READDIR(DIR_COUNT,IER1)U - IF (IER1.EQ.DIR_COUNT+1) IER1 = 0 - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THEN - MSG_NUM = DIR_COUNT-1 - ELSEi - CALL DECREMENT_MSG_KEY - END IF - END IF - - IF (START.AND.DIR_COUNT.GT.NBULL) THENt - IF (READ_TAG) THEN - SBULL = NBULL + 1) - GO TO 100 - ELSEN - START = .FALSE. - DIR_COUNT = NBULLN - END IF- - END IF - IF (CLI$PRESENT('SINCE').OR.NEW - & .OR.START) THEN - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1s - IF (EBULL.GE.NBULL-2) EBULL = NBULL - ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN - EBULL = NBULLZ - SBULL = NBULL - (PAGE_LENGTH-5) + 1I - IF (SBULL.LT.1) SBULL = 1T - ELSEM - SBULL = DIR_COUNTU - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1( - END IF, - ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN - SUBJECT = .FALSE. - REPLY = .FALSE. - SEARCH = .FALSE. - FROM_SEARCH = .FALSE.D - SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1) - IF (SBULL.LT.1) SBULL = 1 - EBULL = SBULL + (PAGE_LENGTH - 7) - 1 - IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN> - SBULL = NBULL - (PAGE_LENGTH-5) + 1 - EBULL = NBULL - IF (SBULL.LT.1) SBULL = 1( - END IFT - IF (REMOTE_SET.EQ.4.AND.SBULL.GT.F_START) THEN - NUM = EBULL - SBULL + 1 - I = EBULLN - NEXT = .FALSE. - DO WHILE (NUM.GT.0.AND.I.GE.F_START) - CALL READDIR(I,IER) - IF (I+1.EQ.IER) NUM = NUM - 1 - I = I - 1 - END DO - NEXT = .TRUE. - NUM = EBULL - SBULL + 1) - SBULL = I + 1( - IF (NUM.EQ.PAGE_LENGTH-7) THEN - IF (EBULL.LT.NBULL.AND.SBULL.EQ.F_START) THEN - I = EBULL - DO WHILE (I.LT.NBULL.AND.NUM.LE.PAGE_LENGTH-5) - I = I + 1 - CALL READDIR(I,IER) - IF (I+1.EQ.IER) NUM = NUM + 1 0 - END DO - IF (NUM.GT.PAGE_LENGTH-5) NUM = PAGE_LENGTH-7C - ELSE IF (EBULL.EQ.NBULL.AND.SBULL.GT.F_START) THEN - I = F_START - 1 - DO J = 1,3 - I = I + 1 - CALL READDIR(I,IER) - END DO - IF (MSG_NUM.GE.SBULL) THEN L - NUM = NUM + 2 - SBULL = F_START - END IF - END IFU - END IF - EBULL = SBULL + NUM - 1T - END IFE - ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THENS -100 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - FIRST_BULL = FIRST_BULL + 1 - DIR_COUNT = FIRST_BULL - IER1 = IERn - IER = 0 - FBULL = 0 - EBULL = 0 - LBULL = SBULL.GT.NBULL_ - DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0) - SBULL = SBULL - 1 - CALL READDIR(SBULL,IER) - IF (IER.EQ.SBULL+1) THENM - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY)P - IF (IER.EQ.0) THEN - IF (FBULL.EQ.0) EBULL = DIR_COUNT - FBULL = FBULL +1 - IF ((.NOT.LBULL.AND.FBULL.EQ.PAGE_LENGTH-7).OR. - & (LBULL.AND.FBULL.EQ.PAGE_LENGTH-5)) THEN - IER = 1 - END IFU - ELSE - IER = 0 - END IF - ELSE0 - IER = 1S - END IFR - END DOH - IF (DIR_COUNT.EQ.FIRST_BULL.AND..NOT.LBULL) THEN_ - CALL READDIR(EBULL,IER) - IER = 0 - DO WHILE (IER.EQ.0.AND.FBULL.LT.PAGE_LENGTH-7) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - IF (IER.EQ.0) THEN - FBULL = FBULL + 1 - EBULL = DIR_COUNT - END IF - END DO - DO I=1,3t - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY) - END DO - IF (IER.NE.0) THEN - EBULL = DIR_COUNTD - FBULL = FBULL + 2 - END IF - END IF - CALL READDIR(EBULL,IER) - IF (EBULL+1.NE.IER) THEN. - EBULL = EBULL + 1 - ELSE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY1) - IF (IER.NE.0) EBULL = EBULL + 1 - END IFE - CALL READDIR(SBULL,IER) - IF (REMOTE_SET.GE.3.OR.BTEST(READ_TAG,3)) THENO - MSG_NUM = MSG_NUM-1 - ELSEC - CALL DECREMENT_MSG_KEYO - END IFE - EBULL = SBULL + FBULL - 1 - ELSE - SBULL = DIR_COUNT - EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1 - IF (EBULL.GE.NBULL-2) EBULL = NBULL - END IF - IF (.NOT.PAGING.OR.PRINTING) EBULL = NBULL - IF (INCMD(:3).EQ.'DIR') THEN - IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN - DECODE(LEN_P,'(I)',BULL_PARAMETER) EBULL - EBULL = MIN(EBULL,NBULL) - END IF - END IF - IF (ANY_SEARCH) THEN - CONTINUED - ELSE IF (.NOT.REMOTE_SET.AND..NOT.READ_TAG) THEN - I1 = SBULLi - DO I = SBULL,EBULL - CALL READDIR(I1,IER) ! Into the queue - IF (IER.EQ.I1+1) THEN - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY)r - ELSE - EBULL = EBULL - 1I - END IF - I1 = I1 + 1e - END DO - ELSE IF (READ_TAG) THEN - I = 0 - DO WHILE (I.LE.EBULL.AND.IER1.EQ.0) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE)T - IF (I.EQ.0.AND.IER1.EQ.0) THEN_ - EBULL = EBULL - SBULL + DIR_COUNT - SBULL = DIR_COUNTN - I = SBULLT - END IFN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28)T - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)L - I = I + 1 - END DO - EBULL = I - 1 - IF (IER1.NE.0) THEN - EBULL = EBULL - 1 - ELSEE - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE) - IF (IER1.EQ.0) THEN - IER = 0A - EBULL_SAVE = EBULL - DO I=1,2 - IF (IER.EQ.0) THENS - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D, - & BULLDIR_ENTRY)C - EBULL = EBULL + 1 - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,F - & TAG_TYPE)W - END IF - END DO - IF (IER.NE.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL) - IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE( - IER1 = 1g - ELSE - EBULL = EBULL_SAVE' - END IF - END IF( - END IF - ELSE - CALL REMOTE_DIRECTORY_COMMAND - & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER) - IF (IER.NE.0) THEN& - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTEG - GO TO 9999S - END IF - END IF - ELSES - NBULL = 0 - END IFE - - IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THENe - CALL CLOSE_BULLDIR ! We don't need file anymore' - IF (READ_TAG) THEN - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unmarked' - ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN - DIR_TYPE = 'unseen' - ELSE IF (BTEST(READ_TAG,1)) THEN - DIR_TYPE = 'marked' - ELSE IF (BTEST(READ_TAG,2)) THEN - DIR_TYPE = 'seen' - END IFI - WRITE (6,'('' No '',A,'' messages are present in'', - & '' folder '',A,''.'')') - & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME))' - ELSE - WRITE (6,'('' There are no messages present.'')') - END IF - DIR_COUNT = -1 - GO TO 9999 - END IF - -C -C Directory entries are now in queue. Output queue entries to screen._ -CU - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'('' ['',I,''-'',I,'']'')')A - & F_START,F_NBULL - ELSE$ - WRITE (HEADLINE,'('' [1-'',I,'']'')') NBULLE - END IF - DO WHILE (INDEX(HEADLINE,'- ').GT.0)D - I = INDEX(HEADLINE,'- ') - HEADLINE(I+1:) = HEADLINE(I+2:)O - END DOO - DO WHILE (INDEX(HEADLINE,'[ ').GT.0)' - I = INDEX(HEADLINE,'[ ') - HEADLINE(I+1:) = HEADLINE(I+2:)t - END DOs - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:)A - END DOB - HEADLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//HEADLINET - BULL_PARAMETER = ' 'O - IF (READ_TAG) THENS - IF (BTEST(READ_TAG,1)) THENU - BULL_PARAMETER = 'MARKED' - ELSE - BULL_PARAMETER = 'SEEN' - END IF - IF (BTEST(READ_TAG,3)) THENS - BULL_PARAMETER = 'UN'//BULL_PARAMETER - END IF - END IF - IF (PRINTING) THENY - BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER - END IFD - WRITE (6,'(1X,A,X,A)') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & HEADLINE(:TRIM(HEADLINE))I - IF (EXPIRATION) THEN - WRITE(6,1005)' - ELSE. - WRITE(6,1000)R - END IFH - - TAG = (BULL_TAG.AND.REMOTE_SET.EQ.0).OR.I - & (BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) - - IF (.NOT.ANY_SEARCH.AND.TAG.AND..NOT.READ_TAG) THEN - IF (INCMD(:3).NE.' ') THEN - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to headerE - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY) - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE)H - IF (IER.NE.0) NEXT_TAG = NBULL + 1R - END IF - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - DO I=SBULL,EBULL - SAVE_SCRATCH_D = SCRATCH_D - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)E - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28) - CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY) - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - END IFR - END DO - END IFU - - CALL CLOSE_BULLDIR ! We don't need file anymore - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header - - I = SBULL - START_SEARCH = I - IF (.NOT.REPLY_FIRST) THEN - START_SEARCH = I - 1 - ELSE IF (.NOT.CLI$PRESENT('START')) THEN - START_SEARCH = BULL_POINT - END IFL - IF (ANY_SEARCH.OR.PRINTING) THEN - CALL OPEN_BULLDIR_SHARED - IF (SEARCH.OR.PRINTING) CALL OPEN_BULLFIL_SHARED - CLOSED_FILES = .FALSE. - END IFE - DO WHILE (I.LE.EBULL) - IF (.NOT.ANY_SEARCH) THENA - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)L - ELSE - IF (CLOSED_FILES) THENM - CLOSED_FILES = .FALSE. - CALL OPEN_BULLDIR_SHARED( - IF (SEARCH.OR.PRINTING) CALL OPEN_BULLFIL_SHARED - END IFI - CALL GET_SEARCH(FOUND,SEARCH_STRING,START_SEARCH,.FALSE. - & ,SUBJECT,REPLY_FIRST,.FALSE.,.TRUE.,FROM_SEARCH, - & NEGATED) - IF (INCMD(:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG, - & TAG_TYPE) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - CALL READDIR(FOUND,IER) - END IFU - REPLY_FIRST = .FALSE. - IF (FOUND.GT.0) THENA - SEARCH_STRING = ' ' - START_SEARCH = FOUND_ - IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN_ - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY) - IF (IER.NE.0) NEXT_TAG = NBULL + 1 - CALL READDIR(FOUND,IER) - SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28). - TAG_TYPE = DUMMY - END IF - ELSEI - I = EBULL + 1 - END IFM - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,) - END IF - IF (I.LE.EBULL) THEN - CALL CONVERT_ENTRY_FROMBIN_FOLDER - IF (BTEST(SYSTEM,30)) THEN - WRITE (6,'('' >'',$)')E - ELSE- - WRITE (6,'('' '',$)')A - END IFE - IF (BTEST(SYSTEM,29)) THEN - WRITE (6,'(''+*'',$)') - ELSE - WRITE (6,'(''+ '',$)')E - END IF - N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3)R - IF ((EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0)L - & .AND.REMOTE_SET.NE.3) THEN - WRITE(6,2010) MSG_NUM,DESCRIP(:54-N),FROM,'(DELETED)'N - ELSE IF (EXPIRATION) THEN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin?U - EXPIRES = 'Shutdown' - ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin?, - EXPIRES = 'Permanent'D - ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN - EXPIRES = 'Unknown' - ELSE - EXPIRES = EXDATE(:7)//EXDATE(10:11)I - END IF - WRITE(6,2010) MSG_NUM,DESCRIP(:54-N),FROM,EXPIREST - ELSED - WRITE(6,2010) MSG_NUM,DESCRIP(:54-N),FROM, - & DATE(:7)//DATE(10:11)C - END IFL - IF (PRINTING) THENE - FOUND_MSG = .TRUE.G - CALL SYS$SETAST(%VAL(0))N - CALL PRINT(MSG_NUM,CLOSED_FILES) - CALL SYS$SETAST(%VAL(1))U - END IFU - END IF - I = I + 1U - IF (ANY_SEARCH) IER = SYS$CANTIM(,)+ - END DON - - DIR_COUNT = MSG_NUM + 1 ! Update directory counter - - IF (ANY_SEARCH.OR.PRINTING) THENI - IF (SEARCH.OR.PRINTING) CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - IF (ANY_SEARCH) THEN - IF (FOUND.GT.0) THENE - DIR_COUNT = FOUND + 1M - ELSE - DIR_COUNT = NBULL + 1) - END IF - END IF - END IF( - - IF (DIR_COUNT.GT.NBULL.OR.(READ_TAG.AND.IER1.NE.0)) THENS - ! Outputted all entries? - DIR_COUNT = -1 ! Yes. Set counter to -1. - IF (PRINTING.AND.CLI$PRESENT('NOW').AND.FOUND_MSG) THEN1 - INCMD = 'PRINT/NOW' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL PRINT(MSG_NUM,CLOSED_FILES) - END IF - ELSE - WRITE(6,1010) ! Else say there are more - END IFE - -9999 POSTTIME = .FALSE. - NEXT = .FALSE. - RETURNL - -1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/) -1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/)B -1010 FORMAT(1X,/,' Press RETURN for more...',/)I - -2010 FORMAT('+',I,1X,A<54-N>,1X,A12,1X,A9)M - - END - - - SUBROUTINE CLOSE_FILES - - IMPLICIT INTEGER (A-Z)( - - COMMON /CLOSE_FILES_INFO/ CLOSED_FILES= - - INQUIRE(UNIT=1,OPENED=IER)E - IF (IER) CALL CLOSE_BULLFIL - - INQUIRE(UNIT=2,OPENED=IER)B - IF (IER) CALL CLOSE_BULLDIR - - CLOSED_FILES = .TRUE. - - RETURNE - END - - - - SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY) - - IMPLICIT INTEGER (A-Z)= - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT)) - - DO I=1,8 - MSG_KEY(I:I) = INPUT(9-I:9-I)R - END DOC - - RETURN - END - - - - SUBROUTINE FILE -CE -C SUBROUTINE FILE -C -C FUNCTION: Copies a bulletin to a file. -CR - IMPLICIT INTEGER (A - Z)E - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'L - - EXTERNAL CLI$_ABSENTE - - CHARACTER*128 FILENAME - - IF (CAPTIVE(1)) THEND - WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')') - RETURN - END IFT - - OPENED = .FALSE.C - -10 IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?U - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)! - IF (EBULL.GT.F_NBULL) EBULL = F_NBULLT - ELSE IF (OPENED) THEN - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - RETURN - ELSE IF (CLI$PRESENT('ALL')) THEN - SBULL = 1 - EBULL = F_NBULLE - IER = 0E - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE' - SBULL = BULL_POINT - EBULL = SBULL - IER = 0o - END IF, - - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN( - WRITE (6,1015) - IF (OPENED) THEN - CALL CLOSE_BULLFILs - CALL CLOSE_BULLDIR - CLOSE (UNIT=3) ! Bulletin copy completed - END IF - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P)t - RETURN - END IF - - IF (.NOT.OPENED) THEN - IER = CLI$GET_VALUE('FILESPEC',FILENAME,LEN_F) - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified - WRITE(6,1020) ! Write errorI - RETURN ! And return - END IF - - CALL DISABLE_PRIVS - - IF (CLI$PRESENT('NEW')) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900,N - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),IOSTAT=IER, - & RECL=LINE_LENGTH,E - & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=FILENAME(:LEN_F),ERR=900, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - ELSE IF (CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12) - END IFE - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesE - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - END IFH - - OPENED = .TRUE. - - FIRST = .TRUE.R - - DO FBULL = SBULL,EBULL - FBULL1 = FBULL - CALL READDIR(FBULL,IER) ! Get info for specified bulletin. - - IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT. - & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN - IF (REMOTE_SET.LT.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1E - IF (FBULL1.GT.SBULL) GO TO 100H - CLOSE (UNIT=3,STATUS='DELETE') - CALL CLOSE_BULLFILC - CALL CLOSE_BULLDIRE - RETURNC - ELSE IF (REMOTE_SET) THEN_ - CALL REMOTE_READ_MESSAGE(FBULL,IER1)R - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTE - ELSEt - CALL GET_REMOTE_MESSAGE(IER1)E - END IFV - IF (IER1.NE.0) GO TO 100C - END IF - - IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN - WRITE (3,'(A)') CHAR(12)G - ELSE IF (FIRST) THEN - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)_ - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THENS - WRITE(3,1060) FROM,DATE//' '//TIME(:8)I - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into fileL - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - END DOE - -100 IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F)E - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,)M - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):), - & FILENAME(:LEN_F)R - END IF( - ! Show name of file created.& - - GO TO 10E - -900 WRITE(6,1000). - CALL ENABLE_PRIVS ! Reset BYPASS privilegesN - RETURN - -1000 FORMAT(' ERROR: Error in opening file.') -1010 FORMAT(' ERROR: You have not read any bulletin.') -1015 FORMAT(' ERROR: Specified message number has incorrect format:') -1020 FORMAT(' ERROR: No file name was specified.') -1030 FORMAT(' ERROR: Following bulletin was not found: ',I) -1040 FORMAT(' Message ',A,' written to ',A)S -1045 FORMAT(' Messages ',A,'-',$) -1046 FORMAT('+',A,' written to ',A) -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,/,'Date: ',A) - - END - - - - SUBROUTINE COPY2(OUT,IN)F - - CALL LIB$MOVC3(8,IN,OUT) - - RETURNO - END - - - - SUBROUTINE LOGIN -CI -C SUBROUTINE LOGINT -C -C FUNCTION: Alerts user of new messages upon logging in.' -C' - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFILES.INC'W - E - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /READIT/ READITS - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING0 - - COMMON /POINT/ BULL_POINT - - COMMON /PROMPT/ COMMAND_PROMPTI - CHARACTER*40 COMMAND_PROMPT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)t - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY*24,INREAD*1 - - LOGICAL*1 CTRL_G/7/ - - DATA GEN_DIR1/0/ ! General directory link list header - DATA SYS_DIR1/0/ ! System directory link list header- - DATA SYS_NUM1/0/ ! System message number link list header - DATA SYS_BUL1/0/ ! System bulletin link list header - DATA ALL_DIR1/0/ ! Full directory link list header (for remote) - - DATA PAGE/0/Y - - DATA FIRST_WRITE/.TRUE./D - LOGICAL FIRST_WRITE - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)A - - DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2) - DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2)R - DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2) - - FOLDER_NAME = FOLDERL - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM) - CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM) - -CU -C Find user entry in BULLUSER.DAT to update information and -C to get the last date that messages were read. -Cn - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_HEADER(IER) ! Get the header - - IF (IER.EQ.0) THEN ! Header is present. - UNLOCK 4 - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - ! Find if there is an entryT - IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN - NEW_FLAG(2)=0 ! If old version clear GENERIC value - NEW_FLAG(1)=143 ! Set new version number - END IF - IF (IER1.EQ.0) THEN ! There is a user entry' - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN0 - ! DISMAIL or SET LOGIN set - IF (CLI$PRESENT('ALL')) THEN - CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1)) - ELSEC - RETURN ! Don't notify - END IF - END IFI - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM)P - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - REWRITE (4) USER_ENTRYT - IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1 - DO I = 1,FLONGG - IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR.I - & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1 - END DOI - ELSE - CALL CLEANUP_LOGIN ! Good time to delete dead usersO - CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry - DO I = 1,FLONGE - SET_FLAG(I) = SET_FLAG_DEF(I) - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)A - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I) - END DOO - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) - IF (DISMAIL.EQ.1) THENE - CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM) - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - ELSEA - CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM) - CALL COPY2(LOGIN_BTIM,TODAY_BTIM) - DO I = 1,FLONG - IF (SET_FLAG(I).NE.0) READIT = 1 - END DO - IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0 - ! Old password change indicates user is new to BULLETIN - ! but not to system, so don't limit message viewing. - END IFB - CALL WRITE_USER_FILE(IER) - IF (IER.NE.0) THEN ! Error in writing to user file - WRITE (6,1070) ! Tell user of the error - CALL CLOSE_BULLUSER ! Close the user file - CALL EXIT ! Go away...l - END IFT - IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set - DIFF = -1 ! Force us to look at messages - CALL OPEN_BULLINF_SHARED. - DO I=1,FOLDER_MAX - CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM)L - END DOs - WRITE (9,IOSTAT=IER) USERNAME,O - & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX) - CALL CLOSE_BULLINF_ - END IF - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header - END IFE - - IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM)i - & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail? - CALL COPY2(BBOARD_BTIM,TODAY_BTIM) - REWRITE (4) USER_HEADER ! Rewrite headerN - IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD')& - ELSE IF (IER.NE.0) THEN - CALL CLOSE_BULLUSERR - CALL EXIT ! If no header, no messages= - END IF: - - IF (IER1.EQ.0) THEN ! Skip date comparison if new entryS -CL -C Compare and see if messages have been added since the last time -C that the user has logged in or used the BULLETIN facility.& -C - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM) - IF (DIFF1.LT.0) THEN ! If read messages since last login, - CALL COPY2(LOGIN_BTIM,READ_BTIM)I - ! then use read date to compare with latest bulletin datei - END IF ! to see if should alert user. - - IF (SYSTEM_SWITCH) THEN - DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM) - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM)L - END IF - END IFL - - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ - ( - IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THENN - CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER)) - CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(:4),IER)B - ELSE IF (DIFF1.GT.0) THEN - BULL_POINT = -1S - IF (READIT.EQ.1) THENO - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL READ_IN_FOLDERS - CALL MODIFY_SYSTEM_LIST(1) - END IF - CALL CLOSE_BULLUSERR - RETURN - END IF0 - - CALL READ_IN_FOLDERSS - CALL MODIFY_SYSTEM_LIST(1) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER. - - ENTRY LOGIN_FOLDERN - - IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE) - END IF - - IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote - ! info, not local login timeU - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN) - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1)) - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0, - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0S - ELSE - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1))Q - IF (DIFF1.LT.0) THEN - CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1))I - ELSED - DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM)I - IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min - IER = SYS$BINTIM('0 00:15',BULLCP_BTIM) - BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta timeD - BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1 - CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM) - END IFB - END IF( - END IF - END IFM - - ENTRY SHOW_SYSTEM - - JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR. - & (BTEST(FOLDER_FLAG,2) - & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER) - & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))B - - NGEN = 0 ! Number of general messages - NSYS = 0 ! Number of system messages( - BULL_POINT = -1 - - IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN, - IF (LOGIN_SWITCH) THEN - IF (READIT.EQ.1) THEN - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) - CALL UPDATE_READ(1)u - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM)O - END IFs - CALL CLOSE_BULLUSER - END IF - RETURN ! Don't overwhelm new user with lots of non-general msgs: - END IFg - - IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN - ! Can folder have SYSTEM messages and /SYSTEM specified?0 - CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time0 - ! for system messages. - END IF - - IF (LOGIN_SWITCH) THEN, - IF (READIT.EQ.1) THENN - CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM) - CALL UPDATE_READ(1) - CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM) - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD) - END IF - CALL CLOSE_BULLUSERI - END IF - - IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0.AND.REMOTE_SET.LT.3) THENO - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THENL - DIFF1 = COMPARE_BTIM(LOGIN_BTIM, - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))P - IF (DIFF1.LT.0) THENG - CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1))P - END IF4 - CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1),L - & LOGIN_BTIM_NEW)O - END IF - - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)O - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THENA - IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999 - END IF - END IFD - - CALL OPEN_BULLDIR_SHARED ! Get bulletin directory - IF (.NOT.REMOTE_SET) THEN - CALL READDIR(0,IER) ! Get header info - ELSE - NBULL = F_NBULL1 - END IFt - - CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY) - CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT))l - GEN_DIR = GEN_DIR1_ - SYS_DIR = SYS_DIR1o - SYS_NUM = SYS_NUM1f - START = 1 - REVERSE = 0 - IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR.R - & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER)) - & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - IF (REVERSE_SWITCH) REVERSE = 1G - IF (IER1.EQ.0) THENM - CALL GET_NEWEST_MSG(LOGIN_BTIM,START) - IF (START.EQ.-1) START = NBULL + 1, - END IF - END IFr - - IF (REMOTE_SET) THENT - CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY)O - ALL_DIR = ALL_DIR1 - CALL REMOTE_DIRECTORY_COMMAND(START,NBULL, - & .NOT.REVERSE,ALL_DIR,IER)i - IF (IER.NE.0) THEN - CALL CLOSE_BULLDIR - CALL DISCONNECT_REMOTEe - GO TO 9999 - END IF - LAST_DIR = ALL_DIR - ALL_DIR = ALL_DIR1 - END IFe - - DO ICOUNT1 = NBULL,START,-1 - IF (REVERSE) THEN - ICOUNT = NBULL + START - ICOUNT1( - ELSE - ICOUNT = ICOUNT1r - END IF - IF (REMOTE_SET) THEN - IF (ALL_DIR.EQ.LAST_DIR) GO TO 100W - CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY)F - IER = ICOUNT + 1s - ELSE - CALL READDIR(ICOUNT,IER)T - END IF - IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user?T - IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date - IF (DIFF.GT.0) GO TO 100 - END IFD - IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1) - ! Show system msg in non-system folder as general msg - IF (USERNAME.NE.FROM.OR.SYSTEM) THENL - ! Is bulletin system or from same user? - IF (SYSTEM) THEN ! Is it system bulletin? R - NSYS = NSYS + 1. - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)E - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT)) - ELSE IF (.NOT.JUST_SYSTEM) THENa - IF (BTEST(FOLDER_FLAG,7)) THEN - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)N - ELSE IF (.NOT.SYSTEM_SWITCH) THEN - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM)D - END IF - IF (DIFF.LT.0) THEN. - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 1N - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.D - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100G - END IF= - NGEN = NGEN + 1 - SYSTEM = ICOUNT - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IF - END IF - END IFm - ELSE IF (IER.EQ.ICOUNT+1) THEN - ! Totally new user, save only permanent system msgs - IF ((SYSTEM.AND.7).EQ.3.OR. - & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THENf - NSYS = NSYS + 1U - CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY) - CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))w - ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg - & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages - SYSTEM = ICOUNT ! Save bulletin number for display - IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN - BULL_POINT = ICOUNT - 11 - IF (.NOT.BTEST(FOLDER_FLAG,2).AND. - & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100s - END IFk - NGEN = NGEN + 1 - CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY) - END IFB - END IF - END DOU -100 CALL CLOSE_BULLDIR -CL -C Review new directory entries. If there are system messages,w -C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting -C to the terminal. If there are simple messages, just output the -C header information. -C= - IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0 - - IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999 - - IF (NSYS.GT.0) THEN ! Are there any system messages? - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifies0 - FIRST_WRITE = .FALSE. ! if this is first write to screen. - END IF - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-(LENF+16))/2d - S2 = PAGE_WIDTH - S1 - (LENF + 16) - WRITE (6,'(''+'',A,$)') CTRL_G - WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep...B - PAGE = PAGE + 1 - CTRL_G = 0 ! Don't ring bell for non-system bulls - CALL OPEN_BULLFIL_SHARED - CALL INIT_QUEUE(SYS_BUL1,INPUT) - SYS_BUL = SYS_BUL1 - SYS_DIR = SYS_DIR1 - SYS_NUM = SYS_NUM1 - NSYS_LINE = 0A - DO J=1,NSYSW - CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)U - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))T - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTEI - ELSE - CALL GET_REMOTE_MESSAGE(IER) - END IF - IF (IER.GT.0) THENR - CALL CLOSE_BULLFIL - GO TO 9999 - END IF - END IFY - INPUT = ' 'R - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - ILEN = LINE_LENGTH + 1L - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)I - END IFE - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)U - END IF - DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO( - IF (ILEN.LT.0) THEN - CALL CLOSE_BULLFILU - GO TO 9999T - END IFM - IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN - INPUT = ' ' - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - DO I=1,PAGE_WIDTH - INPUT(I:I) = SEPARATEt - END DOt - CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - NSYS_LINE = NSYS_LINE + 2B - END IFN - END DO - CALL CLOSE_BULLFIL - SYS_BUL = SYS_BUL1 - ILEN = 0 - I = 1J - DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messagesT - IF (ILEN.EQ.0) THEN - CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT) - ILEN = TRIM(INPUT)R - I = I + 1 - END IFu - IF (SYS_BUL.NE.0) THEN - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN - ! If at end of screen - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input - & 'HIT any key for next page....') - WRITE (6,'(1X)')O - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) '+'//INPUT(:ILEN) - ILEN = 02 - ELSE - WRITE(6,1060) '+'//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:)C - ILEN = ILEN - PAGE_WIDTH! - END IF - ELSEm - PAGE = PAGE + 1t - IF (ILEN.LE.PAGE_WIDTH) THEN - WRITE(6,1060) ' '//INPUT(:ILEN) - ILEN = 0( - ELSE - WRITE(6,1060) ' '//INPUT(:PAGE_WIDTH) - INPUT = INPUT(PAGE_WIDTH+1:)) - ILEN = ILEN - PAGE_WIDTHN - END IF - END IF - END IFL - END DO - IF (NGEN.EQ.0) THENA - WRITE(6,'(A)') ! Write delimiting blank line - END IF - PAGE = PAGE + 1+ - END IFT - - ENTRY REDISPLAY_DIRECTORY - - GEN_DIR = GEN_DIR1& - IF (NGEN.GT.0) THEN ! Are there new non-system messages? - LENF = TRIM(FOLDER_NAME) - S1 = (PAGE_WIDTH-13-LENF)/2R - S2 = PAGE_WIDTH-S1-13-LENF - IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN - WRITE(6,1080) ! Ask for input to proceed to next pageF - CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input - & 'HIT any key for next page....')O - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - WRITE (6,'(''+'',A,$)') CTRL_GE - WRITE(6,1028) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = 1B - ELSE - IF (FIRST_WRITE) THEN - PAGE = 4 ! Don't erase MAIL/PASSWORD notifiesL - FIRST_WRITE = .FALSE. ! if this is first write to screen.N - END IFR - WRITE (6,'(''+'',A,$)') CTRL_GA - WRITE(6,1027) 'New '//FOLDER_NAME(:LENF)//' messages' - PAGE = PAGE + 1 - END IF - WRITE(6,1020) - WRITE(6,1025)( - PAGE = PAGE + 2 - I = 0E - DO WHILE (I.LT.NGEN) - I = I + 1 - CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY)I - CALL CONVERT_ENTRY_FROMBIN_FOLDER - N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3) - N1 = MAX(1,6-N) - IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screenN - WRITE(6,1080) ! Ask for input to proceed to next page - CALL GET_INPUT_NOECHO_PROMPT(INREAD,U - & 'HIT Q(Quit listing) or any other key for next page....') - CALL STR$UPCASE(INREAD,INREAD) - WRITE (6,'(1X)') - CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - PAGE = 1 - IF (INREAD.EQ.'Q') THEN - I = NGEN ! Quit directory listing - WRITE(6,'(''+Quitting directory listing.'')')R - ELSE0 - WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM - END IF - ! Bulletin number is stored in SYSTEM - ELSEI - PAGE = PAGE + 1 - WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEMa - END IF - END DO - IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0)C - & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THEN - PAGE = 0 ! Don't reset page counter if READNEW not set, - END IF ! as no prompt to read is generated.! - END IFt -Cm -C Instruct users how to read displayed messages if READNEW not selected.E -CT - IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.u - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE(6,1030)S - ELSE IF (NGEN.EQ.0) THENI - ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1 - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)// - & '/SYSTEM command can be used to reread these messages.' - ELSEA - FLEN = TRIM(FOLDER_NAME) - IF (FOLDER_NUMBER.EQ.0) FLEN = -1M - ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN - S1 = (PAGE_WIDTH-ILEN)/2 - S2 = PAGE_WIDTH - S1 - ILEN - IF (FOLDER_NUMBER.EQ.0) THEN - WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)// - & ' to read these messages.' - ELSE - WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN)A - & //' '//FOLDER_NAME(:FLEN)//E - & ' to read these messages.' - END IF - END IF - -9999 IF (LOGIN_SWITCH) THEN - CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW)U - CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD) - END IF - RETURN - -1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number') -1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------') -1026 FORMAT(' ',('*'),A,' System Messages',('*'))A -1027 FORMAT(/,' ',('*'),A,('*')) -1028 FORMAT('+',('*'),A,('*')) -1030 FORMAT(' ',('*')) -1035 FORMAT(' ',('*'),A,('*')) -1040 FORMAT(A<53>,2X,A12,1X,A6,X,I) -1060 FORMAT(A) -1070 FORMAT(' ERROR: Cannot add new entry to user file.') -1080 FORMAT(' ',/) - - END - - - E - SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SYIDEF)' - - CHARACTER*(*) NODE_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list& - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlistU - - IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)), - & %VAL(GETSYI_ITMLST),,,) ! Get Info command. - - IF (.NOT.IER) THENN - WRITE (6,'('' ERROR: Specified node name not found.'')') - NODE_AREA = 0s - END IFs - - RETURNe - END - diff --git a/decus/vax92b/bulletin/bulletin1.for b/decus/vax92b/bulletin/bulletin1.for deleted file mode 100644 index 68b8d13..0000000 --- a/decus/vax92b/bulletin/bulletin1.for +++ /dev/null @@ -1,2179 +0,0 @@ -C -C BULLETIN1.FOR, Version 12/30/92 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE MAIL -C -C SUBROUTINE MAIL -C -C FUNCTION: Sends message which you have read to user via DEC mail. -C - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*64 MAIL_SUBJECT - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - IF (BTEST(CAPTIVE(-1),1)) THEN - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - MAIL_SUBJECT = DESCRIP - IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D) - IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN - WRITE(6,'('' ERROR: Subject limit is 64 characters.'')') - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL CLOSE_BULLDIR - - IF (CLI$PRESENT('EDIT')) THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - END IF - - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - - IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Error in opening scratch file.'')') - RETURN - END IF - - IF (CLI$PRESENT('HEADER')) THEN ! Printout header? - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN - IF (REMOTE_SET.NE.3) THEN - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5) - END IF - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IF - WRITE (3,'(A)') INPUT(:TRIM(INPUT)) - END IF - - HEAD = CLI$PRESENT('HEADER') - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THEN - WRITE(3,1060) FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) - ELSE - IF (HEAD) WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Message copy completed - - CALL CLOSE_BULLFIL - - LEN_D = TRIM(MAIL_SUBJECT) - IF (LEN_D.EQ.0) THEN - MAIL_SUBJECT = 'BULLETIN message.' - LEN_D = TRIM(MAIL_SUBJECT) - END IF - - I = 1 - DO WHILE (I.LE.LEN_D) - IF (MAIL_SUBJECT(I:I).EQ.'"') THEN - IF (LEN_D.EQ.64) THEN - MAIL_SUBJECT(I:I) = '`' - ELSE - MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(I+1:) - I = I + 1 - LEN_D = LEN_D + 1 - END IF - END IF - I = I + 1 - END DO - - LEN_P = 0 - DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I) - & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames - LEN_P = LEN_P + I + 1 - BULL_PARAMETER(LEN_P:LEN_P) = ',' - END DO - LEN_P = LEN_P - 1 - - I = 1 ! Must change all " to """ in MAIL recipients - DO WHILE (I.LE.LEN_P) - IF (BULL_PARAMETER(I:I).EQ.'"') THEN - BULL_PARAMETER = BULL_PARAMETER(:I)//'""'// - & BULL_PARAMETER(I+1:) - I = I + 2 - LEN_P = LEN_P + 2 - END IF - I = I + 1 - END DO - - IF (CLI$PRESENT('EDIT')) THEN - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - CONTEXT = 0 - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - VERSION = INDEX(INPUT,';') + 1 - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - WRITE (6,'('' ERROR: No message mailed.'')') - RETURN - END IF - END IF - - CALL DISABLE_PRIVS - CALL SENDMAIL('SYS$LOGIN:BULL.SCR',BULL_PARAMETER(:LEN_P) - & ,MAIL_SUBJECT,STATUS) -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P) -C & //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,STATUS) - CALL ENABLE_PRIVS - - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR') - - RETURN - -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A) - - END - - - - SUBROUTINE MODIFY_FOLDER -C -C SUBROUTINE MODIFY_FOLDER -C -C FUNCTION: Modifies a folder's information. -C - IMPLICIT INTEGER (A - Z) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER PASSWORD*31,DEFAULT_USER*12 - - IF (.NOT.FOLDER_ACCESS - & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to modify folder.'')') - RETURN - END IF - - IF (CLI$PRESENT('NAME')) THEN - IF (REMOTE_SET) THEN - WRITE (6,'('' ERROR: Cannot change name of'', - & '' remote folder.'')') - RETURN - ELSE - CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) - IF (LEN_P.GT.44) THEN - WRITE (6,'('' ERROR: Folder name cannot be larger - & than 44 characters.'')') - RETURN - END IF - END IF - ELSE - FOLDER1 = FOLDER - END IF - - IF (CLI$PRESENT('DESCRIPTION')) THEN - WRITE (6,'('' Enter one line description of folder.'')') - LENF = 81 - DO WHILE (LENF.GT.80) - CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line - IF (LENF.LE.0) THEN - WRITE (6,'('' ERROR: Folder modification aborted.'')') - RETURN - ELSE IF (LENF.GT.80) THEN ! If too many characters - WRITE (6,'('' ERROR: Description must be < 80 characters.'')') - ELSE - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces - END IF - END DO - ELSE - FOLDER1_DESCRIP = FOLDER_DESCRIP - END IF - - IF (CLI$PRESENT('OWNER')) THEN - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - ELSE - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) - END IF - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner name is not valid username.'')') - RETURN - ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN - WRITE (6,'('' ERROR: Folder owner name too long.'')') - RETURN - ELSE IF (.NOT.SETPRV_PRIV()) THEN - WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - WRITE (6,'('' ERROR: No password entered.'')') - RETURN - END IF - WRITE (6,'('' Attempting to verify password name...'')') - OPEN (UNIT=10,NAME='SYS$NODE"'// - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - & //' '//PASSWORD(:TRIM(PASSWORD))//'"::', - & TYPE='SCRATCH',IOSTAT=IER) - CLOSE (UNIT=10) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')') - RETURN - ELSE - WRITE (6,'('' Password was verified.'')') - END IFo - ELSE - FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) - END IF - ELSEr - FOLDER1_OWNER = FOLDER_OWNER - END IFL - - CALL OPEN_BULLFOLDER ! Open folder filen - - IF (CLI$PRESENT('NAME')) THEN - READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0)- - ! See if folder exists - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Folder name already exists.'')') - CALL CLOSE_BULLFOLDER - RETURNA - END IF - END IFT - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN - LEN_F = TRIM(FOLDER_DIRECTORY) - IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// - & FOLDER1(:TRIM(FOLDER1))//'.*') - IF (.NOT.IER) THEN - I = 0 - IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// - & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) - END IF - IF (IER.OR..NOT.IER1) THEN - FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 - FOLDER_NAME = FOLDER1 - IER = 0 - END IF - END IFF - - IF (IER.EQ.0) THENN - IF (CLI$PRESENT('OWNER')) THEN - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)H - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) - END IFI - END IF - FOLDER = FOLDER1 - FOLDER_OWNER = FOLDER1_OWNER - FOLDER_DESCRIP = FOLDER1_DESCRIP - DELETE (7) - IF (CLI$PRESENT('ID')) THENL - FOLDER_FLAG = IBSET(FOLDER_FLAG,6)G - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,6)N - END IF - CALL WRITE_FOLDER_FILE(IER)o - IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') - END IF) - - IF (IER.NE.0) THENe - WRITE (6,'('' ERROR: Folder modification aborted.'')') - END IF - - CALL CLOSE_BULLFOLDER - - RETURNP - END - - - - FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - - IMPLICIT INTEGER (A-Z)P - - CHARACTER*(*) USERNAME,FOLDER_OWNER - - IF (SETPRV_PRIV()) THEN - FOLDER_ACCESS = .TRUE. - ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID - FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) - ELSE - FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER - END IF2 - - RETURNN - END - - - - SUBROUTINE MOVE(DELETE_ORIGINAL)= -Ca -C SUBROUTINE MOVE -CE -C FUNCTION: Moves message from one folder to another. -C - IMPLICIT INTEGER (A - Z)T - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /HEADER/ HEADERi - - COMMON /NEXT/ NEXTT - - COMMON /NEWGROUP/ NEWGROUPL - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLFILES.INC' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - LOGICAL DELETE_ORIGINAL - - CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256 - - DATA TEMP_FILE/.FALSE./ - - DIMENSION BTIM(2) - - ORIGINAL = CLI$PRESENT('ORIGINAL') - - IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You have no privileges to keep''H - & ,'' original owner.'')')t - RETURN - END IFB - - ALL = CLI$PRESENT('ALL')L - - MERGE = CLI$PRESENT('MERGE'), - - SAVE_BULL_POINT = BULL_POINT - - IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THENT - IF (BULL_POINT.EQ.0) THEN ! If no message has been readM - WRITE(6,'('' ERROR: You are not reading any message.'')') - RETURN ! and return - END IF - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entry) - IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIRI - BULL_POINT = SAVE_BULL_POINT - RETURN% - END IF - - NUM_COPY = 1 - ELSEm - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')')U - CALL CLOSE_BULLDIRH - RETURN_ - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN_ - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - CALL CLOSE_BULLDIR - RETURNN - ELSE) - NUM_COPY = EBULL - SBULL + 1O - BULL_POINT = SBULL - END IFE - IF (NUM_COPY.GT.1) ALL = .TRUE. - IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN - NEWGROUP = .TRUE. ! Kludgey way of detecting new2bullI - NEXT = .TRUE. ! If SBULL does not exist, will findU - ELSE ! next message after SBULLS - SBULL1 = SBULL - CALL READDIR(SBULL,IER)M - IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THENE - WRITE(6,'('' ERROR: Specified message was not found.'')')E - CALL CLOSE_BULLDIR - RETURN - END IF - END IF0 - ELSE IF (ALL) THEN - NUM_COPY = NBULLO - BULL_POINT = 1B - NEWGROUP = .TRUE. - NEXT = .TRUE. - END IF - END IFi - - FROM_REMOTE = REMOTE_SETA - CALL CLI$GET_VALUE('FOLDER',FOLDER1)T - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1)L - TO_NEWS = TEST_NEWS(FOLDER1)S - - IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN - IF (.NOT.TEMP_FILE) THEN - OPEN (UNIT=12,FILE='REMOTE.BULLDIR',A - & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) - IF (IER.EQ.0) THENE - OPEN (UNIT=11,FILE='REMOTE.BULLFIL',' - & STATUS='SCRATCH',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED')W - END IFR - ELSE - REWIND (12,IOSTAT=IER)' - END IF - IF (IER.EQ.0) THEN - TEMP_FILE = .TRUE.$ - CALL OPEN_BULLFIL - CALL READDIR(0,IER) - I = BULL_POINT - 1E - IER = I + 1 - NBLOCK = 1 - LAST = BULL_POINT+NUM_COPY-1T - NUM_COPY = 0 - DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) - I = I + 1 - CALL READDIR(I,IER) - IF (IER.EQ.I+1.AND.I.LE.LAST) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)F - IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1)P - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTEI - ELSER - CALL GET_REMOTE_MESSAGE(IER1) - END IF - ELSE - IER1 = 0! - END IF - IF (LENGTH.EQ.0) IER = 1 ! Don't allow empty messagesc - IF (IER1.EQ.0) THENS - SCRATCH_R = SCRATCH_R1D - DO J=1,LENGTH - IF (REMOTE_SET) THEN - CALL READ_QUEUE(%VAL(SCRATCH_R), - & SCRATCH_R,INPUT(:128))C - ELSE' - READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END IFP - WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) - END DOe - END IF - IF (IER1.EQ.0) THENT - BLOCK = NBLOCKE - NBLOCK = NBLOCK + LENGTHR - WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY - END IF - IF (TO_NEWS.AND.ORIGINAL) THEN - WRITE (12,IOSTAT=IER1) NEWS_MSGID - END IF - IF (IER1.NE.0) THENa - I = IER - ELSE - NUM_COPY = NUM_COPY + 1 - END IF - END IF - END DOI - CALL CLOSE_BULLFILn - END IF - IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN - WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') - CLOSE (UNIT=12) - CLOSE (UNIT=11) - TEMP_FILE = .FALSE. - CALL CLOSE_BULLDIRR - RETURN - END IF - END IFT - - CALL CLOSE_BULLDIR - - SAVE_FOLDER = FOLDERt - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBERR - CALL SELECT_FOLDER(.FALSE.,IER) - - IER1 = .TRUE. - - POST_NEWS = (.NOT.ORIGINAL.AND.REMOTE_SET.EQ.4).OR.REMOTE_SET.EQ.3O - - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Cannot access specified folder.'')')' - ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN - IF (READ_ONLY) THEN - WRITE (6,'('' ERROR: No access to write into folder.'')') - ELSE - WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')')L - END IF - IER1 = .FALSE. - ELSE IF (REMOTE_SET.EQ.0.AND.NEWS_FEED()) THENT - IF (.NOT.ORIGINAL) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1)L - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'',, - & '' is present.'')') - IER1 = .FALSE.E - ELSE - REMOTE_SET = 3T - END IF - END IF - END IFR - - IF (.NOT.IER.OR..NOT.IER1) THEN - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - IF (.NOT.IER) THEN - FOLDER = SAVE_FOLDER - BULL_POINT = SAVE_BULL_POINT - ELSE - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1). - END IF - BULL_POINT = SAVE_BULL_POINT - CLOSE (UNIT=12)E - CLOSE (UNIT=11)E - TEMP_FILE = .FALSE.0 - RETURN - END IFF -C -C Add bulletin to bulletin file and directory entry for to directory file. -C - IF (POST_NEWS) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,$ - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')C - ELSE - CALL OPEN_BULLDIR ! Prepare to add dir entry - IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date - IF (FOLDER_BBEXPIRE.GT.0) THENP - EX = FOLDER_BBEXPIRE( - ELSEI - EX = NEWS_EXPIRE_DEFAULTG - END IF_ - CALL GET_EXDATE(EXDATE,EX)L - END IF - CALL OPEN_BULLFIL ! Prepare to add bulletinI - - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 - END IF. - - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))d - & //SAVE_FOLDERL - - IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE))U - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',O - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER.EQ.0) THEN - DO WHILE (FILE_LOCK(IER,IER1))R - OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE))m - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END DOM - END IF - ELSEC - IER= 0 - END IFC - - IF (REMOTE_SET.GE.3) THEN - SAVE_HEADER = HEADER - IF (CLI$PRESENT('HEADER')) THENE - HEADER = .TRUE. - ELSE - HEADER = .FALSE./ - END IF - END IF2 - - IF (MERGE) CALL INITIALIZE_MERGE(IER) - - START_BULL_POINT = BULL_POINT - - IF (IER.EQ.0) THENU - IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN - REWIND (12) - ELSE - READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER) - END IF - END IFL - - DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) - READ (12,IOSTAT=IER) BULLDIR_ENTRY - IF (TO_NEWS.AND.ORIGINAL) THEN - READ (12,IOSTAT=IER) NEWS_MSGID - END IF - NUM_COPY = NUM_COPY - 1 - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)o - CALL CONVERT_ENTRY_FROMBIN_FOLDERi - - IF (REMOTE_SET.GE.3) SYSTEM = 0B - - IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN - SYSTEM = 0_ - IF (FOLDER_BBEXPIRE.GT.0) THEN$ - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message( - EXDATE = '5-NOV-2000' - SYSTEM = 2 - ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THENa - CALL GET_EXDATE(EXDATE,14) - END IF - ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THENA - IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THENn - LIMIT = NEWS_EXPIRE_LIMIT - IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - IF (LIMIT.GT.0) THENd - CALL GET_EXDATE(EXDATE,LIMIT)C - CALL SYS_BINTIM(EXDATE,BTIM) - IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN - CALL COPY2(EX_BTIM,BTIM)L - END IF - END IF - CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) - IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN - IER = 0n - GO TO 1006 - END IF: - ELSEw - IF (FOLDER_BBEXPIRE.GT.0) THEN_ - EX = FOLDER_BBEXPIRE - ELSE - EX = NEWS_EXPIRE_DEFAULT - END IF - IF (F_LAST.EQ.0) THEN - EX = EX + COMPARE_DATE(DATE,' ') - IF (EX.LE.0) THEN) - IER = 0 - GO TO 100 - END IF - END IFW - CALL GET_EXDATE(EXDATE,EX)O - END IFs - END IF - - IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV()) THEN ! Or no privileges?O - SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit - END IF - - IF (BTEST(SYSTEM,2).AND. ! Shutdown message?O - & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? - & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? - SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit - WRITE (6,'('' ERROR: No privileges to add'',A - & '' shutdown message.'')'). - IF (FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & FOLDER_BBEXPIREN - ELSEE - CALL GET_EXDATE(EXDATE,14) - WRITE (6,'('' Expiration will be '',I,'' days.'')') 14W - END IF - EXTIME = '00:00:00.00'F - ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present?L - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privileges to add'',E - & '' permanent message.'')') - WRITE (6,'('' Expiration will be '',I,'' days.'')') - & F_EXPIRE_LIMIT - SYSTEM = IBCLR(SYSTEM,1)F - CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT)A - EXTIME = '00:00:00.00'C - END IF - - IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL - FROM = USERNAME ! Specify owner - END IF - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2. - IF (IER.NE.0) CALL ERROR_AND_EXIT - END IF - - IF (REMOTE_SET.GE.3.AND..NOT.ORIGINAL) THEN+ - ILEN = LINE_LENGTH + 1L - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - POST_SUBJECT = INPUT(7:ILEN)E - ELSES - POST_SUBJECT = DESCRIPI - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN)e - END DOE - - REWIND (UNIT=3) - - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT)E - ELSE - IF (MERGE) CALL ADD_MERGE_TO(IER) - - IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE( - - IF (IER.EQ.0) THENT - NBLOCK = NBLOCK + 1 - - DO I=BLOCK,BLOCK+LENGTH-1 - READ (11'I,IOSTAT=IER) INPUT(:128) - IF (IER.EQ.0) THEN - CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) - END IF - NBLOCK = NBLOCK + 1S - END DOU - END IF - - IF (IER.EQ.0) THEN. - IF (MERGE) THEN - CALL ADD_MERGE_FROM(IER) - ELSED - CALL ADD_ENTRY ! Add the new directory entry - END IF - BULL_POINT = BULL_POINT + 1 - END IF - END IF -100 CONTINUEE - END DO - - IF (POST_NEWS) CLOSE (UNIT=3) - - IF (MERGE) CALL ADD_MERGE_REST(IER) - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL - - IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN - CLOSE (UNIT=11) - CLOSE (UNIT=12) - TEMP_FILE = .FALSE. - END IFL - - IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS) THENL - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - CALL UPDATE_FOLDER ! Update folder infoN -CE -C If user is adding message, an no new messages, update last read time forO -C folder, so user is not alerted of new message which is owned by user. -C - IF (DIFF.GE.0) THENo - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) - END IF - END IFN - - IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with addi - - IF (IER.EQ.0) THEN - WRITE (6,'('' Successful copy to folder '',A)')t - & FOLDER(:TRIM(FOLDER))//'.' - IF (MERGE) THENE - CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//I - & '.BULLDIR;-1') - END IF - ELSE IF (MERGE) THEN - WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') - ELSEI - WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')')' - & BULL_POINT - START_BULL_POINT - END IF - - IF (.NOT.POST_NEWS) HEADER = SAVE_HEADERE - IF (ORIGINAL.AND.(NEWS_FEED().OR.REMOTE_SET.EQ.4)) RETURN - - FOLDER_NUMBER = SAVE_FOLDER_NUMBER - FOLDER1 = SAVE_FOLDER - CALL SELECT_FOLDER(.FALSE.,IER1)H - - BULL_POINT = SAVE_BULL_POINT - - IF (DELETE_ORIGINAL.AND.IER.EQ.0) THENL - IF (FROM_REMOTE.AND.ALL) THEND - WRITE (6,'('' WARNING: Original messages not deleted.'')')( - WRITE (6,'('' Multiple deletions not possible for '', - & ''remote folders.'')')U - ELSE - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL DELETE_MSG - END IF - END IFt - - RETURNi - END - - - - - SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) -C= -C SUBROUTINE PRINTL -CR -C FUNCTION: Print header to queue. -CS - - IMPLICIT INTEGER (A-Z)T - - INCLUDE '($SJCDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'F - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL CLI$_ABSENT - - CHARACTER*32 QUEUE,TEST - - INTEGER*2 FILE_ID(14) - INTEGER*2 IOSB(4) - EQUIVALENCE (IOSB(1),JBC_ERROR) - - CHARACTER*31 FORM - - PARAMETER FF = CHAR(12) - - DATA FIRST /.TRUE./, CHANGED /.FALSE./M - - OPENED = .FALSE. - - IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND.. - & INCMD(:4).EQ.'PRIN') THEN - WRITE (6,'('' Printing all previously queued messages.'')'): - GO TO 200L - ELSE IF (.NOT.FIRST) THEN - IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) - CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0 - CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY - IER = CLI$GET_VALUE('FORM',TEST,FLEN) - CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0) - IF (CHANGED) THENO - WRITE (6,'('' Printing all previously queued messages.'')') - GO TO 200 - END IF - END IFD - -50 IF (PRINT_NUM.EQ.0) THEND - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - IF (EBULL.GT.F_NBULL) EBULL = F_NBULL - ELSE IF (OPENED) THENE - CALL CLOSE_BULLFILI - CALL CLOSE_BULLDIRA - GO TO 150 - ELSE IF (CLI$PRESENT('ALL')) THENF - SBULL = 1 - EBULL = F_NBULL - IER = 0 - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error.A - RETURN - ELSE - SBULL = BULL_POINT - EBULL = SBULL - IER = 0 - END IF - IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN - WRITE (6,1015)G - IF (OPENED) THENY - CALL CLOSE_BULLFILT - CALL CLOSE_BULLDIR - END IFT - WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) - RETURN3 - END IF - ELSEE - SBULL = PRINT_NUME - EBULL = SBULLE - END IFL - - IF (FIRST) THEN - QLEN = 0 - IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue namee - IF (QLEN.EQ.0) THENV - QUEUE = 'SYS$PRINT' - QLEN = TRIM(QUEUE). - END IF - - NOTIFY = CLI$PRESENT('NOTIFY') - - FLEN = 0 - IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name - - CALL DISABLE_PRIVS - - OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')) - - CALL ENABLE_PRIVSD - END IFE - - IF (OPEN_IT) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - OPENED = .TRUE. - END IFY - - HEAD = CLI$PRESENT('HEADER') - - DO I=SBULL,EBULL$ - I1 = I - CALL READDIR(I,IER) ! Get info for specified message - IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENTw - & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN_ - IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 - IF (I1.GT.SBULL) GO TO 100X - CLOSE (UNIT=24,STATUS='DELETE') - IF (OPEN_IT) THEN - CALL CLOSE_BULLFILO - CALL CLOSE_BULLDIRE - END IF - RETURNT - ELSE IF (REMOTE_SET) THEN - CALL REMOTE_READ_MESSAGE(I,IER1)R - IF (IER1.GT.0) THEN - CALL DISCONNECT_REMOTEE - ELSEv - CALL GET_REMOTE_MESSAGE(IER1) - END IFv - IF (IER1.NE.0) GO TO 100F - END IF - - IF (.NOT.FIRST) THEN - WRITE (24,'(A)') FF - ELSE - FIRST = .FALSE. - END IF - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)2 - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENR - IF (HEAD) THEN' - WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8)F - END IFG - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (HEAD) THENr - WRITE(24,1060) FROM,DATE//' '//TIME(:8) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENW - IF (HEAD) WRITE(24,1050) INPUT(7:ILEN)) - ELSE - IF (HEAD) WRITE(24,1050) DESCRIP0 - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) - END DO - END DO - -100 IF (PRINT_NUM.EQ.0) THEN - IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,)' - IF (SBULL.EQ.EBULL) THEN - WRITE(6,1040) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)M - ELSE - WRITE(6,1045) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)t - IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) - WRITE(6,1046) - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)) - END IF - -1040 FORMAT(' Message ',A,' sent to printer.')N -1045 FORMAT(' Messages ',A,$) -1046 FORMAT('+-',A,' sent to printer.') - GO TO 50 - ELSE IF (OPEN_IT) THEN( - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IF: - -150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN - - ENTRY PRINT_NOW - -200 IF (FIRST) RETURNI - - FIRST = .TRUE.' - - CLOSE (UNIT=24) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, - & %LOC('SYS$LOGIN:BULL.LIS')) - - CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE))i - CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) - - IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0): - - IF (FLEN.GT.0) THEN - CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM))L - END IF. - - CALL DISABLE_PRIVSB - - CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) - - CALL END_ITMLST(SJC_ITMLST) - - IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)+ - IF (IER.AND.(.NOT.JBC_ERROR)) THEN - CALL SYS_GETMSG(JBC_ERROR) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') - ELSE - IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) - IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A,t - & '') started on '',A)') QUEUE(:QLEN), - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) - END IFS - - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - - IF (CHANGED) THEN - CHANGED = .FALSE.S - GO TO 50 - END IF. - - RETURND - -900 CALL ERRSNS(IDUMMY,IER) - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - WRITE(6,1000) - CALL SYS_GETMSG(IER)F - RETURNB - -1000 FORMAT(' ERROR: Unable to open temporary file - & SYS$LOGIN:BULL.LIS for printing.') -1010 FORMAT(' ERROR: You have not read any message.')T -1015 FORMAT(' ERROR: Specified message number has incorrect format:')n -1030 FORMAT(' ERROR: Following bulletin was not found: ',I)r -1050 FORMAT('Description: ',A,/) -1060 FORMAT('From: ',A,/,'Date: ',A) - - END - - - - - SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) -C1 -C SUBROUTINE READ_MSG -CF -C FUNCTION: Reads a specified bulletin. -C_ -C PARAMETER:l -C READ_COUNT - Variable to store the record in the message fileu -C that READ will read from. Must be set to 0 to indicate -C that it is the first read of the message. If -1, -C READ will search for the last message in the message file -C and read that one. If -2, just display header information. -C BULL_READ - Message number to be read. -CI - IMPLICIT INTEGER (A - Z)C - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLUSER.INC') - - COMMON /READIT/ READIT - - COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGINGN - LOGICAL PAGINGR - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /HEADER/ HEADERW - - COMMON /NEXT/ NEXTe - LOGICAL NEXT /.FALSE./ - - COMMON /POST/ POSTTIMEe - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMD - DATA BULL_USER_CUSTOM/.FALSE./L - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPO - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - DATA SCRATCH_B1/0/ - - CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH)U - CHARACTER HEADLINE*132U - - LOGICAL SINCE,PAGE - - EXTERNAL CLI$_NEGATED - - POSTTIME = .TRUE. - - CALL LIB$ERASE_PAGE(1,1) ! Clear screenM - END = 0 ! Nothing outputted on screen - - IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is - ! not first page of bulletin - - IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR.I - & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. - & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN - IF (CLI$PRESENT('HEADER')) THENE - HEADER = .TRUE. - ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN - HEADER = .FALSE.i - END IF - ROTC = CLI$PRESENT('ROTATE') - END IFL - - SINCE = .FALSE. - NEW = .FALSE. - PAGE = .TRUE. - - IER = 0 - - IF (.NOT.PAGING) PAGE = .FALSE. - IF (INCMD(:4).EQ.'READ') THEN ! If READ command... - POSTTIME = CLI$PRESENT('POST') - IF (CLI$PRESENT('MARKED')) THENL - READ_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - READ_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR. - & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3)A - ELSE IF (CLI$PRESENT('UNSEEN').OR. - & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THENp - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3), - ELSE IF (CLI$PRESENT('ALL')) THENL - READ_TAG = IBSET(0,1) + IBSET(0,2)O - IF (REMOTE_SET.GE.3) THEN - BULL_READ = F_START - ELSE - BULL_READ = 1 - END IFP - END IF - IF (READ_TAG) THEN - IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THENO - WRITE (6,'('' ERROR: Invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)S - GO TO 9999N - END IFL - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) - END IF - - IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. - IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified?U - IER = CLI$GET_VALUE('SINCE',DATETIME) - IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. - IER = SYS$BINTIM('-- 00:00:00.00',TODAY) - CALL GET_MSGKEY(TODAY,MSG_KEY)L - ELSEE - CALL SYS_BINTIM(DATETIME,MSG_BTIM)! - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - END IFE - CALL OPEN_BULLDIR_SHAREDR - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR) - ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified?! - NEW = .TRUE. - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)W - IF (DIFF.GE.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - ELSE_ - CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & MSG_KEY)$ - END IFA - CALL OPEN_BULLDIR_SHARED - CALL READDIR_KEYGE(IER) - CALL CLOSE_BULLDIR - ELSEs - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.EQ.0) THEN - WRITE (6,'('' No new messages are present.'')') - GO TO 9999 - END IF. - END IFI - BULL_READ = IER - IER = IER + 1 - END IF - IF (CLI$PRESENT('SINCE')) THEN - IF (IER.EQ.0) THENC - WRITE (6,'('' No messages past specified date.'')') - GO TO 9999R - ELSEI - BULL_READ = IER - IER = IER + 1 - END IF( - SINCE = .TRUE.R - END IF - END IF - - NEXT = .FALSE. - IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN) - NEXT = .TRUE. - ELSE IF (INCMD(:4).EQ.'READ'.AND..NOT.SINCE.AND..NOT.NEWF - & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') - & .AND..NOT.CLI$PRESENT('ALL')) THEN= - NEXT = .TRUE. - END IFG - - BULL_NOW = BULL_POINT - - OK = .TRUE. -50 IF (READ_TAG) THENU - IER = 0m - IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR.N - & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN_ - IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THENT - MSG_NUM = F_NBULL+1 - ELSE/ - MSG_NUM = BULL_NOW - END IFN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1H - ELSE IF (INCMD(:4).EQ.'BACK') THEN - CALL OPEN_BULLDIR_SHAREDT - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - CALL CLOSE_BULLDIR_ - IF (IER1.EQ.0) IER = BULL_READ + 1I - ELSE IF (INCMD(:4).EQ.'LAST') THEN - CALL OPEN_BULLDIR_SHARED - IF (BULL_NOW.GT.0) THEN - CALL READDIR(BULL_NOW,IER)A - IF (IER.NE.BULL_NOW+1) THEN - BULL_NOW = 0 - ELSE) - CALL GET_THIS_OR_NEXT_TAGL - & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY)4 - IF (IER1.NE.0) BULL_NOW = 0L - END IFR - END IF - IF (BULL_NOW.EQ.0) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)E - IF (IER1.EQ.0) IER = BULL_READ + 1N - END IF - DO WHILE (IER1.EQ.0)o - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1O - END DOF - CALL CLOSE_BULLDIRC - ELSE IF (INCMD(:4).EQ.'FIRS') THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)' - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.EQ.0) IER = BULL_READ + 1N - ELSE IF (NEXT.OR.SINCE.OR.NEW) THEND - OLD_NEXT = NEXT - NEXT = .FALSE. - IF (NEW) MSG_NUM = BULL_READ - IF (.NOT.OLD_NEXT) THEN - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - ELSE_ - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = BULL_NOW - ELSE IF (BULL_NOW.GT.0) THENM - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_NOW,IER) - CALL CLOSE_BULLDIR - ELSEC - MSG_KEY = BULLDIR_HEADER - MSG_NUM = 0S - END IF, - CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - END IFE - NEXT = OLD_NEXT - IF (IER1.EQ.0) THEN - IER = BULL_READ + 1 - ELSEI - IER = 0 - END IFH - END IF - END IFS - - IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. - & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. - & INCMD(:4).NE.'FIRS'))) THENq - IF (BULL_READ.GT.0) THEN ! Valid bulletin number? - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_READ,IER) ! Get bulletin directory entryI - IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3s - & .AND.INCMD(:4).EQ.'READ') THEN - IF (NEW) THEN - NEXT = .TRUE. - CALL READDIR(BULL_READ,IER)L - END IFI - END IFS - IF (REMOTE_SET.LT.3.AND.C - & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THENl - READ_COUNT = 0 - IF (IER.NE.BULL_READ+1) THENf - CALL READDIR(0,IER)( - IF (NBULL.GT.0) THEN - BULL_READ = NBULL - CALL READDIR(BULL_READ,IER) - ELSE - IER = 0 - END IF - END IFl - ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN, - CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) - IF (IER1.NE.0) IER = 0_ - END IF) - CALL CLOSE_BULLDIRG - ELSE - IER = 0 - END IF - END IF - - IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? - IF (REMOTE_SET.LT.3) THEN - WRITE(6,1030) ! If not, then error outn - ELSE - WRITE(6,1040) - END IF - NEXT = .FALSE. - IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFILe - GO TO 9999 - END IFI - - BULL_POINT = BULL_READ ! Update bulletin countere - - IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED- - - IF (BULL_USER_CUSTOM.AND.(NEXT.OR.INCMD(:4).EQ.'BACK')) THENI - ILEN = LINE_LENGTH + 1 - BLOCK_SAVE = BLOCK - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)_ - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INFROM = INPUT(7:ILEN)C - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - INFROM = FROM - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN_ - INDESCRIP = INPUT(7:ILEN) - ELSE - INDESCRIP = DESCRIP - END IF - - OK = INCLUDE_MSG(INFROM,INDESCRIP) - - IF (.NOT.OK) THENA - BULL_NOW = MSG_NUMM - IF (INCMD(:4).EQ.'BACK') THEN - BULL_READ = MSG_NUM - 1L - ELSEM - BULL_READ = MSG_NUM + 1E - END IFR - IF (REMOTE_SET) CALL CLOSE_BULLFILC - GO TO 50E - END IF - - BLOCK = BLOCK_SAVE - END IF - - NEXT = .FALSE.1 - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1))A - IF (DIFF.GT.0) THENM - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)= - END IF - IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2)! - ELSEn - IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID - CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) - IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) - END IFM - - EDIT = .FALSE. - - PAGE_WIDTH = REAL_PAGE_WIDTH. - - IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THENA - IF (CLI$PRESENT('EDIT')) THEN. - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')E - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)I - GO TO 9999. - END IFE - EDIT = .TRUE. - PAGE_WIDTH = LINE_LENGTHo - PAGE = .FALSE.= - END IF - END IF - - IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT - - IF (REMOTE_SET.GE.3) THEN - WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') - & BULL_POINT,F_START,F_NBULL - DO WHILE (INDEX(HEADLINE,'- ').GT.0) - I = INDEX(HEADLINE,'- ')H - HEADLINE(I+1:) = HEADLINE(I+2:) - END DO - ELSEE - WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL' - END IF( - DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) - I = INDEX(HEADLINE,' ') - HEADLINE(I:) = HEADLINE(I+1:)R - END DO - I = TRIM(HEADLINE)2 - HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) - FLEN = TRIM(FOLDER_NAME) - HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN)E - IF (READIT.GT.0) THEN - WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE))O - ELSE IF (EDIT) THEN - WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) - ELSE - WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE))T - END IF - - END = 1 ! Outputted 1 line to screen_ - - IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN( - IF (REMOTE_SET.NE.3) THEN= - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)e - & //' (DELETED)' - ELSE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)Y - END IF - ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?K - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Expires on shutdown' - ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) - & //' Permanent' - ELSEE - INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// - & ' Expires: '//EXDATE//' '//EXTIME(:5)D - END IFO - IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? - INPUT = INPUT(:TRIM(INPUT))//' / System' - END IFr - IF (EDIT) THEN - WRITE (3,'(A)') INPUT(:TRIM(INPUT))T - ELSE( - WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) - END IFG - - END = END + 1 - - LINE_OFFSET = 0 - CHAR_OFFSET = 0 - ILEN = LINE_LENGTH + 1C - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - INPUT = 'From: '//INPUT(7:)e - DO WHILE (TRIM(INPUT).GT.0) - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:I) - ELSES - WRITE(6,'(1X,A)') INPUT(:I) - END IF - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = 1I - ELSEL - IF (EDIT) THEN - WRITE(3,'(''From: '',A)') FROM= - ELSE - WRITE(6,'('' From: '',A)') FROM - END IF - END = END + 1E - END IFE - IF (INPUT(:6).NE.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF. - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = 'Subj: '//INPUT(7:)P - DO WHILE (TRIM(INPUT).GT.0)_ - I = MIN(PAGE_WIDTH,TRIM(INPUT)) - IF (EDIT) THENT - WRITE(3,'(A)') INPUT(:I) - ELSEE - WRITE(6,'(1X,A)') INPUT(:I) - END IFI - INPUT = INPUT(I+1:) - END = END + 1 - END DO - LINE_OFFSET = LINE_OFFSET + 1= - IF (EDIT) WRITE(3,'(1X)') - ELSE - END = END + 1L - IF (EDIT) THEN - WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) - WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP)C - ELSE - WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP))R - IF (LINE_OFFSET.EQ.1) THENS - CHAR_OFFSET = 1 - PAGE_WIDTH - LINE_OFFSET = 2 - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - END IFD - END IF - END IF - IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1I - CALL CLOSE_BULLFIL ! End of bulletin file readW - - IF (EDIT) GO TO 200 - - WRITE(6,'(1X)') - - IF (READIT.GT.0) WRITE(6,'(1X)')1 - END = END + 1 -C -C Each page of the bulletin is buffered into temporary memory storage before_ -C being outputted to the terminal. This is to be able to quickly close the -C bulletin file, and to avoid the possibility of the user holding the screen, -C and thus causing the bulletin file to stay open. The temporary memoryQ -C is structured as a linked-list queue, where SCRATCH_B1 points to the header -C of the queue. See BULLSUBS.FOR for more description of the queue.E -CB - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?_ - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headL - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,INPUT) - SCRATCH_B1 = SCRATCH_B ! Init header pointer - END IFA - - READ_ALREADY = 0 ! Number of lines already read - ! from record. - IF (READ_COUNT.EQ.-2) THEN ! Just output header first read - READ_COUNT = BLOCK - GO TO 9999 - ELSEU - READ_COUNT = BLOCK ! Init bulletin record counter - END IFD - - GO TO 200 - -100 IF (READIT.EQ.0) THEN ! If not 1st page of READ - WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info - END = END + 2 ! Increase display counter - END IFX - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - -200 DISPLAY = 0 - IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines - - CALL OPEN_BULLFIL_SHARED ! Get bulletin file - MORE_LINES = .TRUE. - DO WHILE (ILEN.GT.0.AND.MORE_LINES) - IF (CHAR_OFFSET.EQ.0) THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - LINE_OFFSET = LINE_OFFSET + 1 - END IF - IF (ILEN.LT.0) THEN ! Error, couldn't read record - ILEN = 0 ! Fake end of reading file - MORE_LINES = .FALSE.E - ELSE IF (ILEN.GT.0) THEN - IF (EDIT) THEN - WRITE(3,'(A)') INPUT(:ILEN) - ELSE IF (CHAR_OFFSET.EQ.0) THEN - LEN_TEMP = ILEN - CALL CONVERT_TABS(INPUT,LEN_TEMP) - IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) - IF (LEN_TEMP.GT.PAGE_WIDTH) THEN - CHAR_OFFSET = 1( - BUFFER = INPUT(:PAGE_WIDTH) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - ELSEL - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)S - END IFT - ELSE. - CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTHL - IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN - BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - CHAR_OFFSET = 0+ - ELSE! - BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) - END IF1 - END IFF - DISPLAY = DISPLAY + 1 - IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN - MORE_LINES = .FALSE._ - END IFA - END IF - END DO - - CALL CLOSE_BULLFIL ! End of bulletin file readS - - IF (EDIT) THEN_ - CLOSE (UNIT=3) - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')L - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - READ_COUNT = 0 ! init bulletin record counterN - GO TO 9999 - END IFr - -C) -C Bulletin page is now in temporary memory, so output to terminal.C -C Note that if this is a /READ, the first line will have problems with( -C the usual FORMAT statement. It will cause a blank line to be outputted -C at the top of the screen. This is because of the input QIO at theM -C end of the previous page. The output gets confused and thinks it must -C end the previous line. To prevent that, the first line of a new page -C in a /READ must use a different FORMAT statement to surpress the CR/LF. -CM - - SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head - DO I=1,DISPLAY ! Output page to terminal - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record - IF (I.EQ.1.AND.READIT.GT.0) THEN - WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) - ELSE - WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) - END IF - END DOR - - IF (ILEN.EQ.0) THEN ! End of message? - READ_COUNT = 0 ! init bulletin record counterG - ELSE ! Possibly end of message since end of page could be last line - CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC)T - IF (IREC.EQ.0) THEN ! Last record? - CALL TEST_MORE_LINES(ILEN) ! More lines to read?( - IF (ILEN.GT.0) THEN ! Yes, there are still moreL - IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletinN - ELSE ! Yes, last line anyway - READ_COUNT = 0 ! init bulletin record counter - END IFI - ELSE IF (READIT.EQ.0) THEN ! Not last record so - WRITE(6,1070) ! say there is more of bulletin - END IF - END IF - -9999 POSTTIME = .FALSE.E - RETURNH - -1030 FORMAT(' No more messages.')' -1040 FORMAT(' Message not found.') -1070 FORMAT(1X,/,' Press RETURN for more...',/) - -2000 FORMAT(A) - - END - - - - - - SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) - - IMPLICIT INTEGER (A-Z) - - CHARACTER INPUT*(*) - - DO I=1,LEN_TEMP - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN' - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'A')+ - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) - IF (INPUT(I:I).LT.'a') - & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) - - END IF - END DO - - RETURN( - END - - - - - - - SUBROUTINE READNEW(REDO)R -C( -C SUBROUTINE READNEWR -CH -C FUNCTION: Displays new non-system bulletins with prompts between bulletins. -C: - - IMPLICIT INTEGER (A-Z)' - - INCLUDE 'BULLUSER.INC'( - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'( - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /POINT/ BULL_POINT - - COMMON /READ_DISPLAY/ LINE_OFFSET - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGING( - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER INREAD*1,FILE_DEF*80,NUMREAD*6E - - DATA LEN_FILE_DEF /0/, INREAD/0/& - - LOGICAL SLOW,SLOW_TERMINAL - - FIRST_MESSAGE = BULL_POINT( - - IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time( - SLOW = SLOW_TERMINAL() ! Check baud rate of terminal - END IF ! to avoid gobs of output - - LEN_P = 0 ! Tells read subroutine there isE - ! no bulletin parameter - -1 WRITE(6,1000) ! Ask if want to read new bulletinsC - - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get inputI - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper caseF - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ - IF (IER.NE.0) THENP - INREAD = NUMREAD(:1) - IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THENS - IF (INREAD.EQ.'Q') THEN - WRITE (6,'(''+uit'',$)')T - ELSE IF (INREAD.EQ.'E') THEN - WRITE (6,'(''+xit'',$)') - DO I=1,FLONG ! Just show SYSTEM folders - NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) - END DOm - DO I=1,FLONG ! Test for new messages in SYSTEM folders - IF (NEW_MSG(I).NE.0) RETURN - END DOB - CALL EXIT - ELSE, - WRITE (6,'(''+o'',$)') - END IFO - RETURN ! If NO, exitI - ! Include QUIT to be consistent with next questionb - ELSE - CALL LIB$ERASE_PAGE(1,1)T - END IF - END IFM - -3 IF (TEMP_READ.GT.0) THEN - IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN - WRITE (6,'('' ERROR: Specified new message not found.'')')T - GO TO 1 - ELSE - BULL_POINT = TEMP_READ - 1I - END IF - END IFF - - READ_COUNT = 0 ! Initialize display pointerL - -5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin: - BULL_POINT_READ = BULL_POINT' - IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? - CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls -10 CALL READDIR(BULL_POINT+1,IER_POINT) - IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system - & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. - BULL_POINT = BULL_POINT + 1 - GO TO 10W - END IF - CALL CLOSE_BULLDIR - END IF - - GO TO 12. - -11 IF (READ_COUNT.GT.0) THEN - CALL OPEN_BULLDIR_SHARED - CALL OPEN_BULLFIL_SHARED - CALL READDIR(BULL_POINT,IER) - ILEN = LINE_LENGTH+1 - DO I=1,LINE_OFFSET - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - END IFs - - BULL_POINT = BULL_POINT_SAVEn - LENGTH = LENGTH_SAVEQ - BLOCK = BLOCK_SAVE - -12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between - WRITE(6,1020) ! full screens or end of bull. - ELSEf - WRITE(6,1030) - END IFT - - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper caseL - - BLOCK_SAVE = BLOCKu - LENGTH_SAVE = LENGTHI - BULL_POINT_SAVE = BULL_POINT - - IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT - WRITE (6,'(''+Quit'',$)') - RETURN - ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directoryT - WRITE (6,'(''+Dir'',$)') - REDO = .TRUE.U - RETURN - ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THENI - ! If F then copy bulletin to fileG - WRITE (6,'(''+ '')') ! Move cursor from end of prompt lineD - ! to beginning of next line. - IF (LEN_FILE_DEF.EQ.0) THENo - CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF)I - IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', - & BULL_PARAMETER,CONTEXT) - IF (IER) THEN - FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]'L - LEN_FILE_DEF = ILEN + 5 - ELSEe - FILE_DEF = 'SYS$LOGIN:' - LEN_FILE_DEF = 10 - END IF - END IF - - LEN_FOLDER = TRIM(FOLDER)U - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,S - & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// - & FOLDER(:LEN_FOLDER)//'.LIS) ') - - IF (LEN_P.EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) - & //'.LIS' - LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 - ELSE - IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) - IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 - & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN - BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//Q - & BULL_PARAMETER(:LEN_P) - LEN_P = LEN_P + LEN_FILE_DEFQ - END IFC - END IF - - BULL_POINT = BULL_POINT_READ - INCMD = 'FILE '//BULL_PARAMETER(:LEN_P) - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL FILE(READ_COUNT)S - GO TO 11 - ELSE IF (INREAD.EQ.'P') THENA - WRITE (6,'(''+P'',$)') - BULL_POINT = BULL_POINT_READ - IF (REMOTE_SET.GE.3.OR.T - & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN - WRITE(6,1040) - CALL GET_INPUT_NOECHO(INREAD) - CALL STR$UPCASE(INREAD,INREAD)I - IF (INREAD.EQ.'P') THEN - WRITE (6,'(''+P'',$)')I - INCMD = 'REPLY' - ELSE IF (INREAD.EQ.'U') THENC - WRITE (6,'(''+U'',$)')f - INCMD = 'RESPOND' - ELSE IF (INREAD.EQ.'B') THEN) - WRITE (6,'(''+B'',$)')G - INCMD = 'RESPOND/LIST'L - ELSEI - GO TO 11: - END IF - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL RESPOND - ELSE IF (READ_ONLY) THEN - WRITE (6,'( - & '' ERROR: You do not write access to this folder.'')')r - ELSE - INCMD = 'REPLY' - IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL REPLY - END IF - GO TO 11 - ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THENd - ! If NEXT and last bulletins not finished - READ_COUNT = 0 ! Reset read bulletin counter - CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin -20 CALL READDIR(BULL_POINT+1,IER) - IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin - CALL CLOSE_BULLDIR ! Exit= - WRITE(6,1010) - RETURNl - ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN - BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it - GO TO 20 ! Look for more bulletins - END IF - CALL CLOSE_BULLDIR - ELSE IF (INREAD.EQ.'R') THENT - WRITE (6,'(''+Read'')')D - WRITE (6,'('' Enter message number: '',$)') - CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input - CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case - READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READR - IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN - WRITE (6,'('' ERROR: Invalid message number specified.'')') - GO TO 12 - ELSE - GO TO 3 - END IF - ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THENN - WRITE(6,1010)Y - RETURN - END IF - IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 - GO TO 5 - -1000 FORMAT(' Read messages? Type N(No),E(Exit),message',o - & ' number, or any other key for yes: ',$) -1010 FORMAT(' No more messages.')9 -1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),', - & 'R(Read msg #),P(Reply) or other for next message: ',$) -1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', - & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$)A -1040 FORMAT(' Type P to post reply, U to reply to user,',. - & ' B to do both, or other to quit: ',$)I - - END - - - - - SUBROUTINE SET_DEFAULT_EXPIRE -CT -C SUBROUTINE SET_DEFAULT_EXPIRE -C -C FUNCTION: Sets default expiration date. -CT - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFOLDER.INC'I - - INCLUDE 'BULLUSER.INC') - - CHARACTER EXPIRE*3T - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN2 - IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)Z - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THENI - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - ELSE IF (TEMP.LT.-1) THEN - WRITE (6,'('' ERROR: Expiration must be > -1.'')')G - ELSE - FOLDER_BBEXPIRE = TEMPP - WRITE (6,'('' Default expiration modified.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER)G - CALL CLOSE_BULLFOLDERD - ELSEO - WRITE (6,'('' You are not authorized to set expiration.'')') - END IFT - - RETURNT - END - - - - - LOGICAL FUNCTION NEWS_FEED()F - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLFOLDER.INC'L - - NEWS_FEED = .FALSE. - - SLIST = INDEX(FOLDER_DESCRIP,'<') - IF (SLIST.GT.0) THEN) - I = SLIST + 1R - FLEN = TRIM(FOLDER_DESCRIP)= - DO WHILE (I.LE.FLEN) - IF (FOLDER_DESCRIP(I:I).EQ.'>') THENo - I = FLEN + 1L - ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. - & FOLDER_DESCRIP(I:I).GT.'Z').AND. - & FOLDER_DESCRIP(I:I).NE.':'.AND.C - & FOLDER_DESCRIP(I:I).NE.'@'.AND.I - & FOLDER_DESCRIP(I:I).NE.'%') THEN - I = I + 1 - ELSEM - I = FLEN + 2I - END IF_ - END DO - IF (I.EQ.FLEN+1) NEWS_FEED = .TRUE. - END IFN - - RETURN. - END diff --git a/decus/vax92b/bulletin/bulletin10.for b/decus/vax92b/bulletin/bulletin10.for deleted file mode 100644 index bf2b34a..0000000 --- a/decus/vax92b/bulletin/bulletin10.for +++ /dev/null @@ -1,2836 +0,0 @@ -C -C BULLETIN10.FOR, Version 12/28/92 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - INTEGER FUNCTION NEWS_READ() - - IMPLICIT INTEGER (A-Z) - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - NEWS_READ = 1 - - IF (END_READ.EQ.0) THEN - IER = NEWS_READ_PACKET(BUFFER(:1024)) - IF (IER.LE.0) THEN - CALL NEWS_LOGOUT - NEWS_READ = 0 - RETURN - END IF - START_READ = 1 - END_READ = IER - END IF - - IF (END_READ.EQ.0) THEN - NEWS_READ = 0 - RETURN - END IF - - DO WHILE (1) - END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) - IF (END_LINE.GT.257.OR. - & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN - END_LINE = 255 - END IF - IF (END_LINE.GT.0) THEN - SB = START_READ - END_LINE = END_LINE + SB - 1 - EB = END_LINE - 2 - IF (BUFFER(EB+2:EB+2).NE.LF) EB = EB + 2 - IF (END_LINE.LT.END_READ) THEN - START_READ = END_LINE + 1 - ELSE - END_READ = 0 - END IF - RETURN - ELSE - BUFFER = BUFFER(START_READ:END_READ) - END_READ = END_READ - START_READ + 1 - IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) - IF (IER.LE.0) THEN - NEWS_READ = 0 - RETURN - ELSE - START_READ = 1 - END_READ = END_READ + IER - END IF - END IF - END DO - - RETURN - END - - - - - INTEGER FUNCTION NEWS_WRITE(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - PARAMETER CR = CHAR(13), LF = CHAR(10) - - COMMON /NEWS_INIT/ END_READ - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POST - - CHARACTER*(*) WRITE - - LOGICAL TRY_RECONNECT/.FALSE./ - - IF (LOCAL_POST) THEN - WRITE (8,'(A)') WRITE - DO I=1,LEN(INPUT),255 - CALL COMPRESS(WRITE,INPUT,L) - LENGTH = LENGTH + MAX(1,L) + 1 - END DO - NEWS_WRITE = .TRUE. - RETURN - END IF - - END_READ = 0 - - IF (WRITE.EQ.' ') THEN - NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) - ELSE - NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) - END IF - - IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN - TRY_RECONNECT = .TRUE. - CALL NEWS_RECONNECT(WRITE) - TRY_RECONNECT = .FALSE. - END IF - - RETURN - END - - - - - SUBROUTINE NEWS_RECONNECT(WRITE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - CHARACTER*(*) WRITE - - CHARACTER*8 NUMBER - - CHARACTER*(FOLDER_RECORD) FOLDER2_COM - - CALL NEWS_LOGOUT - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN - FOLDER2_COM = FOLDER1_COM - FOLDER1 = FOLDER - FOLDER1_DESCRIP = FOLDER_DESCRIP - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - FOLDER1_COM = FOLDER2_COM - - IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END IF - - IF (.NOT.NEWS_WRITE(WRITE)) RETURN - - RETURN - END - - - - SUBROUTINE NEWS_LOGOUT - - IMPLICIT INTEGER (A-Z) - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - CALL NEWS_DISCONNECT - NEWS_CONNECTED = .FALSE. - - RETURN - END - - - - SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) SUBJ,FOLDER1_COM - - IF (REMOTE_SET.EQ.1) THEN - WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 4,SBULL,IMMEDIATE,SUBJ - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - IF (TEST_NEWS_OWNER()) THEN - CALL NEWS_POST('cancel',0,IER,'Delete news item.') - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Not owner of message.'')') - END IF - IER = 0 - END IF - - RETURN - END - - - - - LOGICAL FUNCTION TEST_NEWS_OWNER() - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /PATH/ PATHNAME,LPATH - CHARACTER*132 PATHNAME - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID - - CHARACTER*12 HIGHFROM - - CALL STR$UPCASE(HIGHFROM,FROM) - IF (LPATH.EQ.0) CALL GET_PATHNAME - TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. - & (HIGHFROM.EQ.USERNAME.AND. - & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): - & TRIM(MESSAGE_ID)).EQ. - & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) - - RETURN - END - - - INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,FIND - - FIRST_INDEX = 0 - - DO I=1,LEN(FIND) - J = INDEX(INPUT,FIND(I:I)) - IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) - & FIRST_INDEX = J - END DO - - RETURN - END - - - - SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /XHDR/ XHDR - LOGICAL XHDR /.FALSE./ - - COMMON /POINT/ BULL_POINT - - CHARACTER*8 NUMBER,NUMBER1 - - CHARACTER*1024 TEMP - - DATA QXHDR1 /0/ - - IF (XHDR) THEN - IF (QXHDR1.NE.0) THEN ! Is queue empty? - QXHDR = QXHDR1 ! No, set queue pointer to head - ELSE ! Else if queue is empty - CALL INIT_QUEUE(QXHDR,TEMP) - QXHDR1 = QXHDR ! Init header pointer - END IF - END IF - - SYSTEM = 0 - - IF (REMOTE_SET.EQ.1) THEN - IF (REVERSE) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START - ELSE - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END - END IF - ELSE - IER = 2 - NUMDIR = END - START + 1 - IF (START.LT.F_START) THEN - START = F_START - END = START + NUMDIR - 1 - END IF - END IF - - IF (REMOTE_SET.EQ.3.AND.XHDR) THEN - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - NUMDIR1 = 0 - DO WHILE (NUMDIR1.LT.NUMDIR) - IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (NUMDIR1.EQ.0) THEN - IER = 0 - END = START - 1 - RETURN - ELSE - NUMDIR = NUMDIR1 - END IF - ELSE - IF (.NOT.NEWS_READ()) RETURN - IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.'.AND..NOT. - & OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ')+SB-2) - & ,START,,%VAL(1))) RETURN - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (NUMDIR1.LT.NUMDIR) THEN - NUMDIR1 = NUMDIR1 + 1 - TEMP = BUFFER(SB:EB) - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - END IF - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (NUMDIR1.EQ.0) THEN - IF (START.LE.F_START) RETURN - START = MAX(F_START,START-NUMDIR) - END = START + NUMDIR - 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - ELSE IF (NUMDIR1.LT.NUMDIR) THEN - IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) - & RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - NUMDIR = NUMDIR1 - ELSE - NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) - IF (.NOT.OTS$CVT_TI_L(NUMBER, - & MSG_NUM,,%VAL(1))) RETURN - DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') - NUMBER = ' '//NUMBER(1:) - END DO - MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 - IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN - DO WHILE (NUMBER1(1:1).EQ.' ') - NUMBER1 = NUMBER1(2:) - END DO - END IF - END IF - END IF - END DO - CALL OTS$CVT_L_TI(START,NUMBER,,,) - NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) - END = START + NUMDIR - 1 - DO I=1,2 - IF (I.EQ.1.AND..NOT.NEWS_WRITEt - & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURNM - IF (I.EQ.2.AND..NOT.NEWS_WRITEE - & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN - IF (.NOT.NEWS_READ()) RETURN* - IF (BUFFER(:2).EQ.'22') THEN= - QXHDR = QXHDR1O - IF (.NOT.NEWS_READ()) RETURNE - NUMDIR1 = 0 - DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) - NUMDIR1 = NUMDIR1 + 1 - CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) - SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1= - SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1A - TEMP(I*256+1:) = BUFFER(SB1:EB)E - CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - IF (.NOT.NEWS_READ()) RETURN - END DO( - END IF. - END DO - QXHDR = QXHDR1 - IER = 0A - ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN5 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') THEN - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURN1 - IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4:D - & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN - IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THENR - BUFFER(:3) = '500'N - DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') - START = START + 1 - IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - END DO - IF (BUFFER(:2).NE.'22') THENI - IER = 0I - END = START - 1C - RETURN - END IFR - END IFR - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURNL - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - END = START + NUMDIR - 1 - END IF - IER = 0 - END IFT - - IF (IER.EQ.0) THEN - I = STARTT - DO WHILE (IER.EQ.0.AND.I.LE.END) - IF (REMOTE_SET.EQ.1) THEN - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY - ELSE IF (XHDR) THEN - CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) - LTEMP = INDEX(TEMP,' ') - CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1))I - CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) - DESCRIP = TEMP(257:512) - CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768))) - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) - CALL NEWS_HEADER(IER) - IF (IER.NE.0) RETURNM - END IFL - CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) - I = I + 1 - IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THENN - IER = 2 - IF (.NOT.NEWS_WRITE('NEXT')) RETURN - IF (.NOT.NEWS_READ()) RETURNO - IF (BUFFER(:3).NE.'223') THEN - END = I - 1 - IER = 0P - RETURN - END IF) - IF (.NOT.NEWS_WRITE('HEAD')) RETURN - IF (.NOT.NEWS_READ()) RETURNT - IER = 0 - END IFN - END DO - END IF - - IF (REMOTE_SET.EQ.3) THEN - IER = 1U - IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURNO - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURN - IER = 0E - END IF - - RETURNN - END - - - - INTEGER FUNCTION NEWS_LOGIN - - IMPLICIT INTEGER (A-Z)C - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTEDB - LOGICAL NEWS_CONNECTED /.FALSE./T - - COMMON /XHDR/ XHDRR - LOGICAL XHDR /.FALSE./A - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - IF (.NOT.NEWS_CONNECTED) THEN - NEWS_LOGIN = .FALSE. - CALL START_NEWS_TIMER()N - NEWS_CONNECTED = NEWS_CONNECT()= - CALL CANCEL_NEWS_TIMER() - IF (.NOT.NEWS_CONNECTED) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (.NOT.NEWS_WRITE('XHDR')) RETURNF - IF (.NOT.NEWS_READ()) RETURN - XHDR = BUFFER(:3).NE.'500' - END IFS - - NEWS_LOGIN = .TRUE. - - RETURNt - END - - - SUBROUTINE CONVERT_TO_GMT(BTIM) - - IMPLICIT INTEGER (A-Z) - - DIMENSION GMT_DIFF(2),BTIM(2) - - CHARACTER HOUR*4E - DATA HOUR /' '/ - - PARAMETER NZONES = 4F - - COMMON /ZONE/ ZONE,LZONE - - CHARACTER ZONES*(NZONES*4)C - CHARACTER*4 HOURS(NZONES),ZONEU - DATA ZONES /'EST CST MST PST '/ - DATA HOURS /'5','6','7','8'/T - - TO_GMT = .TRUE. - - ENTRY CONVERT_FROM_GMT(BTIM)M - - IF (HOUR.EQ.' ') THEN - IF (SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN - ZONE = 'GMT'H - ELSE IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) - & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THENE - HOUR = HOURS((INDEX(ZONES,ZONE)+3)/4) - ELSE - ZONE = 'GMT'_ - HOUR = '00' - END IF - IER = OTS$CVT_TI_L(HOUR(:TRIM(HOUR)),DIFF,,%VAL(1))I - IF (DIFF.LT.0) THEN - PAST = .TRUE. - HOUR = HOUR(2:) - ELSE IF (DIFF.GT.12) THEN - PAST = .TRUE. - DIFF = 24 - DIFF0 - IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) - IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) - ELSE - PAST = .FALSE.D - END IF - LZONE = TRIM(ZONE) - IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR))//':00',GMT_DIFF)N - END IFC - - IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THENA - IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) - ELSEO - IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) - END IFC - - TO_GMT = .FALSE. - - RETURNI - END - - - - - SUBROUTINE START_NEWS_TIMER() - - IMPLICIT INTEGER (A-Z) - - INTEGER TIMADR(2) ! Buffer containing timeD - ! in desired system format. - CHARACTER TIMBUF*16,SEC*4 - DATA TIMBUF/'0 00:00:00.00'/L - - EXTERNAL KILL_NEWS_CONNECT - - IF (TIMBUF(9:10).EQ.'00') THEN - CALL LIB$GET_EF(WAITEFN) - TIMBUF(9:10) = '30'F - IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN1 - IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1))T - IF (IER.AND.I.GT.0) THEN - IF (TRIM(SEC).EQ.1) THEN_ - TIMBUF(9:10) = '0'//SEC(:1)D - ELSE - TIMBUF(9:10) = SEC - END IF= - END IF1 - END IF - IER = SYS$BINTIM(TIMBUF(:13),TIMADR) - END IF - - IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) - - RETURNA - - ENTRY CANCEL_NEWS_TIMER() - - IER = SYS$CANCEL(%VAL(WAITEFN)) - - RETURNN - END - - - SUBROUTINE KILL_NEWS_CONNECT() - - IMPLICIT INTEGER (A-Z). - - COMMON /NEWS_CONNECTED/ NEWS_CONNECTED - - IF (NEWS_CONNECTED) RETURNI - - NLUN = NEWS_GET_CHAN() - - IER = SYS$CANCEL(%VAL(NLUN)) - - CALL NEWS_DISCONNECT() - - RETURN - END - - - - SUBROUTINE NEWS_HEADER(IER) - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREFD - CHARACTER*256 REFERENCES - - COMMON /NEWSGROUPS/ NEWSGROUPS) - CHARACTER*256 NEWSGROUPS. - - COMMON /HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINEV - CHARACTER*256 FROM_LINE,SUBJECT_LINE' - CHARACTER*12 MSGNUM - - EX_BTIM(1) = 0E - EX_BTIM(2) = 0 - - DESCRIP = ' ' - FROM = ' 'F - SUBJECT_LINE = ' 'T - FROM_LINE = ' ' - NEWSGROUPS = ' ' - LREF = 0M - - MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4)L - - DO WHILE (BUFFER(SB:EB).NE.'.') - IER = NEWS_READ()D - IF (.NOT.IER) RETURN - IF (BUFFER(SB:EB).NE.'.') THEN - IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THENR - SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 - SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) - DESCRIP = BUFFER(SB1:EB)( - ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN - CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) - ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN - CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) - ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THENW - SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 - FROM_LINE = 'From: '//BUFFER(SB1:EB). - CALL GET_FROM(BUFFER(SB1:EB),EB-SB1+1) - ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND.S - & EB.GT.SB+11) THEN( - NEWS_MSGID = BUFFER(SB+13:EB-1) - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(SB+12:EB) - END IFN - LREF = TRIM(REFERENCES) - ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. - & EB.GT.SB+11) THENF - SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 - NEWSGROUPS = BUFFER(SB1:EB) - ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. - & EB.GT.SB+11) THEN - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(SB+12:EB)/ - ELSE- - REFERENCES = BUFFER(SB+12:EB)//' '//W - & REFERENCES(:LREF) - END IF - LREF = TRIM(REFERENCES). - END IFT - END IF - END DOE - - IER = 0 - - RETURN - END - - - - INTEGER FUNCTION FIRST_ALPHA(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' 'R - END DO - - DO FIRST_ALPHA=1,LEN(INPUT) - IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN - END DOI - - RETURNU - END - - - - - SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - - IMPLICIT INTEGER (A-Z)X - - INCLUDE 'BULLFOLDER.INC'N - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - CHARACTER*8 NUMBERT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCHT - ELSE - IER = 2E - IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START: - IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN. - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:2).NE.'22') RETURN - IER = 0) - END IF - - RETURNB - END - - - - SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READITT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EBF - CHARACTER BUFFER*1280 - - DIMENSION IN_BTIM(2)F - - CHARACTER TIME*20,FIRST*80E - - CHARACTER*8 NUMBERR - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) - IF (IER.EQ.0) THEN - READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START - END IF - ELSE IF (READIT.EQ.1) THENT - I = NEWS_FIND_SUBSCRIBE()A - START = (LAST_NEWS_READ2(2,I).AND.'3FFF'X) + - & LAST_NEWS_READ(2,I) + 1 - IF (START.GT.F_NBULL) THEN - START = -1 - ELSE - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I))R - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)E - END IF - ELSET - START = -1 - IER = SYS$ASCTIM(,TIME,IN_BTIM,) - CALL DATE_TIME(TIME) - SKIP = 0 - DO WHILE (1) - IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM(: - & FOLDER_NAME))//' '//TIME)) RETURNP - IF (.NOT.NEWS_READ()) RETURNO - IF (BUFFER(:2).EQ.'23') THEND - IF (.NOT.NEWS_READ()) CALL EXIT - DO I=1,SKIP - IF (.NOT.NEWS_READ()) CALL EXITR - END DO - FIRST = BUFFER(SB:EB) - IF (FIRST.EQ.'.') RETURNI - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL EXITR - END DON - IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST))))E - & CALL EXIT - IF (.NOT.NEWS_READ()) CALL EXIT - IF (BUFFER(:2).EQ.'22') THEN - IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN - I = F_NBULL + 1 - DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. - & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) - & .OR.I.GT.F_NBULL)) - I = I - 1 - IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURNN - IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN - IF (.NOT.NEWS_READ()) RETURNE - END DOR - IF (I.GE.F_START) START = I - ELSE - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))R - END IF - RETURN - END IFB - END IFB - SKIP = SKIP + 1 - END DO - END IFS - - RETURN - END - - - - SUBROUTINE REMOTE_COPY_BULL(IER)N - - IMPLICIT INTEGER (A-Z)E - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 - ELSEF - END IFW - - RETURND - END - - - - SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) - - IMPLICIT INTEGER (A-Z)D - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUTG - - IF (REMOTE_SET.EQ.1) THEN - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT - ELSE* - END IF - - RETURN - END - - - - SUBROUTINE GET_REMOTE_MESSAGE(IER)Z -C -C SUBROUTINE GET_REMOTE_MESSAGE -CA -C FUNCTION: -C Gets remote message. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($RMSDEF)' - - COMMON /BUFFER/ BUFFER,SB,EBI - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - COMMON /REF/ REFERENCES,LREFO - CHARACTER*256 REFERENCESI - - COMMON /NEWSGROUPS/ NEWSGROUPS - CHARACTER*256 NEWSGROUPS/ - - COMMON /HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE - CHARACTER*256 FROM_LINE,SUBJECT_LINE( - CHARACTER*12 MSGNUM - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - - CHARACTER*256 TEMP,TEMP1 - - IF (SCRATCH_R1.NE.0) THEN ! Is queue empty?P - SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to headL - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_R,INPUT) - SCRATCH_R1 = SCRATCH_R ! Init header pointer - END IFN - - ILEN = 128Y - IER = 0 - LENGTH = 0I - LTEMP = 0 - HEADER_SEEN = .FALSE. - - IF (REMOTE_SET.EQ.3) THENN - LSUB = TRIM(SUBJECT_LINE) - LFRO = TRIM(FROM_LINE) - IF (LOCAL_UPDATE1.NE.0) THEN - ILEN = 1 - INPUT(:1) = CHAR(0) - END IF - END IFS - - DO WHILE (ILEN.GT.0.AND.IER.EQ.0) - IF (REMOTE_SET.EQ.1) THENT - READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUTs - ELSE - IF (ILEN.EQ.128) ILEN = 0 - IF (LTEMP.GT.0) THENL - ILEN = MIN(128,LTEMP) - INPUT = TEMP(:ILEN) - LTEMP = LTEMP - ILENA - END IFA - IF (ILEN.LT.128) THEN - IF (LFRO.GT.0) THEN - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) - END IF) - LTEMP = LFRO - LFRO = 0 - IER = 0 - TEMP = CHAR(LTEMP)//FROM_LINEE - LTEMP = LTEMP + 1 - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)S - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (LSUB.GT.0) THENV - IF (LOCAL_UPDATE1.NE.0) THEN - CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) - END IF - LTEMP = LSUB - LSUB = 0 - IER = 0C - TEMP = CHAR(LTEMP)//SUBJECT_LINE - LTEMP = LTEMP + 1( - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP)E - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE0 - IER = NEWS_READ()E - IF (IER.AND.BUFFER(SB:EB).NE.'.') THEN - IER = 0P - LTEMP = EB-SB+1T - IF (LTEMP.GT.0) THEN - TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) - IF (.NOT.HEADER_SEEN) THENC - IF (TRIM(TEMP).EQ.0) THEN - HEADER_SEEN = .TRUE. - ELSE IF (INDEX(TEMP,': ').EQ.0.AND.I - & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( - & TEMP(2:2)).GT.32.AND.LTEMP.LT.255) THENB - TEMP = CHAR(LTEMP+1) - & //' '//BUFFER(SB:SB+LTEMP-1) - LTEMP = LTEMP + 1 - END IFI - END IF) - IF (LOCAL_UPDATE1.NE.0) THENA - CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) - TEMP(:1) = CHAR(LTEMP) - END IF : - ELSE - HEADER_SEEN = .TRUE.C - TEMP = CHAR(1)//' ' - LTEMP = 1 - END IF - LTEMP = LTEMP + 1N - LINP = MIN(LTEMP,128-ILEN) - INPUT = INPUT(:ILEN)//TEMP(:LINP) - ILEN = ILEN + LINP - LTEMP = LTEMP - LINP - TEMP = TEMP(LINP+1:) - ELSE IF (IER) THEN - IER = 0/ - INPUT = INPUT(:ILEN)//CHAR(0)F - ILEN = -1281 - ELSE - ILEN = 128 - END IF - END IFs - ELSES - TEMP = TEMP(129:) - END IF - END IF - IF (IER.NE.0.AND.ILEN.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1)) - IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error1 - IER = 0 - ILEN = 0E - ELSEF - CALL SYS_GETMSG(IER1) - LENGTH = 0S - IER1 = IERD - CALL DISCONNECT_REMOTEN - IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE - END IF - ELSE IF (ABS(ILEN).EQ.128) THENF - CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) - LENGTH = LENGTH + 1 - END IF - END DOf - - RETURNN - END - - - - - SUBROUTINE REMOTE_REMOVE_FOLDER(IER)Q - - IMPLICIT INTEGER (A-Z)= - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - RETURNR - END - - - - SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) -C -C SUBROUTINE CONNECT_REMOTE_FOLDER -CE -C FUNCTION: Connects to folder that is located on other DECNET node.G -CF - IMPLICIT INTEGER (A-Z)) - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_UNIT /15/ - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHE - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)L - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATEE - - COMMON /READIT/ READITE - - COMMON /NEWS_INIT/ END_READ - - INCLUDE 'BULLUSER.INC'N - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE - CHARACTER*44 FOLDER_SAVE - - DIMENSION DUMMY(4)2 - - IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN - END_READ = 0 - IF (.NOT.NEWS_LOGIN()) THEN: - IER = 2 - RETURNL - END IF - CALL NEWS_GROUP(IER) - IF (IER.NE.0) RETURN - IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) - RETURN - END IFN - - REMOTE_UNIT = 31 - REMOTE_UNITI - - SAME = .TRUE. - LEN_BBOARD = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name differentI - SAME = .FALSE. ! from local? Yes. - LEN_BBOARD = LEN_BBOARD - 1T - END IF - - OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,T - & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') - - IF (IER.EQ.0) THENN - IF (.NOT.SAME) THEN. - FOLDER1_FILE = FOLDER_FILE' - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER1M - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE.) - CALL OPEN_BULLDIR - CALL READDIR(0,IER) - CALL CLOSE_BULLDIRF - REMOTE_SET = REMOTE_SET_SAVE+ - FOLDER_FILE = FOLDER1_FILE - FOLDER_SAVE = FOLDER1 - FOLDER1 = BULLDIR_HEADER(13:) - IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) - END IF - SYSLOG = .FALSE. - IF (READIT.EQ.1) THENR - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' - READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 - IF (IER1) THENE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+'/ - SYSLOG = .TRUE. - END IFO - END IF - IF (.NOT.SYSLOG) THENE - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 - END IF - FOLDER_OWNER_SAVE = FOLDER1_OWNERE - FOLDER_BBOARD_SAVE = FOLDER1_BBOARD) - FOLDER_NUMBER_SAVE = FOLDER1_NUMBERL - IF (IER.EQ.0) THEN - IF (SYSLOG) THEND - READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY,T - & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM - ELSE( - READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY,F - & DUMMY(1),DUMMY(2),FOLDER1_COM - END IF - END IF - IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE - FOLDER1_BBOARD = FOLDER_BBOARD_SAVEF - FOLDER1_NUMBER = FOLDER_NUMBER_SAVE - FOLDER1_OWNER = FOLDER_OWNER_SAVE= - END IF - - IF (IER.NE.0.OR..NOT.IER1) THEN - CLOSE (UNIT=REMOTE_UNIT) - REMOTE_UNIT = 31 - REMOTE_UNIT - IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. - & TEST_BULLCP().NE.2) THEN ! Not BULLCP process= - IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)E - & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)E - CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE)A - IF (IER.EQ.0) REWRITE (4) USER_ENTRYT - CALL CLOSE_BULLUSER - END IFH - END IF - IER = 2T - ELSEI - CLOSE (UNIT=31-REMOTE_UNIT) -CT -C If remote folder has returned a last read time for the folder,P -C and if in /LOGIN mode, or last selected folder was a differentN -C folder, or folder specified with "::", then update last read time.R -CT - IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1)T - & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) - & .OR.FOLDER1_NUMBER.EQ.-1) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY)I - IF (SYSLOG) THENU - CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3))/ - END IF - END IF - IER = 0 - END IFR - - RETURNR - END - - - - SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'I - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BUFFER/ BUFFER,SB,EBF - CHARACTER BUFFER*1280 - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_IDT - - COMMON /NEXT/ NEXTM - LOGICAL NEXT /.FALSE./R - - COMMON /NEWGROUP/ NEWGROUPP - - CHARACTER*8 NUMBERC - - DIMENSION IN_BTIM(2)n - - IF (REMOTE_SET.EQ.1) THEN - IF (ICOUNT.GE.0) THENL - WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNTR - ELSE - WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY - END IF - IF (IER.EQ.0) THEN - IF (ICOUNT.EQ.0) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADERR - ELSE IF (ICOUNT.EQ.-1) THEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY - IF (IER1.GT.0) THEN - CALL ERROR_AND_EXIT0 - ELSE IF (IER.NE.0) THEN - CALL CONVERT_ENTRY_FROMBIN - END IF' - RETURNA - ELSEN - READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY - END IFL - END IF - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE IF (ICOUNT.EQ.1) THEN - CALL CONVERT_HEADER_FROMBIN - ELSE - CALL CONVERT_ENTRY_FROMBIN_ - END IF - ELSE IF (REMOTE_SET.EQ.3) THENR - IF (ICOUNT.EQ.0) THENI - NBULL = F_NBULL - ICOUNT = 1 - RETURNF - ELSE IF (ICOUNT.EQ.-1) THENP - IER = 2 - CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) - IF (START.EQ.-1) RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXITT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSE - IER = 2 - IF (NEXT.AND..NOT.NEWGROUP) THENM - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - ELSEE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END IFB - IF (BUFFER(:2).NE.'22') THENR - DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START)H - ICOUNT = ICOUNT - 1T - IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN& - IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) - & CALL ERROR_AND_EXITL - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:2).EQ.'22') THEN - NEXT = .FALSE.L - DO WHILE (BUFFER(SB:EB).NE.'.') - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - END DO - END IF( - END DO - IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN - IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITM - ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THENE - IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT - IF (BUFFER(:3).NE.'223') RETURN - IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT - IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITC - END IFI - END IF - IF (BUFFER(:2).NE.'22') RETURNe - IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), - & ICOUNT,,%VAL(1))S - IF (.NOT.IER) RETURNC - START = ICOUNT= - BULLETIN_NUM = STARTS - END IF - NEWGROUP = .FALSE. - MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) - IER = 0C - CALL NEWS_HEADER(IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - CALL CONVERT_ENTRY_FROMBINQ - END IF - BLOCK = START - MSG_NUM = STARTR - SYSTEM = 0 - IF (ICOUNT.NE.-1) THEN - ICOUNT = ICOUNT + 1 - ELSE - IER = START - END IF - END IFC - - RETURNL - END - - - - - - SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM)e - - IMPLICIT INTEGER (A-Z)F - - INTEGER BTIM(2) - - CHARACTER*8 MSG_KEY,INPUT - - INPUT = MSG_KEY - - DO I=1,8 - INPUT(9-I:9-I) = MSG_KEY(I:I)D - END DO/ - - CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) - - RETURNE - END - - - - SUBROUTINE NEWS_GROUP(IER)D - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLFOLDER.INC'E - - COMMON /BUFFER/ BUFFER,SB,EBC - CHARACTER BUFFER*1280 - - COMMON /NEWGROUP/ NEWGROUP - - IER = NEWS_WRITE('GROUP '// - & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1))A - IF (.NOT.IER) RETURNA - - IER = NEWS_READ() - IF (.NOT.IER) RETURNV - - IF (BUFFER(:3).EQ.'411') RETURN - - NEWGROUP = .TRUE. - - BUFFER = BUFFER(5:) - - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) - IF (.NOT.IER) RETURNF - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1))E - IF (.NOT.IER) RETURNT - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1))* - IF (.NOT.IER) RETURN - BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) - - IER = NEWS_WRITE('STAT') - IF (.NOT.IER) RETURNR - - IER = NEWS_READ() - IF (.NOT.IER) RETURNT - - IER = OTS$CVT_TI_L(BUFFER(SB+4: - & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) - IF (IER.AND.START.GT.F1_START) F1_START = START - - IF (F1_START.EQ.0) F1_NBULL = 0 - - IER = 0 - - RETURNI - END - - - - SUBROUTINE NEWS_TIME(INTIME,BTIM) - - IMPLICIT INTEGER (A-Z)R - - CHARACTER*(*) INTIMEE - - CHARACTER*20 TIME - - I = 1 - LTIME = TRIM(INTIME)D - DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. - & ICHAR(INTIME(I:I)).GT.ICHAR('9')))_ - I = I + 1F - END DO - - IF (I.GT.LTIME) THEN - CALL SYS_BINTIM('-',BTIM)( - RETURN - END IFT - - CALL STR$UPCASE(TIME,INTIME(I:))N - - DO J = 1,2G - I = 1 - DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) - I = I + 1 - END DO - TIME(I:I) = '-'E - END DO) - - IF (I.EQ.LEN(TIME)) RETURNI - - IF (TIME(I+3:I+3).EQ.' ') THEN( - IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN - TIME = TIME(:I)//'19'//TIME(I+1:) - ELSE - TIME = TIME(:I)//'20'//TIME(I+1:) - END IF - END IFF - - I = 1 - DO J = 1,2 - DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) - I = I + 1 - END DO - I = I + 1E - END DOF - - IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) RETURN - - CALL SYS_BINTIM(TIME(:I-2),BTIM)E - - IF (INDEX(INTIME,'GMT').GT.0) CALL CONVERT_FROM_GMT(BTIM) - - RETURN= - END - - - - SUBROUTINE NEWS_LISTM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BUFFER/ BUFFER,SB,EB_ - CHARACTER BUFFER*1280 - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 - DATA LOCAL_UPDATE1/0/ - - CHARACTER TODAY*24O - - DIMENSION EXPIRED(2) - - CALL LIB$DATE_TIME(TODAY) - - IF (.NOT.NEWS_LOGIN()) RETURN - - IF (.NOT.NEWS_WRITE('LIST')) RETURN - IF (.NOT.NEWS_READ()) RETURNB - IF (BUFFER(:3).NE.'215') RETURN - - SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR.B - & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 - - CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER))E - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL OPEN_BULLNEWS_SHARED ! Open folder fileA - - NEWS_FOLDER1_BBOARD = '::'I - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)U - IF (IER1.NE.0) THEN - NEWS_FOLDER1 = 'a' - NEWS_FOLDER1_NUMBER = 1000 - NEWS_F1_COUNT = 1001 - NEWS_F1_EXPIRE = 14a - NEWS_F1_EXPIRE_LIMIT = 0 - NEWS_F1_FLAG = 0 - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)l - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COME - END IF. - NEWS_FLAG_DEFAULT = NEWS_F1_FLAGM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIREO - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMITT - IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 - NEWS_F_COUNT = NEWS_F1_COUNTA - DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') - FLEN = INDEX(BUFFER(SB:),' ') - 1D - NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1)G - IF (IER1.EQ.0) THENO - CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER)' - END IF - SP = FLEN+SB+1 - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1))T - SP = EP + 2E - EP = INDEX(BUFFER(SP:),' ')+SP-2 - IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) - IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - SP = EP + 1N - IF (IER.NE.0.OR.IER1.NE.0) THENQ - CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) - IER2 = 1A - I = FLENI - DO WHILE (IER2.NE.0.AND.I.GT.1) - IF (NEWS_FOLDER(I:I).EQ.'.') THEN - NEWS_FOLDER = NEWS_FOLDER1(:I) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_FOLDER, - & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COMR - END DO - END IF - IF (IER2.NE.0) I = I - 1 - END DO - IF (FLEN.GT.44) THENS - NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)//N - & BUFFER(SP:EB) - ELSE - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB)C - END IFT - IER = 0 - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - DO WHILE (REC_LOCK(IER)) - READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) - END DO - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 - END DOF - NEWS_FOLDER1_NUMBER = NEWS_F_COUNT. - IF (IER2.EQ.0) THEN U - NEWS_F1_FLAG = NEWS_F_FLAG - IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THENI - NEWS_F1_EXPIRE = NEWS_F_EXPIREI - NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT - END IF - ELSE - NEWS_F1_FLAG = NEWS_FLAG_DEFAULT - NEWS_F1_EXPIRE = 0 - NEWS_F1_EXPIRE_LIMIT = 0 - END IF= - CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE)T - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)_ - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)I - IF (BTEST(NEWS_F1_FLAG,8)) THEN . - NEWS_F1_COUNT = 0 - NEWS_F1_START = 0 - NEWS_F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_LAST = 0 - END IF - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - IF (IER.EQ.0) THEN - NEWS_F_COUNT = NEWS_F_COUNT + 1 - IF (BTEST(NEWS_F1_FLAG,8).AND.A - & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IFR - ELSE IF (BTEST(NEWS_F1_FLAG,8).AND./ - & .NOT.BTEST(NEWS_F1_FLAG,9)) THENL - IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. - & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN - IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. - & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN_ - NEWS_F1_LAST = 0 - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMN - END IFT - IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, - & %DESCR(NEWS_FOLDER1_NUMBER)) - END IF - END IF( - ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN - UPDATE = .FALSE.N - IF (FLEN.GT.44) THEN( - IF (NEWS_FOLDER1_DESCRIP.NE.O - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = - & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)L - UPDATE = .TRUE. - END IFW - ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN - NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) - UPDATE = .TRUE. - END IFX - IF (SPECIAL) THEN - IF (UPDATE) THEN( - NEWS_F1_START = F1_START - NEWS_F1_NBULL = F1_NBULL - END IF_ - ELSE IF (.NOT.UPDATE) THENO - UPDATE = F1_START.NE.NEWS_F1_START.OR.( - & F1_NBULL.NE.NEWS_F1_NBULL - END IF - IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - END IF - END DOL - - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)F - NEWS_F1_COUNT = NEWS_F_COUNTU - REWRITE (7) NEWS_FOLDER1_COM - - IF (SPECIAL) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)R - DO WHILE (IER.EQ.0)D - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THENF - NEWS_F1_NBULL = F1_NBULLA - NEWS_F1_START = F1_STARTT - CALL NEWS_GROUP(IER) - IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN - IF (BTEST(NEWS_F1_FLAG,8)) THEN - IF (NEWS_F1_LAST.NE.F1_NBULL.AND. - & F1_START.LE.F1_NBULL) THENF - IF (NEWS_F1_FIRST.GT.F1_START.AND.M - & NEWS_F1_FIRST.GT.F1_NBULL) THEN' - NEWS_F1_LAST = 0 - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COME - END IF - IF (NEWS_F1_LAST.LT.F1_NBULL) THEN - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),I - & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)). - END IF - END IFE - ELSE IF ((F1_START.NE.NEWS_F1_START.OR. - & F1_NBULL.NE.NEWS_F1_NBULL) - & .AND.F1_START.GT.0) THENR - CALL SYS_BINTIM('-',F1_NEWEST_BTIM) - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - END IF - ELSE IF (IER.NE.0.AND.(.NOT.BTEST(NEWS_F1_FLAG,8).OR. - & NEWS_F1_NBULL.LT.NEWS_F1_START)) THEN - DELETE (UNIT=7) - IER = 0R - END IF= - END IFU - END DO - END IF - - CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) - - CALL CLOSE_BULLNEWS - - RETURN - END - - - SUBROUTINE LOWERCASE(INPUT) - - CHARACTER*(*) INPUT - - DO I=1,LEN(INPUT) - IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THENA - INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a'))E - END IF - END DOT - - RETURNH - END - - - - SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLNEWS.INC'T - - INCLUDE 'BULLFOLDER.INC'I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLFILES.INC' - - COMMON /BUFFER/ BUFFER,SB,EBI - CHARACTER BUFFER*1280 - - COMMON /REF/ REFERENCES,LREFO - CHARACTER*256 REFERENCESD - - COMMON /PATH/ PATHNAME,LPATHR - CHARACTER*132 PATHNAMEE - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /MSGID/ MESSAGE_ID - CHARACTER*256 MESSAGE_ID1 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEWSGROUPS/ NEWSGROUPS1 - CHARACTER*256 NEWSGROUPSE - - COMMON /ZONE/ ZONE,LZONE - CHARACTER ZONE*41 - - COMMON /LOCALPOST/ LOCAL_POST - DATA LOCAL_POST /.FALSE./ - - CHARACTER*(*) FILENAME,SUBJECTT - - CHARACTER TODAY*24,GROUPS*256 - - DIMENSION NOW(2) - - IER = 1 - - CREATE = FILENAME(:8).EQ.'newgroup' - - IF (FILENAME.NE.'cancel') THENE - IF (.NOT.FILEOPEN) THENS - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1) - IF (IER1.NE.0) RETURN - END IF - - IER1 = 0 - DO WHILE (IER1.EQ.0) - READ (3,'(A)',IOSTAT=IER1) BUFFER - IF (IER1.NE.0) GO TO 900E - IF (TRIM(BUFFER).GT.0) IER1 = 1 - END DO - - REWIND (UNIT=3) - END IFO - - IER = SYS$GETTIM(NOW) - CALL CONVERT_TO_GMT(NOW)R - IER = SYS$ASCTIM(,TODAY,NOW,) - - NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// - & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) - IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:)P - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_LOGIN()) GO TO 900 - IF (.NOT.NEWS_WRITE('POST')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900 - IF (BUFFER(:3).NE.'340') THENE - WRITE (6,'('' ERROR: Posting not allowed.'')') - GO TO 900 - END IF - ELSEF - I = INDEX(NEWS_MSGID,'.')I - LENGTH = 0 - OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//I - & NEWS_MSGID(:I-1)//l - & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, - & STATUS='NEW',DISPOSE='DELETE',RECL=256) - IF (IER.NE.0) RETURNM - LOCAL_POST = .TRUE.N - CALL INIT_QUEUE(GROUP_LIST1,FOLDER) - GROUP_LIST = GROUP_LIST1T - END IF - - IF (LPATH.EQ.0) CALL GET_PATHNAME - - IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN) - IF (CREATE) THEN - GROUPS = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME))4 - ELSE IF (NEWS_FEED()) THENO - GROUPS = 'Newsgroups: '//FOLDER1_DESCRIP - ELSE IF (.NOT.BTEST(FOLDER_FLAG,8).AND.P - & TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THENF - GROUPS = 'Newsgroups: '//NEWSGROUPS - ELSE - GROUPS = 'Newsgroups: '//FOLDER_NAME2 - END IF - IF (FILENAME.NE.'cancel'.AND..NOT.CREATE) THEN - NGROUPS = 0 - IF (BTEST(FOLDER_FLAG,8)) THEN - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER). - NGROUPS = NGROUPS + 1 - END IF - IF (CLI$PRESENT('GROUPS')) THEN - CALL OPEN_BULLNEWS_SHARED - FLEN = 0A - DO WHILE (CLI$GET_VALUE('GROUPS',FOLDER1_NAME,FLEN) - & .AND.TRIM(GROUPS)+FLEN+1.LE.LEN(GROUPS))E - CALL LOWERCASE(FOLDER1_NAME) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:FLEN),IER1) - IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9)) THEN - - GROUPS = GROUPS(:TRIM(GROUPS))//T - & ','//FOLDER1_NAME(:TRIM(FOLDER1_NAME))+ - IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THENI - CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,E - & FOLDER1) - NGROUPS = NGROUPS + 1 - END IF - END IF - END DO - CALL CLOSE_BULLNEWS - END IFC - END IF - IF (.NOT.NEWS_WRITE(GROUPS(:TRIM(GROUPS)))) GO TO 900 - END IFI - ATSIGN = INDEX(PATHNAME,'@')S - PCSIGN = INDEX(PATHNAME,'%')I - CALL LOWERCASE(USERNAME)) - IF (PCSIGN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900 - ELSEF - IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' - & //USERNAME(:TRIM(USERNAME)))) GO TO 900F - END IF_ - IF (.NOT.NEWS_WRITE('From: '//USERNAME(:TRIM(USERNAME))// - & PATHNAME(:LPATH))) GO TO 900 - CALL STR$UPCASE(USERNAME,USERNAME) - IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) - & GO TO 900 - - IF (INCMD(:2).EQ.'RE') THEN - IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) - & GO TO 900 - END IFS - - IF (NGROUPS.GT.0) THENR - FROM = USERNAMEW - DESCRIP = SUBJECTT - END IFI - - NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) - IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: - & TRIM(NEWS_MSGID))//'>')) GO TO 900 - - TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) - IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:)F - - IF (LORGAN.EQ.0) THEN - IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN - IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION)_ - END IF - LORGAN = TRIM(ORGANIZATION)F - END IFN - - IF (LORGAN.GT.0) THEN - IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN)))_ - & GO TO 900 - END IFF - - IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//_ - & ZONE(:LZONE))) GO TO 900 - - IF (REMOTE_SET.EQ.4.AND..NOT.C - & (CREATE.OR.FILENAME.EQ.'cancel')) THEN - IF (CLI$PRESENT('EXPIRATION')) THEN - IF (.NOT.NEWS_WRITE('Expires: '//EXDATE( - & FIRST_ALPHA(EXDATE):2) - & //' '//EXDATE(4:6)//' '//EXDATE(10:TRIM(EXDATE))_ - & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900U - ELSE - IF ( FOLDER_BBEXPIRE.GT.0) THEN - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE - CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT)S - END IF - EXTIME = '00:00:00.00' - END IF - END IF - - IF (CREATE) THEN - IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) - & RETURNS - END IF - - IF (FILENAME.EQ.'cancel') THEN - IF (.NOT.NEWS_WRITE('Control: cancel <'N - & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURNU - IF (.NOT.NEWS_WRITE('.')) RETURN - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_READ()) RETURN_ - IF (BUFFER(:3).EQ.'240') IER = 0U - ELSE - CLOSE (UNIT=8,STATUS='SAVE')O - IER = 0 - END IF - LOCAL_POST = .FALSE. - RETURN - END IF - - IF (.NOT.NEWS_WRITE(' ')) GO TO 900 - - IER1 = 0E - DO WHILE (IER1.EQ.0)I - READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER - IF (BUFFER(:ILEN).EQ.'.') THEN - BUFFER = '..' - ILEN = 2_ - END IF - IF (IER1.EQ.0.AND..NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 - END DOF - - IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - IF (.NOT.NEWS_READ()) GO TO 900) - IF (BUFFER(:3).EQ.'240') THENR - IER = 0 - ELSE - WRITE (6,'('' ERROR: Server rejected your posting:'')') - WRITE (6,'(1X,A)') BUFFER(SB:EB)) - END IF - ELSE - LENGTH = (LENGTH+127)/128 - GROUP_LIST = GROUP_LIST1 - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - DO I=NGROUPS,1,-1U - CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1)E - FOLDER_NUMBER = -1E - CALL SELECT_FOLDER(.FALSE.,IER)E - IF (IER) THEN W - CALL ADD_LOCAL_NEWS(8) - END IFL - END DO - IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE_ - CALL SELECT_FOLDER(.FALSE.,IER) - END IF - IF (.NOT.NEWS_WRITE('.')) GO TO 900 - CLOSE (UNIT=8,STATUS='SAVE') - IER = 0 - END IFE - -900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) - - LOCAL_POST = .FALSE.T - - RETURNL - END - - - - SUBROUTINE GET_PATHNAME - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'T - - COMMON /PATH/ PATHNAME,LPATHR - CHARACTER*132 PATHNAME( - - IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN) - IF (.NOT.SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME).AND.' - & .NOT.SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME).AND.O - & .NOT.SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME)) THEN - WRITE (6,'('' ERROR: Cannot find local host name.'')')C - RETURN' - END IF - END IFU - - IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME - - CALL LOWERCASE(PATHNAME)B - LPATH = TRIM(PATHNAME)2 - - RETURNO - END - - - - LOGICAL FUNCTION TEST_NEWS(NAME)N - - IMPLICIT INTEGER (A-Z)N - - CHARACTER*(*) NAME1 - - TEST_NEWS = .FALSE. - - DO I=1,LEN(NAME) - IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN - END DO6 - - TEST_NEWS = .TRUE. - - RETURND - END - - - - SUBROUTINE UPDATE_LOCAL_NEWS - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC'O - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1C - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER CNUM*4,NUMBER*8 - EQUIVALENCE (CNUM,NUM) - - CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM), - - LOCAL_UPDATE = LOCAL_UPDATE1 - - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM)O - IF (NUM.EQ.0) RETURN - R - CALL OPEN_BULLNEWS_SHARED - - DO WHILE (1)I - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER)1 - IF (IER.EQ.0) THEN - CALL CLOSE_BULLNEWS - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - LAST = F1_NBULLW - FIRST = F1_START( - IF (IER.EQ.0) THEN - FOLDER_COM = FOLDER1_COM - CALL OTS$CVT_L_TI(F_LAST+1,NUMBER,,,) - REMOTE_SET = 3W - INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( - & FOLDER))//' '//NUMBER//'-LAST' - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.) - CALL OPEN_BULLNEWS_SHARED - IF (REMOTE_SET.EQ.4) THEN - NEW_F_COUNT = F_COUNTF - NEW_NEWS_F_END = NEWS_F_END - CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) - CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) - IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1I - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN - NEWS_F_END = NEW_NEWS_F_END - F_NBULL = NEW_NEWS_F_END - F_COUNT = NEW_F_COUNT - END IF_ - F_LAST = LAST - NEWS_F_FIRST = FIRST - CALL REWRITE_FOLDER_FILE(IER) - END IF - END IF - END IF - CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) - IF (NUM.EQ.0) THEN - CALL CLOSE_BULLNEWS P - RETURNM - END IF - END DO - - RETURNP - END - - - - - SUBROUTINE NEWS2BULLL - - IMPLICIT INTEGER (A-Z)o - - INCLUDE 'BULLFOLDER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER TIME*20,FIRST*80,FOLDER_SAVE*44,BBOARD_SAVE*12S - - CHARACTER*8 NUMBERB - - DIMENSION SAVE_F_NEWEST_BTIM(2),NOW(2)C - - IER = SYS$GETTIM(NOW) - - CALL ALLPRIV - - CALL NEWS_LISTO - - CALL UPDATE_LOCAL_NEWSE - - CALL SEND_POST - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder fileN - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Find folders with news feed - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<') - ELIST = INDEX(FOLDER_DESCRIP,'>') - IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN - IF (FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR.O - & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))) THEND - NUM_FOLDERS = NUM_FOLDERS + 1D - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END IF - END IF - END DOA - - CALL CLOSE_BULLFOLDER ! We don't need file anymore( - - IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXITT - - FOLDER_Q = FOLDER_Q1G - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)/ - POINT_FOLDER = POINT_FOLDER + 1U - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)P - CALL SELECT_FOLDER(.FALSE.,IER) - FOLDER_SAVE = FOLDER - BBOARD_SAVE = FOLDER_BBOARDE - FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) - FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1)S - IF (IER) THEN. - SAVE_LAST = F_LASTJ - CALL OPEN_BULLNEWS_SHARED - FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) - CALL READ_FOLDER_FILE_KEYNAME - & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER)N - CALL CLOSE_BULLNEWS - FOLDER1_DESCRIP = FOLDER_DESCRIPD - IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)P - IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM - IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THENT - SAVE_LAST = F_NBULL6 - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) - F_LAST = SAVE_LASTM - FOLDER_BBOARD = 'NONEFEED' - CALL REWRITE_FOLDER_FILE(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. - & F_NBULL.GE.F_START) THEN - REMOTE_SET = 3N - IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1)I - & SAVE_LAST = F_START-1 - SAVE_LAST = MAX(F_START-1,SAVE_LAST)Z - CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) - INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM( - & FOLDER_SAVE))//' '//NUMBER//'-LAST' - SAVE_LAST = F_NBULL - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - CALL MOVE(.FALSE.)' - CALL OPEN_BULLFOLDERE - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1)( - IF (IER1.EQ.0) THEN - F_LAST = SAVE_LAST - CALL REWRITE_FOLDER_FILE(IER1)E - END IFD - CALL CLOSE_BULLFOLDER - END IF - END IF - END DOD - - CALL EXIT - END - - - - SUBROUTINE DATE_TIME(TIME) - - IMPLICIT INTEGER (A-Z)0 - - CHARACTER*36 MONTH - DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/r - - CHARACTER*(*) TIMEI - - NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 - - IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' - - TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+A - & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)//U - & TIME(16:17)//TIME(19:20)_ - - RETURNN - END - - - - SUBROUTINE ALLPRIVT - - IMPLICIT INTEGER (A-Z). - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - PROCPRIV(1) = -1 - PROCPRIV(2) = -1N - NEEDPRIV(1) = -1T - NEEDPRIV(2) = -1U - - RETURN - END - - - - SUBROUTINE NEWS_NEW_FOLDER - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLFOLDER.INC', - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COMN - - NEWS_FOLDER1 = FOLDER1 - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) - - DO WHILE (IER.EQ.0) - READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) - IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1T - END DOO - - NEWS_FOLDER1_NUMBER = NEWS_F_COUNTT - CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - - READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_F1_COUNT = NEWS_F_COUNTR - REWRITE (7) NEWS_FOLDER1_COM - - RETURN( - END - - - - SUBROUTINE SUBSCRIBEL - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLUSER.INC'B - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: Selected folder is not a news folder.'')')R - RETURN - END IFA - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. - & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) - I = I + 1_ - END DOC - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: Cannot subscribe. You have '', - & '' reached the news folder limit of '',I,''.'')') - & FOLDER_MAX-1 - RETURN - ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN - WRITE (6,'('' You are already subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSER - WRITE (6,'('' You are now subscribed to '',A,''.'')')E - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IFA - - CALL OPEN_BULLNEWS_SHARED - DO J=I,1,-1 - IF (J.GT.1) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(& - & ZEXT(LAST_NEWS_READ2(1,J-1)),IER)) - IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1))A - END IF1 - END IF - IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THENI - LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER - IF (F_START.LE.F_NBULL) THENN - LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1))S - LAST_NEWS_READ(2,J) = F_START - 1 - ELSE. - LAST_NEWS_READ2(2,J) = 0 - LAST_NEWS_READ(2,J) = F_NBULL - END IFD - CALL CLOSE_BULLNEWS - RETURN - END IF - END DOR - - END - - - - - - SUBROUTINE UNSUBSCRIBE - - IMPLICIT INTEGER (A-Z). - - INCLUDE 'BULLUSER.INC'N - - INCLUDE 'BULLFOLDER.INC'D - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - RETURN - ELSEN - WRITE (6,'('' You are now no longer subscribed to '',A,''.'')')O - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - END IFU - - DO J=I,FOLDER_MAX-2 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1))L - END DOR - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0E - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - - CALL FREE_TAGS(I) - - RETURNL - END - - - - SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'R - - INCLUDE 'BULLFOLDER.INC' - - I = NEWS_FIND_SUBSCRIBE() - - IER = LAST_NEWS_READ(2,I) + 1 - - IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN - IER = 0 - RETURN - END IFI - - RETURNY - END - - - - SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'A - - INCLUDE 'BULLFOLDER.INC'S - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) RETURN - - IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR. - & (LAST_NEWS_READ(2,I).GT.F_NBULL.AND.F_START.LE.F_NBULL)) THEN - LAST_NEWS_READ(2,I) = NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER)I - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)_ - END IFI - - RETURNG - END - - - - - - SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) - - IMPLICIT INTEGER (A-Z)W - - INCLUDE 'BULLUSER.INC' - - IF (SUBNUM.EQ.0) THEN - COUNT = 0F - SUBMSG = LAST_NEWS_READ(2,1) - RETURN - ELSE IF (SUBNUM.EQ.-1) THEN - DO J=COUNT,FOLDER_MAX-1 - CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) - END DO - - LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 - LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 - ELSE IF (SUBNUM.GT.0) THEN% - COUNT = COUNT + 1_ - END IFU - - IF (COUNT.LE.FOLDER_MAX-1) THEN - SUBNUM = LAST_NEWS_READ2(1,COUNT)T - SUBMSG = LAST_NEWS_READ(2,COUNT) - ELSE - SUBNUM = 0 - END IFB - - RETURNP - END - - - - - SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES)O -CC -C SUBROUTINE NEWS_NEW_NOTIFICATIONC -C - - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'E - - COMMON /READIT/ READITT - - COMMON /POINT/ BULL_POINT - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)B - - MESSAGES = .FALSE.A - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) - - CALL OPEN_BULLNEWS_SHARED - SUBNUM = 1L - - FOLDER_DESCRIP = ' ' - REORDER = 0 - DO WHILE (SUBNUM.GT.0)O - IER = 1_ - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)H - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)I - FOLDER1_DESCRIP = FOLDER_DESCRIPd - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) - UNLOCK 7= - IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1_ - IF (IER.EQ.0.AND. - & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THENC - CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) - ELSE IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR.I - & F_START.GT.F_NBULL) THENE - IER = 1I - END IFE - END IF - IF (IER.EQ.0.AND.SUBNUM.GT.0) THENW - IF (READIT.EQ.1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND.T - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THENL - IER = 1 - ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR.L - & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (DIFF.GT.0) IER = 1( - END IF - END IF+ - END IFR - END DO - IF (READIT.EQ.0.AND.SUBNUM.GT.0) THENS - WRITE (6,'('' There are new messages in folder '',L - & A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)D - MESSAGES = .TRUE. - ELSE IF (SUBNUM.GT.0) THEN - IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) - & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN - WRITE (6,'('' There are new messages in folder '' - & A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)F - ELSE - CALL CLOSE_BULLNEWS - CALL SELECT_FOLDER(.FALSE.,IER1) - IF (IER1) THEN6 - CALL LOGIN_FOLDER - IF (BULL_POINT.NE.-1) THEN - IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN - SAVE_BULL_POINT = BULL_POINT - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY - BULL_POINT = SAVE_BULL_POINT - END DO_ - END IFS - END IF - END IF_ - CALL OPEN_BULLNEWS_SHARED - END IF - END IF - END DOS - - IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBET - - CALL CLOSE_BULLNEWS - - RETURN - END - - - SUBROUTINE REORDER_SUBSCRIBEI - - IMPLICIT INTEGER (A-Z)/ - - INCLUDE 'BULLFOLDER.INC'_ - - INCLUDE 'BULLUSER.INC'A - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.0)C - I = I + 1. - END DOL - - I = I - 1 - - DO I1=1,I-1 - DO J=1,I-I1F - K = J + 1 - S1 = LAST_NEWS_READ2(1,J) - S2 = LAST_NEWS_READ2(1,K) - CALL READ_FOLDER_FILE_KEYNUM(S1,IER)E - CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER) - IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN - DO L=1,2P - TEMP = LAST_NEWS_READ(L,J)T - LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K)V - LAST_NEWS_READ(L,K) = TEMP - END DOI - END IF( - END DO - END DOM - - RETURN - END - - - - - LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)0 - - IMPLICIT INTEGER (A-Z)0 - - INCLUDE 'BULLUSER.INC'0 - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN1 - TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) - RETURN - END IF - - I = NEWS_FIND_SUBSCRIBE() - - TEST_SET_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14)I - - RETURN - END - - - - - LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER)I - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC' - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENO - TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) - RETURN - END IFI - - I = NEWS_FIND_SUBSCRIBE() - - TEST_BRIEF_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15) - - RETURNR - END - - - - - LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) - - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC'R - - IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN1 - TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) - RETURN - END IFD - - I = NEWS_FIND_SUBSCRIBE() - - TEST_NOTIFY_FLAG = .FALSE. - - IF (I.GT.FOLDER_MAX-1) RETURN - - TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) - - RETURN_ - END - - - - INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() - - IMPLICIT INTEGER (A-Z)o - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'D - - I = 1 - DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER - & .AND.I.LE.FOLDER_MAX-1) - I = I + 1 - END DO - - NEWS_FIND_SUBSCRIBE = I - - RETURN - END - - - - - SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'' - - I = NEWS_FIND_SUBSCRIBE() - - IF (I.GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURN - END IFd - - IF (NOTIFY.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13)E - IF (NOTIFY.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) - IF (READNEW.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) - IF (READNEW.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) - IF (BRIEF.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) - IF (BRIEF.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) - - CALL UPDATE_USERINFO- - - RETURN - END - - - - SUBROUTINE ADD_LOCAL_NEWS(UNIT)R - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT) - - REWIND UNIT - S - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) - - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL SET_BULLFIL_UPDATE - OBLOCK = NBLOCK + 1 - CALL COPY_BULL(UNIT,1,OBLOCK,IER) - IF (IER.NE.0) THEN_ - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - RETURN - END IF - LENGTH = OCOUNT - (NBLOCK + 1) + 1 - NBLOCK = NBLOCK + LENGTH + 1 - SYSTEM = 0U - CALL ADD_ENTRY - CALL CLOSE_BULLFIL - CALL UPDATE_NEWS_FOLDER - CALL CLOSE_BULLDIR - - RETURN - END, - - - - SUBROUTINE UPDATE_NEWS_FOLDER -CL -C SUBROUTINE UPDATE_NEWS_FOLDER -CR -C FUNCTION: Updates folder info due to new message. -C' - - IMPLICIT INTEGER (A-Z): - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - NEW_NEWS_F_END = NEWS_F_END - NEW_F_COUNT = F_COUNT - - CALL OPEN_BULLNEWS_SHARED - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (NEW_NEWS_F_END.GT.NEWS_F_END) THENR - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWS_F_NEWEST_BTIM)N - F_NBULL = NEW_NEWS_F_END - NEWS_F_END = NEW_NEWS_F_ENDR - F_COUNT = NEW_F_COUNTB - END IF - - IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1R - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) - & NEWS_F_EXPIRED_DATE = NEWS_NEWEST_EX_BTIM_KEY(5:)E - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURNI - END - - - - SUBROUTINE SEND_POSTU - - IMPLICIT INTEGER (A-Z) ( - - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLDIR.INC' - - COMMON /BUFFER/ BUFFER,SB,EB - CHARACTER BUFFER*1280_ - D - CHARACTER FILE*132 - - - C = 0 - - IF (.NOT.NEWS_LOGIN()) RETURN0 - DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'*.POST',FILE,C)) - IF (.NOT.NEWS_WRITE('POST')) RETURN - IF (.NOT.NEWS_READ()) RETURN - IF (BUFFER(:3).NE.'340') RETURN - U - OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') - DO WHILE (IER.EQ.0)T - READ (3,'(Q,A)',IOSTAT=IER) I,INPUT - IF (IER.EQ.0) THEN E - IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 - END IFG - END DON - IF (INPUT.NE.'.') THEN I - IF (.NOT.NEWS_WRITE('.')) GO TO 100 - END IF - IF (.NOT.NEWS_READ()) GO TO 100 - CLOSE (UNIT=3,STATUS='DELETE') I - END DOT - -100 CLOSE (UNIT=3) - - RETURNE - END diff --git a/decus/vax92b/bulletin/bulletin11.for b/decus/vax92b/bulletin/bulletin11.for deleted file mode 100644 index 555784a..0000000 --- a/decus/vax92b/bulletin/bulletin11.for +++ /dev/null @@ -1,2438 +0,0 @@ -C -C BULLETIN11.FOR, Version 1/8/93 -C Purpose: Bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE RESET - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN - MESSAGE_NUMBER = NBULL - ELSE - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER) - IF (IER.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IF - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.EQ.MESSAGE_NUMBER+1 ! Was message found? - & .OR.REMOTE_SET.GE.3) THEN ! Ignore if news - IF (REMOTE_SET.LT.3) THEN - CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - I = NEWS_FIND_SUBSCRIBE() - LAST_NEWS_READ(2,I) = MESSAGE_NUMBER - LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER) - & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) - END IF - ELSE - WRITE(6,1030) MESSAGE_NUMBER - END IF - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./ - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*12 TAG_KEY - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN - WRITE (6,'('' ERROR: NEWS group is not subscribed.'')') - RETURN - END IF - END IF - - IF (ADD_OR_DEL.AND. - & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN - CALL ADD_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (INCMD(:4).EQ.'SEEN') THEN - IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN - READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1), - & IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=13) - BULL_TAG = IBCLR(BULL_TAG,1) - RETURN - END IF - END IF - - IF (.NOT.CLI$PRESENT('NUMBER')) THEN - IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - WRITE(6,1010) ! No, then error. - RETURN - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - IF (IER.NE.0) THEN - IF (TAG_TYPE.EQ.1) THEN - WRITE (6,'('' ERROR: Message was not marked.'')') - ELSE - WRITE (6,'('' ERROR: Message was not seen.'')') - END IF - END IF - END IF - RETURN - END IF - - CALL OPEN_BULLDIR_SHARED - - LAST = 0 - - DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified messages - - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) - - IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - GO TO 100 - END IF - - DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL) - - CALL READDIR(MESSAGE_NUMBER,IER) - IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found? - & .AND.REMOTE_SET.LT.3) THEN ! Ignore if news - WRITE(6,1030) MESSAGE_NUMBER ! No - GO TO 100 - ELSE IF (ADD_OR_DEL) THEN - CALL ADD_TAG(IER,TAG_TYPE) - IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN - IF (REMOTE_SET.LT.3) THEN - DIFF = COMPARE_BTIM(MSG_BTIM, - & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) - IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM - & (1,FOLDER_NUMBER+1),MSG_BTIM) - ELSE - CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER) - END IF - LAST = MESSAGE_NUMBER - END IF - ELSE - CALL DEL_TAG(IER,TAG_TYPE) - END IF - END DO - END DO - -100 IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER) - - CALL CLOSE_BULLDIR - - RETURN - -1010 FORMAT(' ERROR: You have not read any message.') -1030 FORMAT(' ERROR: Message was not found: ',I) - - END - - - - SUBROUTINE ADD_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY - - IF (REMOTE_SET.LT.3) THEN - IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags - WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1) - BULL_TAG = IBSET(BULL_TAG,1) - END IF - WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - ELSE - CALL ADD_NEWS_TAG(IER,TAG_TYPE) - RETURN - END IF - - IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN - WRITE (6,'('' ERROR: Unable to mark message.'')') - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSE - CALL SYS_GETMSG(IER1) - END IF - ELSE - IER = 0 - END IF - - RETURN - END - - - - - SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(2),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - DO J=1,2 - IF (BTEST(READ_TAG,J)) I = J - END DO - - IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN - - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - - OLD_NEXT = NEXT - - NEXT = .FALSE. - J = F_START - 1 - IER1 = J - DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1) - J = J + 1 - CALL READDIR(J,IER1) - END DO - - IF (J+1.NE.IER1) THEN - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - - NEXT = .TRUE. - - DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM) - TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)), - & NEWS_TAG(1,I,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - HEADER = .TRUE. - CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM) - IF (IER.EQ.0) MESSAGE = MESSNUM - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - END DO - - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - - ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - - IER = 36 - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURN - - TAG_TYPE = 0 - - DO I=1,2 - IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) - & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND. - & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN - TEST = TEST_TAG(MSG_NUM, - & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM)) - IF (TEST) THEN - IER = 0 - TAG_TYPE = IBSET(TAG_TYPE,I) - END IFr - END IF - END DOu - - IF (BTEST(READ_TAG,3)) THEN - IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND.m - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN - IER = 0 - ELSE - IER = 36U - END IF - END IFE - - RETURNR - - ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE) - - IER = 36N - - SUBNUM = NEWS_FIND_SUBSCRIBE() - - IF (SUBNUM.GT.FOLDER_MAX-1) RETURNT - - HEADER = .FALSE._ - - TAG_TYPE = 0 - - DO WHILE (IER.NE.0) - I = 0E - DO J=1,2 - IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN - IER = 36 - MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM)E - DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)),P - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THEN - IER = 0 - ELSE - MNUM = MNUM + 1 - END IF - END DOI - IF (IER.EQ.0) THENR - IF (J.EQ.1) THEN - MESSAGE = MNUMI - I = 1 - ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN - MESSAGE = MNUMH - I = 2 - END IF - END IFL - END IF - END DO - IF (I.EQ.0) RETURN - CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM)B - IF (IER.EQ.0) THEN - IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I)( - IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND.A - & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM).AND. - & TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)), - & NEWS_TAG(1,3-I,SUBNUM))) THEN - TAG_TYPE = IBSET(TAG_TYPE,3-I)T - END IFR - RETURNu - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - RETURNw - END IF - END DO - - RETURN - END - - - - - SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM) - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLUSER.INC'E - - INCLUDE 'BULLDIR.INC' - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEXT/ NEXT - - INQUIRE (UNIT=2,OPENED=CLOSE_IT)L - CLOSE_IT = .NOT.CLOSE_ITR - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHAREDD - - IER = 36T - - OLD_NEXT = NEXT - - DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0) - I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM)N - DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM)) - TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)), - & NEWS_TAG(1,J,SUBNUM)) - IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST - IF (TEST) THENF - IER = 0B - MESSNUM = IE - ELSEI - I = I + 1 - END IFi - END DO - IF (IER.EQ.0) THEN - SAVE_MESSNUM = MESSNUM - NEXT = .FALSE.& - CALL READDIR(MESSNUM,IER1). - IF (IER1.NE.MESSNUM+1) THEN - NEXT = .TRUE. - CALL READDIR(MESSNUM,IER1) - END IFL - IF (IER1.NE.MESSNUM+1) THEN - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM)I - ELSED - NEXT = OLD_NEXT - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IFI - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN - ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THENb - IER = 36 - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM) - END IFA - END IF - ELSE - MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 - END IF - END DO - - IF (IER.EQ.0.AND.HEADER) THEN - MESSNUM = MESSNUM - 1e - MSG_NUM = MESSNUM - END IF - - NEXT = OLD_NEXT - - IF (CLOSE_IT) CALL CLOSE_BULLDIR - - RETURN - END - - - - - SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE) - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'R - - INCLUDE 'BULLFOLDER.INC'E - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IER = 0 - - SUBNUM = NEWS_FIND_SUBSCRIBE()U - IF (SUBNUM.GT.FOLDER_MAX-1) RETURNO - - IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN, - CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)- - & NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULLD - NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0I - END IFS - - IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN - NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START( - NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL - CALL LIB$GET_VM((F_NBULL-F_START)/8+1, - & NEWS_TAG(3,TAG_TYPE,SUBNUM)) - CALL ZERO_VM((F_NBULL-F_START)/8+1, - & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))) - ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN - DO I=1,2 - IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN - CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP) - CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(TEMP)) - CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)- - & NEWS_TAG(1,I,SUBNUM))/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP))N - CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)-D - & NEWS_TAG(1,I,SUBNUM))/8+1,L - & NEWS_TAG(3,I,SUBNUM)) - NEWS_TAG(2,I,SUBNUM) = F_NBULL - NEWS_TAG(3,I,SUBNUM) = TEMPu - END IFD - END DO - END IFD - - CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1 - - RETURNO - END - - - - SUBROUTINE SET_TAG(NUM,TAGS,START)L - - IMPLICIT INTEGER (A-Z)G - - DIMENSION TAGS(1) - - I = (NUM-START)/32. - J = NUM - START - I*32Y - - TAGS(I+1) = IBSET(TAGS(I+1),J) - - RETURNE - END - - - - SUBROUTINE CLR_TAG(NUM,TAGS,START)B - - IMPLICIT INTEGER (A-Z)L - - DIMENSION TAGS(1) - - I = (NUM-START)/32R - J = NUM - START - I*32E - - TAGS(I+1) = IBCLR(TAGS(I+1),J) - - RETURN - END - - - - LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START) - - IMPLICIT INTEGER (A-Z)Y - - DIMENSION TAGS(1) - - I = (NUM-START)/32O - J = NUM - START - I*32. - - TEST_TAG = BTEST(TAGS(I+1),J) - - RETURN( - END - - - - SUBROUTINE DEL_TAG(IER,TAG_TYPE)r - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEYG - - IER = 0 - - IF (REMOTE_SET.GE.3) THEN - SUBNUM = NEWS_FIND_SUBSCRIBE() - CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM) - RETURN - END IFS - - DO WHILE (REC_LOCK(IER1)) - READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE), - & IOSTAT=IER1)5 - END DOU - IF (IER1.NE.0) RETURN - - DELETE (UNIT=13,IOSTAT=IER1) - - RETURNN - END - - - - SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM)S - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC'M - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR.E - & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))I - & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN - RETURN - ELSES - NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1I - CALL CLR_TAG - & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),F - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END IF - - RETURNL - END - - - - SUBROUTINE OPEN_OLD_TAG - - IMPLICIT INTEGER (A-Z)D - - INCLUDE '($FORIOSDEF)'H - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'I - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /NEWS_MARK/ NEWS_MARK - DIMENSION NEWS_MARK(128)H - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECN - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) - EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)L - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - CHARACTER*10 BULL_MARK_DIRT - - CHARACTER*12 TAG_KEYS - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)G - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSEN - BULL_MARK_DIR = 'SYS$LOGIN:' - END IF- - - NTRIES = 0T - - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30) - OPEN (UNIT=13,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - NTRIES = NTRIES + 1 - END DOE - - IF (IER.EQ.0) THEN - BULL_TAG = IBSET(BULL_TAG,0) - DO WHILE (REC_LOCK(IER1))N - READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1) - END DO - IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1)D - UNLOCK 13 - END IFR - - NTRIES = 0 - - IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN - DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)G - OPEN (UNIT=23,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD',F - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER)) - NTRIES = NTRIES + 1 - END DO - - IF (IER.EQ.0) THEN - IF (BULL_NEWS_TAG) RETURN - BULL_NEWS_TAG = .TRUE.N - END IF - END IFP - - IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN - WRITE (6,'('' Unable to open mark file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)U - IF (IER1.EQ.0) THENF - WRITE (6,'('' IOSTAT error = '',I)') IER. - ELSE - CALL SYS_GETMSG(IER1) - END IF - RETURN - END IF. - - IF (BULL_NEWS_TAG) THEN - OLD_NEWS_NUMBER = 0 - FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER - CALL OPEN_BULLNEWS_SHARED( - DO WHILE (IER.EQ.0)G - DO WHILE (REC_LOCK(IER))E - READ (23,IOSTAT=IER) NEWS_MARKN - END DOO - IF (IER.EQ.0) THENP - IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN, - NEWS_FOLDER_NUMBER = NEWS_NUMBER - SUBNUM = NEWS_FIND_SUBSCRIBE() - IF (SUBNUM.GT.FOLDER_MAX-1) THEN - DELETE (UNIT=23)W - ELSE - UNLOCK 23 - OLD_NEWS_NUMBER = NEWS_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP - & (NEWS_FOLDER_NUMBER,IER1) - IF (IER1.NE.0) THEN - SUBNUM = 0 - ELSE - DO I=1,2A - NEWS_TAG(1,I,SUBNUM) = F1_START - NEWS_TAG(2,I,SUBNUM) = F1_NBULL - NEWS_TAG(4,I,SUBNUM) = 0E - CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1,T - & NEWS_TAG(3,I,SUBNUM)) - CALL ZERO_VM((F1_NBULL-F1_START)/8+1, - & %VAL(NEWS_TAG(3,I,SUBNUM))) - END DOD - END IFR - END IF - END IFT - IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN) - IF (SUBNUM.EQ.0) THEN - DELETE (UNIT=23) - ELSE - UNLOCK 23 - IF (NEWS_REC.GT.0) THEN - TAG_TYPE = 1S - ELSE) - TAG_TYPE = 2T - END IF - IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers - DO I=5,256 - CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM,+ - & TAG_TYPE)N - END DO - ELSE - DO I=3,128 - CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE) - END DO - END IF - END IF - END IF - END IFD - END DO - NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVEN - CALL CLOSE_BULLNEWS - END IF - - RETURNE - END - - - - SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE)N - - IMPLICIT INTEGER (A-Z)= - - INCLUDE 'BULLUSER.INC'_ - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - IF (NUM.GT.0) THEN) - LAST_NUM = NUM - IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR. - & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN - CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),) - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - ELSE IF (NUM.LT.0) THEN - IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURNE - DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1),S - & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) - CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)), - & NEWS_TAG(1,TAG_TYPE,SUBNUM)) - END DO - END IFN - - RETURNL - END - - - - SUBROUTINE OPEN_NEW_TAG(IER)L - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLUSER.INC'W - - INCLUDE 'BULLFOLDER.INC'A - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*10 BULL_MARK_DIR& - - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - IF (IER) THEN - BULL_MARK_DIR = 'BULL_MARK:' - ELSEU - BULL_MARK_DIR = 'SYS$LOGIN:' - END IFU - - IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER)E - IF (.NOT.IER1) THEN - IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER) - CALL DISABLE_PRIVS - IER1 = .FALSE. - END IF - IF (REMOTE_SET.LT.3) THEN - MARKUNIT = 13 - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW',M - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=3, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - ELSEZ - MARKUNIT = 23S - OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR// - & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW',( - & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED, - & RECORDSIZE=128, - & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:4:INTEGER))) - END IF - IF (.NOT.IER1) CALL ENABLE_PRIVS - IF (IER.NE.0) THENS - WRITE (6,'('' Cannot create mark file.'')')I - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.0) THENB - WRITE (6,'('' IOSTAT error = '',I)') IER - IER = 0 - ELSE - CALL SYS_GETMSG(IER1) - IER = IER1 - END IF - ELSEA - IF (.NOT.IER1) THEN - INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER) - WRITE (6,'('' Created MARK file: '',A)')T - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))N - END IF - IF (MARKUNIT.EQ.13) BULL_TAG = 1 - IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE. - IER = 1- - END IFI - - RETURNG - END - - - - CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE) - - IMPLICIT INTEGER (A-Z)P - - CHARACTER*(*) MSG_KEY - - IF (TAG_TYPE.EQ.1) THEN - CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY)) - ELSE( - CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY)) - END IF_ - - CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:))' - - RETURN' - END - - - - - SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE) - - IMPLICIT INTEGER (A-Z)1 - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*12 TAG_KEY,INPUT_KEY - - CHARACTER*8 NEXT_MSG_KEY - - IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3) - & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN0 - CALL OPEN_NEW_TAG(IER) - IF (.NOT.IER) RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - CALL GET_FIRST_NEWS_TAG(IER,MESSAGE) - RETURN - END IFE - - IF (BTEST(READ_TAG,3)) THEN - MSG_NUM = 04 - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY)N - IF (IER.EQ.0) THEN - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGE - MSG_KEY = BULLDIR_HEADER, - END IF - RETURN - END IFE - - MSG_KEY = BULLDIR_HEADERH - - HEADER = .TRUE. - - DO J=1,2T - IF (BTEST(READ_TAG,J)) I = J - END DOG - - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - - RETURNT - - ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)S - - IF (REMOTE_SET.GE.3) THEN - CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE) - RETURN - END IFI - - TAG_TYPE = 0' - - DO I=1,2 - IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN - DO WHILE (REC_LOCK(IER))O - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I), - & IOSTAT=IER) INPUT_KEY - END DOM - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I)N - END IF - END DOG - - IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR.E - & (BTEST(READ_TAG,3).AND. - & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND.S - & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THENM - IF (IER.EQ.0) UNLOCK 13_ - IER = 0= - MESSAGE = MSG_NUM, - ELSER - IER = 36 - END IFN - - RETURNM - - ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)E - - MSG_NUM = MSG_NUM - 1 - - CALL DECREMENT_MSG_KEYR - - ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)/ - - IF (REMOTE_SET.GE.3) THEN - MSG_NUM = ABS(MSG_NUM) + 1 - CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE) - RETURN - END IF' - - IER = 36A - - HEADER = .FALSE.E - - TAG_TYPE = 0) - - IF (BTEST(READ_TAG,3)) THEN - CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE), - RETURN - END IF_ - - DO WHILE (IER.NE.0) - I = 0A - DO J=1,2 - IF (BTEST(READ_TAG,J)) THEN - DO WHILE (REC_LOCK(IER)) - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J), - & IOSTAT=IER) INPUT_KEYT - END DOO - IF (IER.EQ.0) THENE - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)/ - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IFD - IF (IER.EQ.0) THEN' - IF (J.EQ.1) THEN - NEXT_MSG_KEY = INPUT_KEY(5:) - I = 1 - ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY, - & INPUT_KEY(5:)).GT.0) THENE - I = 2 - END IF - END IF. - END IFI - END DO - IF (I.EQ.0) RETURN - NEXT_MSG_KEY = MSG_KEY - CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I) - IF (IER.EQ.0) THEN - TAG_TYPE = IBSET(TAG_TYPE,I)' - DO WHILE (REC_LOCK(IER))_ - READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I), - & IOSTAT=IER) INPUT_KEY - END DOM - IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I)S - IER = 0 - RETURN0 - ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN - MSG_KEY = NEXT_MSG_KEY - RETURN - ELSE - MSG_KEY = NEXT_MSG_KEYR - END IF - END DOT - - RETURN - END - - - - SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE)I - - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLFOLDER.INC'L - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - INQUIRE (UNIT=2,OPENED=CLOSE_IT)_ - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHAREDI - - DO MESSAGE = MSG_NUM+1,F_NBULL - CALL READDIR(MESSAGE,IER) - IF (IER.EQ.MESSAGE+1) THEN - CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE) - IF (IER.EQ.0) THENN - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIR$ - RETURNN - END IF8 - END IF - END DOW - - IER = 36N - IF (CLOSE_IT) CALL CLOSE_BULLDIRF - - RETURNS - END - - - - INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*8 MSG_KEY1,MSG_KEY2 - - DIMENSION BTIM1(2),BTIM2(2) - - CALL GET_MSGBTIM(MSG_KEY1,BTIM1) - CALL GET_MSGBTIM(MSG_KEY2,BTIM2) - - COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2) - - RETURNG - END - - - - - SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J)I - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - CHARACTER*12 TAG_KEY,INPUT_KEY - - DO WHILE (REC_LOCK(IER))N - READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER) - & INPUT_KEY - END DOM - - CLOSE_IT = .FALSE. - - DO WHILE (1)E - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY)_ - CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)E - END IF - - IF (IER.EQ.0) THEN - IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR. - & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER))) - & IER = 36 - END IF - IF (IER.NE.0) THEN - IER = 1 - UNLOCK 13 - IF (CLOSE_IT) CALL CLOSE_BULLDIRU - RETURN, - ELSE - CALL DECREMENT_MSG_KEYG - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - INQUIRE (UNIT=2,OPENED=IER) - IF (.NOT.IER) THEN - CALL OPEN_BULLDIR_SHAREDG - CLOSE_IT = .TRUE. - END IFN - CALL READDIR_KEYGE(IER) - CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:)) - IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN - UNLOCK 13G - MESSAGE = MSG_NUM - IF (HEADER) THENT - MESSAGE = MESSAGE - 1 - MSG_NUM = MESSAGEP - MSG_KEY = BULLDIR_HEADER - END IFI - IER = 0 - IF (CLOSE_IT) CALL CLOSE_BULLDIRG - RETURN - ELSET - DELETE (UNIT=13)R - IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN - IER = 36 - IF (CLOSE_IT) CALL CLOSE_BULLDIR - RETURN - END IF - DO WHILE (REC_LOCK(IER))K - READ (13,IOSTAT=IER) INPUT_KEYM - END DO - END IFS - END IF - - END DO - - END - - - - SUBROUTINE CLOSE_TAG_ - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLUSER.INC'E - - COMMON /NEWS_MARK/ NEWS_MARKU - DIMENSION NEWS_MARK(128) - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))= - EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)( - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - - TAG_OPENED = .FALSE.I - - IF (BULL_NEWS_TAG) THEN - DO I=1,FOLDER_MAX-12 - DO M=1,2S - IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN/ - IF (.NOT.TAG_OPENED) THEN - CALL OPEN_OLD_TAG - TAG_OPENED = .TRUE. - END IF - IF (M.EQ.1) THEN - NEWS_REC = 1, - ELSE - NEWS_REC = -32767 - END IF - NEWS_FORMAT = 0 - IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1L - LIMIT = 256/(NEWS_FORMAT+1)S - NEWS_NUMBER = LAST_NEWS_READ2(1,I)I - K = 5-NEWS_FORMAT*2R - SET_LIST = .FALSE. - DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I) - IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)), - & NEWS_TAG(1,M,I))) THEN - IF (.NOT.SET_LIST) THENT - CALL SET_NEWS_MARK(K,J) - LAST_SET = J - K = K + 1e - SET_LIST = .TRUE. - END IF - ELSE IF (SET_LIST) THEN - IF (LAST_SET.NE.J-1) THEN - CALL SET_NEWS_MARK(K,-(J-1)) - K = K + 1 - END IFG - SET_LIST = .FALSE. - END IFE - IF (J.EQ.NEWS_TAG(2,M,I)) THENN - IF (SET_LIST.AND.LAST_SET.NE.J) THEN - CALL SET_NEWS_MARK(K,-J) - K = K + 1 - END IF - DO L=K,LIMIT - CALL SET_NEWS_MARK(L,0)I - END DO - K = LIMIT + 1) - END IFE - IF (K.GT.LIMIT) THENS - DO WHILE (REC_LOCK(IER)) - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - END DO - IF (IER.NE.0) THEN - WRITE (23,IOSTAT=IER) NEWS_MARK - ELSE - REWRITE (23,IOSTAT=IER) NEWS_MARK - END IF - K = 5-NEWS_FORMAT*2N - NEWS_REC = NEWS_REC + 1) - IF (J.EQ.NEWS_TAG(2,M,I)) THEN - DO WHILE (REC_LOCK(IER))_ - READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER) - IF (IER.EQ.0) THENT - DELETE (UNIT=23) - NEWS_REC = NEWS_REC + 1 - L = REC_LOCK(IER) - END IF. - END DO - END IF - END IFN - END DO - END IF - END DO - END DO - CLOSE (UNIT=23) - END IFY - - RETURNH - END - - - SUBROUTINE SET_NEWS_MARK(I,J) - - IMPLICIT INTEGER (A-Z)I - - COMMON /NEWS_MARK/ NEWS_MARKA - DIMENSION NEWS_MARK(128), - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECD - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))M - EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(2),NEWS_REC) - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) - - IF (NEWS_FORMAT.EQ.0) THENE - NEWS_MARK2(I) = J - ELSE - NEWS_MARK(I) = J - END IF - - RETURNK - END - - - - SUBROUTINE ZERO_VM(NUM,NEWS_TAG) - - IMPLICIT INTEGER (A-Z) - - LOGICAL*1 NEWS_TAG(1) - - DO I=1,NUM - NEWS_TAG(I) = 0 - END DOF - - RETURN - END - - - - - SUBROUTINE FREE_TAGS(ISUB)A - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'O - - INCLUDE 'BULLUSER.INC'. - - COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1) - COMMON /NEWS_MARK/ NEWS_MARKT - DIMENSION NEWS_MARK(128). - INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC_ - EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))T - EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER) - EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)N - EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)E - - DO I=1,2G - IF (NEWS_TAG(3,I,ISUB).GT.0) THENA - CALL LIB$FREE_VM( - & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB))E - NEWS_TAG(3,I,ISUB) = 0T - NEWS_NUMBER = NEWS_FOLDER_NUMBER - NEWS_REC = -32768 - DO WHILE (REC_LOCK(IER))A - READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK, - IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN - DELETE (UNIT=23) - L = REC_LOCK(IER)N - END IF - END DOR - END IF - - DO J=I,FOLDER_MAX-2( - CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J))_ - END DO - - DO J=1,4 - NEWS_TAG(J,I,FOLDER_MAX-1) = 0C - END DO - END DOO - - RETURNR - END - - - - - SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE) - - IMPLICIT INTEGER (A-Z)U - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*8 PREV_MSG_KEY - - IER = 36: - - IF (REMOTE_SET.GE.3) THEN - INQUIRE (UNIT=2,OPENED=CLOSE_IT) - CLOSE_IT = .NOT.CLOSE_IT - IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED - SUBNUM = NEWS_FIND_SUBSCRIBE() - DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START) - MSG_NUM = MSG_NUM - 1 - CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE)E - IF (IER.EQ.0) THENP - TMP_MSG_NUM = MSG_NUM - CALL READDIR(TMP_MSG_NUM,IER1) - IF (IER1.NE.MSG_NUM+1) THENK - IF (.NOT.BTEST(READ_TAG,3)) THEN - CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM)A - END IF - IER = 36 - END IF - END IF. - END DO - BULL_READ = MSG_NUMG - IF (CLOSE_IT) CALL CLOSE_BULLDIR - ELSE - IF (MSG_NUM.EQ.0) RETURN - SAVE_MSG_NUM = MSG_NUM - PREV_MSG_NUM = MSG_NUM - MSG_NUM = 0G - MSG_KEY = BULLDIR_HEADER - IER = 0E - DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM)' - IF (MSG_NUM.GT.0) THENB - PREV_MSG_KEY = MSG_KEY - PREV_MSG_NUM = MSG_NUM - END IFN - CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)I - END DO - IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN - MSG_NUM = PREV_MSG_NUMS - MSG_KEY = PREV_MSG_KEYH - CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) - ELSE - IER = 36C - END IF - END IF - - RETURN - END - - - SUBROUTINE DECREMENT_MSG_KEYR - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - I = 1 - DO WHILE (I.LT.9) - ITEST = ICHAR(MSG_KEY(I:I))Y - IF (ITEST.GT.0) THEN - MSG_KEY(I:I) = CHAR(ITEST-1)2 - I = 9 - ELSE - I = I + 1 - END IF - END DOB - - RETURNL - END - - - - - SUBROUTINE SET_GENERIC(GENERIC) -C= -C SUBROUTINE SET_GENERIC -CR -C FUNCTION: Enables or disables "GENERIC" display, i.e. displayingG -C general bulletins continually for a certain amount of days.N -C - IMPLICIT INTEGER (A-Z), - - INCLUDE 'BULLUSER.INC'C - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IF (.NOT.SETPRV_PRIV()) THENG - WRITE (6,'(R - & '' ERROR: No privs to change GENERIC.'')') - RETURN - END IF - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)R - - IF (IER.EQ.0) THEN - IF (GENERIC) THENN - IF (CLI$PRESENT('DAYS')) THEN - IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER) - CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2)) - ELSEE - NEW_FLAG(2) = ' 7'= - END IFC - ELSE - NEW_FLAG(2) = 0 - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSES - WRITE (6,'('' ERROR: Specified username not found.'')')I - END IF2 - - CALL CLOSE_BULLUSER - - RETURNT - END - - - SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS) -CE -C SUBROUTINE SET_BRIEF_CONTINUOUS -C -C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying -C the brief message continually until the new messages have been read. -CG - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLUSER.INC' - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - - IF (BRIEF_CONTINUOUS) THEN - NEW_FLAG(2) = -1 - ELSEU - NEW_FLAG(2) = 0D - END IFI - - IF (IER.EQ.0) REWRITE (4) USER_ENTRYT - - CALL CLOSE_BULLUSER - - RETURN - END - - - SUBROUTINE SET_LOGIN(LOGIN) -C -C SUBROUTINE SET_LOGIND -CH -C FUNCTION: Enables or disables bulletin display at login._ -CM - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC' - - CHARACTER TODAY*24N - - DIMENSION NOLOGIN_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - - IF (.NOT.SETPRV_PRIV()) THENW - WRITE (6,'(T - & '' ERROR: No privs to change LOGIN.'')') - RETURN - END IFW - - IER = CLI$GET_VALUE('USERNAME',TEMP_USER) - - CALL OPEN_BULLUSER_SHARED - - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)N - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)T - IF (IER.EQ.0) THENA - IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - CALL SYS_BINTIM(TODAY,LOGIN_BTIM) - ELSE IF (.NOT.LOGIN) THENF - LOGIN_BTIM(1) = NOLOGIN_BTIM(1) - LOGIN_BTIM(2) = NOLOGIN_BTIM(2) - END IF - REWRITE (4) TEMP_USER//USER_ENTRY(13:) - ELSE - WRITE (6,'('' ERROR: Specified username not found.'')')_ - END IF - - CALL CLOSE_BULLUSER - - RETURN7 - END - - - - - - SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER) - - IMPLICIT INTEGER (A-Z) - - CHARACTER USERNAME*(*),ACCOUNT*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST* - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT))_ - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST)S - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - USER = UIC(1) - GROUP = UIC(2) - - RETURN - END - - - - SUBROUTINE DCLEXH(EXIT_ROUTINE) - - IMPLICIT INTEGER (A-Z)T - - INTEGER*4 EXBLK(4)( - - EXBLK(2) = EXIT_ROUTINE - EXBLK(3) = 1W - EXBLK(4) = %LOC(EXBLK(4)) - - CALL SYS$DCLEXH(EXBLK(1)) - - RETURN - END - - - - SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MAILDEF)'J - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - DO WHILE (INDEX(SENDTO,'""').GT.0) - SENDTO = SENDTO(:INDEX(SENDTO,'""'))//_ - & SENDTO(INDEX(SENDTO,'""')+2:) - END DO - - DO WHILE (INDEX(SUBJECT,'""').GT.0) - SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// - & SUBJECT(INDEX(SUBJECT,'""')+2:) - END DO - - C = 0 - - STATUS = MAIL$SEND_BEGIN(C,0,0) - IF (.NOT.STATUS) RETURN - - J = 1 - DO WHILE (J.LE.TRIM(SENDTO)) - I = INDEX(SENDTO(J:),',') - 1W - IF (I.EQ.-1) I = TRIM(SENDTO(J:)) - CALL INIT_ITMLST - CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:))) - CALL ADD_2_ITMLST(0,MAIL$_NOSIGNAL,0) - CALL END_ITMLST(ADDRESS_ITMLST) - - STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0)2 - IF (.NOT.STATUS) RETURN - J = J + IL - IF (SENDTO(J:J).EQ.',') J = J + 1N - END DO - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT - & ,%LOC(SUBJECT)) - CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO))I - CALL ADD_2_ITMLST(0,MAIL$_NOSIGNAL,0)R - CALL END_ITMLST(ATTRIBUTE_ITMLST)N - - STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0) - IF (.NOT.STATUS) RETURN2 - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE)) - CALL ADD_2_ITMLST(0,MAIL$_NOSIGNAL,0) - CALL END_ITMLST(BODYPART_ITMLST) - - STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0) - IF (.NOT.STATUS) RETURNE - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(0,MAIL$_NOSIGNAL,0)S - CALL END_ITMLST(SEND_ITMLST) - - STATUS = MAIL$SEND_MESSAGE(C,%VAL(SEND_ITMLST),0) - IF (.NOT.STATUS) RETURNF - - STATUS = MAIL$SEND_END(C,0,0)R - IF (.NOT.STATUS) RETURNI - - RETURN - ENDU - - - - SUBROUTINE SET_NEWSM - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC'W - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_PU - CHARACTER*64 BULL_PARAMETERV - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /KEEPLOCK/ KEEPLOCK_ - - COMMON /NEXT/ NEXTM - - DIMENSION EXPIRED(2)3 - - CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132 - CHARACTER NEWS_ACCESS*132 - - IF (.NOT.SETPRV_PRIV()) THEN. - WRITE (6,'('' ERROR: No privs to change NEWS.'')') - RETURN - END IF - - ENTRY SHOW_NEWS - - LIMIT = -2 - IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1))_ - IF (.NOT.IER.OR.LIMIT.LT.-1) THENW - WRITE (6,'('' ERROR: Invalid value for LIMIT.'')')R - RETURN - END IF E - END IF - - EXPIRE = -1A - IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1))N - IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN - WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')') - RETURN - END IF - END IF - - IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR.E - & CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN - WRITE (6,'('' ERROR: You have not selected a news group.'')')T - RETURNM - END IF - - CALL OPEN_BULLNEWS_SHARED ! Open folder fileF - - IF (CLI$PRESENT('DEFAULT')) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)L - ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN - BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.' - CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER) - LEN_P = LEN_P + 1 - IF (LEN_P.GT.LEN(FOLDER)) THEN - WRITE (6,'('' ERROR: Class name too long.'')')M - CALL CLOSE_BULLNEWS - RETURNE - END IF - GROUP = BULL_PARAMETER(:LEN_P) - LG = LEN_P' - CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P), - & NEWCLASS) - IF (CLI$PRESENT('DELETE')) THEN - IF (NEWCLASS.NE.0) THEN - WRITE (6,'('' ERROR: Class not found.'')') - ELSEH - DELETE (7) - WRITE (6,'('' Class deleted.'')') - END IFC - IF (BTEST(FOLDER1_FLAG,0)) THENY - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE')A - END IF - RETURN= - ELSE IF (NEWCLASS.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)G - DO WHILE (IER.EQ.0)I - DO WHILE (REC_LOCK(IER))F - READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER)I - END DO_ - IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1 - END DO - FOLDER1_FLAG = NEWS_FLAG_DEFAULT - FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT - F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULTT - CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED)P - CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)s - CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED) - CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE)R - FOLDER1_NUMBER = NEWS_F1_COUNT_ - FOLDER1 = BULL_PARAMETER - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10)T - CALL WRITE_FOLDER_FILE_TEMP(IER)A - IF (IER.NE.0) THEN - CALL CLOSE_BULLNEWS - WRITE (6,'('' Unable to add entry.'')') - RETURN' - END IF - TEMP = FOLDER1_NUMBER - CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) - NEWS_F1_COUNT = TEMP6 - REWRITE (7) NEWS_FOLDER1_COMo - CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER)R - END IF - ELSE - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ. - & %LOC(CLI$_ABSENT)) FOLDER1 = FOLDERO - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Invalid news group.'')') - CALL CLOSE_BULLNEWS - RETURND - END IF - END IFE - - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE - IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT - - CLASS = CLI$PRESENT('CLASS')W - DEFAULT = CLI$PRESENT('DEFAULT')_ - ALL = CLI$PRESENT('ALL') - IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE. - DISABLE = CLI$PRESENT('DISABLE')a - ENABLE = CLI$PRESENT('ENABLE')I - PRIVATE = CLI$PRESENT('PRIVATE') - NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED) - - STORED = 0T - IF (CLI$PRESENT('STORED')) THEN - STORED = 1 - IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN t - F1_LAST = 0 - F1_COUNT = 0W - F1_START = 0L - F1_NBULL = 0E - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF_ - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN - STORED = 2 - CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,L - & 'Are you sure you want to remove stored setting? '// - & '(Y/N with N as default): ') - IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THENE - WRITE (6,'('' Stored setting was not removed.'')')i - CALL CLOSE_BULLNEWS - RETURNC - END IF - IF (DEFAULT) THEN - CALL LIB$DELETE_FILE(BULLNEWSDIR_FILE(O - & :TRIM(BULLNEWSDIR_FILE))//';*') - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))I - & //'[.BULLNEWS*]*.*;*')M - CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))L - & //'BULLNEWS*.DIR;*')O - ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THENC - CALL CLOSE_BULLNEWSI - FOLDER_SAVE = FOLDERA - IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN - FOLDER_NUMBER = FOLDER1_NUMBERH - CALL SELECT_FOLDER(.FALSE.,IER) - END IF( - FOLDER = FOLDER_SAVE - CALL OPEN_BULLDIR_SHARED - KEEPLOCK = .TRUE. - NEXT = .TRUE. - BULL_DELETE = 1 - F_START = 0 - F_NBULL = 999999 - CALL READDIR(BULL_DELETE,IER) - DO WHILE (IER.EQ.BULL_DELETE+1) - DELETE (2) - CALL READDIR(BULL_DELETE,IER) - END DO - NEXT = .FALSE. - KEEPLOCK = .FALSE.T - CALL CLOSE_BULLDIR - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER) - F1_START = 0" - F1_NBULL = 0 - F1_COUNT = 0 - F1_LAST = 0. - END IF - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)) - END IF - - IF (NOPRIVATE.AND..NOT.DEFAULT) THEN - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),O - & STATUS='OLD',IOSTAT=IER)0 - CLOSE (UNIT=3,DISPOSE='DELETE')N - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - END IFL - - IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN - CALL SET_PROTECTIONN - OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER)L - CLOSE (UNIT=3) - IF (IER.NE.0) THEN A - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='NEW',IOSTAT=IER)_ - CLOSE (UNIT=3) - END IF - CALL RESET_PROTECTIONN - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - END IF - - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)R - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - - FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE - - CALL REWRITE_FOLDER_FILE_TEMP(IER) - - IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG)) - & .OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN - NEWS_FLAG_DEFAULT = NEWS_F1_FLAGB - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRER - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMITA - END IFN - - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)M - IF (DEFAULT.OR.CLASS) THEN - IF (CLASS) THENT - WRITE (6,'('' For class '',A,'':'')') GROUP(:LG) - END IF - IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')') S - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' Default is stored.'')')F - ELSE - WRITE (6,'('' Default is not stored.'')')B - END IFU - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration for stored groups is '' - & ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)W - ELSE IF (CLASS) THENE - WRITE (6,'('' Expiration is DEFAULT value.'')')O - ELSEa - WRITE (6,'('' Default expiration for stored groups is '' - & ,''14.'')')I - END IF, - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,), - IF (F1_EXPIRE_LIMIT.GT.0) THEN) - WRITE (6,'('' Default expiration limit is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')')N - ELSER - WRITE (6,'('' There is no default expiration limit.'')') - END IFu - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IFI - ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)Y - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - WRITE (6,'('' Disable is set.'')')' - ELSE' - FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)F - WRITE (6,'('' For news group '',A,'':'')') - & FOLDER1_NAME(:TRIM(FOLDER1_NAME)) - IF (BTEST(FOLDER1_FLAG,8)) THEN - WRITE (6,'('' News group is stored.'')') - CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)M - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Expiration is '',A,''.'')') - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE - WRITE (6,'('' Expiration is DEFAULT value.'')') - END IF - ELSE: - WRITE (6,'('' News group is not stored.'')') - END IF - CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,)( - IF (F1_EXPIRE_LIMIT.GT.0) THENE - WRITE (6,'('' Expiration limit is '',A,''.'')')I - & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) - ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN - WRITE (6,'('' Expiration limit is DEFAULT value.'')') - ELSE. - WRITE (6,'('' There is no expiration limit.'')') - END IF= - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,0)) THEN - WRITE (6,'('' Private is set.'')') - END IFE - END IF - - IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER)2 - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THENX - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1- - WRITE_ACCESS = 1I - ELSE - CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP), - & USERNAME,READ_ACCESS,WRITE_ACCESS)E - END IFE - IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP))T - ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - WRITE (6,'('' Access is not limited.'')') - END IF - END IF - - IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND. - & (.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN - CALL CLOSE_BULLNEWSW - RETURN - END IF - - IF (CLASS.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups...'')') - FOLDER_SAVE = FOLDER - CALL LOWERCASE(GROUP)O - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER)F - IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) - END IF - FOUND = .FALSE.E - MODALL = INDEX(GROUP,'.').NE.LG) - DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR.E - & GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.'))L - FOUND = .TRUE. - IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN = - CALL CLOSE_BULLNEWS= - FOLDER_NUMBER = FOLDER1_NUMBER( - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THENE - CALL OPEN_BULLDIR_SHARED - KEEPLOCK = .TRUE. - NEXT = .TRUE.$ - BULL_DELETE = 1L - F_START = 0 - F_NBULL = 999999T - CALL READDIR(BULL_DELETE,IER) - DO WHILE (IER.EQ.BULL_DELETE+1)E - DELETE (2)H - CALL READDIR(BULL_DELETE,IER) - END DO R - NEXT = .FALSE. - KEEPLOCK = .FALSE. - CALL CLOSE_BULLDIR - END IF - CALL OPEN_BULLNEWS_SHAREDF - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER) - F1_LAST = 0 - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0o - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) u - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)U - ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN - F1_LAST = 0i - F1_COUNT = 0 - F1_START = 0 - F1_NBULL = 0 - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - END IF - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0I - IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRED - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0E - IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)A - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER)T - END DOE - IF (.NOT.FOUND) THEN - WRITE (6,'('' ERROR: No news groups match class name.'')') - WRITE (6,'('' ERROR: Class has been removed.'')') ) - CALL OPEN_BULLNEWS_SHARED - CALL STR$UPCASE(GROUP,GROUP) - CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER) - DELETE (7) - CALL CLOSE_BULLNEWS - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP), - & STATUS='OLD',IOSTAT=IER) - CLOSE (UNIT=3,DISPOSE='DELETE') - END IF - IF (FOLDER_SAVE.NE.FOLDER) THEN - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER_SAVE - CALL SELECT_FOLDER(.FALSE.,IER)I - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0L - CALL SELECT_FOLDER(.FALSE.,IER)& - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER))) - END IFI - RETURN. - END IFL - ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN - WRITE (6,'('' Modifying news groups.'', - & '' This will take a while...'')') - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0 - IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0O - IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. - & (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN - F1_LAST = 0 - F1_COUNT = 0B - F1_START = 0S - F1_NBULL = 0V - NEWS_F1_FIRST = 0 - NEWS_F1_END = 0 - END IF - IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) - IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)_ - IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)1 - IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9) - CALL REWRITE_FOLDER_FILE_TEMP(IER)F - END DO - END IF - - FOLDER_NUMBER = -1 - FOLDER1 = FOLDER6 - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = 0, - CALL SELECT_FOLDER(.FALSE.,IER)) - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER))' - END IF - - CALL CLOSE_BULLNEWS - - RETURN - ENDs - - - - - SUBROUTINE INCLUDE(EXCLUDE) - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLUSER.INC'R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - - IER = SYS_TRNLNM_SYSTEM('BULL_USER_CUSTOM',BULL_PARAMETER)a - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'' - - CALL DISABLE_PRIVS, - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH) - - OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW', - & SHARED,IOSTAT=IER,RECL=INPUT_LENGTH). - - CALL ENABLE_PRIVS - - IF (IER.NE.0) THENi - WRITE(6,'('' ERROR: Error in opening custom file.'')') - RETURN - END IF' - - IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P)) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - CALL CLOSE_BULLDIR ! If not, then error out, - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN - IF (CLI$PRESENT('SUBJECT')) THENE - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - ELSE - INPUT = INPUT(7:) - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1) - END IF - END IF - ELSE - INPUT = FROMD - END IF - IF (CLI$PRESENT('SUBJECT')) THEN - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - INPUT = INPUT(7:) - ELSE - INPUT = DESCRIP - END IFA - END IF - - CALL CLOSE_BULLFIL - END IF. - - IF (CLI$PRESENT('SUBJECT')) THEN - INPUT = 'SUBJECT:'//INPUT' - ELSE - INPUT = 'FROM:'//INPUT - END IFR - - IF (EXCLUDE) THEN - INPUT = ':EXCLUDE:'//INPUT - ELSEI - INPUT = ':INCLUDE:'//INPUT - END IF' - - INPUT = FOLDER_NAME(:TRIM(FOLDER_NAME))//INPUT - - ILEN = TRIM(INPUT)T - ALL = CLI$PRESENT('ALL')a - DISABLE = CLI$PRESENT('DISABLE')= - - IF (IER1.NE.0) THEN - IF (.NOT.DISABLE) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - CLOSE (UNIT=4,DISPOSE='SAVE')E - RETURN - END IF - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERC - IF (IER.EQ.0) THEN L - IF (STREQ(OLD_BUFFER(:OLEN),INPUT(:ILEN))) THEN - IF (.NOT.DISABLE) THEN - WRITE (6,'('' ERROR: Entry already present.'')') R - CLOSE (UNIT=4) - CLOSE (UNIT=3) W - RETURN - END IFE - ELSE IF (.NOT.(ALL.AND.INPUT(:TRIM(FOLDER_NAME)+8).EQ. - & OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+8,OLEN)))) THENI - WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN)E - END IFL - END IF - END DOL - - IF (.NOT.DISABLE) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN) - - CLOSE (UNIT=4,DISPOSE='SAVE') - CLOSE (UNIT=3,DISPOSE='DELETE') - - CALL CHECK_CUSTOM - - RETURN - ENDR - - - - - SUBROUTINE CHECK_CUSTOM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM) - DATA BULL_USER_CUSTOM/.FALSE./A - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE. - DATA SCRATCH_B1/0/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - BULL_USER_CUSTOM = .FALSE.I - - IER = SYS_TRNLNM_SYSTEM('BULL_USER_CUSTOM',BULL_PARAMETER)P - IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'1 - - OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), - & STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH) - - IF (IER.NE.0) RETURN - - IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? - SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to headT - ELSE ! Else if queue is empty - CALL INIT_QUEUE(SCRATCH_B,OLD_BUFFER) - SCRATCH_B1 = SCRATCH_B ! Init header pointer_ - END IF - - NINCLUDE = 0N - DO WHILE (IER.EQ.0) - READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERE - IF (IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ.I - & OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+1,OLEN))) THEN - BULL_USER_CUSTOM = .TRUE. - CALL LOWERCASE(OLD_BUFFER)B - CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) - NINCLUDE = NINCLUDE + 1 - END IF - END DOL - - CLOSE (UNIT=3) - - RETURN - END - - - - - LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1)F - - IMPLICIT INTEGER (A-Z)D - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'L - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM - DATA BULL_USER_CUSTOM/.FALSE./F - - COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE= - DATA SCRATCH_B1/0/N - - CHARACTER*(*) STRING,STRING1_ - - INCLUDE_MSG = .TRUE., - IF (.NOT.BULL_USER_CUSTOM) RETURN - - SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header - - FLEN = TRIM(FOLDER_NAME)D - - INC = .FALSE. - - CALL LOWERCASE(STRING)I - CALL LOWERCASE(STRING1) - DO I=1,NINCLUDE - CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)I - OLEN = TRIM(OLD_BUFFER)L - IF (STREQ(FOLDER_NAME(:FLEN)//':', - & OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN - IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THENN - IF (.NOT.INC) INCLUDE_MSG = .FALSE. - INC = .TRUE. - END IFE - IF ((STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:').AND.E - & INDEX(STRING(:TRIM(STRING)),OLD_BUFFER - & (FLEN+15:OLEN)).GT.0).OR.( - & (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND.I - & INDEX(STRING1(:TRIM(STRING1)),OLD_BUFFER - & (FLEN+18:OLEN)).GT.0)) THENC - INCLUDE_MSG = STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')Y - IF (.NOT.INCLUDE_MSG) RETURN - END IF( - END IF - END DOS - - RETURN - END diff --git a/decus/vax92b/bulletin/bulletin2.for b/decus/vax92b/bulletin/bulletin2.for deleted file mode 100644 index 6bef922..0000000 --- a/decus/vax92b/bulletin/bulletin2.for +++ /dev/null @@ -1,2237 +0,0 @@ -C -C BULLETIN2.FOR, Version 12/28/92 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE SET_BBOARD(BBOARD) -C -C SUBROUTINE SET_BBOARD -C -C FUNCTION: Set username for BBOARD for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($UAIDEF)' - - EXTERNAL CLI$_ABSENT - - CHARACTER EXPIRE*4,INPUT_BBOARD*12,TODAY*24,RESPONSE*4 - - IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN - WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')') - RETURN - END IF - - IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (FOLDER_BBOARD(:2).EQ.'::'.OR.NEWS_FEED()) THEN - WRITE (6,'( - & '' ERROR: Cannot set BBOARD for remote folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - - IF (BBOARD) THEN - IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_UAF - & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1) - CALL CLOSE_BULLFOLDER - IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER? - WRITE (6,'('' ERROR: '',A, - & '' account needs DISUSER flag set.'')') - & INPUT_BBOARD(:INPUT_LEN) - RETURN - ELSE IF (IER1.AND.BTEST(USERB,31)) THEN - WRITE (6,'('' ERROR: User number of UIC cannot '', - & ''be greater than 7777777777.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - CALL READ_FOLDER_FILE_TEMP(IER) - DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR. - & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - END DO - IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. - & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN - WRITE (6,'( - & '' ERROR: Account used by other folder.'')') - CALL CLOSE_BULLFOLDER - RETURN - END IF - IF (.NOT.IER1) THEN - CALL CLOSE_BULLFOLDER - WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'', - & '' file.'')') INPUT_BBOARD(:INPUT_LEN) - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Is the name a mail forwarding entry? '// - & '(Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURN - END IF - CALL OPEN_BULLFOLDER - USERB = 1 ! Fake userb/groupb, as old method of - GROUPB = 1 ! indicating /SPECIAL used [0,0] - END IF - GROUPB1 = GROUPB - USERB1 = USERB - ACCOUNTB1 = ACCOUNTB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - GROUPB = GROUPB1 - USERB = USERB1 - ACCOUNTB = ACCOUNTB1 - FOLDER_BBOARD = INPUT_BBOARD - CALL OPEN_BULLUSER - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL READ_USER_FILE_HEADER(IER) - CALL SYS_BINTIM(TODAY,BBOARD_BTIM) - REWRITE (4) USER_HEADER - CALL CLOSE_BULLUSER - IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified? - USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL - IF (CLI$PRESENT('VMSMAIL')) THEN - GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL - END IF - END IF - ELSE IF (CLI$PRESENT('SPECIAL')) THEN - USERB = IBSET(0,31) ! Set top bit to show /SPECIAL - GROUPB = 0 - DO I=1,LEN(FOLDER_BBOARD) - FOLDER_BBOARD(I:I) = ' ' - END DO - ELSE IF (FOLDER_BBOARD(:4).EQ.'NONE') THEN - WRITE (6,'('' ERROR: No BBOARD specified for folder.'')') - END IF - - IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN - IF (EX_LEN.GT.3) EX_LEN = 3 - READ (EXPIRE,'(I)') TEMP - IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Expiration cannot be > '', - & I3,'' days.'')') BBEXPIRE_LIMIT - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (TEMP.LE.0) THEN - WRITE (6,'('' ERROR: Expiration must be > 0.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE - FOLDER_BBEXPIRE = TEMP - END IF - ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN - FOLDER_BBEXPIRE = -1 - END IF - ELSE - FOLDER_BBOARD = 'NONE' - END IF - - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - WRITE (6,'('' BBOARD has been modified for folder.'')') - ELSE - WRITE (6,'('' You are not authorized to modify BBOARD.'')') - END IF - - RETURN - END - - - - - - - SUBROUTINE SET_SYSTEM(SYSTEM_SET) -C -C SUBROUTINE SET_SYSTEM -C -C FUNCTION: Set SYSTEM specification for selected folder. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THEN - WRITE (6,'('' ERROR: Cannot modify for remote folder.'')') - ELSE IF (SETPRV_PRIV()) THEN - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (SYSTEM_SET) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been set.'')') - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,2) - WRITE (6,'('' SYSTEM designation has been removed.'')') - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0) - CALL CLOSE_BULLFOLDER - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - ELSE - WRITE (6,'('' You are not authorized to modify SYSTEM.'')') - END IF - - RETURN - END - - - - SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG) - - CHARACTER UPDATE*12,UPTIME*8 - - INTEGER UP_BTIM(2) - - IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END DO - - IF (IER.NE.0.OR.VERSION(1).NE.168) THEN - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0 - END DO - CALL SET2(SYSTEM_FLAG,0) - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1) - SHUTDOWN_BTIM(1) = 0 - SHUTDOWN_BTIM(2) = 0 - NODE_NUMBER = 0 - NODE_AREA = 0 - IF (IER.EQ.0) THEN - DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0) - DELETE (UNIT=4) - DO WHILE (REC_LOCK(IER)) - READ (4,IOSTAT=IER) TEMP_USER - END DO - END DO - IER = 2 - ELSE - VERSION(1) = 168 - END IF - END IF - - IF (VERSION(1).NE.168) THEN - CALL CLOSE_BULLFOLDER - CALL OPEN_BULLFOLDER - NODE_AREA = 0 - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - END DO - IER1 = 0 - DO WHILE (IER1.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER1) - IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN - CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER) - END IF - END DO - VERSION(1) = 168 - END IF - - IF (BTEST(FOLDER_FLAG,2)) THEN - CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER) - END IF - - CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - END IF - - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2), - & NODENAME - IF (IER1.NE.0) THEN - CALL DISCONNECT_REMOTE - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - RETURN - END IF - END IF - - CALL GET_UPTIME(UPDATE,UPTIME) - - CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM) - - IF (NODE_AREA.EQ.0) THEN/ - IF (SHUTDOWN_BTIM(1).EQ.0) THENf - DIFF = -1 - ELSE - DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM)o - END IF - IF (DIFF.EQ.-1) THEN - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - SHUTDOWN_BTIM(1) = UP_BTIM(1) - SHUTDOWN_BTIM(2) = UP_BTIM(2) - DO I=1,FLONGr - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I) - END DO - END IF - ELSE ! Test to make sure NODE_AREA is zero - SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero - DO I=1,FLONG - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1( - END DO - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 - END IFo - - IF (IER.NE.0) THENO - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGi - ELSE - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION,_ - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGR - END IFs - - CALL READ_PERMe - - IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER - - RETURNR - END - - - F - SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - - IMPLICIT INTEGER (A-Z), - - INCLUDE '($SYIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listD - CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA)) - CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER)) - CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist' - - IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command.T -CO -C NODE_AREA is set to 0 after shutdown messages are deleted.B -C If node is not part of cluster, NODE_AREA will be 0, -C so set it to 1 as a dummy value to cause messages to be deleted.N -C - IF (NODE_AREA.EQ.0) NODE_AREA = 1 - - RETURND - END - - - - - SUBROUTINE SET_NODE(NODE_SET) -CA -C SUBROUTINE SET_NODE -C -C FUNCTION: Set or reset remote node specification for selected folder. -CE - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'R - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,FOLDER_SAVE*44 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name: - FOLDER_SAVE = FOLDER - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileI - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF (IER.EQ.0) THEN - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'('' ERROR: No privs to modify folder.'')'). - IER = 1 - END IF - ELSE - WRITE (6,'('' ERROR: Specified folder not found.'')') - END IF - IF (IER.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER)o - CALL CLOSE_BULLFOLDER - RETURN - END IF - CALL CLOSE_BULLFOLDERO - END IFU - - IF (FOLDER_NUMBER.EQ.0) THENC - WRITE (6,'('' Cannot set remote node for the default folder.'')')B - ELSE IF (FOLDER_NUMBER.LT.0.OR.FOLDER_NUMBER.GE.1000) THENB - WRITE (6,'('' Cannot set remote node for this folder.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (.NOT.NODE_SET) THENY - IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN - REMOTE_SET_SAVE = REMOTE_SETE - REMOTE_SET = .FALSE.P - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//E - & FOLDERR - CALL OPEN_BULLDIR ! Remove directory file which - CALL CLOSE_BULLDIR_DELETE ! contains remote folder name - REMOTE_SET = REMOTE_SET_SAVE - END IF - FOLDER1_BBOARD = 'NONE' - WRITE (6,'('' Remote node setting has been removed.'')')_ - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE. - ELSE - CALL GET_INPUT_PROMPT(RESPONSE,RLEN, - & 'Are you sure you want to make folder '//' - & FOLDER(:TRIM(FOLDER))// - & ' remote? (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not modified.'')') - RETURNB - END IFN - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THENr - FOLDER1 = FOLDER - END IF. - IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN) - FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN)' - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THENE - WRITE (6,'(O - & '' ERROR: Folder not accessible on remote node.'')') - RETURN - ELSEE - WRITE (6,'('' Folder has been converted to remote.'')')' - END IF - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER - REMOTE_SET_SAVE = REMOTE_SETl - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin fileT - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name? - CALL OPEN_BULLDIR ! If so, put name in header - BULLDIR_HEADER(13:) = FOLDER1 ! of directory file.B - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIR - FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*'A - END IFD - REMOTE_SET = REMOTE_SET_SAVE_ - IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE. - END IF - CALL OPEN_BULLFOLDER ! Open folder file - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::' - & .AND.BTEST(FOLDER_FLAG,2)) THEN - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,L - & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD)) - & //'::"TASK=BULLETIN1"')H - IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder - WRITE(17,'(2A)',IOSTAT=IER) 14,0E - CLOSE (UNIT=17) - END IFB - END IF - FOLDER_BBOARD = FOLDER1_BBOARD - IF (NODE_SET) THEN - F_NBULL = F1_NBULL - F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1)_ - F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2)S - F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1)N - F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2)O - FOLDER_FLAG = 0 - F_EXPIRE_LIMIT = F1_EXPIRE_LIMITG - ELSE - F_NBULL = 0 - END IF - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - ELSEL - WRITE (6,'('' You are not authorized to modify NODE.'')'), - END IFR - - IF (CLI$PRESENT('FOLDER')) THEN - CALL OPEN_BULLFOLDER_SHARED ! Open folder fileO - CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER) - CALL CLOSE_BULLFOLDER - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//G - & FOLDER - END IF - - RETURNY - END - - - - - SUBROUTINE RESPONDO -CS -C SUBROUTINE RESPOND -CO -C FUNCTION: Sends a mail message in reply to a posted message.= -C -C NOTE: Modify the last SPAWN statement to specify the command -C you use to send mail to sites other than via MAIL. -C If you always use a different command, modify both -C spawn commands.W -CE - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'D - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTL - DATA EDIT_DEFAULT/.FALSE./R - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - COMMON /INDESCRIP/ INDESCRIP1 - CHARACTER*(INPUT_LENGTH) INDESCRIP - - CHARACTER FROM_TEST*5,INFROM*(INPUT_LENGTH) - - EXTERNAL CLI$_NEGATED,CLI$_ABSENT - - MSG_OWN = .FALSE. - - IF (INCMD(:4).EQ.'REPLY') THEN( - BULL_PARAMETER = 'mailing list.' - IF (CLI$PRESENT('ALL')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.'M - ELSE - BULL_PARAMETER = 'message owner and mailing list.'U - END IF - MSG_OWN = .TRUE. - END IF - ELSE IF (INCMD(:4).EQ.'RESP') THENO - MSG_OWN = .TRUE. - BULL_PARAMETER = 'message owner.' - IF (CLI$PRESENT('LIST')) THEN - IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'message owner and news group.' - ELSEN - BULL_PARAMETER = 'message owner and mailing list.'C - END IFU - END IF - ELSE IF (REMOTE_SET.GE.3) THEN - BULL_PARAMETER = 'news group.' - ELSE) - BULL_PARAMETER = 'mailing list.' - END IF - - LIST = INDEX(BULL_PARAMETER,'mailing list') - IF (NEWS_FEED().AND.LIST.GT.0) THEN - BULL_PARAMETER(LIST:) = 'news group'// - & BULL_PARAMETER(LIST+LEN('mailing list'):) - END IFP - - IF (MSG_OWN.AND.BTEST(CAPTIVE(-1),1)) THENG - WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') - RETURN - END IF - - WRITE (6,'('' Sending message to '',A)')i - & BULL_PARAMETER(:TRIM(BULL_PARAMETER))G - - IF (INCMD(:4).NE.'POST') THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE(6,'('' ERROR: You have not read any message.'')') - RETURN ! And return - END IF - - CALL OPEN_BULLDIR_SHARED - - CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found?F - WRITE(6,'('' ERROR: Bulletin was not found.'')')P - CALL CLOSE_BULLDIR ! If not, then error out - RETURN - END IF - - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)I - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENo - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENR - INDESCRIP = INPUT(7:) - ELSE - INDESCRIP = DESCRIP - END IF - - CALL CLOSE_BULLFIL - - CALL CLOSE_BULLDIR - - IF (STREQ(INDESCRIP(:3),'RE:')) THEN - INDESCRIP = 'RE:'//INDESCRIP(4:)o - ELSE - INDESCRIP = 'RE: '//INDESCRIP - END IF - END IFy - - IF (REMOTE_SET.GE.3) THEN d - IF (CLI$PRESENT('EXPIRATION')) THENR - CALL GET_EXPIRED(INPUT,IER) - IF (.NOT.IER) RETURN - EXDATE = INPUT(:11) - EXTIME = INPUT(13:23) - END IF - END IFt - - IF (CLI$PRESENT('SUBJECT')) THENI - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES)C - IF (LENDES.GT.LEN(INDESCRIP)) THEN - WRITE(6,'('' ERROR: Subject length exceeded.'')') - RETURNR - END IF - ELSE IF (INCMD(:4).EQ.'POST') THEND - WRITE(6,'('' Enter subject of message:'')')O - CALL GET_LINE(INDESCRIP,LENDES)( - IF (LENDES.LE.0) THENd - WRITE(6,'('' ERROR: No subject specified.'')')O - RETURNO - END IF - ELSE - WRITE (6,'('' Message will have the subject:'')')E - WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH)) - END IF) - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THENc - EDIT = .TRUE.u - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSE - EDIT = .FALSE. - END IFE - - TEXT = CLI$PRESENT('EXTRACT') - - LIST = CLI$PRESENT('LIST')N - - ILEN = 0L - - FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN) - IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN - CALL DISABLE_PRIVS - OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY,M - & SHARED,IOSTAT=IER,FORM='FORMATTED') - IF (IER.NE.0) FILESPEC = .FALSE. - CALL ENABLE_PRIVS( - END IFF - - FOUNDFILE = FILESPEC - - IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,_ - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')F - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER)L - GO TO 900 - END IF - ELSE IF (TEXT.AND..NOT.EDIT) THEN - WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')') - GO TO 900 - END IFD - - LENFRO = 0L - IF (CLI$GET_VALUE('CC',INPUT,ILEN)) THENR - CALL ADD_PROTOCOL(INPUT,ILEN). - INFROM = INPUT(:ILEN)$ - LENFRO = ILENR - IF (MSG_OWN) THEN - INFROM = INFROM(:LENFRO)//',' - LENFRO = LENFRO + 1 - END IF - END IF - - IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN( - CALL OPEN_BULLFIL_SHARED - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)' - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENi - ILEN = TRIM(INPUT) - IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(INPUT(7:),ILEN)T - INFROM = INFROM(:LENFRO)//INPUT(7:). - LENFRO = LENFRO + ILEN - 6 - END IFD - IF (EDIT.AND.TEXT) THEN - IF (INPUT(ILEN:ILEN).EQ.'"') ILEN = ILEN - 1_ - INPUT = INPUT(7:ILEN) - ILEN = ILEN - 6 - IF (INDEX(INPUT,'%"').GT.0) THEN - INPUT = INPUT(INDEX(INPUT,'%"')+2:)r - ILEN = TRIM(INPUT) - END IF - WRITE (3,'(A)') 'In a previous article, '//v - & INPUT(:ILEN)//' wrote:' - END IFL - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE IF (MSG_OWN) THEN - CALL ADD_PROTOCOL(FROM,0) - INFROM = INFROM(:LENFRO)//FROMP - LENFRO = TRIM(FROM) + LENFRO - END IF - - IF (EDIT.AND.TEXT) THENn - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)N - END IFm - DO WHILE (ILEN.GT.0) ! Copy bulletin into file - IF (CLI$PRESENT('NOINDENT')) THENF - WRITE (3,'(A)') INPUT(:ILEN)D - ELSE - WRITE (3,'(A)') '>'//INPUT(:ILEN) - END IF - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - END DOS - - IF (FILESPEC) THENS - WRITE (3,'(A)') ' ' - IER = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO. - CLOSE (UNIT=4)Q - FILESPEC = .FALSE. - END IFH - - CLOSE (UNIT=3) ! Bulletin copy completedL - END IF - - CALL CLOSE_BULLFIL - END IFL - - IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN - IER = 0I - ICOUNT = 0 - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT - IF (IER.EQ.0) THEND - WRITE (3,'(A)') INPUT(:ILEN)R - ICOUNT = ICOUNT + 1 - END IFH - END DO - CLOSE (UNIT=4) - FILESPEC = .FALSE. - IF (ICOUNT.EQ.0) THEN - CLOSE (UNIT=3,STATUS='DELETE') - ELSE - CLOSE (UNIT=3)1 - END IF - END IFN - - IF (LIST.AND.REMOTE_SET.LT.3) THENW - SLIST = INDEX(FOLDER_DESCRIP,'<')= - IF (SLIST.GT.0) THEN - IF (.NOT.NEWS_FEED()) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:)W - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)6 - INPUT = INPUT(:ILEN)z - CALL ADD_PROTOCOL(INPUT,ILEN) - IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN - INFROM = INFROM(:LENFRO)//','R - LENFRO = LENFRO + 1E - END IFL - INFROM = INFROM(:LENFRO)//INPUT(:ILEN) - LENFRO = LENFRO + ILEN - ELSER - FOLDER1_DESCRIP = - & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1)P - IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN - WRITE(6,'('' ERROR: Multiple newsgroup feed'', - & '' is present.'')') - GO TO 900 - END IF - END IF - ELSE - WRITE (6,'('' ERROR: No list address'', - & '' found in folder description.'')') - GO TO 900 - END IF - END IF' - - I = 1 ! Must change all " to "" in FROM fieldO - DO WHILE (I.LE.LENFRO)C - IF (INFROM(I:I).EQ.'"') THEN - INFROM = INFROM(:I)//'"'//INFROM(I+1:)I - I = I + 1 - LENFRO = LENFRO + 1 - END IF - I = I + 1I - END DOA - - STATUS = .TRUE. - - IF (EDIT) THEND - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')P - CONTEXT = 0I - IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) - IF (TEXT.OR.FOUNDFILE) THENR - VERSION = INDEX(INPUT,';') + 1E - IF (INPUT(VERSION:VERSION).EQ.'1') THEN - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSEl - IER = 0( - END IFL - ELSE IF (IER) THEN - IER = 0 - END IF - IF (IER.EQ.0) THEN - CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER, - & INDESCRIP). - STATUS = IER.EQ.0 - IF (IER.EQ.0) THEN - WRITE (6,'('' Message successfully posted.'')')) - END IF - END IF3 - IF (IER.EQ.0.AND.LENFRO.GT.0) THENw - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS)C - END IFU - END IF - ELSE - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,g - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') - IF (.NOT.FILESPEC) THENR - WRITE (6,'('' Enter message: End with ctrl-z,'', - & '' cancel with ctrl-c'')') - ILEN = LINE_LENGTH + 1 ! Length of input line) - ICOUNT = 0 ! Character count counter- - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too longU - WRITE(6,'('' ERROR: Input line length > '',I,) - & ''. Reinput:'')') LINE_LENGTH - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredu - ICOUNT = ICOUNT + ILEN ! Update counter - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - END IF - END DOG - ELSE - IER = 0 - ICOUNT = 0. - DO WHILE (IER.EQ.0) - READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT: - IF (IER.EQ.0) THEN. - ICOUNT = ICOUNT + 1U - WRITE (3,'(A)') INPUT(:ILEN) - END IF - END DO - CLOSE (UNIT=4)H - FILESPEC = .FALSE.G - END IF - IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines - CLOSE (UNIT=3)r - IER = 1 - ELSE - CALL ADD_SIGNATURE(3,' ',FOLDER_NAME) - REWIND (UNIT=3) - IF ((NEWS_FEED().OR.REMOTE_SET.GE.3).AND.LIST) THEN - CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER, - & INDESCRIP) - STATUS = IER.EQ.0 - IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')') - ELSE - IER = 0 - END IF' - CLOSE (UNIT=3)N - IF (IER.EQ.0.AND.LENFRO.GT.0) THENN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM, - & INDESCRIP,STATUS) - END IFE - END IF - END IFD - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No message added.'')') - IF (.NOT.STATUS) THEN) - CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'// - & ' save message? (Y/N with N as default): ')E - IF (STREQ(INPUT(:1),'Y')) THEN' - CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR',M - & 'SYS$LOGIN:BULL.SAV')' - WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.' - END IF - END IF - END IFd - -900 IF (FILESPEC) CLOSE (UNIT=4) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')F - - RETURN - END - - - - SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME) -C) -C SUBROUTINE ADD_SIGNATURER -C, -C FUNCTION: Adds signature to message being mailed/posted.E -CL - IMPLICIT INTEGER (A-Z)i - - CHARACTER*(*) FOLDER_NAME - - CHARACTER*128 BULL_SIGNATUREE - DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/O - - CHARACTER*256 INPUT - - IF (CLI$PRESENT('NOSIGNATURE')) RETURNL - - OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY, - & SHARED,IOSTAT=IER,FORM='FORMATTED') - - IF (IER.NE.0) THENS - OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY,N - & SHARED,IOSTAT=IER,FORM='FORMATTED')M - END IF - - IF (IER.NE.0) RETURNF - - IF (FILEUNIT.EQ.0) THEN - OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND', - & IOSTAT=IER,FORM='FORMATTED')X - END IFS - - ICOUNT = 0 - MATCH = .FALSE. - DO WHILE (IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUTS - ILEN = TRIM(INPUT) - DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0) - MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME)))F - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - IF (.NOT.MATCH) THEN - DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0) - READ (4,'(A)',IOSTAT=IER) INPUTN - ILEN = TRIM(INPUT)L - END DOE - READ (4,'(A)',IOSTAT=IER) INPUT - ILEN = TRIM(INPUT) - END IF - END DO - IF (IER.EQ.0) THEN - IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN - MATCH = .FALSE.I - ELSE - ICOUNT = ICOUNT + 1 - IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' 'G - WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN) - END IF - END IF - END DON - - CLOSE (UNIT=4)D - IF (FILEUNIT.EQ.0) CLOSE (UNIT=3) - - RETURNI - END - - - - - LOGICAL FUNCTION STREQ(INPUT,INPUT1) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,INPUT1 - - STREQ = .FALSE. - - IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN - - DO I=1,LEN(INPUT) - DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I))) - IF (DIFF.NE.0.AND.DIFF.NE.32) RETURN - END DO= - - STREQ = .TRUE.D - - RETURN - END - - - - - - - SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS) -Cw -C SUBROUTINE RESPOND_MAIL -CC -C FUNCTION: Sends mail to address.I -C) - IMPLICIT INTEGER (A-Z)H - - INCLUDE 'BULLUSER.INC'L - - INCLUDE 'BULLFOLDER.INC'R - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) FILE,SENDTO,SUBJECT - - CHARACTER MAILER*128,INDESCRIP*(LINE_LENGTH)I - - INDESCRIP = SUBJECT - LENDES = TRIM(INDESCRIP) - I = 1 ! Must change all " to "" in SUBJECT field - DO WHILE (I.LE.LENDES) - IF (INDESCRIP(I:I).EQ.'"') THENe - IF (LENDES.EQ.LINE_LENGTH) THEN - INDESCRIP(I:I) = '`'E - ELSEP - INDESCRIP = INDESCRIP(:I)//'"' - & //INDESCRIP(I+1:)U - I = I + 1 - LENDES = LENDES + 1 - END IFI - END IF - I = I + 1E - END DOE - - LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0) - VMSSERV = INDEX(FOLDER_DESCRIP,'VMSSERV').GT.0 - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(FOLDER_BBOARD)0 - - IF (LISTSERV) THEN( - IF (SYS_TRNLNM('MX_NODE_NAME',MAILER)) THEN - REPLY_TO = .NOT.SYS_TRNLNM('MX_REPLY_TO',MAILER)3 - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('MX_REPLY_TO',USERNAME(:TRIM(USERNAME))) - ELSE - REPLY_TO = .NOT.SYS_TRNLNM('PMDF_REPLY_TO',MAILER)I - IF (REPLY_TO) IER = LIB$SET_LOGICAL - & ('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME))) - END IF - END IFL - - LEN_SENDTO = TRIM(SENDTO) - IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN) - IF (LISTSERV) THEN - IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))//F - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)N - & //'""" """'//INDESCRIP(:LENDES)//'""" ' - & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS) - END IFW - ELSE - CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))// - & ' '//FILE(:TRIM(FILE))//' """'//SENDTO(:LEN_SENDTO)// - & '""" """'//INDESCRIP(:LENDES)//'"""',,,,,,STATUS) - END IF - ELSEN - I = INDEX(SENDTO,'%""') + 3/ - DO WHILE (I.LT.LEN_SENDTO-2) - IF (SENDTO(I:I+2).EQ.'"",'.OR.SENDTO(I:I+2).EQ.'%""') THEN - I = I + 3 - ELSE IF (SENDTO(I:I+1).EQ.'""') THENP - SENDTO(I:) = ''''//SENDTO(I+2:) - LEN_SENDTO = LEN_SENDTO - 1 - ELSE IF (SENDTO(I:I).EQ.'\'.AND. - & SENDTO(I+1:I+1).NE.'\') THEN' - SENDTO(I+1:) = '\'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 1 - ELSE IF (SENDTO(I:I).EQ.''''.AND. - & INDEX(SENDTO,'@').GT.I) THEN9 - SENDTO(I:) = '\s'//SENDTO(I+1:) - LEN_SENDTO = LEN_SENDTO + 1 - I = I + 2 - END IFF - I = I + 1 - END DO - - CALL SENDMAIL(FILE(:TRIM(FILE)),SENDTO, - & INDESCRIP(:LENDES),STATUS) - IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS)U -C -C Use the following if you do not have VMS V5.3 or greater.' -C -C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//S -C & SENDTO(:LEN_SENDTO)// -C & '" /SUBJECT="'//INDESCRIP(:LENDES)//'"',,,,,,STATUS) - END IFI - - IF (LISTSERV.OR.VMSSERV) CALL SETUSER(USERNAME) - IF (LISTSERV) THEN - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('PMDF_REPLY_TO') - IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('MX_REPLY_TO')H - END IF - - RETURNI - END - - - - INTEGER FUNCTION CONFIRM_USER(USERNAME) -C( -C FUNCTION CONFIRM_USER -C3 -C FUNCTION: Confirms that username is valid user. -CU - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - CALL OPEN_SYSUAF_SHARED - - READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER) - - CALL CLOSE_SYSUAF - - RETURN - END - - - - - - SUBROUTINE REPLACER -C. -C SUBROUTINE REPLACEw -C -C FUNCTION: CHANGE command subroutine.. -C' - IMPLICIT INTEGER (A - Z)C - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULTA - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - CHARACTER INEXDATE*12,INEXTIME*12 - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH) - CHARACTER*4 ANSWER - - CHARACTER DATE_SAVE*12,TIME_SAVE*12 - - INTEGER TIMADR(2) - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - LOGICAL DOALL - - IF (REMOTE_SET.GE.3) THEN - WRITE (6,'('' Cannot CHANGE messages in this folder.'')') - RETURN - END IFL - -CE -C Get the bulletin number to be replaced. -Co - - ALL = CLI$PRESENT('ALL') - - IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P) - IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN - IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read - WRITE (6,1005) ! Tell user of the errorA - RETURN ! and return - END IF - SBULL = BULL_POINT ! Replace the bulletin we are reading' - EBULL = SBULL - - CALL OPEN_BULLDIR_SHARED - CALL READDIR(BULL_POINT,IER) ! Get message directory entryF - CALL CLOSE_BULLDIR - IF (IER.NE.BULL_POINT+1) THEN ! Was message found? - WRITE(6,'('' ERROR: Specified message was not found.'')') - RETURNW - END IF - ELSE - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) ! Get message directory entry - CALL CLOSE_BULLDIR - IF (NBULL.EQ.0) THEN ! Were messages found? - WRITE(6,'('' ERROR: No messages were found.'')')l - RETURN - END IF - - IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN( - CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1)E - IF (SBULL.LE.0.OR.IER1.NE.0) THEN - WRITE (6,'(A)') - & ' ERROR: Specified message number has incorrect format.' - RETURN - END IFd - ALL = .TRUE.N - ELSE IF (CLI$PRESENT('ALL')) THEN_ - SBULL = 1 - EBULL = NBULL - END IF - END IF - - IF (CLI$PRESENT('SYSTEM')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to system.'')') - RETURN) - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THENF - WRITE (6,'( - & '' ERROR: /SYSTEM cannot be set with selected folder.'')')' - RETURN - END IF - END IFT - - IF (CLI$PRESENT('SHUTDOWN')) THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Not enough privileges to change to shutdown.'')') - RETURNi - ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THENT - WRITE (6,'( - & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')') - RETURNR - ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE.L - & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN - WRITE (6,'('' ERROR: Shutdown node name not'',= - & '' permitted for remote folder.'')') - RETURNA - END IF - END IF' - - IF (CLI$PRESENT('PERMANENT').AND. - & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE (6,'(O - & '' ERROR: Not enough privileges to change to permanent.'')')T - RETURN - END IFN -CT -C Check to see if specified bulletin is present, and if the userA -C is permitted to replace the bulletin. -CE - - CALL OPEN_BULLDIR_SHAREDA - - SAME_OWNER = .TRUE. - DO I=SBULL,EBULLP - CALL READDIR(I,IER) ! Get info for specified messages - IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE. D - END DOR - CALL READDIR(SBULL,IER) - - CALL CLOSE_BULLDIR - - IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin, - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner? - WRITE(6,1090) ! If not, then error out.T - RETURN, - ELSE - WRITE (6,1100) ! Make sure user wants to delete it - READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer - CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase - IF (ANSWER(:1).NE.'Y') RETURN ! If not Yes, then exit - END IF - END IF) - -CT -C If no switches were given, replace the full bulletinP -C) - - DOALL = .FALSE. - - TEXT = CLI$PRESENT('TEXT')R - - IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND. - & (.NOT.CLI$PRESENT('GENERAL')).AND. - & (.NOT.CLI$PRESENT('SYSTEM')).AND.S - & (.NOT.CLI$PRESENT('HEADER')).AND.A - & (.NOT.CLI$PRESENT('SUBJECT')).AND. - & (.NOT.TEXT).AND. - & (.NOT.CLI$PRESENT('SHUTDOWN')).AND.' - & (.NOT.CLI$PRESENT('PERMANENT'))) THENI - DOALL = .TRUE. - END IFA - - IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN* - WRITE (6,'('' ERROR: Cannot change text when replacing'', - & '' more than one messsage.'')')o - RETURN - END IF - - CALL DISABLE_CTRL ! Disable CTRL-Y & -C - - PERMANENT = .FALSE. - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THENI - SYSTEM = 0 - CALL GET_EXPIRED(INPUT,IER)P - PERMANENT = BTEST(SYSTEM,1)( - IF (.NOT.IER) GO TO 910E - INEXDATE = INPUT(:11)I - INEXTIME = INPUT(13:23)E - END IFE - -8 LENDES = 0 - IF (CLI$PRESENT('HEADER').OR.DOALL) THENS - WRITE(6,1050) ! Request header for bulletin - READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP - IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull - ELSE IF (CLI$PRESENT('SUBJECT')) THEN - IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES)L - END IFG - - IF (LENDES.GT.0) THEN - INDESCRIP = 'Subj: '//INDESCRIPL - LENDES = MIN(LENDES+6,LEN(INDESCRIP))_ - END IF, - - IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR - - DO NUMBER=SBULL,EBULL - NUMBER_PARAM = NUMBERM - IF (SBULL.NE.EBULL) THEN - CALL READDIR(NUMBER_PARAM,IER) - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find messageE - CALL CLOSE_BULLDIRN - WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')')' - & NUMBER_PARAM/ - WRITE(6,'('' All messages up to that message were modified.'')') - RETURN" - END IF - END IF - - REC1 = 0 - - LENFROM = 0A - - IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN - OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,( - & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')) - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910 - END IF - - CALL OPEN_BULLFIL_SHARED - - REC1 = 1 - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)F - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN' - INFROM = INPUT(:ILEN) - LENFROM = ILEND - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENN - IF (LENDES.EQ.0.AND..NOT.DOALL) THEN - INDESCRIP = INPUT(:ILEN)1 - LENDES = ILEN - END IF' - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - - DO WHILE (ILEN.GT.0) ! Copy bulletin into file+ - WRITE (3,'(A)') INPUT(:ILEN) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - - CALL CLOSE_BULLFIL - - IF (TEXT.OR.DOALL) CLOSE(UNIT=3) - END IF - - IF (TEXT.OR.DOALL) THENT -C( -C If file specified in REPLACE command, read file to obtain bulletin. -C Else, read the bulletin from the terminal.O -C: - L - ICOUNT = 0 ! Line count for bulletin - LAST_NOBLANK = 0 ! Last line with dataN - REC1 = 1E - - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command - & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specifiedG - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THENF - - IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specifiedO - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN - IF (LEN_P.EQ.0) THEN ! If no file param specifiedR - IF (.NOT.CLI$PRESENT('NEW')) THEN - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW',O - & RECL=LINE_LENGTH, - & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST')I - CALL OPEN_BULLFIL_SHARED ! Prepare to copy messageL - ILEN = LINE_LENGTH + 1 - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENN - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENI - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END IF - DO WHILE (ILEN.GT.0) ! Copy message into fileE - WRITE (3,'(A)') INPUT(:ILEN)* - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - END DO - CALL CLOSE_BULLFIL - CLOSE (UNIT=3) ! Bulletin copy completed - END IFf - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - ELSE - CALL DISABLE_PRIVS - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')' - END IF, - IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1')E - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',e - & DISPOSE='DELETE',ERR=920,FORM='FORMATTED') - ELSE IF (LEN_P.GT.0) THEN - CALL DISABLE_PRIVSP - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file - END IF - - CALL ENABLE_PRIVS ! Reset SYSPRV privilegesB - - DO WHILE(1) ! Read until end of file to - READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count - IF (ILEN.GT.LINE_LENGTH) GO TO 950_ - CALL STR$TRIM(INPUT,INPUT,ILEN) - IF (ILEN.GT.0) THEN ! If good input line entered - ICOUNT = ICOUNT + ILEN + 1 ! Increment record count - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0) THENT - IF (ICOUNT.GT.0) THEN - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line withB - ELSE ! 1 space for a blank line. - REC1 = REC1 + 1R - END IF - END IF - END DO - ELSE ! If no input file - OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920, - & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH, - & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin - WRITE (6,1000) ! Request bulletin input from terminal - ILEN = LINE_LENGTH ! Length of input lineE - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long.& - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput::'')') LINE_LENGTHF - ELSE IF (ILEN.GT.0) THEN ! If good input line enteredS - ICOUNT = ICOUNT + 1 + ILEN ! Increment character count - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - LAST_NOBLANK = ICOUNT - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN - WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file - ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with - END IF ! 1 space for a blank line. - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out -10 ICOUNT = LAST_NOBLANKn - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - END IF - -CI -C Add bulletin to bulletin file and directory entry for to directory file.T -C - - DATE_SAVE = DATE - TIME_SAVE = TIME - INPUT = DESCRIPE - - IF (SBULL.EQ.EBULL) THEN - CALL OPEN_BULLDIR ! Prepare to add dir entryv - CALL READDIR(NUMBER_PARAM,IER) ! Get info for message - - IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR.n - & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN - ! If message disappeared, try to find it. - IF (IER.NE.NUMBER_PARAM+1) DATE = ' 'D - NUMBER_PARAM = 0 - IER = 1m - DO WHILE (IER.EQ.NUMBER_PARAM+1.AND. - & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT)) - NUMBER_PARAM = NUMBER_PARAM + 1 - CALL READDIR(NUMBER_PARAM,IER)( - END DO - - IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message - CALL CLOSE_BULLDIRE - CLOSE (UNIT=3,STATUS='SAVE')A - WRITE(6,'('' ERROR: Message has been deleted'', - & '' by another user.'')') - IF (DOALL.OR.TEXT) THEN - WRITE (6,'('' New text has been saved in'', - & '' SYS$LOGIN:BULL.SCR.'')')A - END IF - GO TO 100 - END IF - END IFW - END IF - - CALL READDIR(0,IER) ! Get directory header - - IF (REC1.GT.0) THEN ! If text has been replaced) - - CALL OPEN_BULLFIL ! Prepare to add bulletinl - - BLOCK = NBLOCK + 1 - BLOCK_SAVE = BLOCK - NEMPTY = NEMPTY + LENGTH - - OBLOCK = BLOCK - IF (LENFROM.GT.0) THEN - CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK)( - END IF - IF (LENDES.GT.0) THENR - CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK) - END IF - REWIND (UNIT=3). - CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin - IF (IER.NE.0) THEN ! Error in creating bulletin - WRITE (6,'(A)') ' ERROR: Unable to replace message.'T - CALL CLOSE_BULLFILO - CALL CLOSE_BULLDIRr - CLOSE (UNIT=3) - GO TO 100 - END IF - - LENGTH_SAVE = OCOUNT - BLOCK + 1 - NBLOCK = NBLOCK + LENGTH_SAVE - - IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER)I - - CALL CLOSE_BULLFIL - - IF (.NOT.REMOTE_SET) THENI - CALL READDIR(NUMBER_PARAM,IER) ! Get directory entryI - LENGTH = LENGTH_SAVE ! Update size - BLOCK = BLOCK_SAVE: - CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry - END IF - ELSE - CALL READDIR(NUMBER_PARAM,IER) - END IF - - IF (.NOT.REMOTE_SET) THEN - - IF (LENDES.GT.0.OR.DOALL) THEN - DESCRIP=INDESCRIP(7:62) ! Update description headerS - END IF - CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND. - & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT,I - & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME) - IF (CLI$PRESENT('SYSTEM')) THENN - SYSTEM = IBSET(SYSTEM,0)L - ELSE IF (CLI$PRESENT('GENERAL')) THENE - SYSTEM = IBCLR(SYSTEM,0)E - END IF - CALL WRITEDIR(NUMBER_PARAM,IER) - ELSE - MSGTYPE = 0 - IF (CLI$PRESENT('SYSTEM').OR.W - & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN& - MSGTYPE = IBSET(MSGTYPE,0)' - END IF - IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THENT - MSGTYPE = IBSET(MSGTYPE,1)1 - ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN - MSGTYPE = IBSET(MSGTYPE,2)I - ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL) - & .AND..NOT.PERMANENT) THENA - MSGTYPE = IBSET(MSGTYPE,3)E - END IF - IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP - IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN - EXDATE = INEXDATE - EXTIME = INEXTIME - END IF - WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER)N - & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:62),MSGTYPE, - & EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COMF - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I)I - END IF - ELSE - CALL DISCONNECT_REMOTEL - END IF - END IF - END DOP - - CALL CLOSE_BULLDIR ! Totally finished with replace - - CLOSE (UNIT=3)+ - -100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C - RETURN_ - -910 WRITE(6,1010)H - CLOSE (UNIT=3,ERR=100) - GOTO 100C - -920 WRITE(6,1020)F - CALL ENABLE_PRIVS ! Reset SYSPRV privileges - GOTO 100. - -950 WRITE (6,1030) LINE_LENGTH - CLOSE (UNIT=3)o - GO TO 100 - -1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')O -1005 FORMAT (' ERROR: You are not reading any message.') -1010 FORMAT (' No message was replaced.') -1015 FORMAT (' ERROR: Specified message was not found.') -1020 FORMAT (' ERROR: Unable to open specified file.') -1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')T -1050 FORMAT (' Enter description header.') -1090 FORMAT(' ERROR: Specified message is not owned by you.')C -1100 FORMAT(' Message(s) is not owned by you.',I - & ' Are you sure you want to replace it? ',$)$ -2020 FORMAT(1X,A) - - END - - - - SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME)( - - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLDIR.INC' - - EXTERNAL CLI$_ABSENTO - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER TODAY*24,INEXDATE*12,INEXTIME*12 - - IF (EXPIRE) THENN - SYSTEM = IBCLR(SYSTEM,1) - SYSTEM = IBCLR(SYSTEM,2) - EXDATE=INEXDATE ! Update expiration date - EXTIME=INEXTIME - DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME) - IF (DIFF.LT.0) THEN ! If it's oldest expiration bull - NEWEST_EXDATE = EXDATE ! Update the header in - NEWEST_EXTIME = EXTIME ! the directory file - CALL WRITEDIR(0,IER)N - END IF - ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN - IF (BTEST(SYSTEM,2)) THENF - SYSTEM = IBCLR(SYSTEM,2)! - SHUTDOWN = SHUTDOWN - 1 - CALL WRITEDIR(0,IER)O - END IF - SYSTEM = IBSET(SYSTEM,1) - EXDATE = '5-NOV-2000'L - EXTIME = '00:00:00.00' - ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN - SYSTEM = IBSET(SYSTEM,2) - SYSTEM = IBCLR(SYSTEM,1) - EXDATE = '5-NOV-2000': - NODE_AREA = 0L - IF (INCMD(:4).EQ.'REPL') THEN= - IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME) - & .NE.%LOC(CLI$_ABSENT)) THEN - CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME) - IF (NODE_AREA.EQ.0) THEN - WRITE (6,'('' ERROR: Shutdown node name ignored.'',L - & '' Invalid node name specified.'')')R - END IFn - END IF - END IF - IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)N - WRITE (EXTIME,'(I4)') NODE_NUMBERR - WRITE (EXTIME(7:),'(I4)') NODE_AREA0 - DO I=1,11o - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//S - & EXTIME(7:8)//'.'//EXTIME(9:10) - SHUTDOWN = SHUTDOWN + 1 - CALL SYS$ASCTIM(,TODAY,,) ! Get the present timee - SHUTDOWN_DATE = TODAY(:11) - SHUTDOWN_TIME = TODAY(13:) - CALL WRITEDIR(0,IER) - END IFf - - RETURNi - END - - - - - SUBROUTINE SEARCH(READ_COUNT) -C: -C SUBROUTINE SEARCH -C& -C FUNCTION: Search for bulletin with specified string -C - IMPLICIT INTEGER (A - Z)) - - INCLUDE 'BULLFOLDER.INC't - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - CHARACTER*132 SEARCH_STRING - - EXTERNAL CLI$_ABSENTu - - IF (INCMD.NE.'SEAR') NFOLDER = 1H - - IF (CLI$PRESENT('SELECT_FOLDER')) THENR - CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME) - SCRATCH_F = SCRATCH_F1 - NFOLDER = 0L - END IFT - - DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders - IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME - NFOLDER = NFOLDER + 1. - CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME) - END DOc - - IF (CLI$PRESENT('SELECT_FOLDER')) SCRATCH_F = SCRATCH_F1h - - START_BULL = BULL_POINT - - IF (CLI$PRESENT('START')) THEN ! Starting message specifiedC - CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P) - DECODE(LEN_P,'(I)',BULL_PARAMETER) START_BULL - IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1 - END IFd - - IF (CLI$PRESENT('NOREPLIES')) THEN - SEARCH_STRING = 'RE:' - SEARCH_LEN = 3 - ELSE - IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN)e - END IFd - - IF (NFOLDER.GT.0) FOUND = 0 - - DO WHILE (NFOLDER.GT.0.AND.FOUND.LE.0) - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR.. - & SCRATCH_F.NE.SCRATCH_F1) . - & CALL GET_SEARCH(FOUND,SEARCH_STRING,START_BULL, - & CLI$PRESENT('REVERSE'),CLI$PRESENT('SUBJECT')D - & .OR.CLI$PRESENT('NOREPLIES'), - & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'),S - & CLI$PRESENT('FROM'),CLI$PRESENT('NEGATED') - & .OR.CLI$PRESENT('NOREPLIES')) R - IF (FOUND.EQ.-1) THEN - NFOLDER = 0 - ELSE IF (FOUND.LE.0) THENs - IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR. - & SCRATCH_F.NE.SCRATCH_F1) NFOLDER = NFOLDER - 1s - IF (NFOLDER.GT.0) THENy - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME)( - OLD_FOLDER_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = -1 - IER = 0 - DO WHILE (.NOT.IER.AND.NFOLDER.GT.0) - FOLDER1 = FOLDER1_NAME - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) THEN - FOLDER_NUMBER = OLD_FOLDER_NUMBER - WRITE (6,'('' ERROR: Cannot find folder '',A, - & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME))H - CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN, - & 'Type new folder name or hit RETURN to continue: ') - IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN - NFOLDER = NFOLDER - 1 - CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F, - & FOLDER1_NAME). - END IFo - END IF - END DO - END IF( - END IF - END DOt - - IF (FOUND.GT.0) THEN - BULL_POINT = FOUND - 1 - CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin - ELSE IF (FOUND.EQ.0) THEN - WRITE (6,'('' No messages found with given search string.'')') - ELSE IF (FOUND.EQ.-2) THEND - WRITE (6,'('' ERROR: No more messages.'')')N - END IF_ - - RETURN - END - - - - - SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,START_BULL,REVERSE, - & SUBJECT,REPLY,FILES,START,FROM_SEARCH,NEGATE)C -C -C SUBROUTINE GET_SEARCH -CW -C FUNCTION: Search for bulletin with specified string -CD - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'. - - COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG - - COMMON /CTRLC_FLAG/ FLAG - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /NEXT/ NEXTL - - CHARACTER*(*) SEARCH_STRING - - CHARACTER*132 SAVE_STRING - DATA SAVE_STRING/' '/ - - CHARACTER*53 DESCRIP1 - - FOUND = -1 - - CALL DISABLE_CTRL - - CALL DECLARE_CTRLC_AST - - IF (TRIM(SEARCH_STRING).EQ.0) THENE - IER1 = .FALSE. - ELSE - IER1 = .TRUE.T - END IF - N - IF (.NOT.IER1.AND..NOT.REPLY.AND. - & (SUBJECT.OR.SEARCH_MODE.NE.1)) THENS - ! If no search string enteredS - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (TRIM(SAVE_STRING).EQ.0) THEN - WRITE (6,'('' No search string present.'')') - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLE - RETURN - END IF - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1.AND..NOT.REPLY) THENE - SEARCH_STRING = SAVE_STRING ! use saved search string - IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2 - END IFL - - IF (FILES) CALL OPEN_BULLDIR_SHARED - - CALL READDIR(0,IER) - - OLD_SEARCH_MODE = SEARCH_MODE - IF (IER1) THEN ! If string entered - IF (SUBJECT) THEN0 - SEARCH_MODE = 3 - ELSE IF (FROM_SEARCH) THEN - SEARCH_MODE = 4 - ELSE - SEARCH_MODE = 2 - END IF - NEGATED = NEGATE - ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN - SEARCH_MODE = 3R - NEGATED = NEGATE - ELSE IF (FROM_SEARCH.AND.SEARCH_MODE.NE.4) THEN - SEARCH_MODE = 4I - NEGATED = NEGATE - ELSE IF (REPLY) THEND - NEGATED = NEGATE - CALL READDIR(START_BULL,IER) - IF (START_BULL+1.NE.IER) THENE - WRITE (6,'('' ERROR: No message being read.'')'), - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLt - RETURNg - ELSE - SEARCH_MODE = 1 - SEARCH_STRING = DESCRIP - IF (REVERSE) START_BULL = START_BULL - 2 - END IF - END IFi - - SAVE_STRING = SEARCH_STRING - SEARCH_LEN = TRIM(SAVE_STRING)g - - CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper caseR - - IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR. - & REVERSE.OR.REPLY) THENf - IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN - START_BULL = 0 ! If starting message not specified, use first - IF (REVERSE) START_BULL = NBULL - 1 ! or laste - END IF - IF (REVERSE) THEN( - END_BULL = 1u - STEP_BULL = -1r - ELSE - END_BULL = NBULL' - STEP_BULL = 1 - END IF - END IFB - - IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR.X - & (START_BULL+1.EQ.0)) THEN - FOUND = -2 - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_ASTD - CALL ENABLE_CTRL - RETURN - END IF2 - - IF (FILES) CALL OPEN_BULLFIL_SHARED - - SAVE_BULL_SEARCH = 0C - DO BULL_SEARCH = START_BULL+1, END_BULL, STEP_BULLE - CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry - IF (READ_TAG) THEN - IF (STEP_BULL.EQ.-1) THEN - CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY)T - IF (IER.NE.0) THEN - CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY)d - END IFd - ELSE - CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER, - & BULL_SEARCH,DUMMY) - END IF - IF (IER.EQ.0) THENS - IER = BULL_SEARCH + 1 - ELSE) - GO TO 800 - END IF( - END IF - IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800 - SAVE_BULL_SEARCH = BULL_SEARCH - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN - IF (SEARCH_MODE.EQ.4) THEN) - CALL STR$UPCASE(DESCRIP1,FROM) - ELSER - CALL STR$UPCASE(DESCRIP1,DESCRIP)O - END IF - IF ((SEARCH_MODE.GE.3.AND. - & INDEX(DESCRIP1,SEARCH_STRING(:SEARCH_LEN)).GT.0).OR. - & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR. - & (INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1.AND. - & DESCRIP1(:4).EQ.'RE: ')))) THEN - IF (.NOT.NEGATED) THEN - FOUND = BULL_SEARCHf - GO TO 900D - END IF - ELSE IF (FLAG.EQ.1) THEN0 - WRITE (6,'('' Search aborted.'')')_ - GO TO 900 - ELSE IF (NEGATED) THEN R - FOUND = BULL_SEARCH - GO TO 900 - END IF) - END IF - IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN( - IF (REMOTE_SET) THENI - CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER) - IF (IER.GT.0) THEN - CALL DISCONNECT_REMOTE - GO TO 900 - ELSE - CALL GET_REMOTE_MESSAGE(IER)E - IF (IER.GT.0) GO TO 900i - END IF - END IFH - ILEN = LINE_LENGTH + 1 - DO WHILE (ILEN.GT.0)c - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E - CALL STR$UPCASE(INPUT,INPUT) ! Make upper case - IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THENC - FOUND = BULL_SEARCH - IF (.NOT.NEGATED) GO TO 900A - ELSE IF (FLAG.EQ.1) THENR - WRITE (6,'('' Search aborted.'')') - GO TO 900N - END IFF - END DOI - IF (NEGATED) THEN - IF (FOUND.EQ.-1) THEN - FOUND = BULL_SEARCH - GO TO 900 - ELSE - FOUND = -1 - END IF - END IF - END IF - END DO) - -800 FOUND = 0i - -900 IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read - IF (FILES) CALL CLOSE_BULLDIR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLS - - RETURNL - END - - - - - SUBROUTINE UNDELETE -CT -C SUBROUTINE UNDELETE -CF -C FUNCTION: Undeletes deleted message.T -C - IMPLICIT INTEGER (A - Z)T - - COMMON /POINT/ BULL_POINT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'L - - INCLUDE 'BULLFOLDER.INC'E - - EXTERNAL CLI$_ABSENT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' Cannot UNDELETE messages in this folder.'')'), - RETURN - END IFL -Ce -C Get the bulletin number to be undeleted. -C - - IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) - IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?& - DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes -5 FORMAT(I)) - ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? - GO TO 910 ! No, then error.E - ELSER - BULL_DELETE = BULL_POINT ! Delete the file we are readingT - END IF - - IF (BULL_DELETE.LE.0) GO TO 920 - -C -C Check to see if specified bulletin is present, and if the user -C is permitted to delete the bulletin. -CO - - CALL OPEN_BULLDIR - - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?_ - WRITE(6,1030) ! If not, then error out - GOTO 100 - END IFR - - IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,L - IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or - & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) - & .AND.FOLDER_SET)) THEN ! folder owner?E - WRITE(6,1040) ! Then error out. - GO TO 100 - ELSE - CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin - IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?U - WRITE(6,1030) ! If not, then error outN - GOTO 100 - END IFF - END IF - END IF - - IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message - EXDATE = EXDATE(:7)//'19'//EXDATE(10:) - ELSE ! Permanent or Shutdown - IF (EXDATE(2:2).EQ.'-') THEN - EXDATE = EXDATE(:6)//'20'//EXDATE(9:) - ELSE - EXDATE = EXDATE(:7)//'20'//EXDATE(10:)) - END IF - END IF - - IF (.NOT.REMOTE_SET) THEN - CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration dateE - WRITE (6,'('' Message was undeleted.'')')R - ELSE - WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.NE.LEN(FOLDER1_COM)) THEN - WRITE (6,'(1X,A)') FOLDER1_COM(:I)- - ELSEU - WRITE (6,'('' Message was undeleted.'')')M - END IF_ - ELSE - CALL DISCONNECT_REMOTER - END IF - END IFM - -100 CALL CLOSE_BULLDIR - -900 RETURN - -910 WRITE(6,1010)N - GO TO 900 - -920 WRITE(6,1020)I - GO TO 900 - -1010 FORMAT(' ERROR: You are not reading any message.')5 -1020 FORMAT(' ERROR: Specified message number has incorrect format.')_ -1030 FORMAT(' ERROR: Specified message was not found.'). -1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.'). - - END - - - - SUBROUTINE ADD_PROTOCOL(INPUT,ILEN) - - IMPLICIT INTEGER (A - Z)e - - INCLUDE 'BULLNEWS.INC'E - - CHARACTER*20 MAIL_PROTOCOLe - - CHARACTER*(*) INPUT - - DATA LMAIL/0/ - - IF (LMAIL.EQ.-1) RETURN - - IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN - - IF (LMAIL.EQ.0) THENB - IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THENA - MAIL_PROTOCOL = MAILER - END IF - LMAIL = TRIM(MAIL_PROTOCOL)E - IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN - MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%'_ - LMAIL = LMAIL + 1 - END IF - IF (LMAIL.EQ.0) THEN - LMAIL = -1 - RETURNO - END IF - END IF - - AT = INDEX(INPUT,'@') - IF (AT.GT.0) INPUT = INPUT(:INDEX(INPUT(AT:),' ')+AT-2) - - INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"'L - - IF (ILEN.NE.0) ILEN = ILEN + LMAIL + 2 - - RETURNE - END diff --git a/decus/vax92b/bulletin/bulletin3.for b/decus/vax92b/bulletin/bulletin3.for deleted file mode 100644 index 886da6b..0000000 --- a/decus/vax92b/bulletin/bulletin3.for +++ /dev/null @@ -1,2221 +0,0 @@ -C -C BULLETIN3.FOR, Version 1/13/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE -C -C SUBROUTINE UPDATE -C -C FUNCTION: Searches for bulletins that have expired and deletes them. -C -C NOTE: Assumes directory file is already opened. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER*107 DIRLINE - - CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE - CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME - - IF (REMOTE_SET.AND. - & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - - IF (TEST_BULLCP().OR.REMOTE_SET) RETURN - ! BULLCP cleans up expired bulletins - - ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test - - TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are - TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value - ! assigned to the latest expiration date - - TEMP_DATE = '5-NOV-1956' ! Storage for computing newest - TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs - - TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest - TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date - - BULL_ENTRY = 1 ! Init bulletin pointer - UPDATE_DONE = 0 ! Flag showing bull has been deleted - - NEW_SHUTDOWN = 0 - OLD_SHUTDOWN = SHUTDOWN - - DO WHILE (1) - CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry - IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found - IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0 - ! If not shutdown, or time - & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns? - IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin? - IF (NODE_AREA.GT.0) THEN - READ (EXTIME(1:2),'(I2)') I - READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG - NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60 - READ (EXTIME(7:8),'(I2)') I - READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG - NODE_AREA_MSG = NODE_AREA_MSG + I*60 - IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND. - & NODE_AREA_MSG.EQ.NODE_AREA) THEN - DIFF = 0 - ELSE - DIFF = 1 - END IF - END IF - DIFF = COMPARE_DATE(EXDATE,' ') - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - IF (DIFF.GT.0) NEW_SHUTDOWN = NEW_SHUTDOWN + 1 - ELSE - DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed? - IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ') - END IF - IF (DIFF.LE.0) THEN ! If so then delete bulletin - CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry - IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file - UPDATE_DONE = BULL_ENTRY ! store it to use for reordering - END IF ! directory file. - ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed - ! If a bulletin is deleted, we'll have to update the latest - ! expiration date. The following does that. - DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE) - IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND. - & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN - TEMP_EXDATE = EXDATE ! If this is the latest exp - TEMP_EXTIME = EXTIME ! date seen so far, save it. - END IF - TEMP_DATE = DATE ! Keep date after search - TEMP_TIME = TIME ! we have the last message date - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - ELSE - TEMP_DATE = DATE - TEMP_TIME = TIME - IF (.NOT.BTEST(SYSTEM,0)) THEN - TEMP_NOSYSDATE = DATE - TEMP_NOSYSTIME = TIME - END IF - END IF - BULL_ENTRY = BULL_ENTRY + 1 - END DO - -100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file - CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries - END IF - - DATE = NEWEST_DATE - TIME = NEWEST_TIME - CALL READDIR(0,IER) - SHUTDOWN = NEW_SHUTDOWN - NEWEST_EXDATE = TEMP_EXDATE - DIFF = COMPARE_DATE(NEWEST_EXDATE,' ') - IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000' - NEWEST_EXTIME = TEMP_EXTIME - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL WRITEDIR(0,IER) - SYSTEM = 0 ! Updating last non-system date/time - NEWEST_DATE = TEMP_NOSYSDATE - NEWEST_TIME = TEMP_NOSYSTIME - CALL UPDATE_FOLDER - SYSTEM = 1 ! Now update latest date/time - NEWEST_DATE = TEMP_DATE - NEWEST_TIME = TEMP_TIME - CALL UPDATE_FOLDER - - IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted? - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info - END IF - -C -C If newest message date has been changed, must change it in BULLUSER.DAT -C and also see if it affects notification of new messages to users -C - IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN - CALL UPDATE_LOGIN(.FALSE.) - END IF - - RETURN - - END - - - - SUBROUTINE UPDATE_READ(USERFILE_OPEN) -C -C SUBROUTINE UPDATE_READ -C -C FUNCTION: -C Store the latest date that user has used the BULLETIN facility. -C If new bulletins have been added, alert user of the fact. -C - - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($PRVDEF)' - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2) - - LOGICAL MODIFY_SYSTEM /.TRUE./ - -C -C Update user's latest read time in his entry in BULLUSER.DAT. -C - IF (.NOT.USERFILE_OPEN) THEN - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - END IF - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.NE.0) THEN ! If header not present, exit - IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER - RETURN - ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN - ! If header present, but no - DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG - SET_FLAG_DEF(I) = 0 ! information, write default - NOTIFY_FLAG_DEF(I) = 0 ! flags. - BRIEF_FLAG_DEF(I) = 0 - END DO - SET_FLAG_DEF(1) = 1 - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - - CALL SYS$ASCTIM(,TODAY,,) ! Get today's time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - UNLOCK 4 - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER1) - - IF (IER1.EQ.0) THEN ! If entry found, update it - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - REWRITE (4) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - ELSE ! If no entry create a new entry - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - LOGIN_BTIM(1) = TODAY_BTIM(1) - LOGIN_BTIM(2) = TODAY_BTIM(2) - READ_BTIM(1) = TODAY_BTIM(1) - READ_BTIM(2) = TODAY_BTIM(2) - CALL WRITE_USER_FILE_NEW(IER) - END IF - - IF (MODIFY_SYSTEM) THEN - CALL MODIFY_SYSTEM_LIST(1) - MODIFY_SYSTEM = .FALSE. - END IF - - IF (.NOT.USERFILE_OPEN) THEN - CALL CLOSE_BULLUSER ! All finished with BULLUSER - END IF - - RETURN ! to go home... - - END - - - - - SUBROUTINE FIND_NEWEST_BULL -C -C SUBROUTINE FIND_NEWEST_BULL -C -C If new bulletins have been added, alert user of the fact and -C set the next bulletin to be read to the first new bulletin. -C -C OUTPUTS: -C BULL_POINT - If -1, no new bulletins to read, else there are. -C - - IMPLICIT INTEGER (A - Z) - - COMMON /POINT/ BULL_POINT - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INTEGER DIR_BTIM(2) - -C -C Now see if bulletins have been added since the user's previous -C read time. If they have, then search for the first new bulletin. -C Ignore new bulletins that are owned by the user or system notices -C that have not been added since the user has logged in. -C - BULL_POINT = -1 ! Init bulletin pointer - - CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file - CALL READDIR(0,IER) ! Get # bulletins from header - IF (IER.EQ.1) THEN3 - CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START) - IF (START.LE.0) THEN - BULL_POINT = START - CALL CLOSE_BULLDIR - RETURNN - END IF - DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM)) - IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user - IF (SYSTEM) THEN ! If system bulletin - CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM) - DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM)T - IF (DIFF.GT.0) THEN_ - START = START + 1 - CALL READDIR(START,IER)S - ELSE ! SYSTEM bulletin was not seenE - SYSTEM = 0 ! so force exit to read it. - END IF - END IF - ELSEP - START = START + 1 - CALL READDIR(START,IER) - IF (IER.NE.START+1) START = NBULL + 1 - END IF_ - END DO - IF (START.LE.NBULL) BULL_POINT = START - 1 - END IFT - - CALL CLOSE_BULLDIR - - RETURNx - END - - - - SUBROUTINE GET_EXPIRED(EXPDAT,IER) - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLUSER.INC'I - - INCLUDE 'BULLFOLDER.INC'd - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 EXPDAT - CHARACTER*24 TODAYp - - DIMENSION EXTIME(2),NOW(2)- - - EXTERNAL CLI$_ABSENTc - - IER = SYS$ASCTIM(,TODAY,,) ! Get today's datee - - IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN)5 - - PROMPT = .TRUE. - - EXPIRE_LIMIT = F_EXPIRE_LIMIT - IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0)a - & EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT - -5 IF (PROMPT) THEN - IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified? - PROMPT = .FALSE.H - ELSE - DEFAULT_EXPIRE = FOLDER_BBEXPIREe - IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0)1 - & DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULTL - IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE - & .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT. - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - DEFAULT_EXPIRE = F_EXPIRE_LIMIT - END IF - IF (BTEST(FOLDER_FLAG,3).OR.A - & REMOTE_SET.EQ.4) THEN ! NOPROMPT was setE - IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date) - SYSTEM = SYSTEM.OR.2 ! make permanentD - EXPDAT = '5-NOV-2000 00:00:00.00' - ELSE ! Else set expirationG - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE) - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00' - END IF - ILEN = TRIM(EXPDAT) - ELSE - IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date - WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4). - ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN - WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4)x - ELSEd - WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4), - & DEFAULT_EXPIRE - END IFF - WRITE (6,1035) - CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line - IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN - IF (DEFAULT_EXPIRE.EQ.-1) THEN - EXPDAT = '5-NOV-2000 00:00:00.00' - SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message - ELSE - CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE)i - EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00'l - END IF - ILEN = TRIM(EXPDAT)i - END IFe - END IF - END IF - ELSE - RETURN - END IF, - - IF (ILEN.LE.0) THEN - IER = 0. - RETURN - END IF - - EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces - - IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND.P - & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified? - EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date - ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specifiedT - & INDEX(EXPDAT,'-').GT.0) THEN ! but no year? - SPACE = INDEX(EXPDAT,' ') - 1 ! Add year - IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) - YEAR = INDEX(TODAY(6:),'-')O - EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) - END IF - - CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case - IER = SYS_BINTIM(EXPDAT,EXTIME) - IF (IER.NE.1) THEN ! If not able to do so - WRITE(6,1040) ! tell user is wrong - IER = 0 ! Set error for return valueM - GO TO 5 ! Re-request date (if prompting) - END IFT - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,) - IF (TIMLEN.EQ.16) THENA - CALL SYS$GETTIM(NOW) - CALL LIB$SUBX(NOW,EXTIME,EXTIME) - IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,)M - END IFN - - IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDATS - IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today'sY - IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND.F - & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - WRITE(6,1050) EXPIRE_LIMIT ! Expiration date > limitI - IER = 0 ! Set error for return valueH - GO TO 5 ! Re-request date (if prompting)N - END IFU - IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23))e - IF (IER.LE.0) THEN ! If expiration date not future - WRITE(6,1045) ! tell useri - IER = 0 ! Set error for return valueT - GO TO 5 ! Re-request date (if prompting) - END IFT - - IF (PROMPT) THEND - IF (BTEST(SYSTEM,1)) THEN ! Permanent message - WRITE (6,'('' Message will be permanent.'')') - ELSE - WRITE (6,'('' Expiration date will be '',A,''.'')') - & EXPDAT(:TRIM(EXPDAT))s - END IF - END IFr - - IER = 1 - - RETURN - -1030 FORMAT(' It is ',A,'. Specify when message expires.') -1031 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is permanent.')( -1032 FORMAT(' It is ',A,'. Specify when message expires.', - & ' Default is ',I3,' days.') -1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ', - & 'or delta time: dddd hh:mm:ss')L -1040 FORMAT(' ERROR: Invalid date format specified.')( -1045 FORMAT(' ERROR: Specified time has already passed.') -1050 FORMAT(' ERROR: Specified expiration period too large.' - & ' Limit is ',I3,' days.')S - - END - - - SUBROUTINE MAILEDIT(INFILE,OUTFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($SSDEF)'_ - - INCLUDE 'BULLUSER.INC') - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - EXTERNAL BULLETIN_SUBCOMMANDS - - CHARACTER*(*) INFILE,OUTFILE - - CHARACTER*80 MAIL_EDIT,OUTR - DATA MAIL_EDIT /' '/. - - CHARACTER*132 INPUT - - CHARACTER*256 SPAWN_COMMAND - - IF (CAPTIVE(2)) THEN - WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')')I - RETURN - END IF) - - IF (MAIL_EDIT.EQ.' ') THENE - IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THENN - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)T - IF (IER.EQ.0) THEN( - DO WHILE (REC_LOCK(IER)) - READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT - END DO2 - CLOSE (UNIT=10) - IF (IER.EQ.0) THENI - INPUT = INPUT(32:)2 - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.8) THEN - MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3))) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IFE - END DO - END IFU - END IFi - END IF - CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) - END IF - - OUT = OUTFILE - IF (TRIM(OUT).EQ.0) THEN - OUT = INFILE - END IFS - - CALL DISABLE_PRIVSl - CALL DECLARE_CTRLC_ASTl - IF (TRIM(MAIL_EDIT).GT.0 - & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN - IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:)b - IF (OUT.EQ.INFILE) THENa - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' "" '//OUT(:TRIM(OUT))C - ELSE - SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT)) - & //' '//INFILE//' '//OUT(:TRIM(OUT)) - END IF - CALL LIB$SPAWN(SPAWN_COMMAND)r - ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THENf - CONTEXT = 0. - IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT) - IF (.NOT.IER1) THEN - CALL TPU$EDIT(' ',OUT) - ELSE - CALL TPU$EDIT(INFILE,OUT) - END IF - IER1 = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) - ! TPU does CLI$ stuff which wipes our parsed command linee - ELSEo - CALL EDT$EDIT(INFILE,OUT) - END IFG - CALL CANCEL_CTRLC_AST - CALL ENABLE_PRIVS - - RETURN - END - - - - - - SUBROUTINE CREATE_BULLCP - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE '($PRCDEF)' - - INCLUDE '($SSDEF)'I - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /REALPROC/ REALPROCPRIV(2) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - STRUCTURE /QUOTA_ITMLST/_ - BYTE ITEM' - INTEGER VALUE - END STRUCTURE - - RECORD /QUOTA_ITMLST/ QUOTA(5)T - - DIMENSION IMAGEPRIV(2)_ - - CHARACTER IMAGENAME*132,ANSWER*4 - - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: You do not have the privileges '', - & ''to execute the command.'')')N - CALL EXIT - END IF - - JUST_STOP = CLI$PRESENT('STOP') - - IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN - WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')')A - CALL EXITT - ELSE IF (.NOT.JUST_STOP.AND.T - & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN - CALL SYS$SETPRV(,,,IMAGEPRIV)E - IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THENC - WRITE (6,'('' ERROR: This new version of BULLETIN'',T - & '' needs to be installed with SYSNAM.'')') - CALL EXIT - END IF - END IFR - - IF (TEST_BULLCP()) THEN - IF (.NOT.JUST_STOP) THEN - WRITE (6,'('' BULLCP process running. - & Do you wish to kill it and restart a new one? '',$)') - READ (5,'(A)') ANSWER(:1) - IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXITT - END IF - - CALL DELPRC('BULLCP',IER)N - - IF (.NOT.IER) THEN - CALL SYS_GETMSG(IER) - CALL EXIT - ELSE IF (JUST_STOP) THEN - WRITE (6,'('' BULLCP process has been terminated.'')')E - CALL EXIT - END IF - ELSE IF (JUST_STOP) THENL - WRITE (6,'('' BULLCP is not presently running.'')')_ - CALL EXIT - END IFA - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(FOLDER_DIRECTORY)M - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)T - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) -CG -C Generate a new BULLCP.COM each time. This is done in case the BULLETIN -C executeable is moved, or a new version of BULLETIN is being installed that. -C has changes to BULLCP.COM. (It's also a security risk to execute the old -C copy, as someone might have been able to write into that directory and -C replace BULLCP.COM, and the command procedure is executed under the -C SYSTEM account, so it has all privileges.)P -C. - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')E - IF (IER.NE.0) RETURN - WRITE(11,'(A)') '$SET NOON' - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$LOOP:'. - WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG' - WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' - & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR' - WRITE(11,'(A)') '$B/BULLCP' - WRITE(11,'(A)') '$WAIT 00:01:00' - WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out - CLOSE(UNIT=11)A - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - CALL GETQUOTA(QUOTA,1)D - - IER = 0 - DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0))I - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B) - & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4), - & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))0 - END DO - - IF (IER) THEN - OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1', - & STATUS='OLD',IOSTAT=IER1) - IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1)c - END IF - - IF (.NOT.IER) THEN) - CALL SYS_GETMSG(IER) - ELSEP - IF (CONFIRM_USER('DECNET').NE.0) THEN - WRITE (6,'('' WARNING: Account with username DECNET'',Y - & '' does not exist.'')')A - WRITE (6,'('' BULLCP will be owned by present account.'')') - END IF - WRITE (6,'('' Successfully created BULLCP detached process.'')') - END IFN - CALL EXIT - - END - - - - - - - SUBROUTINE FIND_BULLCP - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - DATA BULLCP /0/ - - CHARACTER*80 TEMP - - IER = SYS_TRNLNM('BULL_BULLCP',TEMP)R - IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1T - - RETURN) - END - - - - - LOGICAL FUNCTION TEST_BULLCPB - - IMPLICIT INTEGER (A-Z) - - COMMON /BCP/ BULLCP - LOGICAL BULLCPM - - TEST_BULLCP = BULLCP( - - RETURN) - END - - - - - SUBROUTINE RUN_BULLCP - - IMPLICIT INTEGER (A-Z)) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC'A - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'C - - COMMON /BCP/ BULLCP - LOGICAL BULLCPH - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSd - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /BBOARD_LOOP/ BBOARD_LOOP - - CHARACTER*24 OLD_TIME,NEW_TIMEA - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit. - - CALL LIB$DATE_TIME(OLD_TIME)e - - BULLCP = 2 ! Enable process to do BULLCP functionsD - - IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP') - IF (.NOT.IER) THEN ! Can't create mailbox, so exit. - CALL SYS_GETMSG(IER) - CALL EXITa - END IFe - - IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted. - - CALL REGISTER_BULLCP0 - - CALL SET_REMOTE_SYSTEMe - - CALL START_DECNET - - BBOARD_LOOP = 0 - NEWS_LOOP = 0 - - DO WHILE (1) ! Loop once every 15 minutes - CALL SYS$SETAST(%VAL(0)) - - UPDATEBBOARD = 1 - IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN - LEN_P = TRIM(BULL_PARAMETER) - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER)m - & UPDATEBBOARD - IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15 - END IF - - UPDATENEWS = 4 - IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THENr - LEN_P = TRIM(BULL_PARAMETER)' - DECODE(LEN_P,'(I)',BULL_PARAMETER,IOSTAT=IER)I - & UPDATENEWS - IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15 - END IF - - CALL LIB$DATE_TIME(NEW_TIME) - CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections - FOLDER1_DIRECTORY = FOLDER_DIRECTORY - CALL SYS$SETAST(%VAL(1)) - - NOW = INDEX(NEW_TIME,' 03:').NE.0.AND.E - & INDEX(OLD_TIME,' 03:').EQ.0 - IER = 1c - DO WHILE (IER) - CALL BBOARD ! Look for BBOARD messages. - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - POINT_FOLDER = 0O - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)M - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))O - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).NE.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) ! Select folderE - IF (IER) THENA - CALL DELETE_EXPIRED ! Delete expired messages - IF (NOW) THEN ! Do empty block cleanup at 3 a.m. - IF (NEMPTY.GT.200) THEN - CALL CLEANUP_BULLFILE ! Cleanup empty blocks - END IFB - END IFC - END IF - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - CALL SYS$SETAST(%VAL(1))D - END DOT - CALL SYS$SETAST(%VAL(0))E - CALL DELETE_EXPIRED_NEWS(NOW) - CALL SYS$SETAST(%VAL(1)) - IF (NOW) THEN ! Cleanup deleted users from files at 3 a.m. - CALL SYS$SETAST(%VAL(0)) - CALL TOTAL_CLEANUP_LOGIN - CALL SYS$SETAST(%VAL(1)) - END IFI - CALL SYS$SETAST(%VAL(0))E - CALL REGISTER_BULLCP@ - IER1 = 1M - DO WHILE (IER1) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST', - & FOLDER_DIRECTORY)T - IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN - IER1 = 1 - ELSE - IER1 = 0 - END IFU - END DOO - IF (IER) CALL ADD_DIRECTORIES - CALL SYS$SETAST(%VAL(1))T - END DO - - CALL SYS$SETAST(%VAL(0)) - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIESI - CALL SYS$SETAST(%VAL(1))o - - BBOARD_LOOP = BBOARD_LOOP + 1c - IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0 - - CALL SYS$SETAST(%VAL(0)) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND.O - & NEWS_LOOP.EQ.0) CALL CREATE_PROCESS('BULLCP NEWS')R - CALL SYS$SETAST(%VAL(1)) - - NEWS_LOOP = NEWS_LOOP + 1U - IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0 - - OLD_TIME = NEW_TIMER - CALL HIBER('15') ! Wait for 15 minutesR -CT -C Look at remote folders and update local info to reflect new messages. -C Do here after waiting in case problem with connecting to remote folder -C which requires killing process. -C - - FOLDER_Q = FOLDER_Q1 - POINT_FOLDER = 0 - DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) - POINT_FOLDER = POINT_FOLDER + 1 - CALL SYS$SETAST(%VAL(0))S - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (FOLDER_BBOARD(:2).EQ.'::') THEN - CALL SELECT_FOLDER(.FALSE.,IER) - END IFO - CALL SYS$SETAST(%VAL(1))F - END DO - CALL SYS$SETAST(%VAL(0)) - FOLDER_NUMBER = 0 ! Reset to GENERAL folderS - CALL SELECT_FOLDER(.FALSE.,IER)B - CALL SYS$SETAST(%VAL(1)) - END DO - - RETURNE - END - - - - - - SUBROUTINE SET_REMOTE_SYSTEMT - - IMPLICIT INTEGER (A-Z)n - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER NODENAME*8W - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1), - - CALL OPEN_BULLFOLDER_SHAREDR - - IER = 0 - DO WHILE (IER.EQ.0) - CALL READ_FOLDER_FILE(IER) - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2) - & .AND.IER.EQ.0) THENY - CALL CLOSE_BULLFOLDER - CALL SETUSER(FOLDER_OWNER) - CALL SELECT_FOLDER(.FALSE.,IER1)n - IF (IER1) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14, - & BTEST(FOLDER_FLAG,2),NODENAME - END IF_ - CALL SETUSER(USERNAME)C - CALL OPEN_BULLFOLDER_SHAREDB - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - END IF - END DOT - - CALL CLOSE_BULLFOLDER - - FOLDER_NUMBER = 0 ! Reset to GENERAL folder - CALL SELECT_FOLDER(.FALSE.,IER) - - RETURNd - END - - - - - SUBROUTINE REGISTER_BULLCP - - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLUSER.INC't - - INTEGER SHUTDOWN_BTIM(FLONG)M - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)e - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8 - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)c - - CALL OPEN_BULLUSERi - - DO WHILE (REC_LOCK(IER)), - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGT - END DOW - - IF (IER.NE.0) THEN/ - DO I=1,FLONG - SYSTEM_FLAG(I) = 0 - SHUTDOWN_FLAG(I) = 0O - END DO - CALL SET2(SYSTEM_FLAG,0) - NODE_AREA = 0U - END IFU - - CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME) - NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)R - - DO I=1,FLONG - SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I)' - END DO1 - - IF (IER.NE.0) THENW - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,O - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG! - ELSEd - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGP - END IFS - - CALL CLOSE_BULLUSER - - RETURNE - END - - - - - - SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLUSER.INC' - - INTEGER SHUTDOWN_BTIM(FLONG)1 - - EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG); - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME - CHARACTER NODENAME*8U - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CALL OPEN_BULLUSER_ - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*SYSTEM',IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGt - END DO' - - CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER)f - - SEEN_FLAG = 0 - DO I=1,FLONGe - IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1 - END DOB - IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node - - IF (IER.NE.0) THENP - WRITE (4,IOSTAT=IER) - & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,' - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGL - ELSEF - REWRITE (4,IOSTAT=IER) - & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, - & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG - END IFB - - CALL CLOSE_BULLUSER - - RETURNE - END - - - - - - SUBROUTINE HIBER(MIN) -CI -C SUBROUTINE HIBER -CA -C FUNCTION: Waits for specified time period in minutes. -CM - IMPLICIT INTEGER (A-Z)L - INTEGER TIMADR(2) ! Buffer containing timeU - ! in desired system format.L - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/B - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SCHDWK(,,TIMADR,) ! Set timer. - IER=SYS$HIBER() - - RETURNA - END - - - - SUBROUTINE WAIT_SEC(PARAM)U -CP -C SUBROUTINE WAIT_SECa -Ca -C FUNCTION: Waits for specified time period in seconds. -CL - IMPLICIT INTEGER (A-Z)s - INTEGER TIMADR(2) ! Buffer containing timeV - ! in desired system format. - CHARACTER TIMBUF*13,PARAM*2 - DATA TIMBUF/'0 00:00:00.00'/S - DATA WAIT_EF /0/ - - IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF)C - - TIMBUF(9:10) = PARAMm - - IER=SYS$BINTIM(TIMBUF,TIMADR) - IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer. - IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set.p - - RETURN - END - - - - SUBROUTINE DELETE_EXPIRED_NEWS(NOW) -CE -C SUBROUTINE DELETE_EXPIRED_NEWSL -CO -C FUNCTION: -CP -C Delete any expired message in local news folders. -C - - IMPLICIT INTEGER (A-Z)> - - INCLUDE 'BULLFOLDER.INC'm - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /NEXT/ NEXT4 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLFIL/ BULLFIL - - INTEGER TODAY(2),DAY(2),NEXT_EX_BTIM(2) - - CHARACTER*8 TODAY_KEY - CHARACTER ASCTIME*24_ - - IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN - - FOLDER_NUMBER = 1000N - - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' - - CALL OPEN_BULLNEWS_SHARED - - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1)D - - IF (IER.NE.0) THEND - CALL CLOSE_BULLNEWST - RETURN - END IF - - CALL SYS_BINTIM('-',TODAY)' - E - CALL GET_MSGKEY(TODAY,TODAY_KEY) - - DO WHILE (1) - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - - DO WHILE (REC_LOCK(IER)) - READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM - END DO - CALL NEWS_TO_FOLDERL - - UNLOCK 7 - - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - GO TO 1000D - ELSE IF (REMOTE_SET.NE.4) THEN - REMOTE_SET = 4 - CALL OPEN_BULLDIR_SHAREDR - END IF - - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - - DEL_COUNT = 0W - NDEL = -1t - DS = .FALSE. - DN = .FALSE. - CALL READ_FIRST_EXPIRED(NDEL)C - DO WHILE (NDEL.GT.0) - DIFF = COMPARE_BTIM(TODAY,EX_BTIM)C - IF (DIFF.GT.0) THEN - IF (NDEL.EQ.F_START) DS = .TRUE. - IF (NDEL.EQ.F_NBULL) DN = .TRUE. _ - IF (NDEL.GT.NEWS_F_END) THEN% - CALL READ_NEXT_EXPIRED(NDEL)E - ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN - DEL_COUNT = DEL_COUNT + 1N - CALL READ_NEXT_EXPIRED(NDEL)s - ELSE IF (EXDATE(8:9).EQ.'18'.OR. ! Deleted manually? - & INDEX(EXDATE,'1900').GT.0) THEN - IF (LENGTH.GT.0) CALL DUMP_MESSAGE()% - CALL SYS$ASCTIM(,ASCTIME,TODAY,) - EXDATE = ASCTIME(:11) R - EXTIME = ASCTIME(13:23)S - LENGTH = 0 - CALL WRITEDIR(MSG_NUM,IER) - DEL_COUNT = 0. - CALL READ_FIRST_EXPIRED(NDEL) - ELSE - CALL READ_NEXT_EXPIRED(NDEL) I - END IF - ELSE - CALL COPY2(NEXT_EX_BTIM,EX_BTIM) - IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) - END IF - NDEL = 0E - UNLOCK 2A - END IF - END DO - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - NEXT = .FALSE. - CALL READDIR(F_START,IER)L - IF (DS.OR.F_START.EQ.IER) THEN - IER = 0 - NEXT = .TRUE. - I = F_STARTE - DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0) - I = I + 1 - CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0_ - END DOR - F_START = Ia - NEXT = .FALSE. - END IF - CALL READDIR(F_NBULL,IER)i - IF (DN.OR.F_NBULL.EQ.IER) THEN - I = F_NBULL - IER = I - DO WHILE (I.GE.F_START.AND.IER.EQ.I)q - I = I - 1 - CALL READDIR(I,IER) - IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = IN - END DO_ - IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) - IF (I.NE.IER) F_NBULL = I - END IF - F_COUNT = MAX(0,F_COUNT - DEL_COUNT) - CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE) - FOLDER_FLAG = IBSET(FOLDER_FLAG,13) - CALL REWRITE_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - CALL READ_FIRST_EXPIRED(NDEL) - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND. - & COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) - IF (LENGTH.GT.0) CALL DUMP_MESSAGE() - DELETE (UNIT=2)E - CALL READ_FIRST_EXPIRED(NDEL)C - END DOI - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13) - CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE) - CALL REWRITE_FOLDER_FILE(IER) - END IF - END DO= - - CALL CLOSE_BULLDIR - CALL CLOSE_BULLNEWS - -1000 IF (NOW) THEN . - CONTEXT = 0( - IER = LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT) - IF (IER) IER = CONV$RECLAIM(BULLNEWSDIR_FILE) - CALL COPY2(EX_BTIM,TODAY)L - BULLFIL = 0 - DO I=1,31 - IER = SYS_BINTIM('1 00:00',DAY) - IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM) - CALL SET_BULLFIL - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;')E - END DO E - IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) - & //'BULLNEWS*.DIR;*') - END IFL - - RETURN, - END - - - - SUBROUTINE DELETE_EXPIRED -C -C SUBROUTINE DELETE_EXPIRED -CE -C FUNCTION: -CC -C Delete any expired bulletins (normal or shutdown ones). -C (NOTE: If bulletin files don't exist, they get created now by -C OPEN_FILE_SHARED. Also, if new format has been defined for files,W -C they get converted now. The directory file has had it's record sizeL -C lengthened in the past to include more info, and the bulletin file -C was lengthened from 80 to 81 characters to include byte which indicated -C start of bulletin message. However, that scheme was removed andR -C was replaced with a 128 byte record compressed format). -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'Y - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - CHARACTER UPTIME_DATE*12,UPTIME_TIME*12 - - CALL OPEN_BULLDIR_SHARED ! Open directory file - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - CALL CLOSE_BULLFIL, - CALL READDIR(0,IER) ! Get directory header - IF (IER.EQ.1) THEN ! Is header present?A - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? - IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid. - IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')U - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.F - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND.G - & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown messages exist and need to be checked?A - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1* - END IF - IF (IER.LE.0.OR.IER1.LE.0) THENN - CALL CLOSE_BULLDIRA - CALL OPEN_BULLDIR ! Reopen without sharing - CALL UPDATE ! Need to updateF - END IF - ELSE ! If header not there, then first time running BULLETIN - IF (FOLDER_NUMBER.EQ.0) THEN - CALL OPEN_BULLUSER ! Create user file to be able to set - CALL CLOSE_BULLUSER ! defaults, privileges, etc.T - END IF - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENA - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - END IFU - CALL CLOSE_BULLDIRB - - RETURNA - END - - - - - SUBROUTINE BBOARD -CO -C SUBROUTINE BBOARD -CE -C FUNCTION: Converts mail to BBOARD into non-system bulletins.O -CN - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'I - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE '($RMSDEF)' - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS - DATA FOLDER_Q1/0/ - - COMMON /BBOARD_LOOP/ BBOARD_LOOPB - - CHARACTER*12 INEXDATE - CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76i - CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12 - CHARACTER F_BBOARD*64,BBOARD_NAME*64 - - DIMENSION NEW_MAIL(FOLDER_MAX)N - - DATA SPAWN_EF/0/,HEADER_Q1/0/ - - CALL SYS$SETAST(%VAL(0))N - - IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF)i - - CALL DISABLE_CTRL - - CALL INIT_QUEUE(HEADER_Q1,INPUT)T - - CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) - - FOLDER_Q = FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from fileF - CALL READ_FOLDER_FILE(IER) - IF (IER.EQ.0) THEN - NUM_FOLDERS = NUM_FOLDERS + 1 - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - END IF - END DOE - - CALL CLOSE_BULLFOLDER ! We don't need file anymorei - CALL SYS$SETAST(%VAL(1))o - - IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900D - - CALL SYS$SETAST(%VAL(0)). - CALL CHECK_MAIL(NEW_MAIL) - CALL SYS$SETAST(%VAL(1))4 - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - - NBBOARD_FOLDERS = 0 - - POINT_FOLDER = 0Y - -1 POINT_FOLDER = POINT_FOLDER + 1T - IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 - - CALL SYS$SETAST(%VAL(0))E - - FOLDER_Q_SAVE = FOLDER_QF - - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR. - & FOLDER_BBOARD(:2).EQ.'::') GO TO 1 - - NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1 - - IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1I -C -C The process is set to the BBOARD uic and username in order to create -C a spawned process that is able to read the BBOARD mail (a real kludge). -C - - CALL GETUSER(USERNAME_SAVE) ! Get present username - CALL GETACC(ACCOUNT_SAVE) ! Get present account - CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic - - IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present? - IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username - IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version? - CALL SETACC(ACCOUNTB) ! Set to BBOARD accountW - CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uicL - END IF - - LEN_B = TRIM(BBOARD_DIRECTORY) - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)//L - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*') - ! Delete old TXT files left due to errors_ - - IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN - ! If normal BBOARD user - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0)) - IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM', - & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST')S - WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' - WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV'E - WRITE(11,'(A)') - & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)//I - & '''F$GETJPI("","USERNAME")''' - WRITE(11,'(A)') '$ MAIL' - WRITE(11,'(A)') 'SELECT MAIL' - WRITE(11,'(A)') 'READ'F - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL'. - WRITE(11,'(A)') 'READ/NEW'0 - WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE' - WRITE(11,'(A)') 'DELETE/ALL'R - WRITE(11,'(A)') 'SELECT/NEW'( - CLOSE(UNIT=11)B - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) - & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1))I - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF)) - CALL SYS$SETAST(%VAL(0))) - END IF - ELSEI - CONTEXT = 0_ - IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARDL - & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT) - IF (IER) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//G - & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:', - & 'NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))D - CALL SYS$SETAST(%VAL(0))W - END IF - IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR. - & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN - IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// - & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) - CALL SYS$SETAST(%VAL(1)) - IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))D - CALL SYS$SETAST(%VAL(0))R - END IF - END IFF - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM)B - - NBULL = F_NBULL - - CALL SETACC(ACCOUNT_SAVE) ! Reset to original accountL - CALL SETUSER(USERNAME_SAVE) ! Reset to original username - CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic - - OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD: - & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100) - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line - CALL SYS$SETAST(%VAL(1))' - -5 CALL SYS$SETAST(%VAL(0)) - - CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM)R - - DO WHILE (LEN_INPUT.GT.0) - IF (INPUT(:5).EQ.'From:') THEN - INFROM = INPUT(7:) ! Store usernameP - ELSE IF (INPUT(:5).EQ.'Subj:') THENE - INDESCRIP = INPUT(7:) ! Store subjectt - ELSE IF (INPUT(:3).EQ.'To:') THENE - INTO = INPUT(5:) ! Store addressr - END IF - READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail - END DOe - - INTO = INTO(:TRIM(INTO))r - CALL STR$TRIM(INTO,INTO)s - CALL STR$UPCASE(INTO,INTO)s - FLEN = TRIM(FOLDER_BBOARD)h - HEADER_Q = 0 - NHEAD = 0 - IF (.NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN - HEADER_Q = HEADER_Q1 - IER = 0H - CALL STRIP_HEADER(' ',0,STRIP) - STRIP = .TRUE. - DO WHILE (IER.EQ.0.AND.STRIP)m - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTL - IF (IER.EQ.0) THENL - CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP)M - CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - NHEAD = NHEAD + 1 - END IFT - END DO - - FOUND = .FALSE. - J = 0B - DO WHILE (J.LT.2.AND..NOT.FOUND) - J = J + 1 - POINT_FOLDER1 = 0 - FOLDER_Q2 = FOLDER_Q1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) - CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM)b - POINT_FOLDER1 = POINT_FOLDER1 + 1 - IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND. - & FOLDER1_BBOARD(:2).NE.'::'.AND. - & FOLDER1_BBOARD(:4).NE.'NONE') THEN. - IF (J.EQ.1) THEN - F_BBOARD = FOLDER1_BBOARD - ELSE - F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP)n - END IF - IF (J.EQ.1.OR.F_BBOARD.NE.FOLDER1_BBOARD) THEN - FLEN = TRIM(F_BBOARD) - FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN)) - IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN - HEADER_Q = HEADER_Q1 - I = 1 - DO WHILE (I.LT.NHEAD.AND..NOT.FOUND)L - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN)) - I = I + 1 - END DOe - END IFm - END IF - END IFF - END DO. - END DO - IF (FOUND) FOLDER_COM = FOLDER1_COMi - END IFa - - IF (NHEAD.EQ.0) THENL - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line - ELSE2 - HEADER_Q = HEADER_Q1 - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1_ - END IF - - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0)D - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT - IF (INPUT(:5).EQ.'From:') GO TO 5N - END DO ! If line is just form feed, the message is empty - IF (IER.NE.0) GO TO 100 ! If end of file, exit - - EFROM = 2 - I = TRIM(INFROM)F - DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the dateT - IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" lineN - I = I - 1T - END DOR - IF (I.GT.0) INFROM = INFROM(:I) - - CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER)* - - ISTART = 0F - NBLANK = 0O - IER = 0 - DO WHILE (IER.EQ.0) ! Move text to bulletin file - IF (LEN_INPUT.EQ.0) THEN - IF (ISTART.EQ.1) THEN - NBLANK = NBLANK + 1 - END IFi - ELSE - ISTART = 1L - DO I=1,NBLANK - CALL WRITE_MESSAGE_LINE(' ')E - END DO) - NBLANK = 0D - CALL WRITE_MESSAGE_LINE(INPUT) - END IF - IF (NHEAD.EQ.0) THEN - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTn - ELSE - CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)H - LEN_INPUT = TRIM(INPUT) - NHEAD = NHEAD - 1 - END IF - IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN - DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)C - & .AND.IER.EQ.0) - READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTO - END DOL - IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN - IER = 1 - ELSE4 - NBLANK = NBLANK + 1 - END IFe - END IF - END DO - - FOLDER_NAME = FOLDER ! For broadcasts - - CALL FINISH_MESSAGE_ADD ! Totally finished with add - - CALL SYS$SETAST(%VAL(1))C - - GO TO 5 ! See if there is more mail - -100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input fileO - CALL SYS$SETAST(%VAL(1))) - GO TO 1 - -900 CALL SYS$SETAST(%VAL(0)) - - FOLDER_NUMBER = 0 - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNUM(0,IER) - CALL CLOSE_BULLFOLDER - CALL ENABLE_CTRLo - FOLDER_SET = .FALSE.r - - IF (NBBOARD_FOLDERS.EQ.0) THENn - CALL OPEN_BULLUSER - CALL READ_USER_FILE_HEADER(IER)e - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM)a - REWRITE (4) USER_HEADER ! Rewrite headerc - CALL CLOSE_BULLUSERP - END IFR - CALL SYS$SETAST(%VAL(1)) - - CALL SYS$SETAST(%VAL(0))) - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND. - & .NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) CALL NEWS2BULL - CALL SYS$SETAST(%VAL(1))e - - RETURNe - -910 WRITE (6,1010) - GO TO 100 - -930 CLOSE (UNIT=14)W - CALL CLOSE_BULLFILL - CALL CLOSE_BULLDIRE - WRITE (6,1030)B - GO TO 100 - -1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.')_ -1030 FORMAT(' ERROR:Alert system programmer. Data file problems.') - - END - - - - - LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) - - IMPLICIT INTEGER (A-Z)U - - CHARACTER*(*) INPUT,BBOARD - - DETECT_BBOARD = .TRUE.B - - LEN_BBOARD = LEN(BBOARD) - 1$ - - DO I=1,TRIM(INPUT)-LEN_BBOARD - IF (.NOT.STREQ(INPUT(:4),'Subj').AND.A - & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND. - & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND.S - & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR.F - & INDEX(' .@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0)) - & RETURN - END DO - - DETECT_BBOARD = .FALSE. - - RETURN, - END - - - - LOGICAL FUNCTION ALPHA(IN)t - - CHARACTER*1 INR - - ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z')) - & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z')) - - RETURNS - END - - - - CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP), - - CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP1 - - BBOARD_NAME = FOLDER_BBOARD - - I = INDEX(FOLDER_DESCRIP,'<') - IF (I.EQ.0) RETURN - - BBOARD_NAME = FOLDER_DESCRIP(I+1:) - - I = INDEX(BBOARD_NAME,'%"') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:) - - I = INDEX(BBOARD_NAME,'!') - DO WHILE (I.GT.0) - BBOARD_NAME = BBOARD_NAME(I+1:) - I = INDEX(BBOARD_NAME,'!') - END DOW - - I = INDEX(BBOARD_NAME,'>') - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'@')) - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - I = INDEX(BBOARD_NAME,'%')B - IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1) - - RETURNt - END - - - - - SUBROUTINE CREATE_PROCESS(COMMAND)I - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRCDEF)' - - INCLUDE 'BULLFILES.INC' - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - STRUCTURE /QUOTA_ITMLST/N - BYTE ITEMC - INTEGER VALUE( - END STRUCTURE - - RECORD /QUOTA_ITMLST/ QUOTA(5) - - CHARACTER*132 IMAGENAME - - CHARACTER*(*) COMMAND - - CALL GETIMAGE(IMAGENAME,ILEN) - - LEN_B = TRIM(BBOARD_DIRECTORY)F - - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='OLD',IOSTAT=IER) - IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE'), - - CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)% - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW) - OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM', - & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')A - IF (IER.NE.0) RETURN_ - WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN) - WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' - WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT' - WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' - WRITE(11,'(A)') '$B/'//'''F$PROCESS()''') - WRITE(11,'(A)') '$EXIT:'% - WRITE(11,'(A)') '$LOGOUT' - CLOSE(UNIT=11)Q - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionU - - DEL = .FALSE. - IER = .FALSE. - - CALL GETQUOTA(QUOTA,0)L - - DO WHILE (.NOT.IER) - IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', - & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',,= - & PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) - & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))= - IF (.NOT.IER.AND..NOT.DEL) THENI - CALL DELPRC('BULLCP NEWS',DEL)$ - IER = .NOT.DELA - ELSE - IER = .TRUE. - END IF - END DOR - - RETURNU - END - - - - - SUBROUTINE GETQUOTA(QUOTA,CLI) -C -C SUBROUTINE GETQUOTA -CH - IMPLICIT INTEGER (A-Z)( - - INCLUDE '($PQLDEF)' - - INCLUDE '($JPIDEF)' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - STRUCTURE /QUOTA_ITMLST/ - BYTE ITEMr - INTEGER VALUEE - END STRUCTURE - - RECORD /QUOTA_ITMLST/ QUOTA(5) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listT - CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT)) - CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT)) - CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistA - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - I = 1 - IF (CLI.AND.CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN T - DECODE(LEN_P,'(I)',BULL_PARAMETER) PGFLQUOTAL - QUOTA(I).ITEM = PQL$_PGFLQUOTA - QUOTA(I).VALUE = PGFLQUOTA - I = I + 1 - END IFO - IF (CLI.AND.CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN. - DECODE(LEN_P,'(I)',BULL_PARAMETER) WSEXTENT - END IF_ - QUOTA(I).ITEM = PQL$_WSEXTENTA - QUOTA(I).VALUE = WSEXTENT - I = I + 1 - QUOTA(I).ITEM = PQL$_WSQUOTA - QUOTA(I).VALUE = WSQUOTAR - I = I + 1 - QUOTA(I).ITEM = PQL$_WSDEFAULT1 - QUOTA(I).VALUE = WSDEFAULTP - I = I + 1 - QUOTA(I).ITEM = PQL$_LISTEND - QUOTA(I).VALUE = 0. - - RETURN - END - F - - - - SUBROUTINE GETUIC(GRP,MEM) -C -C SUBROUTINE GETUIC(UIC) -CB -C FUNCTION: -C To get UIC of process submitting the job.A -C OUTPUT: -C GRP - Group number of UIC -C MEM - Member number of UICA -CN - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listO - CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP)) - CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistH - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURN - END - - - - SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)F -C -C SUBROUTINE GET_UPTIME -C -C FUNCTION: Gets time of last reboot. -C_ - - IMPLICIT INTEGER (A-Z)D - - INCLUDE '($SYIDEF)' - - INTEGER UPTIME(2)L - CHARACTER*(*) UPTIME_TIME,UPTIME_DATE - CHARACTER ASCSINCE*24 - - CALL INIT_ITMLSTU - CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME)) - CALL END_ITMLST(GETSYI_ITMLST) - - IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,) - - CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) - - UPTIME_DATE = ASCSINCE(:11) - UPTIME_TIME = ASCSINCE(13:23) - - RETURN - END - - - - INTEGER FUNCTION GET_L_VAL(I) - INTEGER I - GET_L_VAL = I - RETURN. - END - - - - SUBROUTINE CHECK_MAIL(NEW_MAIL) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSQ - DATA FOLDER_Q1/0/ - - DIMENSION NEW_MAIL(1) - - CHARACTER INPUT*132 - - INTEGER*2 COUNT - - FOLDER_Q = FOLDER_Q1 ! so reinit queue pointerN - - OPEN (UNIT=10,FILE='VMSMAIL_PROFILE', - & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER) - - DO I=1,NUM_FOLDERSD - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)D - - IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR.N - & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND.I - & FOLDER_BBOARD(:4).NE.'NONE') THEN - ! If normal BBOARD or /VMSMAIL - DO WHILE (REC_LOCK(IER1)) - READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT - END DO) - COUNT = 0 - IF (IER1.EQ.0) THEN - INPUT = INPUT(32:)C - DO WHILE (TRIM(INPUT).GT.0) - IF (ICHAR(INPUT(1:1)).EQ.1) THEN - CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT) - INPUT = ' ' - ELSE - INPUT = INPUT(ICHAR(INPUT(3:3))+5:) - END IF - END DO - END IF= - IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN! - NEW_MAIL(I) = .TRUE.d - ELSE$ - NEW_MAIL(I) = .FALSE. - END IF - ELSE - NEW_MAIL(I) = .TRUE.4 - END IF - END DOC - - CLOSE (10)f - - RETURN - END - - - - SUBROUTINE GETIMAGE(IMAGNAME,ILEN)T -C( -C SUBROUTINE GETIMAGE(IMAGNAME,ILEN)P -CB -C FUNCTION: -C To get image name of process.( -C OUTPUT: -C IMAGNAME - Image name of processF -C ILEN - Length of imagenameA -CF - - IMPLICIT INTEGER (A-Z)L - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) IMAGNAMEe - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME, - & %LOC(IMAGNAME),%LOC(ILEN)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistS - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command. - - RETURNL - END - - - - - SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2)0 - - IF (REMOTE_SET) THEN - CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START)0 - ELSEA - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - IF (START.EQ.0) THEN - START = -1A - END IF - END IFE - - RETURN - END - - - - SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM) - - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DIMENSION IN_BTIM(2)E - - CALL GET_MSGKEY(IN_BTIM,MSG_KEY) - CALL READDIR_KEYGE(START) - - IF (START.EQ.0) RETURN - - CALL OPEN_BULLUSER_SHARED - - IER = START + 1 - DO WHILE (START+1.EQ.IER) - IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0) - START = START + 1. - CALL READDIR(START,IER) - END DOL - - CALL CLOSE_BULLDIR - - RETURN1 - END - - - - - - SUBROUTINE READ_NOTIFY. - - IMPLICIT INTEGER (A-Z)) - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLUSER.INC'E - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE= - END DOB - - IF (IER.NE.0) THENE - DO I=1,FLONG - NOTIFY_REMOTE(I) = 0_ - END DO - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTEI - END IFO - - CALL CLOSE_BULLDIRI - - RETURN= - END - - - - SUBROUTINE DELPRC(DELNAM,IER) - - IMPLICIT INTEGER (A-Z)N - - INCLUDE '($JPIDEF)' - - CHARACTER*(*) DELNAMD - - DATA OBIO/0/,OCPU/0/,ODIO/0/ - - CHARACTER PRCNAM*15 - - TEST = 'BULLCP NEWS'.EQ.DELNAMB - - WILDCARD = -1 - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listB - I - CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM)) - CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID)) - IF (TEST) THEN - CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO)) - CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU))P - CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO)) - END IFE - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,) - IF (.NOT.IER) THEN - IER = 1I - DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM)T - ! Get next interactive process - IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.$ - END DO - END IF_ - IF (IER.AND.PID.NE.0) THEN - IF (TEST.AND.N - & (BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN - OBIO = BIOM - ODIO = DIO - OCPU = CPU= - IER = 0 - RETURNI - END IF - IER = SYS$DELPRC(PID,) - IF (IER.AND.TEST) THEN - OBIO = 0 - ODIO = 0 - OCPU = 0 - END IF - END IFE - RETURN) - END diff --git a/decus/vax92b/bulletin/bulletin4.for b/decus/vax92b/bulletin/bulletin4.for deleted file mode 100644 index b224397..0000000 --- a/decus/vax92b/bulletin/bulletin4.for +++ /dev/null @@ -1,2162 +0,0 @@ -C -C BULLETIN4.FOR, Version 11/27/92 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C -C SUBROUTINE ITMLST_SUBS -C -C FUNCTION: -C A set of routines to easily create item lists. It allows one -C to easily create item lists without the need for declaring arrays -C or itemlist size. Thus, the code can be easily changed to add or -C delete item list codes. -C -C Here is an example of how to use the routines (prints file to a queue): -C -C CALL INIT_ITMLST ! Initialize item list -C ! Now add items to list -C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME)) -C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE)) -C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist -C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,) -C - SUBROUTINE ITMLST_SUBS - - IMPLICIT INTEGER (A-Z) - - DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/ - - ENTRY INIT_ITMLST - - IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called? - CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header - CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header - ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list - CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS) - NUM_ITEMS = 0 ! Release old itemlist memory - SAVE_ITMLST_ADDRESS = 0 - ELSE ! ITMLST calls cannot be nested. - WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)') - WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')') - CALL EXIT - END IF - - RETURN - - - ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR) -C -C ITMLST entries are initially stored in a queue. Each queue entry -C needs 8 bytes for pointer + 12 bytes for itemlist info. -C - CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry - - CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR, - & RETADR) - ! Store data in itemlist format - CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER)) - ! Insert entry into queue - NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count - - RETURN - - - ENTRY END_ITMLST(ITMLST_ADDRESS) - - CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS) - ! Get memory for itemlist - SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory - - DO I=1,NUM_ITEMS ! Place entries into itemlist - CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST) - CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8), - & %VAL(ITMLST_ADDRESS+(I-1)*12)) - CALL LIB$FREE_VM(20,INPUT_ITMLST) - END DO - - CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12)) - ! Place terminating 0 at end of itemlist - - RETURN - END - - - - SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR, - & RETADR) - - IMPLICIT INTEGER (A-Z) - - STRUCTURE /ITMLST/ - UNION - MAP - INTEGER*2 BUFLEN,CODE - INTEGER BUFADR,RETADR - END MAP - END UNION - END STRUCTURE - - RECORD /ITMLST/ INPUT_ITMLST(1) - - INPUT_ITMLST(1).BUFLEN = BUFLEN - INPUT_ITMLST(1).CODE = CODE - INPUT_ITMLST(1).BUFADR = BUFADR - INPUT_ITMLST(1).RETADR = RETADR - - RETURN - END - - - SUBROUTINE CLEANUP_LOGIN -C -C SUBROUTINE CLEANUP_LOGIN -C -C FUNCTION: Removes entry in user file of user that no longer exist. -C It creates empty space for new user. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - CHARACTER*12 LOGIN_USER - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - CALL OPEN_SYSUAF_SHARED - - LOGIN_USER = USERNAME - READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one - TEMP_USER = USERNAME - USERNAME = LOGIN_USER - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists - END DO - - IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN - ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE(UNIT=4) ! Delete non-existant user - CALL OPEN_BULLINF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - LU = TRIM(TEMP_USER) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & TEMP_USER(:LU)//'.*MARK;*') - TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128) - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1))) - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF - READ (9,KEY=TEMP_USER,IOSTAT=IER) - IF (IER.EQ.0) DELETE(UNIT=9) - CALL CLOSE_BULLINF - END IF - END IF - - CALL CLOSE_SYSUAF ! All done... - - RETURN - END - - - SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C SUBROUTINE TOTAL_CLEANUP_LOGIN -C -C FUNCTION: Removes all entries in user file of usesr that no longer exist -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - CHARACTER TODAY*24 - - DIMENSION TODAY_BTIM(2) - - CALL SYS$ASCTIM(,TODAY,,) ! Get the present time - CALL SYS_BINTIM(TODAY,TODAY_BTIM) - - MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED') - - CALL OPEN_SYSUAF_SHARED - CALL OPEN_BULLUSER - CALL OPEN_BULLINF - - TEMP_USER = USERNAME - - IER = 0 - - DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT - READ (4,IOSTAT=IER) USER_ENTRY - IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND. - & USERNAME(:1).NE.':'.AND. - & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists - DO WHILE (REC_LOCK(IER)) - READ (8,KEY=USERNAME,IOSTAT=IER) - END DO - IF (IER.NE.0) THEN ! If no UAF entry and last login was - ! more than 6 months old, delete entry - IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN - DELETE (UNIT=4) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - LU = TRIM(USERNAME) - IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'// - & USERNAME(:LU)//'.*MARK;*') - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128) - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) DELETE (UNIT=9) - END IF - IER = 0 - ELSE - DO I=0,FOLDER_MAX-1 - IF (TEST2(NOTIFY_FLAG,I)) THEN - CALL SET2(NOTIFY_REMOTE,I) - END IF - END DO - END IF - END IF - END DO - - CALL CLOSE_SYSUAF ! All done... - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER - END DO - - IF (IER.NE.0) THEN - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - - READ (9,KEYGT=' ',IOSTAT=IER) USERNAME - - DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127) - IF (LU.GT.1) THEN - USERNAME(LU-1:LU-1) = - & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - READ (4,KEYEQ=USERNAME,IOSTAT=IER) - IF (IER.NE.0) DELETE (UNIT=9)s - READ (9,IOSTAT=IER) USERNAME - END DOn - - CALL CLOSE_BULLINFl - CALL CLOSE_BULLUSER - - USERNAME = TEMP_USERr - - RETURN - END - - - SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER) -CO -C SUBROUTINE COPY_BULLo -Cs -C FUNCTION: To copy data to the bulletin file.i -Cc -C INPUT:l -C INLUN - Input logical unit numberr -C IBLOCK - Input block number in input file to start atc -C OBLOCK - Output block number in output file to start ats -C -C OUTPUT: -C IER - If error in writing to bulletin, IER will be <> 0. -CI -C NOTES: Input file is accessed using sequential access. This is -C to allow files which have variable records to be read. TheA -C bulletin file is assumed to be opened on logical unit 1. -CI - - IMPLICIT INTEGER (A - Z)i - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LAST_RECORD_WRITTEN/ OCOUNT - - INCLUDE 'BULLDIR.INC' - - IF (REMOTE_SET) THENT - CALL REMOTE_COPY_BULL(IER) - IF (IER.NE.0) CALL ERROR_AND_EXITT - END IFI - - DO I=1,IBLOCK-1 - READ(INLUN,'(A)')T - END DOv - - OCOUNT = OBLOCK - ICOUNT = IBLOCK - - NBLANK = 0s - LENGTH = 0e - DO WHILE (1) - ILEN = 0 - DO WHILE (ILEN.EQ.0) - READ(INLUN,'(Q,A)',END=100) ILEN,INPUT% - ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH)( - IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN - INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded - INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file.A - ILEN = ILEN - 2 - END IFI - IF (ILEN.GT.0) THEN - IF (ICOUNT.EQ.IBLOCK) THENI - IF (INPUT(:6).EQ.'From: ') THEN - INPUT(:4) = 'FROM'm - END IF - END IF) - ICOUNT = ICOUNT + 1 - ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN - NBLANK = NBLANK + 1 - END IFt - END DO - IF (NBLANK.GT.0) THENt - DO I=1,NBLANK - CALL STORE_BULL(1,' ',OCOUNT) - END DOE - LENGTH = LENGTH + NBLANK*2f - NBLANK = 0T - END IF - CALL STORE_BULL(ILEN,INPUT,OCOUNT) - LENGTH = LENGTH + ILEN + 1 - END DOf - -100 LENGTH = (LENGTH+127)/128U - IF (LENGTH.EQ.0) THEN - IER = 1 - ELSEt - IER = 0u - END IFM - - CALL FLUSH_BULL(OCOUNT) - - RETURNm - END - - - - - SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT)E - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'l - - COMMON /STORE_POINT/ POINTe - DATA POINT/-1/8 - - CHARACTER INPUT*(*),OUTPUT*255t - - IF (POINT.EQ.-1) THEN - POINT = 0U - IF (BTEST(FOLDER_FLAG,12)) CALL STORE_BULL1(0,CHAR(0),OCOUNT)N - END IFT - - IF (BTEST(FOLDER_FLAG,12)) THEN - CALL COMPRESS(INPUT(:ILEN),OUTPUT,OLEN)r - CALL STORE_BULL1(OLEN,OUTPUT,OCOUNT) - ELSEE - CALL STORE_BULL1(ILEN,INPUT,OCOUNT)u - END IFM - - RETURNM - END - - - - - SUBROUTINE STORE_BULL1(ILEN,INPUT,OCOUNT) - - IMPLICIT INTEGER (A-Z) - - PARAMETER BRECLEN=128 - - CHARACTER INPUT*(*),OUTPUT*256 - - COMMON /STORE_POINT/ POINTV - - IF (ILEN+POINT+1.GT.BRECLEN) THEN - IF (POINT.EQ.BRECLEN) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)) - OUTPUT = CHAR(ILEN)//INPUTE - POINT = ILEN + 1L - ELSE IF (POINT.EQ.BRECLEN-1) THEN - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)) - OUTPUT = INPUT - POINT = ILEN, - ELSE - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)i - & //INPUT(:BRECLEN-1-POINT)) - OUTPUT = INPUT(BRECLEN-POINT:)S - POINT = ILEN - (BRECLEN-1-POINT)D - END IF - OCOUNT = OCOUNT + 1R - DO WHILE (POINT.GE.BRECLEN)P - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - OCOUNT = OCOUNT + 1 - OUTPUT = OUTPUT(BRECLEN+1:) - POINT = POINT - BRECLEN - END DO - ELSEN - OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN)B - POINT = POINT + ILEN + 1 - END IF - - RETURN - - ENTRY FLUSH_BULL(OCOUNT)N - - IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0) - CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN)) - POINT = -1i - - RETURN - - END - - - SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT) - - IMPLICIT INTEGER (A-Z)S - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) OUTPUTT - - IF (REMOTE_SET) THENY - CALL REMOTE_WRITE_BULL_FILE(OUTPUT) - ELSEY - WRITE (1'OCOUNT) OUTPUT - END IFi - - RETURNY - END - - - SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN)U - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) BUFFERo - - COMMON /HEADER/ HEADER - LOGICAL HEADER /.TRUE./ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINEE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REF/ REFERENCES,LREF. - CHARACTER*256 REFERENCES - - IF (ILEN.GT.LINE_LENGTH) THEN ! First read?e - CALL STRIP_HEADER(BUFFER,0,IER) - STRIP = .NOT.HEADERM - IBLOCK = SBLOCK ! Initialize pointers. - BULL_HEADER = .TRUE. - SEEN_FROM = .FALSE. - SEEN_SUBJ = .FALSE. - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 - MSG_SENT = .FALSE. - FINDREF = .NOT.STRIP.AND.REMOTE_SET.EQ.4 - ELSE ! Else set ILEN to zeroK - ILEN = 0 ! to request next line - END IFS - - IF (MSG_SENT) THEN - BUFFER = ' ' - ILEN = 1 - MSG_SENT = .FALSE. - RETURN - END IF - - DO WHILE (1) - DO WHILE (ILEN.EQ.0) ! Read until line created - CALL GET_BULL(IBLOCK,BUFFER,ILEN) - IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record. - IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records.R - END DO - - IF (STRIP.OR.FINDREF) THEN - IF (BULL_HEADER) THEN - IF (BUFFER(:5).EQ.'From:'.AND..NOT.SEEN_FROM) THEN - SEEN_FROM = .TRUE. - RETURN - ELSE IF (BUFFER(:5).EQ.'Subj:'.AND..NOT.SEEN_SUBJ) THEN - SEEN_SUBJ = .TRUE.o - RETURN - ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN - MSG_SENT = .TRUE._ - RETURN - ELSEL - BULL_HEADER = .FALSE. - IF (REMOTE_SET.EQ.4) FOUNDREF = .FALSE. - END IF - END IF - IF (REMOTE_SET.EQ.4.AND.ILEN.GT.12.AND._ - & (BUFFER(1:11).EQ.'References:'.OR. - & BUFFER(1:11).EQ.'Message-ID:')) THEN - IF (.NOT.FOUNDREF) LREF = 0 - FOUNDREF = .TRUE.E - IF (LREF.EQ.0) THEN - REFERENCES = BUFFER(13:ILEN) - ELSE - REFERENCES = REFERENCES(:LREF)//' '// - & BUFFER(13:ILEN)) - END IF. - LREF = TRIM(REFERENCES) - END IF) - IF (STRIP) THEN - IF (DATE_LINE.NE.' ') DATE_LINE = ' 'E - CALL STRIP_HEADER(BUFFER,ILEN,STRIP) - IF (DATE_LINE.NE.' ') THEN - BUFFER = DATE_LINE - ILEN = TRIM(DATE_LINE) - MSG_SENT = .TRUE.M - RETURN - END IF - IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0E - ELSES - IF (TRIM(BUFFER).EQ.0) THENN - FINDREF = .FALSE. - IF (.NOT.FOUNDREF) LREF = 0 L - END IF - RETURN - END IF/ - ELSE - RETURN - END IF - END DOA - - RETURNR - - ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC)I - - IREC = (SBLOCK+BLENGTH-1) - IBLOCK( - - RETURN - END - - - SUBROUTINE GET_BULL(IBLOCK,BUFFER,OLEN) -C -C SUBROUTINE GET_BULL -CA -C FUNCTION: Outputs line from folder file. -CE -C INPUT:= -C IBLOCK - Input block number in input file to read from.D -C, -C OUTPUT: -C BUFFER - Character string containing output line. -C OLEN - Length of character string. If 0, signifies that -C new record needs to be read, -1 signifies error. -CN -C NOTE: Since message file is stored as a fixed length (128) record file,D -C but message lines are variable, message lines may span one or) -C more record. This routine takes a record and outputs as manyI -C lines as it can from the record. When no more lines can beY -C outputted, it returns OLEN=0 requesting the calling program to -C increment the record counter.' -C - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLDIR.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 - DATA SCRATCH_R1 /0/ - - PARAMETER BRECLEN=128 - - CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(INPUT_LENGTH)C - - DATA POINT /1/, LEFT_LEN /0/, COMP /0/ - - IF (OLEN.GT.LINE_LENGTH) THEN ! First read?F - POINT = 1 ! Initialize pointers., - LEFT_LEN = 0 - DTYPE = 0 - END IFS - - IF (POINT.EQ.1) THEN ! Need to read new line? -10 IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN - DO WHILE (REC_LOCK(IER)) ! Read from file - READ (11'IBLOCK,IOSTAT=IER) TEMP - END DOP - ELSE IF (REMOTE_SET) THEN ! Remote folder?O - IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read linest - CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue - ELSE ! Local folderi - DO WHILE (REC_LOCK(IER)) ! Read from filea - READ (1'IBLOCK,IOSTAT=IER) TEMP - END DOs - END IF - IF (OLEN.GT.LINE_LENGTH.AND.IER.EQ.0 - & .AND.ICHAR(TEMP(:1)).EQ.0) THENn - DTYPE = 1 - POINT = POINT + 1 - END IFR - ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of lineE - OLEN = 0 ! so indicate need to read - POINT = 1 ! new line to calling routine.Y - RETURN - END IFE - - IF (IER.GT.0) THEN ! Error in reading file. - OLEN = -1 ! OLEN = -1 signifies error - POINT = 1K - LEFT_LEN = 0 - RETURN - END IFN - - IF (LEFT_LEN.GT.0) THEN ! Part of line is left from - OLEN = ICHAR(LEFT(:1)) ! previous record read.% - IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record.. - IF (DTYPE.EQ.0) THEN - BUFFER = LEFT(2:OLEN-LEFT_LEN+1)// - & TEMP(:LEFT_LEN) ! Output line. - ELSEC - CALL UNCOMPRESS(LEFT(2:OLEN-LEFT_LEN+1)E - & //TEMP(:LEFT_LEN),BUFFER,OLEN)I - END IF - POINT = LEFT_LEN + 1 ! Update pointers. - LEFT_LEN = 0R - ELSE ! Rest of line is longer than - LEFT(OLEN-LEFT_LEN+2:) = TEMP ! a record, so store record - LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read. - OLEN = 0 ! Request new record read.A - END IF - ELSE ! Else nothing left over. - OLEN = ICHAR(TEMP(POINT:POINT)) ! Get line length - IF (OLEN.GT.BRECLEN-POINT) THEN ! If it extends to next record - LEFT = TEMP(POINT:) ! Store it in leftover buffer - LEFT_LEN = OLEN - (BRECLEN-POINT) ! Store leftover length - OLEN = 0 ! Request new record read - POINT = 1 ! Update record pointer. - ELSE IF (OLEN.EQ.0) THEN ! Empty line signifies - POINT = 1 ! end of message.e - ELSE ! Else message line fully readT - ILEN = OLEN - IF (DTYPE.EQ.0) THENU - BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it - OLEN = OLENI - ELSEE - CALL UNCOMPRESS(TEMP(POINT+1:POINT+ILEN),BUFFER,OLEN) - END IFL - POINT = POINT+ILEN+1 ! and update pointer. - END IF - END IF - - RETURN - - ENTRY TEST_MORE_LINES(OLEN) ! Test for more lines in record.) - ! Returns length of next line.M - IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than - OLEN = 0 ! record, no more lines. - ELSE ! Else there is another line.B - OLEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length.I - END IF - - RETURN - - END - - - - - - SUBROUTINE DELETE_ENTRY(BULL_ENTRY) -CP -C SUBROUTINE DELETE_ENTRY -C -C FUNCTION: -C To delete a directory entry. -C( -C INPUTS: -C BULL_ENTRY - Bulletin entry number to delete -C - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLDIR.INC' - - IF (NBULL.GT.0) THENB - CALL READDIR(0,IER)O - NBULL = -NBULL - CALL WRITEDIR(0,IER) - END IFB - - CALL DUMP_MESSAGE() - - CALL READDIR(BULL_ENTRY,IER) - DELETE(UNIT=2). - - NEMPTY = NEMPTY + LENGTHT - - CALL WRITEDIR(0,IER)( - - RETURN - END - - - SUBROUTINE DUMP_MESSAGE() -C -C SUBROUTINE DUMP_MESSAGE -CI -C FUNCTION: -C To delete a directory entry. -CP - IMPLICIT INTEGER (A-Z)/ - - INCLUDE 'BULLFOLDER.INC'O - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER DUMP_FILE*80L - - IF (BTEST(FOLDER_FLAG,1)) THENE - DUMP_FILE = FOLDER_FILER - IF (REMOTE_SET.EQ.4) THEN - DUMP_FILE = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)T - DO I=1,TRIM(DUMP_FILE)T - IF (DUMP_FILE(I:I).EQ.'.') DUMP_FILE(I:I) = '_' - END DO - DUMP_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// - & DUMP_FILE - END IF - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG',N - & IOSTAT=IER,STATUS='OLD', - & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND') - IF (IER.NE.0) THEN - OPEN(UNIT=3,FILE=DUMP_FILE(:TRIM(DUMP_FILE))//'.LOG', - & IOSTAT=IER1, - & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')C - IF (IER1.NE.0) RETURN - ELSE - WRITE (3,'(A)') CHAR(12)e - END IF - - CALL OPEN_BULLFIL - - ILEN = LINE_LENGTH + 1 - - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)L - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENN - WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - ELSE - WRITE(3,1060) FROM,DATE//' '//TIME(:8)4 - END IF - IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENe - WRITE(3,1050) INPUT(7:ILEN) - ELSE - WRITE(3,1050) DESCRIP - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END IF - - DO WHILE (ILEN.GT.0) - CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) - IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) - END DO - - CLOSE (UNIT=3) ! Bulletin copy completed - - CALL CLOSE_BULLFIL - END IFr - -1050 FORMAT('Description: ',A,/) -1060 FORMAT(/,'From: ',A,' Date: ',A11)R - - RETURNI - END - - - - SUBROUTINE GET_EXDATE(EXDATE,NDAYS) -C -C SUBROUTINE GET_EXDATE -C -C FUNCTION: Computes expiration date giving number of days to expire.N -C - IMPLICIT INTEGER (A-Z)R - - CHARACTER*12 EXDATE - - CHARACTER*3 MONTHS(12)s - DIMENSION LENGTH(12) - DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP',E - & 'OCT','NOV','DEC'/ - DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/ - - CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date - - DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day - DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year - - MONTH = 1 - DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month - MONTH = MONTH + 1 - END DOE - - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSED - LENGTH(2) = 27 - END IFE - - NUM_DAYS = NDAYS ! Put number of days into buffer variableL - - DO WHILE (NUM_DAYS.GT.0) - IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN) - ! If expiration date exceeds end of monthU - NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1) - ! Decrement # of days by days left in month - DAY = 1 ! Reset day to first of monthR - MONTH = MONTH + 1 ! Increment month pointer - IF (MONTH.EQ.13) THEN ! Moved into next year? - MONTH = 1 ! Reset month pointer - YEAR = YEAR + 1 ! Increment year pointer - IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length - LENGTH(2) = 28 ! if we're in a leap year - ELSE - LENGTH(2) = 27E - END IF - END IFC - ELSE ! If expiration date is within the monthN - DAY = DAY + NUM_DAYS ! Find expiration day - NUM_DAYS = 0 ! Force loop exitt - END IF - END DO - - ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date - ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date - EXDATE(4:6) = MONTHS(MONTH) ! Put month into new dateo - - RETURNN - END - - - - SUBROUTINE GET_LINE(INPUT,LEN_INPUT)h -C2 -C SUBROUTINE GET_LINE -Ce -C FUNCTION: -C Gets line of input from terminal.e -C) -C OUTPUTS:c -C LEN_INPUT - Length of input line. If = -1, CTRLC entered. -C if = -2, CTRLZ entered. -C -C NOTES:c -C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER -C for initializing the CTRLC AST.u -Cr - - IMPLICIT INTEGER (A-Z)A - - LOGICAL*1 DESCRIP(8),DTYPE,CLASSM - INTEGER*2 LENGTHI - CHARACTER*(*) INPUT - EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE)T - EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER) - - DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/F - - EXTERNAL SMG$_EOF - - COMMON /DECNET/ DECNET_PROC,ERROR_UNITL - LOGICAL DECNET_PROC - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGI - - CHARACTER PROMPT*(*),NULLPROMPT*1 - LOGICAL*1 USE_PROMPTI - - USE_PROMPT = .FALSE.E - - GO TO 5 - - ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT)I - - USE_PROMPT = .TRUE. - -5 LIMIT = LEN(INPUT) ! Get input line size limit - INPUT = ' ' ! Clean out input buffer - -C -C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and -C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1e -C - - CALL DECLARE_CTRLC_AST( - - LEN_INPUT = 0 ! Nothing inputted yet - -CE -C LIB$GET_INPUT is nice way of getting input from terminal, -C as it handles such thing as accidental wrap around to next line.s -C - - IF (DECNET_PROC) THEN - READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT( - IF (IER.NE.0) LEN_INPUT = -2 - RETURN - ELSE IF (USE_PROMPT) THEN - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,PROMPT) ! Get line from terminal with prompt! - ELSEn - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompti - END IFr - - IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER) - - CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT)l - - IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred - CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST - IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input? - LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of lineT - DO I=0,LEN_INPUT-1 ! Extract from descriptor - CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I)) - END DO) - CALL CONVERT_TABS(INPUT,LEN_INPUT)T - LEN_INPUT = MAX(LEN_INPUT,LENGTH) - ELSE - LEN_INPUT = -2 ! If CTRL-Z, say so - END IF - ELSEL - LEN_INPUT = -1 ! If CTRL-C, say so - END IF - RETURNF - END - - - - SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT) - - IMPLICIT INTEGER (A-Z)t - - CHARACTER*(*) INPUT - - PARAMETER TAB = CHAR(9) - - LIMIT = LEN(INPUT)L - - DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT) - TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs - MOVE = ((TAB_POINT-1)/8)*8 + 9 - ADD = MOVE - TAB_POINT - IF (MOVE-1.LE.LIMIT) THEN( - INPUT(MOVE:) = INPUT(TAB_POINT+1:) - DO I = TAB_POINT,MOVE-1 - INPUT(I:I) = ' ' - END DOr - LEN_INPUT = LEN_INPUT + ADD - 1 - ELSE - DO I = TAB_POINT,LIMIT1 - INPUT(I:I) = ' ' - END DO - LEN_INPUT = LIMIT+1 - END IF - END DO - - CALL FILTER (INPUT, LEN_INPUT) - - RETURNN - END - - - SUBROUTINE FILTER (INCHAR, LENGTH)= - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INCHARP - - DO I = 1,LENGTH - IF ((INCHAR(I:I).LT.' '.AND. - & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10))) - & INCHAR(I:I) = '.' - END DOO - - RETURN - END - - - SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logicalP - CHARACTER*(*) OUTPUT ! byte to character value - LOGICAL*1 INPUT - OUTPUT = CHAR(INPUT) - RETURN - END - - SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routineN - IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here - - COMMON /CTRLY/ CTRLYS - - COMMON /CTRLC_FLAG/ FLAGN - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - IF (FLAG.EQ.2) THEN - CALL LIB$PUT_OUTPUT('Bulletin aborting...')T - CALL SYS$CANEXH()u - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C - CALL EXITR - END IF - FLAG = 1 ! to set flag - RETURN( - END - - - - SUBROUTINE DECLARE_CTRLC_AST -CL -C SUBROUTINE DECLARE_CTRLC_ASTT -CN -C FUNCTION: -C Declares a CTRLC ast. -C NOTES:D -C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/. -CS - IMPLICIT INTEGER (A-Z)I - - EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINEI - COMMON /TERM_CHAN/ TERM_CHANU - - COMMON /CTRLC_FLAG/ FLAGU - - FLAG = 0 ! Init CTRL-C flagI - IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - - ENTRY CANCEL_CTRLC_ASTE - - IER = SYS$CANCEL(%VAL(TERM_CHAN)) - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO - & CTRLC_ROUTINE,,,,,) ! Enable the AST - - RETURN - END - - - - - SUBROUTINE GET_INPUT_NOECHO(DATA) -CE -C SUBROUTINE GET_INPUT_NOECHO -C& -C FUNCTION: Reads data in from terminal without echoing characters. -C Also contains entry to assign terminal. -C - IMPLICIT INTEGER (A-Z)F - - CHARACTER*(*) DATA,PROMPT - - COMMON /TERM_CHAN/ TERM_CHANE - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /CTRLC_FLAG/ FLAGE - - COMMON /READIT/ READIT - - INCLUDE '($TRMDEF)' - - INTEGER TERMSET(2)A - - INTEGER MASK(4) - DATA MASK/4*'FFFFFFFF'X/ - - DATA PURGE/.TRUE./E - - DO I=1,LEN(DATA)L - DATA(I:I) = ' '. - END DOU - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),E - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE.E - ELSE - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA), - & TRM$M_TM_NOECHO) - END IFu - - RETURNe - - ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT) - - DO I=1,LEN(DATA)D - DATA(I:I) = ' 'E - END DOR - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),E - & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE) - PURGE = .FALSE. - ELSE' - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA), - & TRM$M_TM_NOECHO) - END IFL - - RETURNI - - ENTRY GET_INPUT_NUM(DATA,NLEN), - - DO I=1,LEN(DATA)o - DATA(I:I) = ' 'R - END DOR - - IF (PURGE) THEN - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),_ - & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM) - PURGE = .FALSE.o - ELSEt - CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,, - & TERMSET,NLEN,TERM) - END IFD - - IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THENP - ! Input did not end with CR or buffer full - NLEN = 1 - DATA(:1) = CHAR(TERM), - END IF3 - - RETURN3 - - ENTRY ASSIGN_TERMINAL - - IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminalE - - CALL DECLARE_CTRLC_ASTD - - FLAG = 2 ! Indicates that a CTRLC will cause an exit - - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID)A - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IF (CLI$PRESENT('KEYPAD')) THEN - CALL SET_KEYPAD - ELSE IF (READIT.EQ.0) THENN - CALL SET_NOKEYPADu - END IFa - - TERMSET(1) = 16 - TERMSET(2) = %LOC(MASK) - - DO I=ICHAR('0'),ICHAR('9')G - MASK(2) = IBCLR(MASK(2),I-32)p - END DOa - - RETURNe - END - - - - - - SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH) -C) -C SUBROUTINE GETPAGSIZy -Cy -C FUNCTION: -C Gets page size of the terminal.a -Co -C OUTPUTS:t -C PAGE_LENGTH - Page length of the terminal. -C PAGE_WIDTH - Page size of the terminal. -Cn - IMPLICIT INTEGER (A-Z)= - - INCLUDE '($DVIDEF)' - - LOGICAL*1 DEVDEPEND(4)n - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1)))N - CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist - - CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,)t - - PAGE_LENGTH = ZEXT(DEVDEPEND(4))n - - PAGE_WIDTH = MIN(PAGE_WIDTH,132) - - RETURNo - END - - - - - - LOGICAL FUNCTION SLOW_TERMINAL' -CD -C FUNCTION SLOW_TERMINAL -C -C FUNCTION: -C Indicates that terminal has a slow speed (2400 baud or less).) -CM -C OUTPUTS: -C SLOW_TERMINAL = .true. if slow, .false. if not. -CB - - IMPLICIT INTEGER (A-Z)I - - EXTERNAL IO$_SENSEMODEE - - COMMON /TERM_CHAN/ TERM_CHANl - - COMMON CHAR_BUF(2)n - - LOGICAL*1 IOSB(8) - - INCLUDE '($TTDEF)'h - - IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,, - & CHAR_BUF,%VAL(8),,,,) - - IF (IOSB(3).LE.TT$C_BAUD_2400) THEN - SLOW_TERMINAL = .TRUE. - ELSEn - SLOW_TERMINAL = .FALSE.r - END IFI - - RETURN - END - - - - - SUBROUTINE SHOW_PRIV, -CS -C SUBROUTINE SHOW_PRIVC -CA -C FUNCTION: -C To show privileges necessary for managing bulletin board.V -CN - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLUSER.INC'A - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($PRVDEF)' - - INCLUDE '($SSDEF)' - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not presentM - CALL CLOSE_BULLUSER - CALL OPEN_BULLUSER ! Get BULLUSER.DAT filet - CALL READ_USER_FILE_HEADER(IER) - USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - USERPRIV(2) = 0 - REWRITE (4) USER_HEADER - END IF - WRITE (6,'('' Following privileges are needed for privileged - & commands:'')')G - DO I=0,38e - IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR.l - & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN - WRITE (6,'(1X,A)') PRIVS(I) - END IF) - END DO - ELSEN - WRITE (6,'('' ERROR: Cannot show privileges.'')')U - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSERK - - CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER)l - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)))C - END IFR - - RETURN - - END - - - - - SUBROUTINE SET_PRIV -CI -C SUBROUTINE SET_PRIV -C. -C FUNCTION: -C To set privileges necessary for managing bulletin board. -CT - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($PRVDEF)' - - INCLUDE 'BULLUSER.INC'_ - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /PRVDEF/ PRIVS - CHARACTER*8 PRIVS(0:38) - DATA PRIVST - & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH', - & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM', - & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA',L - & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP', - & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE', - & 'GRPPRV','READALL',' ',' ','SECURITY'/N - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - DIMENSION ONPRIV(2),OFFPRIV(2)R - - CHARACTER*32 INPUT_PRIV - - IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEND - WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')') - RETURN - END IF1 - - IF (CLI$PRESENT('ID').OR. - & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THENM - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN)1 - & .NE.%LOC(CLI$_ABSENT)) ! Get the IDsL - IF (CLI$PRESENT('ID')) THEN - CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - ELSE= - CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER) - END IF - IF (.NOT.IER) CALL SYS_GETMSG(IER)_ - END DO - RETURN - END IFB - - OFFPRIV(1) = 0H - OFFPRIV(2) = 0I - ONPRIV(1) = 0 - ONPRIV(2) = 0 - - DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN) - & .NE.%LOC(CLI$_ABSENT)) ! Get the privilegesH - PRIV_FOUND = -1 - I = 0 - DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1)D - IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I - I = I + 1 - END DO - IF (PRIV_FOUND.EQ.-1) THEN - WRITE(6,'('' ERROR: Incorrectly specified privilege = '', - & A)') INPUT_PRIV(:PLEN) - RETURNR - ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN - IF (INPUT_PRIV.EQ.'NOSETPRV') THEN - WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')') - RETURN - ELSE IF (PRIV_FOUND.LT.32) THEN - OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND) - ELSE- - OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)t - END IFT - ELSE - IF (PRIV_FOUND.LT.32) THENS - ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND) - ELSE: - ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32)e - END IFg - END IF - END DOo - - CALL OPEN_BULLUSER ! Get BULLUSER.DAT file - - CALL READ_USER_FILE_HEADER(IER) - - IF (IER.EQ.0) THEN ! If header is present, exit - USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1) - USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2) - USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1))O - USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2)) - REWRITE (4) USER_HEADER - WRITE (6,'('' Privileges successfully modified.'')') - ELSE= - WRITE (6,'('' ERROR: Cannot modify privileges.'')')a - END IF - - CALL CLOSE_BULLUSER ! All finished with BULLUSER( - - RETURN, - - END - - - - SUBROUTINE ADD_ACL(ID,ACCESS,IER) -Cb -C SUBROUTINE ADD_ACL -CD -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.r -C IER - Return error from attempting to set ACL. -C) -C NOTE: The ID must be in the RIGHTS data base. -CM - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLFOLDER.INC'A - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*256,ID*(*),ACCESS*(*),NEWS_ACCESS*132 - - INCLUDE '($ACLDEF)' - - INCLUDE '($SSDEF)' - - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS='I - & //ACCESS//')',ACLENT,,)H - IF (.NOT.IER) THEN_ - IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND. - & INDEX(ACCESS,'C').EQ.0) THEN - CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER) - IF (.NOT.IER) THEN - CALL ERRSNS(IDUMMY,IER) - WRITE (6,'( - & '' ERROR: Specified username cannot be verified.'')')( - CALL SYS_GETMSG(IER) - RETURN - END IF - IDENT = USER + ISHFT(GROUP,16)T - IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,) - IF (IER) THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,)M - END IFI - END IF - END IFT - IF (.NOT.IER) RETURNL - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(R - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)N - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP)3 - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILET - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,) - END IFG - - RETURNT - END - - - - SUBROUTINE DEL_ACL(ID,ACCESS,IER) -CT -C SUBROUTINE DEL_ACLD -C -C FUNCTION: Adds ACL to bulletin files. -C -C PARAMETERS: -C ID - Character string containing identifier to add to ACL. -C ACCESS - Character string containing access controls to give to ID.T -C IER - Return error from attempting to set ACL. -C -C NOTE: The ID must be in the RIGHTS data base. -C - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLFOLDER.INC'W - - INCLUDE 'BULLFILES.INC' - - CHARACTER ACLENT*256,ID*(*),ACCESS*(*),NEWS_ACCESS*132l - - INCLUDE '($ACLDEF)' - - IF (ID.NE.' ') THEN - IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS=' - & //ACCESS//')',ACLENT,,) - IF (.NOT.IER) RETURN - - CALL INIT_ITMLST ! Initialize item listS - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT))E - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistI - ELSE - CALL INIT_ITMLST ! Initialize item lists - CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT))S - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlistT - END IFA - - IF (INDEX(ACCESS,'C').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(W - & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)r - RETURN - END IFd - - IF (INDEX(FOLDER1,'.').GT.0) THEN - IER = SYS$CHANGE_ACL(,ACL$C_FILE,NEWS_ACCESS(FOLDER1_DESCRIP)I - & ,%VAL(ACL_ITMLST),,,) - ELSE - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE - & (:TRIM(FOLDER1_FILE))//'.BULLFIL',%VAL(ACL_ITMLST),,,)( - END IF) - - RETURNO - END - - - - - SUBROUTINE CREATE_FOLDER, -C -C SUBROUTINE CREATE_FOLDER4 -C -C FUNCTION: Creates a new bulletin folder. -CW - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /BULL_CUSTOM/ BULL_CUSTOMI - - IF (CLI$PRESENT('NEWS')) THEN - CALL CREATE_NEWS_FOLDERS - RETURN - END IFV - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('NEEDPRIV').OR. - & BTEST(BULL_CUSTOM,0))) THENC - WRITE(6,'('' ERROR: CREATE is a privileged command.'')') - RETURN - END IFt - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name - - IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 45 characters.'')') - RETURN - END IFH - - IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR. - & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR.E - & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN - WRITE (6,'('' ERROR: Privileged qualifier specified.'')') - RETURN - END IF. - - IF (CLI$PRESENT('NODE')) THEN ! Remote node specified?E - IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name) - FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B)n - FOLDER1_BBOARD = FOLDER_BBOARD - IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1,LEN_P)) THEN - FOLDER1 = FOLDER: - ELSE IF (LEN_P.GT.40) THEN - WRITE (6,'('' ERROR: REMOTENAME cannot be longer '',S - & ''than 40 characters.'')') - END IF - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)E - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not accessible on remote node.'')') - RETURNo - ELSE IF (CLI$PRESENT('SYSTEM').AND.I - & .NOT.BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'',V - & '' is not SYSTEM folder.'')') - RETURN - END IF - END IFC - - LENDES = 0N - DO WHILE (LENDES.EQ.0) - IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified? - IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES)U - ELSE - WRITE (6,'('' Enter one line description of folder.'')')P - CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line - FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces - END IF - IF (LENDES.LE.0) THENI - WRITE (6,'('' Aborting folder creation.'')') - RETURNP - ELSE IF (LENDES.GT.80) THEN ! If too many characters - WRITE(6,'('' ERROR: folder must be < 80 characters.'')')) - LENDES = 0D - END IF - END DOE - - CALL OPEN_BULLFOLDER ! Open folder fileO - READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0)$ - ! See if folder existsP - - IF (IER.EQ.0) THEN - WRITE (6,'('' ERROR: Specified folder already exists.'')') - GO TO 1000 - END IF_ - - IF (CLI$PRESENT('OWNER')) THEN - IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN - WRITE (6,'('' ERROR: /OWNER requires privileges.'')') - CALL CLOSE_BULLFOLDER - RETURNH - ELSE - CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) - IF (LEN_P.GT.12) THEN - WRITE (6,'('' ERROR: Folder owner name must be'',i - & '' no more than 12 characters long.'')') - CALL CLOSE_BULLFOLDER - RETURN - ELSE IF (CLI$PRESENT('ID')) THEN - IER = CHKPRO(FOLDER1_OWNER) - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: ID not valid.'')') - CALL CLOSE_BULLFOLDER - RETURNe - END IF - ELSEP - CALL GET_UAF - & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER)I - IF (.NOT.IER) THEN - WRITE (6,'('' ERROR: Owner not valid username.'')') - CALL CLOSE_BULLFOLDER - RETURNN - END IFV - END IFP - FOLDER_OWNER = FOLDER1_OWNERO - END IF - ELSEF - FOLDER_OWNER = USERNAME ! Get present username - FOLDER1_OWNER = FOLDER_OWNER ! Save for later - END IF( - - FOLDER_SET = .TRUE. - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)N - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)L - -C -C Folder file is placed in the directory FOLDER_DIRECTORY. -C The file prefix is the name of the folder. -Ct - - FD_LEN = TRIM(FOLDER_DIRECTORY) - IF (FD_LEN.EQ.0) THEN - WRITE (6,'('' ERROR: System programmer has disabled folders.'')'). - GO TO 910 - ELSER - FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDERE - END IF - - OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,n - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED'): - - IF (IER.NE.0) THENi - WRITE(6,'('' ERROR: Cannot create folder directory file.'')')f - CALL ERRSNS(IDUMMY,IER)- - CALL SYS_GETMSG(IER) - GO TO 910o - END IFe - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLFIL',STATUS='NEW', - 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,C - 1 FORM='UNFORMATTED',IOSTAT=IER) - - IF (IER.NE.0) THENR - WRITE(6,'('' ERROR: Cannot create folder message file.'')')D - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - GO TO 910/ - END IF= - - FOLDER_FLAG = 0 - - IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THENI - ! Will folder have access limitations? - FOLDER1_FILE = FOLDER_FILE - CLOSE (UNIT=1) - CLOSE (UNIT=2) - IF (CLI$PRESENT('SEMIPRIVATE')) THEN - CALL ADD_ACL('*','R',IER) - ELSE - CALL ADD_ACL('*','NONE',IER)f - END IF - CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER) - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))I - 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1)) - IF (.NOT.IER) THEN - WRITE(6, - & '('' ERROR: Cannot create private folder using ACLs.'')') - CALL SYS_GETMSG(IER)R - GO TO 910 - END IF - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IFa - - IER = 0 - LAST_NUMBER = 1 - DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1) - READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1)E - LAST_NUMBER = LAST_NUMBER + 1) - END DO_ - - IF (IER.EQ.0) THENN - WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')')E - & FOLDER_MAX_ - WRITE (6,'('' Unable to add specified folder.'')') - GO TO 910 - ELSE - FOLDER1_NUMBER = LAST_NUMBER - 1 - END IFF - - IF (.NOT.CLI$PRESENT('NODE')) THEN) - FOLDER_BBOARD = 'NONE' - IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT) - REMOTE_SET = .FALSE. - FOLDER_BBEXPIRE = 14 - F_NBULL = 0N - NBULL = 0 - F_NEWEST_BTIM(1) = 0 - F_NEWEST_BTIM(2) = 0 - F_NEWEST_NOSYS_BTIM(1) = 0 - F_NEWEST_NOSYS_BTIM(2) = 0 - F_EXPIRE_LIMIT = 0 - FOLDER_NUMBER = FOLDER1_NUMBER - ELSEe - CLOSE (UNIT=1,STATUS='DELETE') - CLOSE (UNIT=2,STATUS='DELETE') - IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name?U - REMOTE_SET = .FALSE.U - CALL OPEN_BULLDIR ! If so, store name in directory file3 - BULLDIR_HEADER(13:) = FOLDER1 - CALL WRITEDIR_NOCONV(0,IER) - CALL CLOSE_BULLDIRE - FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*'T - FOLDER1 = FOLDERI - END IF - REMOTE_SET = .TRUE. - IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0)E - FOLDER1_FLAG = FOLDER_FLAG - FOLDER1_DESCRIP = FOLDER_DESCRIP - FOLDER_COM = FOLDER1_COM - NBULL = F_NBULLA - END IFI - - FOLDER_OWNER = FOLDER1_OWNERL - - IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6) - IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7) - IF (CLI$PRESENT('POST_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) - IF (CLI$PRESENT('ADD_ONLY')) FOLDER_FLAG = IBSET(FOLDER_FLAG,11)N - IF (CLI$PRESENT('COMPRESS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,12) - - CALL WRITE_FOLDER_FILE(IER) - CALL MODIFY_SYSTEM_LIST(0)L - - CLOSE (UNIT=1)T - CLOSE (UNIT=2)) - - NOTIFY = 0A - READNEW = 0 - BRIEF = 0 - IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1 - IF (CLI$PRESENT('READNEW')) READNEW = 1 - IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1 - IF (CLI$PRESENT('BRIEF')) THENI - BRIEF = 1I - READNEW = 1L - END IFC - CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) - - WRITE (6,'('' Folder is now set to '',A)') - & FOLDER(:TRIM(FOLDER))//'.' - - GO TO 1000E - -910 WRITE (6,'('' Aborting folder creation.'')') - IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE.E - CLOSE (UNIT=1,STATUS='DELETE')D - CLOSE (UNIT=2,STATUS='DELETE')N - -1000 CALL CLOSE_BULLFOLDER - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection - - RETURN - - END - - - - INTEGER FUNCTION CHKPRO(INPUT) -CI -C Description:E -C Parse given identify into binary ACL format. -C Call SYS$CHKPRO to check if present process has readn -C access to an object if the object's protection is the ACL. -CO - IMPLICIT INTEGER (A-Z)P - - CHARACTER ACL*256 - CHARACTER*(*) INPUT - - INCLUDE '($CHPDEF)' - - CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))//N - & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format - IF (.NOT.CHKPRO) RETURN ! Exit if can'tI - - FLAGS = CHP$M_READ ! Specify read access checking - - CALL INIT_ITMLST ! Initialize item listL - CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1))) - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the - ! rights-id assigned to it - RETURN - END - - - - - SUBROUTINE CREATE_NEWS_FOLDER -C) -C SUBROUTINE CREATE_NEWS_FOLDER -CT -C FUNCTION: Creates a new newsgroup.E -C - - IMPLICIT INTEGER (A-Z)R - - INCLUDE 'BULLFOLDER.INC'r - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /EDIT/ EDIT_DEFAULT( - DATA EDIT_DEFAULT/.FALSE./o - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. - & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)) - - IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER1_NAME,LEN_F) - CALL LOWERCASE(FOLDER1_NAME)O - - LEN_P = 0 - - IF (CLI$PRESENT('FILESPEC')) THEN - IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P) - CALL DISABLE_PRIVS - OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD', - & READONLY,SHARED,ERR=920,FORM='FORMATTED') - CALL ENABLE_PRIVS ! Reset SYSPRV privileges( - END IFn -Co -C If file specified in command, read file.E -C Else, read from the terminal.a -Cc - - IF (EDITIT) THEN ! If /EDIT specified - IF (LEN_P.EQ.0) THEN ! If no file param specified - CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED') - LEN_P = 1 - ELSE - CLOSE (UNIT=3)s - CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR') - OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD', - & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')g - END IF - ELSE IF (LEN_P.EQ.0) THEN ! If file param - OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message - WRITE (6,1000) ! Request input from terminal -1000 FORMAT (' Enter newsgroup description:', - & ' End with ctrl-z, cancel with ctrl-c') - ILEN = 0 - ICOUNT = 0 - DO WHILE (ILEN.GE.0) ! Input until no more input - CALL GET_LINE(INPUT,ILEN) ! Get input line - IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long - WRITE(6,'('' ERROR: Input line length > '',I, - & ''. Reinput:'')') LINE_LENGTHU - ELSE IF (ILEN.GE.0) THEN ! If good input line enteredI - WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file -2010 FORMAT(A) - ICOUNT = ICOUNT + ILEND - END IFD - END DO - IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out - IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out - ENDIF - - REWIND (UNIT=3) - - CALL NEWS_POST('newgroup '//FOLDER1_NAME(:LEN_F),.TRUE.,IER,0 - & 'Adding newsgroup.')o - CLOSE (UNIT=3), - - RETURNW - -920 WRITE(6,1020) -1020 FORMAT (' ERROR: Unable to open specified file.') - CALL ENABLE_PRIVS - RETURN - -910 WRITE(6,1010) -1010 FORMAT (' No news group was added.') - CLOSE (UNIT=3)N - RETURN - - END - - - - - SUBROUTINE INIT_COMPRESSe - - IMPLICIT INTEGER (A-Z)1 - - CHARACTER*2 MAP(159),UNMAP(0:254) - - DATA MAP/ - & ' ', 'e ', 'th', ' t', 's ', ' a', 'in', 't ', 'er', 'he', 'on', - & 'at', ': ', 're', 'an', 'it', 'ti', 'n ', ' i', ' o', 'es', 'ne', - & 'te', 'd ', ' s', 'en', 'ed', 'is', 'ic', 'y ', 'st', 'ar', 'or', - & ', ', ' w', 'al', 'ou', 'ha', 'du', 'le', 'r ', 'nt', '.e', 'nd', - & 'to', 'f ', 've', 'ng', 'ct', ' p', 'o ', 'me', 'om', 'of', '. ', - & ' c', 'io', 'ri', 'ca', 'se', ' m', ' b', 'ta', 'co', 'el', 'si', - & 'as', 'hi', 'de', ' f', 'l ', 'ec', 'll', 'ro', 'et', 'a ', ' d', - & 'ni', ' e', 'ea', 'no', 'li', 'ch', 's.', 'ra', 'ma', 'ce', 'sc', - & 'ns', 'g ', 'ss', 'nc', 'us', 'be', ' h', '> ', 'h ', 'ac', 'os', - & 'ci', 'bl', 'ph', 'rt', ' r', 'ot', ' I', 'tr', 'ut', ' n', 'la', - & 'cs', 'ly', 'pr', 'wa', 'ws', 'oo', 'pe', 'ag', 'ys', 'so', 'ie', - & 'ur', 'un', ' (', 'po', 'fo', 'em', ' l', 'm ', 'ho', 'lo', 'wi', - & ' T', 'e.', 'im', 'di', 'ia', '.c', 'pa', 'ge', 'ga', 'ee', 'rs', - & 'pi', 'su', 'Th', 'il', 'ai', 'wh', 'ol', 'ul', 'gr', 'ow', 'u ', - & 'iv', 'pl', 'ab', 'am', 'mo'/ - - CHARACTER*1 A(0:127,0:127)) - CHARACTER*2 B - - CHARACTER*(*) IN,OUT - CHARACTER*255 T - - DO I=0,127, - DO J=0,127 - A(J,I) = ' ' - END DO - END DOR - - UNMAP(0) = ' ' - DO I=1,254 - UNMAP(I) = CHAR(255)//CHAR(255) - END DOT - S - J = 1 - DO I=1,8 - J = J + 1T - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)I - END DO1 - DO I=10,31N - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)s - END DO - DO I=127,254E - J = J + 1 - B = MAP(J) - UNMAP(I) = B - A(ICHAR(B(:1)),ICHAR(B(2:2))) = CHAR(I)I - END DOL - - RETURN= - - ENTRY COMPRESS(IN,OUT,O)A - - L = LEN(IN) - O = 1 - K = 1 - DO WHILE (K.LT.L) - T(O:O) = A(ICHAR(IN(K:)).AND.127,ICHAR(IN(K+1:)).AND.127)E - IF (T(O:O).NE.' ') THENN - K = K + 2 - O = O + 1 - ELSE IF (L.GT.K+2.AND.IN(K:K).EQ.IN(K+1:K+1).AND.A - & IN(K:K+1).EQ.IN(K+2:K+3)) THEN - C = 4 - K = K + 4 - DO WHILE (K.LE.L.AND.IN(K:K).EQ.IN(K-1:K-1)) - C = C + 1 - K = K + 1 - END DOO - T(O:O+2) = CHAR(255)//CHAR(C)//IN(K-1:K-1)I - O = O + 3 - ELSE IF (IN(K:K+1).EQ.' ') THEN - K = K + 2 - T(O:O) = CHAR(0) - O = O + 1 - ELSE - T(O:O) = IN(K:K) - K = K + 1 - O = O + 1 - END IF - END DO) - IF (K.EQ.L) THENL - T(O:O) = IN(K:K) - ELSE - O = O - 1 - END IF - - OUT = T - - RETURN' - - ENTRY UNCOMPRESS(IN,OUT,O)T - - L = LEN(IN) - O = 0 - I = 1 - DO WHILE (I.LE.L) - J = ICHAR(IN(I:I)) - IF (J.EQ.255) THEN - DO J=1,ICHAR(IN(I+1:I+1)) - O = O + 1n - T(O:O) = IN(I+2:I+2) - END DO3 - I = I + 3 - ELSEN - B = UNMAP(J)C - IF (B.EQ.CHAR(255)//CHAR(255)) THEN - O = O + 1+ - T(O:O) = IN(I:I) - ELSE - O = O + 2 - T(O-1:O) = B - END IF_ - I = I + 1 - END IF - END DOR - - OUT = T(:O) - - RETURNO - END diff --git a/decus/vax92b/bulletin/bulletin5.for b/decus/vax92b/bulletin/bulletin5.for deleted file mode 100644 index 79fc697..0000000 --- a/decus/vax92b/bulletin/bulletin5.for +++ /dev/null @@ -1,2321 +0,0 @@ -C -C BULLETIN5.FOR, Version 1/14/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C -C - SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF) -C -C SUBROUTINE SET_FOLDER_DEFAULT -C -C FUNCTION: Sets flag defaults for specified folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_NEGATED - - IF (REMOTE_SET.GE.3.OR.FOLDER_NUMBER.LT.0) THEN - WRITE (6,'('' ERROR: Command is invalid for this folder.'')') - RETURN - END IF - - ALL = .FALSE. - DEFAULT = 0 - - IF (INCMD(:3).EQ.'SET') THEN - IF (.NOT.SETPRV_PRIV()) THEN - WRITE (6,'( - & '' ERROR: Privileges needed for changing defaults.'')') - RETURN - END IF - ALL = CLI$PRESENT('ALL') - DEFAULT = CLI$PRESENT('DEFAULT') - CALL OPEN_BULLUSER_SHARED - IF (CLI$PRESENT('PERMANENT')) THEN - CALL SET_PERM(NOTIFY,READNEW,BRIEF) - ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN - IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1) - IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0) - END IF - ELSE - CALL OPEN_BULLUSER_SHARED - END IF - - CALL READ_USER_FILE_HEADER(IER) - IF (DEFAULT.EQ.0.OR.DEFAULT) THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER) - REWRITE(4) USER_HEADER - END IF - - IF (ALL.OR.(BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1)) THEN - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - CALL READ_USER_FILE(IER) - END DO - END IF - - CALL CLOSE_BULLUSER - - RETURN - END - - - - - SUBROUTINE READ_PERM - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG) - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - COMMON /FLAG_ACCESS/ FLAG_ACCESS - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG - SET_PERM_FLAG(I) = 0 - BRIEF_PERM_FLAG(I) = 0 - NOTIFY_PERM_FLAG(I) = 0 - END DO - BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder - WRITE (4,IOSTAT=IER) - & '*PERM ', - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - CALL READ_USER_FILE_HEADER(IER) - IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN - CALL SET2(BRIEF_FLAG_DEF,0) - REWRITE(4) USER_HEADER - END IF - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0) - IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN - IF (.NOT.TEST2(SET_FLAG,0)) THEN - CALL SET2(BRIEF_FLAG,0) - REWRITE(4) TEMP_USER//USER_ENTRY(13:) - END IF - END IF - CALL READ_USER_FILE(IER) - END DO - ELSE - UNLOCK 4 - END IF - - RETURN - - ENTRY SET_PERM(NOTIFY,READNEW,BRIEF) - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER) - - REWRITE (4,IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - - RETURN - - ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - - IF (.NOT.FLAG_ACCESS) THEN - WRITE (6,'('' ERROR: Cannot set flags for protected'', - & '' folder without explicit access granted'',/, - & '' via SET ACCESS. See HELP SET ACCESS for further'' - & '' information.'')') - RETURN - END IF - - IF (REMOTE_SET.GE.3) THEN - IF (REMOTE_SET.EQ.3.AND.NOTIFY.EQ.1) THEN - WRITE (6,'('' ERROR: NOTIFY is not valid for this folder.'')') - RETURN - END IF - CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) - RETURN - END IF - - CALL OPEN_BULLUSER_SHARED - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER, - & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - END DO - - CALL CLOSE_BULLUSER - - IER = .TRUE. - IF (NOTIFY.EQ.0) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN - WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') - RETURN - ELSE - CALL CHANGE_FLAG(0,4) - END IF - ELSE IF (NOTIFY.EQ.1) THEN - CALL CHANGE_FLAG(1,4) - RETURN - ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND. - & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - IER = .FALSE. - ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND. - & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR. - & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN - IER = .FALSE. - END IF - - IF (IER) THEN - IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2) - IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3) - ELSE - WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') - WRITE (6,'('' Flags will be set to those permanent settings.'')') - - IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,2) - ELSE - CALL CHANGE_FLAG(0,2) - END IF - - IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN - CALL CHANGE_FLAG(1,3) - ELSE - CALL CHANGE_FLAG(0,3) - END IF - END IF - - RETURN - END - - - - - - SUBROUTINE REMOVE_FOLDER -C -C SUBROUTINE REMOVE_FOLDER -C -C FUNCTION: Removes a bulletin folder. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - EXTERNAL CLI$_ABSENT - - CHARACTER RESPONSE*4,TEMP*80 - - IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name - - IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN - IF (.NOT.FOLDER_SET) THEN - WRITE (6,'('' ERROR: No folder specified.'')') - RETURN - ELSE - FOLDER1 = FOLDER - END IF - ELSE IF (LEN_T.GT.44) THEN - WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')') - RETURN - END IF - - CALL GET_INPUT_PROMPT(RESPONSE,LEN, - & 'Are you sure you want to remove folder ' - & //FOLDER1(:TRIM(FOLDER1))//' (Y/N with N as default): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THEN - WRITE (6,'('' Folder was not removed.'')') - RETURN - END IF - - IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDER - END IF - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if folder exists - CALL SET_FOLDER_FILE(1) - - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder exists.'')') - GO TO 1000 - ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN - CALL REMOTE_REMOVE_FOLDER(IER) - IF (.NOT.IER) GO TO 1000 - END IF - - IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR. - & FOLDER1_NUMBER.EQ.0) THENa - WRITE (6,'('' ERROR: You are not able to remove the folder.'')') - GO TO 1000 - END IFF - - TEMP = FOLDER_FILEE - FOLDER_FILE = FOLDER1_FILED - - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE.f - - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THENC - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1M - OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER, - & RECL=256,FILE=FOLDER1_BBOARD(3:FLEN) - & //'::"TASK=BULLETIN1"')R - IF (IER.EQ.0) THEN ! Deregister remote SYSTEM folder - IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THENT - CALL OPEN_BULLDIRT - CALL READDIR(0,IER)R - IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:) - CALL CLOSE_BULLDIRe - END IFn - WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1 ! Select folderS - IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER) ! Throw away responseR - IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0 ! Deregister - CLOSE (UNIT=17) - END IF - END IFE - - TEMPSET = FOLDER_SET - FOLDER_SET = .TRUE. - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)N - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - ! in case files don't exist and are created. - CALL OPEN_BULLDIR ! Remove directory file - CALL OPEN_BULLFIL ! Remove bulletin file) - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionD - FOLDER_FILE = TEMPE - FOLDER_SET = TEMPSETR - - DELETE (7)D - - TEMP_NUMBER = FOLDER_NUMBER - FOLDER_NUMBER = FOLDER1_NUMBERQ - CALL SET_FOLDER_DEFAULT(0,0,0)E - FOLDER_NUMBER = TEMP_NUMBER - - WRITE (6,'('' Folder removed.'')')R - - IF (FOLDER.EQ.FOLDER1) THEN - FOLDER_SET = .FALSE. - ELSE. - REMOTE_SET = REMOTE_SET_SAVE - END IFN - -1000 CALL CLOSE_BULLFOLDER - - RETURNI - - END - - - SUBROUTINE SELECT_FOLDER(OUTPUT,IER). -CP -C SUBROUTINE SELECT_FOLDER -C -C FUNCTION: Selects the specified folder. -CU -C INPUTS: -C OUTPUT - Specifies whether status messages are outputted. -C -C NOTES:E -C FOLDER_NUMBER is used for selecting the folder. -C If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used. -C If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used, -C but the folder is not selected if it is remote.E -C If the specified folder is on a remote node and does not have -C a local entry (i.e. specified via NODENAME::FOLDERNAME), then -C FOLDER_NUMBER is set to -1.T -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'U - - INCLUDE '($RMSDEF)' - INCLUDE '($SSDEF)'F - - COMMON /POINT/ BULL_POINT - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - DATA REMOTE_SET /.FALSE./ - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUMR - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - COMMON /HEADER/ HEADERM - - COMMON /READIT/ READITa - - COMMON /FLAG_ACCESS/ FLAG_ACCESS4 - - EXTERNAL CLI$_ABSENT,CLI$_NEGATED - - CHARACTER FSTATUS*4,FOLDER1_SAVE*44,NEWS_ACCESS*132 - - CHARACTER*80 LOCAL_FOLDER1_DESCRIP - - DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder hasA - DATA FIRST_TIME /FLONG*0/ ! been selected before this. - - DIMENSION OLD_NEWEST_BTIM(2)W - - DATA LAST_NEWS_GROUP/0/ - - COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR.O - & (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR. - & (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR. - & (INCMD(:3).EQ.'SET') - - IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN - IF (OUTPUT) THEN ! Get folder name - IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME) - FOLDER1 = FOLDER1_NAME - END IF - - FLEN = TRIM(FOLDER1) ! Add GENERAL after :: if no - IF (FLEN.GT.1) THEN ! name specified after the :: - IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THENI - FOLDER1 = FOLDER1(:FLEN)//'GENERAL') - END IFP - END IF - - IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND. - & OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND. - & FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL - FOLDER_NUMBER = 0 - FOLDER1 = 'GENERAL' - END IF - END IFR - - REMOTE_TEST = 0 - REMOTE_SET_NEW = 0D - - IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info6 - FOLDER1_COM = FOLDER_COM - IER = 0' - NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z') - ELSET - NEWS = ((INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND. - & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT))Q - & .OR.(FOLDER_NUMBER.GT.1000.AND..NOT.OUTPUT) - IF (NEWS.AND. - & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED ! Go find folder - READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM - NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE - NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT - IF (IER.NE.0) THENU - WRITE (6,'('' Fetching NEWS groups from remote node.''T - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have''' - & ,'' to be done.'')') - CALL CLOSE_BULLFOLDER - FOLDER1_SAVE = FOLDER1. - CALL NEWS_LISTC - CALL OPEN_BULLFOLDER_SHARED( - FOLDER1 = FOLDER1_SAVE. - ELSE IF (NEWS_F1_COUNT.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND. - & OUTPUT.AND.NEWS_F1_COUNT.GT.LAST_NEWS_GROUP) THEN - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000) THEN - FOLDER1_SAVE = FOLDER1 - FOLDER1_NUMBER = LAST_NEWS_READ(1,FOLDER_MAX) - IER = 2 - DO WHILE (IER.EQ.2). - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMPT - & (FOLDER1_NUMBER,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) IER = 2F - END DOI - FOLDER1 = FOLDER1_SAVE - END IFC - IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.1000A - & .AND.IER.EQ.0) THEN - WRITE (6,'('' Type NEWS/NEWGROUP to see recently'', - & '' added news groups.'')') - ELSEt - LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_COUNT - END IFO - LAST_NEWS_GROUP = NEWS_F1_COUNT - FOLDER1_SAVE = FOLDER1 - CALL STR$UPCASE(FOLDER1,FOLDER1) - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:INDEX(FOLDER1,'.')),IER) - IF (IER.EQ.0) THEN - IF (NEWS_F1_EXPIRE.GT.0) D - & NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRET - IF (NEWS_F1_EXPIRE_LIMIT.NE.0) m - & NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMITU - END IF - FOLDER1 = FOLDER1_SAVE - END IFI - CALL LOWERCASE(FOLDER1) - ELSE - CALL OPEN_BULLFOLDER_SHARED ! Go find folder - END IF - - IF ((OUTPUT.AND.(FOLDER_NUMBER.NE.0.OR.FOLDER1.NE.'GENERAL')) - & .OR.FOLDER_NUMBER.LE.-1) THENB - REMOTE_TEST = INDEX(FOLDER1,'::') - IF (REMOTE_TEST.GT.0) THENf - FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1) - FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1)) - FOLDER1_NUMBER = -1r - IER = 0c - ELSE IF (INCMD(:2).EQ.'SE') THEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1(:TRIM(FOLDER1)),IER)' - ELSEO - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)R - END IF' - ELSE - FOLDER1_NUMBER = FOLDER_NUMBER' - CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER)I - END IF - - IF (REMOTE_TEST.EQ.0.AND.IER.EQ.0) THEN - IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!!I - FOLDER1_FLAG = FOLDER1_FLAG.AND.3e - F1_EXPIRE_LIMIT = 0) - CALL REWRITE_FOLDER_FILE_TEMP(IER1)O - END IFe - END IF - - CALL CLOSE_BULLFOLDER( - - IF (NEWS.AND.BTEST(FOLDER1_FLAG,8).AND.IER.EQ.0) THEN( - REMOTE_SET_NEW = 4T - CALL SYS_BINTIM('-',EX_BTIM)A - END IF - END IF1 - - IF (BTEST(FOLDER1_FLAG,9)) THEN - IF (OUTPUT) THEN - WRITE(6,'('' This news group has been disabled.'')') - END IF - IER = 2 - RETURN - END IFM - - IF ((IER.EQ.0.OR.NEWS).AND.REMOTE_SET_NEW.NE.4.AND. - & FOLDER1_BBOARD(:2).EQ.'::') THEN - IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow( - IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME - LOCAL_FOLDER1_FLAG = FOLDER1_FLAG' - LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIPT - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1) - IF (IER1.NE.0) THEN - IF (OUTPUT) THENI - WRITE (6,'('' ERROR: Unable to select the folder.'')') - IF (.NOT.NEWS) THEN - LENB = TRIM(FOLDER1_BBOARD) - IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1I - WRITE (6,'('' Cannot connect to node '',A,''.'')') - & FOLDER1_BBOARD(3:LENB) - ELSE IF (.NOT.IER1) THENf - WRITE (6,'('' Cannot connect to remote NEWS node.'')')r - END IF - END IFI - RETURNS - END IF - IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::" - FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'//O - & FOLDER1 - FOLDER1_NUMBER = -1 - REMOTE_SET_NEW = 1O - ELSE IF (NEWS) THENi - REMOTE_SET_NEW = 3a - CALL OPEN_BULLNEWS_SHARED ! Update local folder information - IF (IER.NE.0) CALL NEWS_NEW_FOLDERU - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND. - & F1_START.GT.0) THEN - IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM)1 - F_NBULL = F1_NBULL - F_START = F1_START - CALL REWRITE_FOLDER_FILE(IER)o - END IFI - CALL CLOSE_BULLFOLDER - ELSE ! True remote folder - FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP ! Use local description - IF (BTEST(FOLDER1_FLAG,0)) THEN ! If remote folder is protected - LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0)e - END IFe - FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag infoa - CALL OPEN_BULLFOLDER ! Update local folder informatione - CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER) - OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) - OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) - FOLDER_COM = FOLDER1_COMi - FOLDER_NAME = FOLDERd - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLFOLDER - REMOTE_SET_NEW = 1O - DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM)P - IF (DIFF.LT.0) THEN - CALL READ_NOTIFY - IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN - CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM) - END IF - END IFC - END IF - END IFC - - IF (IER.EQ.0) THEN ! Folder foundC - FLAG1_ACCESS = .TRUE. - CALL SET_FOLDER_FILE(1)E - IF (BTEST(FOLDER1_FLAG,0)) THEN ! Folder protected? - IF (NEWS) THEND - CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSEL - CALL CHKACLN - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IFO - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAMEB - & .NE.FOLDER1_OWNER.AND.IER) THEN - IF (NEWS) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER1_DESCRIP),S - & USERNAME,READ_ACCESS,WRITE_ACCESS)S - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,WRITE_ACCESS)! - END IF - IF (SETPRV_PRIV().AND.READIT.EQ.0) THENT - IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE. - READ_ACCESS = 1 - WRITE_ACCESS = 1 - END IF - IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN - IF (OUTPUT.AND.NEWS) THEN - WRITE(6,'('' You are not allowed to access news group.'')')D - ELSE IF (NEWS) THENH - IF (NEWS_FIND_SUBSCRIBE().LE.FOLDER_MAX-1) THEN - CALL NEWS_SET_USER_FLAG(0,0,0) - END IFN - ELSE IF (OUTPUT) THENN - WRITE(6,'('' You are not allowed to access folder.'')')E - WRITE(6,'('' See '',A,'' if you wish to access folder.'')')) - & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) - ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR.E - & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER)U - CALL CLR2(SET_FLAG,FOLDER1_NUMBER)E - IF (IER.EQ.0) REWRITE (4) USER_ENTRY - CALL CLOSE_BULLUSER - END IF - IER = 0_ - RETURN - END IF - ELSE IF (BTEST(FOLDER1_FLAG,0).AND.(.NOT.IER.OR.D - & (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND..NOT.NEWS)) - & .AND.(FOLDER1_BBOARD(:2).NE.'::'.OR.NEWS)) THENE - IF (NEWS) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - CALL OPEN_BULLFOLDERE - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0)L - CALL REWRITE_FOLDER_FILE_TEMP(IER1) - CALL CLOSE_BULLFOLDER - ELSE IF (FOLDER1_BBOARD(:2).EQ.'::') THEN - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - END IF - ELSE ! Folder not protectedP - IER = SS$_ACLEMPTY.OR.SS$_NORMAL ! Indicate folder selected - END IF - - IF (REMOTE_SET_NEW.NE.1.AND.REMOTE_SET.EQ.1) - & CLOSE(UNIT=REMOTE_UNIT) - - REMOTE_SET = REMOTE_SET_NEW - - IF (IER) THENi - FLAG_ACCESS = FLAG1_ACCESS ! Can set flags? - - FOLDER_COM = FOLDER1_COM ! Folder successfully set soS - FOLDER_FILE = FOLDER1_FILE ! update folder parameters - - IF (FOLDER_NUMBER.NE.0) THENO - FOLDER_SET = .TRUE. - ELSEN - FOLDER_SET = .FALSE.. - END IFN - - IF (REMOTE_SET.LT.3) THEN - FOLDER_NAME = FOLDERX - HEADER = .NOT.BTEST(FOLDER_FLAG,4) - ELSE - HEADER = .FALSE. - FOLDER_NAME = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)Q - IF (REMOTE_SET.EQ.4) NEWS_FOLDER_COM = NEWS_FOLDER1_COM - END IFM - - IF (REMOTE_SET.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,10)E - & .AND..NOT.BTEST(FOLDER_FLAG,11)) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<'), - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - IF (NEWS_FEED()) THENe - WRITE (6,'('' Use the POST command to send a '',T - & ''message to this folder''''s news group.'')')P - ELSE IF (SLIST.GT.0) THEN - WRITE (6,'('' Use the POST command to send a '',A - & ''message to this folder''''s mailing list.'')') - END IF - END IFE - END IF& - - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - WRITE (6,'('' Folder has been set to '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.' - END IFN - - IF (OUTPUT) THENO - IF (REMOTE_SET.EQ.3) THEN - BULL_POINT = F_START - 1 - FSTATUS(:1) = - & FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,' ')+1:) - IF (STREQ(FSTATUS(:1),'X')) THEN - WRITE (6,'('' WARNING: The local news server has'', - & '' deactivated this group.'')') - ELSE IF (STREQ(FSTATUS(:1),'=')) THEN - WRITE (6,'('' NOTE: This group is no longer'', - & '' active. It has been replaced by:'')') - WRITE (6,'(1X,A)') FOLDER_DESCRIP( - & INDEX(FOLDER_DESCRIP,'=')+1:) - END IF - ELSE_ - BULL_POINT = 0 ! Reset pointer to first bulletin - END IF - END IF_ - - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAMEE - & .NE.FOLDER_OWNER) THEN - IF (.NOT.WRITE_ACCESS) THENY - IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.SLIST.EQ.0) THENS - WRITE (6,'('' Folder only accessible for reading.'')') - END IFr - READ_ONLY = .TRUE. - ELSER - READ_ONLY = .FALSE. - END IF - ELSEI - READ_ONLY = .FALSE. - END IF_ - - IF (FOLDER_NUMBER.GT.0.AND.REMOTE_SET.LT.3) THENO - IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THENA - ! If first select, look for expired messages. - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get header info from BULLDIR.DAT) - IF (IER.EQ.1) THEN ! Is header present? - IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired? - IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.R - & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)) - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN - ! Do shutdown bulletins exist? - SHUTDOWN = 0 - IER1 = -1 - ELSE - IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENT - CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) - END IF - IER1 = 1 - END IF - IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THENB - CALL UPDATE ! Need to updateI - END IF - ELSE, - NBULL = 0c - END IF' - CALL CLOSE_BULLDIR - CALL SET2(FIRST_TIME,FOLDER_NUMBER) - END IFf - END IFW - - IF (OUTPUT) THEN - IF (CLI$PRESENT('MARKED')) THEN - READ_TAG = 1 + IBSET(0,1)R - BULL_PARAMETER = 'MARKED'E - ELSE IF (CLI$PRESENT('SEEN')) THENh - READ_TAG = 1 + IBSET(0,2)B - BULL_PARAMETER = 'SEEN'' - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THENR - READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) - BULL_PARAMETER = 'UNMARKED'a - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN - READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) - BULL_PARAMETER = 'UNSEEN'. - ELSE - READ_TAG = IBSET(0,1) + IBSET(0,2) - END IF' - IF (READ_TAG) THEN - IF (FOLDER_NUMBER.GE.0) THENA - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)I - ELSE - WRITE (6,'('' ERROR: invalid qualifier'', - & '' with remote folder.'')') - READ_TAG = IBSET(0,1) + IBSET(0,2)L - END IF - END IF - IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THENA - IF (IER.EQ.0) THEN - WRITE(6,'('' NOTE: Only '',A,'' messages'', - & '' will be shown.'')') - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - ELSE - WRITE(6,'('' WARNING: No '',A,) - & '' messages found.'')')T - & BULL_PARAMETER(:TRIM(BULL_PARAMETER)) - END IF - END IF - END IFL - - IF (REMOTE_SET.GE.3.AND.OUTPUT.AND..NOT.READ_TAG) THENC - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN - BULL_POINT = IER - 1 - WRITE(6,'('' Type READ to read new messages.'')') - END IFT - ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND.O - & REMOTE_SET.LT.3) THEN - IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)E - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN ! If new unread messages - CALL FIND_NEWEST_BULL ! See if we can find it, - IF (BULL_POINT.NE.-1) THEN - WRITE(6,'('' Type READ to read new messages.'')') - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 0M - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10 - DIG = DIG + 1E - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - END IF - END IF - END IF - END IFF - IER = 1 - IF (TEST_BULLCP().NE.2) CALL CHECK_CUSTOM - ELSE IF (OUTPUT) THENF - WRITE (6,'('' Cannot access specified folder.'')') - CALL SYS_GETMSG(IER)C - END IF - ELSE ! Folder not found1 - IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')') - IER = 0. - END IF_ - - RETURNN - - END - - - - - - SUBROUTINE UPDATE_FOLDER -CT -C SUBROUTINE UPDATE_FOLDERt -Cc -C FUNCTION: Updates folder info due to new message. -C - - IMPLICIT INTEGER (A-Z)O - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC') - - IF (FOLDER_NUMBER.LT.0) RETURN) - - CALL OPEN_BULLFOLDER_SHARED ! Open folder filet - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)E - - F_NBULL = NBULL - - IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - - IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message?N - F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest - F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time. - END IF_ - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - RETURNU - END - - - - SUBROUTINE SHOW_FOLDER -CU -C SUBROUTINE SHOW_FOLDER -CS -C FUNCTION: Shows the information on any folder. -C - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'D - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG - DIMENSION SET_PERM_FLAG(FLONG)E - DIMENSION BRIEF_PERM_FLAG(FLONG) - DIMENSION NOTIFY_PERM_FLAG(FLONG) - - INCLUDE '($SSDEF)'_ - - INCLUDE '($RMSDEF)' - - EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS - - IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN - WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')') - RETURN - END IFl - - IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT))S - & THEN - FOLDER1 = FOLDER - IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) - END IF - - IF (INDEX(FOLDER1,'::').NE.0) THEN - WRITE (6,'('' ERROR: invalid command for remote folder.'')')y - RETURN - END IFE - - IF (TEST_NEWS(FOLDER1)) THEN s - INCMD = 'SET NEWS 'B - IF (CLI$PRESENT('FULL')) INCMD = 'SET NEWS/FULL ' - IF (CLI$PRESENT('SHOW_FOLDER')) INCMD = 'SET NEWS '//FOLDER1 - CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS). - CALL SHOW_NEWS - RETURN - END IF - - CALL OPEN_BULLFOLDER_SHARED - - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - - IF (IER.NE.0) THEN. - WRITE (6,'('' ERROR: Specified folder was not found.'')') - CALL CLOSE_BULLFOLDERO - RETURN - ELSE IF (FOLDER.EQ.FOLDER1) THENB - WRITE (6,1000) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - ELSE. - WRITE (6,1010) FOLDER1,FOLDER1_OWNER, - & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)) - END IF( - - IF (CLI$PRESENT('FULL')) THEN - CALL SET_FOLDER_FILE(1) - CALL CHKACLh - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THENo - IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote' - & BTEST(FOLDER1_FLAG,0)) THEN ! and private? - WRITE (6,'('' Access is limited.'')')I - END IFN - ELSE - IF (SETPRV_PRIV()) THEN - READ_ACCESS = 1' - WRITE_ACCESS = 1R - ELSEO - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',H - & USERNAME,READ_ACCESS,WRITE_ACCESS)U - END IF& - IF (WRITE_ACCESS) - & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL') - END IF - IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - IF (FOLDER1_BBOARD(:2).EQ.'::') THENT - FLEN = TRIM(FOLDER1_BBOARD) - IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN - WRITE (6,'('' Folder is located on node '',' - & A,''.'')') FOLDER1_BBOARD(3:FLEN) - ELSE - CALL SET_FOLDER_FILE(1)= - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL READDIR(0,IER)M - CALL CLOSE_BULLDIR - CALL SET_FOLDER_FILE(0)N - REMOTE_SET = REMOTE_SET_SAVE - WRITE (6,'('' Folder is located on node '',' - & A,''. Remote folder name is '',A,''.'')') e - & FOLDER1_BBOARD(3:FLEN-1), - & BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER)) - END IFI - ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN - FLEN = TRIM(FOLDER1_BBOARD) - IF (FLEN.GT.0) THEN - WRITE (6,'('' BBOARD for folder is '',A,''.'')') - & FOLDER1_BBOARD(:FLEN)E - END IFE - IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THENt - WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')E - IF (BTEST(GROUPB1,31)) THENo - WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')') - END IF - END IFD - ELSED - WRITE (6,'('' No BBOARD has been defined.'')') - END IFA - IF (FOLDER1_BBEXPIRE.GT.0) THEN - WRITE (6,'('' Default expiration is '',I3,'' days.'')') - & FOLDER1_BBEXPIREo - ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN - WRITE (6,'('' Default expiration is permanent.'')') - ELSEG - WRITE (6,'('' No default expiration set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,2)) THEN - WRITE (6,'('' SYSTEM has been set.'')') - END IFE - IF (BTEST(FOLDER1_FLAG,1)) THEN - WRITE (6,'('' DUMP has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,3)) THEN - WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,4)) THEN - WRITE (6,'('' STRIP has been set.'')')+ - END IF - IF (BTEST(FOLDER1_FLAG,5)) THEN - WRITE (6,'('' DIGEST has been set.'')') - END IF0 - IF (BTEST(FOLDER1_FLAG,7)) THEN - WRITE (6,'('' ALWAYS has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,10)) THENT - WRITE (6,'('' POST_ONLY has been set.'')')B - ELSE IF (BTEST(FOLDER1_FLAG,11)) THEN - WRITE (6,'('' ADD_ONLY has been set.'')') - END IF - IF (BTEST(FOLDER1_FLAG,12)) THEN) - WRITE (6,'('' COMPRESS has been set.'')') - END IFU - IF (F1_EXPIRE_LIMIT.GT.0) THEN - WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')') - & F1_EXPIRE_LIMIT - END IFL - CALL OPEN_BULLUSER_SHARED - CALL READ_USER_FILE_HEADER(IER) - CALL READ_PERM - PERM = .FALSE.R - IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THENr - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.E - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN0 - PERM = .TRUE.' - WRITE (6,'('' Default is BRIEF, which is permanent.'')')o - ELSE - WRITE (6,'('' Default is BRIEF.'')')A - END IF - ELSE - IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND.' - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE.F - WRITE (6,'('' Default is READNEW, which is permanent.'')')3 - ELSE - WRITE (6,'('' Default is READNEW.'')')G - END IF - END IF - ELSE. - IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.) - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - PERM = .TRUE. - WRITE (6,'('' Default is SHOWNEW, which is permanent.'')')E - ELSE - WRITE (6,'('' Default is SHOWNEW.'')')A - END IF - END IF - END IFN - IF (.NOT.PERM) THEN - IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.s - & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' BRIEF is the permanent setting.'')')y - ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' READNEW is the permanent setting.'')') - ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND. - & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is the permanent setting.'')') - END IF - END IFE - IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN - IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN( - WRITE (6,'('' Default is NOTIFY, which is permanent.'')') - ELSE - WRITE (6,'('' Default is NOTIFY.'')') - END IF - ELSE - WRITE (6,'('' Default is NONOTIFY.'')') - END IF - CALL CLOSE_BULLUSER - END IF - END IFO - - CALL CLOSE_BULLFOLDER - - RETURNN - -1000 FORMAT(' Current folder: ',A44,' Owner: ',A12,/,e - & ' Description: ',A)I -1010 FORMAT(' Folder name is: ',A44,' Owner: ',A12,/,E - & ' Description: ',A)L - END - - - SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT)D -C! -C SUBROUTINE DIRECTORY_FOLDERSF -CE -C FUNCTION: Display all FOLDER entries. -CM - IMPLICIT INTEGER (A - Z)I - - INCLUDE '($SSDEF)'F - - INCLUDE 'BULLFOLDER.INC'_ - - INCLUDE 'BULLUSER.INC'I - - INCLUDE 'BULLDIR.INC' - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - LOGICAL PAGINGE - - COMMON /CTRLC_FLAG/ FLAG_ - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - DATA SCRATCH_D1/0/D - - CHARACTER FOLDER_MATCH*80,DATETIME*20,FSTATUS1*4,NEWS_ACCESS*132 - - INTEGER*2 MLEN,FLEN - - OLD_BUFFER = ' ' - - IF (CLI$PRESENT('NEWS')) THEN - IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN - CALL OPEN_BULLNEWS_SHARED - ELSE - WRITE (6,'('' ERROR: NEWS connection is not present.'')') - RETURNR - END IF - ELSEE - CALL OPEN_BULLFOLDER_SHARED ! Get folder file - END IF1 - - IF (FOLDER_COUNT.EQ.0) THEN - SUBSCRIBE = .FALSE.F - ACTIVE = .FALSE. D - STORED = .FALSE. F - CLASS = .FALSE.I - NEW = .FALSE. - FOLDER_COUNT = 1 ! Init folder number counterS - NLINE = 1U - START = .FALSE.T - IF (.NOT.CLI$PRESENT('NEWS')) THEN - NEWS = .FALSE.) - IF (CLI$PRESENT('DESCRIBE')) THEN - NLINE = 2 ! Include folder descriptor if /DESCRIBE - END IF - ELSE - NEWS = .TRUE. - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER) - IF (IER.NE.0) THENF - WRITE (6,'('' Fetching NEWS groups from remote node.'' - & ,'' This will take several minutes.'')') - WRITE (6,'('' This is the only time this will have'' - & ,'' to be done.'')')S - CALL CLOSE_BULLFOLDER - CALL NEWS_LISTT - CALL OPEN_BULLNEWS_SHARED) - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER)O - END IF - COUNT = CLI$PRESENT('COUNT') - IF (COUNT) TOTAL_COUNT = 0M - STORED = CLI$PRESENT('STORED') - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE')D - NEW = CLI$PRESENT('NEWGROUPS')( - CLASS = CLI$PRESENT('CLASS') - IF (CLASS) CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP('A',IER) - IF (NEW) THEN - NEW_NEWS = MAX(LAST_NEWS_READ(1,FOLDER_MAX),1000) - ELSE IF (SUBSCRIBE) THENO - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT) - SUBNUM = 1) - ELSE - ACTIVE = .NOT.CLI$PRESENT('ALL') - END IFS - END IF - IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THENL - IF (NEWS) CALL LOWERCASE(FOLDER1) - CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER)L - IF (IER.NE.0) THEN( - WRITE (6,'('' There are no folders.'')')E - CALL CLOSE_BULLFOLDER. - FOLDER_COUNT = -1 - RETURN - ELSE( - START = .TRUE.E - END IFe - END IF - MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN) - IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH) - IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN - FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*'O - MLEN = MLEN + 2 - END IF - ELSE IF (NEWS.AND.COUNT.AND.TOTAL_COUNT.LT.0) THEN& - WRITE (6,'('' The total count is: '',I)') -TOTAL_COUNT - TOTAL_COUNT = 0F - FOLDER_COUNT = -1 - RETURN - ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN_ - SUBNUM = -2 - ELSEF - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)E - END IF) - -CI -C Folder listing is first buffered into temporary memory storage before -C being outputted to the terminal. This is to be able to quickly close the -C folder file, and to avoid the possibility of the user holding the screen, -C and thus causing the folder file to stay open. The temporary memoryI -C is structured as a linked-list queue, where SCRATCH_D1 points to the header -C of the queue. -CE - CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM) - SCRATCH_D = SCRATCH_D1d - - CALL DECLARE_CTRLC_AST. - - NUM_FOLDER = 0 - IER = 0 - IER1 = 0 - MORE = .FALSE.E - NEWS_TEST = MATCH.OR.ACTIVE.OR.STORED - DO WHILE (IER.EQ.0.AND.IER1.EQ.0) - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THEN - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER) - IF (IER.NE.0) SUBNUM = -1. - END IF. - END DOU - F1_COUNT = MSGNUM - IF (SUBNUM.EQ.0) IER = 1i - ELSE IF (START) THEN - START = .FALSE. - ELSE IF (NEW) THEN - IER = 2 - DO WHILE (IER.EQ.2) - CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER) - IF (IER.EQ.0.AND.BTEST(FOLDER1_FLAG,10)) THEN - IER = 21 - NEW_NEWS = FOLDER1_NUMBER - END IF - END DOs - IF (IER.EQ.0) THENE - NEW_NEWS = FOLDER1_NUMBERI - ELSEN - CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2) - NEW_NEWS = NEWS_F1_COUNT - END IFi - ELSE - CALL READ_FOLDER_FILE_TEMP(IER) - IF (CLASS) CALL LOWERCASE(FOLDER1_DESCRIP)n - IF (CLASS) NEWS_TEST = .FALSE.B - IF (CLASS.AND.FOLDER1.EQ.'a') IER = 2 - END IF - IF (IER.EQ.0) THEN - IF ((INDEX(FOLDER1_BBOARD,'::').EQ.0.OR.NEWS).AND.' - & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN - CALL SET_FOLDER_FILE(1) - IF (NEWS) THEN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN, - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2) - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CALL CHECK_ACCESS(OLD_BUFFER(:TRIM(OLD_BUFFER)), - & USERNAME,READ_ACCESS,-1)G - ELSEA - READ_ACCESS = 1 - END IF2 - END IF, - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSEE - READ_ACCESS = 1 - END IFH - IF (READ_ACCESS) THEN - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - ELSEE - FSTATUS1 = ' 'M - END IF - IF (.NOT.NEWS_TEST) THENF - IF (NEWS.AND.CLASS) - & FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-2) - NUM_FOLDER = NUM_FOLDER + 1 - CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM) - ELSE IF ((.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND..NOT. - & BTEST(FOLDER1_FLAG,9))).AND. - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - GO TO 100 - END IF - END IF - IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THENI - IER1 = 1F - MORE = .TRUE. - END IF - END IF - IF (FLAG.EQ.1) IER1 = 1E - END DO) - - IF (NEWS_TEST) NEWS_TEST = .FALSE. - - CALL CANCEL_CTRLC_AST - CALL CLOSE_BULLFOLDER ! We don't need file anymore' - - IF (FLAG.EQ.1) THENA - WRITE (6,'('' Folder search aborted.'')') - FOLDER_COUNT = -1 - RETURN - END IFI - - IF (NUM_FOLDER.EQ.0) THEN - WRITE (6,'('' There are no folders.'')') - FOLDER_COUNT = -1I - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - RETURN - END IFE - -CM -C Folder entries are now in queue. Output queue entries to screen. -C1 - - SCRATCH_D = SCRATCH_D1 ! Init queue pointer to headern - -100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen - - IF (.NOT.NEWS) THEN - WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'', - & 2X,''Owner'',/,1X,80(''-''))') - ELSE IF (COUNT) THEN - WRITE (6,'(1X,''Folder'',X,6X, - & ''First Last Count'',N - & /,1X,(''-''))')( - ELSE IF (CLASS) THENu - WRITE (6,'(1X,''Class'',/,1X,(''-''))')( - ELSED - WRITE (6,'(1X,''Folder'',X,''Status'',7X,D - & ''First Last'',/,1X,(''-''))')_ - END IF - - IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1T - - I = 1 - DO WHILE ((I.LE.NUM_FOLDER.OR.NEWS_TEST).AND.FLAG.NE.1) - IF (.NOT.NEWS_TEST) THEN - CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM)e - I = I + 1 - END IF - IF (.NOT.NEWS) THENR - DIFF = COMPARE_BTIM - & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM) - IF (F1_NBULL.GT.0) THEN - CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,) - ELSE - DATETIME = ' NONE'E - END IF - IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THENG - WRITE (6,1000) ' '//FOLDER1,DATETIME(:17),F1_NBULL,S - & FOLDER1_OWNER - ELSEE - WRITE (6,1000) '*'//FOLDER1,DATETIME(:17),F1_NBULL,A - & FOLDER1_OWNER - END IF3 - ELSE - FLEN = MIN(80,PAGE_WIDTH-80+49) - IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+48)U - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEND - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:) - IF (FSTATUS1(:1).NE.'=') THEN - FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1)E - END IFD - ELSEF - FSTATUS1 = ' ' - END IFF - IF (BTEST(FOLDER1_FLAG,9)) FSTATUS1 = 'n' - IF (COUNT) THEN - TOTAL_COUNT = TOTAL_COUNT + F1_COUNT= - IF (F1_START.LE.F1_NBULL) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN), - & F1_START,F1_NBULL,F1_COUNT - ELSE - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN),0,0,0 - END IFd - ELSE IF (CLASS) THEN - WRITE (6,1010) FOLDER1_DESCRIP(:FLEN) - ELSE IF (F1_START.LE.F1_NBULL) THEN - IF (SUBSCRIBE) THEN - IF (F1_COUNT.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN - WRITE (6,1005) '*'//FOLDER1_DESCRIP(:FLEN-1),I - & FSTATUS1(:1),F1_START,F1_NBULLh - ELSE - WRITE (6,1005) ' '//FOLDER1_DESCRIP(:FLEN-1), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSEA - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN), - & FSTATUS1(:1),F1_START,F1_NBULL - END IF - ELSE IF (SUBSCRIBE) THEN - WRITE (6,1005) ' '//FOLDER1_DESCRIP(:FLEN-1),C - & FSTATUS1(:1),0,0 - ELSEP - WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),FSTATUS1(:1),0,0 - END IFS - END IF - IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP - LAST_DISPLAY = FOLDER1_NUMBERD - IF (NEWS_TEST.AND.FLAG.NE.1) THENU - NUM_FOLDER = NUM_FOLDER + 1 - IF (PAGING.AND. - & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE. - FOUND = .FALSE. - DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND)T - CALL READ_FOLDER_FILE_TEMP(IER)R - J = INDEX(FOLDER1_DESCRIP,' ') - IF (J.GT.0) THEN - FSTATUS1(:1) = FOLDER1_DESCRIP(J+1:)a - ELSEd - FSTATUS1 = ' 'O - END IF - IF (IER.EQ.0.AND.(.NOT.ACTIVE.OR.(FSTATUS1(:1).NE.'x'.AND.E - & .NOT.BTEST(FOLDER1_FLAG,9))).AND.E - & (.NOT.STORED.OR.BTEST(FOLDER1_FLAG,8)).AND. - & (.NOT.MATCH.OR.STR$MATCH_WILD(FOLDER1_DESCRIP - & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN)))) THEN - IF (BTEST(FOLDER1_FLAG,0)) THENN - IF (OLD_BUFFER.NE.NEWS_ACCESS(FOLDER1_DESCRIP)) THEN - OLD_BUFFER = NEWS_ACCESS(FOLDER1_DESCRIP) - CALL CHKACL(OLD_BUFFER(:TRIM(OLD_BUFFER)),IER2)R - IF (IER2.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENA - CALL CHECK_ACCESS(OLD_BUFFER - & (:TRIM(OLD_BUFFER)),USERNAME,FOUND1,-1)m - ELSE - FOUND1 = .TRUE. - END IFl - END IFi - FOUND = FOUND1 - ELSE - FOUND = .TRUE.r - END IFT - END IFy - END DO - MORE = MORE.AND.FOUND - IF (MORE) THENo - CALL READ_FOLDER_FILE_KEYNUM_TEMP(LAST_DISPLAY,IER) - END IF - FOUND = FOUND.AND..NOT.MORE - IF (.NOT.FOUND) FLAG = 1L - END IF - END DOI - - IF (NEWS_TEST) THEN - CALL CANCEL_CTRLC_ASTC - CALL CLOSE_BULLFOLDERI - END IFN - - IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries? - IF (NEWS.AND.COUNT) THEN - TOTAL_COUNT = -TOTAL_COUNTS - ELSE - FOLDER_COUNT = -1 ! Yes. Set counter to -1. - END IF - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS - ELSE- - WRITE(6,1100) ! Else say there are more - IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = FOLDER1_NUMBER - END IF - - RETURNT - -1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12)I -1005 FORMAT(1X,A,X,2X,A1,4X,I10,' ',I10)N -1010 FORMAT(1X,A,X,I10,2X,I10,1X,I6) -1100 FORMAT(1X,/,' Press RETURN for more...',/) - - END - - - SUBROUTINE SET_ACCESS(ACCESS) -Cs -C SUBROUTINE SET_ACCESS -C -C FUNCTION: Set access on folder for specified ID. -C -C PARAMETERS: -C ACCESS - Logical: If .true., grant access, if .false. deny access -C - - IMPLICIT INTEGER (A-Z)C - - INCLUDE 'BULLFOLDER.INC') - - INCLUDE 'BULLUSER.INC'W - - INCLUDE '($SSDEF)'n - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - LOGICAL ACCESS,ALL,READONLY - - EXTERNAL CLI$_ABSENTI - - CHARACTER ID*64,RESPONSE*4,NEW_NEWS_ACCESS*132 - - CHARACTER INPUT*132 - - IF (CLI$PRESENT('ALL')) THENH - ALL = .TRUE. - ELSEL - ALL = .FALSE.( - END IFN - - IF (CLI$PRESENT('READONLY')) THEN - READONLY = .TRUE.) - ELSE - READONLY = .FALSE. - END IF_ - - IF (ALL) THEN - IER = CLI$GET_VALUE('ACCESS_ID',FOLDER1,LEN) ! Get folder name - ELSE - IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name - END IFC - - IF (IER.EQ.%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER - NEWS = INDEX(FOLDER1,'.').GT.0 - - IF (NEWS) THEN - IF (.NOT.CLI$PRESENT('CLASS')) THENC - CALL LOWERCASE(FOLDER1) - ELSE IF (FOLDER1(TRIM(FOLDER1):TRIM(FOLDER1)).NE.'.') THEN - FOLDER1 = FOLDER1(:TRIM(FOLDER1))//'.'M - END IF - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER ! Open folder file - END IFE - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THENF - WRITE (6,'('' ERROR: No such folder exists.'')') - ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN - WRITE (6,D - & '('' ERROR: You are not able to modify access to the folder.'')') - ELSE IF (CLI$PRESENT('CLASS').AND..NOT.BTEST(FOLDER1_FLAG,0)) THENH - WRITE (6,'('' ERROR: Must use SET NEWS/CLASS/PRIVATE.'')') - ELSEE - CALL SET_FOLDER_FILE(1)T - IF (NEWS) THEN - CALL CHKACL(NEW_NEWS_ACCESS(FOLDER1_DESCRIP),IER) - ELSE - CALL CHKACL - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) - END IF - IF (NEWS.AND.IER.EQ.RMS$_FNF) THEN - CALL SET_PROTECTION - OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),N - & STATUS='NEW',IOSTAT=IER)I - CLOSE (UNIT=3) - CALL RESET_PROTECTION - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Access file cannot be created.'')')A - RETURNC - END IF - CALL ADD_ACL('*','NONE',IER) - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')'). - CALL SYS_GETMSG(IER) - RETURN - END IF - ELSE IF (IER.EQ.RMS$_FNF) THEN - FOLDER_FILE = FOLDER1_FILE - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL - REMOTE_SET = REMOTE_SET_SAVE - IER = SS$_ACLEMPTY.OR.SS$_NORMAL - CALL SET_FOLDER_FILE(0) - END IF - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN) - IF (.NOT.NEWS.AND. - & ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS))) THEN - WRITE (6,'('' ERROR: Folder is not a private folder.'')') - RETURN - END IF - CALL GET_INPUT_PROMPT(RESPONSE,LEN,'Access is presently' - & //' unlimited. Do you want to change this? (Y/N): ') - IF (RESPONSE(:1).NE.'y'.AND.RESPONSE(:1).NE.'Y') THENX - WRITE (6,'('' Access was not changed.'')') - RETURN - ELSE - FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0) - IF (READONLY.AND.ALL) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.ALL) THEN - CALL ADD_ACL('*','NONE',IER). - END IF - IF (.NOT.NEWS) CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) - IF (ALL) THEN ! All finished, so exit - WRITE (6,'('' Access to folder has been modified.'')') - GOTO 100 - END IF - END IF - END IF - - IF (ALL) THEN_ - IF (ACCESS) THEN - CALL DEL_ACL(' ','R+W',IER) - IF (READONLY) THEN - CALL ADD_ACL('*','R',IER) - ELSE IF (.NOT.NEWS) THEN - FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0) - IF (.NOT.NEWS.AND.REMOTE_SET) THEN& - CALL SET_FOLDER_FILE(1) - FOLDER_FILE = FOLDER1_FILER - REMOTE_SET_SAVE = REMOTE_SET - REMOTE_SET = .FALSE. - CALL OPEN_BULLDIR - CALL OPEN_BULLFIL - CALL CLOSE_BULLFIL_DELETE - CALL CLOSE_BULLDIR_DELETE - REMOTE_SET = REMOTE_SET_SAVEE - CALL SET_FOLDER_FILE(0) - END IF - END IFF - ELSEE - CALL DEL_ACL('*','R',IER) - END IFI - IF (.NOT.IER) THEN - WRITE(6,'('' Cannot modify access.'')') - CALL SYS_GETMSG(IER) - END IF - END IF - - DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN)N - & .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL) - IER = SYS_TRNLNM(INPUT,INPUT) - IF (INPUT(:1).EQ.'@') THENP - ILEN = INDEX(INPUT,',') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT) - OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN), - & DEFAULTFILE='.DIS',IOSTAT=IER)N - IF (IER.NE.0) THENE - WRITE (6,'('' ERROR: Cannot find file '',A)')S - & INPUT(2:ILEN) - RETURN - END IF - READ (3,'(A)',IOSTAT=IER) INPUT - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' 'I - ELSE) - FILE_OPEN = .TRUE. - END IFF - ELSE - FILE_OPEN = .FALSE. - END IF' - DO WHILE (TRIM(INPUT).GT.0) - COMMA = INDEX(INPUT,',') - IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 11 - IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2L - IF (COMMA.GT.0) THEN - ID = INPUT(1:COMMA-1)T - INPUT = INPUT(COMMA+1:)( - ELSE - ID = INPUT - INPUT = ' 'P - END IF - ILEN = TRIM(ID)T - IF (.NOT.NEWS.AND.ID.EQ.FOLDER1_OWNER) THENN - WRITE (6,'('' ERROR: Cannot modify access'',Y - & '' for owner of folder.'')') - ELSEE - IF (ACCESS) THEN - IF (READONLY) THEN - CALL ADD_ACL(ID,'R',IER)T - ELSEU - CALL ADD_ACL(ID,'R+W',IER)A - END IF. - ELSE - CALL DEL_ACL(ID,'R+W',IER) - IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER) - END IF - IF (.NOT.IER) THENI - WRITE(6,'('' Cannot modify access for '',A, - & ''.'')') ID(:ILEN)N - CALL SYS_GETMSG(IER). - ELSE - WRITE(6,'('' Access modified for '',A,''.'')') - & ID(:ILEN)T - END IF - END IFF - IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN - READ (3,'(A)',IOSTAT=IER) INPUTM - IF (IER.NE.0) THEN - CLOSE (UNIT=3) - INPUT = ' ' - FILE_OPEN = .FALSE. - END IF - END IFC - END DOC - END DO - -100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THENI - IF (NEWS) THENK - CALL OPEN_BULLNEWS - ELSE - CALL OPEN_BULLFOLDER - END IFO - OLD_FOLDER1_FLAG = FOLDER1_FLAG - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - FOLDER1_FLAG = OLD_FOLDER1_FLAG - CALL REWRITE_FOLDER_FILE_TEMP(IER) - CALL CLOSE_BULLFOLDER - END IF - END IFI - - RETURN - - END - - - - SUBROUTINE CHKACL(FILENAME,IERACL)N -C -C SUBROUTINE CHKACL -CD -C FUNCTION: Checks ACL of given file. -Cy -C PARAMETERS: -C FILENAME - Name of file to check. -C IERACL - Error returned for attempt to open file.L -C_ - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) FILENAMED - - INCLUDE '($ACLDEF)' - INCLUDE '($SSDEF)' - - CHARACTER*256 ACLENT,ACLSTR - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(256,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IERACL=SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) - - IF (IERACL.EQ.SS$_ACLEMPTY) THENe - IERACL = SS$_NORMAL.OR.IERACLF - END IFS - - RETURN( - END - - - - SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS) -C -C SUBROUTINE CHECK_ACCESS -CR -C FUNCTION: Checks ACL of given file. -CT -C PARAMETERS: -C FILENAME - Name of file to check.R -C USERNAME - Name of user to check access for. -C READ_ACCESS - Error returned indicating read access. -C WRITE_ACCESS - Error returned indicating write access. -C If initially set to -1, indicates just -C folder for read access.C -CS - - IMPLICIT INTEGER (A-Z)s - - CHARACTER FILENAME*(*),USERNAME*(*),ACE*256,OUTPUT*80 - - INCLUDE '($ACLDEF)' - INCLUDE '($CHPDEF)' - INCLUDE '($ARMDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS)) - CALL ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - FLAGS = 0 ! Default is no access - - ACCESS = ARM$M_READ ! Check if user has read access - READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME,I - & %VAL(ACL_ITMLST))D - - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THEN, - READ_ACCESS = 0e - END IFC - - IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access - RETURN - ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of' - WRITE_ACCESS = 0 ! course there is no write access. - RETURN - END IFR - - ACCESS = ARM$M_WRITE ! Check if user has write access - WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME, - & %VAL(ACL_ITMLST))R - - IF (ICHAR(ACE(:1)).NE.0) THEN - CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,) - IF (INDEX(OUTPUT,'=*').NE.0.AND. - & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0 - ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN - WRITE_ACCESS = 0 - END IFF - - RETURNS - END - - - - - SUBROUTINE SHOWACL(FILENAME) -C -C SUBROUTINE SHOWACL -CO -C FUNCTION: Shows users who are allowed to read private bulletin. -C$ -C PARAMETERS: -C FILENAME - Name of file to check.H -C - IMPLICIT INTEGER (A-Z)s - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) FILENAMEL - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)R - - CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH)D - - CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH) - - RETURNS - END - - - - SUBROUTINE FOLDER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) KEY_NAMEe - - INCLUDE 'BULLFOLDER.INC'' - - COMMON /NEWS_OPEN/ NEWS_OPENF - - ENTRY WRITE_FOLDER_FILE(IER)E - - IF (NEWS_OPEN) CALL FOLDER_TO_NEWS, - - DO WHILE (REC_LOCK(IER))' - IF (NEWS_OPEN) THEN) - WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM. - ELSE - WRITE (7,IOSTAT=IER) FOLDER_COM - END IF - END DO - - RETURNT - - ENTRY WRITE_FOLDER_FILE_TEMP(IER)_ - - IF (NEWS_OPEN) CALL FOLDER1_TO_NEWSE - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THEN - WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMQ - ELSE. - WRITE (7,IOSTAT=IER) FOLDER1_COM - END IFO - END DO - - RETURN - - ENTRY REWRITE_FOLDER_FILE(IER)o - - IF (NEWS_OPEN) THEN - CALL FOLDER_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE' - REWRITE (7,IOSTAT=IER) FOLDER_COMi - END IFo - - RETURNh - - ENTRY REWRITE_FOLDER_FILE_TEMP(IER) : - - IF (NEWS_OPEN) THEN - CALL FOLDER1_TO_NEWS - REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM - ELSEE - REWRITE (7,IOSTAT=IER) FOLDER1_COM - END IFL - - RETURN) - - ENTRY READ_FOLDER_FILE(IER) - - DO WHILE (REC_LOCK(IER))( - IF (NEWS_OPEN) THENE - READ (7,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,IOSTAT=IER) FOLDER_COMN - END IF - END DO( - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNe - - ENTRY READ_FOLDER_FILE_TEMP(IER)c - - DO WHILE (REC_LOCK(IER))e - IF (NEWS_OPEN) THEN - READ (7,IOSTAT=IER) NEWS_FOLDER1_COMF - ELSE - READ (7,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1C - - RETURNE - - ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER) - - SAVE_FOLDER_NUMBER = FOLDER_NUMBER - - DO WHILE (REC_LOCK(IER))E - IF (NEWS_OPEN) THENE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COMM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - FOLDER_NUMBER = SAVE_FOLDER_NUMBERE - - RETURNR - - ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER)R - - DO WHILE (REC_LOCK(IER))D - IF (NEWS_OPEN) THENL - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)S - - DO WHILE (REC_LOCK(IER))I - IF (NEWS_OPEN) THENP - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COMI - END IF - END DON - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1C - - RETURNf - - ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER) - - DO WHILE (REC_LOCK(IER))A - IF (NEWS_OPEN) THENN - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM - END IF - END DOH - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1, - - RETURN - - ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))I - IF (NEWS_OPEN) THEN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COMU - END IF - END DON - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1N - - RETURNE - - ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER)) - IF (NEWS_OPEN) THENr - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DO - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURNE - - ENTRY READ_FOLDER_FILE_KEYNAMEGT_TEMP(KEY_NAME,IER) - - DO WHILE (REC_LOCK(IER))D - IF (NEWS_OPEN) THEN - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM - ELSE - READ (7,KEYGT=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM - END IF - END DOR - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1 - - RETURN. - - ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER)D - - DO WHILE (REC_LOCK(IER))T - IF (NEWS_OPEN) THENN - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COMN - ELSE - READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM - END IF - END DOF - - IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER - - RETURNF - - END - - - SUBROUTINE USER_FILE_ROUTINES - - IMPLICIT INTEGER (A-Z)A - - INCLUDE '($PRVDEF)' - - INCLUDE '($FORIOSDEF)'_ - - CHARACTER*(*) KEY_NAME - - INCLUDE 'BULLUSER.INC'O - - CHARACTER*12 SAVE_USERNAMEL - - ENTRY READ_USER_FILE(IER) - - SAVE_USERNAME = USERNAMEL - - DO WHILE (REC_LOCK(IER))E - READ (4,IOSTAT=IER) USER_ENTRY - END DOS - - TEMP_USER = USERNAME - USERNAME = SAVE_USERNAMED - - RETURNB - - ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER)T - - SAVE_USERNAME = USERNAMEC - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRYk - END DOA - - USERNAME = SAVE_USERNAMEe - TEMP_USER = KEY_NAME - - RETURN - - ENTRY READ_USER_FILE_HEADER(IER)N - - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=' ',IOSTAT=IER) USER_HEADER - IF (IER.EQ.FOR$IOS_ATTACCNON) THEN - WRITE (4,FMT=USER_FMT,IOSTAT=IER) - & USER_HEADER_KEY,NEWEST_BTIM,) - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - IER = FOR$IOS_SPERECLOC - END IF - END DOI - - RETURND - - ENTRY WRITE_USER_FILE_NEW(IER)O - - DO I=1,FLONGS - SET_FLAG(I) = SET_FLAG_DEF(I)E - BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)S - NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I)l - END DO - - ENTRY WRITE_USER_FILE(IER) - - DO WHILE (REC_LOCK(IER))E - WRITE (4,IOSTAT=IER) USER_ENTRY - END DOC - - RETURN - - END - - - - CHARACTER*(*) FUNCTION NEW_NEWS_ACCESS(IFILE) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - S - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_'E - END DO2 - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1)n - - NEW_NEWS_ACCESS = L - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS'C - - RETURNT - END - - - - - CHARACTER*(*) FUNCTION NEWS_ACCESS(IFILE) - L - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - CHARACTER IFILE*(*),FILE*80 - - FILE = IFILE - h - DO I=1,TRIM(FILE) - IF (FILE(I:I).EQ.'.') FILE(I:I) = '_'M - END DOE - - FILE = FILE(:INDEX(FILE,' ')-1) - IF (FILE(TRIM(FILE):TRIM(FILE)).EQ.'_') FILE = FILE(:TRIM(FILE)-1), - - C = 0 - - DO WHILE (TRIM(FILE).GT.0.AND..NOT.LIB$FIND_FILE( - & NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//FILE(:TRIM(FILE)) - & //'.ACCESS',NEWS_ACCESS,C))E - L = LAST_INDEX(FILE,'_')-1 - IF (L.LE.0) THEN - FILE = ' 'U - ELSE - FILE = FILE(:L) - END IF - END DOs - - RETURN - END - - - - - INTEGER FUNCTION LAST_INDEX(INPUT,FIND) - - IMPLICIT INTEGER (A-Z)A - - CHARACTER*(*) INPUT,FINDf - - F = LEN(FIND)W - - DO LAST_INDEX=LEN(INPUT)-F+1,F,-1 - IF (INPUT(LAST_INDEX:LAST_INDEX+F-1).EQ.FIND) RETURNE - END DO0 - - RETURN - END diff --git a/decus/vax92b/bulletin/bulletin6.for b/decus/vax92b/bulletin/bulletin6.for deleted file mode 100644 index d21e023..0000000 --- a/decus/vax92b/bulletin/bulletin6.for +++ /dev/null @@ -1,2482 +0,0 @@ -C -C BULLETIN6.FOR, Version 11/27/92 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE CLOSE_FILE -C -C SUBROUTINE CLOSE_FILE -C -C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y -C - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - DATA BULLFIL /0/ - - DATA LUN /0/ - - ENTRY CLOSE_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY CLOSE_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY CLOSE_BULLNEWS - ENTRY CLOSE_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY CLOSE_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY CLOSE_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN) - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE CLOSE_FILE_DELETE - - IMPLICIT INTEGER (A-Z) - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - ENTRY CLOSE_BULLDIR_DELETE - LUN = LUN + 1 ! Unit = 2 - - ENTRY CLOSE_BULLFIL_DELETE - LUN = LUN + 1 ! Unit = 1 - - CALL ENABLE_CTRL - - CLOSE (UNIT=LUN,STATUS='DELETE') - - IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL - - LUN = 0 - - RETURN - END - - - SUBROUTINE OPEN_FILE(UNIT) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE '($FORIOSDEF)' - - INCLUDE '($PRVDEF)' - - INCLUDE '($RMSDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - DATA LUN /0/ - - LUN = UNIT - 14 ! 14 gets added to LUN - - ENTRY OPEN_BULLNEWS - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF - LUN = LUN + 1 ! Unit = 9 - - ENTRY OPEN_SYSUAF - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER - LUN = LUN + 2 ! Unit = 4 - - ENTRY OPEN_BULLDIR - LUN = LUN + 1 ! Unit = 2 - - ENTRY OPEN_BULLFIL - LUN = LUN + 1 ! Unit = 1 - - IER = 0 - - NTRIES = 0 - - CALL SET_PROTECTION - - CALL DISABLE_CTRL ! No breaks while file is open - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='NEW',FORM='UNFORMATTED',SHARED, - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - END IF - - IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - IF (REMOTE_SET.EQ.4) THEN - IF (BULLFIL.NE.1) CALL SET_BULLFIL - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - IF (IER.EQ.0) THEN - DO WHILE (REC_LOCK(IER2)) - READ (1'1,IOSTAT=IER2) NBLOCK - END DO - IF (IER2.NE.0) THEN - NBLOCK = 1 - WRITE (1'1,IOSTAT=IER2) NBLOCK - END IF - BULLFIL = 1 - END IF - ELSE - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED') - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILE - NTRIES = 0 - ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DNF) THEN - IER1 = LIB$CREATE_DIR( - & FOLDER_FILE(:INDEX(FOLDER_FILE,']'))) - IF (IER1) IDUMMY = FILE_LOCK(IER,IER1) - END IF - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.4) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM, - & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR. - & PRV$M_SETPRV,(0,I=1,FLONG*4-1) - CLOSE (UNIT=4) - IDUMMY = FILE_LOCK(IER,IER1) - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (LUN.EQ.7) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN - FOLDER1 = 'GENERAL' - FOLDER1_OWNER = 'SYSTEM' - FOLDER1_DESCRIP = 'Default general bulletin folder.' - FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = 14 - NBULL = 0 - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER)) - CALL SYS_BINTIM('5-NOV-1982 00:00:00.00', - & NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE) - WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2) - & FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP - & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0 - ! 4 means system folderr - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1)e - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE)R - NTRIES = 0B - END IFI - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE.L - END IF+ - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=NEWS_FOLDER_RECORD/4, - & ORGANIZATION='INDEXED',IOSTAT=IER) - IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN( - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN', - & ACCESS='KEYED',RECORDTYPE='FIXED',S - & RECORDSIZE=NEWS_FOLDER_RECORD,E - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2,T - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER,O - & 57:64:CHARACTER:DESCENDING)) - CLOSE (UNIT=7) - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loopL - ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1)F - CALL CONVERT_BULLNEWS(BULLNEWS_FILE)C - NTRIES = 0' - END IF' - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IFC - - IF (LUN.EQ.9) THENM - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN',M - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))L - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = 0 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - END IF - - IF (IER.NE.0) THEN - WRITE (6,'(E - & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)T - IF (IER1.EQ.0) THENe - WRITE (6,'('' IOSTAT error = '',I)') IERE - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXITD - END IFN - - LUN = 0 - - CALL RESET_PROTECTION - - RETURNO - END - - - - SUBROUTINE TIMER_ERR(UNIT) - - IMPLICIT INTEGER (A-Z), - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14)' - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/T - - IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error - WRITE(6,'('' ERROR: Unable to open '',A, - & '' file after 30 secs.'')') - & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT)))) - WRITE (6,'('' Please try again later.'')') - END IF3 - - CALL ENABLE_CTRL_EXIT ! No breaks while file is open - END - - - - SUBROUTINE OPEN_FILE_SHARED - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($FORIOSDEF)' - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEWS_OPEN/ NEWS_OPEN - - COMMON /BULLFIL/ BULLFIL - - EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT -C -C The following 2 files were used prior to V1.1. -C - CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/E - CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/ - - CHARACTER*44 SAVE_FOLDERL - DATA SAVE_BLOCK/-1/ - - CHARACTER*14 NAMES(6) - DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT', - & 'BULLINF.DAT','BULLNEWS.DAT'/ - INTEGER NAME(14)Z - DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/, - - DATA LUN /0/K - - ENTRY OPEN_BULLNEWS_SHARED, - LUN = LUN + 5 ! Unit = 14 - - ENTRY OPEN_BULLINF_SHARED - LUN = LUN + 1 ! Unit = 9E - - ENTRY OPEN_SYSUAF_SHAREDI - LUN = LUN + 1 ! Unit = 8 - - ENTRY OPEN_BULLFOLDER_SHARED - LUN = LUN + 3 ! Unit = 7 - - ENTRY OPEN_BULLUSER_SHARED - LUN = LUN + 2 ! Unit = 4L - - ENTRY OPEN_BULLDIR_SHARED - LUN = LUN + 1 ! Unit = 2Q - - ENTRY OPEN_BULLFIL_SHARED - LUN = LUN + 1 ! Unit = 1R - - IER = 0 - - NTRIES = 0D - - CALL DISABLE_CTRL - - IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THENE - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE, - & STATUS='OLD',FORM='UNFORMATTED',N - & RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(13:20:CHARACTER, - & 1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER, - & 85:96:CHARACTER),ACCESS='KEYED') - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL TIMER_ERR(LUN) - END DO - DIR_NUM = -1 - ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')_ - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0E - & .OR.FOLDER.EQ.'GENERAL')) THEN - IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') - IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR') - IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop - ELSE IF (IER.EQ.0) THEN - INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE)O - IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN - CLOSE (UNIT=2)S - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loopI - CALL CONVERT_BULLFILES - NTRIES = 0 - END IF - ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLDIRS) - NTRIES = 0 - END IFE - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - DIR_NUM = -1 - END IFO - - IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR.= - & SAVE_FOLDER.NE.FOLDER)) THEN - CALL REMOTE_READ_MESSAGE(BULL_POINT,IER) - IF (IER.GT.0) THEN - CALL ERROR_AND_EXIT - ELSE - SAVE_BLOCK = BLOCKO - SAVE_FOLDER = FOLDERF - CALL GET_REMOTE_MESSAGE(IER)D - IER = 0 - END IF - ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN - SAVE_BLOCK = -1E - IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='OLD',R - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, - & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY)I - IF (REMOTE_SET.EQ.4) THEN - IF (IER.EQ.0) THENR - DO WHILE (REC_LOCK(IER2))N - READ (1'1,IOSTAT=IER2) NBLOCKE - END DO - IF (IER2.NE.0) NBLOCK = 1 - BULLFIL = 2 - END IF - END IF - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_BULLFILEE - NTRIES = 0 - END IFY - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF - - IF (LUN.EQ.4) THENB - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4, - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THENA - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_USERFILE5 - NTRIES = 0 - END IF - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - END IF) - - IF (LUN.EQ.7) THENO - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD', - & RECORDSIZE=FOLDER_RECORD/4, - & ACCESS='KEYED',RECORDTYPE='FIXED',W - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) - CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE) - NTRIES = 0 - END IFI - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .FALSE.E - END IFS - - IF (LUN.EQ.14) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',( - & RECORDSIZE=NEWS_FOLDER_RECORD/4,I - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED) - - IF (IER.EQ.FOR$IOS_INCRECLEN) THEND - IDUMMY = FILE_LOCK(IER,IER1)N - CALL CONVERT_BULLNEWS(BULLNEWS_FILE)O - NTRIES = 0 - END IFU - NTRIES = NTRIES + 1 - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT - END DO - IF (IER.EQ.0) NEWS_OPEN = .TRUE. - END IFE - - IF (LUN.EQ.8) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT', - & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,IOSTAT=IER,SHARED, - & USEROPEN=LNM_MODE_EXEC)E - END DO - END IFS - - IF (LUN.EQ.9) THEN - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & RECORDSIZE=FOLDER_MAX*2+3,) - & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED, - & KEY=(1:12:CHARACTER)) - IF (IER.EQ.FOR$IOS_INCRECLEN) THEN - IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop - CALL CONVERT_INFFILE - NTRIES = 0 - END IF - NTRIES = NTRIES + 1D - IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXITF - END DO - END IFE - - IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN - CALL OPEN_FILE(LUN)o - ELSE IF (IER.NE.0) THEN - WRITE(6,'('' ERROR: Cannot open '',A)') - & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN)))) - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)) - WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) - WRITE(6,'(1X,A)')USERNAME - IF (IER1.EQ.0) THEN) - WRITE (6,'('' IOSTAT error = '',I)') IERE - ELSE - CALL SYS_GETMSG(IER1) - END IF - CALL ENABLE_CTRL_EXIT_ - END IFR - - LUN = 0 - - RETURNL - END - - - SUBROUTINE RESET_PROTECTION - - IMPLICIT INTEGER (A-Z)0 - - DATA PROT_LEVEL /0/ - - PROT_LEVEL = PROT_LEVEL - 1 - IF (PROT_LEVEL.GT.0) RETURN - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protectionr - - RETURNs - - ENTRY SET_PROTECTIONL - - PROT_LEVEL = PROT_LEVEL + 1 - IF (PROT_LEVEL.GT.1) RETURN - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)0 - ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP) - - RETURNe - END - - - - - SUBROUTINE FOLDER_TO_NEWS - - IMPLICIT INTEGER (A-Z)' - - INCLUDE 'BULLFOLDER.INC' - - NEWS_FOLDER = FOLDER: - NEWS_FOLDER_NUMBER = FOLDER_NUMBER6 - NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP( - & MIN(45,INDEX(FOLDER_DESCRIP,' ')):)e - NEWS_F_NBULL = F_NBULLB - NEWS_F_COUNT = F_COUNT - NEWS_F_START = F_START - NEWS_F_LAST = F_LASTE - NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1)E - NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2)C - NEWS_F_FLAG = FOLDER_FLAG - NEWS_F_EXPIRE = FOLDER_BBEXPIRE - NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT - - RETURNC - - ENTRY FOLDER1_TO_NEWS - - NEWS_FOLDER1 = FOLDER1O - NEWS_FOLDER1_NUMBER = FOLDER1_NUMBERI - NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP( - & MIN(45,INDEX(FOLDER1_DESCRIP,' ')):) - NEWS_F1_NBULL = F1_NBULLT - NEWS_F1_COUNT = F1_COUNTI - NEWS_F1_START = F1_STARTR - NEWS_F1_LAST = F1_LASTD - NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1)E - NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2)E - NEWS_F1_FLAG = FOLDER1_FLAG - NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE - NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMITD - - RETURNG - - ENTRY NEWS_TO_FOLDER1 - - FOLDER = NEWS_FOLDER6 - FOLDER_NUMBER = NEWS_FOLDER_NUMBERU - FOLDER_DESCRIP = NEWS_FOLDER(:TRIM(NEWS_FOLDER))T - & //NEWS_FOLDER_DESCRIPN - FOLDER_BBOARD = '::'E - F_NBULL = NEWS_F_NBULL - F_COUNT = NEWS_F_COUNT - F_START = NEWS_F_STARTD - F_LAST = NEWS_F_LAST+ - F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1)A - F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2)Y - FOLDER_FLAG = NEWS_F_FLAG - IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE'D - FOLDER_BBEXPIRE = NEWS_F_EXPIRE - F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMITL - - RETURNI - - ENTRY NEWS_TO_FOLDER1 - - FOLDER1 = NEWS_FOLDER1( - FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER= - FOLDER1_DESCRIP = NEWS_FOLDER1(:TRIM(NEWS_FOLDER1)) - & //NEWS_FOLDER1_DESCRIP - FOLDER1_BBOARD = '::' - F1_COUNT = NEWS_F1_COUNT4 - F1_NBULL = NEWS_F1_NBULLO - F1_START = NEWS_F1_STARTE - F1_LAST = NEWS_F1_LAST2 - F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1): - F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2)6 - FOLDER1_FLAG = NEWS_F1_FLAG - IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE' - FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE - F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMITO - - RETURNN - - END - - - - - SUBROUTINE CONVERT_BULLDIRS - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'' - - INCLUDE 'BULLFILES.INC' - - CHARACTER BUFFER*125X - - WRITE (6,'('' Converting data files to new format. Please wait.'')'), - - CALL SET_PROTECTION - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',ACCESS='DIRECT', - & ORGANIZATION='RELATIVE',DISPOSE='KEEP', - & IOSTAT=IER) - - IF (IER.NE.0) GO TO 900 ! No BULLDIR file found. - - READ (2'1,IOSTAT=IER1) BUFFER - - CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL) - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,1 - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',I - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 ) - - IF (IER.NE.0) THEN - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,I - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')_ - END IF) - - IF (IER1.NE.0) GO TO 800 - - CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM) - CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM) - BULLDIR_HEADER(29:40) = BUFFER(39:) - CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM)S - BULLDIR_HEADER(49:52) = BUFFER(70:) - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER - - ICOUNT = 2O - DO WHILE (IER.EQ.0) - READ (2'ICOUNT,IOSTAT=IER) BUFFERT - IF (IER.EQ.0) THEN - MSG_NUM = ICOUNT - 1F - DESCRIP = BUFFER(:) - FROM = BUFFER(54:)O - BULLDIR_ENTRY(81:84) = BUFFER(85:)_ - BULLDIR_ENTRY(93:100) = BUFFER(108:) - CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM)T - CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM) - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE (9,IOSTAT=IER) BULLDIR_ENTRY - ICOUNT = ICOUNT + 1 - END IF - END DOD - -800 CLOSE (UNIT=9,DISPOSE='KEEP')e - CLOSE (UNIT=2)o - -900 CALL RESET_PROTECTIONF - - RETURN - - END - - - - SUBROUTINE CONVERT_BULLFILESI -C+ -C SUBROUTINE CONVERT_BULLFILESN -CE -C FUNCTION: Converts bulletin files to new format file. -C Add expiration time to directory file, add extra byte to bulletinI -C file to show where each bulletin starts (for redunancy sake in -C case crash occurs). -C - - IMPLICIT INTEGER (A-Z)' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - CHARACTER*81 BUFFER - - WRITE (6,'('' Converting data files to new format. Please wait.'')')0 - - OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD', - & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',, - & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', - & SHARED,READONLY,IOSTAT=IER) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))O - & //'.BULLFIL',STATUS='OLD',F - & RECORDTYPE='FIXED',RECORDSIZE=80, - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - CALL SET_PROTECTION - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81, - & FORM='FORMATTED') - - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,( - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')N - - NEWEST_EXTIME = '00:00:00.00' - READ (9'1,1000,IOSTAT=IER) - & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8), - & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8)' - NEMPTY = 0L - IF (IER.EQ.0) CALL WRITEDIR(0,IER1) - - EXTIME = '00:00:00.00'' - ICOUNT = 2O - DO WHILE (IER.EQ.0) - READ(9'ICOUNT,1010,IOSTAT=IER) - & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK - IF (IER.EQ.0) THEN - READ(10,'(A)') BUFFER - WRITE(1,'(A)') BUFFER(:80)//CHAR(1) - DO I=2,LENGTH - READ(10,'(A)') BUFFERY - WRITE(1,'(A)') BUFFER - END DO= - CALL WRITEDIR(ICOUNT-1,IER1)= - ICOUNT = ICOUNT + 1 - END IF - END DOK - - CLOSE (UNIT=9)) - CLOSE (UNIT=2)Q - CLOSE (UNIT=10) - CLOSE (UNIT=1)D - - CALL RESET_PROTECTION - RETURNb - -1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)T -1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4) - - END - - SUBROUTINE CONVERT_BULLFILE -CI -C SUBROUTINE CONVERT_BULLFILE -C -C FUNCTION: Converts bulletin data file to new format file. -C -C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length. -C This converts from 81 byte length to 128 compressed format. -CT - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'X - - INCLUDE 'BULLFILES.INC' - - CHARACTER*80 BUFFER,NEW_FILES - - WRITE (6,'('' Converting data files to new format. Please wait.'')')I - - CALL CLOSE_BULLDIR - - CALL SET_PROTECTION - - CALL OPEN_BULLFOLDERA - -100 READ (7,FMT=FOLDER_FMT,ERR=200) - & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //FOLDER(:TRIM(FOLDER))u - NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD' - OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL'Y - & ,STATUS='OLD',R - & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT', - & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)I - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL',STATUS='NEW',IOSTAT=IER, - & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,_ - & FORM='UNFORMATTED') - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLFIL;-1',NEW_FILE)W - - CALL OPEN_BULLDIR - - CALL READDIR(0,IER) - - IF (IER.EQ.1) THENG - NBLOCK = 0 - DO I=1,NBULL - CALL READDIR(I,IER)S - NBLOCK = NBLOCK + 1E - SBLOCK = NBLOCK - DO J=BLOCK,LENGTH+BLOCK-1_ - READ(10'J,'(A)') BUFFER - ILEN = TRIM(BUFFER) - IF (ILEN.EQ.0) ILEN = 1 - CALL STORE_BULL(ILEN,BUFFER,NBLOCK) - END DO - CALL FLUSH_BULL(NBLOCK)B - LENGTH = NBLOCK - SBLOCK + 1 - BLOCK = SBLOCK - CALL WRITEDIR(I,IER) - END DO - - NEMPTY = 0 - CALL WRITEDIR(0,IER) - END IF_ - - CLOSE (UNIT=10) - CLOSE (UNIT=1)E - - CALL CLOSE_BULLDIRR - GOTO 100W - -200 CALL OPEN_BULLDIR_SHARED - - CALL RESET_PROTECTION - - RETURNI - - END - - - - SUBROUTINE CONVERT_BULLFOLDER(FILENAME) -CF -C SUBROUTINE CONVERT_BULLFOLDER -CN -C FUNCTION: Converts bulletin folder file to new format. -C - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'F - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)'F - - INCLUDE '($FORIOSDEF)'W - - CHARACTER*(*) FILENAME_ - - CHARACTER NEW_FILE*80,OLD_FOLDER*25 - - WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')') - & FILENAME(:TRIM(FILENAME)) - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']'))Y - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1E - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1))E - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED',4 - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE) - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',1 - & RECORDSIZE=FOLDER_RECORD, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER), - & DISPOSE='DELETE')* - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THEN - F_NUMBER = 0 - DO WHILE (IER.EQ.0)F - IF (ASK_SIZE.EQ.184) THENB - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)',R - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER) - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPI - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM) - ELSE IF (ASK_SIZE.EQ.173) THEN - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)E - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPD - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM. - END IF - IF (IER.EQ.0) THEN - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM)D - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) - IF (NEWS_FEED()) THEN D - CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST)2 - ELSEC - F_LAST = 0 - END IF - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER)T - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBC - & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET - & ,F_NEWEST_NOSYS_BTIM,0,0,F_LAST - F_NUMBER = F_NUMBER + 1 - END IF - END DO - ELSE - F_NUMBER = 0 - DO WHILE (IER.EQ.0)' - READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)', - & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)R - & OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPR - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - IF (IER.EQ.0) THEN - FOLDER_FLAG = 0 - IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2) - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //OLD_FOLDER(:TRIM(OLD_FOLDER))T - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)L - IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,0) - END IFO - DO WHILE (FILE_LOCK(IER,IER1))V - OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',e - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.EQ.FOR$IOS_INCFILORG) THEN - IDUMMY = FILE_LOCK(IER,IER1)n - CALL CONVERT_BULLDIRS - END IF - END DOE - IF (IER.EQ.FOR$IOS_FILNOTFOU) THENE - F_NEWEST_BTIM(1) = 0D - F_NEWEST_BTIM(2) = 0& - ELSET - CALL READDIR(0,IER)S - IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN - IF (NBULL.GT.0) THEN - CALL READDIR(NBULL,IER) - NEWEST_DATE = DATE. - NEWEST_TIME = TIMEo - CALL WRITEDIR(0,IER)= - END IF - END IF - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) - CLOSE (UNIT=2) - END IFR - FOLDER = OLD_FOLDER - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE)I - WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER) - & FOLDER,F_NUMBER,FOLDER_CREATED_DATE, - & ,FOLDER_OWNER,FOLDER_DESCRIP - & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB - & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0= - F_NUMBER = F_NUMBER + 1 - END IF - END DO - END IFT - - CLOSE (UNIT=7)T - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)E - IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE), - - CALL RESET_PROTECTION - - IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY)) - & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file - - RETURND - END - - - - SUBROUTINE CONVERT_BULLNEWS(FILENAME) -CD -C SUBROUTINE CONVERT_BULLNEWS -CN -C FUNCTION: Converts bulletin NEWS file to new format.N -C, - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($SSDEF)', - - INCLUDE '($FORIOSDEF)'( - - CHARACTER*(*) FILENAMET - - CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55,TMP*2 - - WRITE (6,'('' Converting '',A,'' to new format. ''K - & ,''This will take a while.'')') FILENAME(:TRIM(FILENAME))N - - CALL SET_PROTECTION - - EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')), - SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1E - NEW_FILE = FILENAME(:SUFFIX)//'OLD' - - DO WHILE (FILE_LOCK(IER,IER1)) - OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD', - & RECORDTYPE='FIXED',ACCESS='KEYED',n - & ORGANIZATION='INDEXED',IOSTAT=IER,f - & KEY=(1:25:CHARACTER,26:29:INTEGER)) - END DO - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',C - & RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600,L - & ORGANIZATION='INDEXED',IOSTAT=IER,B - & KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER,F - & 57:64:CHARACTER:DESCENDING),DISPOSE='DELETE')E - - IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why? - - NEWS_FOLDER_NUMBER = 0( - CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE)E - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE)8 - NEWS_F_LAST = 0 - NEWS_F_FLAG = 0 - NEWS_F_EXPIRE = 7 - NEWS_F_FIRST = 0Y - NEWS_F_END = 0. - NEWS_F_EXPIRE_LIMIT = 0 - READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108)M - DO WHILE (IER.EQ.0) - OLD_FOLDER = INPUT(:25) - CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER) - OLD_DESCRIP = INPUT(30:)M - CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START) - CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT)D - CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL)0 - CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM) - LMOVE = INDEX(OLD_DESCRIP,' ')-1T - IF (LMOVE.LE.0) THEN' - NEWS_FOLDER = OLD_FOLDER - NEWS_FOLDER_DESCRIP = OLD_DESCRIPC - ELSEL - NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE)) - NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):)I - END IF - WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM - READ (7,IOSTAT=IER) INPUT(:108) - END DO - - CLOSE (UNIT=7) - CLOSE (UNIT=19,STATUS='SAVE') - - IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)R - IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE)M - - CALL RESET_PROTECTION - - RETURND - END - - - - SUBROUTINE CONVERT_USERFILE -C -C SUBROUTINE CONVERT_USERFILE -C -C FUNCTION: Converts user file to new format which has 8 bytes added. -CI - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLUSER.INC'A - - CHARACTER BUFFER*74,NEW_FILE*80 - - CHARACTER*12 LOGIN_DATE,READ_DATE - CHARACTER*8 LOGIN_TIME,READ_TIME. - - WRITE (6,'('' Converting data files to new format. Please wait.'')')C - - EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))F - SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1 - NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'F - IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE) - - OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',Y - & ACCESS='KEYED',RECORDTYPE='FIXED', - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,( - & KEY=(1:12:CHARACTER))D - INQUIRE (UNIT=9,RECORDSIZE=RECL)N - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')')1 - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')F - IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)R - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFo - - IF (IER.EQ.0) THENZ - CALL SET_PROTECTION7 - OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16, - & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, - & KEY=(1:12:CHARACTER)) - END IFE - - IF (IER.NE.0) THENL - WRITE (6,'('' Cannot convert user file.'')') - IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)F - CALL SYS_GETMSG(IER1) - CALL RESET_PROTECTION_ - CALL ENABLE_CTRL_EXITA - END IFQ - - DO I=1,FLONG - NEW_FLAG(I) = 'FFFFFFFF'X1 - NOTIFY_FLAG(I) = 0 - BRIEF_FLAG(I) = 0= - SET_FLAG(I) = 0& - END DOD - - IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR.F - & RECL.EQ.74) THEN ! Old format - IF (RECL.LE.58) RECL = 50B - IER = 0A - DO WHILE (IER.EQ.0) - READ (9,'(A)',IOSTAT=IER) BUFFERE - IF (IER.EQ.0) THEN - TEMP_USER = BUFFER(:12)Y - LOGIN_DATE = BUFFER(13:23)T - LOGIN_TIME = BUFFER(24:31)E - READ_DATE = BUFFER(32:42) - READ_TIME = BUFFER(43:50) - IF (RECL.EQ.58) - & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))= - IF (RECL.EQ.66) - & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1))E - IF (RECL.EQ.74) - & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1)) - CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM) - CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM)S - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,1 - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - IF (RECL.LT.66) THEN - READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER, - & LOGIN_BTIM,, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - ELSE ! Folder maxmimum increase - OFLONG = (RECL - 28) / 16 ! Old #longwords/flagE - DO WHILE (IER.EQ.0)) - READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) - & TEMP_USER,LOGIN_BTIM,READ_BTIM,I - & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG), - & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG) - IF (IER.EQ.0) THEN. - WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, - & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG - END IF - END DO - END IFE - - IER = 0 - - CLOSE (UNIT=9) - CLOSE (UNIT=4), - - CALL RESET_PROTECTION - - RETURN - END - - - SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT) -CM -C SUBROUTINE READDIRn -C -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file and returns the information for that entry. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.R -C If 0, gives header info, i.e number of bulls, -C number of blocks in bulletin file, etc. -C OUTPUTS:E -C ICOUNT - The last record read by this routine. -C= - - IMPLICIT INTEGER (A - Z)R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'L - - COMMON /PROMPT/ COMMAND_PROMPTT - CHARACTER*40 COMMAND_PROMPT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /NEXT/ NEXTW - - COMMON /KEEPLOCK/ KEEPLOCK - DATA KEEPLOCK/.FALSE./W - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - COMMON /BULLFIL/ BULLFIL - - CHARACTER*3 CFOLDER_NUMBER, - - CHARACTER*8 NEWS_KEY - - ICOUNT = BULLETIN_NUM - - IF (ICOUNT.EQ.0) THEN - IF (.NOT.REMOTE_SET) THENR - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THENO - IER = 0 - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER - END IF - END DON - IF (IER.EQ.0) THENT - CALL CONVERT_HEADER_FROMBIN - IF (REMOTE_SET.EQ.4) THEN - DIR_NUM = -1 - ELSE_ - DIR_NUM = 0 - END IF_ - END IFI - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURNC - END IF - IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEND - IF (NBULL.LT.0) THEN ! This indicates bulletin deletion - ! was incomplete. - CALL CLOSE_BULLDIRu - CALL OPEN_BULLDIR - CALL CLEANUP_DIRFILE(1) - CALL UPDATE_FOLDERE - END IF - IF (NEMPTY.EQ.' '.AND. - & FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0 -CC -C Check to see if cleanup of empty file space is necessary, which is* -C defined here as being 50 blocks (200 128byte records). Also check -C to see if cleanup was in progress but didn't properly finish. -CI - IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEND - WRITE (CFOLDER_NUMBER,'(I3)') FOLDER_NUMBER - IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX( - & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER, - & 'NL:','NL:',1,'BULL_CLEANUP')S - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLEANUP_BULLFILE - END IF - END IF - ELSED - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER))G - IF (REMOTE_SET.EQ.4) THEN - IF (NEXT) THEN - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRY, - ELSE - READ(2,KEYGE=NEWS_KEY(ICOUNT,FOLDER_NUMBER) - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRYR - END IF - ELSE - IF (ICOUNT.LT.F_START) ICOUNT = F_START - IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL - IF (DIR_NUM.EQ.ICOUNT-1) THEN - READ(2,IOSTAT=IER) NEWSDIR_ENTRYS - ELSE_ - READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER) - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRY2 - END IFN - IF (INCMD(:4).EQ.'BACK') THEN - DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START)A - ICOUNT = ICOUNT - 17 - READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER)I - & ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRY - END DO - END IF) - END IF - IF (IER.EQ.0) THEN - NUM = GET_INTEGER(%REF(NEWS_MSG_KEY)) - IF (NUM.NE.FOLDER_NUMBER) THEN - IER = 36_ - UNLOCK 2 - ELSEM - MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:))) - IF (MSG_NUM.GT.F_NBULL) THEN - IER = 36 - UNLOCK 2 - ELSE IF (ICOUNT.LE.F_START.AND.E - & MSG_NUM.GT.F_START) THENI - INQUIRE (UNIT=7,OPENED=IER1) - IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED - IDUMMY = REC_LOCK(IER) - CALL READ_FOLDER_FILE_KEYNAMEE - & (FOLDER,IER2) - F_START = MSG_NUM - CALL REWRITE_FOLDER_FILE(IER2) - IF (.NOT.IER1) CALL CLOSE_BULLNEWS - IDUMMY = REC_LOCK(IER) - END IFC - END IFC - IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THENW - ICOUNT = MSG_NUM= - BULLETIN_NUM = ICOUNT - END IFE - END IF - ELSEC - IF (DIR_NUM.EQ.ICOUNT-1) THENS - READ(2,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97). - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) W - & BULLDIR_ENTRY - END IFA - IF (MSG_NUM.NE.ICOUNT) THEN - IER = 36 - UNLOCK 2 e - END IFw - ELSE - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '// - & BULLDIR_ENTRY(66:97)N - READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) - & BULLDIR_ENTRY - END IF - END IF - END IFE - END DO= - IF (IER.EQ.0) THEN - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN( - DIR_NUM = MSG_NUM - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL - ELSE - DIR_NUM = -1c - END IFU - ELSE - CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) - RETURNE - END IF - END IFE - - IF (IER.EQ.0) THEN - ICOUNT = ICOUNT + 1E - IF (.NOT.KEEPLOCK) UNLOCK 2, - END IFL - - RETURNC - - END - - - - CHARACTER*8 FUNCTION NEWS_KEY(ICOUNT,FOLDER_NUMBER) - - IMPLICIT INTEGER (A-Z)P - - CHARACTER*4 INTEGER_KEY - - NEWS_KEY = INTEGER_KEY(FOLDER_NUMBER)//INTEGER_KEY(ICOUNT)E - - RETURNI - END - - - - INTEGER FUNCTION GET_INTEGER(NUM) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*4 CTEMP,INTEGER_KEY - - CTEMP = INTEGER_KEY(NUM)I - - CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER) - - RETURNe - END - - - - CHARACTER*4 FUNCTION INTEGER_KEY(NUM) - - IMPLICIT INTEGER (A-Z) - - INTEGER TEMPP - CHARACTER*4 CTEMP - EQUIVALENCE (CTEMP,TEMP)Q - - TEMP = NUMN - - DO I=4,1,-1 - INTEGER_KEY(I:I) = CTEMP(5-I:5-I)= - END DOR - - RETURN - END - - - SUBROUTINE READDIR_KEYGE(IER) -CR -C SUBROUTINE READDIR_KEYGEC -CQ -C FUNCTION: Finds the entry for the specified bulletin in the -C directory file corresponding to or later than the date specified. -C -C INPUTS: -C MSG_KEY - Message key (passed via BULLDIR.INC common block). -C OUTPUTS:U -C IER - If 0, no entry found. Else contains message number. -CM - - IMPLICIT INTEGER (A - Z)R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'3 - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - COMMON /KEYID/ NEWS_KEYID - DATA NEWS_KEYID/2/B - - COMMON /KEEPLOCK/ KEEPLOCKF - - COMMON /BULLFIL/ BULLFILQ - - CHARACTER*4 INTEGER_KEY - - IF (.NOT.REMOTE_SET) THEN - DO WHILE (REC_LOCK(IER)) - IF (REMOTE_SET.EQ.4) THEN - IF (NEWS_KEYID.NE.4.OR.MSG_NUM.EQ.0) THENR - READ(2,KEYGT=INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY - & ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRYR - ELSE - READ(2,IOSTAT=IER) NEWSDIR_ENTRY - END IF - IF (IER.EQ.0) THENS - NUM = GET_INTEGER(%REF(NEWS_MSG_KEY)) - IF (NUM.NE.FOLDER_NUMBER) THEN - IER = 36_ - UNLOCK 2R - ELSE - MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:))) - IF (MSG_NUM.GT.F_NBULL) THEN_ - IF (NEWS_KEYID.EQ.4.AND.MSG_NUM.NE.0) THEN E - IF (MSG_NUM.GT.NEWS_F_END) THENF - IDUMMY = REC_LOCK(IER) - END IF - ELSE - IER = 36A - UNLOCK 2 - END IF - END IF - END IF - END IF - ELSE( - READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) - & BULLDIR_ENTRY - IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN - REWRITE (2) BULLDIR_ENTRY(:65)//' '//) - & BULLDIR_ENTRY(66:97)E - READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) - & BULLDIR_ENTRY - END IFR - END IF( - END DO - IF (IER.EQ.0) THEN - IER = MSG_NUM - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - CALL CONVERT_ENTRY_FROMBIN - DIR_NUM = MSG_NUM - IF (.NOT.KEEPLOCK) UNLOCK 2 - IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFILr - ELSE - IER = 0 - DIR_NUM = -1 - END IF - ELSES - CALL REMOTE_GET_HEADER(DUMMY,-1,IER) - END IF - - - RETURN, - - END - - - - SUBROUTINE CONVERT_HEADER_FROMBIN - - IMPLICIT INTEGER (A-Z)e - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM) - CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) - NBULL = F_NBULL - NEMPTY = 0 - END IF - - CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,) - - NEWEST_EXDATE = DATETIME(:11) - NEWEST_EXTIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,) - - NEWEST_DATE = DATETIME(:11) - NEWEST_TIME = DATETIME(13:23) - - CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,) - - SHUTDOWN_DATE = DATETIME(:11) - SHUTDOWN_TIME = DATETIME(13:23) - - RETURN, - END - - - - SUBROUTINE CONVERT_ENTRY_FROMBIN - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /POST/ POSTTIME - - CHARACTER*24 DATETIME - - IF (REMOTE_SET.EQ.4) THEN - CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY(5:)),%DESCR(MSG_BTIM)) - CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY(5:)),%DESCR(EX_BTIM)) - IF (POSTTIME) CALL COPY2(MSG_BTIM,NEWS_POST_BTIM)c - DESCRIP = NEWS_DESCRIPi - FROM = NEWS_FROM I - BLOCK = NEWS_BLOCKL - LENGTH = NEWS_LENGTH - SYSTEM = 0 - END IF - - ENTRY CONVERT_ENTRY_FROMBIN_FOLDER - - CALL SYS$ASCTIM(,DATETIME,EX_BTIM,) - - EXDATE = DATETIME(:11)t - EXTIME = DATETIME(13:23)i - - CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,)n - - DATE = DATETIME(:11)s - TIME = DATETIME(13:23)A - - RETURN - END - - - - - - SUBROUTINE WRITEDIR(BULLETIN_NUM,IER) -Cn -C SUBROUTINE WRITEDIR -C. -C FUNCTION: Writes the entry for the specified bulletin in theI -C directory file. -C -C INPUTS: -C BULLETIN_NUM - Bulletin number. Starts with 1.M -C If 0, write the header of the directory file. -C OUTPUTS:, -C IER - Error status from WRITE. -C - - IMPLICIT INTEGER (A - Z)L - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /DIR_POSITION/ DIR_NUM - - CHARACTER*8 NEWS_KEYT - - CONV = .TRUE. - - GO TO 10. - - ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER) - - CONV = .FALSE.N - , -10 IF (BULLETIN_NUM.EQ.0) THEN - IF (CONV) CALL CONVERT_HEADER_TOBINO - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER - ELSE - IER = -1N - IF (DIR_NUM.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0 - ELSE( - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IFR - END IF - IF (IER.NE.0) THEN - IF (REMOTE_SET.EQ.4) THEN - IER = 0M - ELSE - READ (2,KEYID=0,KEY=0,IOSTAT=IER)R - IF (IER.EQ.0) THEN - REWRITE (2,IOSTAT=IER) BULLDIR_HEADER( - END IF - END IFS - END IF - IF (IER.NE.0) THENN - IF (REMOTE_SET.NE.4) THEN - WRITE (2,IOSTAT=IER) BULLDIR_HEADER - END IFE - END IFR - END IF - ELSE - MSG_NUM = BULLETIN_NUM - IF (CONV) CALL CONVERT_ENTRY_TOBIN - IF (REMOTE_SET) THEN - WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM, - & BULLDIR_ENTRY - ELSE - IER = -1 - IF (DIR_NUM.EQ.MSG_NUM) THENI - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRYO - END IFA - END IF& - IF (IER.NE.0) THENE - IF (REMOTE_SET.EQ.4) THEN - DO WHILE (REC_LOCK(IER).AND. - & BULLETIN_NUM.NE.NEWS_F_END+1) - READ (2,KEYID=1,KEY=NEWS_KEY(_ - & BULLETIN_NUM,FOLDER_NUMBER),IOSTAT=IER) - END DO - ELSEC - READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER) - END IFE - IF (REMOTE_SET.EQ.4.AND.( - & BULLETIN_NUM.EQ.NEWS_F_END+1) THEND - CALL SPECIAL_NEWSDIR_ENTRY(IER)U - ELSE IF (IER.EQ.0) THEN - IF (REMOTE_SET.EQ.4) THEN - REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - ELSE - IF (REMOTE_SET.EQ.4) THEN - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY - ELSE - WRITE (2,IOSTAT=IER) BULLDIR_ENTRY - END IF - END IF& - END IFT - END IF - END IF - - IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT - - DIR_NUM = -1 - - RETURN - - END - - - - SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER)K - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC'E - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($RMSDEF)' - - DIMENSION BTIM(2) - - CHARACTER*8 NEWS_KEY - - READ (2,KEYID=3,KEY=NEWS_MSGID,IOSTAT=IER) INPUT(:84) - DO WHILE (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).NE.FOLDER_NUMBER) - READ (2,IOSTAT=IER) INPUT(:84) - IF (NEWS_MSGID.NE.INPUT(21:84)) IER = 2 - END DO - - IF (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).EQ.FOLDER_NUMBER) THEN U - IER = 2A - RETURN - END IF - -10 IER1 = 0N - DO WHILE (REC_LOCK(IER1)) - READ (2,KEYID=1,KEYGT=NEWS_KEY(NEWS_F_END,FOLDER_NUMBER), - & IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH)) - END DO - DO WHILE (IER1.EQ.0) - FNUM = GET_INTEGER(%REF(INPUT))I - IF (FNUM.NE.FOLDER_NUMBER) THENT - IER1 = 2S - ELSE - CALL GET_MSGKEY(%REF(INPUT(85:)),%DESCR(BTIM))T - IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND.E - & .NOT.BTEST(FOLDER_FLAG,13)) THEN - CALL COPY2(NEWEST_EXBTIM,BTIM) - END IFC - F_COUNT = F_COUNT + 1 - NEWS_F_END = GET_INTEGER(%REF(INPUT(5:))) - DO WHILE (REC_LOCK(IER1)) - READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) - END DO - END IF - END DOZ - - IF (MSG_NUM.NE.NEWS_F_END+1) THEN - MSG_NUM = NEWS_F_END + 1 - CALL CONVERT_ENTRY_TOBIN - END IFN - WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY D - - IF (IER.NE.0) THEN - CALL ERRSNS(IDUMMY,IER1) - IF (IER1.EQ.RMS$_DUP) GO TO 10 - ELSEO - F_COUNT = F_COUNT + 1s - END IF - - RETURNt - END - - - - SUBROUTINE CONVERT_HEADER_TOBIN - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' e - - INCLUDE 'BULLDIR.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNITu - - CHARACTER*8 NEWS_KEYe - - CHARACTER*4 INTEGER_KEY - - CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM)3 - - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM) - - CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM)B - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM) - CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE)I - END IF - - RETURNT - END - - - - SUBROUTINE CONVERT_ENTRY_TOBIN. - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /LOCALPOST/ LOCAL_POSTD - - CHARACTER*4 INTEGER_KEY - - CHARACTER*8 NEWS_KEY - - CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM)( - - IF (REMOTE_SET.EQ.4) THEN - CALL COPY2(NEWS_POST_BTIM,MSG_BTIM)R - END IF - L - CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM) - - IF (LOCAL_POST) THEN5 - CALL COPY2(NEWS_POST_BTIM,MSG_BTIM)E - END IF - - IF (REMOTE_SET.EQ.4) THEN - NEWS_DESCRIP = DESCRIP. - NEWS_FROM = FROMM - NEWS_BLOCK = BLOCK - NEWS_LENGTH = LENGTH - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - NEWS_MSG_KEY = NEWS_KEY(MSG_NUM,FOLDER_NUMBER) - NEWS_MSG_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEYT - CALL GET_MSGKEY(EX_BTIM,MSG_KEY) - NEWS_EX_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY - ELSEU - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)B - END IFT - - RETURN - END - - - - SUBROUTINE READ_FIRST_EXPIRED(NDEL) - - IMPLICIT INTEGER (A-Z)Y - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - I - COMMON /KEYID/ NEWS_KEYIDY - - COMMON /KEEPLOCK/ KEEPLOCK - V - CHARACTER*4 INTEGER_KEY - - EX_BTIM(1) = 0I - EX_BTIM(2) = 0 - MSG_NUM = 0 - - ENTRY READ_NEXT_EXPIRED(NDEL) - - NEWS_KEYID = 4I - KEEPLOCK = .TRUE. - CALL GET_MSGKEY(EX_BTIM,MSG_KEY)F - CALL READDIR_KEYGE(NDEL)E - KEEPLOCK = .FALSE.) - NEWS_KEYID = 2R - - RETURNE - END - - - - SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH) -CE -C SUBROUTINE READACLU -CI -C FUNCTION: Reads the ACL of a file. -CM -C PARAMETERS: -C FILENAME - Name of file to check.T -C ACLENT - String which will be large enough to hold ACL information.G -CM - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFILES.INC' - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*)E - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)( - - BIG = .NOT.IER$ - IF (BIG) THEN - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - ACLLENGTH = ACL$S_ADDACLENTR - CTXT = 0 - END IFB - - DO ACC_TYPE=1,2 - POINT = 1 - OUTLEN = 0 - DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)M - IF (.NOT.BIG) THEN - IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+C - & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,) - ELSE - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))),I - & ACLLEN,ACLSTR,,,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) IER = .FALSE. - END IF - AC = INDEX(ACLSTR,',ACCESS') - IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR.A - & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND. - & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,',ACCESS') - 1N - IF (ACLSTR(END_ID:END_ID).EQ.']') THEN - START_ID = END_ID - 1 - ASCII = .FALSE. - DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND. - & ACLSTR(START_ID:START_ID).NE.'='.AND.. - & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII))E - IF (ACLSTR(START_ID:START_ID).NE.','.AND.R - & (ACLSTR(START_ID:START_ID).LT.'0'.OR. - & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE. - IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN - START_ID = START_ID - 1 - END IFT - END DO - IF (ASCII) THEN - START_ID = START_ID + 1H - END_ID = END_ID - 1R - IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN - START_ID = INDEX(ACLSTR,'=') + 1 - END_ID = INDEX(ACLSTR,'ACCESS') - 2U - END IF - END IF - END IF - IF (OUTLEN.EQ.0) THEN - IF (FILENAME.NE.BULLUSER_FILE) THEN - IF (ACC_TYPE.EQ.1) THEN, - WRITE (6,'( - & '' These users can read and write to this folder:'')') - ELSE - WRITE (6,'(D - & '' These users can only read this folder:'')') - END IF - ELSE - WRITE (6,'('' The following are rights identifiers'', - & '' which will give privileges.'')') - END IF - OUTLEN = 1 - END IFE - IDLEN = END_ID - START_ID + 1 - IF (OUTLEN+IDLEN-1.GT.80) THENT - WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)D - OUTPUT = ACLSTR(START_ID:END_ID)//',' - OUTLEN = IDLEN + 2U - ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN - WRITE (6,'(1X,A)') - & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)E - OUTLEN = 1 - ELSEE - OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//',' - OUTLEN = OUTLEN + IDLEN + 1 - END IFK - END IF - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO - IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)F - END DOB - - RETURNI - END - - - - - SUBROUTINE CONVERT_INFFILE - - IMPLICIT INTEGER (A-Z)I - - INCLUDE 'BULLUSER.INC'I - - INCLUDE 'BULLFILES.INC' - - OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD', - & ACCESS='KEYED',RECORDTYPE='FIXED', - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER)) - - INQUIRE (UNIT=10,RECORDSIZE=RECL) - - IF ((RECL-28)/16.GT.FLONG) THEN - WRITE (6,'('' ERROR: Old data files have more folders'', - & '' than was specified with BULLUSER.INC.'')') - WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') - IF (USERNAME.EQ.'DECNET') THEN - CALL SYS$DELPRC(,)I - ELSE - CALL SYS$CANEXH() - CALL EXIT - END IF - END IFA - - RECL = RECL/8 - - OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW', - & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3, - & IOSTAT=IER,ORGANIZATION='INDEXED', - & KEY=(1:12:CHARACTER))I - - DO WHILE (IER.EQ.0) - READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)= - IF (IER.EQ.0) WRITE (9) TEMP_USER, - & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX)R - END DO - - CLOSE (UNIT=10,STATUS='DELETE') - - CLOSE (UNIT=9)S - - RETURNN - END - - - SUBROUTINE ERROR_AND_EXIT - - IMPLICIT INTEGER (A-Z)R - I - CALL ERRSNS(IDUMMY,IER) - CALL SYS_GETMSG(IER) - CALL ENABLE_CTRL_EXIT - - RETURN - END - - - - - SUBROUTINE COPY_ACL(INFILE,OUTFILE) -CE -C SUBROUTINE COPY_ACL -CM -C FUNCTION: -C Copy ACLs from one file to another fileH -C - IMPLICIT INTEGER (A-Z)R - - INCLUDE '($ACLDEF)' - - CHARACTER*(*) INFILE,OUTFILEN - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))S - ! Get length needed to store acl outputS - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) - - CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR) ! Create character string to - CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store aclO - - CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH) - ! Pass location of stringG - CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR) - - RETURND - END - - - SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH) -CE -C SUBROUTINE COPY_ACL1R -C. -C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines -C since must convert location of string into a character string. -CD - IMPLICIT INTEGER (A-Z)R - - INCLUDE '($ACLDEF)' - - CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,)L - ! Read input file acl - - IF (.NOT.IER) THENS - IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,) - IF (.NOT.IER) RETURN - ACLLENGTH = ACL$S_ADDACLENTL - CTXT = 0 - DO WHILE (IER) - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,S - & %LOC(ACLENT))O - CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlistI - IER = SYS$CHANGE_ACLC - & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT)) - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST) - & ,,,CTXT,,) - CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS) - IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has - ! (and must) be applied firstE - END DO - RETURN - END IFO - - CALL INIT_ITMLST ! Initialize item list - - POINT = 1 - DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output fileY - CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT,_ - & %LOC(ACLENT(POINT:))) - POINT = POINT + ICHAR(ACLENT(POINT:POINT)) - END DO= - - CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist - IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,) - - RETURNE - END - - - - - SUBROUTINE CHECK_DIR_ACCESS() - - IMPLICIT INTEGER (A-Z)L - - INCLUDE 'BULLFILES.INC'F - - CHARACTER*80 TEST,TEST1 - - DATA CHECKED /.FALSE./C - - IF (CHECKED) RETURN - - CHECKED = .TRUE.E - - IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN - IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1) - IF (IER) IER = TEST.NE.TEST1 - IF (IER) THEN - TEST1 = BULLNEWS_FILE - CALL ADD_DIRECTORY(BULLNEWS_FILE) - C = 0 - IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C)I - BULLNEWS_FILE = TEST1 - END IF - IF (.NOT.IER) THEN - TEST1 = FOLDER_DIRECTORY - FOLDER_DIRECTORY = TEST - END IF - CALL ADD_DIRECTORY(BULLNEWS_FILE)b - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - IF (.NOT.IER) FOLDER_DIRECTORY = TEST1 - ELSE. - CALL ADD_DIRECTORY(BULLNEWS_FILE)T - CALL ADD_DIRECTORY(BULLNEWSDIR_FILE) - END IF - - CALL CHECK_DIR(FOLDER_DIRECTORY)i - CALL CHECK_DIR(NEWS_DIRECTORY)A - - CALL ADD_DIRECTORIES) - - RETURN - END! - t - - - SUBROUTINE ADD_DIRECTORIESS - - INCLUDE 'BULLFILES.INC'A - - CALL ADD_DIRECTORY(BULLUSER_FILE) - CALL ADD_DIRECTORY(BULLFOLDER_FILE) - CALL ADD_DIRECTORY(BULLINF_FILE) - - RETURNT - END - - - - SUBROUTINE CHECK_DIR(DIRECTORY) - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) DIRECTORY - - CHARACTER*80 TEST,TEST1 - - IF (.NOT.SYS_TRNLNM_SYSTEM(DIRECTORY,TEST)) RETURN_ - - CALL SYS_TRNLNM(DIRECTORY,TEST1)C - IER = 1 - DO WHILE (TEST.NE.TEST1.AND.IER) - IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST) - END DOL - - IF (TEST.NE.TEST1) THEN - IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':' - CALL DISABLE_PRIVS - OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))// - & 'BULL.SCR',STATUS='NEW',IOSTAT=IER) - CLOSE(UNIT=3,STATUS='DELETE')( - CALL ENABLE_PRIVS - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No access to directory: '',A)')C - & TEST1(:TRIM(TEST1)) - CALL EXIT - END IF - DIRECTORY = TEST1C - ELSEQ - IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':' - DIRECTORY = TEST - END IFE - - RETURNN - END - - - - - SUBROUTINE ADD_DIRECTORY(DIRECTORY) - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) DIRECTORY - - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:)) - DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:)S - IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY - & = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':'T - DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) - & //DIRECTORY - - RETURNA - END diff --git a/decus/vax92b/bulletin/bulletin7.for b/decus/vax92b/bulletin/bulletin7.for deleted file mode 100644 index 184bb57..0000000 --- a/decus/vax92b/bulletin/bulletin7.for +++ /dev/null @@ -1,2232 +0,0 @@ -C -C BULLETIN7.FOR, Version 1/15/93 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE UPDATE_LOGIN(ADD_BULL) -C -C SUBROUTINE UPDATE_LOGIN -C -C FUNCTION: Updates the login file when a bulletin has been deleted -C or added. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($SSDEF)' - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2) - - IF (FOLDER_NUMBER.GE.1000) GO TO 1000 - -C -C We want to keep the last read date for comparison when selecting new -C folders, so save it for later restoring. -C - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2) - - CALL OPEN_BULLUSER_SHARED - -C -C Newest date/time in user file only applies to general bulletins. -C This was present before adding folder capability. -C We set flags in user entry to show new folder added for folder bulletins. -C However, the newest bulletin for each folder is not continually updated, -C As it is only used when comparing to the last bulletin read time, and to -C store this for each folder would be too expensive. -C - - TEMP_BTIM(1) = NEWEST_BTIM(1) - TEMP_BTIM(2) = NEWEST_BTIM(2) - CALL READ_USER_FILE_HEADER(IER) - NEWEST_BTIM(1) = TEMP_BTIM(1) - NEWEST_BTIM(2) = TEMP_BTIM(2) - - IF (IER.NE.0) THEN - CALL CLOSE_BULLUSER - RETURN - ELSE IF (FOLDER_NUMBER.EQ.0) THEN - CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM) - REWRITE (4,IOSTAT=IER) USER_HEADER - END IF - -1000 BROAD_MSG = .FALSE. - IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added? - IF (INCMD(:3).NE.'ADD') THEN - BROAD_MSG = .TRUE. - ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN - BROAD_MSG = .TRUE. - END IF - END IF - - IF (BROAD_MSG) THEN - IF (BTEST(FOLDER_FLAG,0)) THEN ! Folder protected? - CALL CHKACL - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) - IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN - CHECK_ACL = 0 - ELSE - CHECK_ACL = 1 - END IF - ELSE - CHECK_ACL = 0 - END IF - - CALL NOTIFY_USERS(CHECK_ACL) - END IF - - IF (FOLDER_NUMBER.GE.1000) RETURN - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) - ! Reobtain present values as calling programs still uses them - - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - - CALL CLOSE_BULLUSER - - RETURN - - END - - - - - SUBROUTINE NOTIFY_USERS(CHECK_ACL) -C -C SUBROUTINE NOTIFY_USERS -C -C FUNCTION: Notify users with SET NOTIFY set of new message. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE '($BRKDEF)' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER OUTPUT*160,TERMINAL*8,FLAGS*4 - CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME - CHARACTER NEWS_ACCESS*132 - - INTEGER SAVE_LAST_NEWS_READ(2,FOLDER_MAX) - - PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7) - - DATA FIRST/.TRUE./, BROAD1_USER_QUEUE/0/, TEMP_USER_QUEUE/0/ - - OUTPUT = BELL//CR//LF//LF// - & 'New bulletin added to folder '//FOLDER_NAME(: - & TRIM(FOLDER_NAME)) - & //'. From: '//FROM(:TRIM(FROM))//CR//LF// - & 'Description: '//DESCRIP(:TRIM(DESCRIP)) - - IF (FIRST) THEN - IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS) - IF (.NOT.IER) THEN - IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS) - END IF - - BFLAG = 0 - READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG - IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER - FIRST = .FALSE. - FOLDER1_NAME = ' ' - END IF - - CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast - - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - IF (FOLDER1_NAME.EQ.FOLDER_NAME) THEN - DO WHILE (1) - CALL READ_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - IF (TEMP_USERNAME.EQ.'*') THEN - CALL SYS$SETRWM(%VAL(0)) - RETURN - ELSE - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - END IF - END DO - END IF - - IF (REMOTE_SET.EQ.4) THEN - CALL OPEN_BULLINF_SHARED - CALL LIB$MOVC3(4*2*FOLDER_MAX,LAST_NEWS_READ, - & SAVE_LAST_NEWS_READ) - END IF - - CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME) - CALL INIT_QUEUE(BROAD1_USER_QUEUE,TEMP_USERNAME) - WRITE_TEMP_QUEUE = TEMP_USER_QUEUE - BROAD_USER_QUEUE = BROAD1_USER_QUEUE - - DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL)) - READ_TEMP_QUEUE = TEMP_USER_QUEUE - SENT_TEMP_USER = ' ' - DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND. - & READ_TEMP_QUEUE.NE.WRITE_TEMP_QUEUE) - CALL READ_QUEUE(%VAL(READ_TEMP_QUEUE),READ_TEMP_QUEUE, - & SENT_TEMP_USER) - END DO - IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL READ_NEWS_USERINFO(TEMP_USERNAME,IER) - ELSE - CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER) - END IF - CALL WRITE_QUEUE(%VAL(WRITE_TEMP_QUEUE),WRITE_TEMP_QUEUE, - & TEMP_USERNAME) - ELSE - IER = 2 - END IF - IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND. - & TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THEN - IF (CHECK_ACL) THEN - IF (REMOTE_SET.EQ.4) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & TEMP_USERNAME,IER,WRITE_ACCESS) - ELSE - CALL CHECK_ACCESS - & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & TEMP_USERNAME,IER,WRITE_ACCESS) - END IF - ELSE - IER = 1 - END IF - IF (IER) THEN - CALL SYS$BRKTHRU(,OUTPUT(:TRIM(OUTPUT))//CR, - & TEMP_USERNAME(:TRIM(TEMP_USERNAME)), - & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,%VAL(5),,) - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE), - & BROAD_USER_QUEUE,TEMP_USERNAME) - ELSE IF (REMOTE_SET.LT.3) THEN - CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:) - END IF - END IF - END DO - CALL SYS$SETRWM(%VAL(0)) - - IF (REMOTE_SET.EQ.4) THEN - CALL CLOSE_BULLINF - CALL LIB$MOVC3(4*2*FOLDER_MAX,SAVE_LAST_NEWS_READ, - & LAST_NEWS_READ) - END IF - - FOLDER1_NAME = FOLDER_NAME - - TEMP_USERNAME = '*' - CALL WRITE_QUEUE(%VAL(BROAD_USER_QUEUE),BROAD_USER_QUEUE, - & TEMP_USERNAME) - - RETURN - END - - - - - - SUBROUTINE ADD_ENTRY -C -C SUBROUTINE ADD_ENTRY -C -C FUNCTION: Enters a new directory entry in the directory file. -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER TODAY_TIME*32 - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (REMOTE_SET) THEN - LOCAL = .TRUE. - IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL') - IF (LOCAL) THEN - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0 - ELSE - WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER) - & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'), - & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'), - & CLI$PRESENT('CLUSTER') - END IF - IF (IER.EQ.0) THEN - READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM - END IF - IF (IER.EQ.0) THEN - IF (I.EQ.LEN(FOLDER1_COM)) THEN - IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,) - NEWEST_DATE = TODAY_TIME(:11) - NEWEST_TIME = TODAY_TIME(13:23) - NBULL = F1_NBULL - CALL UPDATE_FOLDER - ELSE - WRITE (6,'(1X,A)') FOLDER1_COM(:I) - END IF - ELSE - CALL DISCONNECT_REMOTE - IF (INCMD(:4).EQ.'MOVE') CALL EXIT - END IF - CALL UPDATE_LOGIN(.TRUE.) - RETURN - END IF - - CALL READDIR(0,IER) - - IF (IER.NE.1) THEN - NEWEST_EXDATE = '5-NOV-2056' - NEWEST_EXTIME = '00:00:00.00'e - NEWEST_DATE = '5-NOV-1956' - NEWEST_TIME = '00:00:00.00' - NBULL = 0. - IF (REMOTE_SET.NE.4) NBLOCK = 0m - SHUTDOWN = 0 - NEMPTY = 0 - END IFE - - IF (.NOT.NEW_DATE) THEN - DIFF = COMPARE_DATE(NEWEST_DATE,DATE)a - IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_TIME,TIME) - END IF - IF (DIFF.GE.0) NEW_DATE = .TRUE. - END IFC - - CALL SYS$ASCTIM(,TODAY_TIME,,)U - DATE = TODAY_TIME(:11)E - TIME = TODAY_TIME(13:23)M - - NEWEST_DATE = DATET - NEWEST_TIME = TIMEN - - IF (.NOT.BTEST(FOLDER_FLAG,13)) THENI - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE)W - IF (DIFF.GT.0) THENe - NEWEST_EXDATE = EXDATEe - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - END IFs - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - CALL UPDATE_LOGIN(.TRUE.) - - IF (REMOTE_SET.EQ.4) THEN - BLOCK = NBLOCK - LENGTHt - CALL WRITEDIR(NEWS_F_END+1,IER)i - ELSEu - BLOCK = NBLOCK + 1 - CALL WRITEDIR(NBULL+1,IER) - END IFi - - IF (IER.NE.0) RETURNs - - IF (REMOTE_SET.EQ.4) THEN - NEWS_F_END = NEWS_F_END + 1_ - NBULL = NEWS_F_END_ - F_NBULL = NEWS_F_END - ELSEE - NBULL = NBULL + 1) - NBLOCK = NBLOCK + LENGTH) - END IF_ - - CALL WRITEDIR(0,IER) - - IF (BTEST(FOLDER_FLAG,13)) THEN - CALL READ_FIRST_EXPIRED(NDEL)R - DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND.' - & COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0)= - IF (LENGTH.GT.0) CALL DUMP_MESSAGE()= - DELETE (UNIT=2) - CALL READ_FIRST_EXPIRED(NDEL) - END DO - CALL OPEN_BULLNEWS_SHARED - CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER) - FOLDER_FLAG = IBCLR(FOLDER_FLAG,13). - CALL REWRITE_FOLDER_FILE(IER) - CALL CLOSE_BULLNEWS( - END IFD - - RETURN - END - - - - - INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2)L -C_ -C FUNCTION COMPARE_BTIM -CU -C FUCTION: Compares times in binary format to see which is farther in future. -C_ -C INPUTS: -C BTIM1 - First time in binary format -C BTIM2 - Second time in binary format -C OUTPUT: -C Returns +1 if first time is farther in future -C Returns -1 if second time is farther in future -C Returns 0 if equal timeM -CE - IMPLICIT INTEGER (A - Z)l - - DIMENSION BTIM1(2),BTIM2(2),DIFF(2) - - CALL LIB$SUBX(BTIM1,BTIM2,DIFF) - - IF (DIFF(2).LT.0) THENI - COMPARE_BTIM = -1S - ELSE IF (DIFF(2).GE.0) THEN - COMPARE_BTIM = +1O - END IFS - - RETURN - END - - - - - - INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1) -C -C FUNCTION MINUTE_DIFFw -Cs -C FUNCTION: Finds difference in minutes between 2 binary times. -C -CI - IMPLICIT INTEGER (A-Z)I - - DIMENSION DATE1(2),DATE2(2) - - CALL LIB$DAY(DAYS1,DATE1,MSECS1)O - CALL LIB$DAY(DAYS2,DATE2,MSECS2)A - - MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000_ - - RETURNS - END - - - - - - N - INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2)D -CF -C FUNCTION COMPARE_DATE -CH -C FUCTION: Compares dates to see which is farther in future._ -CR -C INPUTS: -C DATE1 - First date (dd-mm-yy) -C DATE2 - Second date (If is equal to ' ', then use present date): -C OUTPUT: -C Returns the difference in days between the two dates./ -C If the DATE1 is farther in the future, the output is positive, -C else it is negative. -CY - IMPLICIT INTEGER (A - Z)' - - CHARACTER*(*) DATE1,DATE2 - INTEGER USER_TIME(2)N - - CALL SYS_BINTIM(DATE1,USER_TIME)N - - CALL VERIFY_DATE(USER_TIME) -CL -C LIB$DAY crashes if date invalid, which happened once due to an unknown -C hardware or software error which created a date very far in the future. -CL - CALL LIB$DAY(DAY1,USER_TIME)w - - IF (DATE2.NE.' ') THENC - CALL SYS_BINTIM(DATE2,USER_TIME) - CALL VERIFY_DATE(USER_TIME)R - ELSEE - CALL SYS$GETTIM(USER_TIME) - END IFE - - CALL LIB$DAY(DAY2,USER_TIME) - - COMPARE_DATE = DAY1 - DAY2R - - RETURNA - END - - - - SUBROUTINE VERIFY_DATE(BTIM) - - IMPLICIT INTEGER (A-Z)E - - DIMENSION BTIM(2),TEMP(2) - - CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.GT.0) THEN ! Date invalidR - BTIM(1) = TEMP(1)E - BTIM(2) = TEMP(2)$ - END IFE - - CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP) - - IER = COMPARE_BTIM(BTIM,TEMP) - - IF (IER.LT.0) THEN ! Date invalidD - BTIM(1) = TEMP(1)O - BTIM(2) = TEMP(2)_ - END IF, - - RETURN - END - - - - INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2)S -CQ -C FUNCTION COMPARE_TIME -CN -C FUCTION: Compares times to see which is farther in future. -CP -C INPUTS: -C TIME1 - First time (hh:mm:ss.xx) -C TIME2 - Second time( -C OUTPUT: -C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further -C in the future, outputs positive number, else negative. -C. - - IMPLICIT INTEGER (A-Z)U - CHARACTER*(*) TIME1,TIME2 - CHARACTER*24 TODAY_TIME - CHARACTER*12 TEMP2P - - IF (TIME2.EQ.' ') THENM - CALL SYS$ASCTIM(,TODAY_TIME,,) - TEMP2 = TODAY_TIME(13:23) - ELSE - TEMP2 = TIME2S - END IFT - - COMPARE_TIME = 3600*10*(ICHAR(TIME1(:1))-ICHAR(TEMP2(:1))) - & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2))) - & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4))) - & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5))) - & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7))) - & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8))) - - IF (COMPARE_TIME.EQ.0) THEN - COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10)))L - & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11))) - IF (COMPARE_TIME.GT.0) THENA - COMPARE_TIME = 1 - ELSE IF (COMPARE_TIME.LT.0) THEN - COMPARE_TIME = -1 - END IF - END IFL - - RETURN - END - -C------------------------------------------------------------------------- -C -C The following are subroutines to create a linked-list queue for P -C temporary buffer storage of data that is read from files to be -C outputted to the terminal. This is done so as to be able to close -C the file as soon as possible. -C -C Each record in the queue has the following format. The first two -C words are used for creating a character variable. The first word -C contains the length of the character variable, the second contains -C the address. The address is simply the address of the 3rd word ofE -C the record. The last word in the record contains the address of the* -C next record. Every time a record is written, if that record has aN -C zero link, it adds a new record for the next write operation. -C Therefore, there will always be an extra record in the queue. To -C check for the end of the queue, the last word (link to next record) -C is checked to see if it is zero. -CT -C------------------------------------------------------------------------- - SUBROUTINE INIT_QUEUE(HEADER,DATA)N - CHARACTER*(*) DATAO - INTEGER HEADERM - IF (HEADER.NE.0) RETURN ! Queue already initializedT - LENGTH = LEN(DATA)C - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - CALL LIB$GET_VM(LENGTH+12,HEADER) - CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH) - RETURN - END - - - SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA)I - INTEGER RECORD(1) - CHARACTER*(*) DATAI - LENGTH = RECORD(1) - CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD)))E - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4)L - IF (NEXT.NE.0) RETURN - CALL LIB$GET_VM(LENGTH+12,NEXT) - CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH) - RECORD((LENGTH+12)/4) = NEXTR - RETURNR - END - - SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA) - CHARACTER*(*) DATA_ - INTEGER RECORD(1) - LENGTH = RECORD(1)O - CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) - IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4) - NEXT = RECORD((LENGTH+12)/4) - RETURNA - END - - SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR) - CHARACTER*(*) INCHAR,OUTCHAR - OUTCHAR = INCHAR(:LENGTH) - RETURN - END - - SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN) - IMPLICIT INTEGER (A-Z). - DIMENSION IARRAY(1) - IARRAY(1) = CHAR_LENE - IARRAY(2) = %LOC(IARRAY(3)) - IARRAY(REAL_LEN/4+3) = 05 - RETURNE - END - - - - SUBROUTINE DISABLE_PRIVST -CT -C SUBROUTINE DISABLE_PRIVST -C -C FUNCTION: Disable image high privileges.O -CS - - IMPLICIT INTEGER (A-Z)H - - INCLUDE '($PRVDEF)' - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - DATA PRV_DEPTH /0/E - - COMMON /REALPROC/ REALPROCPRIV(2) - - PRV_DEPTH = PRV_DEPTH + 1 - - IF (PRV_DEPTH.GT.1) RETURNF - - CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges, - - SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1)O - - CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs - - RETURNO - END - - - - SUBROUTINE ENABLE_PRIVS -C= -C SUBROUTINE ENABLE_PRIVS -CA -C FUNCTION: Enable image high privileges. -CX - - IMPLICIT INTEGER (A-Z)S - - COMMON /PRIVS/ SETPRV,PRV_DEPTH - DIMENSION SETPRV(2) - - PRV_DEPTH = PRV_DEPTH - 1 - - IF (PRV_DEPTH.GT.1) RETURN0 - - CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privsT - - RETURNQ - END - - - - SUBROUTINE CHECK_PRIV_IO(ERROR) -CO -C SUBROUTINE CHECK_PRIV_IOT -C -C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need -C privileges to output to. -C- - - IMPLICIT INTEGER (A-Z)( - - CALL DISABLE_PRIVS ! Disable SYSPRV O - - OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW') - CLOSE (UNIT=6,STATUS='DELETE'). - - OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW') - IF (IER.NE.0.OR.IER1.NE.0) THEN - IF (IER1.EQ.0) WRITE (4,100) - IF (IER.EQ.0) WRITE (6,200)N - ERROR = 1 - ELSE - CLOSE (UNIT=4,STATUS='DELETE') - ERROR = 0N - END IF - - CALL ENABLE_PRIVS ! Enable SYSPRV I - -100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.') -200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')N - - RETURNA - END - - - SUBROUTINE CHANGE_FLAG(CMD,FLAG) -C -C SUBROUTINE CHANGE_FLAGD -CE -C FUNCTION: Sets flags for specified folder. -C -C INPUTS: -C CMD - LOGICAL*4 value. If TRUE, set flag. -C If FALSE, clear flag. -C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG -C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG -CO - IMPLICIT INTEGER (A - Z)_ - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC't - - INCLUDE 'BULLFOLDER.INC'w - - COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG) - - DIMENSION FLAGS(FLONG,4)y - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))n - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - - DATA CHANGE_FOLDER /.FALSE./n - - IF (CLI$PRESENT('FOLDER')) THEN - IER = CLI$GET_VALUE('FOLDER',FOLDER1)I - IF (IER) THENl - FOLDER_NUMBER_SAVE = FOLDER_NUMBER - CALL OPEN_BULLFOLDER_SHARED - CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: No such folder found.'')')A - RETURN - ELSE IF (INDEX(FOLDER1,'.').GT.0.OR.s - & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')')A - RETURN - END IF$ - END IF - FOLDER_NUMBER = FOLDER1_NUMBER - CHANGE_FOLDER = .TRUE. - ELSE IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command not valid for folder.'')') - RETURN - END IFE - -C -C Find user entry in BULLUSER.DAT to update information.e -C - - ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG) - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1) - READ_BTIM_SAVE(2) = READ_BTIM(2)i - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entrye - - IF (IER.GT.0) THEN ! No entry (how did this happen??) - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today2 - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry - CALL READ_USER_FILE_HEADER(IER)Y - IF (CMD) THENv - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER) - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER) - END IF - NEW_FLAG(1) = 143A - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER)B - ELSEA - IF (CMD) THEN - CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)S - ELSE - CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)_ - END IF - NEW_FLAG(1) = 143Y - REWRITE (4,IOSTAT=IER) USER_ENTRY - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN - DO WHILE (REC_LOCK(IER)) - READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE - END DO - - IF (IER.NE.0) THEN - DO I=1,FLONG0 - NOTIFY_REMOTE(I) = 0 - END DOI - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - ELSE - CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER) - REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE - END IF - END IFh - - CALL CLOSE_BULLUSER - - IF (CHANGE_FOLDER) THEN - FOLDER_NUMBER = FOLDER_NUMBER_SAVE - CHANGE_FOLDER = .FALSE.M - END IF - - RETURN - - END - - - - - SUBROUTINE SET_VERSIONr -Co -C SUBROUTINE SET_VERSIONe -Cg -C FUNCTION: Sets version number.Z -C - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFOLDER.INC'L - - DIMENSION FLAGS(FLONG,4) - EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1)) - - LOGICAL CMD - - DIMENSION READ_BTIM_SAVE(2) - -C* -C Find user entry in BULLUSER.DAT to update information.0 -CC - - CALL OPEN_BULLUSER_SHARED ! Open user file - - READ_BTIM_SAVE(1) = READ_BTIM(1)E - READ_BTIM_SAVE(2) = READ_BTIM(2)( - - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entryC - - IF (IER.EQ.0) THENE - NEW_FLAG(1) = 143 - REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entryE - READ_BTIM(1) = READ_BTIM_SAVE(1) - READ_BTIM(2) = READ_BTIM_SAVE(2) - END IF - - CALL CLOSE_FILE (4) - RETURN1 - - END - - - - - - SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE) -CT -C SUBROUTINE CHECK_NEWUSERE -CM -C FUNCTION: Checks flags for a new: Whether DISMAIL is set, -C and what the last password change was.- -C- -C INPUTS: -C USERNAME - Username- -C OUTPUTS: -C DISMAIL - Returns 1 if account has DISMAIL. -C returns 0 if account has no DISMAIL. -C PASSCHANGE - Date of last password change. -C - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) USERNAME - - INTEGER PASSCHANGE(2) - - INCLUDE '($UAIDEF)' - - CALL INIT_ITMLSTh - CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS)) - CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE)) - CALL END_ITMLST(GETUAI_ITMLST)h - - DISMAIL = 0 ! Set return falsen - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record - IF (IER) THEN ! If username found - IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET? - DISMAIL = 1 ! Yepe - END IF - END IF - - RETURN ! Return - END ! Endt - - - - INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT) - - IMPLICIT INTEGER (A-Z)d - - CHARACTER*(*) INPUT,OUTPUTr - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))E - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlistI - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:EINPUT),,) - & %VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN)E - - RETURNB - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM_INDEX(INPUT,OUTPUT)( - - IMPLICIT INTEGER (A-Z)1 - - CHARACTER*(*) INPUT,OUTPUT, - - PARAMETER LNM$_STRING = '2'X - PARAMETER LNM$_INDEX = '1'X - PARAMETER LNM$_MAX_INDEX = '7'X - - DATA NINDEX /0/ - - IF (MAX_INDEX.LT.NINDEX) THEN - NINDEX = 0 - SYS_TRNLNM_SYSTEM_INDEX = 0( - RETURN - END IFL - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - IF (NINDEX.EQ.0) THEN _ - CALL INIT_ITMLST ! Initialize item listC - CALL ADD_2_ITMLST(4,LNM$_MAX_INDEX,%LOC(MAX_INDEX))L - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - IF (.NOT.SYS_TRNLNM_SYSTEM_INDEX) RETURN - END IFD - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,LNM$_INDEX,%LOC(NINDEX))I - CALL ADD_2_ITMLST_WITH_RETE - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))5 - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlistS - - SYS_TRNLNM_SYSTEM_INDEX = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM_INDEX) OUTPUT = OUTPUT(:OLEN) - NINDEX = NINDEX + 1T - - RETURND - END - - - - - INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT)D - - IMPLICIT INTEGER (A-Z) - - CHARACTER*(*) INPUT,OUTPUTL - - PARAMETER LNM$_STRING = '2'X - - CALL INIT_ITMLST ! Initialize item list - IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET - & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))T - CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlistN - - EINPUT = INDEX(INPUT,':') - 1 - IF (EINPUT.LE.0) EINPUT = TRIM(INPUT) - - SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM', - & INPUT(:EINPUT),,%VAL(TRNLNM_ITMLST)) - - IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN - OUTPUT = OUTPUT(:OLEN) - END IFE - - RETURNS - END - - - - - INTEGER FUNCTION FILE_LOCK(IER,IER1)C - - IMPLICIT INTEGER (A-Z): - - INCLUDE '($RMSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THENt - FILE_LOCK = 1 - INIT = .FALSE. - ELSE - IF (IER.GT.0) THEN - CALL ERRSNS(IDUMMY,IER1), - IF (IER1.EQ.RMS$_FLK) THEN= - FILE_LOCK = 1A - CALL WAIT_SEC('01') - ELSE' - FILE_LOCK = 0A - INIT = .TRUE.. - END IFH - ELSE - FILE_LOCK = 0 - IER1 = 0. - INIT = .TRUE. - END IF - END IF - - RETURN - END - - - - SUBROUTINE ENABLE_CTRL - - IMPLICIT INTEGER (A-Z)E - - COMMON /CTRLY/ CTRLYI - - COMMON /CTRL_LEVEL/ LEVEL - - COMMON /DEF_PROT/ ORIGINAL_DEF_PROT - - COMMON /KEYPAD/ KEYPAD_MODEN - - QUIT = 1 - - ENTRY ENABLE_CTRL_EXITE - - QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0 - IF (QUIT.EQ.1) LEVEL = LEVEL - 1 - - IF (LEVEL.LT.0.AND.QUIT.EQ.1) THENL - WRITE (6,'('' ERROR: Error in CTRL.'')') - END IFl - - IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN - CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -CF - END IFo - - IF (QUIT.EQ.0) THEN - IF (KEYPAD_MODE.EQ.0) THEN - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,)' - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1)R - END IF - CALL CLOSE_TAG - CALL UPDATE_USERINFO - CALL PRINT_NOW - CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,) - CALL EXITT - END IFF - QUIT = 0 ! Reinitialize - - RETURNO - END - - - SUBROUTINE DISABLE_CTRL - - IMPLICIT INTEGER (A-Z)F - - COMMON /CTRLY/ CTRLYE - - COMMON /CTRL_LEVEL/ LEVEL - DATA LEVEL /0/N - - IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,) - LEVEL = LEVEL + 1 - - RETURN - END - - - - - SUBROUTINE CLEANUP_BULLFILE -CE -C SUBROUTINE CLEANUP_BULLFILE -CN -C FUNCTION: Searches for empty space in bulletin file and deletes it.R -C. - IMPLICIT INTEGER (A - Z)D - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'd - - CHARACTER FILENAME*132,BUFFER*128 - - CALL OPEN_BULLDIR_SHARED - -CF -C NOTE: Can't use READDIR for reading header since it'll spawn a -C BULL/CLEANUP. (Fooey). -C - - DO WHILE (REC_LOCK(IER))a - READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADERF - END DOe - - IF (NEMPTY.EQ.0) THEN ! No cleanup necessary - CALL CLOSE_BULLDIR - RETURN - ELSE IF (NEMPTY.GT.0) THENH - - CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) - ! Set protection to (SYSTEM:RWED,OWNER:RWED,,) - - OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE', - 1 RECORDTYPE='FIXED',RECORDSIZE=32, - 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512) - ! Compressed version is number 1 - - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER)) - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSEE - CALL SYS_GETMSG(IER1)A - END IFB - CALL CLOSE_BULLDIRL - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURN - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL') - - CALL OPEN_BULLFIL_SHARED ! Open bulletin file - - NBLOCK = 0 - - DO I=1,NBULL ! Copy bulletins to new file - CALL READDIR(I,IER)) - ICOUNT = BLOCK - DO J=1,LENGTH - NBLOCK = NBLOCK + 1 - DO WHILE (REC_LOCK(IER1)) - READ(1'ICOUNT,IOSTAT=IER1) BUFFERE - END DOE - IF (IER1.NE.0) THEN ! This file is corrupt - NBLOCK = NBLOCK - 1 - NBULL = I - 1 - GO TO 100E - END IF - WRITE(11) BUFFERT - ICOUNT = ICOUNT + 1 - END DO - END DO - -100 CALL CLOSE_BULLFILS - ELSE IF (NEMPTY.EQ.-1) THEN - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR',U - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1R - DO WHILE (IER) - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.BULLDIR;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - RETURN - END IFU - - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',= - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,_ - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',C - & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 ) - - IF (IER.NE.0) THEN: - OPEN (UNIT=12,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',E - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,o - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - IF (IER.NE.0) THENT - WRITE (6,'('' Cannot open temporary file for'' - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER))U - CALL ERRSNS(IDUMMY,IER)_ - IF (IER1.EQ.0) THEN( - WRITE (6,'('' IOSTAT error = '',I)') IERS - ELSE - CALL SYS_GETMSG(IER1) - END IF - CLOSE (UNIT=11)R - CALL CLOSE_BULLDIR - CALL SYS$SETDFPROT(CUR_DEF_PROT,), - RETURN - END IFL - END IF - - CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR', - & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR') - - NEMPTY = 0U - WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header - - NBLOCK = 0 ! Update directory entry pointers - DO I=1,NBULLt - CALL READDIR(I,IER)T - BLOCK = NBLOCK + 1 - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)U - WRITE (12,IOSTAT=IER) BULLDIR_ENTRY - IF (IER.NE.0) THEN - WRITE (6,'('' Cannot write to temporary file for'', - & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER))S - CALL ERRSNS(IDUMMY,IER) - IF (IER1.EQ.0) THEN - WRITE (6,'('' IOSTAT error = '',I)') IER - ELSED - CALL SYS_GETMSG(IER1)T - END IF - CLOSE (UNIT=12) - CLOSE (UNIT=11) - CALL CLOSE_BULLDIRN - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - RETURNA - END IF - NBLOCK = NBLOCK + MAX(LENGTH,0) - END DOP - - CLOSE (UNIT=12,STATUS='KEEP') - CLOSE (UNIT=11,STATUS='KEEP') - - CALL CLOSE_BULLDIR - CALL OPEN_BULLDIR ! Open with no sharing( - - NEMPTY = -1 ! Copying done, indicate that in case of crash - WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory headerA - - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL', - & '*.BULLFIL') - IER = 1 - DO WHILE (IER)L - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//I - & '.BULLFIL;-1') - END DO - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR', - & '*.BULLDIR') - CALL CLOSE_BULLDIR_DELETE - IER = 1 - DO WHILE (IER)L - IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//T - & '.BULLDIR;-1') - END DOM - IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*', - & '*.*;1') - - CALL SYS$SETDFPROT(CUR_DEF_PROT,) - - RETURN' - END - - - - - SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)) -C -C SUBROUTINE CLEANUP_DIRFILEU -CT -C FUNCTION: Reorder directory file after deletions.E -C Is called either directly after a deletion, or isT -C called if it is detected that a deletion was not fully -C completed due to the fact that the deleting process -C was abnormally terminated. -CE - IMPLICIT INTEGER (A - Z)I - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVEd - - CHARACTER*12 DATE_SAVE,EXDATE_SAVEN - CHARACTER*12 TIME_SAVE,EXTIME_SAVET - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRYS - DATE_SAVE = DATET - TIME_SAVE = TIME( - EXDATE_SAVE = EXDATET - EXTIME_SAVE = EXTIMEN - - NBULL = -NBULL ! Negative # Bulls signals deletion in progress - MOVE_TO = 0 ! Moving directory entries starting here - MOVE_FROM = 0 ! Moving directory entries from here - I = DELETE_ENTRY ! Start search point for first deleted entries - DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL) - CALL READDIR(I,IER) - IF (IER.NE.I+1) THEN ! Have we found a deleted entry?L - MOVE_TO = I ! If so, start moving entries to here - J=I+1 ! Search for next entry in file - DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL) - CALL READDIR(J,IER) - IF (IER.EQ.J+1) MOVE_FROM = J - J = J + 1 - END DOR - IF (MOVE_FROM.EQ.0) THEN ! There are no more entries - NBULL = I - 1 ! so just update number of bulletins - CALL WRITEDIR(0,IER)O - RETURN_ - END IF - LENGTH = -LENGTH ! Indicate starting point by writing_ - CALL WRITEDIR(I,IER) ! next entry into deleted entry - FIRST_DELETE = I ! with negative lengthL - MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of - MOVE_TO = MOVE_TO + 1 ! the entries - ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion - FIRST_DELETE = I ! was previously in progressQ - J = I ! Try to find where entry came from - CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY) - ENTRY_Q = ENTRY_Q1 - DO K=J,NBULLG - CALL READDIR(K,IER) - IF (IER.EQ.K+1) THEN - CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - END IF - END DO - ENTRY_QLAST = ENTRY_Q - ENTRY_Q2 = ENTRY_Q1 - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST) - CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY) - ENTRY_Q2 = ENTRY_QL - BLOCK_SAVE = BLOCKT - MSG_NUM_SAVE = MSG_NUMT - DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST) - ! Search for duplicate entries - CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY) - IF (BLOCK_SAVE.EQ.BLOCK) THEN' - MOVE_TO = MSG_NUM_SAVE + 1E - MOVE_FROM = MSG_NUM + 1 - END IF - END DO - ! If no duplicate entry found for this - ! entry, see if one exists for anyt - END DO ! of the other entries - END IF - I = I + 1( - END DO - - IF (I.LE.NBULL) THEN ! Move reset of entries if necessaryE - IF (MOVE_FROM.GT.0) THEN - DO J=MOVE_FROM,NBULL - CALL READDIR(J,IER)E - IF (IER.EQ.J+1) THEN ! Skip any other deleted entries - CALL WRITEDIR(MOVE_TO,IER) - MOVE_TO = MOVE_TO + 1) - END IF( - END DOL - END IF - DO J=MOVE_TO,NBULL ! Delete empty records at end of fileT - CALL READDIR(J,IER) - DELETE(UNIT=2,IOSTAT=IER) - END DO - NBULL = MOVE_TO - 1 ! Update # bulletin count - END IF1 - - CALL READDIR(FIRST_DELETE,IER)i - IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN - LENGTH = -LENGTH ! Fix entry which has negative lengthn - CALL WRITEDIR(FIRST_DELETE,IER) - END IFS - - CALL WRITEDIR(0,IER)I - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVEO - DATE = DATE_SAVE) - TIME = TIME_SAVE - EXDATE = EXDATE_SAVEE - EXTIME = EXTIME_SAVE - - RETURN_ - END - - - SUBROUTINE SHOW_FLAGS -C_ -C SUBROUTINE SHOW_FLAGS -CN -C FUNCTION: Show user flags.F -C( - IMPLICIT INTEGER (A - Z)F - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'/ - - INCLUDE 'BULLFOLDER.INC'L - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (FOLDER_NUMBER.LT.0) THENi - WRITE (6,'('' ERROR: Cannot show flags for remote folder.'')') - RETURN - END IFN - -C -C Find user entry in BULLUSER.DAT to obtain flags. -C - IF (REMOTE_SET.LT.3) THEN - CALL OPEN_BULLUSER_SHARED ! Open user fileN - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry - ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN1 - WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') - RETURNU - END IF - - WRITE (6,'('' For the selected folder '',A)') - & FOLDER_NAME(:TRIM(FOLDER_NAME)) - - IF (TEST_SET_FLAG(FOLDER_NUMBER).AND. - & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THENE - WRITE (6,'('' READNEW is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND. - & TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' BRIEF is set.'')') - ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.L - & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN - WRITE (6,'('' SHOWNEW is set.'')') - ELSE IF (REMOTE_SET.NE.3.AND.TEST_NOTIFY_FLAG(FOLDER_NUMBER)) THENE - WRITE (6,'('' NOTIFY is set.'')')) - ELSEL - WRITE (6,'('' No flags are set.'')') - END IFE - - IF (REMOTE_SET.LT.3) CALL CLOSE_BULLUSER) - - RETURN - END - - - SUBROUTINE SET2(FLAG,NUMBER)N - - IMPLICIT INTEGER (A-Z)R - - INTEGER FLAG(2) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1))E - - RETURN - END - - - SUBROUTINE CLR2(FLAG,NUMBER), - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1))_ - - RETURNF - END - - - - LOGICAL FUNCTION TEST2(FLAG,NUMBER) - - IMPLICIT INTEGER (A-Z) - - INTEGER FLAG(3) - - F_POINT = NUMBER/32 + 1 - TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1)), - - RETURND - END - - - - - INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL)R -CC -C FUNCTION GETUSERS -CI -C FUNCTION: -C To get names of all users that are logged in.e -Cr - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($JPIDEF)' - -!*** MODULE $PSCANDEF ***D - PARAMETER pscan$_BEGIN = '00000000'X( - PARAMETER pscan$_ACCOUNT = '00000001'X - PARAMETER pscan$_AUTHPRI = '00000002'XL - PARAMETER pscan$_CURPRIV = '00000003'X - PARAMETER pscan$_GRP = '00000004'XE - PARAMETER pscan$_HW_MODEL = '00000005'X - PARAMETER pscan$_HW_NAME = '00000006'X - PARAMETER pscan$_JOBPRCCNT = '00000007'XM - PARAMETER pscan$_JOBTYPE = '00000008'X - PARAMETER pscan$_MASTER_PID = '00000009'X - PARAMETER pscan$_MEM = '0000000A'X= - PARAMETER pscan$_MODE = '0000000B'X - PARAMETER pscan$_NODE_CSID = '0000000C'Xn - PARAMETER pscan$_NODENAME = '0000000D'X D - PARAMETER pscan$_OWNER = '0000000E'X - PARAMETER pscan$_PRCCNT = '0000000F'X - PARAMETER pscan$_PRCNAM = '00000010'X - PARAMETER pscan$_PRI = '00000011'X, - PARAMETER pscan$_PRIB = '00000012'X - PARAMETER pscan$_STATE = '00000013'XO - PARAMETER pscan$_STS = '00000014'XS - PARAMETER pscan$_TERMINAL = '00000015'X - PARAMETER pscan$_UIC = '00000016'Xr - PARAMETER pscan$_USERNAME = '00000017'X - PARAMETER pscan$_GETJPI_BUFFER_SIZE = '00000018'X - PARAMETER pscan$_END = '00000019'X - PARAMETER pscan$k_type = '00000081'X$ - PARAMETER pscan$M_OR = '00000001'XR - PARAMETER pscan$M_BIT_ALL = '00000002'X - PARAMETER pscan$M_BIT_ANY = '00000004'X - PARAMETER pscan$M_GEQ = '00000008'X - PARAMETER pscan$M_GTR = '00000010'X - PARAMETER pscan$M_LEQ = '00000020'X - PARAMETER pscan$M_LSS = '00000040'X - PARAMETER pscan$M_PREFIX_MATCH = '00000080'X - PARAMETER pscan$M_WILDCARD = '00000100'XA - PARAMETER pscan$M_CASE_BLIND = '00000200'XF - PARAMETER pscan$M_EQL = '00000400'X - PARAMETER pscan$M_NEQ = '00000800'X - STRUCTURE /item_specific_flags/ - PARAMETER pscan$S_OR = 1 - PARAMETER pscan$V_OR = 0 - PARAMETER pscan$S_BIT_ALL = 1 - PARAMETER pscan$V_BIT_ALL = 1 - PARAMETER pscan$S_BIT_ANY = 1 - PARAMETER pscan$V_BIT_ANY = 2 - PARAMETER pscan$S_GEQ = 1 - PARAMETER pscan$V_GEQ = 3 - PARAMETER pscan$S_GTR = 1 - PARAMETER pscan$V_GTR = 4 - PARAMETER pscan$S_LEQ = 1 - PARAMETER pscan$V_LEQ = 5 - PARAMETER pscan$S_LSS = 1 - PARAMETER pscan$V_LSS = 6 - PARAMETER pscan$S_PREFIX_MATCH = 1) - PARAMETER pscan$V_PREFIX_MATCH = 7 - PARAMETER pscan$S_WILDCARD = 1a - PARAMETER pscan$V_WILDCARD = 8i - PARAMETER pscan$S_CASE_BLIND = 1 - PARAMETER pscan$V_CASE_BLIND = 9 - PARAMETER pscan$S_EQL = 1 - PARAMETER pscan$V_EQL = 10e - PARAMETER pscan$S_NEQ = 1 - PARAMETER pscan$V_NEQ = 11I - BYTE %FILL (2)Z - END STRUCTURE - - CHARACTER USERNAME*(*),TERMINAL*(*) - - DATA CONTEXT/0/ - - IF (CONTEXT.EQ.0) THEN - CALL INIT_ITMLST ! Initialize item listN - ! Now add items to listI - CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ) - CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE) - CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist - - IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST)) - END IFt - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listT - CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME)) - CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = 1 - TERMINAL(:1) = CHAR(0)e - DO WHILE (IER.AND.TERMINAL(:1).EQ.CHAR(0))x - ! Get next interactive process - IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,) - ! Get next process.J - END DOJ - - IF (.NOT.IER) CONTEXT = 0 - - GETUSERS = IERT - - RETURN - END - - - - - - SUBROUTINE OPEN_USERINFOo -Cs -C SUBROUTINE OPEN_USERINFO -CC -C FUNCTION: Opens the file in SYS$LOGIN which contains user information. -Cd - IMPLICIT INTEGER (A - Z)t - - INCLUDE 'BULLUSER.INC'I - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)t - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)M - DATA USERINFO_READ /.FALSE./L - - EQUIVALENCE (LAST_READ_BTIM(1,1),LAST(1,1)) - DIMENSION LAST(2,FOLDER_MAX)L - - INTEGER TODAY_BTIM(2) - - CALL OPEN_BULLINF_SHARED! - - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LASTT - - IF (IER.EQ.0) THEN ! Check to see if dates all in future - CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date - DO I=1,FOLDER_MAX - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM) - IF (DIFF.GE.0) THEN ! Must have been in a time wrap - LAST_READ_BTIM(1,I) = TODAY_BTIM(1) - LAST_READ_BTIM(2,I) = TODAY_BTIM(2) - END IFE - END DO - END IF2 - - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process? - & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user? - USERNAME = 'DECNET' - READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST - END IFV - - IF (IER.NE.0) THENL - OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD',_ - & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER) - INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE) - IF (IER.EQ.0) THEN - READ (10) - & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2)N - CLOSE (UNIT=10,STATUS='DELETE') - ELSE - CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT fileF - CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info - CALL CLOSE_BULLUSER - IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process? - CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date - CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) - CALL READ_USER_FILE_HEADER(IER) - NEW_FLAG(1) = 143 - NEW_FLAG(2) = 0 - CALL WRITE_USER_FILE_NEW(IER)d - END IFc - IF (IER.EQ.0) THEND - DO I=1,FOLDER_MAXI - LAST_READ_BTIM(1,I) = READ_BTIM(1)E - LAST_READ_BTIM(2,I) = READ_BTIM(2)n - END DO - END IFE - END IF - IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST - END IFT - - LU = TRIM(USERNAME) - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU))) - READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIMA - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU)))s - IF (IER1.NE.0) THEN - DO I=1,FOLDER_MAX - LAST_SYS_BTIM(1,I) = 0U - LAST_SYS_BTIM(2,I) = 0' - END DO - END IFC - - CALL READ_NEWS_USERINFO(USERNAME,IER) - - CALL CLOSE_BULLINFR - - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM(1,1) - & ,OLD_LAST_READ_BTIM) - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM)a - CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ)S - - USERINFO_READ = .TRUE. - - RETURN_ - END - - - - SUBROUTINE READ_NEWS_USERINFO(NAME,IER) -CF -C SUBROUTINE READ_NEWS_USERINFO -C- - IMPLICIT INTEGER (A - Z) - - INCLUDE 'BULLUSER.INC'u - - CHARACTER*(*) NAME - - LU = TRIM(NAME) - - NAME(LU:LU) = CHAR(128.OR.ICHAR(NAME(LU:LU))) - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(NAME(LU-1:LU-1))). - ELSE - NAME(2:2) = CHAR(128.OR.ICHAR(NAME(2:2)))T - END IF - READ (9,KEY=NAME,IOSTAT=IER) NAME,LAST_NEWS_READB - NAME(LU:LU) = CHAR(127.AND.ICHAR(NAME(LU:LU)))T - IF (LU.GT.1) THEN - NAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(NAME(LU-1:LU-1))) - ELSEI - NAME(2:2) = CHAR(127.AND.ICHAR(NAME(2:2))) - END IF_ - IF (IER.NE.0) THENT - DO I=1,FOLDER_MAX - LAST_NEWS_READ(1,I) = 0 - LAST_NEWS_READ(2,I) = 0 - END DO - END IFT - - RETURNR - END - - - - - SUBROUTINE UPDATE_USERINFO -CR -C SUBROUTINE UPDATE_USERINFO) -C -C FUNCTION: Updates the latest message read times for each folder. -C - IMPLICIT INTEGER (A - Z)U - - INCLUDE 'BULLUSER.INC' - - COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)) - COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) - COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)I - - EQUIVALENCE (LAST_READ_BTIM(1,1),LAST(1,1)) - DIMENSION LAST(2,FOLDER_MAX)_ - - IF (.NOT.USERINFO_READ) RETURN- - - DIFF = .FALSE. - FNUM = 1E - - DO WHILE (.NOT.DIFF.AND.FNUM.LE.FOLDER_MAX) - DIFF = LAST_READ_BTIM(1,FNUM).NE.OLD_LAST_READ_BTIM(1,FNUM)E - IF (.NOT.DIFF) THENF - DIFF = LAST_READ_BTIM(2,FNUM).NE.OLD_LAST_READ_BTIM(2,FNUM) - END IF - FNUM = FNUM + 1E - END DO - - DIFF1 = .FALSE. - FNUM = 1 - - DO WHILE (.NOT.DIFF1.AND.FNUM.LE.FOLDER_MAX)l - DIFF1 = LAST_SYS_BTIM(1,FNUM).NE.OLD_LAST_SYS_BTIM(1,FNUM) - IF (.NOT.DIFF1) THEN - DIFF1 = LAST_SYS_BTIM(2,FNUM).NE.OLD_LAST_SYS_BTIM(2,FNUM)C - END IF - FNUM = FNUM + 1p - END DOH - - DIFF2 = .FALSE. - FNUM = 1p - - DO WHILE (.NOT.DIFF2.AND.FNUM.LE.FOLDER_MAX)R - DIFF2 = LAST_NEWS_READ(1,FNUM).NE.OLD_LAST_NEWS_READ(1,FNUM) - IF (.NOT.DIFF2) THEN - DIFF2 = LAST_NEWS_READ(2,FNUM).NE.OLD_LAST_NEWS_READ(2,FNUM)n - END IF - FNUM = FNUM + 1T - END DO_ - - IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN - - CALL OPEN_BULLINF_SHAREDp - - IF (DIFF) THEN0 - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,LAST - END IFR - - IF (DIFF1) THEN - LU = TRIM(USERNAME)n - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))0 - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - END IFR - - IF (DIFF2) THEN - LU = TRIM(USERNAME)B - USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))' - IF (LU.GT.1) THENt - USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1))) - ELSE - USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2))) - END IF - READ (9,KEY=USERNAME,IOSTAT=IER) - IF (IER.EQ.0) THEN - REWRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READp - ELSE - WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ0 - END IF - USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU))) - IF (LU.GT.1) THEN' - USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1)))0 - ELSE - USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2))) - END IF - END IFc - - CALL CLOSE_BULLINFM - - RETURNS - END - - - INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) - - IMPLICIT INTEGER (A-Z)Y - - INTEGER BTIM(2) - - CHARACTER*(*) TIME - - IF (TRIM(TIME).EQ.20) THEN - SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM)c - ELSER - SYS_BINTIM = SYS$BINTIM(TIME(:MIN(LEN(TIME),23)),BTIM) - END IF - - RETURNT - END - - - - - SUBROUTINE NEW_MESSAGE_NOTIFICATION -C -C SUBROUTINE NEW_MESSAGE_NOTIFICATION -Cp -C FUNCTION: -CC -C Update user's last read bulletin date. If new bulletins have beenS -C added since the last time bulletins have been read, position bulletin -C pointer so that next bulletin read is the first new bulletin, and -C alert user. If READNEW set and no new bulletins, just exit.M -CR - - IMPLICIT INTEGER (A-Z)M - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - COMMON /READIT/ READITE - - COMMON /POINT/ BULL_POINT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)C - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHA - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)S - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATET - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUMt - - COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)s - - COMMON /COMMAND_LINE/ INCMD - CHARACTER*132 INCMD - - IF (INCMD(:4).EQ.'SHOW') THEN - CALL READ_IN_FOLDERS ! Read folder infoL - ELSE IF (.NOT.LOGIN_SWITCH) THENd - LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1) - LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2) - CALL UPDATE_READ(0) ! Update login timec - IF (CLI$PRESENT('SELECT_FOLDER')) THEN - CALL SELECT_FOLDER(.TRUE.,IER) - IF (IER) RETURN - END IF - CALL READ_IN_FOLDERS ! Read folder infoR - ELSED - LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn'tN - END IF ! think it's called via LOGINe - - FOLDER_Q = SAVE_FOLDER_Q1 - - DO I = 1,SAVE_FOLDER_NUMI - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flagM - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1F - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENA - CALL SET2(NEW_MSG,FOLDER_NUMBER)1 - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.S - & (FOLDER_NUMBER.GT.0.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THENf - IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND.O - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM, - & F_NEWEST_BTIM)D - ELSEN - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM), - IF (DIFF.LT.0.AND.READIT.EQ.1) THEN - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR. - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR.O - & NEW_FLAG(2).NE.-1) THEN - DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - END IF - IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THENN - IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) - IF (IER.LE.15) DIFF = -1, - END IF - END IF= - END IFR - IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND. - & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messagesN - CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag - END IFN - END IF - END DOe - - FOLDER_Q = SAVE_FOLDER_Q1 - - IF (READIT.EQ.0) THEN ! If not in READNEW mode - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)N - NEW_MESS = .FALSE. - DO I = 1,SAVE_FOLDER_NUM-1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THENI - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),3 - & F_NEWEST_BTIM) - IF (DIFF.LT.0) THEN ! Are there unread messages? - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_NOSYS_BTIM)_ - IF (DIFF.GT.0) THEN ! Unread non-system messages? - DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM)0 - ! No. Unread system messages? - IF (DIFF.GT.0) THEN ! No, update last read time.2 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(1) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = - & F_NEWEST_BTIM(2) - END IF0 - END IF - IF (DIFF.LT.0) THENS - WRITE (6,'('' There are new messages in '', - & ''folder '',A,''.'',$)') FOLDER(:TRIM(FOLDER)) - NEW_MESS = .TRUE. - END IF - END IFM - END IFD - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS)O - IF (INCMD(:4).EQ.'SHOW') THEND - SAVE_FOLDER_Q1 = 0$ - RETURNX - END IF - IF (NEW_MESS.OR.NEWS_MESS) THENI - WRITE (6,'('' Type SELECT followed by foldername to'',W - & '' read above messages.'')') - END IF - SAVE_FOLDER_Q1 = 0 - FOLDER_NUMBER = 0U - CALL SELECT_FOLDER(.FALSE.,IER)N - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM) - IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN - CALL FIND_NEWEST_BULL ! See if there are new messages - IF (BULL_POINT.NE.-1) THENR - WRITE(6,'('' Type READ to read new '',A,'' messages.'')') - & FOLDER(:TRIM(FOLDER)) - NEW_COUNT = F_NBULL - BULL_POINT - DIG = 07 - DO WHILE (NEW_COUNT.GT.0) - NEW_COUNT = NEW_COUNT / 10A - DIG = DIG + 1 - END DO - WRITE(6,'('' There are '',I,'' new messages.'')') - & F_NBULL - BULL_POINT ! Alert user if new bulletins - ELSE - BULL_POINT = 0 - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)) - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)a - END IF - END IF - ELSE ! READNEW mode. - DO I = 1,SAVE_FOLDER_NUM - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN) - CALL SELECT_FOLDER(.FALSE.,IER) - IF (IER) THEN - IF (SYSTEM_SWITCH.AND. - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN - DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM)L - ELSEF - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), - & F_NEWEST_BTIM)E - IF (BTEST(FOLDER_FLAG,7)) DIFF = -1A - IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER)N - & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERB - IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR. - & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) - & WRITE (6,'('' There are new messages in folder ''D - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - ELSEL - WRITE (6,'('' There are new messages in folder ''T - & ,A,''.'')') FOLDER(:TRIM(FOLDER)) - END IFS - DIFF = 0. - END IF - END IFM - IF (DIFF.LT.0) THEN - IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERO - IF (BULL_POINT.NE.-1) THENA - IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THENA - SAVE_BULL_POINT = BULL_POINTS - REDO = .TRUE. - DO WHILE (REDO) - REDO = .FALSE. - CALL READNEW(REDO) - IF (REDO) CALL REDISPLAY_DIRECTORY, - BULL_POINT = SAVE_BULL_POINTE - END DO - END IFO - END IF - END IF_ - END IFL - END IFE - END DO - CALL NEWS_NEW_NOTIFICATION(NEWS_MESS) - CALL EXIT - END IF7 - - RETURNU - END - - - - - SUBROUTINE READ_IN_FOLDERSH - - IMPLICIT INTEGER (A-Z)B - - INCLUDE 'BULLFOLDER.INC'1 - - INCLUDE 'BULLUSER.INC') - - COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUMC - DATA SAVE_FOLDER_Q1/0/( - - COMMON /READIT/ READIT - - COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) - - COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA - COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)E - - COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH - COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) - COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE - CHARACTER*4 SEPARATE - N - CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM)L - FOLDER_Q = SAVE_FOLDER_Q1 - - CALL OPEN_BULLFOLDER_SHARED ! Go find folders) - - SAVE_FOLDER_NUM = 0 - - FOLDER_NUMBER = 0 - CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER) - IF (LOGIN_SWITCH) FOLDER_NAME = FOLDER - DO WHILE (IER.EQ.0) - SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1) - IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1 - & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENE - ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.N - & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THENe - CALL CHANGE_FLAG_NOCMD(0,3) - CALL SET_VERSIONs - ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR. - & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.t - & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR.a - & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN -CI -C Unknown problem caused system folder flag in folder file to disappear -C so this tests to see if the flag has disappeared and resets if needed.G -CO - IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & .NOT.BTEST(FOLDER_FLAG,2)) THENO - FOLDER_FLAG = IBSET(FOLDER_FLAG,2)N - CALL REWRITE_FOLDER_FILE(IER)S - ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND. - & BTEST(FOLDER_FLAG,2)) THEN - CALL MODIFY_SYSTEM_LIST(1)R - END IFQ - END IF - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER) - END DOE - - CALL CLOSE_BULLFOLDER - - FOLDER_Q = SAVE_FOLDER_Q1 - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) - - RETURN) - END - - - - - SUBROUTINE DISCONNECT_REMOTEG - - IMPLICIT INTEGER (A-Z)_ - - INCLUDE 'BULLFOLDER.INC'c - - WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')') - - FOLDER_NUMBER = 0 - - CALL SELECT_FOLDER(.FALSE.,IER) - - WRITE (6,'('' Resetting to '',A,'' folder.'')') - & FOLDER(:TRIM(FOLDER))N - - RETURNr - END diff --git a/decus/vax92b/bulletin/bulletin8.for b/decus/vax92b/bulletin/bulletin8.for deleted file mode 100644 index 40efd24..0000000 --- a/decus/vax92b/bulletin/bulletin8.for +++ /dev/null @@ -1,2034 +0,0 @@ -C -C BULLETIN8.FOR, Version 12/4/91 -C Purpose: Contains subroutines for the BULLETIN utility program. -C Environment: VAX/VMS -C Programmer: Mark R. London -C - SUBROUTINE START_DECNET - - IMPLICIT INTEGER (A - Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - CHARACTER NAMEDESC*9 /'BULLETIN1'/ - CHARACTER NAMEDESC1*4 /'NNTP'/ - - DIMENSION NFBDESC(2) - LOGICAL*1 NFB(5) - - EXTERNAL IO$_ACPCONTROL - - PARAMETER NFB$C_DECLNAME = '15'X - - IF (CONFIRM_USER('DECNET').EQ.0) THEN - CALL SETDEFAULT('DECNET') - END IF - -C CALL SET_TIMER('02') - - GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED') - - NFBDESC(1) = 5 - NFBDESC(2) = %LOC(NFB) - - NFB(1) = NFB$C_DECLNAME - - NEWS_GOT_HOST = NEWS_GETHOST() - - IF (.NOT.GATEWAY_ONLY) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,, - & 'BULL_MBX') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX') ! Assign net device - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN) - CALL SYS$SETAST(%VAL(1)) - END IF - - IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN - IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,, - & 'BULL_MBX1') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1') - IF (.NOT.IER) CALL EXIT(IER) - - IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,, - & NFBDESC,NAMEDESC1,,,,) - IF (.NOT.IER) CALL EXIT(IER) - - CALL SYS$SETAST(%VAL(0)) - CALL READ_MBX(DCL_CHAN1) - CALL SYS$SETAST(%VAL(1)) - END IF - - DO I=1,MAXLINK - CALL LIB$GET_EF(READ_EFS(I)) - CALL LIB$GET_EF(WRITE_EFS(I)) - END DO - - IF (GATEWAY_ONLY) CALL SYS$HIBER() - - RETURN - END - - - SUBROUTINE SETDEFAULT(USERNAME) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($LNMDEF)' - - INCLUDE '($PSLDEF)' - - INCLUDE '($UAIDEF)' - - CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*9 - CHARACTER SYSLOGIN*72 - - INTEGER*2 UIC(2) - - CALL INIT_ITMLST - CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV)) - CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR)) - CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT)) - CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC)) - CALL END_ITMLST(GETUAI_ITMLST) - - CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - CALL SETACC(ACCOUNT) - CALL SETUSER(USERNAME) - CALL SETUIC(INT(UIC(2)),INT(UIC(1))) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - CALL ADD_2_ITMLST - & (ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:))) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to list - SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:) - CALL ADD_2_ITMLST - & (ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN)) - CALL END_ITMLST(CRELNM_ITMLST) ! Get address of itemlist - - CALL SYS$CRELNM(,'LNM$PROCESS','SYS$LOGIN',PSL$C_SUPER, - & %VAL(CRELNM_ITMLST)) - - CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,) - - RETURN - END - - - - SUBROUTINE READ_MBX(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1 - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - EXTERNAL MBX_AST - - EXTERNAL IO$_READVBLK - - DATA MBX_EF/0/ - - IF (MBX_EF.EQ.0) CALL LIB$GET_EF(MBX_EF) - - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - MBX_CHAN_NUM = MBX_CHAN - ELSE - MBX_CHAN_NUM = MBX_CHAN1 - END IF - - IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN_NUM), - & IO$_READVBLK,MBX_IOSB, - & MBX_AST,%VAL(DCL_CHAN_NUM),MBX_BUF,%VAL(132),,,,) - IF (.NOT.IER) CALL EXIT(IER) - - RETURN - - END - - - - - SUBROUTINE MBX_AST(DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($MSGDEF)' - - INCLUDE 'BULLUSER.INC' - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area for - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - INTEGER*2 MBXMSG,UNIT2 - - EQUIVALENCE (MBX_BUF(1),MBXMSG) - - CHARACTER NODENAME*6,FROMNAME*12 - - IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN - LNODE = 0 - DO WHILE (MBX_BUF(10+LNODE).NE.':') - LNODE = LNODE + 1 - NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE)) - END DO - DO I=LNODE+1,LEN(NODENAME) - NODENAME(I:I) = ' ' - END DO - I = 10 + LNODE - DO WHILE (MBX_BUF(I).NE.'=') - I = I + 1 - END DO - LUSER = 0 - DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND. - & MBX_BUF(I+LUSER+1).NE.'/') - LUSER = LUSER + 1 - USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER)) - END DO - DO I=LUSER+1,LEN(USERNAME) - USERNAME(I:I) = ' ' - END DO - FROMNAME = USERNAME - CALL GET_PROXY_USERNAME(NODENAME,USERNAME) - CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM)) - ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR. - & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - ELSE - CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2) - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2) - UNIT_INDEX = UNIT_INDEX + 1 - END DO - IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX) - CALL READ_MBX(%LOC(DCL_CHAN_NUM)) - END IF - - RETURN - END - - - - - SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - EXTERNAL READ_AST - - EXTERNAL IO$_READVBLK - - IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK, - & READ_IOSB(1,UNIT_INDEX),READ_AST, - & %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(1024),,,,) - - RETURN - - END - - - - - SUBROUTINE WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*128 INPUT - - EXTERNAL IO$_READVBLK,NEWS_READ_AST - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN - CALL DISCONNECT(UNIT_INDEX) - ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1 - IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN - IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN - REC_SAVE(UNIT_INDEX) = 0 - ELSE - RETURN - END IF - ELSE - CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),INPUT) - END IF - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER) - ELSE IF (NNTP_CHANS(UNIT_INDEX).GT.0) THENe - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)), - & %VAL(NNTP_CHANS(UNIT_INDEX)), - & IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST,H - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX), - & %VAL(1024),,,,) - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THENP - IER = WRITE_IOSB(1,UNIT_INDEX)B - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX)R - END IFE - - RETURN, - END - - - - SUBROUTINE READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z)L - - PARAMETER MAXLINK = 10O - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)O - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFA - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK)1 - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_WRITE_AST - - EXTERNAL IO$_WRITEVBLKR - - UNIT_INDEX = %LOC(ASTPRM) - - IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN - -C IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1 - - CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE) - - IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.15) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_WRITE_PACKET_BULLCP(READ_EFS(UNIT_INDEX), - & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX,A - & READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX)) - IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = READ_IOSB(1,UNIT_INDEX) - END IF - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL EXECUTE_COMMAND(UNIT_INDEX) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX)F - END IFR - - RETURN( - END - - - - - - SUBROUTINE NEWS_WRITE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z)S - - PARAMETER MAXLINK = 10 - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFI - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)_ - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSBW - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - UNIT_INDEX = %LOC(ASTPRM) - - IF (READ_IOSB(1,UNIT_INDEX)) THEN - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX)S - RETURN - END IFD - - CALL DISCONNECT(UNIT_INDEX) - - RETURNE - END - - - - - SUBROUTINE NEWS_READ_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z)O - - PARAMETER MAXLINK = 10R - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)E - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB - LOGICAL*1 WRITE_BUF - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THENS - NUM = WRITE_IOSB(2,UNIT_INDEX) - CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER)F - IF (IER) RETURN( - END IF - - CALL DISCONNECT(UNIT_INDEX) - - RETURN% - END - - - - - SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER)C - - IMPLICIT INTEGER (A-Z)T - - PARAMETER MAXLINK = 10L - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)G - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFC - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB% - LOGICAL*1 WRITE_BUF - - CHARACTER*(*) OUTPUTT - - EXTERNAL IO$_WRITEVBLK, WRITE_AST - - CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX)) - - ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER) - - IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)),s - & %VAL(DEVS(UNIT_INDEX)),( - & IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST,T - & %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,) - - IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN - IER = WRITE_IOSB(1,UNIT_INDEX) - END IF_ - - RETURN - - END - - - - - - SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM)N - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10 - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK) - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSBR - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)R - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF) - - COMMON /ANY_ACTIVITY/ CONNECT_COUNT - DATA CONNECT_COUNT /0/M - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1C - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - CHARACTER*(*) USERNAME,FROMNAME - - COMMON /NEWSHOST/ NEWS_GOT_HOST - - EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST - - CONNECT_COUNT = CONNECT_COUNT + 1 - - IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - - CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IF (REJECT.NE.IO_REJECT) THEN - IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN - IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN() - IF (IER) THEN - NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN() - WRITE_IOSB(1,UNIT_INDEX) = 1 - IER = NEWS_SOCKET_BULLCP(WRITE_EFS(UNIT_INDEX), - & WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX)A - IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX)) - END IF1 - IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) - ELSE - CALL READ_CHAN(CHAN,UNIT_INDEX) - END IF - END IF) - - CALL READ_MBX(DCL_CHAN_NUM) - - RETURN - END - - - - SUBROUTINE NEWS_SOCKET_AST(ASTPRM)= - - IMPLICIT INTEGER (A-Z)0 - - PARAMETER MAXLINK = 10_ - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)O - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSBI - LOGICAL*1 WRITE_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - EXTERNAL NEWS_CREATE_AST( - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THENM - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - IER = NEWS_CREATE_BULLCP(WRITE_EFS(UNIT_INDEX), - & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX)M - IF (IER) RETURN. - END IFN - - CALL DISCONNECT(UNIT_INDEX) - - RETURN - END - - - - SUBROUTINE NEWS_CREATE_AST(ASTPRM) - - IMPLICIT INTEGER (A-Z)A - - PARAMETER MAXLINK = 10L - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)T - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSBI - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)I - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFI - - UNIT_INDEX = %LOC(ASTPRM) - - IF (WRITE_IOSB(1,UNIT_INDEX)) THENC - CALL WRITE_AST(%VAL(UNIT_INDEX)) - CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX)X - ELSEN - CALL DISCONNECT(UNIT_INDEX)U - END IFG - - RETURNO - END - - - - SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX, - & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM) - - IMPLICIT INTEGER (A-Z), - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area forU - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - PARAMETER MAXLINK = 10R - - COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)= - COMMON /PROCBUF/ WRITE_EFS(MAXLINK) - INTEGER*2 WRITE_IOSB4 - LOGICAL*1 WRITE_BUF - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)I - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFK - DATA COUNT /0/I - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)L - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)K - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)A - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12T - - COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1D - - EXTERNAL IO$_ACCESS,IO$M_ABORTE - - CHARACTER*(*) USERNAME,FROMNAME,NODENAMEU - - CHARACTER*100 NCBDESC - - START_NCB = 7+MBX_BUF(5)E - - LEN_NCB = MBX_BUF(START_NCB-1) - - CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC))N - - IF (COUNT.GT.MAXLINK) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - CHAN = DCL_CHAN_NUMT - ELSEN - IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX')I - ELSE - IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1') - END IF - - IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER) - - IF (IER) THENU - CHAN = DEV_CHAN - REJECT = %LOC(IO$_ACCESS) - - UNIT_INDEX = 1 - DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.)A - UNIT_INDEX = UNIT_INDEX + 1 - END DON - ELSE - CALL SYS$DASSGN(%VAL(DEV_CHAN)) - END IF - - IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THENE - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT)T - CHAN = DCL_CHAN_NUM - ELSE - COUNT = COUNT + 1 - UNITS(UNIT_INDEX) = DEV_UNITL - DEVS(UNIT_INDEX) = DEV_CHAN - USER_SAVE(UNIT_INDEX) = USERNAMER - FROM_SAVE(UNIT_INDEX) = FROMNAMEO - NODE_SAVE(UNIT_INDEX) = NODENAMEV - FOLDER_NUM(UNIT_INDEX) = -1 - LEN_SAVE(UNIT_INDEX) = 0N - PRIV_SAVE(1,UNIT_INDEX) = 0 - PRIV_SAVE(2,UNIT_INDEX) = 0 - END IF - END IFI - - IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,, - & ,NCBDESC(:LEN_NCB),,,,)L - - IF (REJECT.EQ.%LOC(IO$_ACCESS).AND. - & (.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN - REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT) - COUNT = COUNT - 1W - DEVS(UNIT_INDEX) = 0 - UNITS(UNIT_INDEX) = 0A - END IFU - - RETURNN - END - - - - SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER)D -C, -C SUBROUTINE GETDEVUNIT -C -C FUNCTION: -C To get device unit numberH -C INPUT:I -C CHAN - Channel numberE -C OUTPUT: -C DEV_UNIT - Device unit numberN -C( - - IMPLICIT INTEGER (A-Z)A - - INCLUDE '($DVIDEF)' - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listT - CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist= - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN - END - - - - SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER) -C) -C SUBROUTINE GETDEVMAME -C -C FUNCTION: -C To get device name -C INPUT:_ -C CHAN - Channel number( -C OUTPUT: -C DEV_NAME - Device name -C DLEN - Length of device name -CS - - IMPLICIT INTEGER (A-Z) - - INCLUDE '($DVIDEF)' - - CHARACTER*(*) DEV_NAME - - CALL INIT_ITMLST ! Initialize item list - ! Now add items to listV - CALL ADD_2_ITMLST_WITH_RET - & (LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN)) - CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlistI - - IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,) - - RETURN_ - END - - - - SUBROUTINE DISCONNECT(UNIT_INDEX) -CP -C SUBROUTINE DISCONNECT -CI -C FUNCTION: Disconnects channel and remove its entry from the lists.) -C - - IMPLICIT INTEGER (A-Z)X - - PARAMETER MAXLINK = 10O - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK) - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFO - - COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132) ! Buffer area forR - INTEGER*2 MBX_IOSB ! terminal QIO calls. - LOGICAL*1 MBX_BUF - - COMMON /NNTP/ NNTP_CHANS(MAXLINK) - - IF (UNITS(UNIT_INDEX).EQ.0) RETURNN - - CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX))) - - CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - COUNT = COUNT - 1 - DEVS(UNIT_INDEX) = 0O - UNITS(UNIT_INDEX) = 0 - - IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN - CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX)) - CALL NEWS_DISCONNECT - NNTP_CHANS(UNIT_INDEX) = 0 - END IF1 - - RETURN) - END - - - - SUBROUTINE SET_TIMER(MIN) -CI -C SUBROUTINE SET_TIMER -C( -C FUNCTION: Wakes up every MIN minutes to check for idle connections -CO - IMPLICIT INTEGER (A-Z)U - INTEGER TIMADR(2) ! Buffer containing timeE - ! in desired system format.) - CHARACTER TIMBUF*13,MIN*2 - DATA TIMBUF/'0 00:00:00.00'/ - - EXTERNAL CHECK_CONNECTIONSE - - CALL LIB$GET_EF(WAITEFN)E - - TIMBUF(6:7) = MIN - - IER=SYS$BINTIM(TIMBUF,TIMADR) - - ENTRY RESET_TIMER - - IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,) - ! Set timer. - - RETURN4 - END - - - - - SUBROUTINE CHECK_CONNECTIONSP - - IMPLICIT INTEGER (A-Z) - - PARAMETER MAXLINK = 10G - - COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK)A - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)N - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUFC - - IF (COUNT.GT.0) THEN - DO UNIT_INDEX=1,MAXLINK_ - IF (DEVS(UNIT_INDEX).NE.0.AND.C - & IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THENE - CALL DISCONNECT(UNIT_INDEX)W - END IFE - END DO - END IF$ - - CALL RESET_TIMERS - - RETURNE - END - - - - SUBROUTINE GET_USER_PRIV(USERNAME,PRIV) - - IMPLICIT INTEGER (A-Z) - - DIMENSION PRIV(2) - - CHARACTER USERNAME*(*) - - INCLUDE '($UAIDEF)' - - INTEGER*2 UIC(2) - - CALL INIT_ITMLSTE - CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV)) - CALL END_ITMLST(GETUAI_ITMLST)T - - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) - - IF (.NOT.IER) THENW - USERNAME = 'DECNET'S - IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)F - END IFD - - RETURN& - END - - - - - - SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME) - - IMPLICIT INTEGER (A-Z)T - - CHARACTER NODE*(*),USERNAME*(*) - - CHARACTER NETUAF*100,USERTEMP*12E - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - - LNODE = LEN(NODE) - LUSER = LEN(USERNAME) - - NUM = 1 - NENTRY = NETUAF_QUEUE - - USERTEMP = 'DECNET' - - DO WHILE (NUM.LE.NETUAF_NUM) - NUM = NUM + 1A - CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF)B - IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND. - & (NETUAF(33:32+LUSER).EQ.USERNAME.OR. - & NETUAF(65:65).EQ.'*')) THENT - IF (NETUAF(33:32+LUSER).EQ.USERNAME) THEN - IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:) - RETURN - END IFT - IF (NETUAF(65:65).NE.'*') THENE - USERTEMP = NETUAF(65:)N - ELSE& - USERTEMP = USERNAMES - END IFT - END IF - END DO) - - USERNAME = USERTEMP - - RETURNE - END - - - - - - SUBROUTINE GET_PROXY_ACCOUNTS - - IMPLICIT INTEGER (A-Z) - - CHARACTER NETUAF*656Z - - COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM - DATA NETUAF_QUEUE/0/X - - CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100))F - - OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT', - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)) - - FORMAT = 0R - - IF (IER.NE.0) THEN1 - OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT',D - & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED', - & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)C - FORMAT = 1 - END IF - - NETUAF_NUM = 0 - NENTRY = NETUAF_QUEUE - DO WHILE (IER.EQ.0) - READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAFD - IF (IER.EQ.0) THEN - NETUAF_NUM = NETUAF_NUM + 1 - IF (FORMAT.EQ.0) THEN - NETUAF = NETUAF(13:)2 - NLEN = NLEN - 12a - DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64)= - SKIP = 4 + ICHAR(NETUAF(65:65))M - NETUAF(65:) = NETUAF(65+SKIP:) - NLEN = NLEN - SKIP - END DOT - IF (NLEN.GT.64) THENC - ULEN = ICHAR(NETUAF(65:65)) - NETUAF(65:) = NETUAF(69:)4 - DO I=65+ULEN,76A - NETUAF(I:I) = ' ' - END DO - ELSE) - NETUAF(65:) = 'DECNET' - END IFR - END IF - CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100)) - END IF - END DOC - - CLOSE (UNIT=7)_ - - RETURNK - - END - - - - - SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX)E - - IMPLICIT INTEGER (A-Z)N - - INCLUDE 'BULLFOLDER.INC'N - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLUSER.INC'T - - INCLUDE 'BULLFILES.INC'( - - PARAMETER MAXLINK = 10S - - COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)U - COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT - INTEGER*2 READ_IOSB - LOGICAL*1 READ_BUF - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)A - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)5 - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)E - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12I - - COMMON /ACCESS/ READ_ONLY - LOGICAL READ_ONLY - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH - - PARAMETER BRDCST_LIMIT = 82*12 + 2 +2 - CHARACTER*(BRDCST_LIMIT) BMESSAGE - - COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY - CHARACTER*80 FOLDER1_DIRECTORY - - CHARACTER*80 FOLDER2_DIRECTORY - - DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK)S - DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/ - - EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ - - CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56 - CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128 - - EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE) - - INTEGER BULLCP_PRIV(2)= - - CALL COPY2(BULLCP_PRIV,PROCPRIV)D - - ILEN = READ_IOSB(2,UNIT_INDEX)X - CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER))E - - REMOTE_SET = .FALSE.N - REC_SAVE(UNIT_INDEX) = 0S - USERNAME = USER_SAVE(UNIT_INDEX)I - FOLDER = FOLDERNAME(UNIT_INDEX) - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX). - FOLDER_FLAG = 0 - NODENAME = NODE_SAVE(UNIT_INDEX) - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) - - CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE) - - IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND. - & CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15.OR.CMD_TYPE.EQ.1) THENT - ! Do we need priv info?v - IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THENE - CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX), - & PRIV_SAVE(1,UNIT_INDEX))C - USERNAME = USER_SAVE(UNIT_INDEX) ! If changed to DECNET - CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX))_ - IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THENL - CALL CHECK_BULLETIN_PRIV(USERNAME)T - CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV)_ - END IF - END IF - END IFD - - FOLDER2_DIRECTORY = FOLDER_DIRECTORY - IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND.T - & TRIM(FOLDER1_DIRECTORY).GT.0) THEN - FOLDER_DIRECTORY = FOLDER1_DIRECTORY - CALL ADD_DIRECTORIES - END IF - - IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THENe - IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THENC - CALL LIB$MOVC3(4,1,%REF(BUFFER(1:)))N - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - ELSE T - CALL LIB$MOVC3(4,0,%REF(BUFFER(1:))) - CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1) - END IF - ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folderN - IF (BUFFER(ILEN:ILEN).EQ.'+') THEN - SYSLOG = .TRUE. - ILEN = ILEN - 1 - ELSE t - SYSLOG = .FALSE.I - END IF - FOLDER1 = BUFFER(5:ILEN) - FOLDER_NUMBER = -2 - CALL SELECT_FOLDER(.FALSE.,IER)X - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:))) - IF (USERNAME.NE.'DECNET'.AND.IER) THEN - CALL OPEN_USERINFO2 - IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real. - USER_SAVE(UNIT_INDEX) = USERNAME - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:))) - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:)))U - ELSE - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),- - & %REF(BUFFER(9:)))U - LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1)A - LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) - END IFI - ELSE - CALL LIB$MOVC3(4,0,%REF(BUFFER(9:)))T - CALL LIB$MOVC3(4,0,%REF(BUFFER(13:))) - END IF - LINFO = 16 - IF (SYSLOG) THEN - LINFO = 24t - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1),B - & LAST_SYS_SAVE(1,UNIT_INDEX)) - CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1),0 - & %REF(BUFFER(17:))) - IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THENM - CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),T - & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))C - END IFS - END IF - BUFFER = BUFFER(:LINFO)//FOLDER_COMB - CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1)R - IF (IER.AND.IER1) THEN - IF (SYSLOG) THENA - CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX) - ELSE) - LAST_SYS_SAVE(1,UNIT_INDEX) = 0 - LAST_SYS_SAVE(2,UNIT_INDEX) = 0 - END IFN - FOLDERNAME(UNIT_INDEX) = FOLDER - FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBERU - END IF - ELSE IF (CMD_TYPE.EQ.2) THEN ! Add message - LEN_SAVE(UNIT_INDEX) = 0 - OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX)N - ELSE IF (CMD_TYPE.EQ.6) THEN ! Add message lineI - LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1B - CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)), - & OUT_SAVE(UNIT_INDEX),BUFFER(5:132)) - ELSE IF (CMD_TYPE.EQ.3) THEN ! Add message entry - FROM = USER_SAVE(UNIT_INDEX) - IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX) - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP))% - P = LEN(DESCRIP) + 5 - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P, - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P_ - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM)E - P = 4 + PC - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)T - IF (READ_ONLY.AND. - & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN - BUFFER = 'ERROR: Insufficient privileges to add message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000U - ELSE IF ((SYSTEM.AND.7).NE.0) THEN - IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND.E - & .NOT.BTEST(FOLDER_FLAG,2)) THEN ! Test if SYSTEM folder - SYSTEM = SYSTEM.AND.2 - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)' - END IFT - IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN( - ! Priv test - IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit presentS - & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THENT - SYSTEM = 0B - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - ELSE ! Allow permanent if - SYSTEM = SYSTEM.AND.2 ! owner of folder - END IF - END IFN - IF (BTEST(SYSTEM,2)) THEN ! Shutdown? - CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA) - WRITE (EXTIME,'(I4)') NODE_NUMBERN - WRITE (EXTIME(7:),'(I4)') NODE_AREAE - DO I=1,11I - IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0' - END DO - EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'// - & EXTIME(7:8)//'.'//EXTIME(9:10) - END IF, - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD) - P = 4 + P - IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THENI - BROAD = 0 - END IF - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL)H - P = 4 + PA - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL) - P = 4 + PT - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER) - CALL SET_FOLDER_FILE(0)1 - CALL OPEN_BULLDIR - CALL READDIR(0,IER) ! Get NBLOCK - IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0 - CALL OPEN_BULLFILE - OENTRY = OUT_HEAD(UNIT_INDEX)N - LENGTH = LEN_SAVE(UNIT_INDEX) - LEN_SAVE(UNIT_INDEX) = 0 - DO I=1,LENGTHT - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)6 - WRITE (1'NBLOCK+I) INQUEUEE - END DO - IF (BROAD) THENQ - CALL GET_BROADCAST_MESSAGE(BELL) - CALL BROADCAST(ALL,CLUSTER) - END IF - CALL CLOSE_BULLFIL ! Finished adding bulletinI - CALL ADD_ENTRY ! Add the new directory entry - CALL UPDATE_FOLDER ! Update info in folder fileL - CALL CLOSE_BULLDIR ! Totally finished with add - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - - IF (.NOT.BROAD) GO TO 1000 - -100 CALL GETUSER(BULLCP_USER) ! Get present username - CALL OPEN_BULLUSER_SHARED ! Broadcast on other nodesX - TEMP_USER = ':'E - DO WHILE (1) - DO WHILE (REC_LOCK(IER)) - READ (4,KEYGT=TEMP_USER,IOSTAT=IER)S - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAMEU - TEMP_USER = TEMP_USER(:TRIM(TEMP_USER)) - IF (IER.EQ.0.AND. - & (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME - & .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER)) - & .AND.TEMP_USER(:1).EQ.':') THEN - IER1 = REC_LOCK(IER) ! Skip the node thatC - END IF ! originated the message( - END DOP - IF (TEMP_USER(:1).NE.':') THEND - CALL CLOSE_BULLUSER - CALL SETUSER(BULLCP_USER) - REMOTE_SET = .FALSE.M - CLOSE (UNIT=REMOTE_UNIT) - GO TO 1000T - END IFE - CALL SETUSER(USERNAME) ! Reset to original username - FOLDER1 = 'GENERAL' - FOLDER1_BBOARD = ':'//TEMP_USER - CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) - IF (IER.NE.0) THEN/ - CALL ERRSNS(IDUMMY,IDUMMY,INODE)T - IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR.B - & INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN, - DELETE (4) - END IF - ELSE( - IER = 0 - I = 1 - DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH) - WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER) - & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127))R - I = I + 128X - END DOE - IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER) - & 15,BLENGTH,BELL,ALL,CLUSTER - END IFD - END DO - ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entryE - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT) - CALL SET_FOLDER_FILE(0)E - CALL OPEN_BULLDIR_SHARED - IF (ICOUNT.GE.0) THEN, - CALL READDIR(ICOUNT,IER). - ELSE - CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:)))_ - CALL READDIR_KEYGE(IER) - END IF - CALL CLOSE_BULLDIR - CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:))) - IF (ICOUNT.NE.0) THENS - BUFFER(5:) = BULLDIR_ENTRY - CALL WRITE_CHAN - & (LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER) - ELSE - BUFFER(5:) = BULLDIR_HEADER - CALL WRITE_CHAN - & (LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER) - END IF - ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL) - CALL SET_FOLDER_FILE(0)E - CALL OPEN_BULLDIR_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX)D - DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL)O - CALL READDIR(I,IER) - INQUEUE = BULLDIR_ENTRY - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)F - END DO - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX)C - REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY) - LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1 - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE) - OUT_SAVE(UNIT_INDEX) = OENTRYI - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.9) THEN ! Write directory entry - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)E - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR - IF (ICOUNT.GT.0) THENR - BULLDIR_ENTRY = BUFFER(9:)R - CALL WRITEDIR_NOCONV(ICOUNT,IER)% - ELSE - BULLDIR_HEADER = BUFFER(9:) - CALL WRITEDIR_NOCONV(ICOUNT,IER). - END IF - CALL CLOSE_BULLDIR - ELSE IF (CMD_TYPE.EQ.4) THENN - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE) - DESCRIP_TEMP = BUFFER(13:ILEN) - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)S - CALL OPEN_BULLDIRM - CALL READDIR(BULL_DELETE,IER)) - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN_ - CALL CLOSE_BULLDIRV - BUFFER = 'ERROR: Cannot find message to delete.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENB - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to delete message.'A - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000_ - END IF - CALL REMOVE_ENTRY - & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE)+ - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.5) THEN ! Read messageI - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT), - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(ICOUNT,IER) - CALL OPEN_BULLFIL_SHARED - OENTRY = OUT_HEAD(UNIT_INDEX)L - DO I=BLOCK,BLOCK+LENGTH-1 - READ (1'I,IOSTAT=IER) INQUEUE - CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)E - END DO - CALL CLOSE_BULLFIL - CALL CLOSE_BULLDIR - OENTRY = OUT_HEAD(UNIT_INDEX) - REC_SAVE(UNIT_INDEX) = 128 - LEN_SAVE(UNIT_INDEX) = LENGTH. - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)L - OUT_SAVE(UNIT_INDEX) = OENTRYW - CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER) - CALL SAVE_LAST_READ_BTIM(UNIT_INDEX) - ELSE IF (CMD_TYPE.EQ.10) THEN ! Replacing bulletin - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)3 - CALL SET_FOLDER_FILE(0)C - CALL OPEN_BULLDIRC - CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + 5 - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT)E - P = 4 + P( - CALL READDIR(ICOUNT,IER) - IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN - CALL CLOSE_BULLDIRM - BUFFER = 'ERROR: Cannot find message to replace.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP)) - P = LEN(DESCRIP) + P - CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE)) - P = 4 + PM - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + PE - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P - ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV()X - IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR.A - & BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR. - & (USERNAME.NE.FROM.AND..NOT.ALLOW).OR.i - & ((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN - CALL CLOSE_BULLDIR - BUFFER = 'ERROR: Insufficient privileges to replace message.' - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000o - END IF - CALL READDIR(0,IER) ! Get NBLOCK - CALL OPEN_BULLFILN - NEW_LENGTH = LEN_SAVE(UNIT_INDEX)_ - LEN_SAVE(UNIT_INDEX) = 0 - OENTRY = OUT_HEAD(UNIT_INDEX)O - DO I=1,NEW_LENGTHR - CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)1 - WRITE (1'NBLOCK+I) INQUEUEX - END DO - CALL CLOSE_BULLFIL ! Finished adding bulletin) - IF (NEW_LENGTH.GT.0) THEN - NEMPTY = NEMPTY + LENGTH1 - LENGTH = NEW_LENGTH - BLOCK = NBLOCK + 1E - END IF - CALL WRITEDIR(ICOUNT,IER)F - NBLOCK = NBLOCK + NEW_LENGTH - CALL WRITEDIR(0,IER) - CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1),P - & BTEST(MSGTYPE,2),EXDATE,EXTIME)M - IF (BTEST(MSGTYPE,0)) THEN - SYSTEM = IBSET(SYSTEM,0) ! System? - ELSE - SYSTEM = IBCLR(SYSTEM,0) ! General?L - END IF - CALL WRITEDIR(ICOUNT,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.11) THEN ! Undeleting - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE) - P = 4 + PO - CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP)) - P = LEN(DESCRIP_TEMP) + PI - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)L - CALL OPEN_BULLDIRS - CALL READDIR(BULL_DELETE,IER)L - IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENT - CALL CLOSE_BULLDIRy - BUFFER = 'ERROR: Cannot find message to undelete.'l - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000E - ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROMA - & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENU - CALL CLOSE_BULLDIRs - BUFFER = 'ERROR: Insufficient privileges to undelete message.'X - CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER) - GO TO 1000 - END IF - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE)) - P = LEN(EXDATE) + P_ - CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME)) - P = LEN(EXTIME) + P. - CALL WRITEDIR(BULL_DELETE,IER) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.12) THEN ! Find newest bulletin - CALL SET_FOLDER_FILE(0) - CALL OPEN_BULLDIR_SHARED - CALL READDIR(0,IER) - CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT) - CALL CLOSE_BULLDIR - CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER) - ELSE IF (CMD_TYPE.EQ.14) THEN ! Register remote folder - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),FLAG)e - FOLDER1 = FOLDER - FOLDER_NUMBER = -1 - CALL SELECT_FOLDER(.FALSE.,IER)C - CALL OPEN_BULLUSER_SHAREDO - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - DO WHILE (REC_LOCK(IER)) - READ (4,KEY=TEMP_USER,IOSTAT=IER) R - & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAGI - END DO - IF (IER.NE.0) THEN - DO I=1,FLONGS - NEW_FLAG (I) = 0= - END DO - END IF - IF (FLAG) THEN - CALL SET2(NEW_FLAG,FOLDER_NUMBER) - ELSE - CALL CLR2(NEW_FLAG,FOLDER_NUMBER) - END IF - IF (IER.EQ.0) THEN - REWRITE (4) TEMP_USER,, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - ELSE - TEMP_USER = ':'//NODENAME(:TRIM(NODENAME)) - WRITE (4) TEMP_USER, - & LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME - END IF - CALL CLOSE_BULLUSERO - ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message - CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH) - CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START) - IF (BLENGTH.EQ.-1) THENG - IF (SCRATCH(UNIT_INDEX).EQ.0) THEN - CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - END IFS - CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)), - & %VAL(SCRATCH(UNIT_INDEX)+START-1)) - ELSE - CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)), - & %REF(BMESSAGE(1:)))L - CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL) - CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER) - CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX)) - IF (ILEN.GT.20) THENF - CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER)_ - FOLDER = BUFFER(44:) - GO TO 100 - ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN - CALL BROADCAST(ALL,CLUSTER)E - END IFY - END IF - END IFW - -1000 CALL COPY2(PROCPRIV,BULLCP_PRIV) - - IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN - FOLDER_DIRECTORY = FOLDER2_DIRECTORY - CALL ADD_DIRECTORIES - END IFA - - RETURNE - END - - - - SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX) - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC'O - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'E - - PARAMETER MAXLINK = 10( - - COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)4 - COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)L - COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK) - COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)E - COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK) - COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK) - CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 - - DIMENSION SAVE_BTIM(2)U - - USERNAME = USER_SAVE(UNIT_INDEX)P - FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX) - - IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURNS - - CALL OPEN_USERINFOM - DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),_ - & LAST_SAVE(1,UNIT_INDEX)) - IF (DIFF.LT.0) THEN - LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX). - LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX) - END IFO - - IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND.( - & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND.S - & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND. - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THENt - DIFF1 = -1l - ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND.R - & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THENN - DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1), - & LAST_SYS_SAVE(1,UNIT_INDEX)) - ELSED - DIFF1 = 0I - END IFE - - IF (DIFF1.LT.0) THENU - LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX) - LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX) - END IF - - IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO - - RETURNO - - ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM) - - DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM)E - - IF (DIFF.GE.0) RETURN - - LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)F - LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)O - - RETURNT - - ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX) - - CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date - - LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)A - LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)( - - RETURNI - - END - - - - - SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME)T - - IMPLICIT INTEGER (A-Z)M - - COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) - - INCLUDE 'BULLFILES.INC' - - IER = SETPRV_PRIV() - - IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND. - & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN, - CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)), - & USERNAME,R_ACCESS,W_ACCESS)U - IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV)D - END IF, - - RETURNF - END - - - - SUBROUTINE GETACC(ACCOUNT)P -CH -C SUBROUTINE GETACC -CL -C FUNCTION: -C To get account of present process. -C OUTPUTS: -C ACCOUNT - ACCOUNT owner of present process., -C) - - IMPLICIT INTEGER (A-Z)N - - CHARACTER*(*) ACCOUNT ! Limit is 12 characters - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT))R - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info( - - RETURN - END - - - - - - SUBROUTINE GETSTS(STS)O -CE -C SUBROUTINE GETSTS -CL -C FUNCTION: -C To get status of present process. This tells if its a batch process. -C OUTPUTS:) -C STS - Status word of present process.W -CR - - IMPLICIT INTEGER (A-Z)N - - INCLUDE '($JPIDEF)' - - CALL INIT_ITMLST ! Initialize item list - CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS)) - CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlistU - - IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get infoL - - RETURNI - END - - - - - - INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN) - - IMPLICIT INTEGER (A-Z)E - - INCLUDE '($FABDEF)' - INCLUDE '($RABDEF)' - - RECORD /FABDEF/ FAB - RECORD /RABDEF/ RAB - - FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE) - - STATUS = SYS$OPEN(FAB)U - IF (STATUS) STATUS = SYS$CONNECT(RAB) - - LNM_MODE_EXEC = STATUSi - - END - - - - INTEGER FUNCTION REC_LOCK(IER)T - - INCLUDE '($FORIOSDEF)' - - DATA INIT /.TRUE./ - - IF (INIT) THEN - REC_LOCK = 1 - INIT = .FALSE. - ELSER - IF (IER.EQ.FOR$IOS_SPERECLOC) THEN - CALL WAIT_SEC('01') - REC_LOCK = 1R - ELSE - REC_LOCK = 0, - INIT = .TRUE. - END IF - END IFE - - RETURN( - END - - INTEGER FUNCTION TRIM(INPUT) - CHARACTER*(*) INPUT - DO TRIM=LEN(INPUT),1,-1 - IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURNT - END DO - RETURNO - END - - SUBROUTINE SYS_GETMSG(IER)O - - IMPLICIT INTEGER (A-Z)N - - CHARACTER*80 MESSAGEY - - CALL LIB$SYS_GETMSG(IER,,MESSAGE) - WRITE (6,'(A)') MESSAGE - - RETURNL - END - - - - SUBROUTINE HELP(LIBRARY)3 - - IMPLICIT INTEGER (A-Z)E - - CHARACTER*(*) LIBRARY - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P) - IF (.NOT.IER) BULL_PARAMETER = ' 'F - - CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY) - - RETURNL - END - - - - - SUBROUTINE GET_NODE_INFO -Cn -C SUBROUTINE GET_NODE_INFOl -C -C FUNCTION: Gets local node name and obtains node names from -C command line. -CE - - IMPLICIT INTEGER (A-Z)R - - EXTERNAL CLI$_ABSENTO - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODEL - CHARACTER*32 NODES(10)E - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER LOCAL_NODE*32,NODE_TEMP*256,PASSWORD*31,TEMP_USER*12I - - NODE_ERROR = .FALSE.O - - LOCAL_NODE_FOUND = .FALSE.B - CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE) - L_NODE = L_NODE - 2 ! Remove '::' - IF (LOCAL_NODE(1:1).EQ.'_') THEN - LOCAL_NODE = LOCAL_NODE(2:)I - L_NODE = L_NODE - 1 - END IFO - - NODE_NUM = 0 ! Initialize number of nodesO - IF (CLI$PRESENT('NODES')) THEN ! Decnet nodes specified? - DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP) - & .NE.%LOC(CLI$_ABSENT)) ! Get the specified nodes - IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP) - DO WHILE (TRIM(NODE_TEMP).GT.0) - NODE_NUM = NODE_NUM + 1 - COMMA = INDEX(NODE_TEMP,',')E - IF (COMMA.GT.0) THENt - NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1)5 - NODE_TEMP = NODE_TEMP(COMMA+1:) - ELSEE - NODES(NODE_NUM) = NODE_TEMP - NODE_TEMP = ' ' - END IFR - NLEN = TRIM(NODES(NODE_NUM))M - I = INDEX(NODES(NODE_NUM),'::') - TEMP_USER = ' ' - IF (I.GT.0.AND.NLEN-I.EQ.1) THENP - NLEN = NLEN - 2 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)0 - ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN - TEMP_USER = NODES(NODE_NUM)(I+2:) - NLEN = I - 1 - NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)L - POINT_NODE = NODE_NUMD - IER = 1 - DO WHILE (IER.NE.0) - WRITE(6,'('' Enter password for node '',2A)') - & NODES(NODE_NUM)(:NLEN),CHAR(10) - CALL GET_INPUT_NOECHO(PASSWORD) - IF (TRIM(PASSWORD).EQ.0) THEN - DO WHILE (NODE_NUM.GT.0)A - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DOg - NODE_ERROR = .TRUE. - RETURNT - END IF3 - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '// - & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"',$ - & ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Password is invalid.'')')$ - END IF - END DO - END IF$ - IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN - NODE_NUM = NODE_NUM - 1 - LOCAL_NODE_FOUND = .TRUE.A - ELSE IF (TRIM(TEMP_USER).EQ.0) THEN - POINT_NODE = NODE_NUM4 - OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)// - & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED', - & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER) - IF (IER.NE.0) THEN - DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - NODE_ERROR = .TRUE.R - RETURN - END IF - END IF - END DOC - END DO - ELSEO - LOCAL_NODE_FOUND = .TRUE.I - END IFU - RETURNI - END - - - - - SUBROUTINE SET_FOLDER_FILE(NUM) -CT -C SUBROUTINE SET_FOLDER_FILET -CM -C FUNCTION: Sets folder file name. If NUM = 0, set FOLDER_FILE,M -C if = 1, set FOLDER1_FILEA -C/ - - IMPLICIT INTEGER (A-Z)V - - INCLUDE 'BULLFOLDER.INC'T - - IF (NUM.EQ.0) THENI - CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE)) - ELSE IF (NUM.EQ.1) THEN - CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE)A - END IFE - - RETURNO - END - - - - SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE) -CS -C SUBROUTINE SET_FILE -CE - IMPLICIT INTEGER (A-Z)T - - INCLUDE 'BULLFILES.INC' - - CHARACTER*(*) FOLDER,FOLDER_FILER - - IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN - FOLDER_FILE =B - & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER) - ELSED - FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//S - & '.]' - END IF - - RETURNT - END - - - - - SUBROUTINE SET_BULLFIL - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'( - - INCLUDE 'BULLDIR.INC' - - COMMON /BULLFIL/ BULLFIL - - CHARACTER FILDATE*12I - - DATA UPDATE/.FALSE./& - - UPDATE = .TRUE. - - ENTRY SET_BULLFIL_UPDATE - - UPDATE = .NOT.UPDATEA - - IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) - IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') - & IER = SYS$ASCTIM(,FILDATE,,) - IF (BULLFIL.EQ.1) FILDATE = EXDATES - FILDATE = FILDATE(FIRST_ALPHA(FILDATE):) - - M = INDEX(FILDATE,'-')L - FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'), - & INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'// - & FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'// - & FILDATE(:M-1)//FILDATE(M+1:M+3)R - - IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN - FOLDER_FILE = FOLDER1_FILE - IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL - IF (BULLFIL.EQ.-1) THENM - BULLFIL = 1 - CALL OPEN_BULLFIL - ELSE IF (BULLFIL.EQ.-2) THEN - BULLFIL = 2 - CALL OPEN_BULLFIL_SHAREDT - END IF - END IF( - T - IF (UPDATE) THEN M - READ (1'1) NBLOCK - REWRITE (1) NBLOCK + LENGTHU - UPDATE = .FALSE. - END IFS - - RETURN2 - END - - - - INTEGER FUNCTION MINGT0(I,J) - - IMPLICIT INTEGER (A-Z) - - IF (I.LE.0) THENT - MINGT0 = J - ELSE IF (J.LE.0) THEN - MINGT0 = I - ELSE) - MINGT0 = MIN(I,J)E - END IF - - RETURNI - END diff --git a/decus/vax92b/bulletin/bulletin9.for b/decus/vax92b/bulletin/bulletin9.for deleted file mode 100644 index fb0a304..0000000 --- a/decus/vax92b/bulletin/bulletin9.for +++ /dev/null @@ -1,2006 +0,0 @@ -C -C BULLETIN9.FOR, Version 1/15/93 -C Purpose: Contains subroutines for the bulletin board utility program. -C Environment: VAX/VMS -C Usage: Invoked by the BULLETIN command. -C Programmer: Mark R. London -C - SUBROUTINE DELETE_NODE -C -C SUBROUTINE DELETE_NODE -C -C FUNCTION: Deletes files sent via ADD/NODES at remote hosts. -C - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLDIR.INC' - - COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM, - & NODE_ERROR,POINT_NODE - CHARACTER*32 NODES(10) - LOGICAL LOCAL_NODE_FOUND,NODE_ERROR - - CHARACTER INLINE*80 - - CALL GET_NODE_INFO - - IF (NODE_ERROR) GO TO 940 - - IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN - WRITE (6,'('' ERROR: Cannot specify local node.'')') - GO TO 999 - END IF - - IER = CLI$GET_VALUE('SUBJECT',DESCRIP) - - DO POINT_NODE=1,NODE_NUM ! Write out command to nodes - NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name - INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP)) - WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE - READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE - IF (INLINE.EQ.'END') THEN - WRITE (6,'('' Message successfully deleted from node '',A)') - & NODES(POINT_NODE) - ELSE - WRITE (6,'('' Error while deleting message to node '',A)') - & NODES(POINT_NODE) - WRITE (6,'(A)') INLINE - END IF - END DO - - GO TO 999 - -910 WRITE (6,1010) - GO TO 999 - -940 WRITE (6,1015) NODES(POINT_NODE) - -999 DO WHILE (NODE_NUM.GT.0) - CLOSE(UNIT=9+NODE_NUM) - NODE_NUM = NODE_NUM - 1 - END DO - - RETURN - -1010 FORMAT (' ERROR: Deletion aborted.') -1015 FORMAT (' ERROR: Unable to reach node ',A) - - END - - - - - SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME) -C -C SUBROUTINE SET_FOLDER_FLAG -C -C FUNCTION: Sets or clears specified flag for folder -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) FLAGNAME - - IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN - WRITE (6,'('' ERROR: Command invalid for folder.'')') - ELSE IF (FLAG.EQ.7.AND..NOT.SETPRV_PRIV()) THEN - WRITE (6,'('' ERROR: Privileges required for this command.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - IF (REMOTE_SET.NE.4) THEN - CALL OPEN_BULLFOLDER ! Open folder file - ELSE - CALL OPEN_BULLNEWS_SHARED - END IF - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - IF (SETTING) THEN - FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG) - ELSE - FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG) - END IF - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - - WRITE (6,'(1X,A,'' has been modified for folder.'')') - & FLAGNAME - ELSE - WRITE (6,'(1X,'' You are not authorized to modify '',A)') - & FLAGNAME//'.' - END IF - - RETURN - END - - - - - SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT) -C -C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT -C -C FUNCTION: Sets folder expiration limit. -C - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC' - - INCLUDE 'BULLFILES.INC' - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - IF (REMOTE_SET.EQ.3) THEN - WRITE (6,'('' ERROR: Command invalid for folder. '')') - ELSE IF (LIMIT.LT.0) THEN - WRITE (6,'('' ERROR: Invalid expiration length specified.'')') - ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN - CALL OPEN_BULLFOLDER ! Open folder file - - CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) - - F_EXPIRE_LIMIT = LIMIT - - CALL REWRITE_FOLDER_FILE(IER) - - CALL CLOSE_BULLFOLDER - WRITE (6,'('' Folder expiration date modified.'')') - ELSE - WRITE (6,'('' You are not allowed to modify folder.'')') - END IF - - RETURN - END - - - - - - SUBROUTINE MERGE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE - - ENTRY INITIALIZE_MERGE(IER1) - - DO WHILE (FILE_LOCK(IER1,IER2)) - OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) - & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED', - & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, - & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE', - & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') - END DO - - IF (IER1.NE.0) RETURN - - NBULL = 0 - - WRITE(24,IOSTAT=IER1) BULLDIR_HEADER - CALL CONVERT_HEADER_FROMBIN - - TO_POINTER = 1 - - RETURN - - ENTRY ADD_MERGE_TO(IER1) - - IER1 = 0 - - DO WHILE (IER1.EQ.0) - - BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY - - CALL READDIR(TO_POINTER,IER) - - DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM) - IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - CALL CONVERT_ENTRY_FROMBIN - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - - BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE - END DO - - CLOSE (UNIT=24) - - RETURN - - ENTRY ADD_MERGE_FROM(IER1) - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE) - IF (DIFF.GT.0) THEN - NEWEST_EXDATE = EXDATE - NEWEST_EXTIME = EXTIME - ELSE IF (DIFF.EQ.0) THEN - DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME) - IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME - END IF - - IF ((SYSTEM.AND.4).EQ.4) THEN - SHUTDOWN = SHUTDOWN + 1 - SHUTDOWN_DATE = DATE - SHUTDOWN_TIME = TIME - END IF - - BLOCK = NBLOCK - LENGTH - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - RETURN - - ENTRY ADD_MERGE_REST(IER1) - - CALL UPDATE_LOGIN(.TRUE.) - - DO WHILE (IER1.EQ.0) - - CALL READDIR(TO_POINTER,IER) - IF (TO_POINTER+1.NE.IER) THEN - READ (24,KEYID=0,KEY=0,IOSTAT=IER1) - CALL CONVERT_HEADER_TOBIN - REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER - IF (IER1.EQ.0) THEN - CLOSE (UNIT=24,DISPOSE='KEEP') - CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// - & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR') - ELSE - CLOSE (UNIT=24) - END IF - RETURN - END IF - - NBULL = NBULL + 1 - MSG_NUM = NBULL - - CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) - WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY - - NEWEST_DATE = DATE - NEWEST_TIME = TIME - - TO_POINTER = TO_POINTER + 1 - END DO - - CLOSE (UNIT=24) - - RETURN - END - - - - - SUBROUTINE SET_NOKEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 0 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',) - - RETURN - END - - - - - - SUBROUTINE SET_KEYPAD - - IMPLICIT INTEGER (A-Z) - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYPAD/ KEYPAD_MODE - - COMMON /KEYLOAD/ LOAD_KEY - - INCLUDE '($SMGDEF)' - - KEYPAD_MODE = 1 - - TERM = SMG$M_KEY_TERMINATE - - IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1) - - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD') - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM, - & 'SHOW KEYPAD/PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM, - & 'SHOW FOLDER/FULL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',)n - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',)r - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',)C - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',)A - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',)R - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',)6 - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',)O - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',)= - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',)c - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) - IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',)' - - LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT', - & 'SYS$LOGIN:BULL.INI',1)9 - - RETURNR - END - - - - SUBROUTINE SHOW_KEYPAD(LIBRARY) - - IMPLICIT INTEGER (A-Z)O - EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT9 - CHARACTER*(*) LIBRARY - - COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID - - COMMON /KEYLOAD/ LOAD_KEYd - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - INCLUDE '($HLPDEF)' - - CHARACTER KEY*10,EQU*50,ST*20,IFS*20F - - OUT = 6 - - IF (CLI$PRESENT('PRINT')) THEN - OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT', - & IOSTAT=IER) - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')') - RETURNR - END IF - OUT = 8R - END IF C - - IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN - DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) - IER = SMG$GET_KEY_DEF( - & KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST)T - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THEN - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST))O - END IF - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS)) - END IF - WRITE (OUT,'(A)') '+' - END DO - RETURN - ELSE IF (LOAD_KEY) THEN - C = 0 - IER = 1I - WRITE (OUT,'(1X,A)') 'Keypad definitions:' - L = 1R - DO WHILE (IER) - IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST)T - IF (IER) THEN - WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'// - & EQU(:TRIM(EQU))//'"' - IF (TRIM(ST).GT.0) THENI - WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST)) - END IF: - IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN - WRITE (OUT,'(A,$)') '+ '//'ifstate=' - & //IFS(:TRIM(IFS))M - END IFE - WRITE (OUT,'(A)') '+' - L = L + 1 - IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN - L = 0 ! Reinitialize screen counter - CALL LIB$PUT_OUTPUT(' ')A - CALL GET_INPUT_NOECHO_PROMPT( - & KEY(:1),'Press key to continue ... ') - IER = LIB$ERASE_PAGE(1,1) ! Erase displayM - END IFA - END IFE - END DO - IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE')r - RETURN - END IF' - - IF (OUT.EQ.8) THEN - CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD') - & ,LIBRARY,HLP$M_HELP) - CLOSE (UNIT=8,DISP='PRINT/DELETE') - ELSEE - CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD'' - & ,LIBRARY,HLP$M_HELP) - END IFL - - RETURND - END - - INTEGER FUNCTION PRINT_OUTPUT(INPUT) - IMPLICIT INTEGER (A-Z)I - CHARACTER*(*) INPUT - WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT)) - IF (IER.EQ.0) PRINT_OUTPUT = 1U - RETURND - END - - - - SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY) -C/ -C SUBROUTINE OUTPUT_HELPN -CE -C FUNCTION: -C To create interactive help session. Prompting is enabled. -C INPUTS: -C PARAMETER - Character string. Optional input parameter -C containing a list of help keys. -C LIBRARY - Character string. Name of help library.R -C - IMPLICIT INTEGER (A-Z)1 - - INCLUDE '($LBRDEF)' - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACTE - CHARACTER*20 KEY(10) - DIMENSION KEYL(10)D - - EXTERNAL PUT_OUTPUT - - CHARACTER*(*) LIBRARY,PARAMETER - - CHARACTER*80 PROMPT - - DATA DISPLAY_ID/0/,KEYBOARD_ID/0/ - - IF (KEYBOARD_ID.EQ.0) THEN_ - IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20) - IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID) - END IF - - CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input - - CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library readF - CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name - - DO I=1,10 ! Initialize key lengths) - KEYL(I) = 0 - END DO - - NKEY = 0 ! Number of help keysM - - DO WHILE (1) ! Do until CTRL-Z entered or no more keys - - HELP_PAGE = 0 ! Init line counter - NEED_ERASE = .TRUE. ! Need to erase screenM - - OLD_NKEY = NKEY ! Save old key count - EXACT = .TRUE. ! Exact key matchT - - DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND.L - & HELP_INPUT(:1).NE.'?') - ! Break input into keys - NKEY = NKEY + 1 ! Increment key counter - - DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0) - HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces( - HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input - END DO - - NEXT_KEY = 2T - - DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search forI - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or - & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash - NEXT_KEY = NEXT_KEY + 1 ! indicating start of next keyR - END DO - - IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key - KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key stringG - KEYL(NKEY) = HELP_INPUT_LEN ! Key lengthA - HELP_INPUT_LEN = 0 - ELSE ! Found the next key - KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1) - HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN)D - KEYL(NKEY) = NEXT_KEY - 1 - HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1E - END IFA - END DO - HELP_INPUT_LEN = 0 - IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help - & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)),E - & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)), - & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)), - & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10)))G - - IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1_ - ! IER = 0 special case means input given to full screen prompt - - IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact matchT - DO I=OLD_NKEY+1,NKEY ! then don't updateD - KEYL(I) = 0 ! new keys - END DOA - NKEY = OLD_NKEY - END IF - - IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics? - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IF - - DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0) - IF (NKEY.EQ.0) THEN ! If top level, prompt for topicG - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Topic? ',HELP_INPUT_LEN)K - ELSE ! If not top level, prompt for subtopicD - LPROMPT = 0 ! Create subtopic prompt lineL - DO I=1,NKEY ! Put spaces in between keys - PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' ' - LPROMPT = LPROMPT + KEYL(I) + 1A - END DOK - PROMPT = PROMPT(:LPROMPT)//'Subtopic? ' - LPROMPT = LPROMPT + 10, - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN) - END IF, - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) - IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered - KEYL(NKEY) = 0 ! Back up one key level - NKEY = NKEY - 1 - END IFT - END DO - - IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level, - CALL LIB$PUT_OUTPUT(' ') ! Skip line - CALL LBR$CLOSE(LINDEX) ! then close library, - RETURN ! and end help session. - END IF - - END DOK - - END - - - - INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL)K -C, -C FUNCTION PUT_OUTPUT -CG -C FUNCTION: -C Output routine for input from LBR$GET_HELP. DisplaysS -C help text on terminal with full screen prompting.R -C INPUTS: -C INPUT - Character string. Line of input text. -C INFO - Longword. Contains help flag bits.S -C DATA - Longword. Not presently used. -C LEVEL - Longword. Contains current key level. -CR - IMPLICIT INTEGER (A-Z)B - - INCLUDE '($HLPDEF)' - - COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACTM - CHARACTER*20 KEY(10), - DIMENSION KEYL(10)Y - - COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN - COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO - CHARACTER*80 HELP_INPUT - - COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING - - CHARACTER INPUT*(*) - - CHARACTER SPACES*20 - DATA SPACES /' '/ - - OTHERINFO = INFO.AND.HLP$M_OTHERINFOE - - IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be foundZ - NEED_ERASE = .FALSE. ! Don't erase screen - IF (HELP_PAGE.EQ.0) THEN ! If first line of help text - DO I=OLD_NKEY+1,NKEY ! remove any new keys thatG - KEYL(I) = 0 ! were inputted, as they areF - END DO ! not valid, as no matchF - NKEY = OLD_NKEY ! could be found. - END IF - ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND. - & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND.I - & %LOC(INPUT).NE.0) THEN ! If text contains key names - ! Update if not wildcard search and they are new keys - IF (KEYL(LEVEL).GT.0) THEN ! If key already updated - EXACT = .FALSE. ! Must be more than one match possible - END IF ! so indicate not exact match.R - START_KEY = 1 ! String preceeding spaces. - DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ') - START_KEY = START_KEY + 1 - END DO - KEY(LEVEL) = INPUT(START_KEY:) ! Store new key - CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length. - ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text, - DO I=OLD_NKEY+1,NKEY ! remove any new keys that - KEYL(I) = 0 ! were just inputted, allowing - END DO ! this routine to fill them. - END IF - - IF (NEED_ERASE) THEN ! Need to erase screen? - IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic.Y - NEED_ERASE = .FALSE. - END IF - - HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter - IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page? - HELP_PAGE = 0 ! Reinitialize screen counter+ - CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screenF - IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID, - & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN) - CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input - IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input? - EXACT = .TRUE. ! If more than one match was found and being - ! displayed, text input specifies that the - ! current displayed match is desired.& - PUT_OUTPUT = 0 ! Stop any more of current help display. - ELSE ! Else if RETURN entered - IER = LIB$ERASE_PAGE(1,1) ! Erase display - NSPACES = LEVEL*2 ! Number of spaces to indent output - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2P - ! Key name lines are indented 2 less than help description. - IF (NSPACES.GT.0) THEN ! Add spaces if present to outputB - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) - ELSE ! Else just output text. - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IFA - HELP_PAGE = 1 ! Increment page counter.I - END IF - ELSE ! Else if not end of page - NSPACES = LEVEL*2 ! Just output text line - IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 - IF (NSPACES.GT.0) THEN - PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT)A - ELSE - PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT) - END IF - END IFt - - RETURNy - END - - - - - SUBROUTINE SHOW_VERSION - - IMPLICIT INTEGER (A-Z)P - - CHARACTER VERSION*12,DATE*24' - - CALL READ_HEADER(VERSION,DATE)A - - WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION)) - - WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE)) - - RETURNV - END - - - - - SUBROUTINE FULL_DIR(INDEX_COUNT) -C( -C Add INDEX command to BULLETIN, display directories of ALLT -C folders. -CP - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLDIR.INC' - INCLUDE 'BULLFILES.INC' - INCLUDE 'BULLFOLDER.INC' - INCLUDE 'BULLUSER.INC'L - - COMMON /POINT/ BULL_POINT - - COMMON /TAGS/ BULL_TAG,READ_TAG - - COMMON /NEW_DIR/ NEW - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - DATA FOLDER_Q1/0/ - - CHARACTER NEWS_ACCESS*132 - - BULL_POINT = 0 - - IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART') - & .AND.INDEX_COUNT.EQ.1) THENg - INDEX_COUNT = 2 - DIR_COUNT = 0 - END IF - - IF (INDEX_COUNT.EQ.1) THENL - CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) - - FOLDER_Q = FOLDER_Q1 - - SET = CLI$PRESENT('SET')E - NEW = CLI$PRESENT('NEW')a - INEW = NEW - - IREAD_TAG = IBSET(0,1) + IBSET(0,2) - IF (CLI$PRESENT('MARKED')) THEN - IREAD_TAG = 1 + IBSET(0,1) - ELSE IF (CLI$PRESENT('SEEN')) THEN - IREAD_TAG = 1 + IBSET(0,2) - ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT - & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN_ - IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3)H - ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT - & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THENa - IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3)_ - END IF - - NEW = NEW.AND..NOT.IREAD_TAGN - - SUBSCRIBE = CLI$PRESENT('SUBSCRIBE')_ - IF (SUBSCRIBE) THEN - CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT)U - SUBNUM = 1 - CALL OPEN_BULLNEWS_SHAREDE - ELSEK - CALL OPEN_BULLFOLDER_SHAREDe - END IFE - - NUM_FOLDERS = 0 - IER = 0 - DO WHILE (IER.EQ.0) ! Copy all bulletins from fileH - IF (SUBSCRIBE) THEN - IER = 1 - DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) - CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) - IF (SUBNUM.NE.0) THENL - CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER)P - IF (IER.NE.0) THEN - SUBNUM = -1 - ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL - & .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN - IER = 1L - END IF - END IF - END DO - IF (SUBNUM.EQ.0) IER = 1 - ELSEK - FOUND = .FALSE.E - DO WHILE (.NOT.FOUND.AND.IER.EQ.0) - CALL READ_FOLDER_FILE_TEMP(IER) - IF (IER.EQ.0) THENE - IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER)E - & .OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THENt - FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM - & (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0D - END IFd - END IFY - END DO - END IF - IF (IER.EQ.0) THENL - IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THENQ - FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))o - & //FOLDER1 - IF (SUBSCRIBE) THEN - CALL CHECK_ACCESS - & (NEWS_ACCESS(FOLDER_DESCRIP), - & USERNAME,READ_ACCESS,-1) - ELSE - CALL CHECK_ACCESS - & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', - & USERNAME,READ_ACCESS,-1) - END IF - ELSEM - READ_ACCESS = 1 - END IFn - IF (READ_ACCESS) THEN - NUM_FOLDERS = NUM_FOLDERS + 1( - CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)I - END IFD - END IF - END DOP - - CALL CLOSE_BULLFOLDER ! We don't need file anymore - - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - IF (NEW) THEN - WRITE (6,1010) - ELSE) - WRITE (6,1000) - END IF$ - IF (SUBSCRIBE) THEN - WRITE (6,1025) - ELSEI - WRITE (6,1020) - END IF! - DO J = 1,NUM_FOLDERSY - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (SUBSCRIBE) THEN - WRITE (6,1035) FOLDER1_DESCRIP(:72),F1_NBULL - ELSE - WRITE (6,1030) FOLDER1,F1_NBULL - END IF - END DOL - IF (NUM_FOLDERS.EQ.0) THENs - WRITE (6,1050) - INDEX_COUNT = 0e - RETURN - END IFD - WRITE (6,1060) - FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header - INDEX_COUNT = 2 - DIR_COUNT = 0 - RETURNt - ELSE IF (INDEX_COUNT.EQ.2) THEN - READ_TAG = IREAD_TAG - IF (DIR_COUNT.LE.0) THEN - F1_NBULL = 0 - DIR_COUNT = 0 - DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0) - NUM_FOLDERS = NUM_FOLDERS - 1s - CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM) - IF (F1_NBULL.GT.0) THENe - FOLDER_NUMBER = -1A - CALL SELECT_FOLDER(.FALSE.,IER) - IF (.NOT.IER) F1_NBULL = 0C - END IF - END DO, - - IF (F1_NBULL.EQ.0) THEN - WRITE (6,1050) - INDEX_COUNT = 0N - RETURN - END IFS - END IF - _ - IF (READ_TAG) THEN - CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)G - ELSE IF (INEW) THENA - NEW = INEW - IF (REMOTE_SET.GE.3) THEN/ - CALL NEWS_GET_NEWEST_MESSAGE(IER) - IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1 - ELSED - CALL FIND_NEWEST_BULLs - END IF - END IF - - CALL DIRECTORY(DIR_COUNT) - IF (DIR_COUNT.GT.0) RETURN - - IF (NUM_FOLDERS.GT.0) THEN - WRITE (6,1040)= - ELSE - INDEX_COUNT = 0 - END IF - END IF - - RETURNl - -1000 FORMAT (' The following folders are present'/)o -1010 FORMAT (' The following folders with new messages are present'/). -1020 FORMAT (' Name',42X,'Count'/) -1025 FORMAT (' Name',70X,'Count'/) -1030 FORMAT (1X,A,1X,I6) -1035 FORMAT (1X,A,1X,I6) -1040 FORMAT (' Type Return to continue to the next folder...') -1050 FORMAT (' End of folder search.') -1060 FORMAT (' Type Return to continue...')A - - END - - - - - - SUBROUTINE SHOW_USERb -C -C SUBROUTINE SHOW_USERe -Ct -C FUNCTION: Shows information for specified users.g -Ca - IMPLICIT INTEGER (A-Z)( - - INCLUDE 'BULLFOLDER.INC' - - INCLUDE 'BULLUSER.INC'Y - - INCLUDE 'BULLDIR.INC' - - COMMON /POINT/ BULL_POINT - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - COMMON /CTRLC_FLAG/ FLAGI - - DIMENSION NOLOGIN_BTIM(2),START_BTIM(2) - - CHARACTER DATETIME*17 - - DIMENSION LAST(2,FOLDER_MAX) - INTEGER*2 LAST2(4,FOLDER_MAX) - EQUIVALENCE (LAST,LAST2)N - - ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL')I - & .OR.CLI$PRESENT('LOGIN') - - SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER= - - IF (.NOT.ALL) THENm - IER = CLI$GET_VALUE('USERNAME',TEMP_USER)T - IF (.NOT.IER) TEMP_USER = USERNAME - END IFG - - IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THENU - WRITE (6,'('' ERROR: No privs to use command.'')') - RETURN - END IFI - - CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)U - - FOLDER_PRESENT = CLI$PRESENT('FOLDER')A - - IF (FOLDER_PRESENT) THENN - IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME) - IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME - NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1) - & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z')p - IF (.NOT.NEWS) THEN - CALL OPEN_BULLFOLDER_SHARED - ELSE - CALL OPEN_BULLNEWS_SHARED - CALL LOWERCASE(FOLDER1_NAME)R - END IF - CALL READ_FOLDER_FILE_KEYNAME_TEMP - & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER)o - CALL CLOSE_BULLFOLDER - IF (IER.NE.0) THEN - WRITE (6,'('' ERROR: Folder not found.'')') - RETURNi - END IF - END IFe - - SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START')c - IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN - IF (.NOT.NEWS) THEN) - IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM) - IF (.NOT.IER) THEN) - WRITE (6,'('' ERROR: Invalid date specified.'')')t - RETURNN - END IF! - ELSE - WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')') - RETURNL - END IF - ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN - IF (NEWS) THEN - IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), - & STARTMSG,,%VAL(1)) - IF (.NOT.IER) THENt - WRITE (6,'('' ERROR: Invalid number specified.'')') - RETURNN - END IF - ELSE - WRITE (6,'('' ERROR: /START not valid with folder.'')') - RETURNB - END IF - ELSE IF (SINCE) THENR - IF (BULL_POINT.EQ.0) THENn - WRITE (6,'('' ERROR: No current message.'')') - RETURNU - ELSE IF (NEWS) THEN - STARTMSG = BULL_POINT - ELSE - START_BTIM(1) = MSG_BTIM(1) - START_BTIM(2) = MSG_BTIM(2) - END IF - ELSE IF (.NOT.NEWS) THENN - CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM) - ELSEO - STARTMSG = 1 - END IFM - - CALL DISABLE_CTRL - CALL DECLARE_CTRLC_AST/ - IF (FOLDER_PRESENT) THENM - CALL OPEN_BULLINF_SHARED - IER = 0 - DO WHILE (IER.EQ.0.AND.FLAG.NE.1)1 - IF (ALL) THEN - DO WHILE (REC_LOCK(IER)) - READ (9,IOSTAT=IER) TEMP_USER,LASTE - END DO - ELSE - IF (NEWS) THEN - LU = TRIM(TEMP_USER) - TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) - IF (LU.GT.1) THEN - TEMP_USER(LU-1:LU-1) =N - & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))I - ELSE - TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2))) - END IF, - END IF - DO WHILE (REC_LOCK(IER)) - READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST' - END DO - END IF - UNLOCK 9$ - IF (IER.EQ.0) THENA - LU = TRIM(TEMP_USER) - I = MAX(LU,2) - DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7)) - I = I - 1) - END DO - IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND._ - & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THENS - TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127) - TEMP_USER(I-1:I-1) = - & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127) - I = 0E - NEWSMSG = 1 - DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBERS - & .AND.NEWSMSG.LE.FOLDER_MAX) - NEWSMSG = NEWSMSG + 1 - END DOE - IF (NEWSMSG.LE.FOLDER_MAX) THENI - FOUND = LAST(2,NEWSMSG).GE.STARTMSG - ELSE - FOUND = .FALSE. - END IF - ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN - FOUND = COMPARE_BTIM - & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0 - ELSE - FOUND = .FALSE.F - END IFF - IF (FOUND.AND.NEWS) THEN. - WRITE (6,'(1X,A,'' latest message read '', - & I,''.'')')( - & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG) - ELSE IF (FOUND) THENN - CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),) - WRITE (6,'(1X,A,'' latest message read '',A,''.'')')2 - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - ELSE IF (.NOT.ALL) THEN - WRITE (6,'('' User has never read or not subscribed'', - & '' to specified folder.'')'). - END IF - END IF - IF (.NOT.ALL) THEN - IF (IER.NE.0) THEN - WRITE (6,'('' User info does not exist.'')') - END IFO - IER = 2 - END IFF - END DO - CALL CLOSE_BULLINF - ELSE IF (.NOT.ALL) THEN - CALL OPEN_BULLUSER_SHARED( - CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) - IF (IER.EQ.0) THEN - IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN - WRITE (6,'('' NOLOGIN set for specified user.'')') - ELSE: - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) - WRITE (6,'('' User last logged in at '',A,''.'')') - & DATETIME - END IFI - ELSE - WRITE (6,'('' Entry for specified user not found.'')') - END IF - CALL CLOSE_BULLUSERR - ELSEE - CALL OPEN_BULLUSER_SHAREDE - CALL READ_USER_FILE(IER) - DO WHILE (IER.EQ.0.AND.FLAG.NE.1) - CALL READ_USER_FILE(IER)Q - IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND.N - & TEMP_USER(:1).NE.'*') THEN - IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM)H - IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN - WRITE (6,'('' NOLOGIN set for '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)) - ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND. - & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THENR - CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,)S - WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') - & TEMP_USER(:TRIM(TEMP_USER)),DATETIME - END IFR - END IFe - END DO - CALL CLOSE_BULLUSER= - END IFR - CALL CANCEL_CTRLC_AST - CALL ENABLE_CTRLN - - RETURNN - END - - - - - SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER) -CU -C SUBROUTINE INIT_MESSAGE_ADD -C. -C FUNCTION: Opens specified folder in order to add message. -CA -C INPUTS: -C IN_FOLDER - Character string containing folder name -C IN_FROM - Character string containing name of owner of message. -C If empty, the message is searched for either a -C Reply-to: field or a From: field. If none, then -C the owner of the process is used. If IN_FROME -C ends with a %, it is assumed that it is simply -C the prefix that should be when responding to the -C address via MAIL. I.e. the PMDF interface sends -C IN%, so when the From: field is found, the message -C owner becomes IN%"from-address". -C IN_DESCRIP - Character string containing subject of message. -C If empty, the message is searched for a line -C which starts with "Subj:" or "Subject:". -C OUTPUTS: -C IER - Error status. True if properly connected to folder. -C False if folder not found.R -C - IMPLICIT INTEGER (A - Z)e - - INCLUDE 'BULLFILES.INC' - - INCLUDE 'BULLFOLDER.INC'e - - INCLUDE 'BULLDIR.INC' - - COMMON /BCP/ BULLCP - LOGICAL BULLCP5 - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROA - CHARACTER*12 PROTOCOL - DATA LPRO/0/) - - COMMON /DIGEST/ LDESCR,FIRST_BREAKe - - CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPE - COMMON /MAIN_HEADER_INFO/ INEXDATE - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /TEXT_PRESENT/ TEXTi - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./ - - COMMON /SCRTYPE/ SCRTYPEG - DATA SCRTYPE/0/ - - COMMON /BULLPAR/ BULL_PARAMETER,LEN_P - CHARACTER*64 BULL_PARAMETER - - IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER) - IF (IER.EQ.1.AND.LEN_P.GT.0 - & .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,) - - BULLCP = 1 ! Inhibit folder cleanup subprocess. - - CALL CHECK_DIR_ACCESS() - - CALL INIT_COMPRESST - - CALL OPEN_BULLFOLDER ! Get folder fileR - - CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER)R - - CALL CLOSE_BULLFOLDER - - IF (IER.NE.0) THENe - CALL ERRSNS(IDUMMY,IER)E - RETURN - ELSE_ - IER = 1- - END IF0 - - FOLDER_NAME = FOLDER - - ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER) - - TEXT = .FALSE. ! No text written, as of yet - - FIRST_BREAK = .TRUE.O - - IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folderM - FOLDER_SET = .FALSE. ! indicate it - ELSE ! Else it's another folderp - FOLDER_SET = .TRUE. ! indicate it - END IFN - - FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))// - & FOLDER ! set folder file names - - ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER) - - CALL OPEN_BULLDIR ! Open directory file - - CALL OPEN_BULLFIL ! Open data file - - CALL READDIR(0,IER1) ! Get NBLOCKo - IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0I - - NBLOCK = NBLOCK + 1 - LENGTH = NBLOCK ! Initialize line count - - LEN_FROM = TRIM(IN_FROM)A - - IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol - PROTOCOL = IN_FROM(:LEN_FROM)//'"' - LPRO = LEN_FROM + 1 - LEN_FROM = 0 - END IFI - - IF (LEN_FROM.GT.0) THEN - INFROM = IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THENR - CALL STORE_FROM(INFROM,LEN_FROM)) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocolL - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO)( - END IF - LEN_DESCRP = TRIM(IN_DESCRIP)G - IF (LEN_DESCRP.GT.0) THEN) - INDESCRIP = IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)R - END IFl - ELSE - DESCRIP = ' ' - END IF - ELSEE - OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR', - & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW') - SCRTYPE = 0 - IF (IER1.NE.0) THENT - OPEN (UNIT=3,DISPOSE='DELETE',FILE='BULL.SCR',S - & FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW')W - SCRTYPE = 1 - END IF - SAVE_IN_DESCRIP = IN_DESCRIP - SAVE_IN_FROM = ' ' - END IFI - - OLD_BUFFER = ' 'T - - OLD_BUFFER_SUBJ = .FALSE. - OLD_BUFFER_FROM = .FALSE. - - INEXDATE = .FALSE.H - - RETURNE - END - - - - SUBROUTINE WRITEOUT_STOREDE - - IMPLICIT INTEGER (A-Z) - - INCLUDE 'BULLFOLDER.INC'I - - CHARACTER*256 BUFFER9 - - REWIND (UNIT=3) - - IER = 0 - DO WHILE (IER.EQ.0) - READ (3,'(A)',IOSTAT=IER) BUFFER - IF (IER.EQ.0) THEN - CALL WRITE_MESSAGE_LINE(BUFFER) - END IF - END DO - - IF (BTEST(FOLDER_FLAG,5)) RETURNS - IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3)H - IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3) - - RETURN - END - - - - SUBROUTINE WRITE_MESSAGE_LINE(BUFFER) -C -C SUBROUTINE WRITE_MESSAGE_LINE -CK -C FUNCTION: Writes one line of message into folder.T -C_ -C INPUTS: -C BUFFER - Character string containing line to be put into message.. -CT - - IMPLICIT INTEGER (A-Z)E - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPM - COMMON /MAIN_HEADER_INFO/ INEXDATEP - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /DIGEST/ LDESCR,FIRST_BREAK& - DATA FIRST_BREAK/.TRUE./- - - COMMON /TEXT_PRESENT/ TEXT - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*(*) BUFFERM - - COMMON /LAST_BUFFER/ OLD_BUFFER - CHARACTER*(INPUT_LENGTH) OLD_BUFFER - - COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINEN - - CHARACTER*24 TODAY - - DATA STORED /.FALSE./ - - LEN_BUFFER = TRIM(BUFFER) - - IF (LEN_FROM.EQ.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - IF (LEN_BUFFER.GT.LINE_LENGTH) THEN' - WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER) - END IF - IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - SAVE_IN_FROM = - & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER) - RETURN2 - ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. - & BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN - INDESCRIP = r - & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER) - LDESCR = LDESCR + LEN_BUFFER. - RETURN - ELSE IF (BUFFER(:5).EQ.'From:') THEN - IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:)2 - OLD_BUFFER_FROM = .TRUE. - OLD_BUFFER_SUBJ = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - INDESCRIP = BUFFER(10:) - OLD_BUFFER_SUBJ = .TRUE.B - OLD_BUFFER_FROM = .FALSE. - RETURN - ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN - IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) - OLD_BUFFER_FROM = .TRUE.& - OLD_BUFFER_SUBJ = .FALSE. - RETURNW - ELSE IF (LEN_BUFFER.EQ.0) THEN - IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM) - LEN_FROM = TRIM(SAVE_IN_FROM) - IF (LEN_FROM.GT.0) THEN - OLD_BUFFER_FROM = .FALSE. - INFROM = SAVE_IN_FROM - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_FROM(INFROM,LEN_FROM) - ELSE IF (INDEX(INFROM,'%"').GT.0) THEN_ - LPRO = INDEX(INFROM,'%"') + 1 - PROTOCOL = INFROM(:LPRO) - END IFH - IF (LDESCR.GT.0) THEN - LEN_DESCRP = LDESCR' - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - ELSET - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)& - IF (LEN_DESCRP.GT.0) THEN - INDESCRIP = SAVE_IN_DESCRIPA - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - ELSED - DESCRIP = ' ' - END IF - END IFI - STORED = .TRUE. - IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STOREDM - STORED = .FALSE. - END IF) - END IF - OLD_BUFFER_FROM = .FALSE. - OLD_BUFFER_SUBJ = .FALSE.d - RETURN - END IFs - IF (BTEST(FOLDER_FLAG,5)) THENE - IF (INDEX(BUFFER,'-------------').EQ.1) THEN - BREAK = .TRUE.r - DO I=1,LEN_BUFFER - IF (BUFFER(I:I).NE.'-') BREAK = .FALSE. - END DOo - ELSE - BREAK = .FALSE. - END IF - IF (BREAK) THENn - IF (.NOT.FIRST_BREAK) THENi - CALL FINISH_MESSAGE_ADD - CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER) - ELSEh - FIRST_BREAK = .FALSE. - CLOSE (UNIT=3)I - END IFt - LFROM = 0 - LDESCR = 0e - RETURN - ELSE IF (.NOT.FIRST_BREAK) THENo - IF (LDESCR.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - LDESCR = LEN_BUFFER - 9 - CALL STORE_DESCRP(BUFFER(10:),LDESCR) - IF (LFROM.EQ.0) THEN - LFROM = LEN_FROMo - CALL STORE_FROM(INFROM,LFROM). - END IF - ELSE IF (BUFFER(:6).EQ.'From: ') THEN - LFROM = LEN_BUFFER - 6 - IF (LFROM.LE.0) THEN - LFROM = TRIM(SAVE_IN_FROM) - IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1 - CALL STORE_FROM(PROTOCOL(:LPRO)// - & SAVE_IN_FROM//'"',LFROM) - ELSE( - CALL STORE_FROM(SAVE_IN_FROM,LFROM) - END IFE - ELSE IF (LPRO.GT.0) THEN - LFROM = LFROM + LPRO + 1C - CALL STORE_FROM(PROTOCOL(:LPRO)// - & BUFFER(7:LEN_BUFFER)//'"',LFROM)A - ELSE - CALL STORE_FROM(BUFFER(7:),LFROM)E - END IF - END IFM - RETURNU - END IFR - ELSE - IF (LEN_BUFFER.GT.0) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)) - ELSEA - WRITE (3,'(A)') ' ' - END IFM - TEXT = .TRUE. - RETURN/ - END IF - END IFR - - IF (LEN_BUFFER.EQ.0) THEN ! If empty lineM - CALL STORE_BULL(1,' ',NBLOCK) ! just store one space - ELSE) - IF (LEN_DESCRP.EQ.0) THEN - IF (BUFFER(:9).EQ.'Subject: ') THEN - DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:) - LEN_DESCRP = LEN_BUFFER - END IFL - END IF - IF (.NOT.INEXDATE) THENS - IF (BUFFER(:9).EQ.'Expires: '.OR. - & BUFFER(:11).EQ.'X-Expires: ') THEN - I = INDEX(BUFFER,' ')+1 - NODATE = .FALSE.O - DO J=I,LEN_BUFFER - IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN - BUFFER(J:J) = ' ' - END IF - END DOR - CALL STR$UPCASE(BUFFER(I:),BUFFER(I:)) - NODATE = .TRUE. - I = INDEX(BUFFER,' ')+1 - EXDATE(3:3) = '-' - EXDATE(7:7) = '-' - DO WHILE (I.LE.LEN_BUFFER)G - IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THENE - IF (NODATE) THENf - IF (INDEX(BUFFER(I:),' ').EQ.2) THEN - EXDATE(1:2) = '0'//BUFFER(I:I) - I = I + 1R - ELSE) - EXDATE(1:2) = BUFFER(I:I+1)e - I = I + 2I - END IF_ - NODATE = .FALSE.I - ELSE - IF (LEN_BUFFER-I.EQ.1.OR. - & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century? - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - YEAR = INDEX(TODAY(6:),'-')K - EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1) - I = I + 2A - ELSE_ - EXDATE(8:) = BUFFER(I:I+3) - I = I + 4 - END IFI - END IF/ - ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN - EXDATE(4:6) = BUFFER(I:I+2) - I = I + 3 - ELSE - I = I + 1 - END IF - END DOO - INEXDATE = .TRUE. - END IFO - END IF - CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK) - IF (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11)) THEN - WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH))) - END IF - TEXT = .TRUE. - END IFI - - RETURNS - END - - - - - SUBROUTINE FINISH_MESSAGE_ADD -CR -C SUBROUTINE FINISH_MESSAGE_ADD -CI -C FUNCTION: Writes message entry into directory file and closes folder -CO -C NOTE: Only should be run if INIT_MESSAGE_ADD was successful. -CE - - IMPLICIT INTEGER (A-Z)S - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'T - - INCLUDE 'BULLUSER.INC'S - - COMMON /DIGEST/ LDESCR,FIRST_BREAKO - - COMMON /SCRTYPE/ SCRTYPET - - COMMON /TEXT_PRESENT/ TEXTE - - COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPM - COMMON /MAIN_HEADER_INFO/ INEXDATET - CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP - - COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM - CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM - - CHARACTER*24 TODAYU - - DIMENSION BIN_EXTIME(2) - - IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN - IF (LEN_FROM.GT.0) THEN) - CALL STORE_FROM(INFROM,LEN_FROM)H - ELSE - CALL GETUSER(FROM)F - INFROM = FROM - LEN_FROM = TRIM(INFROM) - END IF - IF (LEN_DESCRP.GT.0) THEN) - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IF - LDESCRP = 1R - FIRST_BREAK = .FALSE. - CALL WRITEOUT_STORED - CLOSE (UNIT=3) - ELSE IF (LEN_FROM.EQ.0) THENT - CALL GETUSER(FROM) - INFROM = FROMr - LEN_FROM = TRIM(INFROM)- - LEN_DESCRP = TRIM(SAVE_IN_DESCRIP) - IF (LEN_DESCRP.GT.0) THENI - INDESCRIP = SAVE_IN_DESCRIP - IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN - CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) - END IFM - ELSE - DESCRIP = ' ' - END IF - CALL WRITEOUT_STORED - END IFD - - CALL FLUSH_BULL(NBLOCK) - - CALL CLOSE_BULLFIL ! Finished adding bulletin - - IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msgS - & .NOT.TEXT) THEN ! or no message text found - CALL CLOSE_BULLDIR ! then don't add message entry_ - RETURN - END IF) - - EXTIME = '00:00:00.00'U - IF (INEXDATE) THENA - IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME) - IF (IER) THEN ! If good date formatO - IER = SYS$ASCTIM(,TODAY,,) ! Get today's date - IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's - IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great?E - & .OR.IER.LE.0) THEN ! or expiration date not futureE - INEXDATE = .FALSE. ! Don't use it - END IFE - ELSE - INEXDATE = .FALSE. ! Don't use it1 - END IF - END IF - - IF (.NOT.INEXDATE) THEN - IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time?: - EXDATE = '5-NOV-2000' ! no, so set date far in futureL - SYSTEM = 2 ! indicate permanent message - ELSE ! Else set expiration dateB - CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) - SYSTEM = 0E - END IF - END IFB - - LENGTH = NBLOCK - LENGTH + 1 ! Number of records - - CALL ADD_ENTRY ! Add the new directory entry - - CALL CLOSE_BULLDIR ! Totally finished with add - - IF (BTEST(FOLDER_FLAG,11)) THEN - SLIST = INDEX(FOLDER_DESCRIP,'<')R - IF (SLIST.GT.0) THEN - INPUT = FOLDER_DESCRIP(SLIST+1:) - ILEN = INDEX(INPUT,'>') - 1 - IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)E - INPUT = INPUT(:ILEN). - CALL ADD_PROTOCOL(INPUT,ILEN)9 - CLOSE (UNIT=3,STATUS='SAVE')' - IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THENU - IER = LIB$SET_LOGICALM - & ('MX_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN - IER = LIB$SET_LOGICALS - & ('PMDF_REPLY_TO',INFROM(:TRIM(INFROM))) - ELSEI - USERNAME = FOLDER - END IF_ - IF (SCRTYPE.EQ.0) THEN - CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INPUT,A - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') - ELSEL - CALL RESPOND_MAIL('BULL.SCR',INPUT,0 - & INDESCRIP(:LEN_DESCRP),STATUS) - CALL LIB$DELETE_FILE('BULL.SCR;*') - END IFS - END IF - END IFS - - CALL UPDATE_FOLDER - - RETURN. - END - - - - - SUBROUTINE STORE_FROM(IFROM,LEN_INFROM) - - IMPLICIT INTEGER (A-Z)B - - COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO - CHARACTER*12 PROTOCOL - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) IFROM - - CHARACTER*(INPUT_LENGTH) INFROM - - INFROM = IFROM - - IF (LPRO.GT.0) THEN ! Protocol present? - I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL - IF (I.EQ.2) THEN - INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' - I = LPRO + 1 - LEN_INFROM = LEN_INFROM + LPRO + 1T - END IF - DO WHILE (I.LT.LEN_INFROM) - IF (INFROM(I:I).EQ.'"') THENB - INFROM(I:I) = ''''D - ELSE IF (INFROM(I:I).EQ.'\') THEN - INFROM(I+1:) = '\'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 1 - ELSE IF (INFROM(I:I).EQ.''''.AND. - & INDEX(INFROM,'@').GT.I) THEN - INFROM(I:) = '\s'//INFROM(I+1:) - LEN_INFROM = LEN_INFROM + 1 - I = I + 2 - END IF - I = I + 1 - END DO - END IF - - DO I=1,LEN_INFROM ! Remove control characters - IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' 'o - END DOI - - DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ')b - INFROM = INFROM(2:)S - LEN_INFROM = LEN_INFROM - 1 - END DOR - - TWO_SPACE = INDEX(INFROM,' ') - DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM) - INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:) - LEN_INFROM = LEN_INFROM - 1' - TWO_SPACE = INDEX(INFROM,' ') - END DOF - - CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM), - & NBLOCK) - - IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol programC - & INFROM = INFROM(INDEX(INFROM,'%"')+2:) - - IF (INDEX(INFROM,'::').GT.0) ! Strip off node name - & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER - - CALL GET_FROM(INFROM,LEN_INFROM)M - - RETURNL - END - - - SUBROUTINE GET_FROM(INFROM,LEN_INFROM): - - IMPLICIT INTEGER (A-Z): - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INFROM - - DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards.R - & INDEX(INFROM,'!').LT.INDEX(INFROM,'@'))E - INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user - END DOE - - DO WHILE (INDEX(INFROM,'<').GT.0.AND. ! Name may be of form - & INDEX(INFROM,'@').GT.INDEX(INFROM,'<'))E - INFROM = INFROM(INDEX(INFROM,'<')+1:)! personal-name E - END DO - - DO WHILE (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name)E - & INDEX(INFROM,'@').GT.INDEX(INFROM,'(')) - INFROM = INFROM(INDEX(INFROM,'(')+1:) - END DOR - - I = 1 ! Trim username to start at first alpha character - DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR. - & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR. - & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR. - & INFROM(I:I).EQ.'\'.OR. - & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')): - I = I + 1 - END DO - INFROM = INFROM(I:) - J = LEN_INFROM - I + 1B - - I = 1 ! Trim username to end at a alpha character) - DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND. - & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND. - & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND. - & INFROM(I:I).NE.'\'.AND., - & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.''''): - I = I + 1 - END DO - FROM = INFROM(:I-1) - - DO J=2,TRIM(FROM) - IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND. - & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR. - & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THENS - FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a'))6 - END IF - END DOA - - RETURND - END - - - - - SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP) - - IMPLICIT INTEGER (A-Z)F - - INCLUDE 'BULLDIR.INC' - - CHARACTER*(*) INDESCRIP - - CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP) - - DO I=1,LEN_DESCRP ! Remove control characters - IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' - END DO+ - - DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ') - INDESCRIP = INDESCRIP(2:)L - LEN_DESCRP = LEN_DESCRP - 1E - END DOF - - IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN( - ! Is length > allowable subject length?) - CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//N - & INDESCRIP(:LEN_DESCRP),NBLOCK) - END IFE - - DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP)))O - - RETURNH - END - - - - - - SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER)i -Ct -C SUBROUTINE STRIP_HEADER -C -C FUNCTION: Indicates whether line is part of mail message header. -CI -C INPUTS: -C BUFFER - Character string containing input line of message.C -C BLEN - Length of character string. If = 0, initialize subroutine. -C -C OUTPUTS:Y -C IER - If true, line should be stripped. Else, end of header.D -CI - IMPLICIT INTEGER (A - Z)R - - INCLUDE 'BULLDIR.INC' - - INCLUDE 'BULLFOLDER.INC'C - - COMMON /DATE/ DATE_LINE - CHARACTER*(INPUT_LENGTH) DATE_LINEE - - COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT - - CHARACTER*(*) BUFFER_ - - IF (TRIM(BUFFER).EQ.0) THEN - ! If STRIP not set for folder or empty line - IER = .FALSE.F - CONT_LINE = .FALSE.( - RETURN - END IF - - IF (BLEN.EQ.0) THEN - DATE_LINE = ' ' - CONT_LINE = .FALSE.( - END IF - - IER = .TRUE.M - - IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuationE - & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header lineD - - I = 1 - DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ') - IF (BUFFER(I:I).EQ.':') THEN ! Header line found - CONT_LINE = .TRUE. ! Next line might be continuationR - IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN - DATE_LINE = 'Message sent'//BUFFER(5:BLEN)P - IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THENF - DATE_LINE(TRIM(DATE_LINE)+1:) = '.'N - END IF - END IFI - RETURN - ELSE - I = I + 1 - END IF - END DO_ - - IER = .FALSE. - CONT_LINE = .FALSE. - - RETURNL - END diff --git a/decus/vax92b/bulletin/bulletin_announce.txt b/decus/vax92b/bulletin/bulletin_announce.txt deleted file mode 100644 index 3f99241..0000000 --- a/decus/vax92b/bulletin/bulletin_announce.txt +++ /dev/null @@ -1,513 +0,0 @@ -From: MERC::"uunet!ORYANA.PFC.MIT.EDU!BULLETIN" 24-NOV-1992 19:13:50.41 -To: galaxy::gleeve -CC: -Subj: BULLETIN utility. - -You are about to receive version 2.11 of the PFC BULLETIN. - -BULLETIN is public domain software. (I will gladly accept -recommendations for new features, not for changes that are due to -"personal" preference.) - -If you are running a version of BULLETIN older than 2.11, this version -will modify the format of some of the data files. (This will be done -automatically when the new version is run). After successful -installation, the older versions of these files can be removed. NOTE: -Problems can occur if the old version of BULLETIN is run after the -data files have been modified. Such a situation is possible on a -cluster where each node has installed the executable separately. To -help installation, a new command procedure UPGRADE.COM has been -included. Read the comments in the file for information on how to use -it. - -As of V2.0, BULLETIN is able to read USENET NEWS via TCP/IP using either -CMU, MULTINET, UCX, TWG, or via DECNET. It can also serve as a NEWS -gateway for DECNET nodes without direct access to the NEWS server, i.e. a -DECNET node without Internet access will be able to read NEWS. - -NOTE: The following commands can be sent to BULLETIN@ORYANA.PFC.MIT.EDU: - SEND ALL [SINCE time] Sends all bulletin files. - If SINCE time specified, only files created - since that time will be sent. - SEND filename Sends the specified file. - BUGS Sends a list of the latest bug fixes. - HELP or INFO Sends a brief description of BULLETIN. - SUBSCRIBE Subscribes to mailing list for upgrade - notifications. - UNSUBSCRIBE Unsubscribes from mailing list. - -There is also a documentation file written by Chris Tanner from Chalk -River Nuclear Labs which can be used as handout. To obtain this, -request the file BULLETIN.DOC. (This does not describe the NEWS reader -feature, however.) - -NOTE: An old bug might have changed the protection on the BULLETIN data -files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and -*.BULLDIR) should be (RWED,RWED,,). - -You will be receiving 21 files (NOT NECESSARILY IN THIS ORDER!): - 1) BULLETIN.FOR - 2) BULLETIN0.FOR - 3) BULLETIN1.FOR - 4) BULLETIN2.FOR - 5) BULLETIN3.FOR - 6) BULLETIN4.FOR - 7) BULLETIN5.FOR - 8) BULLETIN6.FOR - 9) BULLETIN7.FOR - 10) BULLETIN8.FOR - 11) BULLETIN9.FOR - 12) BULLETIN10.FOR - 13) BULLETIN11.FOR - 14) ALLMACS.MAR - 15) BULLCOMS1.HLP - 16) BULLCOMS2.HLP - 17) BULLET1.COM - 18) BULLET2.COM - 19) PMDF.COM - 20) MX.COM - 21) NEWS.COM - -(They will be identified in the SUBJECT header.) BULLET1.COM and -BULLET2.COM are command procedures which when run, will create several -small files. After you run them, you can delete them. If you have PMDF -at your site, you should also run PMDF.COM. However, this only applies -to PMDF V3.2 or earlier, as later versions of PMDF have the necessary -interface code for BULLETIN included in it. In that case, or in case -you don't have PMDF, you can delete it. The same applies to MX. Then, -read AAAREADME.TXT for BULLETN installation instructions. If you are -using the news feature, NEWS.COM contains files which pertain to news. - -NOTE: When creating these files (using the EXTRACT command) from the VMS -MAIL utility, you will have to strip off any mail headers that are -present, including blank lines. - MRL@NERUS.PFC.MIT.EDU -V 2.11 - -Added SET NEWS command. Used for setting a news group or a class of news -groups to be stored on disk for quicker access by users (rather than being -read by users directly from the server). Can also disable access to a group. -Users can set NOTIFY on stored groups. 11/5/92 - -NEWS command now by default shows only groups which are active. Can show all -groups with /ALL command. /STORED and /COUNT are new qualifiers. 11/5/92 - -Stored news groups are stored with data compression. Normal folders can also be -stored that way if set with the SET COMPRESS command. 11/5/92 - -INDEX command modified to make it more useful. /NEW is now the default, and now -only shows folders or groups that have new messages. /SET added to show only -folders which have READNEW, SHOWNEW, or BRIEF set, and /SET is the default. -11/5/92 - -Fixed bug with BROADCAST routines which could cause BULLCP to go into MWAST -state. 11/5/92 - -Modified code which adds BBOARD messages to speed it up when multiple messages -are being added. 11/5/92 - -Folder names can now be up to 44 letters long. 11/5/92 - -BULL_BBOARD_UPDATE and BULL_NEWS_UPDATE are now continuously translated by -BULLCP so that they can be changed dynamically. 11/5/92 - -BULLCP now is created with reasonable working quotas rather than PQL_ defaults -which are usually way too low. 11/5/92 - -Changed all variables to be long word multiples in order to be more ALPHA -compliant (and maybe faster because of it?). 11/5/92 - -/ROTATE added for read commands to allow reading messages encoded in ROT-13 -coding. This is used by some news groups to display messages which could be -taken as being offensive (i.e. rec.humor.funny). 11/5/92 - -Fixed many minor bugs that no one mentioned, so I won't either. 11/5/92 - -Fixed ADD/BROADCAST/EDIT not working with TPU. 8/13/92 - -V 2.10 - -Allow non-digest messages to be added to a folder which has DIGEST set. 8/6/92 - -Added ADD_ONLY attribute. If a mailing address is present, when messages are -added to a folder, they will also be mailed to the address. Users are -prevented from using the POST command. Instead, the ADD command will be used -if the POST command is entered. One use for this is a local board which is -also distributed to non-local users. 8/1/92 - -Added POST_ONLY attribute This causes the ADD command to mail messages to the -mailing address if it is present, rather than add it to the folder. 8/1/92 - -Fixed several shutdown bugs. 7/23/92 - -Fixed PMDF broken by V2.09. 6/16/92 - -Added system logical name BULL_CUSTOM. It is equated to a hex number string. -Bit 0 set = need privileges to create folder, 1 set = captive account can -write files, 2 set = captive account can use editor. 5/25/92 - -V 2.09 - -Allow having more than one database by redefining BULL_DIR. However, only -directories that are defined in the list of equivalence names pointed to by -the system logical name BULL_DIR_LIST are allowed. See AAREADME.TXT -for more info. 5/10/92 - -GENERAL folder can now be renamed or modified (not deleted). 4/22/92 - -/FROM, /NOREPLIES, & /NEGATED added to SEARCH and DIRECTORY commands. 3/18/92 - -Mail routines now use MAIL$ calls for outgoing mail for faster execution. -3/15/92 - -Changing keypad definitions using initialization file now possible. 3/12/92 - -Subscribed news groups are now listed in alphabetical order. 3/7/92 - -V 2.08 - -Fixed bug which caused missing news groups. See NEWS.TXT for info. 2/25/92 - -Allow setting local protection on remote folders. 12/12/91 - -Fixed bug with creation of folder files. If they were deleted after the folder -was created, the files that would be created by BULLETIN to replace them (when -the folder is selected) would be created with the wrong protection. 12/12/91 - -Fix problem with MULTINET V3.0 and DECNET/NEWS gateway feature. BULLCP will -hang without this fix if there is an attempt to read news via it. 12/9/91 - -Fix bug that causes incorrect time on news postings after the first post. -Display time when reading news messages in local rather than GMT time. 12/8/91 - -Add 30 second timeout for connecting to nameserver for news. Can be increased -up to 99 seconds via defining BULL_NEWS_TIMER. 12/3/91 - -Allow list of numbers when specifying message numbers for PRINT and FILE -commands. 11/27/91 - -Fixed bugs in BBOARD code: Messages with lines > 255 characters would not be0 -included. Subject line not correctly extracted if next line was simply a -To:. (relink PMDF driver if using PMDF for patch to take affect). 11/27/91 - -V 2.07 - -NEWS listing now shows the status of the news group, i.e. active, inactive, -moderated, or renamed. 10/23/91 - -Fixed PRINT command so that if a print qualifier (i.e. /QUEUE) is specified, -it will cause any pending print jobs to be printed if the qualifier for theT -pending jobs is different. 10/23/91 - -Added /NOSIGNATURE qualifier for POST & RESPOND commands. 10/21/91e - -Fixed error in POST & RESPOND command. If a file was specified on the command -line, and /EDIT was specified, the file would be sent even if the user quit outu -of the edit, rather than exitting (i.e. outputting a file). 10/21/91 - -Fixed REPLY option in READNEW, as it was possible for users with only read -access to a folder to be able to add REPLY messages. 10/10/91 - -Add REPLY option to READNEW feature when reading messages. Also, really fix -the REPLY command, as mentioned in V2.06. 8/11/91 - -V 2.06 - -Added code to keep track of which messages have been read a per message basis. r -Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED toc -DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to -indicate which messages have been SEEN. 7/31/91 ] - -Added /NOW to PRINT command. Messages no longer have to be printed one messagei -at a time. It now works identical to VMS MAIL. 7/31/91 - -Added code to NEWS users when new groups have been created. User will be -alerted when selecting a news group that new groups are present, and will be -instructed to type NEWS/NEWGROUP in order to see them. 7/31/91i - -Added /PRINT to DIRECTORY command to allow printing of messages which are foundr -by using the DIRECTORY command. 7/31/91 - -Modified directory listing display so that the first and last message in the -folder are now displayed at the top. Fixed bug which truncated very large newse -group names. 7/31/91h - -Added FIRST command to read first message found in folder. 7/31/91B - -Modified REPLY command for folders associated with mailing lists, so that the -reply message to the mailing list rather than adding a local message. 7/31/91 - -Modified code to correctly store subject headers from BBOARD mail which areT -more than one line long. Previously, the subject would be truncated. 6/18/91 - -V 2.05 - -The MARK code was modified to work with NEWS folders. 6/3/91B - -Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more thanL -one folder at a time. 6/13/91 - -NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page,C -a folder was skipped when the next page was shown. 6/3/91 - -INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and thee -directory listing of a folder was displayed, and then RETURN is entered to h -skip to the next folder, the directory display of the next folder would be -incorrect. 6/3/91 2 - -Fixed broadcast bug. If a message was added with /BROADCAST to a remote folderE -from a node in a cluster which was not the node that BULLCP was running on. -The broadcast would appear twice on the cluster. 5/24/91E - -Added code to alert user if message too large to be fully broadcasted. 5/24/91 - -Added code to avoid erroneous notifications of new messages for an empty NEWS -group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not -affect all sites, as it depends on the behavior of the server. 5/22/91 - -Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91 - -Added /EDIT qualifier for MAIL. 5/20/91 - -Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91 - -Added TWG (Wollongong) interface for NEWS. 5/18/91s - -Fixed bug which truncated subject headers of messages created when using REPLY -and RESPOND to messages which have long subject lines. 5/12/91 - -V2.04 - -Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which -ALWAYS has been set will be displayed every time a user logs in, rather than -just once. Also, non-SYSTEM messages will be displayed continuously (viaa -whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actuallyE -read. 4/29/91 d - -Added capability of controlling the time between updates for BBOARD and NEWS inr -BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to -the number of minutes of desired time in minutes. 4/27/919 - -Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91S - -Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribedh -news group folders. 4/25/91n - -V2.03 - -Added /FOLDER to SHOW USER in order to show the latest message that a user -has read in the specified folder. Also added /SINCE and /START (the formerU -for real folders, the latter for news groups). 4/11/91t - -Fixed logic so that defining BULL_NEWS_ORGANIZATION will override thea -definition defined in BULLNEWS.INC. 4/10/91 - -Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read -message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for thee -SEARCH verb. /EDIT now works with SEARCH. 4/9/91 - -Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway softwarem -from working with UCX. 4/9/91 - -Fixed bug caused by V2.00 which caused incorrect listing of message during -BULL/LOGIN for remote folders. 4/3/91 - -Fixed bugs which caused erroneous new message notifications for subscribed -NEWS groups that were empty. 3/27/91 - -V 2.02 - -Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet)._ - -Changed BBOARD algorithm so that it is now possible to have only one realo -BBOARD account, and have all the others be VMS MAIL forwarding entries. -See HELP SET BBOARD MORE_INFO for more info (it's been updated). - -Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use -the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV. - -Fixed many bugs in POST, REPLY, and RESPOND. - -Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups.d - -Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DATV -to speed up NEWS updates. Can be used on other files (in particular -BULLINF.DAT) in order to save space. - -Add /EDIT to BACK, NEXT, LAST, and when entering message number. - -Modify ADD/REPLY command to local (non-NEWS) folders so if there are new -messages present, it doesn't reset the newest message count. Previously, -adding a message would reset the user's last read message date to that message -in order to avoid notifying the user of new messages due to the user's own -message. / - -Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED- -IATE IS entered, a carriage return will read the next new message. Previously -the wrong message would be displayed. - -V 2.01 - -Fixed many bugs associated with USENET NEWS reading feature. - -Added UCX interface for NEWS.o - -Added signature file for POST and RESPOND messages.l - -Added capability to specify file name for POST, REPLY, and RESPOND.d - -Added the line "In a previous message, wrote:" to theo -beginning of a message when /EXTRACT is specifiede - -Added hook for network mail to run command procedure rather then using -VMS MAIL. BULL_MAILER can be defined to point to the procedure, and ith -is called with the username and subject as the parameters. - -V 2.00 - -Added USENET NEWS reading feature. - -V 1.93 - -Fixed bug which wouldn't allow a permanent message to be added by ai -non-privileged user in a remote folder (the folder had been setup to allow -permanent messages from non-privileged users, of course). - -Fixed bug which causes the DELETE command not to delete a SHUTDOWN message -without the use of /IMMEDIATE. - -Fixed the algorithm which prevented duplicate notification of messages inn -remote folders on different nodes, as duplication was still possible. - -V 1.92 - -Fixed bug which causes BULLCP to loop when trying to cleanup a folder whiche -has more than 127 identifiers granted access to a folder. Also correct -SHOW FOLDER/FULL, which had a similar problem when trying to display the -identifiers. - -Fix PMDF interface to recognize to recognize PMDF_PROTOCOL.i - -V 1.91 - -Disallow SPAWN command for CAPTIVE account.n - -Fix MAIL command to correctly allow passing addresses with quotes, i.e.f -IN%"""MRL@NERUS.PFC.MIT.EDU""".i - -V 1.90 - -SET NOTIFY now works for remote folders. - -Avoid generating notification message due to SET NOTIFY flag if the messaged -was broadcasted when added using ADD/BROADCAST.m - -Bug in DIR/SINCE for remote folders fixed. If no new messages were present, -it would incorrectly show messages.a - -Added /FF to EXTRACT command to seperate messages in the file with form feeds. - -Allow specifying CURRENT and LAST when specifying a range of messages for -commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc. - -Open folder files with READONLY when not writing to them in order to avoid -changing modification date, which results in unnecessary backups. - -Modify HELP so that it won't prompt for Subtopic is there is none. - -Prevent screen from being erased after exiting HELP. - -Fix bug which causes CREATE/NOTIFY to crash. - -SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain -the list of users logged in to all nodes of a cluster, so this qualifier is no -long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they -are no longer used.e - -BULLETIN now will use the editor specified by the SET EDITOR command withine -MAIL for editing messages. - -Typing BACK after typing a DIRECTORY command will now show the previous -DIRECTORY display entries rather than reading the previous message. - -Several bugs related to the MARK command were fixed. Also the software has been -optimized so that scanning for MARKed messages should take less time.s - -/EXPIRATION added to DIRECTORY command to show expiration rather than creation -date of messages. - -Any BULLETIN interactive command can be executed at DCL level by typingo -BULLETIN "command" or BULLETIN "command1;command2;etc.". - -The CHANGE command has been modified so a range of message can be specified, -i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning -to extract the old text message, whereas it should have meant that only thet -text was to be changed. This prevented a user from specifying that only the -text should be changed if that user didn't have editing enabled. This has beenF -fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has beend -removed (previously it was a synonym for /EXTRACT). - -SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs. - -Removed security hole which occurs if you are using the old method of accessingf -a remote node via /NODES (it would have required looking a the sources to find,e -which one installer did and was worried about). Because of this, if you use -this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed -in the NCP database pointing to the file BULLETIN.COM, i.e. the commandr -"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed -during the system startup. - -Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No -page would be erased (of course), and the next line outputted would start wheren -the previous line left off, rather than starting on a new line. - -Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their -login procedure before the terminal is known, and whose default page width is -larger (i.e. 132) than what the terminals are (i.e. 80). - -Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for theW -BULLCP process.t - -Added ATTACH command.s - -Modify SET STRIP so that it saves the date that the message was sent and -leaves it at the to of the message. - -BULLETIN will search BBOARD message headers for a line that starts withf -"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It ifi -finds that line, it will use that date as the expiration date of the message. - -Added /REPLY to SEARCH command. Modified so that it's possible to abort out ofW -a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searchingo -the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETINg -would abort totally rather than just aborting the search). - -Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this isi -combining the DIRECTORY and SEARCH commands. - -Fixed design flaw which allowed the following to occur: If a folder is ai -remote system folder, when BULLETIN/LOGIN was executed, the same messages mightS -be displayed on both the local and remote nodes. BULLETIN now will know thato -the user has seen the message on one node and will not display it if that user -logs in on the other node. - -Optimized code which caused slow display of new messages when executinge -BULLETIN/LOGIN without /REVERSE for a remote folder. - -Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect isn -that users will not be allowed to change the setting. The main intent here -was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL -folder.I - -Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF wass -selected for that folder, and a non-SYSTEM message was also present. - -Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that -there are unread new messages every time BULLETIN/LOGIN is executed, rather -than just the one time. The BRIEF notification code has also been optimized -so that it'll take less time to notify you of new messages.y - -A major bug was fixed which was introduced in previous mods to speed upe -BULLETIN/LOGIN. The effect is that no notifications will appear for certain -folders via BULLETIN/LOGIN. This would only happen if a folder was removed at -some time. diff --git a/decus/vax92b/bulletin/bullmain.cld b/decus/vax92b/bulletin/bullmain.cld deleted file mode 100644 index 4ca45c0..0000000 --- a/decus/vax92b/bulletin/bullmain.cld +++ /dev/null @@ -1,33 +0,0 @@ - MODULE BULLETIN_MAINCOMMANDS - DEFINE VERB BULLETIN - PARAMETER P1, LABEL=SELECT_FOLDER - QUALIFIER ALL - QUALIFIER BBOARD - QUALIFIER BULLCP - QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED) - QUALIFIER EDIT - QUALIFIER KEYPAD, DEFAULT - QUALIFIER LOGIN - QUALIFIER MARKED - QUALIFIER PAGE, DEFAULT - QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER READNEW - QUALIFIER REVERSE -! -! The following line causes a line to be outputted separating system notices. -! The line consists of a line of all "-"s, i.e.: -!-------------------------------------------------------------------------- -! If you want a different character to be used, simply put in the desired one -! in the following line. If you want to disable the feature, remove the -! DEFAULT at the end of the line. (Don't remove the whole line!) -! - QUALIFIER SEEN - QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT - QUALIFIER STARTUP - QUALIFIER STOP - QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7") - QUALIFIER UNSEEN - QUALIFIER UNMARKED - QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED) - QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED) - DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP diff --git a/decus/vax92b/bulletin/mx.com b/decus/vax92b/bulletin/mx.com deleted file mode 100644 index 42acb58..0000000 --- a/decus/vax92b/bulletin/mx.com +++ /dev/null @@ -1,958 +0,0 @@ -$set nover -$copy/log sys$input BUILD_MX_BULL.COM -$deck -$ save_verify = 'f$verify(0)' -$! -$! Command file to build MX_BULL (MX SITE transport for BULLETIN) -$! -$ say := write sys$output -$ if f$trnlnm("BULL_SOURCE") .eqs. "" -$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory" -$ exit -$ endif -$ say "Compiling MX_BULL...." -$ cc mx_bull -$ say "Linking MX_BULL...." -$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option -SYS$SHARE:VAXCRTL.EXE/SHARE -$ say "Build of MX_BULL.EXE completed" -$ exit f$verify(save_verify).or.1 -$eod -$copy/log sys$input MX_BULL.C -$deck -#module MX_BULL "01-001" -/* - * - * Program: MX_BULL - * - * Author: Hunter Goatley - * Academic Computing, STH 226 - * Western Kentucky University - * Bowling Green, KY 42101 - * goathunter@wkuvx1.bitnet - * 502-745-5251 - * - * Date: March 8, 1991 - * - * Functional description: - * - * This program serves as an MX SITE transport to transfer incoming - * mail files to UALR's BULLETIN. - * - * The MX_SITE delivery agent takes messages routed to a SITE path and - * feeds them into a subprocess that executes a command procedure named - * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the - * the command procedure: - * - * P1 - The name of a temporary file containing the message - * text, including all of the RFC822 headers - * (corresponding to the DATA part of an SMTP - * transaction). - * P2 - The name of a temporary file containing a list of - * a messages recipients, which corresponds to the - * RCPT_TO addresses of an SMTP transaction. - * P3 - The RFC822 address of the sender of the message, - * which corresponds to the MAIL FROM address of an - * SMTP transaction. - * - * This program expects the same parameters, except that the third - * parameter is optional. If the third parameter is omitted, BULLETIN - * will scan the RFC822 headers in the message for a "From:" line. - * If the third parameter is specified, it is expected to be a file - * specification. It is assumed that SITE_DELIVER.COM has written the - * address to this file. - * - * The logical MX_BULLETIN_POSTMASTER can be defined as a local - * username to receive error notices. If BULLETIN returns an error - * while trying to add a message, and the MX_BULLETIN_POSTMASTER - * is defined as a valid local username, the message will be mailed - * to that user for further handling. - * - * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode: - * - * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER - * - * Modification history: - * - * 01-001 Hunter Goatley 14-MAR-1991 14:41 - * Added scan_for_from_line, which scans the message's RFC822 - * headers for the "From:" line. General cleanup on a few - * routines. MX_BULL now provides an RESPOND-able address in - * BULLETIN. - * - * 01-000 Hunter Goatley 8-MAR-1991 07:20 - * Genesis. - * - */ - -/* Include all needed structures and constants */ - -#include descrip -#include lib$routines -#include libdef -#include lnmdef -#include maildef -#include rms -#include ssdef -#include str$routines -#include string - -/* Declare the external BULLETIN routines that we call */ - -unsigned long int INIT_MESSAGE_ADD(); -unsigned long int WRITE_MESSAGE_LINE(); -unsigned long int FINISH_MESSAGE_ADD(); - -/* Define some macros to make things a little easier */ - -#define rms_get(rab) ((rms_status = SYS$GET(rab))) -#define err_exit(stat) {traceerr(stat); return(stat);} -#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status); -#define vms_errchk(func) {vms_status=func; vms_errchk2();} - -#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg); -#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg); - -/* Define some global variables to make things easy */ - -struct FAB msgfab; /* FAB for message text */ -struct RAB msgrab; /* RAB for message text */ -struct FAB rcptfab; /* FAB for recipients file */ -struct RAB rcptrab; /* RAB for recipients file */ -struct FAB fromfab; /* FAB for FROM file */ -struct RAB fromrab; /* RAB for FROM file */ -char msgbuf[512]; /* Input buffer for msgrab */ -char rcptbuf[512]; /* Input buffer for rcptrab */ -char frombuf[512]; /* Input buffer for frombuf */ -short trace; -unsigned long int rms_status; /* Status of RMS calls */ -unsigned long int vms_status; /* Status of other calls */ - -static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE"); - -#define itmlstend {0,0,0,0} /* An empty item list */ -typedef struct itmlst /* An item list structure */ -{ - short buffer_length; - short item_code; - long buffer_address; - long return_length_address; -} ITMLST; - -ITMLST - nulllist[] = {itmlstend}; - -ITMLST - address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */ - {0, MAIL$_SEND_USERNAME, 0, 0}, - itmlstend}, - bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */ - {0, MAIL$_SEND_RECORD, 0, 0}, - itmlstend}, - attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */ - {0, MAIL$_SEND_TO_LINE, 0, 0}, - {0, MAIL$_SEND_FROM_LINE, 0, 0}, - {0, MAIL$_SEND_SUBJECT, 0, 0}, - itmlstend} - ; - -ITMLST - trnlnm_itmlst[] = { /* $TRNLNM item list */ - {0, LNM$_STRING, 0, 0}, - itmlstend} - ; - - -/* - * - * Function: open_file_rms - * - * Functional description: - * - * This routine opens a sequential text file in VMS "normal text" file - * format. It uses RMS to open the file. - * - * Inputs: - * - * infab - Address of the input FAB - * inrab - Address of the input RAB - * buff - Address of the input buffer - * filename - Address of the filename to open (ASCIZ) - * - * Outputs: - * - * fab and rab are modified if file is opened. - * - * Returns: - * - * RMS status - * - */ -unsigned long int -open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename) -{ - unsigned long int rms_status; - - *infab = cc$rms_fab; /* Initialize the FAB */ - *inrab = cc$rms_rab; /* Initialize the RAB */ - infab->fab$b_fns = strlen(filename); /* Set filename length */ - infab->fab$l_fna = filename; /* Set filename address */ - infab->fab$b_fac = FAB$M_GET; /* GET access only */ - infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD; - inrab->rab$l_fab = infab; /* Let RAB point to FAB */ - inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */ - inrab->rab$w_usz = 512; /* Record size is 512 bytes */ - inrab->rab$l_ubf = buff; /* Read to this buffer */ - - rms_status = SYS$OPEN (infab); /* Open the file */ - if (!(rms_status & 1)) /* If an error occurs, return */ - return (rms_status); /* ... a status */ - rms_status = SYS$CONNECT (inrab); /* Connect the RAB */ - return (rms_status); /* Return the RMS status */ -} - -/* - * - * Function: init_sdesc - * - * Functional description: - * - * Initialize a static string descriptor. - * - * Inputs: - * - * sdesc - Address of the descriptor to initialize - * (of type struct dsc$descriptor_s) - * string - Address of null-terminated string the descriptor describes - * - * Outputs: - * - * sdesc - Descriptor passed as sdesc is initialized - * - */ -void -init_sdesc (struct dsc$descriptor_s *sdesc, char *string) -{ - sdesc->dsc$w_length = strlen(string); /* Set the length */ - sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */ - sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */ - sdesc->dsc$a_pointer = string; /* Point to the string */ -} - -/* - * - * Function: add_to_bulletin_folder - * - * Functional description: - * - * Adds a message to a BULLETIN folder by calling the external - * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and - * FINISH_MESSAGE_ADD. - * - * The following constants are (may be) passed to INIT_MESSAGE_ADD: - * - * Subject = "" Causes BULLETIN to scan RFC822 headers for - * a "Subject:" or "Subj:" line - * From = "MX%" Causes BULLETIN to scan RFC822 headers for - * a "Reply-to:" or "From:" line - * - * Inputs: - * - * filerab - Address of the message file's RAB - * folder - Address of a string descriptor for the name of the folderr - * from - Address of a string descriptor for the "From:" address - * - * Outputs: - * - * None. - * - * Returns: - * - * unsigned long int - RMS status of call to INIT_MESSAGE_ADDS - * - */i -unsigned long ints -add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from)U -{. - unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */l - struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */ - static $DESCRIPTOR(subject,""); /* Subject is "" */v - - /* Call BULLETIN routine to initialize adding the message */ - - INIT_MESSAGE_ADD (folder, from, &subject, &bull_status); - - if (!(bull_status & 1)){ /* Error? */ - return(bull_status);U - }t - - /* Loop reading message lines until end-of-file. For each line read,2 - create a string descriptor for it and call the BULLETIN routine to* - add the line. */e - - while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */o - filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */ - init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */e - WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */ - }e - - FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */ - - tracemsg("Message added to folder"); - return(SS$_NORMAL); /* Return success to caller */ -}2 - - e -/* - * - * Function: scan_for_from_line - * - * Functional description:. - * - * The routine scans the message's RFC822 headers for the "From:" line.e - * It parses out the address by extracting the

Rm{I zI%wt}+gfzotF;6eCNfP|_9!bn!vA)Pllz`%We5!KtXkeQg}LYbm*)!LJv@*Q##{j^23eJN4mt;Y zZ2F5s@pDu-6mayuZ4Z3C^8V3_bw@QQUzLWb}e zaT}Fw?03D6D~W(**%>N#&N%140yL|h81Y5#E_9F23-@`BeVURDL7#uLIIRS&)`P85M66qct*cdG;9zE8cq;+hA&hPJFE3<0 z-HJ!A&a8Yfl>;2U+zf&ahdlNzpUMYnS0VNVp72ff`fy04LG-@qag8)VmPzk3ElVe~ z!$vCvT&_)rv{J#lz_=K87J4l#0xtyur3QJ1fT*AE1YiTi?SLGFpc+vPNDt@;;dDgGrpaj`i>rCl)D}L4bDz) z`3RaTTX$(`tW4mE#m9cG`mso*@RnavMQy7oWR_qFXfy$2;>)U8E1&QF(>JBY>tNx8 z6I(%}5NK%vl(MEt?VDWD{sSz~csZ>EtQzK+xEsG{eJe z%hVfseHv=Bxwg#gikr#Sxu?DZ zm&$}-ZQf%}d|#BovoRdl&FKTJC%07u@BI71ctfEfD0$+;33I^arW|y5WX*DH6I0$| zZzjvFmlAZIIJ}qZY5E##v(t|=TLIiMf{f^HmS%Vue_Hc!S)q&J&5#9WL%y6c@p$rA zxFlKnimD2O0s|K_1K7+D_8bkoOyK=~6AdQ(=$pPMf^qvr)y6qdnFeA-3*=#At&kv) z5@1{ZVG}VNQFH;E`v8w*yVe4P7F22`SOF<81qc(6;{e|cV!k-?q;)HeprfNp*h8{m-+TJw^q z_BgM#ct($Pv>eEMaNn+{x_o|L;k+%IS506_d{|$hxZodJ>i3JirIfhqr^x;Oz7kL)cDMKInW@AXi2Z%fnPf@IF4`3^W5Ix2GV+dLtwaM1j+QI4InTn5Qf2R2Wu4*2S^490ZL{ z@`Li`gG&annfts2Wc^PzFz`TJ{8L$na1P){=Z)&w45C&pc;zGxYum;rG+52)SDa{|>Z zZt1IBK7qzn#6f8T?izz#UDje;fs?e-4nW3yIlwcqNb+9nljdDl1nY7;%CdNI)-6at zc3X>CtxN*tM$mZS5pZ}(LQknM(o&O?%d7QrV0Ldgf zV6g#wqCty*?Qw9O4rxtEGXy-U|8w^u)6vFfn+@G6g;Q_tE&vS+KUi1Fz`)1g$IQ4y z$66S&b*lz3HhPtb3;k;X?e*olaCdP5 zGnd{Y_Ajlc4fkf*-D`ODwwTvm-<%@DjsS zx#gA?yo!@pyB1km@FprSNTR7w;}&UMZELqLVQMD>#C(Kqg@(*&zQqMnPD>U(VOD_d zZF(`YZ4!Tj1IRu2`%;iSM6!J^47}&;UUrnL;B>nhNEbhNzt(NX{s>{^DLwXypf#=g z8RS8`fgVi!{KLxqCv7?eO}7~E`O-*C@(orL-JX>JLib9JP4wLI8-@tyHz(DZ~HL`}@v z3vg4eJnFubzW8o>+SDUcwyS{TA5?r%-uAsm``ApLqu>Jre&=lYeP+$18BHxLi9B;U z#Xz})6Rc7-NS=Y8nStT7F{qrXXAlI5CiHDM@Ww2|^W)rqZIZ2`4~pr9hh*Iefyg6FOcPMD)HeFxi*#2HZbZzOcL`o(pC2-e+iOZvf+T_j1>`~0o^xLRabz{Wz*Mr@Mh7^4e7Cq zgc_YcFl^`vmQ=pB5>$dHf?6lM&@)etzi^t%20l|Do&hw9(a`W(Jk~07^P{3O%NG~U z+tR&k(u_}F_lrXIW32dKw7xJmL}}T9Ak*TXF$$nPsk1G;WS74*2e)_>9{h5h?ss*L z%8R&}I=`w@_vSMSFs#g)<{ zDFy*%28KrhJ$5h3P98d~q`>fS@luce;E<>ccRnTJ)^)SNtcX2pk1pmD}IcFQ-098~sEWn8s)>#hROoB$8B-v!Rv=!VRPb>Dvc5W3pI=lqykj*9`Z-cSI%*UD~v;jX(`Go6nLTm_BuqnxlI z2A+w4>0hMr=<3p2j~{!3_B{z#pqcCa476`*!L0{HQ@1)!_sCj&4ZNG*OH5NA&%0n}nSl3F8C``~CsJ8Rdg!Y+fyr!rU>%e{}wL04EwfP081WWg@hIpZ%H^Y&@) z=bj#cMnz8V=e1M)k{aSCs)JTmL0rCpeOC6rzEsh=0R^JrZ7#_+ix|}bR1I3z!Qp%SfO&TY?I?hB?YqA`C?A>?OS_`}c zU6x^G;o8h5tC|(_l~f#6!#FZdHN`hB4d@pX+wUFM%plLOvha$e*0v2gC7CSyG892` z(Z6NxwLM^*pnFAXYanRl4ru;L1vC;aTybH`Lj7GOtETvaW_uqdJ3xBw_bkBeKAt1a zt2Z22zu*tQ1Z4h-Q&DGEpH#bdjMyKpI5nvm|6VK<1%)1HysGEizCx${>(r!vh)(%G z6SS+7iNC`(KC}08PsgjR@v2=vp*?gH2JjB8GHC`OW(EdmJU9wO&Nn}2thDO-zReP~ ze#tAFuC{_!v0Y|oV(;k9nsai}uLI!`cCzeq9tqem{HX!;_#h_+`7NDe#cLA64O-)9 zICuWh4L3T$CoVx_#~iwy#w;!D!LJ{a6rri-79C7 zz}}sZ-9R6krxlmfX;>~a{1eI3Jy!$NV}A(Qr4qdI7o<-W0~%do;)kc6q?O-({8*&% zC{qD);ufTIT(d*wv+#*znJFdZ$wwT%zSh&3dSr?^xD5|JUjnomo%FaIMj9ejWoNe`;lPq3JuUK325ak3V?^CF~}2PSIieDgi!026TcD=nOhxW(I~A{vQsp zi>V%XCD098wWd|^BY?-}l-rR-O8zGD-*gO~D9AFr&}S0o{lleIQ2Xkh!kRA}AG$k^ zy`QwbYtP-s;jG{~PK+V(m&1zZ0*JCbiFIASzN9>;=E+kC*;nNbn$Wy)PQp;3f+3>2 z%SQg&o8a$rRY9X2kn#&sqH7n_)|{+hkYUJ-nZj9T?8XzjNJy;nA#?XbCHZA@K!;?+ zF5(k~oLC_xKJBWa*yf0xOj}FY_D`A#?(2e2l{?AgdQoOh8)(c!n&IJPb|>5R4h~7% zeG5_=7Zq$heti0ir2;Jd`jU{owTA?W$=NTlG*?{}F65uoD)Icju3Ul}> z!a>axk&mx}-hTY3I(zcv$9$3>K5}U1Y8+sUVloHs!UT=BnrU8oEE3wMoh-Ik-?eJa zqEm&bsm>LV4B!zbhLj4HuYBSabN7h6EbP)!-^PA73Eb_?R0NNBJu{7;Q3i4^2e{AL z$9!_9za%dtZI}yarI&<&ca0=MPWMpo1C2@Wc<|pjt0&X~ub z9VJL1y~sgdv5ZjAQQ`!!rt?aXK!B!XRnRfVUry87RZjGb9xGIt)u+ z1uZ$Qxk^Srd-m%oJ&B60pgj`cJORpo;2H#82Fw8Ga3_!%pwlA318?mW4Ihl;kC%z< zGGRI_VG+zF@m1(g8qb`U3JgLFE2Yvy8CwE2*6!N->q@Pr!4nhk*wtCp88>7Q8v-Al z0`0YsWq8OU*I{ACz6aC`IdTY94Hqa~GsHA?p8d$0F9zCQzPZ`y_yW+%5~%3w6zKlK z5*{sZP2VBJ@bF7xz+P2d-^lZ5knNXn~ssHJ^)x;bBLiAUKUPwVS8`S8LVGw0zU@+ke;%GWP zoks&S{#3@i(a<=}Fv?Wmc97hfO&^Mii|X=E2v{%+rygYZ7?ii&>Isj61bD};PnpPJ z7x61E%pb5^lRCUtar#HqWM$A>h%V4~9Er^*K!Ihx+X=xE=z^!Um^BhZ?`l(-(T{0BA)Geq7MLY8i8GKhml zcA?@Gn_llZt_fZjzDyN-s+cIlO@kuY=Cy?-Mlntwj2>)A)n?&muxAiwxVa(nl;I62 zclE=nEc%--EESXh)t;bTI~(76Sc)xWJ_72!?`Ht5mj(@=o=Mu$16nNJeKGK1sv>yL zb?n>1SUbUgz zVju!)CqnAhbLyg?1q zqsF4pwD<_6Yy^i0I9-Bza#auV_&y%!zGwv6O`w+s+PVO09q^pMTDAyb)J6MEgKjyxt1F|%Y-4%KQmHFBi*{IBL(GTnO@N)VP&Dz6`>&;Pln4ncMUZdK&fHZY2G>PERzq} z`h5f!(!6uIKzoz#q|`A#XFNDL_Bl*K7f~KDF*numc=rc8>xEZDf=)f-@!&T&y9qR0 z)&v^wdUqojl>T75XnetG^+BM-5&@RzAIYG`N~h4X0PxzuWCyPq&g~IO3=+%?3^y;d zSo%O#3I#yoVg@9vz;OXOD+^q2I#xuAf^z2$3%lA0^It5M-`HI3rZVXk2WUlmVxPPH zBfjH{kqGgF6{tiI z0Idh<>SeNLul>HR#ZqLpEO=g<-{5SJ@}4&$3=fmF%)G!MApFdrktKLz-~&Z)jm!aB zZv~PA3qfu5f|MwrJ;+KN`r4oxJ=x)syM2&=zTQE5C&+Z2Hn`W0SXuq$V*iCV{dG$Y z!%p}T-$&47&)cld+m$6Ey27#LJRZRncQipO-^zUz0) z?&|GwQrr{c2RiHAt91jTa>bZ5B7c@evHO1-Ld)BCc z_Ua2*xVW5n@sSnOrJgRqAPH*!gARO{HhFQgLx!S~VNJqIp;FNPOnK%_(jC1Q13?+} z?U8AqUN@+g0FQu7liqQlVS)VNOOLN;?1XK<>c059h*_S2L6Ko)Ve!Nt5ic%r@OY%2 z@LCbFzgw^OK)?Zw0KEcmZD9)uv#2lMPt~Np46U166tN)XVQQ}=!%C0l!kjkn0p5DO z2R?8d)j8Cp^g-JSRFiV@c${QX<<|dPnA7%V8>l8-aa8>7PtXpj#W!`HF1V@l^!>LM zSR z;ENLQ(Fxe}VUqx8yZ~0IwZ*Ih?f&naZwC#{rwyRd9Fh1uy@NtK?Djo43oaGQ0+w*s z_v%XugLcT4@|-AQE{E5IISlL!VEqmgt5Zd!0>jF}h)!r4-@E0(!_QWZ;rhBW_qXcx9%u-0`=}rYssVSYa!=VW@phez zK=rB;EpThiMKf~2pQ9OwJP`db6*Qv#Q2uP1Ci~em&HC-`;9bVE%)Y#A{?jruIe61g zWfRre_Lm+)Y6S59Oe9%OeoNKa9|R0xb$~i#1@DPtCqSniA5EOYoO__D{rqc|Sd*tN zMj@;2yMmf0T8ovzYb=g@mK6As98on#s%Yn-(@&pFVF>o@TN`8$#3jMXA;(ZB!vNk- zVIV3!wQshzZOw|K;;Nvtb{j9SZhZ7#40IX-=qxCo&1bAsOP0uV%Oruik$eo$Q?L@W z%)AsfE*A!+5aj%6*>w?gg2lf(S7ZfjZkFDA4B10|SpzhhE6vORuDe-y-(iVp@c!nu zcMMz%oF>ZG9gU0r-j$ODjW)r<px~HR|SrPGx$uCDw#HR;sZP zbc*{uP#TK)dHnskHknK794h!_xtMd+85BV0&R%R;a$bf5V#1<@*P9gj^!<>bF&hBKt1mkfwlzDIjanYt<0caH0z!qX3%I@@o7sT)lD}S zWJ^~))m?Um>FT8F`}&d$iN-eN6`eU|FK)3hb?$uH;F2fLAj8bSVA#6<_SO_oyC4y~ zN^8}HQ08||4o_l}e0u^GK=$u-aV~t(qhs90y2prD=yJUY-<4R2H5zK5_C}o2-G{1| z{@#_7XGjF;SeCq@_ww7Y(|1mUiA)bwSP=AAZvK}J*$(82s&$Eme=5y(E2GuBlhDh5P>l{d-v1_pJa~+mV@DlyZ+FfiXTOtbHZD9C z6H0hQr8!kWtCK-z4aqHS*w-z*{;OVmKWJ%Ih`s;fq{UpI77J*fh=i$FZdSADL z&A1sl;ccBd(9YWyfwo7WvJ$-amkYFa=3T@kMd3(LPaHgg46p5`8mi9DE|={F*}C{< zPLkKV1z__1w<(}echT#N3$8?@SX{XO_N6$3EQ2gF1E}BgAP{493uwOeA!OZ0ve@F? z$qS25GHzu3(yCkuDn%i?<@*o4<_PvW<283>2T%K&WWnW0$DpnR@2f!9ZE6*)ItjFw z4wr7wnibHtKxGz|l|j&v=yl*U;db=MD_O``E9AbE(&|%j+zgy@dkSLC zDfSo~(uevj1hOKgX-(AL`Dfd@F7_>a!u&*AdLqbYpt$*0czhDy%o9zLptOak1E=Jy z>(RU!v-@=fivnoR6zGHrW`UbI7q;?VX5eM$eB9T1%xb39GSGxIB+hM*m@zDYmIH407Q9e_~GI8%9to z6LO}8o%hciGsC58g4ZTBT?{NP>Xr4cJP#T!V{T$^kO!rCaLj^^7yPFClXVUb zzGv6)F$lR{Y~zOBHgNf?$)|JRRvC*N!-)@*{BL=s>{68I75=5padAyBuZ#j4L+59q zmwmS2vqapE9tnD;vgzi6?Af4^8WGSLWuQA6m`bMJ2@TdP*C`1)%EQjkDZhG0pJOYi z4W$g)-!F-&&Z7fVNUMQbqMh>PIxipewJrjm8hehr{FXY#_yT4@TH?vp@rA4HwAQ_5z? z>t>8X45YXY(w1O>rcn@`*dhQ)qdedS)QS(Aq(G|yCmbnR`qNJ8`i+lM&b|K77B(fp zb@%yS(E9EOC{4p_98lXr;ufTb2O2SEvRYm$;|x0dz)ck-irhyBwfqGg%-qyKW%aY( z;*`imS}Tq_Ed3Q*lF7ox!p{(252~M#>QZM=9~)7Z?vnJ`JmcT@zn~rD@S3#k-mRo` zw#z!pl;l9;B2!KjtbD?*sw~`d&J%RjQ9$>_IWB3SvlLYoA%1HK=vlY8uy09TOk={; zg*rN>+wBz&HO-n8DSJQ>v^xu1y5;Nryd>7+*O{rI?M%v`kru4!_8Aw*h6h1D*Ds&2 zmIRgR3<`(6?J~6|zHCeAK_ptx2pHsC(^e@41!e|@by5Z5OiJ&CvXfev)`DgRA^Gb_ z=(IEJ63*-17=kvjPnhv2aY}a= zzI5^P+a9f3Y%tUO*3whIR3e`@Olay-jH^>%csL)tnB)QI&@tn}A~E5an?funo^h~I z)d3$o04X0>kX(uEK1C$=P1KpmZ_pNVGZ}Pnf`Z{+{izBS3_n&WfJO>nIba5)ENtTg zwHJJ)C(RJ(Dp3WcAqYF<6llxf_9}P<`nY00;L3KS-ASUv5_(Z2gAeU?q=P8 zdHmq9c0|8kZ_*-1^$044ui{&1ot3c4!^^b`88(YNq3DMF#MRyAzI-guZZM+jiVxwI1j! z{qsDxPCSr>tncW6m;N5%Cu2>g>Q4BwC#5g8XjXXVL&i%nMP6bW?2x*%?FfSi!%C^= zs~>d>N$qMm5Tu>Pq3tWC!467a$6P@pwV;#=X}Q9}lk26{%oA7*1?hsXY`1L(oyy7M zQNFYBw1imD9`F$%pj8!ono>tIt~#u!(Oe9^vn^#^@bCUa#iQL9k>?UJwfC%10Js19 z4)%dt$}@JaX6`t0SapL0$Btz|Qd--tvieFuW;hE^wRT;Jsfdp_)^RZC!G=_kvK`=3 z?+|DPSDoQSzhuUV%f>%M16^xcQhOwJDTMv`$N{={B}w7IEU(NJH^Sb_C#r*HXdA^C z1RX#Fu^jV2%R4~x8qy3(%nS_d&6y&Ll|koBmLLyFuKloy6S}X?>4g^qWRFZratagZ z)O<;B3!?7XiNCV!Iud<9B-RB_)ZXWOmZ{Sg)T&36n!lDLmEDgAm89@86Vm%&SsekI z0R`tnrxjCFi^JX5oe`8jT&h*{a!J=3tpb&J@M?f9@r>M49Fk_ROwd`x@ki;9(XtN3 zS8NBF4;*oUj`8v`BtGkWeZcl$e>>Xz#ZbGcON?L zu4Y?&MGH!baGUf>$w-sXGQ0_4}BfwLQ4hN<3iqLaVvl4OOo+7y`P^JptVy zG?DjVrnlk-rE7CyU!>&e_8wSJTgC8Wm7+~+IYWeCww^pgK$pd-z#WXN;vYM6IQ*lz z8bvogd*dW9?~paanhsOYjgSFdJDzFWX~+uiRkX>~WC=SmYcscF1=o9q4NBKyOvK?U zo0X&wIf7d}XtXlReUZcPeaA?tP&?ZvO zotZwIYuj#2;SK0#d@TI*5YzsqPwhDhybJ+d7eQ;BSGjEaAP(7IhqF?p& zU9%LWbE9{66%0fnJxA@{8YxUJD$v@V})wd(!gh8-;(&XjBEQ!IWW`2s(72 zw@XQR4HL`Ky^2zMjC{Yd%vO}z6Li@JwC83@Z*k5pjjo;r@444Id#r6XJU6-QOn{=$ zVU-u)6Z=7D+f0+Ls0ZD^Aqy(iz~>CW*2phl;+^Fhuu+un0_a>NPKLxSidGU44;Wd;dZ1P$&xt=#;PoHi{Z3*iKftnl?yH29$@@Thgr7}N zEqHnZ)Q(JSDd3E;{9z2P#koMe6jYlz7!tQ!(QMQ{z5ueT6nV!iXkW9G`P9?Qp!*P8 z3Vcq=%4|rOCQv-Zpk1f&cY=Bh)AmzI{}n)^=sX^B4`&3WmFQ2E34Ix&qX1gv;0+RL zlh`c5+v5G;+9uXwO$Ie)28I(tJI)nb~K~FbB+s>f6KM`gg zLe&bqpgTG>*cD}hixdLCrh{&nNp{%O zGDBIPrE_x%zvH7Rk58Tc=js%|C)D(*Jk%aMg8zx*_>@ntWI3iESlcrFDQNxC{T9m< z&KOIMhchPq-VHiK^r7-G*A(y>xr#AN;eC#L@-tp&Y}sJ#58o&glo%ih5nt z*$LepcRk3hb^21!>9V?|UJp(gt^l3<2)fblDX4{b%=HUsbOh?|Zwh=2oZ#5zcqp{v zQ~4k0*hdI7TtmR63uNCEa_Is}6UbNyIj`Kz_1K$x0eqh`w%j7hKuRvqXHaKm0N?w} z4XzK24V=O*vw?0O1hv?}H&y2~t2ErvP1prGIglG9v!8*Tq41Du!BYtn@U9!sj@@tD z6rFQi;vnaSZMkwXuh}|d<>b3w`Qok79 zXf1I0CI~%&%6smPTilPeIFw#%gI6AbZl0;*InKzDX7(lM#L*1N!-WhIVcTJ}^kW(bXZt3F6-_o?&>#0Mz15(`C?LW?6bH)!q|bha&r(rar_*rxGBgAKG`?CX#L?Q8(=iY;QkzQE!_joC4cd?nER z$fB+1>?Q7OLTRX@Mxq z#ILR3Tp^JJiW|_GDbSPmOv;vq{gbDNzB^#xvG9{BjQq^9L^#P)kYxtZx6q{n2Sr zhon>(G(r16%ghz{A?eU>s@B|T8{9VC1%*aD?CgydMY(5cR4>Fm1=XAJ41y4~22R)Z zTvP8()K)5jh=b}e@JbQT3d>C*pjOr-cg+RwA02sJH63yf(yle1%W-<&9n;Wt#rZD}|^V_2rYzv)jd6RCKS*?n;%c=ucT)C;n5qvn$sUqAS!P~!t1s(cBIpFTJ0c!-Rv@(0U>WME|*qatk=F zR0zs7qVW3Sv<%o`FC$!{SAgPZKH4p&It*IOp!FJ{JOyb}f%*dFI*W8!z-106X#acy ze?&PCs0^}a-~z3qIk&#!Vf+dOeul)uyPBEB=JdI4VO73%QU@|7G9k35FS6&}e-7?9 zjM1!y%lzI3Y^|EEth0fAO^gC)Rar^Th68dN-bsAp1eMG9Yd>X3nGDKP^(+UHc!UJy z4^J>?SL*1{I$&~om;JAa`}{%WDE8X}VR;CVt1!!LNWLN5y2PLR1R4IRE8ScFFaA!0 zT1!~#4n|)I(7he(E6TW9hpLgw)86K_{k~Uw^X}#*mG2V=%-eZak+RO|L7abM0>?$tnZdiQf(FdWH zrIR95L9@ui8KhhXk4>;KY>ZgIa(n@(ghnkjxIm-m zkabyWWWl2&HeQUi;_7j{!K3fUD|RMgHSf=&uB&9{ov}CGln_bQ6MrN z+)m%rGUKt0<+_{~7TKUX$#_6xyWbYL>$FRV#(e|bYyD$)asW5@e(U2cmOcs_)j@6K z{|X&z)`RA~4fPg*ZYfwS|E0tF1-osMGIYGQ1JrL)KIYoNAOJEE)LPJN%zglFKY(^* zoq*V}SwdIkh)n9sE$tbPPfgPmUwl-$LP4G3-<=~{9SRrx%$c*i-xt&)S{lrzGeZ@s z^0UjoVl7$06wr*?zdJ{GBM-@RNzG3Fe1WU!#II!{pq*i>3xjv2a2mQtTD?`gwPRDN zGuBy`Ii9FA?%T_BCI@Y`wV(5g-#J@e55N*dU zARs;QIUhr({NIEPw(NfsHt1fT#K_Lj$R?xca-NYvm;thO4mseo8RQ`D05|C;nMtVZ z404*7Vw7-@rR$6Or^#;IkTlnzuxTG=xQHO@{j|yBmo_L6Fx3e$Jp3;)K}YeKg@2#6 zwAHy;tMkgYfkx2f89L=b_Y#_F@R`i-H9R%@1?cd*zwm-V6|{d5Zs+Y!mJJOz zI&AnDz_z`$e8JwFyK@>3=$0r&m-7!nd6Gks=OHNfL2m2-t+4>zH807a$IJklXRu`l zmH15jQLr{Vyp#gXc7AC-_)SK_b<)WOR$+}x^H2Co#qcvEwoFJqB(rQkC?hj>+A^?% zPaOX2yccxZaI(WO_D7AN%n6Qj0S0he$pKXE+}U$Y^}wWc^+@%BG(MorMEhlMPzQ3>pNOgp}(ag7V~# zrGBs)NfKJG#WX*1_VVf=xO6&9eo#lUmIL5F011x=HAcTUHR zo73=kWl_w{3x(HsK#}J}p@F zh|Keog{jWRBR7B81S(NLH!>du-O>y${Tq+S!R~K^YZ$0o*!^H048 z9WTBZdroINRTUB`Q3$oI;SW?=20jF;bsCq6Db(I3$u*umV=c>TY zt~0}7;y)KTP&sg*SqxkPfBv%3bAgA^3ipXpZo58++qm?e-B_ui2wGK^vC>%Ihowtp zx4WQX6K1XsG{U2fffY&s8U54P2WFE%F{165XPS!!7>@LI+I)@Q?YeYHZP z5+{4eRFSz4wU*x!RtZpf*syBSBIB5+V$ik_7iguKe0}*Al%|d9r8PoopcdU7Y;jQX zP`{!Bl)wW(D<(NXBRP{rrzhLBGH`?1RnU=~ZmRiGfg5s@x(3+K@N;l&p(mz;XLmq*#-N@8-*UkU>L+Yu2hC8UwBEsE zTb=(7K3G>80P+oKBU@lo4Oc*VLg2KIs~^t?@56Ubvnt#g4mv3a`*<&8W&?dJOBj4o z4Wn*p*B#viho%0W+h@lv0FOT*_f=IHj6m^EpvOvV9~pK=zV}?Ea&CzWUKNo%pz+?$ z)q6`pXM75SPxMnequ6|9rnp=o=w#o2_EE1yc19m)IOPb@bQE;rVImVhOT`pNh0n-v>RLrly)KKoq^h|o(^BUF55Z^ z3G6jFTc9u>QZ#@^b@S92jF}l26t;o44uWPbK2LJ70-d4V$II}L*=o^r>xRA;Q?pKj zTC$0teHk}-j~si^JgId$XbsgvnCf$&o3z-O+^efc#;(7wZDhe-`Drm`t0m?`NmP_Ej^{GuanhFsGt z3O*fNfT6Ivg$Bb&0tc3v_N3?v zd?poB3=NBOzG=N&P@e+Yt&Ke`2tvmiR}{-Of@cH*apzxrGYI?)f(~ZTxdqOq6Td)b zYsrIV5-dJkbM&68!NslAUZ?;%mst?SeP--&VW4rp`Jiz>_#8x_3~1aB;!n(ZD?W&u z`=(h%7Fs?F#yMYwIT8vf(`6V;nHd-ekA8A66m}c$d*FC{0VkN1FtrpsB3#eF$x!KV z>9az+Pl_S~JA>sOuYwaUVho@&9E2hFka&X!V=l`r>eY_k209%n5jwBV*2e?s3B30Q z^$Qe*puK=8OQDKer>lbRU)TidrqA6c)TwN#u+1%<>wn^BseIBAz_!rdM1GmAz!!#>jeiP7Df$ZDzfVeGO z>FgxtB<)uk5wp543N*FOoGbLQM`w?YB)okG=~Ec1R(F_zx8q%4fbRT)n^362exyz6 z-;Q9ng*zp96(eTc)SM_V4OC8|nWEC-{Y@aZN$1>;Nee;uOMu&`$nM~N!QK8W$)qJA zF>Sev6{sD^&@D(LcC#ak?`7MHY4=Q}fkW~D)E z!y#oUeU6|pbnLkTR62@)%e>Dw-~0j1CmcRzo;0z~6`cPd zwG(8{z!Y3N!Dk3cbeN<;@f+ZByhO+3+R2Frxw`uaOR>g@ z_Z^_yionCw4B%6DkjIr@gCrjzjs1ao=$Z`Xp!FX`keOMOe)@aNemX3N!usi;mKdZ( zs{xKpNN)~TTu36~0dh6E*gub&nojVJbmC(IR+1s+MX{ZPNuBuOfwsr``azcwfYK6V z=2Lc`0E=Jj20^i=N2{X2sh&{GDuU)hW1ulB_3qQxih~U&{I{;o{P>ZTf9H=MO`&Qi zv!LRjSy1hlfm|q4;4TwUWK0-$nM<9(tJg;FLUzwySg6C7G?DTtUK0RTAm1;qD^J|kdk;T2S#S=1u zpl1iS`9V`PJ3}JKwF-Q&mO-KVNj;9GaS{4<`#^hz5}EkFFqg#5=-@Vu;b2HKezTL^ zl5H*rbf)7|1Nd%P@OXNe^rTNgN~W&ReG9wPGxWgsz`3OHa91o{Hr?xq*Gnf~P?hr# zG)jRs=7BWBprx0@eGpxER291W!&pzjvJwd@Khv zcEV|+@U6xaHs;39!1;`W`{f7Wq`plhx16_t+H0JkouCI5x8-m*o%pp)1bUY-s0$36 z*vM7DV&+tsnKGbpAXv|O%Rz;cQ)^pTt?ml{5fp3LroaW7!I^k~Iq7`(ZDEFg|NBAL z-%bauvWrpu&~W2(C}@OM9@OJjVXy>^|35#;xN+g*HIWrJAtUvmm0Iqekogl!@R<1S zCk;0iy*PAQ3AE!oT1KsXH|Pp!kZQ;%bPvC=x1T|K9C+flWS9C6WgU)QZFSIj$|9eI zllnL#47@vb?k_)UF9}|-R^L90n*nt4jtKMRmERIePCk6svy_ve^Z$)U3EUHI6f;OO zXeK#KlSa%*JbsQ+c7bKVW6R+AgiUfh%Rs$7Rso1U#0cSi=qUI{&~7DWBfB#?mIr0H zW*M}XTZ zJMp~j3B$wlsweCR-MkGMeFfED65#$Nt};^qQD(Zz%)WNEh6`6oiNC}{t!G5xrI8VX z6*B{ap5LBJ(8?yX7MdTyZUdi;hs$lE2)EtLeNlR4rO=Gl96?YE7JHwUkPAUQCD8h_ z(@xt$Ky6-BH$!$ILrYM2-I)2JW!nT@Q=;80%;3lTI_k=&CpKK(Qtiq_UE9~c_IXFMl@RzG2DLBMJ$ z#L5HM8ti+I6O6yqLwX^^wj1z=oEUg4p?KPx1w9~4`X2vN6*_x5xhnvzwy*1N%QSqmsdAl5R}M*V1SR|e?-ow(?A ziCyZ_rBB+651rmqn9~McXJBx_djD;8C5A-M9hX~5j)QJ1)?Iti!iu9Mto&S_V8N6q znYgA6AwsJ~844daMVt1u2euL*nPC=?uv}CuNN$s&X+TE(;HwG08ebi5oorRlhn=^Au>WHakNigY$)l z5+}i2hDd1fq0Of&^LkHn46n)_vk2rY5|B5 zU#5C&e$sG*>DM7h_e0{Y=ERUwhfXWWVVPrE0_wO2yG{X+=D1lCt0pAw~u^O!t#s|Kg?dU`Sot}47JYrHGrYd8z57OlU&8xmv zmSX6feSH^;M6%br3DR>{3Z0y)4w@AMO?xergU%hp?BeudJ93O&V)n+lyj*9GzED81 z?E>4wRBx=dt{#VTMjfstx3`hgk!_WKJ1 zLq(B1$dQ;~L5dqCpgz!Iuw`aoXqv(dE)Fs$D8Bd)b|^on1+fjZ8bZl2^rYOPRPYK8 z4n-bAOqXIE;jsmcpn-38Vc73xS>PWK_gW~SM>A7_k0Fua_G_yG{|}(_W&*h{{1vEe z&CVbwdVQnzI?yiriSPRywHeqMHg@x{Td}EvSl>06EZIQi=6=vQ<>1?*q1R~qZ<0_2 zjotEifKFt31ZoeLf#!yq8(=NyT|Qr-_1ng->!muTkd;Fm{GdGLc9i8v^CPY9(3s;3 zAbIYcoa+P7z*iU_c>nqq&xgS=%P%eVVCH7vyt8o$^I{L9l}X1y_XmRKix#*Ga(Ha$ zQias^DxgzwLA&FRys8ZVt_1C$e^ZXw2Fm!@froRjoS=RD^jiGb4>Zy(G zpt%l34fX@ytQ0`!0x{o+yKeXbv_t&y`#xKcO`x&YoqwgcK^KZD@j=Wu4w^`p2zF9} znsOXw%KD3-v6xQgAEu!7>8uQ$U{k=m!#lV^E!DjJ$CwO3zQ z$DNm(HIDbQ?dvI8ux#6W&<6Fi~V(YM=u;xljo_VUYAk1E@)D+VAt zI+c&Po&cS)09vo3*wNSSt-1+xl6t570(Zd^8`~jn69K6J+rnVmMEAltmJJ+Bjxz;7=Rm+rKJ8P& z!okVVnJjvpG3n@6PskqF6C7X>P*wr=2ii7(=e3TxZUEghE8(iZ?l$p>$RSl`NQ#8c z_P4QscZHnzv&$&Wa9600ftA)C9c>1C(EWd)HGK|wYka?nY-gxD_FGIx3Y0URMe}{^ zXl8a#(%N(8_{Nhf4hhX{df9IWnM=z6?d@Ij$chb|?vJ^$f$V1DSDUTj#ZmtxT7iS% zp}a$i#RWqRcFj%v_w+OVcfoplfBSx^1U?}&exb(*LyTwf5^XjgNOl_Qo*!e zC9|FOT-wZ4(lAS9AyX^3U3w5(n-rT%H5eS285ltG=cb_9Cw4W4g&@w#_-I3L+n>I7 za$pNVI9Igg__X@Ptx}qqJ=d{L4wYf@hxrRD>#B@bI z3P5*A8v9K>*OR!gqkRsj%?cY4+RISKwwec2Yk^v^bv(B}F|Zg*S7|;0o!uHO*AQ{4 zZ4zkx83zMow-*~LXm#lc&^TM?>b(Z*Kr39>z_Vnl_QP)Kf{f7aL*0F$3ZAEf&e>Zt zfX3`#wcLb)sVDXNRyctc*s~}=_KJmrQ@F$>kjsP^erm9OiH)&Z)h;)oA%N?}?j7J$ ztT-7qF1jR}P_x`#ok51dk(q%(h+$)Q&6JYKMGxjZIKE+O;3eNM1yu$?2epKQ@`uCR zJk2F#H$F=!38~m=X{o_^ZVHnd<1E)*4hJ>ubU-dL*18KmqblIZldi}X|LyHMaw~SL zaSAddGED5Blo!O;aKhcwTvK7=a)|4|CzPu)>?}MrwXD!Z6ui9GOTwe3-A3H&@}WbI zS(%mU*E8e@1XZSaF{m>9yHn!Bdg}<-T~cjADxW~^n=WFpd{K}xuY8x0Q<2ZsE)YkZSXG>atB50M^!{z|4 zjG!4x^Q;x7FwL5x#lrv*xdifXA9(-Yg(9zg^8}B9Pmcwi+~~saCK$9=404uJddo`z zxSoX~7nT^f+Nkg{JcQZ54dfnfFkj=*&ci*4vqAgbjFWH7JN#Z!Ff69;_!J&!=`{~@ z>g435vAI^@ttcQK(mCHUptaHuEL|5oa}&p*41yFw%q<(p~|2YBoG&Xu2}}xIxPk%Q1_)UfOp1& z4mrGaH34)+lq7aH%|E(<7pmtHcoz~6_j*@uSDW$~hB>X*7fFKpZ?OD0&-#qSHY2ZH zCqXNB6VrIOZ6tI=KHf<@wn4PQV8%&K&ld4`Ab@RdQL zkDzCEeJS4`%L*!I3zWdCXO4Vf`XMP}1ipd@bP-Xbj6Fx}aG1*zP^$s7-;fD( z78Sy@sgJRk20A|x*|f_^pxsvJ^{+6t+RGvK8Zc$@}&_aSKB@!9pMhNWJ68ozG` zjS2HHBpwRgwWV8m6)5*xFbXpy3V?Fk^uAXM*;POXv`R8KgT{Z>DS=jh@|^h7B(YgS zHyL!I@4}AhGbJ}m$b#-;_;9%4!PmAq4<4P0+XT9crsTr2?`=FQchmPl4=E z6oiEt*NVAkK;`Eg22kC5P=Vn^|J$BMD%oba%| zLXk(DF{o+2u>FVArOeMC}g=1uw5~?3nFr z!yw7_~skr9g?4#feCo3W;cHsO0 z1#xKJ2aS1x<|Du~+NwTWZ67JbxM843+R>*cc0DPq=vbVjT!?!{4o_VUzq=UHQUKim zW~i!rtak}BXdZo$ej8~2+m4AP2SD{Vwl)x`!2_DRyw3m`?IJvnCjf4f?0*Q^LwB+a z*X}tUusZ!nmDt6p6SW|BhcW7QPl0X*0=Fq4BXathr^6PfNa?2D%nDIQ+K-DoSI7k( zVUs<6TzriY$SfmhpR@Bo_iZmwg65M;DDzX`^YYrddSyUI!GKO=l4ptW><@Cdf3)*D zY^$HvvLt1}cc4lvO@W``A!wfaM8L+0&TDcw^jCvckpAaqS_j&~_x{n5?7gS2gX;bL ztv||lq`N4s?9~F@Mj_8^biW96c-B+UO*#Kr-OpHXhX9hm7GsF3SP!eR%kv zMXtjppk2l@H(+m9q84OaVj*bc0<=FH+E4j{-?bAxvKB*o9xhOyyFh&oIi(R?&pYHv zaq{$kt1*S%t}3ZzR@A}Hp|1@;`^iXK&l}_j#7Kj1g~BHX*&>y#j$gIfRzl7Ggk>iq zEGC_Mxb(Y0d)*hm=i{4v`0h;xcE~x^$LE1^A9$vLA97bJ*#4=!pgI@Ys+0%c^ZFq0 z#-aJG`Y#T|&rvzh-LEex4(jQF+V~n=%_2<++!73K%nS_mDt7x^IEytvGgF{5`9LRw z-xOe(_?1^0y1E*&Yv|^Yt?Q8EKmslcofd;d&ruN zx(YfqTN*Ta37f+LuMXw3Q84diX>+gM2Rgr(6SVGf{}u2m@kaJ1%O)Q9ka0e|9kS*V zH0lXoEeaZLkU}xdH|Dk11IC@1Dh4*UK8K2fMixMAZ#1)DCkilu&WGdyCC>HtRMlrV zJNg`TdkLOK2aidBa@8)-ZQ+KZ(n}9NDJVAst(KKX*`FbyWhR8!)CD?c04xt4QJLZ! zGg15X!Gx$L@Qhc;(h6Am2^ELC8Z@?o^Uo1;fPA>s%T~h#!1VYa&XX>;C?G})j@RV(xBWQb6PvE^H0UIYmHvx$; zxHB^_fYwrof_Kk6Wvc^i+h3CNs0*|~y^Yo zBTJCIVc?w?-P2sXz}NPIbD*Nj`H7(MU1p=+CB2PL8g6WuWMR5f;%-RJ6UdC*q0>sz zaI+`hZCj!f<5aKuq2Z2+kc8aZpP&@cnGD$x0G(rnrWGkrXhV1Yw8(^;mCV_l1zH|b z3n~TwgM1G2Q&c#Tb3rQ+p|WT`xg-r8mvOsv%%Lderqh9~;A05l#XLc+Dj9}<|LY-X z6STJ>PRtY8nV|g$P+7FpCJ$Pn`oEqBv}8!e3A{xq))X}Vn}uegS>al3M1ohuZDJ-U zm4L_CAZ?l@4B(swi37;~JW$j!D1&>N@Kt{&g_8Q96B+sp9-#Zbz|$H3-%K(Ft-k$t zCuC~C#)&I7TAJ}Mg^Y;8W+AvaAu9nAw9Hn4WIpeHQdq&!$5|W!-3?g)>b-6OCCCZP zKD+M9C@>^Of%Z^`gNEN{G_Y=Nnen^&`k%>++-aPK-^*9*1od10+%dnAcs)Nt= zg`bOyTH=CB77utii&36(G9>PsYV~f0LAxpFl)tDS+;UCHhh)Oo84@S6dKK_wfm{gA z>+zAGgVI5>EYQ62Yqu@fbPf)1cp-en0qM7bXNPdLYCt`15Ef_nXTIK5*ZZSzMyfT?+v*UZCN!2Pi6*&?g<9*9|9mQ zWMlZp4%%4-T5IUQ0P+zGL)XamO|uHzCN=d*Fi1W2nO^uf3%qScY|9E)Ye;}$B51%E zw6Oa}*kXkuRV5kFc{cyg_atibtJvz#>XK2VXfX)I3WgCGaha3;aTXLXm2?}+22GGjy$Zb-rmY`M9e4tgEJPaFs zJ8ptjj!#^i0$y>c3R=gBlD(h_T==J_ah2^5)>EB zjdiHL>Sh3)B)|oUEgWGjis8deF0(=pL3-r>VcX=EM5;~(ZIkOfqPe`qQp6Mzf}pcb zo`oCUYP2kIn;xP#!`V?Sl;fF!tnjl9Rv?=N83Y~dLOGsYP;^TTVtvO4S=lJh09xw^ zVdGxq2p#q9n`ZU-(3BU4q@H=Jfm`U<#!|V#ZE?`LM|W{hI*A9J8v^QU_}%4??*Qct z(D^x_of*We@n>NW>`vzAX4v>$d>8X~7U9?xiVVt-)w8F6=sdj|KcoBN?*NzMF5=4~ z)HiRe%I|uyBJj(Fl?tF5<&KMwpsaB0jHJ0|*cO|+mV|t{ekX_nv>I%~(fe;BLE{6E z5pPiZ9&5iCUcb<-A`-O5i-})Nlfj#rfnoMx7x9pFw+!NqAft%LCr$~0Zph8J7p0Nr zAzYZa_r)QR*P5W-2M0st&bHFyc2|^HL3X`4$RGnixP*nc6Eu!-jQx>nTPL@vD7gLt#Vja? z3W+b9aW`~QTKP%Fje_7)$dy68#}_(ep9nE_H^q%{!1~yZpr0LS&htEp#TZ%OLyvA@PLp zId&fh#U;(y5fBWT0Z9g*7z_6?JXXMG9YK5xI_s!S&PjB!zM)Ud3eLG%RUDz-k_dl; z!yj~q@q`@)zL%UQ2tV@%-$X408K3RcTO&V@e}O${zS0ad8s;%Yh2>$YJZRt8W!XHa3-7{wZ~t2ueo%)folSVhZS)-vhb74(=pok@maP5c7= zh1V7aE2=U4i-}iDIOyWieo&p+h0}IjPhVlxpM6|fSEqM6r83k$xP8;3@Txs1)IhgB zXIQGn=X=e)lDXjPtpt%N|3Ry;;~DrtdyRS%wHGg$J;k~2K?tZc0o|+}Xw%T} zx;OD<$XU;(e+z_MCn*bk(^UYSYY4hE4z%wFyxQcZ#J1-XE_ypE@PhVU-IUnI#Lu=n zS$z{Iziqh^xyr?2z6tk6nrHVo>@@Ax_IOB{>FOkPDwqoX|YY%6qB@3xhPYtWqll^j?a`@H;2taE zb?L*GR?eEta#!0rP$e@cJ^4o7e8_&#f1R9e--9%{^+D?iIn#Ke8P}JvgM5;!AO>Am z3E4v$|0)M^(3LFcMy(@HQw}uEzH(Dy+b4%hpMMGe^kim`1Dzt#7#ryUTGY`QoXYw0 z$P&M$%5EZyQ+cBK3Ke)k@-q!{Soav64b~KA5Mb!^f56BRlh5P5{FTc@mHA5G`B+vIob}6^Ku#^x4oe6mkJXLW+cFUDWxlT}x{ZP2V;HHe)t_4L`zXheQWP;qi zDFU7=5lVvGg`BZ+Gw8glKJe)JGw~xUGFEQ35h}V6lwPUw0%)wr8n9)(0Y*%_`>VDM*VUhLwkny9v#pa?OjrHkN1P;00~pp6S$ zZ$fH#(0RJpN^Wo|y3|YM$%3WlK6$h-@H6}j$SvSh?4D*N4Vixe)fJ#t8{FHVSsEsO zg$Gs15muqalNQ*oaGCg|qotOM8`|~)O?(uB{0Y9t7gT0i1*)7}uD}U$GbkN>*aRtk zB3B)_doVFbk0AiG|L@&7HGT$8Q0*XaCeg}gmB5)q@CfVt1I$scTyAECO!7a;zzHqW zMB~apcZnrC?3xcM1j6@SiCiUcX5s4)1#qa%_Y~b>{rS{%D{s*q*2>_ubW+M5g4Q%SZiS5TqU|n3+1Cv^MNwegrt7nV-ZOyO4v_vkYAXiXv*inr zl5H?qnhagTjA-MR>wxA5;t{8xmFO^mZ|??gY~o4Vw!>hj#9dkL-cqAvO=&OisYt2} z525$Duv|10xo8NM)t->h^SSBBEKNMR}1=jAG9n`){QwcO~022Y7U8%tk2)h3nx|eI> zu^A6j?jY7wkk)HQtSUAnu%4LkDTTz$m5$B6y3XN+Vx#5 zpxwOj49Z|}*}fMB-g9=ViT~UEwD{eu2IZ>81x1H8UtJ->Td*qRCpeXILw6qCG6|Rp zY8BQquz-5awxIYEVYtY~w&U=euDF@Y6xff5O?JOi<|hUknEC$VQgss*KFTsBSAq^$ z+YY%=7Tl-=oo)o~ueC*i?|uc%mAJqJI)N5@Rt zvta)x(6ym{(^cUnfm;2bTP-b@pDtnmjTu13eqwG;Fz^e`3Em;m^>UTN3E$*X z(bcSL12(P<{F^Af2YiAv)I(r5f^QrKnG8NXB0bH2s$VWI&jrv72dEwEv7?bu>S3zC zJj27!Ii^~!mML}zZuGp(2~Y|Dw(`Z)mll(`boIkpx24(LXON3^g_4PkHm~261&jt!?2728~`m zhgo)QYa7C|EQA?4;q@G}Z?FVf<23dsYCo8oc|tvHXFenNB%Wu{e1=-*!xjfkIlTGm ziYq2}g-dQ`g=pRIRsru0yRt9-Ca5)@I_n*09jFs=1=JqrY!R?^XW#<)sAct=ugk7j zL)z+~dn-ZZ_7YI6fpQq=xGLwOn^_@Qv))16pQFtmXQB7J1Uv#GQ6$V@$=ucYa|0h= zgn^dMzw}ID@8X9J6ooO#EIM5W>#8{E~cY~=i123q5JH?G%!B_0>-XLbsnVk-c z&dlQata$JR=;S5vZLpyEEYNAXM%KZ~JBvVRUzqjip&AdaR}&^C99miyq73fOe0Xii z$@X9>XX>?(8T_7(vN8@E4df$C^|mgSnkdO2%@D%O02)bsZMkTF__CMt7P!{0zp@3M z%OGnah_w&2F5v@Kliq;qH;Gqr;2TIFIg{;6tMbkwm-_WSmu(%p|HZ9*sj39(nHhi% zur=Z}67tCaU$8hw?>2)lVian!YyJ8)%3r>F@iHhPnPz4c{DVKZNOi|G)dMd|AnVPY zq7@iGd*KWqF>w>ro&xp!mrdMa=+D=o%d!DA8Hu(1}H=FY-HX8zS%e5XT*tYba3pg-BK@fj(e*a^fV6z(E7KS z|LkF)V|EbAbXl#AeRf*g`-1h_0l~c{pw={s**73%_B7BaAH(6+7f<=_2&*t&^kxQ^ zSm1dK9#DO9Qi>rIwEw%e>l*9qOlHvfxkW099QwD#84~~8WmGtP|LgUN0^_rfPO?9c zKe60A7q$mk3@Sf=o#=zKSw|=HAF!X`pMMJyHcUcbv-_+)%N#XK7adN>pT!GqVJI*d zHveBIW3lLPL*=KXA{P@6L=~N!9^}%_=q_v$leNuDMH95zum6R?gBd~#ChITl;A8e% z&GG}H=J`~cSg?>*`pMg>$_${}IITY1H$BJ5a>VV)($@d$WTJk&m)e@*pp29*j@j8V zFwDEd&gAR+l=pvZ@-Fok2kN)KQdI)4qA7?2Wjd)8l^F#qWwX}VR6N`<=W=Q+cr~FC z!%p{-86^)o_?Vxa1nnBtTy(f$>yt_PQ%_6p?~p`}6d~5{Tk@Hb~4GFbFXuHh5`0D19(bAp#}`j$JKS$^_dC-Y=jA z>a#=3i=dWF)~K}!;v2g|i&Bl08N!$u7*;kceknW0-e$!lE{kkMP>$Imp)WJNcvlYC zL~t#vfE1=;r6Oydc!7fBSQvVTrQQI_Ek)7e+9TpCy*S8_*34BKatZl=yu{7$$ z`Vek?Z82nDLClFfk$+MNR0?f*<{JSz#`&_XV>{?H>$SH)`xcZys}13$^`#up{)X+4 zRq>$E0ngWhtOc#pgUr(Mb@1NRi7ok9etZF_r6S;RO&sDT@CsYdd9UD>NtyH{p`WLk z#rsZM#+rd*o|R!@{&_4Cc5BgV%kCUJv{_7vzQ(fwllhtpm9a9JHij?i(|eX#&M_ zLJYH^!LAL8IY|E#*_CO#QQJaF4B^ZS3_l>p=|M}lX-F+1hnyE_FBfs^uLjxt=dR%j z=uS(>es*a4D2q*nLtkR??jQXEZ?~$iNM(I%+FFjdO}1**%ICZPfY0#wCZG#)mjrmd zqA~-=>mt?(_M&@@;%{2%J_%nH11jZ;v_4p+sy)<-y>(Qum4|_mfgk6|J-m<}(K%?- z59io3Z1os=&xUY61TqFH>^f72<=IqDRf&f1EGF=!%b?LWP)aJl0m`h4I#{`~?sOgz zN;}Ea9NuKwkiZbPvNNefL51Ppoq`1Og7&j-%1!jUA{H$8ru+v(l@f-kV|5k@9c=4a zvKbCC>+lyIljirY3d_-_vvjg*|ln)0C!G&%uZ5d=zwu$!W?E!OXzG_FyUpDAn@8+Z~{j%!8Qu7&c0C zvRM`Q3xKp_fx{P9?^FnU-dN+$oU(tdj0Y9IUfC1G44Ewy6m%EaeMC^J+%s@Gs4pWA zn=3PL5_>xpa^Dd*!%pTV$E;JJWz~FOdq6p72I!>mXH%sVAg8cBo2q&3BoCywUAx|A zqhFd%s&nSqCWTG=K&c9n+Ie6m9V`D;4DJ=fmOA<7&XF0+07EX zZ88>%t+$+P1l_qR3mO+>65t8)mp=?LM96ctj7aOQyAzmYd&4RsLHpJg%ZDV-aJ78F zepMnZ5VSW)mLXB9fQf$=><;+P$q{~jQ9P$TBYC}jmRlqq6lIElt z0&PHJOm8L9;vY*%ybRlVW}%$GQ+ZY1mW`mZ$Kn~J83Y}+foyD5ICe$zBU{}{;qdCj z80cvXpuC3~@|+BYg*uOpZLnsuWe|acsP~j)LG!lkum3>Cuqp~NB*yi*-jOJ4pAHhg zd;cw{H4hG7=n0qT{ty6#{xY`%I}ByIOLpH(pYO!YAk7d3I{!C~2eSPBObMtqv{Svi zB=|^iyX0Z;!g~eKs`Jy#p68oE>(iM%&wC4Pc+d~ND&%kV^*@cf6fsq(AxD@xuL3)$ zuC4*COyy>HI9qVNvSRy5WkK+IL*WY04vKqItX5ujV3q*wgt#&9FytnZlO_Hik|X3i zs^Wqb1kmS!CW?brK|g@V8{HNDBQXuM{KMqCCTQg-WcP*n(tE~`bA^q(c6l!En67Ac zPY=}S=V5qwzo$Z$)6$2pJl&id)V~AuSl>#drGeIk%|F1*vE!b^G{38JR9?i*v}#<=+yuFHzT{!hEFJTanV>O}`3IU;3L50`99O!V z_wD9#&@RP?^2|o_x%9KaYwS*ST%VZXHXVHathb**JKskJ(D{7-?o1K=XeCrMV@?8J zX^9&H=#+49NS7)7uskU9>cz>9>l0TffLFz_$U#mNRb_}~W?<+EyyqhM(Mo8m6Xc8y zh?*S}x5yY(%j}+V=FEKg6H{$LfiUYG=PYFgP{>~qJnSUsf7x3Vd~B`9(^)%P;%0$% zc0yzK;kz8DO&r49ds3F9Ow;ULqP)XfZh7{bj{c8);B(@HD;BH`*ShpJ&2<_#s4ovn z33s%I*W-%oup)Dijks+Jqnqw55XEAbg>?aAS0=$wC2S@C#J zg={D2PVI;P5o5@pQDM-z94sJLLDIu*!!yL>XEugF@Ch!UF<8*-Ydw4%7JA;ApS{EL z*3KOPIBPh_ob~3|^f}v>Cn~6d&iq^OHuKf3ZfieZj$5Bq`=!$&b-8<@o=8>&I`521 zcoxV!r3-8eq%;SuEZHXjDuLq}#2IeJR7t%!!J>2HWoAcJVwAVuPI5$7eotk{2Fh*G$h__AcL2ETnS!k`v;O`_FWp$F>mUgFC> zd(B%H0&dyks$HS00?vIr*82^zYa825JksD5^7EyA149ojtz7PPFJsB6m!fTAw=G{po^WLEP=>NSrj|BXa5LQ0;L+U%kzj!Fz*69F!R0P!o3U@2m1CDl znOL8U8JQo^>Zg?=yFj2!kv`qCkPF;xf=F z#`~L94@!NUgP3`gR{-5`1Kyz{iZR;=UgIYL8r=|N_~-6Dw->ZqWP>$$&QOs-6f|}M zT0s)9Gpl;#<`70rmV=MI)fhw={#{pNh-GGA*m6+yh)Epitg(xrne{Hvtxo?Lq#3~e zJuoSuw_=_LgEv#l?;ir-$=Qw*pn2Gv9&_QdS1dSYuW-cz^q!`?xW`M<8E~G%hS_fC z!Dxx$AKiza<*|R0J80#!0`jOtdO#!d1L%e!0hepYE1)2& zeq)L6X zdJ;DZ8%oMBz}NmPM6^};7z7=TwO>r->7LthQXtMu9@%wX8Ky_J?F;lX6zE`@TD$VW zL*-^;@QGSSPC6Vrp{XQwC3$s2;0Mb+Z&On~{NcO#U@my9>&Q$)oiZggcF0ODa|RiP z!pBx@Po5!M*6<@J9ki_|L2HkW3_~3F{+~o&=@?LN&LK5kM9lQ0;OU)TdyBdn6%Hvi z@4lc28ubRv?OhQ(%oI0sS#^{AVWzm1nxH-*Xo3LRCzOM`9&AcT&6@lv!8|O2Vv=`S z`EEXt#byF1EF^?L?Oo8AC#anXSrelOI#+UM+fjqR6HKi^>v(xQCWQ9bIaEY~_cbuU z*Mt0ZRP9oErU1GV{R96Cp>7xWS!4MZX7oI>QxylzeAe-R+b_|3PeX>lr5>i*gZ6gT(dCu0 zs}$rE_UMQsor?B@P51SJrRTsq_j*9{vB?g0>flQ}4&Rk*oxT+0KfQwrrCtxNv0dkk zy0*}l%elGgf@J&d?JNF(>TeS+(0K?95H(VzP18z2)w;09n~R{Hp7JqQ1<G(&Y0+ZVe2_Q- z_m=XEznS_~v4P4k&}vX@{X6uTM9h54#~|3gWi-3J?}2>LXj9WvdlB;7C_EJgoLFK!^UFpVR_eg zM1phr1w##CxY&xxM>pK)oWUd83|eirAJjLtF|a*k)q6qH2Nc5bI7dH3A)_Cl_1Ge8 znk)yWZE!Psif2_ew$fCeA%U3zqfEsXH=wg>`4}Jv`Sn`$uH1hc)U%n-02(2Imtir> ze~B;l<||JZi8Et>oD2y%#UxR{<=S^}e+jZP9apUYJr$vEnw37Qg#&1Vl6Qpi%v;R| zMR4`ZvH1y-_7L?pHs63o6XC7~?Q~KFr9V(xY8!iV_eF8IKP9b1l|iF3&{Gt%uVkJ{ z03B9$CTYtPmf{!QkwrVKlR>Avf_A$@6F{j{F#F#GgTtU29hx7nv0cyfk-fFVz+?sc z+`=8z-G37dRKcY=uJaMoAmOzOl<#nb7f23-p*t$UDPdXmoG&~cpKjH5e3Hujkq90E z!PdTkgq$8jA~OR6@|-_t%=%RJ_lND^+xXZR5|zxnjxP{mNc=37`(rut0dVyfv)GRV zv~vR-uh6^r_LRxjbwKu@34msY6AgPLr8~tAC#feDDJXz?ZwilY$b5iQMC%Hhr)`ED zA$fg=<7Z}9$o>)ASw89+#)rJE$gtOX}8Ob%e+1J`d$K(>Q6 z3fgjmUEJQ$d+GjLM@SfYfx-wBp(KhSuNEL5)vq6DbF>);JqM7+R}%W;G1nu$K=IiCf%GxI=q zpT&o}wNB^d0G*fi&bgq$LJA`O@_@a~pEEj^cjm4P2AM06{3=8NbQ+k*%sB~sb1$m4 z?>6SrUky9;39|MLbO#@39i0it=gAJw#E;B4n(_Qrtu#Y2X#8JN7JTzFC;U8#Hw=;t z;N5l>{2cS%SiLXo0mE&0!*u%#FYHdyV$vcOgW%40gzl%#C?VK%#PWOS%+N>{s zGgF$O6FmM=#QdD`;N;ln2vsH}pq+gG?qKQ%$$&;juDEr5v2dOG_|&Pk51T+|Q_Z&% zuyAoX@!}(E`PSpd#a#v0oAE&wO@dBql4sr|-O+n7@MAf6Uo5D{4{EV-f>+YAf^O|I z0P!IwZh~ia`0t!mJf`Djef{0x^Wgb(De&4$(Aav@RV^;=SB3&M3_9AP23#oxN{XO! z4EPp0n;8gHPL~7^DuS-Tss~5>YyT(eyx?(%%R<*YoK7)<2AvOq?o$G-)Hfx0B4nSOB=i)pN{0_A*DL#jO;&C;)cKHLu=c|y27U(3 zS%T}YPb|{$YQI0RNM{uT7lUR~!!s+;o~b@=2F*+06}NI3zZ5_+ax5m-K?D8gco{V3 zfkxVv1v!A_#27T?m@hH=$_rI6FwVVf)wfWdaf8HSB>@J_c_4GWj`vjT?VFMuxRi}S zQ>o>Jr4B1YCvox#S*#19(LgRDV;w&W2zx$tWrYH$J%D}fAgFDOSeXYqp%qyt_Es@51(Enz0wHRj_c3-SF*a7SAA3Cih%8)1l&ep!{Y%T^7T6Z2_`FAjZ z3)Ct`n?=UfK9vT|VtGE4TmJHcq(BLz`v5*`TW!%~(5T>koV@}_ng-q64x5XE6u)vj z%doTsjTq9v{eMtu$81gD_MHUCcQ&9CUrb~r1P&&s?LJpM=a#*M52zgn9uokCKcuyf z&3`f=|EYsCEjyg-; z_XHNJgcTJm>bZopbY=#IZQ#M41nE7X)$3@ZU!eYgS@UCA@DK+B%J^BAnZ-SoNaq}p$h)E(D~^XT zE?#ob8Zz#LJbtDHy5r!%EH6Vx8wY5!9?~7kdBAlS(tTdbyYBLg&KD^P2(>+2kgmp^ zTMw*yS2pwJNO#SK6a`xkmP#25&gIcy5OgrQSt@;mnFU;yvE=0z%sqDHAlo{$^u(qK zQ@Mfx$v&$a2evKTfpj{)@J8^Mvph=PVrD33C}$90U|0*%o3rksqE62jpJC<|&;QPxZ!1D;xdoC>fDZ4Z<{6UqJDd^&(Ocq6T(A>*| z@+oe?^C#t*?-l^b`PO>vy8Fh7r<^4yT?)cs0@+^AfUU0tS@&&!*F()@zq0E5paOlR z>w3`hvNs!Vo^yZVB!A5rh2VAD_(!9OSv3H?g?&ZQjTIK20U%e!Gl)V~2()w_<>b)w z44Dxj6Tr%l0U8~uXAor&bl7#8H|B*#?}Vc-1icu2yW(#uD}%?Q3lglh>YEoVRGwgU znIp1C4s`yU#SyukpwkC=L9@Y8N(`CI3=DoJ9lMqUJ_)u0?K}gmYJuFy6AUWZB*5#N z;p6D-H$WHCfYwLzoKPz*I|%9L=}E*M+i;_E1`nvM3p!Wm7JQ}3mMbD3-p1&(cIDPC zo|B|-gY7+d2Ci9Q(>_pL2)@M+Y!7&?3aGTXRQFuDKT&M4GI;%}3i!B?9h;7x`!g%1 z=Nx7O_d^$ZT?%yunFt<}0GkM2qXp{sgVuXakP(PB?$Hs8 zGXw41@VIfLkI`$96w|s=hd0Z@Up4va@U38C*s==T<9OKIpj~-}Wg1KNk;{1@b5s}@ z8miq|M5kLfonhbv?Ey5@mk{`=32HBa`%)`PdRX+{KI%wM0gcK&{A}&D_+#fluXm)OLVk2E3>F+QcHAqK?3asdjyQOp9+ZeEndk zclF-9UcqLrE04P0)qqw;WZ#-_q(#85@7P601(DRIm;Io-z#-$h&~u4Af6wi=X$!1~ z1kav7c=6q&>(4r=&`Im0pgYJE7_z|kzdjVMSdbhbHUss@vJvrnYdO0^&(462icaEkw;#wtPpFk*=)|ICEnkmeg*v#!))oXF z#|E7S3|X-h0*yQ56D)Zc0&PHZ0_QsdmN&A2R-C}r)j?-tyl))I3%SwpQ5_U`26sRi zafkTCY-R>E(3o99c-dv`(t~PZ>Iyql6uU0|)oquUI{EXGSQGC5hq)UcFg{QR&6&x7 zQjrbU;)fC&{nx-Uc-*wT+*~j3)^ag2l4mk!#=jj3=4>l=1dB2%y>xr2P91IUXKWKe? zt8*^I-;cl}UXq}@lXVk&Qw}#Dd^aQY{VvbMIFI*I?YoUZqr&;1mNKXn{=MG?w4Cwb z!3X>N6~Q;2Ji9)1Do3`8v>Zz4G(x)ij1m8`^S-_<< zs0Rl!6)~?b1gWFWU3{M@@-x3cx(X?3XR;-k_#4m2!Sv)CkyMKn%N-JLyE>X;~lh(2glM)s`- zpJrt4NpR3&$YEw+c(VME+fh#@28JE!E)j)0l|idXV5L~N2DlId<<1s?wnYq(*%UeB zUU8m|KOvw>iovdpRgUMK9_X-|HITvuIwL3u%2_gh`GV3BB@3i|h&&qrKGWm+)YONy z=d|})PHMZ3r{OnFgSqf5pel`qIc`bd5^>n zoUgdg1fD580a|R^I$cx@KB{wQPr`(RU&=B@6=!1qNJ93`f=?APxakt;^h5bR6C^L* zfVvwpa{-yd!GEU}s1+{;O*@MV+#?buSY6imwA(vEd8Hz#7lV7`9eLE2nA9T)ZsF*! zH155y^kPuD)KRO2YLKyUP)fef0ND+vzw+|AnjSarxnC6O@*v@KZgT<9YR~@+gwpyyb)|dj z_oYlM>7C}f3cSjM4YZ@+)p;Ax{x{G$EqB`=ELeI@&m#8ml5~edpjOg;@Cgo}nTzxi z$PhmZ=olmLxClGwtdgT2+N;3pzdepMERfqV&y80%Jg1Q7H+YT!QYwMkQf4cSdk-0$ z^^e=lZwWd?G^G|~I_UhMory9j6E8WQRtg2hEGNUw6G}@VqvPBR8yl^C{0!PTRlb4t zrh?XfzcH48j#WD*!n;~(FPLNepPqR)?EhsO7Pv!@yhV-$yAg<|o|K&OOW=VO5 z%AH$UN~V_*3!-T@AgojIT#$ULwRygNagr=z6d?tw~&5Dw5u zEKCATA2x9_Jj@oJeiu9z3c7{tp>V~6K#7!z5=+jRbp3fJbnR?=hq2ywunpjmct{&+ zON;5GcNajihq)OZE>4|z>0**h%EVQmb^=EG2@+orUoSptaRL-4useA{b%Z2CVUYC6 z#Rcc)u&gxhRocJ1#dOkENTmc`Wkp$f;$YY*9Xe^EC+&SYM|5r&+2$&~3 z1n|fBFP1Yd@k)R&^G>LON6ZTnj=rd!Y;{?K=klK?TYpbzzIai??Ko%*xZvf1_zxfS zpL);D6e*oGe@~fwk@lW9{0t8dH+ZnKu`Ca?_#kd`qy*d^PI)Xd+xL~vVgsMgldr#X z&Z|PiuM#I{t%Fd5K+AMr&=~~s_2oQLLJSY(%~q+z-aW{+E&x%EO1Nvj{C8Pq)tY`YU+9h%3_q0 z!O~K1HzYTM=DJX07<8wll=;-te|8yhfloW)nFU(U10G*pXr}-Qbx5({=>O?f?TLdg zW*p6EWOTGGusOH zayWl=$I2Mc8P44oy&7!)c>e_F*ahmK+^Zzd@G$d0qQeqq=BCRUG6&?8%#Npllanym zlsjj@YZzRlau6oR90T2Kmh6CtOpyLJZ0DF4DKUWVmC#@)U}j)&0H>L+pqn7cVUV3Y&{ll2j!^TJnQjxo$wMkV<{dbfsBwbUAA?Tnh?@o(p`IoU zY8`>9fx8p5b3#0K?P}(YS=bV&`ZB7Y6TD^!5~HRDzICuTeZj*3KGhm@qT!w?`lZVP zudHm$`~=E|eMuz>@}QX_34u9o4+XAyT)P3wro29r!8zI(v=Z;%9ccVSGhcoJDv0lJ z>3cJXFmT>jF{z}KU3!NT=VGr*Tk{fT&Cr45(h_+2C&mE2fjcq}mhDQJFCSU+VG}C@ zq|XOw!yvEX!8L{oYPHCNTP-RKh0F{L{^u4OoKQ0Kn42l`^RDWe+5Cd(G4C!+-cu$I znhPd&6cV!)L#WL{Sv!D>0kuY!ht{{CiVQXDXt;e}ue}(w8Z$AcFhjj*_LZ4#h0XIo zh45vNcO^k9yTJ3uM*G+GME2y(Us|)$xOb5sI1GwFJuO&Ce1v~?@@CJunIdhRRg*yF zZyE!rj&#|AFwz?|?~F6gJxoUAwuj){20EL3+J-zk7WT{F-NnaT^B6c7ICBa&9KHWm z5t0gyfa?4f0o&s!dnN?HYw2|p@78eefk+F`8Q!3p6EwTV2k!HOZzKSP$dOuZ1@PUL zpdI)w|feo!M@A$KSO(R96Rb&tUzsuchTTJ9_SWf zOcRtCV5M6+gD~_oTUM01Lku*lxFA^ol)Mzwr-Paqm2d4*6yWy}fm{r(>p{CnP;XF_ z0gXLC+iSfFT^HdM&N_vTHTvQV;1gy%K>qs^UZxZmeQ4Lu39Zw8;cf!040s4Wi5JyP z;MsS$njZ45+V) zm~8~*To8tish+#|9#kE|dg7qg2)-T%VgwbISEU(>LHGYvl?JOYfZEoWvm=D^F!ITY z*jnbGF)r+_a?mbaNFlq@ZR(P2-Sv0dWdxGN7K0Wr%#18*vJ`2Vt_o^zg7a2zua@Wa zsJPwyk?kirpKVwq20GnrrdyyoXb@uU)2+WJl+KWOcW#*^sL#oe@}rkaT7K93!*`=Y z3Y#oN@`UX#sDf5J-w|27^qdLT;U%Ds>Q+!oOHcx&qd_n7Z!iDd^AF$YuCh2N!?nFr z{)G`}pTm^i;v6(r-gyLDRa?Bndh$hZMc@f)iDZN7X)b+jcF<_fvd_+YK{+DX0i+$; z1P5KB5(zqwcm4rp2Fbd`hmN(sdtUHeEE>_o2H6}UlBvKT4<2b*;2l=~*!g?$j_PjR z(q(~no`GwP+ei3IUV_*Ag4`#haY;l9teQbm&T;Qy)-rQ&@dd8?=IJPaR_}{|JB_*E z%51OiABXASx=fp)1a$vTrV+F$0cn}ez9BQ4rOQMWW@cQwdxW(7E>N)7XYo*tUc76y$bP zdC&@WE=V&N-bGP^NBnF}29RrxfMT|5c2VwyV);V=6-)8<1Wzc@; zZ;>5?AgEvXqMboS?MxyQ=ePB-b3kjK_A`hu?37*@e8y=ZxXmGGbyP=$Q&$<3dvUo8 zn&16yOjr`QrG16e!feoS?I0bz4A|D+66-PphEiq*4EKp5+?ONW)dF)Mcx4tY7fPVa zq-Tn}Rb1uvBI=L~mjdOkL=Qh9(CqQ$467P87S)~$nrRC?G9*E^;Bp&ubkFbj0>tK5&uXYwy`?oQW8FH2c1h1gsdv$i+c5@39?R22DDS0iNA!0X{B** z6SyxW{;#PWT0enS(<1Le=ZCg?_#2wNWefJXg3gWw?Ih`+c>uI^<5q9iWR?e@1^*A; z9Rl40uqsgX<*Jh^44|0|9fmSy1_qXAtjtRLS;0B(iwtNE2GmFh0go|&RtE4hR7!Bh z+&U_F9(+*bepYZF8dqpbLvoSdaRty|7ze05TlP@Dq63sCLHPt%Zi0k6Vy2!@%>x=Y zwE7@!^Jn#UP{-LEULH6vR|4&*HqiaU%5T3o{*}+-6_eqm0;o?qhn;1)pbF@2YH-h6 zV56lOsBBA|5dw1TwCnGj^}r|V7C3(cjkNi~%l5E}o3Qaq$cj*5NG-I{4-}|Tr?bB+ zzP92Z~9U)rgM}!@oOQCR$zA$b)O24sH)j0@d-j!WX)O zY2DK)bJA^kafc|racWp7D>IZcGce3&;D(H8-@%va3B?Eg);uY*sN{`h(t8w>AG|}` zSfjSiz3kcJKOCU-@bL`Ta=$oe^ztNh-R#7 zr^7ns&cwMtRYPEBtq3wC!epKt^0jT)Aq)lZ<7yw%nH3e#G@TdsezC38Vdnf4wXDbV`%W4=#6EzgR1)$sZEK39>& z{(BE!2>SMdON`;+);UE>V`T(ynZkpaL-8VLbl}5wN2Jq^mOk^oJL9M6G=m90_!>9P zfyBUb4!489^i(;+t`xCOm|%8EwB+C#kATygE;}rq!=MbBT}&6_%Q)f9ZGM3%OLA_= zfs0@G&dpEx+c0&(wBy`tF8}6%`=cM&r>H!5T^!))wqlML124nF#VgA_EHhro27z|G zgL^Hu?hK5eQ^uJY81hkim3*M_tWA9muY8mvKve)A!^6+kpqgkIGiZF-1gyJl1vtha zV|Ac2tRbUTe_x;4^ug}=)VXH7Q_kms_C-j*XK>6)Wn4NcWiIs}}a= zyM`H{mE&o!Tjd;~`}rh6=O!VqAMN0V#yI?Z&C8G#tqknbtsc}wDF`ue3KXcmUY7|< zbITVk^|StL&jwn1{K9e_cvKdWpg|)&pmh_6nh%zyp0)6p`ys(VG|o&Ae1a)>v)H=@ zOZ_SgW*9OELDzj>2uc^9v##)xvBEmwJnFigy z1iqS`je&zfbJq2D&ILTHKr3zy^_)N=mx>MN%D+++Vd(tt4yu8-gS!T=4OTiCw41_3 zAp_c*ASba3!qmPtu?GzT$Tn*+$S`z*c5OSf-CwccfzqFeJ^)=Wd<^7z$XO1k>xD%?YoOIY zGg_=0(`1%_qJT?Zn-_c^&8J(nKR^e3f$l;<3hT+Ru;v4=jP{%>#83~~fuhREpn1q` z>XOyg-)g{jARFo}Vt|XSvIC1Lwk%`--NDVg$#bsmodY1_f9{Aq9a!e@xbpp%+H3_+upSsiQ)o&Px$tN1`Z zG}J2s#UI#=83ISYDl$kR%mB~p$)ugi{;s&nO@*PFnSo*IlGSX;`mu!&q<03IGXRag zvV-ys=nQMI3WFQ6unZ)?zy<0{Lr=;Bw`9PpdT_O5pfjg=Ag{eugt!Rg7D8=vSnFjz z1EDqv7wFs#=puYB@UEf{0y19?D@uUMm~S7}-vf2t@4%aVd~>-#t-=qB&TQlkmcz^y0VztL)2&jbiR1;POS#U4JN(?UzY}(XZlw~g zFc9@y%wU;_rMZd4b=nLyp!L7v;4&TM++197#t&)TuX{R0W{HQCs~u!-Kfaz6BDOGl zQq*fR;_s7TZ>!O=T_(icxF4o22A{MC zKk{vp@&024?p}6F6SzR*giQQjECmg>=9whgb223Ud24xK$?db5keba3-j9T?|KMUs zyft%uYT?TpGu{|l%OpU8HQSB1_sFKi%ZiMM%#SO z)&U&_tM6K<1a7h5X^)hEZZo>`ft}IgM0uhXqwca2;@T(R)*z&P;xLt^W1qw_SLnJ6 zZkP{N?0T&TT4P9*AE2&Bw5Ix|FS1Z1KhipuCQvyFX{+K{ z#{#)s&(Rk=LfwJ7o&_w&_s#_;M(Iaq0LR-iq%ocU?JWwhHdmX_!5Ed}XW_Lp?JC!+i$)r6=?}Ysi}9hU*&* z)H%Uti3vbLbY0&x*CbE`EKmaZ2(*fZ{1wThuSFIC#fS}8c?&BWe65ERbayi9IGG^Q zL^x`e+V2}Ht=R!SZwR!uVGgJtDu8;j z2p@xC^L`7@34HrO>+WVMGBVgRa6wigfO=XAAU?5cm!v>vkX2e8T4~btCl8b&3qa{4 zdrslbeoj!VK++j#J%tQ>J%!I=6@~`T{!h^D$vfVcPv79SDGa;-7?k?p^$T>I5wN!DrrGlNDJKWw@KQl{FY<#}C7wcW4Nyr2=f+(Xs8>!KofB@D6}#}`v7K9*p6_f_hcHnVAN6oOW?-2lvhd@`*WMzOhPk>fB&s$v>yz>i##f~eC z&o3(}Fg*OP@W4yXxKWi+sIzSGBNfIU;7qj}6ru)O=4gWYu}9=TH!)6}-(@ZKOvOIk_L?c>~aiq zwE2*<1#&5PY$SN#0JM7=)aE%dU17Dtw^dqhpgV{7*{)BW3a_GaL8s3AyL06Dec7w? ze}Y%>s4+A#GcX9W-NU(-M}(nMUbp)QxXQHJk(}r!#LzcM5wy=cTBce|jsddI8@#3` z+T}zBs2X4}iG-x20wqv?NTeU+U&aR-Guc3=5f?%9hRTEb&ye;1#H{ZT0Ih%&iU!?& z`SJp29%F?xD4t#B^%ZFKD(#O3$1`Y67--Q?GH7*EA~aN|fmY8S1~m<=ZyXQ>FJJpQ z19YAsYI*ZTf#IP%&hm!WN7&dHBMzTJ$9S5gKxqWC#JPLG#84637VC37$_iblgKHg+ zAgtzKhlMvQXcYo@?IWa(hp9ppl$u)v+U9^u21tnpDH$-=4M6V?0k8D|RdV$)-*@XU zG&3_Wct>;Tn^@$w%$c-4-DSmP2WIdZULo*`R?rgBL-8LNjz^<4Tn4`#|m1X zXQ%->QHjUnM(8&G3E-0)ZIyXg88`)8u7!i*K^c-(L3McuQfR|UD$qV7sLMIRZ@!iU zoxFm&lMqyD!>~MPCARhFn{WPjyR`Ixi`@q1`oc*G$74V#Tt*VS8UtG^Rs`DS@&n~G zsPZ}Bb6|y_>%HgeCp^_sKOKy3Az4=O@`Opy0&`K*qKqxrqy!LOr+7RtB}BKgAfpeBn`6i;*` zdo%bXwHARk&|DtsSUh--56fXiYaAGv^A4(p-i z#2u)s!J8`>SQ(TVTA3Lb9zK5GXUo9B@bLDTz*jrwR)SY~p(bWf4nQi2_(1+yz-+?h zne$NJPbfqT#0TFtug%%OT;HpI5p)N!fPxSMsF#V9?a%n{gBpJ18{ z>UtY?U-Sai!E7D7p_SLl51T;eA>4;Fye>2FFmNKZxWKnuweIj~ovsVIM+~i{--*)F z2k}r_`k~Lb$fnTp z!V=s0}hS( zU3~rK`vgaxc^Gy|i@u-Y^ps(8p1C@xUPYaS0^Ojbx9sy~@M!|d9H8D$W@Ft7ae43> zO7IHPlfB8urW$r%oNjel^xT6Lvf42lfx%nS_gZ%hWwN+=(5^C-VdqZ}-rt=?2SkCtF4Da17K)5C!WOmg6ad9qO_5;C4erkd4fzWbKo0 zfpl|peHI4YCpeocxo85P!OOB@4snLg%f-Ci4?RI^gF@|{Mi1zy@HYbR8Ik34e&fzvYLU9L6f0_ znE~0A<>4X_wN-o|wGBn=4JwhpcH4qd0r;dHUXYt6t?s%g?rG#$5ed4L>Hn9Q-r1*? zvL86Ol+R+m7-+7EoiTjVyIJ7%M}9%e=l*=)+z0BY!_4jjxlLli&(hQo(21U%|F3U3 zn0nU~QaEk7l9~QbnU$gQe@Ed&22qeN9JiuN!(!neKSSsLhN9!=XKcH2^AK;-qZ+V_ zGFApNRj})pdNI6z|4l&{9QO*V750JWbj)_qr#gnYwo?({OsbWTxAJgzO-p zlm)7(aJ5#UD?a(algS%wUGz(r34-n%!4_8X47}hqj<+58LDSJPkT3OJS2kp51pa@!f z1G)rui}8QZZ2LobX4s|EE$q$QkDv=nR({yT1HZ@AX?IEs4?`z&12Yq((=Vq!xD5>JQ7kvDglq%Ms9WFx^75T$?7HHRb{zC>MGlDmKb&v+RHn)cmrR8NZyQ0k^hBv-xs(G?Un^pQy%Yiz-5$sl`v!kYF!c$i*tlJi-B z0%QyyG@}25TaIbMjm@C@2tfTi_&CDu58^g1parK_L1#WbgzR92+^uUdCF!Al1qUB! z^(ng$cvU`VCymfT5$^hf&UdzhcHux))@UCDjbw-%I=v0tJ_of<^b8bMu&-MlX#Rvt zUmH{#%|E~_+wAblXR!ikusMo%X~Yk1xkcceS&(*}2m?CbqMSl3_YOp|C`$7lR_YCy%LQdZEb}O6U*>3B;I4}*$NslZWsI4)DB+T z3Yjwr-~)~Jc28z``2l=5iX?0VTN;$oj`==?WB`ySKdiqux8piUKWI-;1n)lri?Q+_T-dt*!9xMa>XQ^$JV>NWwCH_gzwWo} zI}axFAn=q0G_|{f=2>|>NL(dc32+(IL-%M0 z+jrEnNsB=a(z~=s_xmI`!S#_z*Z&>w%6BMp-thpf12%=8oI-f-DyYAN*tr8O>;2d> zL?+z;S-Aq#C&1TVLgWv~31vKxQH|3-*4(qyQx;@Mv~gI{ths10Xxxb5h}BF`%QBJY z1dqTu(4m%~d(J`DFl_W&#^+dahGF4iMmC0r$=!!{s)I)pPjE0iOx9%RWoBULZr1&m z#}Apm)dAOh+2Z0|wsGf>6>hZRp|x z6tE=b%RYbT?M;H9<62jI*aVur_Yhy{{!$3EV(=mS-qlA2dGVn3tONsSKOu+k?!ZLl zWAnFI^xTFmGluLWg6<89Q_tbwbrd|ufBB0JLmx8(L(r1rnyX?Iz~#m&CuAO8D+m^EF(`rF8_NZ%KRo(_Ln4nafTWo|(Arvo5b2n8n+&?9bo-qUj8$66 zTi|mNI)5bt4N35Ax>_rdYs+L20A=VKXQ8_Q%>%SCSPf7$QV% zYBboE879esOeQWZ!p=KJj(5-)EONYWdhvehSMZ9ecm~iuLL->ZMB>aqEn7&OFceB4 z)^kAPNx}piimyPS2)Y#+G!+55ojxWt_k!xATPqkDhq3Rm)?BX<)a$7bsKv70%zKuLjDi2Z;+G$c;I&kh`(% zKqIYu(DCeB5pO?!WQB}ngKpZI@n*;56!DfIWh0Upt8()3MFz%NdvrkU1>p*Vn=)#<6a+6O7OVsrFcCDT z3_5o>GVj6aTc=y5uN7o?$Q)8#Q**GH4-$y{3ZS_#h?v&v1-(~w7$z_?Fv!WrZ#V@i z$yx;3YUr4kL8%pn6(Dm4=N5mk<(vk&;kbNz#*NTF~|Hgw-2zajx$JF#Wd4~hT!FQ|A2j`3jk8X&^ zxvMgOR_qjfv6kx7-@~`d@1keq969xp-j`E%{j*qjP)QkdvmQ+Lr~$8Vnr&0e(n2U)pErOR9Ar98rk%&kJmkx9dzed{Z%EKg?6#QWoO|}*3k}d&E&DYSyI;=` z+Gb%biICgtA^|Et{@0K6xvQ>(TRwA zEtK%c^2#+C&{_3T42hqkrZadS-vhd$I^{sq)2(`pYV(|P&w@?9Bl2vk9;2J^h6J!j zp(dXImFuw9*u`=lEzsPXFvG?Kg^5KO)3r`dZsA`g-uBu>KovB)<1kHn2Qzc0qoY9N zeekR)D`*GmH&Cvx1l>dHJt5S4=6g;r&gd_J3PKEtIg$*Mm>C!f3l20bZP7i~q%(8R zeupG}5m5Q_!(mNMhc4e8;VDAfEVwtNaB(sGvu|XNk@x?%$OtS4oLfBQL^JEu7B4vCznV)Lc?g*oFI;h6Tb8$EyfGGzZc^jaWD1hjh7 zo-Ji(qqV^V2@#fwUu!`#TaZ(geBOh~Fdh%h#O}=s-g!?NZu~J_W8GF-zg-;>np_P3 z)IT(IC&yRFnksvNlVYDMlT{sEhtRec%6FHZ5^7hmS!};7B)Mv-o@QdV9T(`9Y4s0qvl;FzJtf4xhU@de z`=Y9#Fi`){An=ZReRI%-SCY-&TCXcE0EdAJ!$0#xcoetS@h`Y)%*MIy@Ut6BK&-di z>zzFU75Etb9dFPvFJNaAY6dMI2cm!LRMc{sN#E;6}l={h-v$)Npz zUcm~IC~A@2*$P_k33I1W)0^6&6Z<|`v2cNGQ$=&9yyG`J%OwS}X2;c(Pux>)e*hkkm<*>xsoV5EV-_u-Yh$qR0JE132Gc z3q>}Df9#;+!&n&pxpyR>p8?$BWP2QX2CyUa3}BV%OD}Kh;&^-MUR8dd!Mh6z>hLpw zo31nahP;;E%f2;K!Npk@{Xk#_%oBn6=yoEoBEuAB1_sP?foXdpFejw0_uCzE6VyUn z$PH~-&M8~DNf9KH2nxL#P><30z=xIxi~`MVN^iI7i`vv2>rmABpnb!sw~6nAz}99J zkm`f{42V7OtPV^sK&RHoGtl-dU&t5~==|TZl}fv=sU85Yh{asNz>9o#?@CauR}a2l z+lY;&bz+Ub_QVX8CeSzt%3W7pyF(g9@0%XiNE7^G*}IhMilf{)No=QcgH|tsFKKY@ z;nM$Hn8Pl*P%M6mRzV<-Px28hc~HM=(u{RnEq6?oIi$vGRs2|xB(2P*+Uxv*p#jwD zRb-gT%m8XP3bHtcYGphD zLRZVydN;gW|6vnoPt2dYiau}LT6-nxFM);M>V>+1%Fqaxf1=>=m=n66^4;Q-ZbX6& zGe``Y&^moDg92!U`Gg}Sp`fm{=}Vu7_P=HBrD^iceX7FvR!J}kbQ>S$*+!5(hddZ( z!^(qu(ZAi5UVB)Ib^b2t`MhLqXsZYZ=&)Bu-F@KmlH(bqAS?1)LDxtGYP3xMxuflz ztL{DxQNDtDS>*6~_L*Owr3rGlttj6G(0P;Mp!G(e-Az3k@?~y29(B+>#d2Bxq3s6H z*pqm|W409`@8v+&f0SeZZ{Gtn1P)?Zfb4S4I*Zqf)EaQ-(Bw9?doqk)%6!&FR?Z=%73 zAAQpoMKEr^sMC$Baa8={2&*cN3wu3f zqT7-`ip}Mq-T>NaWzZeQP#>5T&V0b7|M^&@{F}dPCe2v%S&=~%G@dw*wXT6>ElU_* zM{j7n@3obD5eDa(>>X;u=ILE*hTMb#-d$QXg=v-uc-zV}(5ky~otG23t+=k8ocfk= zOF(CgX6%e-6ZEG}lXYX-5~aw>@bACiV4&Gr=^!X zemwSzT)!nEEki#(N|8YY#l-0{0@WwM=jbX*%-0Cl*PUsf_0hE)bOIbM^Y%D-ct88> z0UmMVki=!LsuBa}q=1m$CPM#q1iKX$rEWODzo6CY$*F{idOpP`K(Wyx&}ITTiFkWT z<0tXO>@1*}{L07Au3h5bft(2~0Wts1#tSd!C0L0qobFXMJK9^>fc+t4oJIz;H^Wyt zMrxV%+492UPRpy68KyHcFf_f4Xix0IgK7*x4)?As{ zb)w*el~|!xngVENwcAma#mQoecPB3_KFPR|^-HUA<-=4(@Sfn-9aCqSsT^(zXju2C zuhnVFk}gRxP+qa&TCeP*X{cSgOvy-QQ=jXcE=ex%-nu7Fcf2YhdBM3i(MiK0d}iEJ z=p5-JOuJ02f>kGp$C;tnCEylbc-%?RE9fW>WF`?j`vh}|fLr)WQ1J&T%T~-tC<#Fd zM)lA$P}^34`Z};Z_#kB^CVn55yMwL4r8p#I zKxdl;yOa5$w{V^Qq4QMr(|QHa$pSncP0lU!V%$Z~7m-n)IsMeaZOeod!F`sSWlNp}bM=A34z%JGG}6EB6*p)W zmANBEkzJl)Cg}XfCtN>wuL7;~0j+KY-8Y_y5qg;Q7dTID@eY0AwsoWP`di#r&y{!x z|8SAxU`SL_k62Q|<0TK;x4`Mpc75Z6xmuaY?QvVhSIvDnLG6Q;Sl~oqok&NwjjNE?5mG-5d{k7Xx9F!MIbf(mA=K2@#Ax-p8q(jacId1TL80an{g~QCpJuV;{ zcuuzRtO6(`Am^~Ng3kRe2@tShXj)O5(_AjY3SD^(DFq=XBtlvd+zf#>7oNKuxw7kG zi!Fm3XpBxsKW^1Bv$7YV)eCRU9ReRAqDIJ)?RcA6y zTy#|W|0>8bYt7bcQHLCoCNOY;#)qIA2tnf%pc|^7{d!KD899qI6#pnDDj0Hr%43EJ z4;zzJUieMjf`|f8X$>1$0riwb83GQ0&qKee^e%Xgb=gL*GI61QObq-C0bE)PvzQqe zF5F#Qz`TmF_Mu1F`HkSx12lpJ8b3jtkPba{#xL4r&lQO@$cQi>tlhpXqhh7u83oX2 zxFl>$_?C!7MWmL9f!7Sh)m&MEyJvv);ApE0lQ2_5%vuPznw1GFW`j>?hl;q`T}^xO zp9?fcjDL<(LD#qDjC+`>$PH>+^#?gjRsyYQN8DBiO6N|i70o;YIA^)WWd#-}f%E)t zhhqn327zv~?t`U#aQmYJd~25iw51+&Py6641%}zo3=By()^)^4D}dHMBs=6y)RtLX zy>d$HbX^(HEdgxPlXhtd6kVQS6xqXM((Q3gK-$%=hv|eeC^v*uvj>Jw^%J_FC#1;s z-UPG*OP*!o*HFlO?H6cy`~^B+!O4)A#&f%Ph9RuJyalQ+K_>)4+Lc$CJgV;5+IMU3 z(E;@;pdrW6G5x{SpKC6^1SQ^=snBraU`S*zY)!Vf-~e73am@E=QTNK;i+3-I$}l`+ zk*g3nHs#Xs4O7`C&ATpc`1iPl|Eo{I|>Dr7#^k{1G|ge@(koQ>Pe1CzfPYN6kvS1 znMXX*;$0mp!$S^5o~e+~vu%flo**dnqCuBWPdMC@2%1Rwi%EpQdSk#vJ=z3X?SqFe=DP#LRR)GEa=hnayP`HSPpL#G!pD1rK8 z@S9uKo;=ND(yj1L($(Q{*)dP1Tdqn+9>~H{ln|t4%sKmpp@V10?{%fE(^dIFE6MpB zvy!cT8|JiLU!)10G312IsQ;M9q6pr7e&ka!*d-iuJDz>WG39E0R%NhpBHygdk6YG# z*MyYPNuc#qkh^GFr>iPraajbH=( z0qy)>gO8kEAouv^CJk@4?={mEtmHTuz&DdW2)tn}#&(!@!W>u6YnBQrtl+iuLbi@m zQsy!{g)tg}W^WL;J3>kYS-UI#f(H9UwjHzv?aBi8yC6Ae3R0XrIv~{M@IFIyn(iKn z&~T6&SZ1-Rbg{ix0G*O!`P6H-#Usu=;Z5r{GA~s;uyL7CxCq0)J4en)Y&(>Fv2d6A z4{)4hE(G0Ff22xlqPF@;D0>ZvA3+LS}CJyQK|$Qo4j+x;3d~C zw_gsVMFFYS1}UM_-(U^vJ4JZ-7cj0Z{u>obQhCABkz8 zdoq;^q(JR0Muo%g8{=-y)vDz=-Omuw!^qaT=fA2FDAr4k6wG9%=u+{Ltw(1~!I& z|2G~rTp`8q@Bhc`&lx5>EY+!4?j?WtlQP^GG0;58`JRUscZL5*EZci!jbHEejUCBO ztPKC`oj9C9W3%>bDRnQWR4{|jB9LJC_kX6L&fHV7X-IBP?N5~Efyg|V`pzKvMjOcP zkL93M2M}{WZEFee*|~_hQ$bK&3Ax<~ROW$CuLq^t3I&h1dS{j~fX`2PkQ`wZItvsO z-pen23EF(&?aHO!H5nkg_^wa=zKL&+K-ffYsghGGnb~#jq^s>({ZE(5;m+q&TJ_*nhY>JV($f#o)ssvkLIsiNr5Zjg35-gtE5dREidy;vo&xeg&P!C+OhSx@XVTUbh0!4qHA@iQ&!R zcF@ZbbUQ7d9C!plCE4LZf8xu+S87kescXkPF_Tj^hBerezSV zX@PrA9~e9gyFa`VG2lA1NG0qfNC%GgG_hmfS_})A85nTgW(Qd{EZ-EkL64Vd-RJTW zEpG4%XhxQp=kH&HfcvrdThU_Rc74AF>lT)E(TAiwb;LzZTsJO3%@TAE&}f#h$D~Fd$#O;Qn>3_ z-w%oRpx$~tbmezr-^2w!&;0p$6YO&-aGJZ@Q*l?~oJFV~LtFxA8ldS>$jVRPT1JjR z&;in}4Q)B|=cjIe(v}M5a*Z4wbXpN?3_s|OYX9NpgDjBcW8n58 zXzce{G~dSAaVxpaHd-(qROJlp5zBw@6?`X{45-Y#hPbir?E)nZIfj)7Tn!C+1y{?1 z+Fjtb)01U}tXjVpZ2(O|h=qAcwLf5Fkldrpzzgo5+pRD3YS_5+1slkhEdp(J;C0WC zdkXzdUWe`wln0Fjg7*BLunOvPePk!w`+13M6T8DMk6NFn2{nuCz+q!;o~QwQFrbgIR?-s8u6e0jjUl zTNc7vl#r5hAJ{#d42fTwg$m!4yitU_zad(+7bPyvI9glfXw$RSWL?w&_i5fXDlH(V%fVS%yWR{h!GWpPZ~FgRhS7 zYAGoI9i+Yuv^F-`;nXJM=|;=^zHa|>YQ=|5pwNj2R}hzK+(D-exELv#_pbc;2Yj8L zfJq6bBdeaa(?2`yfbKb*Al37sJE_k=cRuQZ+O?pakAe)GkZ_zZfzKgnnk;A(kBfn` z&i&Lz4cX0aazN@@47Pw;)yWRq*i|3hU|!5W;qgJpwL+-9kH`6yt<(R4ZVi&3(viHp zd7pJOsHOVZI;hX}<&DkI^wb9_m%%5}@iJKM>6)a$x`WwCbAjhdaIOK3kAf#A94jJ4 z8KCE9?U|LMb)hwY>x9#Jjz(i}>*0g1gh$PF5BUs_mbC>A&T&yY8pQ%mYci;SPUmz) zIu&&%6ZB*(NkL8pMcHni<#lt7BtWXRPU5ndb?@NM$!p{{2wnM9aj@aUePi&+B8;k> zKW6P=Suv?6pwc~Np^C$oqXuW?dYZn*dI_yrVT#yuyp2JW;bAtU)qfl2#_h|e`GIEZ z?|jHVV&V%ZwQsPbgD!PEw^ zIl)Sx)fIO>oY#@LFk!k_-U8MuQqVBeL2CPg?tFPDTydeuYhRxKP4M|spgp=S3~z!J zAT25JBg|K}9DKSGd@APl3D5&^c)+WW-+Ne!sZO}Dm;>Br-1cL)EeFHH#rfK$cQ&dE zGdyH2=q&jmt9g9UA`MWSniqoC*)ImMmnUBU`5kh4!^gI}e#G_Ut^TNOE({vKIl`>%)@}X) z(#V#oKMiVS$$;*$gq2-OYpWPoM57-v+*D~ke&=WyHy1;vFr+ucy9B}ZS_Wdn$`Eew zi5{RM0lrPq1?{4Pw*Nsph4(QCgU+4&)3oEPQ>Edq+G(F22{nOpS?A}qR|?r{qgQ?g z-=2YWXLYA=1;av-3qm{cII~rP|9sQk0kTVC!p~{OR-j%cKf}ZS>K`2DI~Q$l*yy6k zpa^P@{_iLh1m*1i>K_g)-r%CjumrUKZ-H)NZ_26dpu5W+g7!8plxOG!jRZXmP;@(b zUv{^l-}Y$T;;ayPgA3O86)PBiD1vq|CObTf<}=jV^9Hmd)f`-zm-}2|m%4OGjfdgk z|K-o6#16*`O7bx)F+BY5|A3Jt#=dsKe1qZ~FOZ^1%T#I?DC+*U60>qBoXRc9(7AsZ zuikpwAGf{cLK2KXxlT#LBQ0gn9zc7xlzmSH7B2!N5XbvruXgOeT@2bYC$H#o{vl*1 z#1YUbmk>9tTE?sA@B0{Zs(I_5d4iow%(TGw6M>I4uZV=4K=MZtr0hI+fi@S=$QE>e9%zi*0yH|o#NV>|O=tG_FcUwUu@LB7D7CW1hunJXGX)N_Y?IgqZhtE> zSSCe0P-Ixj%)oFkp}gUS#P*$LX*||XnPmMRyCt&TUl7=zEM0QCtVoBEN*?oRk7du5m&S;lwo@}d79oJ0(~r1pUBCN6wz z#kPbU)TCsad&}D9Y7F#p;>C+WZFC+`dx9U-#$DNtmf)&tmyhW zjmgckxg5G51H6_1uIlgE;8M`=!{Msa5*ERbAwx(l9t0}EpeHFRG6;ZM|4ZC87kCzS z)Sfg#3sfgT_w-4CM=bdn1RbVHSNy-E`H}4&=z2cT>D}Pq zdebNQaTnXF9I;g3h&*1l`PIoP1+mvfG|K9%E3>6|OKaWjfaTFk;E=vv$A5Kq(cJB27Sj zL`dyv{OBvFY%>M<^bmN@=)OjfYar~nlb|sa=xPNihGonQ424b-mq0glt1`Se-)Of$ zEPl!%C*6G-Q|qTN#4fR0R%BooxXyvYTYP2z%9x+dir_Uj@Eum^Y5kyiC|OXA$#eUt z;L()e#&w9AT44o}`|g3ng`!gxcWAt-s`Ljg|a&i7I;nRz=mFy$@wX0qIRDM9Cn zgFOSJUj-hy1fL3VXy36)`GYLeHfTtfOk_Bw{z?&aA20YMGLZb+%~*6B}^ z-tk4tYmvwTLD0^OMDVUM#M$7Apc_}C{B~Z_>#G1A3GT}i{W2sIJRY|+IFk!}Q}>6j zS9HGg2t*umcx26TY?CPbh;K{K8iap$KG3LLp~kQrH2)86U4U~4biW{?rC|n2b&%TD zKJ;-A`<(mVb-6%(x?Xf@YFXit?KeXfp!*4YithU5X$x-$dwWZG)U?}(dtE+s2vj21 z`!ir~ixATaf$ofy0lT!#0-9bxJI`(!A>Y@Eo;rCL5{)03YU}M@>>HD|2WgB5w7da4 zMudE8r5YqZc5p#&vQ)d9#|N?T4kVp`%V7})K?f_F&|Vg~g2Lt2Grewo3JJDT1?{xp zXV{p)R|#spK-w@`;Qk_Fj0#k~o%jw*F%pmy?6a7>nOc6|VBetf;I{#IxD`^eamZrG z_xDXnp4fK})NJ$z)#{-9UxDH>$jtG#1uinx2_|3LtB&(y(3J^B$(8zewA4rHGulC6Ss&p>)0pxX{X;oAcC3wUP+_=?Lf z$q`j^K!^VoO1QJq(FE^G)au>-FfVA+7Yk*p>rJIcW|%c$d*`j21bvJ7CqH}mF5 zcTHmT5|Qm~p7g-shfYZ*3)?Baf6#Vz6WBIzzxr6if=R4iE++$fo?Y0nvqSRMX>r90 z28PFqpmTf+Ah!Y5@p$(KFMe`Clkf411-T2ol?_A;y3VPC&Idwvi)h@l$5EG=w1Or( zUa>!TeLiS~&Pq`K4-^|P7rC5VTo@oE!!iG;k#qG=rBi%rpm9;8G47H8uwNn)1I>OP zs05wx7V_Ic>@?5Yr`-ZJ3<}NVpgq&5vD%6^Rv|q~Edil_J0=V6PN@)cP5JPLZ;AK* zDH3~>xj`$h-61IiRM$OJKIX~;+Ql;e05eK_@hBi>E3uiBeccukqf9nAoGbbekLN+;cax9WKn>Z(&BlBcUl^vwCO8=C>?sQ>>%1mRcG{dMp zjhE-haMs^B*%A9o=3bcbbpP|p;1ygYM>e!1h^(0m+Q6dQw)FT)-L}^2i!xiM$4a5K zVvxeH6LhXz$Zv;NOI1I&gNHBA<_szFi2^0JML4DUg=EQ0oASI8!Mbw;i<7M=KT zLaEN9kTamze3EbiM3t|h7JAv1Wfl}2m*BPLYoez@(FO~(xf;_X4mYRetXjHxJrPt@!I~y-} ziW-AX`A`O(Yz6X%6zJ?9(>$%|frbZPyvUgI!1p$27u~h!Q~wnpa|`{4&|T|>!|dXf zNo>$MQVnD_7sJEm1qT!|#oa}WKztR@Y?Ood+*8~k(xA1ZnhdL%85kfdN~b=u{(Cch zKXXOn%c$uL!k|`Si$I$fI5xq%#lf+;x*XKp69$D5r1G=)b@x+<_2V4yzQy;TaTlcB z@DJrd%`LuP+k%e&y(>J;u%E zQm6GU;swLeP&Lq*LlTe^SKf#*bk0A}yo`5mpH*nq_Ni8vp*=@725_I17u4TK_V%VyMO72m{D|&?+eChFZ}0lsxmLhbyyMrmOOSZmE3mqWpC5 z+bYpB%Ry%V$b(Mz*%uxtw3MM2+$#s2&1vz=cG9gCpq=)HdPbmD(0>*=uvmk{a|d~s z=BggOAo*ZRiTNu)qqPs^L3b$#Fg%=pe`1l2S38)j->wdE5$JALP~8IBSzG7?S)~SA z4FMj70=26jYQ^34Gk{tmU_J4Bt5Y~_z|$<6)}WRM zCv?r=4>rhb2#jB$3fUhg#jpmn|Bpe?p^k^!Mk3}+Ph`)#cu?)=uEA=exv%OwXyd#L zL*g%o2LghMi;s)niD^z;m3fM555uVf7d8*x3 zTDk4O1d$h@R_}}T4T1W)E)T*JG(&Q-UUPgjT5;Ur14Do>TGJ5}Vm4jMr`}cJ>v^p=BC2A&!oOm$r zy#jdr3~9F2OcT@><6dtG6~LE=g-Wa4^D@RL90jwK=BJ{KXzXPO*kw<^z|=k{F9g*yf#zv!!xdf z%mzcp?bC?|2)cF|x-MM17L=rSM;M#G} z8oWM=LmE65nV8f#y=Tf9qoor|Sjta6F6ov1Xn4;N)bo2NT(KZoC4<|33M5vNkkSyY znLf~*CUp1Zx!tZJca_@OJIcJ?34>R|A?EwayR|^`eWK9$z7u=+zpYkTrl4~!Pq2VR z6_j@lf?DL*=00KfyxCn8IJ+IXwhcB1hB!k4KH~+S1LI@3*rCL*j+ues`|9~J-6dy1 zL$aZuIW2APJh2Oz7J%;g`t$m*@44sC1m^@R~m<&wRH7cz%+L zVP~P&!lDMqNuc`~#1Zp*_e`E@xOJNsSRQH;U#tw;v3956j>jzt55A7Icak=K*o4T3 zd-%U)EIqbLQX#AU*#*npt_K8}4l*A&@<0}}W?61eK}=|ABp*1hr|fJzEhxtFFcoxL z4Pu8)kjifb`8A;q9a(~g$_fmLO(%L*$Vdp3?CO|tbZYHE_Me##&WLT+aQp0fgk^EE zqAXNJ(}|vp*H_Y#jx(qRKIQG(UK8_^?Rd02!+K^023F7tZiEe&78I-uV^qA=DGA#D z05%_@dmaPJTs@_9*28WyTM)C zH0&%x;BVvhb2oLF`UE)S7}VI_D{wMA{QRKx@v2p)A3@ul$fYqKgH~xcLua1g;luo( zRV{etCKW;D!=GK7kme>q9UUnv@vT1=ZTVoo=fgkHtRJYYhQuyVWz^btZ-$)eP@ zK7Mtq>(!4wv*e(K|1D6a3cR4h2W}UnZkqw>;g^Btm{(t7|M_l$wDmEum!RF!4_8mp zUB~>LWqR#|^@`ARxDMRf6=X=kv?XVOH$}QUt zxmp`a7ZlCgq8-3)(hX``<%3T0N8I0|4l2D>U}K~UBPaW^?gC%t7-C&KadYm4-rRuc z;8CCNDxf`Gs3WBnnq8s=(y>A(R!(J0R%HJLYK!~_-DAhZ&taRCbvNUX9;7A$uZ055 zV>Vf;e&;-NS_yq_8qR;KxyX;1mqC?bBQpcYB;DmATI>?{U!M1bm?Q+Mx3KR60-csW zHJ7G<*uQphri0866hI>xC;sdzn%!D7 zH%s2FeZsjbD{FT)=7ZKP1gU~X3sW2(=U0j>zMUnLwEWGPq>|q;H#M!3Tc?MD?!iuW z05?ANZ(8oP{1#Y6Pu49^R&Wa6cvT5BKAG%rENjlixtoknHH-IUtCxXK$Ni7W(aWunf$ zDS-3IvuNdsLRYRl`%%_!PKg zm=A-Jq%@sGPgVbhPo= zW<$41;nbVE!8e0FSXT<#vFpcttYJ!Ox)YD$+`x)R&`32XLj-t)D@ZZ?yYt~ZWHV5G z3oD=W{SMaGpshhZ^=#m<0Hqbs8km*<4<&}p%nS@mdGP6x0=0_!#5DL!=Jy(&ntg)% zW$X@R)%igM*R4Q#24d2So*sN=K*I7JI7Lb^1aQ67Gv+p5;04;ocH*6r`szQeOVz49 zZz%{f1aPh7fyps=mx(heeP$462;iE_2@<{4y0T2%D)Onmj_FPBOKPw-ll|*$kX!at zW&{__SJiC>_e%Y4wSJ#G;m z-~tqSi%%eUuO7$QN#M0$pcB3zC(OLGNL!O=!v1liu!Nnlfh^K_GF7#cmncT5`z_DP z5=}7VD)^TTS%salIBumkc(f+q?HSi|-gv?}4?*;b%u?w}n+ig63+O_|;}>cyZJ>=(L^fH0N~%wTS-QWklauw)4co z)>(>>l$Elx5wrkWiwBgNAiAFfYe|9fC=Pv)9=Hrh1tJ$aDp@_WbAja_1<$lU{qPgKyz6oQh69O@r8g#kc`wha?6W)J&z!z(2B?-Obb_qjm0}3A zfnHF@t-`RCnSmioW=cu<mpI4+wA5mF(BKBZWjlGWv;W3u+x$SpcDhy-Zs%6 z`mnxk?^ z*7HFaXqE3m*x73`EHT?ZI3te~cmzzkF`0|||6y)N-F+I66W2HxUYz%~TbeLgQJ&$& zE09rB9Fl%F$)s8)MjCpXB>Q)52r}W2W6=Ds%CHS|{~v=q!;4jWnb{e`dCp5Iw1 zdi{RTqqKVW2A+KzA`};_RA!I_t4KHZb`ADZkydV--pO{5nPJflzK-b(G7K+P@y8h2 zWKUHHUE!gOpxUZ$-_~#^9laka z6r2$1sGB4%EXMHS)HY?#7)H*wmzfnZUI;a92uSIPNM~ZmI7s~I9>k1#z|w`yUj@gS_Z44c9%!-`gRnU#oUl)zf<}Ed43FG%)-@m6Yin z(A|kFiXd4Yus-DV&=3**NR`;dsS~yM!7gRg?Vj>$O3ChK_l(xd|mizoIoktl%85-EYqbJbas;cw1Og&NJY#^on#b4ms zN;W>w*ngo@-@&ln#m&>!-g9n0B=Be|NP-WPClnb39jYGe>gb(wF|hK(p~AOEa_`(> z$ckH&9WB^1@uVBEN|Slsd2N(BZ%&@Pr8 zP$LWu-HNNY$soYM$ShJk1ggZh750l3L#Iaqho4iVTdPDFf)DZ_ptb4L5w( zUtygcArrvLkP!+xrIU-{Ay~cV_SwNK42+5`ir`XI3FKQ&hK*frJHb}~FmN#3^vDFa z<~bP*1z++R?7KW4)UUK>U}c#2zRwYqPUnM9l9?uLp?)zrp|Z0Cteim_#pl-!o!(QJ z!_KtMgJ<#rSJ1uUa335yS0lx+gPDPWGb{FCYOVmoLxl%bQohIQ{`K+3EM#yvAdKvv zt7#IE;FS`B=;}^BU=T%C8TuqPZ6C{4zPViBP-aO44?6YE{V8Ef zhN#erNYFeMs;vw5Co_j@Fi07RpqjanSGn7Hc@SvT@rU^a;3zOVeBu#i2uotP@0Yb% zK`YY&MP>#ehJXDM*9{dCg{|2%IZ(8_MAok)Rz_;6ayg@CNoX2g=VH z&bhlyQlGOqSO}CB|JzG;JXA`4;G>x^#iT-AlHnmcV z3=#~C%$x2UFoy(?r^*d&{fY0ucbLc_(*CwZfeGtB80F6~4Cn81+u8d6Ve5BwF;Ghf zJ}MGs!nNiw^NCieE;-Qn+&hM%#I_qd+)HMB0v({z_rl<0(8ZE-MiURHf=(@Y-*>Vv zX~v7DQ?5J~;?I+m0#^&ls$CET^|GOBUl{~1CT;-Td8Hu0018{Tp6(mMAbEqEGHSaL z${BWUD0{g6qpC7!1PavSyaBq4sR8LOBCsxw#1rr_5M#)lL;T=V>I4e@cN9!wI61{% z5j0l=UfcP#$ACc&B^AbX6}3+PX_35c-;ym5Uvn}%%+P$x@YwpVC20S�se4QfZ% zznR!NT~&tR;c|W!K0!gFs+xmmRU??L9~a*f35xqOd|f`Ec^>$@*dXAvgu%Jd^NkBk<;{(P7O&!zXpK}gcgI1#2b11z&&C2l5y{G#H1L*G3e{dfk zK%e$f;{vS}m@4__sAp3HNDoIM2gs%B9~L~FqQY%}q%s$h?lvLTrfmbw zrNJ@{c+emZ{(QLnz!f#S%LJQ zlZTAqOLl?6M$`%Rnvlss~k42M?WAVr5{gFXyRZkO7rCbKNc-b0~7iiSV2= z3%0=ah@54K7HD122czC4y^XRAyO|jno;2Ku*wJDqzL=GbD=K=zOGctCdb z7=kNDkViHaaQ;1Xx{VinSK$W%8MXG^(SlNt@b!R;g4Us~P-1|D>j%(@Q=n6CUNg8o zY@3Nx{!BX1dx+_WCFmqd$Zgk0@5|P?3+?z+UR?k!{XxMzK}JA2OlW!9!&F7oyvs`f>wG!vWW{Q zc!a)dLe{Z8yFL|ute7e%Y%fdmG*Bv3KIXasqzb(D#Ikr&e}j(DazPa_P~K#-1K%|L zy9{)BLLm6QVSdoQ0MLr^Q=mz?rO5$cGeBz?AYpn0$xWb4rwBU908|F-P}V7c-Pd}b z4|F;{7x#nbpmi&dmGN5t-hBXNf&I5HgG`cV*aN=*GYT|X4H@COU(^w(AOk8{9|S_q z*-wsmaPYyteD-pcM(I}855=Hc-Ox=-2AL*c>yA=(qK0lXxD6Ev87Z~_-Pi257;;JK z``ZU)Js-FwGX9YPjTD2@O0$m8a@ggqZy)rj6fEArP{)TYrM!Wr6thT`>zd0mLawd! zmTZ}>%FU3dd(2TxQ+A6^&{9y&2Irh5x6cNG=abb^CxGrFcmN6vUeH>l6GhC|dzy77 zDeTb!ol6G_OAGi70Faxv_sQOw$dV@_cHlfCWE>4VW(yvfhFp;hx=HQ_w_MXJ1 zgKxR8`ZG^3@o1_VXqOB04hG2Ru?Q^oal{umZrTDsw0u{bhMAAHKeluE;0((qzhch4HoO^C@3W}3|(HgPjN zl-KQ^0&RT@FevgWd|+UDC*Qe7ne$G@d?iTuvp`Ea7SKtG&?aN}w-C|A%AnomSJ>Be z-#DQdW~T4;2VDE&4Vw7N{*P|pdpKjty0 zs{mT91X_m#ajgo21Z3p>W#el#hJDNo44ExDZr}Ag;Fd#kzXj;lRLD)4-;welX#W;u zrsB_CL+JXHD3pB9!oX;#*92OXeb*4QDjU6*gQ!VCeOUO3j1aHSG+(!{7_yWX@ zOQ0GPzB(Ly1fdy&0@C`X63{wlF};IAJM8v7IGY68jZqdL0-j6EQ!oRS|D~WaAA~Eg zt})v6;rfqB(7f^pRMPQyTnm&^?7qmv+_b6h(h9*4CVrW}^V}xh4>W>|4}#ZAWvu)h z)WB@wp~wN673wTiX^aMqY$ft|Tm$#@y&p6#zJFQcleL!`xZVf*LW%*hhUV~l52o$= zj^$P`3yWrbboG4na1!{wK@Nt(5^r#q5aeee21CJ{ITyC_mN*j&d|%N4-;^_owrbqO7k z|2YM^Z&VeMc0o60K2&}&4U!=R7#@BWf_RDnd;q307f9qK_})NJytfFn@j>DpJev$U z3lLn=8t-~iQ0_KU<{ck&D>Nu1;Hd&qn1jZIeWhdcj_585iT5`?``#hWjqUvV1EI~w z?~V zP9Au6R0`y?Ni)`&+*d8X8p8EhED*H*4Pq{2otp~(U6zNbR~f{?Die2IstE^;IbAC8 zFHp=ARP}}Jy_N*a&sev7X4SsczIT+oGIy!(5ZK-^X&LA&j6x@gNuabZ#!%?gcXx%< z^;vROB5eY{f36XpR=TQ@86>B|An5Q(=L54!hU$hQhnzLPvNrjZ9%!l*`@#5X^QV$d zIZzFxjaCk=lZTwNS%l>T(M^Xv8p5cL~FRsYpjVk;Q)R?_nQvQJ#lYq*+I~$iMFdSrNV8CYPEb#Jo zxr2~WN&=VNF8I$a1*Iy9U!W1GU8>wu_Dk3*D99=7IU{YpeVSXs0oZ@ zml~5^a4t(0Y`PfeCBpD9x!ZZRh#O?Yc?HBH;JJ5jFqARyf#%*PfpUd-xlYL>PEgr+ z%rybD4kG??o654+nak$Af7I9NX9QZ;0y-H}1=OAZrNcWLFU)A&rO3(fP`O2>Wr7OB zA<+2`w?X&6CbkIJwu9P;3|?m+3v;Q;Rx3bP>45s%9&)=lLG$dw;2N0ca;V}0eHr!U z>V2obXt6`uiXG4uN+qERYPAn7B=3BVT^4Q$T}OTd)Iw;P&@Au?w7V9ZE}B56NiPE( z09%-vU9!vzw8Q{(J_4xyzaIUhSFjE%PKJ%$Hi0Zf8@f~(gg`r6D;Mxt@*Z4XqLU<8 zxyXYVRKjClx-SF?`@E86UUOnJ%XLH+rC10+Zz_X_{UUmX{eGlS7iLI=g*uc5-5?6u zIRy&$tXmU!E`K%o#D|Cvct|404d_GwkkZhF7iVe}8tr(#yF}q-r7UPfEE^>L)nsx( z;ra5y<4)|IHi1hNSs0`l4l^@=T7w`biWE+-;Ox{4;*_zUcT$_h-NVf;X?|2=}M!87onn)%ZO-wEvcGU1`IX5gDGIKlIV zkWc}gc>+pHRS!V*%Pcb$!&rai_n?s^XpUbA+T99Td!DgYcqQ|R)8J$HBfF%8=Qu^= zb2i3htdL={(Au6PCD0{Vrof=V@S;EI)+^f*4IafqLcSiq&NK!@n5M4W5a5z(nOIns zeYj5Eit}~WB6X0NQ8j^D^%k0phZe=HRdzE0tufwvyj)+H_Yap=6X)uTYb)92Ed|{t z<aVmMHJmAB#f%ah~S-aCf$G+o4x24*Dh`e2g+zSL-mmI3J|_xWWg7p6IsA!nw&QTof6>h{CLL3 zZC*)SS%noRm66(KvJ5{DeBGe<;Fh&)^V-4^qZp?TM)S8WRkKX8GFAfBRCi$d&K)zuhP>7&2!0s*XP(4n72!a z#_929$=r54x~+cpRmLZ&3J=&cK=scgP)lUjgb&kW!L6*z(8ki#$=SaAvZu5rYrbifGz(-}+nO_nUryke2I<}4_j zgSroU3rzD$It7{w+RwnvFlW~t^W~*7lR+~=kl8X&9^g=9S7cFHwXCp~Wu1rE-gds! zP+6mC=WpqQ^A0GtLFztfhNH|34Cpl=4})R$g&9IiWD;tY+bG$6rK>BBLpp!m%POO*_ zv3D_Os*1&?zQ*&>)V)#9j&&ry@!Y5cD!r0LuN&TwO24(fnZJio-`GuO&8h!SK%{B5KF2K|ezZ7w)<1_9$P6-| zF+`ACcP!l_sB2@lFrbT1X*Tb!Z40FjomLV9yHb|n7&8L{$gLu3QJ^B7MPZ_Pm&p#o z?nUx54;KRq1IYD?U^9_TW9bkBwWM6xC!S@Cy?ud~a7bK$p11+=V~c?aDDEyl-_nt>(z8T z#i({S&kxi-0`0bgq&O9Di33@42g(V!>m5YPlanD4a(V)nB&3Cc<=kuVsRcOhbC7_Q zHxfC$o7eS5)dWga2elkItg6q-0J?V$d31t_AwyA_;l=szqvA`g8X~wv<-@q3Rn)3Z zF{Sqlog*WhE~WFSfa;WfzF9(zn`fMuvNYs{a)EN!vN;~#B9DJq!zE{D`dp<68bCwsZ3B#1H`2hIQOK5vz{@I>{C0Et6d3`z_y z{0lF(q*u-aRb9tGHJ@fzdC_O1ixH(7tA(cPA9eLtV|c-TtYLcRvb2U3e?!?B0wd;r zzp#*JPO9ogt=~#h7$)}WO}#7d{eUW1T}BpL$F2DJrY?!9LBS)L*>pH=k(`Xw(4tKact|dcD~e722O8}UuQbEXo1#o zDLnY~viVQT%;exnb{8hhGgAfES%)|cgDowg3(1eo6VV3kY(MeC!RABK7mgjXL8t4i zVNhdu2pVZBS^86N=jvsjRF23juWr&&OuNOXKHbQ`;wuxwHZbVQU%q; z*5{(Ddzo0RB$(sa4l*lrci9-Q?eURyP>Ex7wR>|jy%x06HIa$mK;ed22B(7Jec{bP z=~_x^3@4Zw7!E5cGn8xupCTr}@JA8UH0WiHxVd?w`qAIYpxxiX6%C9Bw>c(z6?Apo zlvwVY_;bzL4LyRp?csZ67lX>~1@C4pU(t1FQ&YNP@^a89x;*nG=JMi>K+{~0BqxsU zb;);{-Y?Rc=5*|n(UnKtY$BjCn031p`>S=8zc!@LFP&l{^=7{$!$WzN81apPR&3Fa z*JOjbWyj`;D1IzB37*dbpQtGXYP0q+zH9`KQyJyU$Zn~J`TnAWWnnZQ2FP64#z3whO7u%-rR)fcFJ2)-9-S8dYK z{UIxkJ1qSb3pzR=>!WL+q+U?*!?~hIopv{NM%4sPQ30)<0_7EKyT%~vpwt*nGBYrw z+(E2{f{3Tw!MAfv7`*C;xO;VpSsMjeZN;t=5RyD&>z0#Du3s&V#?Ngu)@hjUI2F9k z3A9%YeU}>UHB(Yx_sxf|-ePbulP<}1W^n0mR6t+5g@0X^0N5n_CtwOdPLBMeS2<_h zMrFHW)#{*Fg`5s4dz`D_bo;qwuiVpx!ec-1H!yAgW2_HqO^Sean=uGfE`R0T{!jAg zk&R4uHl@3ObP7V&Q!R;|HFb;k?DE}&Mulf?a1g^7XduL&~$vCyoV`TfGe0}LQni8E~Mj!`_GkS(KE*qPNM zam~Dn|CLLq4(OhWl~V0p0p0pur3*y0e=4%N40@%_k8dKhb<~)BMn3}`iz+}GbSost_L(59rIM6xOi6WXp zI~+kLQh^Q@c$m5y)HamSJ}|YpjzMI{F$M(&@Sd?FTm{lek0Vp&zKUSXbI$QNX7xJc zI7rNybvO7f_lL<2YGDnx1*9i!jH`$ggr6@_a`)C_M&^m-3ZS+LXpZj$*eI|zBvp(I zr8Wr)pZGwnv?{%2pEs{IzL|Ar!}j!UQTfTNUI7O*K7r0E=v=(Cqt*V<6-RGD?)nzV zqZ#e2U9Sqe3_xQyoZvATIR;Lc{$me?&T+9^0pCI#HcKan@V^~>u#$iLwOs%KW4mk;Sx@s!_;}LiCJ$vS+ZqWv51#k`L z!3UZ#W>7fnZI`J%@nsvdq=k;*f%`Ok47-&YR05WGJTO}f+SscE+J(mC+QpK${@zm# z?i|i+mBXx0t&T4Cn0O%9?f+fL*6FHSM*ZuRb@wJkf&_l>oVaF^qJb6~EoEg}yFQow8zr2xUoeX%b!z1u|L-0yPnWT`4 zndW_G12!IABo;pfbg}uzih58UWa5XfDfrr(Y|YK+wAxvRO_KYS;R@F;iVUI*0a0qO z*~O<3AtJkK1N&T=7&JiPRK8E+xKew>3lB>%(Wg@uOPo!VxgGfea`RJAk@5kj>243K z!6#69pJaNf@5ar;@yk%h)~|O`^utuUbq#?fqN!2lD=IfWc7lh|2kRhphBM3z41KOI z-+!}#h2=_U+&uz~*umF9A^N85;9hZdIH)fPx~KX=8i#@{sA&Qo+ee+9eF(~V5P!dg z>^S3xw7dRIgr4833R-yp+o9AhD#go?2ukbPQ)V4k7x7YMz}>3^x1DU=L38_HSK{95 z0gbJt;CXpNR~r=u9)^wGJnU8sN{2JMDmZu;Hf{|%F1v54m4(Ph0niFoS%v^n#wC!6 zTTpZ8@t*$H?+4c(@DkyE3tF=Zoxu?3Dv>o^cOz+SFmKN*!33TP$t*z?$Or=`WIRB? z=>@2F1e=Kvgq3;C57|7D(a_bV9DHsjXvg$^@NIX9B5bC4-`fyRgOo0# zP|fXHf((hivJ7XL85pEvx?Zlj(8`n3&(7m=4|Hxhs82GTK@mKYkdnl@gLk9owL_4gs znt$U=o%_}cpgouUt;-)>UG~cTzal7gJ$}!}AQ^YOseIL!;IE4>2Nb5Sa^si-KEYv1 zuDh4r(g*8KaEf^@fUF957W^=EsRRS(vyi_p3VwjMSv+3SwMJ_Ctk!#O*(!VtoD37o zSJjnRL>&EEZoePY^E~Fd3N*hz-!jzRN~Q>W3(_Jb&>X(J!;`tI@iPLPsvN@ z?f#)7%qg(tlwGL(E>jPX@qhQbfL1c!DLGOgqw?vP!QLx-PH=jG(i3P0sSLw8W(Lr@ zDBYq~P;i-n=C(gu2Yu3H-F3``SZl1X=KE5(deCN7BAouYznrlVR_SnLVfLdZ`W*Xw3?E z%>#Q}&$|ZJ&3#j9ybcylII;Dl`wK=xGtj(}OTy6?d=UoV&1+ztHB#Appyf{HVxZMk zUUo|p%4Y2jZGAc#6pgGY*&`x=s50fTNid<$g zsqX=--Dk}K-Wzmgsm7+*H|CqqLQV}gv9S6+^2_RZUnG4w^I`$lf>0!C?>F^{_djp~8@F|@=I!HQ1gV}go z?rHKvZDG0bX>pDsd(};F936Az1GQhEVF=1eEe0W=^`4L4^Wi$9g9Dt~8Mpo6fbH0A zeEmmuuEHK24p4s`bS^J%APfx5O6L1PFy4B`wc zk8PBV64TUVw0k4D^~a(W0UM{rrX=g4^!A%4z02#70No+j+3sxz-e--}j$k&h;M>8} zIL+1T%A;;JVTL)oPQw-hEs^Q&a@y{{6TA)uej@rQP4ILuyXeByi9)gr7nm6sw*FYe z$PWrR$hqgWk3A}`90ZM@f<`!61pJyn@zJcXX&=a4pfOg>$OV6nW;8N7+JnwG3oL2{ z-_Qd&)AR$l{q?>qS?2akodBk+kFM!k@&Z05v4duMq31sAHsw3;z~TWHON!2wN8O9^ zp?MLt#etk_T0zU_L1WI)T(fn$$~OLchM;}95D^ECj_C{s!CQwG=}7Xp+*1Ut-vG@d zRv$m~q2VoKzyr5?ifPGn)ZebL60uMLwL;WpZ5Qj3ymUp5fi>@mJOgW<>9I_I*_t(0 zQw~bTDcr19kOhs}sorK@aG-bHN7<#$K7Mii;yfLHLL@+~)(N254xST#b{Q@6`v_`o zR%KI7JO$AxQ%v65-~G!CTWZF?k$dx zfg=V%I|fMG?e+71aC-tYl5r7q{ug9_UE`!94G$O}yynxcsd-Vr%`|<%5$=8~1I>&I z1{nq^hJP{bZF&o*%Q<>Jo)^ksHSd@x$J>g<9%ceFh2XpGtTawU2-qkK?=$P`micDRi#N}Ik){OR$GG>!v93D+J;7YYUw3&;G<;s;a0yYc@s?r@k3i8fX~ofCZijgXsyrmIZ8)GCFDCRkEx@fzpR97zZ+|+hM<5RGDvoL6l^^}OaB?_^> zmL7Q!YX>?!^q9)YSNxDMM9&2rcV5Nb6o?Z8of3nTb0Ow{?s5AR%$}6@0ko1V@yL!7 zyx>!s-461#9FUc8wF1>hP+g0TBO*(&xltT)pBL!tf*?>YhlyWd1^C(>Q6>2Pbn7-r zNPhv|-gR(DjTaFM$LipPF#Z<2WKL3WCPXC@(|mY{v45e(?J(|_4r zauRwwy&~v5srQqnZ&{u4a?4sJr`;iI5nLm{Kx1NMX%Ad(c_u zklncC=hlhGW;{%}^A_ojnu{IZSNChMmL$)(pa9xAws8^YJWbH~yZ0G*8NljYuN4J} z|BZ+255#u1mI_iSAj5ElnStT@mcCYZPxDB-5Z^49_Q*$fOhXS$o3G1pK>;#SDd-?% z>*(fb{?eW)!O)EZ)B;yjVsHd4H3DCpxN_%K6DH@gJ2xA#i0;^>kRtgo_>wR9{zOKW ziC>q3XE!81F*4MH_a@fy;3{cAt1w9`8$hGm;FG=k6D3veE;01y>(Fhwyau+dZoAGN z9Z7jXSMbGNqIqBErtclL?GwVBj45L0B`d^+H{cHU${VJ zk(;M^B&WW%0=R#Zm}IV%bL7Y5q*ZrZ>({fqF4eK|+I2ERmOI%{8MK;?nB`4~nm9R2&f?IrIpqbr1#+mt*hEWL)0o{Hq8yQ_&r>n|>ZpHw$ zr@@;QXJ@m5Hf>M8S#V|Y8bve7Ip9;xLw+|b68zw*;mC5a!17Uta-Rj5SY=evj&TzP zH^`^ZIsvq1mJ_t5A6yftcd7go0gs`sJLdcJ(qF@z)F~yCYoET00OiBA!HQtt9Rb}H zXd@9La9TpF!eEA*;jVheo*)5+PEH%>wR&?kCOru@0Ieqm-5DVQnjP;?)Ly(~c239c z`f)=Rn&?E5)R-QCOu zxnBS@BMv?f?6%<<3k?5pf$S@S+;@kp5;PVKHJuf5nxWASZrKj26NlTo&U#JWJNbZu z1!$b&-<>1=Y(f7f9NfJF>{zMEpd{7|x*G$uSLKGa*tL}>mdb5-njRgV^l=vGG~$^5 z|JA>r4KT?N3uFwe7WK%~XcO)6583Xw&IME_9`O&GEX8mQbpA_JTlWR;ouH-$!)N8n z9%;~ca@B!p^K1Z1d8>n5o z0CcYg%fzp#pnEl148Aac{doa&Kg@9hWd=ot&f5!w9WBci7cTp2_2a;L7IVF|+l+Ud z^4uxM#xdJr&lg1oS%%KfIi_69r#4FWZgz4IUR!lR>%b-11Nu(Iu>u?CL)QjyG4L^P z&Rgr2c)_MUeRZJ31x0QKPU#Y*S6V%(4E>Y4r&NjCr?GW6Q06uqvjT8B1DKZE!aHjE`)_AG*^Z~fQ zlvDucPf)5gv}%?C*`a3rPUR-+!Ydto&7}rX&pmf%WIg*NE>Wbw50X`Q@XK|&-_>|-35w?BxbJXPvBfLy!?cbuXk!^8V*b2&~OWLp=&V6s4>cXnfJh1jXQ z#K<*2UO291@Gb}6A_TFs&oL0R8(?1d%RgNb|0Je?t6qMFPUGYVH&64-BUUr5Qk1+I zpgGu495j1e$^$wN9#r&$b_wQ--vFHfD-R!&0Nq=>sQFRwCEruv`$srfdnU2H2d%V+ z%yuv`ya$bVfkzY|<@lmojT4$bZ#F=*Zn2l*!l2T4QhMQr83`r*I!T2acJ#ga4+;l) zmKe`@vK)@Jz3+v(n~y$u5-Z_qr2vXK0&Q4WDFB-3fV4dcw_(9K4Ag7CZFmN>(*;sy z^FhjNP|G$5bSN%rSq(88(yrBExWUZ8VD8aet^mocP_sZcl|sw{uk7jIg~S59%?pWl zH_$$1P`sZgf*lsVqDD@IwpYH zl6GWc4t)-3m_S-27%gc~3k4g7w+MZ70s=NU1TNu#vCC;=uG|A z{|_%5(G%rZ{k>m+wPzBz&3KU9_8@2#Eaa5t)#ad(Kgj-&u9vGEPC#ziY2#sAwa!6; z8Fbaql7rUJyKO>FoQ}Sm!4m#3wH>o&L%khZuU_CCVonpot(sKkKWp91$H%|sqB_}*PUA?lDk=o+M8 z1xPOoaSkhH+Axn?@CQ^jfJagArVVjOf8HpMWFLyPuSp-Z}o22-4t{2pDT5E=xDXbt*7Gd-k~;RjM2@`$4UCh-vJgAc&C8 z?Pz0f-fix}&aAG-fGnfPa0@j4`^K*I%Ax8xkJg_%pu+&#lPAG2kz?xao3&gkTl@8Y zgr`3U$qPFu|8KRi0VBhF(8~Ko`fYdHm}D4OGNN7Xayvfw1+tS1tcy4FnD`nakUG#> zrfJeU=B%n*E)wPW!11)^Pb;@{P$578K3$AnOaQ;x77qMVT z73kieEan2%eE{Cl11MS#>&=2kWg-;#3SL=XIGz8B!ZeDE+ z+8qnJnIoh>xMgK>0O-8X*`UCyfbzk;0NZxZ{1OxYG9jL6Isqa5!QD!dpwfyV<%jU> zo9|bM-MZ0uNg!eEUd0zvr9gB0iCYw3OntY2*KxhiRuyKkJ3Nl-*T^sQmjcCD;^yBX zLEQ539~LBE;AMdEHk`6zQw5FgZBdkx<0(770K&GChL&7e{E`SVs62JigBV6o#0R?Db&KN z%HS=gu?ln#2&){=G6iti0$vRv4O-!n!zUaYurtd&L^A%9#BiM8iv$8sIlgI;xQkT2jrr=Qs z&}yL>pzyj7)WDpvP-th-l6S48E>k~(Pw$Rr0M(9W&Lsv0Wsvc4(3(vTXaQCM8M0tt zXLxv-or%3;F#|X)b4Y;s?HwGFw)+-<%fRE)B?41xz&E6|2(-0<(gM$kJO#6ksk{$U z6`^YpBzP`SP2l@1E*Bfl zogX{5F+`Yw6C5k=3%d+TeL$&1^NGXP0#7t%;o~bE zv+gqFDk{);#+Lqyq(-56Ir$t_sc(5f0rkD@MM8q&(=^dP*Hv(r)=ALT8!tm5xc>t+ zlH&4TViPFuaxesfh5=R;vxDj>(0v)0i4rvWggmYa(g(wmkQ)EoVgrdq4-Y=L0ZsuR zk3En9ug$~Orh|>g*%=;k{T~jh_2x5x_6%Y>2b7;-<*|#7@~7C!m{uS9G_#SNK_2zA zOhFw!iABwgtpJ0b5`9GdP19Ym`$-dq$CFM0tEK5zzjxXz8bb{m8 zz7JL{SF9u++hiW+5mhquY2ssI$atv8@S@+$g`Jr@BCAw<+QH?QjtJ>YgI-M)!R7tD zwpErvj^RcB+XYO$O9M7uZA{l!PW5GwRu`R zZ60R@e7hJ>R@B}Jk>F`m0JYea5hJ+OEr#XhZ0AHm7DWD#=kt9N)VQJQKS$sJ4M~t* zvfJ(OwjX>P7dA74SYwNAoK_SvPRnxR(`HsitM0^w9qdfYPpN}v?jUVATqD7tnhM&% zS7_q|^~GdS=5Q3+ICBhh6xE-5$}!w$W?%-0NL0bLnd{$bxpUf>s`Z`Y&C4UcPMJqGBlq0j1zRItOU1=g-}ZppimQ zU%drdW=q5S44{58Xhq*R|LQ+Dw3O3-MPfES}LSMZTycF-NBLF_yXoFEY|s{^2OaAX-C&X-_# zz|6oPdHB-GJBi02cU&fbZl=@$kMzG#1>M#6@6Hk9Cs0&Cc>42Rahjmoczb`%VR(AZg<(J}qC;7xj2$X&RUEDKO1GIYRL;A6T zIqx{@crM2!fku0`_#Znkv*F>Tl$FySDt!rBcP>&*=)fNjIcd-yq^bir$4DQp&usQK zj1}!TnIs}nyfDd`jafgZxqJZ|!$bb26Td+BHYkI}NWtbzlm3wgokwU3;93ygwDsr) z&>%Z#4aR)Q!{21mc#J{m6Rbl9)E?)9%{zQ*gD9UGc*)nTEQw7LG_nE>Pi2d>Zy=-P z$0qonaR7}@30EjUu7h46efT2tb!mo&%nS@at*t8NPvQdk2(n;WlM^UOJZui&$_SdFG|w88e5PpeKt(Pws@=`&1K)KA8fBg*_|25htBLvHW!G29TH*iH z!8so!ljk3u4NkG`pv}7fKZAOA(3~IqMS^nzf}idpr_4ABG$shT!SMRjRGw%K{m+HF zYDMNe%IBG*$=btY!ku6v1xoGkyl^{`Lts^4TbiJDs8Fz+6a#17`Hl^bifoppl*};9 z=`GZUIw(L6JPJI^Y=JV z1flUC0_w|w!{ZVo=oljdR~r=>P|ShT5a@Onq#Pk}|K)k;ni46{iZ)nz4xe?GVR*#M zz<_)1T@ti5u!tE{(&)RL1`o+feSXq#L&-uEc6L%!g2RRW#FvFxQ(_*beg@@E=&kgB z)j+rWPI&H=85IG$1sHUCC+KdAC7;fu1UH%)>MUL|+k{8;uJ9kQ*ritQh${o#)ogi3 zRz@xK!Mhv=&`pPy9*P`t@gEi(Ucv=oflhEShKO!BW#zM~0d)5n>uMg*UMa9Ro3`0; zahn$gE17~gnhtiI{m9A>T0@4ATeFF8vX(-tg2b8|GNA4lD5pb4){+CjrdMuZR?P63 zq$8^qx=5D8F?mvoDYR_kV0dT@a$mC&q_&d*wZiePEkM*!=%Zd543C)^7??xdrIn=j zD1&RcC`ju`&;hjtfw*%Sy)_^X>II{=2E@85zS=!S8I_X(wJp4{->N)a1De;1!7exi zasjTEI7p5g(i-Pu%K0gXIua|xa^sUSxLv0NZ`U38u!L#RH>VE_9aE1bi0s<1BH(lv z=q927kh+6Ppq6YyS!Qs;f>(=vZb;v(`fyVi16Rxb4LX1LL&bZK7;tLIF}!#sc6Hx@ z{6m{gF}S=Ho#v|kI+9h;C3;2R1-;O;9(jfrUT?Ns-?u_>d%V_COvHYwHD=2Y-g-p2w+nqQ6e&BhAbXnlUo6XJ zxvR|ZgqeW>wEAeDk|1bDlEZ~w`MaraN`o)GO%sQl2~ErnF8u9LeEYFLqm2+3O=q6) z#b)L)MvtmEbwP03*Z9M-D-kIcjxr5Po|l5#y^>(@xi3RQn3Oc8UiR9{_2b}d(2e3O zp#D`nXa^J0$GP1T`O>Z-f1g$%S&AUm}pVr>91~l&hT_x@8c9>b={B%|?2A8+new`^$ z1D&*T`B40xX{Deup`rcwJq*I&HeHGo^q@J0+iO5GRXhxdQ9rt`ZvvlZwOJ6f3K_hr z`9wwq!;_zzmT)qF*8xMO)lNC_eVGorD+jVJ9ppl=DhJMn6?entOP*7K_Mwr@f%pM> z4vrTn_lPoVoZMVeaG)vD-AkU~DKi6u-O>kjCR=a6GCpjKxJxoU%|FzzY9e!bNl3*_ zF{sNP>^SLo;KhXGPdAwEpF25K1JptaIrAQLyNHarrN%1tHc?+tFnsu93>jfM1+o!z z?uXR}@%5^KJz^39B5t2-*Saj4$f31IN15Rt?5x-)%M6#st~${5epa%`W{zKTjs>y4 zQs95ib59X8CIUY37F;@jPs$c$u*?NFuTJn7w1_sbI~-DKuHL5%x((ot!G7>^?K$r_ zH-XobZ`lLd)dL!rgv53Dwn^e&xb?L`>qb042Y42B1VV1NRl4%1JBU@Ut1+`DLKW15 z0j+;62~~Kq%#c;3(JWRJD}kd09wBbI{P63bVqqP)*{>kJ2x#q2 zryGkW!=!oBc@&>JU+`Q1VUq~VmJ^B@%cmBB;8`^A`8!XR8JfQId1(Lp*)xuwpy$k8xgYq@V^0XBG?}_*L3~A|1gIxE zX~sIPmWB$>Yv!&0-=u<8&1&vZ76hd_8?Iz8O;F()@50cW0_yAYoX}Ndc+Skgz$6iM zYQ=|5pp{b09SlKzj;En}s3B?Jl|8jK_{VwBWnPdKjSo@AZXq*k(jeQxy?M~3J`(dn z4<1&Z_0{*Gy${!W1qKzUEckRT3kJ{g-f6~~K3`bCzUKrlblshh30E z+O@QHz2u+ERPxxpT(VlR>!QrDjdSf5L`VIQkBd;02c3%!J&=FVqS^m;z-|Ftz{PN3 z6=;@(iy@Ka?j^=!<-dwo;5(rK;tNiQYPGw0pw*s*P7>gg76lo09#&fFJmZF;gJ(#f zZcx0BJ$TfQA6$}hfR9So;gC58%~}FFtzQ;)gWb`T;Kp?uo!8&uzIv|2Lm1Y+2kk}zweK51b+Q1c{g3_bI?$*FH7>3^Z+#v=wu z`d4A>esVP9BOBifH4c4k#M~})KAdfFT1TwdqO`OfPa@?noaMcz2)i%p+{;biFaY0O z!_Kg=d*$^~9xVpYEa4$&yl7en@9A@$(-qk|T~z>-e`Nly3+~V|xxBF>*wC4WAu;Av zXj8MbnAOUpHV%eF2E(tr_`)`VXUp0DJ=&TA+8YBZKZ4c^$;7-0EtoK)>TBW3eW0B; z%pEJQmogl=@)~p>8>BqB1{q%mmnY!U@+x0EJDMRU=E*Vl75EhIn44a4;Ipa0GiV%; zTmSqJbqsWOC8(SurReB)+#m@Im|vAXGH1WOrcye!!PT#*aM zm4SLj^A9k)?|&__i0f<#=s>k1tuzHOhKKUgtEN795VXFj`N);k{oXs17Ye8{gVxJ9 z`0QQBtgtNZ`u&Yv+$ttt7DD^9TR@{g$qwKIXQKl;f>{EzTCPOLM5`_6sE&eJ->jor z>zYGj6gH~!GH~A62s$m0D{zulnh9uq)S5?D5l2~tq<#s3bg}4I$aeqOkd@5`I;>Sy zl%W%P?j2m>U%@mU&}tXB&p@m7I9mkT8bG~Q(AqZeRqaLd9ks6T2yERiBG*!3adN5# z_+Hm3C7{grCaAM9t!XLr_C6KR+zMzF9+tC@pf`xVJP^NUnok9&E%{Km;=zmZxlSPq zf5xeHf$sQv_!uRX+}wLg5j1-QPA3oMJ*b|#WeUD?6Yz9w04c@i6J-uVz{Z5Al~Ie>~phv|?NMZVII^B+&Th_Nzof({@Ct=a>h zplGyT!A+4tjG?o+L3^j)_0(0*Uw>?3oH)NLbkDlvm13Y(Z=f-RS!O$s9J~;`lF61G zl#U?d1zxG(6KE|(b3`k^LyD}Rvl0zbz_-VP#+tylN(P=-eC+3{AB$89Z}}xv)V7*J z;${g(O9Z@{>5HYH;nqBpM96G1cqKHbtOqCfBCQ)*2lh+o-aAkkq2gE(2`c0M+%>FZkCRvQ;OGlMFGk<4_?yby`r5(_iIdGNJ=ocG zek4c8c~r&yzh|lp8qwhK@SH7U0UFAdL!7g|e^Y*BMWise3^?4ASgG)`vU7*3TI9(uT8=yOv|wv`PXEw(s=6$$7BtSrb7D%BXiupT zbJF7#k)SpzqO6-#xl+b-YSGH@gP;>hIY6hLHtYV&JI~AT5G^D@J7}(f>h7Gv4M*?4 z1@D7_tn1-r*x1bw1d3XQN%O8NFvwzcUuN8Ep@fw&=BA*VuXakAPX)V>Ng@T(5@%6( zS?RfEvZR2t``JUMl>|Yfsd<721deorS}`mSQ%{4|8-oTRR5$u9oG7d_iGhKiL5|@qsQ<^~0dD4{Ip=8ge%J)MI~TOZ zXFnfbM1hsqN89Xc_uqonpg&A@SeCr-4`>Bdllkfg=b4g{zeZFjCdq!e|4 z&fhgjh{l0u62Ud5)){vGO%oVCfVS}Khge@$^iAkaWL$p*bSmFN=ncWJK?_hh3Yn3L zdKD74;MNVu1%XyeIM;ygK}+AS4qCr51r+nVTnwDTY(kps|C=PVxj?lXs3K{dt}6xK z;Q%`ODdjKU``C@HFR~&9!8=%abn0Uk|I<*||n8oJ@9^n^BQJB>FXWB!h zpbi0vyWgPmZ=%;37l4N5F5G|X_Lw2;(X$h$BT6-Xui*#P`^j2nUdI!%=UiaE<;v9A z?*HiFr1PNpLC9*gK*NJ)US!A^muNH}{@B{3ki79#K!OCcg)$?^3)BG`~5ZfN_a z^S=^gz%inwCQ%!hrDHTlVb7W4hR*Gq&RabUw9B=Y2E`Gq*L;*m_LSZ0n&RRo%l+8S z>*sbi4J}ZNLB4MB% z4j@0U2X74gWgTXif2YmdAaG*Ejwk2k!S?Z7p85=Q#`I*ZwB$Q6FCTu6Jnr>+%0#y% zfA~SAFgRtffm#hOEFq`koPefpMRtaVAd`)0p){l3_J{-AiZE$?Y0#Fx#YnmgV@Y{-QZpb8@MIYb_tZv!0Yx9 zb+MK*55q&_<)CgSc<>XFzSc0vGsrT$2j~A2;94?f`K+#9@cA|U!r4hG_mnR<{#^4H zbRzacXnlWT2`gy!u@8DX2rTjs^EBn?R*JWFi$*YC=zXfUI)hYGQYo(hGJa52)8w#9W@BV5qTYjT~ql zGCJ<8-oI9HZ7*>rPt?JqlQCPa zh&2ofpt+L=39V6w93EM-94lhYyLa)RCazH* zU(kp*aw=2;joZM+k6skGgTs(t#?Ci}A9@^M|i20BvpJwas6 z`$s2By(0XCKzE-#V`WyV-+qWuSL2QY_X<;R-gyKXm11KM1XUpmxEKtjGdM~bJh#tQ z=7OvjKmDgkLRE+%5nNh&ef|m>?eae=>#fSg0J`VCz~4Z&+d&z+LU_}i15??goOIo+ zGh8N=fQFavC-68>wc$v?H#Y#;|P(_v-bXWZ5EfQiMPMLsaqs2aW`JNVH zfb_J&XF(>GwcbUn0`*8mp(7$(pph!jT9h4^9GsgzY?5Pm2w7#VV_v}C%Q301)o;~| zr-7WWH9*(v1S$wY`=)5-{f{_W`e0syl^CcE4?6M99n`MG@FD09AXqo%0JKbFf#gD4 zc9a$qcr3t*nRlVsVp&Luurg_yyXqS4JvyLzXMWiN#S5UN6MPJY44=ULKTvt809pkh zAG|TpYDQP@B~Xh`8eGzoXbThTS9f=W|(nh}Ea7(uBXSN;d33lZ?ih>bsU%Kn*N>`-_aaimnIkr~u3 z#FAC`B;%5@%DO*;TOhcljmlVRh94i<379z2E%S__(IIH%9GLtEc)PM>N)h=9vA zbC63wDQ?EO^&JmObeLqpHv|C}9N%Cw;me+XI!_!felBNUoD8yYKLe;7$tzm$;^)E-oA^Lutjm-xK0dyoXHwoK z(7p;DkCSQNtY?W|xxvrQbMe8{gtvO3zMwR$!0@nH;FZ;sLfHiKg7&j-%1!iFY?SYF zS@Al+E#_A2s#!{6;5J9gF22++ivQj*OnB(e^*C#}K{R;wl(F}3fr?XXyV0Xdg1@R$ zXT9T$`tse&7j%0)Xm6S#7SoqH9N&RtJZL3VvO^Vy`MW`;O@wk<{4KWxdHeRQN{hD$sEqkX{FacEFVQzTxKckO<_cJ5`jov0tzLL*CSNAI%i3GByc80< zH#fWZ32l4vSV$4PO)^5BOl@01M2|>ct3EEc@0rjB^4m2%o z(S7t`L)O)6Yxb}Hrzixi4~*mUa z8K>A;txD^1)?C-wqr)J^zzH^4?3G*lnJQn^2^)^y1dWz}&o!IeqPvb6Y{A#^>LZ|A z0U_fDjNo&XOL-8sFihyas0iNM-p?$iqnabwzI?5v#NL^Qlo`G1TayMw~h94Xow(Q_hQ1H&EWkquw~g`)FaCpvA|T1%ylE+yn)R1edjsD3 zv~OV!3hrbOVt7%%?*D&ZL}H(=p$HK>DYK6K`Ysj;!SyRyuJ2-*p*MB$F=)yLoyF?M ztlqMafsw%YyPDy^=voCk{$O#Ogho!moOUyFPdjZr&Y{Wx()_nSo(-b|2$@JiAkQ zVWs{xw!eFYKxH>*zfBdcdK8&2DBLOjE(HW zE3V5yt8@M{aDr~^S+}Wk?_>}^o&lHNK>h|{*g7w#6^|DRfZ`W%B6dr_ac4!)`hCy| zH{cVon@;rjCCy-oxc|a-#X?An9{U7s^Ac*3jFCZ!;X5+}18Ch;;3ECDxpfW8 zI@p=E`0m}H`KXa07v#Qp2Jo&<>zYX4B+yyh^O4qAfethYnE|=n9u%YX3|!zA+HJ@F zd4F$$S~;NA^5CvN^iDk)=sJK^4xp9qO(%Nz4l*Cu6qK^6A@I@zSyu2}2-6{{A3XC8 zx(fjm!;{M{f)1DloiVZ@Ace>6qpUS3J%Dcl;AOD<{6Ijhj3+?o>W^qX@X9V}hKc#- zVRw-S{X3YzbQpXnWVPTHqMS)$!)gLg7Kg#XJC(5{)4YQpjlf&>w;h- z>l}j0{l^{(O=sQTG`*8;nSB+g{oD**59HObap?;-NZY*44zx>a^P30YgYlO3Hcv9> zdf(X=RTF5W$8}m_;|5#M$hOLo=HzK}dqFdM=<9~$K`kSN2Z%L8y`PuJHnBVG@~HKB znozUIjsbb43)Zzm0yYdm76<-<&ewQ|SUY4ozh05y2Qvdhg`$8BL(-X6#4ZYKD?HHM zB@J^IM?%Sxf*BzZ+;B3GwVU-16nc<{-Lch z0SO!VEiGt(?Bqao11MxfLFUw)UjJrU_^T#g9Y2QxPbbhSI$2OV<3XSV@9~b>Bv?Fu z+w>+jz~lY9Xa&gF$f-@n(~Xw-eck>Cyw-&aw!-~VjXP*nvWt*+V8@xQ^aegIa zJbQL3`*ArAhKI_EvNB)pg3iHh5onWvq-}89540i;x^Czglj>J4eQof~#6`^IBA-5m znM)lE1+_jNf{*gKdPkYz-<=OBprvT8?70Th9w!A&cD!PLkgHo|g^CV$tW;xUb2<22 z3x$p~`k?h9AU8$kJz!#Pssru2S^Px94SY1tj&(ht-8UQzAd_VneljyKh+MvUM**~w z<|Js4Y8AUq0MkjSq{Sy*ohz7l^|yNmlbdIAIp|hdg^o4(&{Um=fog3XnMod3o-`$jL9wBf%cYeCzwxgq65W{f2RXs_at%teT#CbHOFgVjW{>BA<_ zXf`-rz(*`yi8;da_Gx!OBimV}6%zawilDPvMbw#BPTyzPq9Fj;1e5uJ4{kHKmDHw( zJp_ZEA5(hSpH!lt1ls@bAp>&cov~G#Vbq>RVRiRI^5sTJ)9u=~Up@2mFsQ##asNvm1X$F%)sC(6e2XOD)VH`IanDi4sqKh z(7kC23@`j&{C#(5lhu(V&>FC&sG7h{A!lRkG&C7?)TDk)RTp7+aX#qlCG$3cM9JpB z8h?{3kGhkBV7E{3Fo0VM@#i}NmN&A2dWJj<8y9V=)V(DOx?f5i($Chd78kj66MVWU zsH~INUu$)&^3u6gPFyXm{~xwGd|>#X3~D8MbpMN+xn5_l*R`Hg&$ecig9eA1!LI!x z1G1^1;kWxDo$B)WN+6q{EspEPhd}jHJcBZWpu;rj9l}%3W?u}cnAx9feU~XiZOa)& zrQQ>tQxBdF=+?LLW>5vK6fED_Xw6kwxmvpS!6MM?d@2vOrqc_N_QHGY%`57gzP?CK6Cw}YQk zFaCtxVtj!&)*X43=0nhZ(%`jq;5pn5*es2QvXvC*>VwGnTz|NFUamQGsWSd3pBiX| zYIB43NyFI8eRBE|0zX&EoSC=yX8-3Uu}7x}b^Usx$e;=;84Vz(|EisOW4Wt5?fk`( z9^pNYK3Z*l6(FX>@SB-|LCoTCch-AFka@`tL22hNmV%CYQs`K7{`f}OkQ~spE*io; zPO>u4yq^XRZ^)Q0sD_5@^i<;Bx;XH(h3E(Nk2Z@9C60b~3C`KL;;1+;sQuXpD!(}y zDsRfmfEN^iS7ZwyudCa6Sm`DB-eS_{rP1&%o+b-Vl(w{8GA0hF^5;!&^eM5z2-`(YDkF0<+zJNU$NM$nj# z1QV$J3R?GkYLoGL9>uwlJ@?9Q&R-d9qcbVsVX7ixM+S7Qni{7TXP~k1j7%Q4k7vyU zEEGW_q({`59ghh)etD%(!OUO;DiJ~FvcvKw$Ob6}=vu=h-#bx{OMbWLxUcDq)=<6P z*ue@)|J)3QFYiPwfefKCfZPKqr$a-m1&Rvl#N-+NfX4s*R&KIi{9zM2L*issuL7PZ z(9AvP>|A$i0j4V+$Ccg%EATTU#?6)Pp29bu(NUFqN(X56I1#i9@xA}kgWSiT%1i-` zh9=I@`M|sbv@C8xBQHbZ9Gy$8?;iBE$^{!iZ-M}~>Npr;lEoR9$TTZ~))_)wWL7xy z!3E9GZ|Nd&W(=_N^$)$U%95EfXP4_atxio10dQ)P2aW#n_JQZhc$MUu1DG!K<_dUm zDKPDb1FZs3WB~QTPUtd8G)YWl*O!@I9B}K{M%j=hlV(({jJ|5LJjX$|OF@L8@Uaz} zN=_1J%Tz9?yZ4VvKUx|zXAWyOVyxQ*$1HdxpPNC@0klK_v^)j0f-4cS3Sj5OnOYN} z3xz>rf((KVrxyBhA!kvVAE+{#prm*5sFczq(M)Vv|bBc?k4SS=T* z4SV9xu21qHeiJ)r3AuVj__wT?+T0Ew7%aduVW6|>R2cp;Gcc@AZ&6eLtrvmKq%N(k zVsK$QZ|}>l6zQBJqA9b0_nsmb!@oOMo*hgG{Pc36B3w0Jjt&by1NS*q9YG5g{sxKV zO_0Ojz-i3&gaO3kU|@9c+3QunqXpuLGB7e1 zbu+X{$ObR3h)}r>OA)f584RA=M+I@LJO#HY6d24n!1K~Bha4X5cKhYvthA=#_KQgl zerru6xGgX6L*_*i!KXHpvi6kE3$gYTRFc8l!bs~b*%=ZA81~Ii2CV`Hul|SKYQYX# z=LymUUbA7twI2O$TM1CR7VG*;&>DEq+Q2&-FL;U?mw?)x%pEJkIYBoR;#yq~3i-qq zfwlm=tLwq1n&rte{9|Td0IhYI0a{4A?$p1YL#J2q!dA7si+Hi5OA<8V14^j}wZ1{x zzehl;nuIH`tn5eF4f3xfY}`#tO+r?-S9njRb=F7MlU3e7j0gH2VLba463Wat5>G}l~j#M-PEnjCCR|Tz^K@w2ue?U42;Z^8eEI!2Bp@! zJxm3S88E7VP9~UA4{FRD@)B^8<$tQu=2?)@BXP<;vC>a+fhVZ_q9o4nqQ6C0ch0d6 zMX9Wht}AD_c7U!)au5RbJi+yu2!rCXq{SsX+oaeNRw#e`Aj$zcgI$tAkzsnm2F}NC zia^&T9XK_w_L^bL5^t6uMFw^TMGl7h=QloQU}Vr|kYP~#_YQR-cpLcch3`s5xe6)_ zifk!$u{V9!UtygcF{k0dq?QYse2;JV{antsg)6M+OE+k5nmWV3I|VP>eBVecP+7I& z#WMR6F31+HRt>jeiSHb>4%@eUu-~&m2{e`(^IsKG;JLb*|1C^4-z&!OpP7LnNIWO0 z&_R@8L1^^DR7X%AQ3HjlIYRBi;D$WV;nn&shO;azw_Rp0@#g-2m|I&O)ZRuj6JZ)? ztRB3-Id7u247l?rbKBANlzr)fP|#865eq@{T%bDSz7N>>dqkdc>02u>Jp3Q!xAT%- zpN86Ot`g{6>N4k92SAGrKL&}YgH~7_;b%%{X7K8DZF8Ok8c9CVf9D39W$8gK_ALtv zm~|IS6D^RA6*{qUDqFH5`!7&i4RizNmN}Ew-wt+}%NAvS?l*_ph8EXHTV$Kq4JgS^iQ2Z5OOXjXqGM(QeKoXh%?|a zk&U5Kx#fi<0|N^KgXJMEkZ-|f{{@>#GCcebnXec5lrd+0m%f+K^0z8&*TW+~qoANw zjU}LQX(oOwtIt5?!!cJc&`8Mq1I)F4E|`%PUTxH#je`P$ah@4hfzQHA1A+} zJa`s5bH=*UA?L3vJo@MfUK+IY@qwGYwwg|l9vVPqqd+NAACw=2pMct9bG+_80^bK> zaB7$S{55V~mq;@gr#zrv)MivH!9QHpw0%4%VQwM$oMS$`OCw#5&ajkXx zZ}%3SanKU@2f2pP0<;>ELGNIK@Ufdu`IaRu-o*=<)c`Fbk^t?w;RdZ*3fKs};8PI5p=*1bfuBJ!DW+gGsDXE6m2>1zc~I{SvR6iAa!ccp z@;xF)%|u^F!DazW8Xe8IIr_zVfXc%=h?H^*UT|nLNV5cF=@`jO0`;0%7`IPX2k_~#&)8d}*f$87yT=_{<$N=}wgq%A2V`Bhmf8$SS<^mAt0@N`{%~@gurZ=k z!vM6_yy8KiM6efVHPDP+aCaD_af1|S?g|u#koazy{?mfNdF}^|`P%{&q(JL;z`MZi zm@J#I(D`Qi-2A-0KUYpZ_^Ar&y; zHAKKyn7wV7FL(&#R9T65E^P)mfhNKD=#QD;%-RJ6Hu1aW*}^m43b;IO?!n4bE4SU z9-Rz&xVi6PP^TCJs4UqRik7GXAZex@v#!l><^)*(pwrY)i2vC1L(T?&1@AE{ z^D_iQ9Sg~s!UwI%s~~#7E8tHxi}#(j)X07OVnNL{u^#=__Jm)`d)U=j7!;j&fyFkHzj~srs?n(ZS?VuY^^%c~A9a64Smnu5p%O1Ci zo6x&#KtsTeFAfRw@UsT$>7+82#khgaodC7B;eC-W%sZUbHkE+-%wL)hE_!nLfrJSw zsNc15IfDqK6ntv5U*R7}F8ITOJrc5@wtc}(giE^i8^q7tzd`d+>f9hk&-2Z@i^_GJ z6onWbE(Z5^*w`U`r60R(1wo}d1LODpBj3Q?r+2}-AY&NNIZ9&tNuVAQs5FJFQ~~dL z*xJEf20GILF`f?UH7#KhKYHLwW&A_C0wwSrVpr@0PR*SZ!TLcPGy(|T$xsFz2vFGb z2Ao^LyCz>SB)6=X2|hPf%*N)>DpqyS2tdeh2l)JDiR2z(Q2p9s-~!sI30kFps}p*I zFlddwq7#QRBIQXiG#+5)*io;-lrX;!bP%;(kbLk?(8ckL4E+o;42;Z|m>*axF|e>O zFo2dT&%AE2O?XjSSYvlmf>d*0&2eyVOaj!}2A|iMnce%@u8C78G0P0Q;-89!K(!f1e@c`x6i1Wx&yj@?1_ti#7bq*&A*^N4d`shM9AJ*@a|bftK7Gd9WDFc)_V%ngVK5K=g1iBnpT~sJwmD;iLxMf$btQ`0Bv zrpNyZ_^u`frNfPU4JQg_Daq~Vz5RhrO{<&jV>_sAR|AQ_W@kbEouGAeEOI8f4(>_S z1`$(gq`tqDxPIfK$dzRHWDvxsIiOydpUj+zMvlsebbx-P!0p^~e-;NIq|S#sI$S$xP${ z!(Zh?U8gVdLgr}#-#VN)_%l+*YU!zeJ%K%ZpgEwFI_BqBc5d`obO=1a2pQg67(B7RXUzb)5q9`_#DXPp4^vY?dm2G!KsWQoES$vZ zCE_X!pKkzdBR;%zpDt*pI6njE)Y+zH-W=&JkTTe=na<*YvmJ2k%bK+Hqz3)3qNq2{Jsq ze8~UORoR>eT%`}xU&=ACu`n=1bsIrL>k@d(0BR6f109;Z7`A^QoT zJ?XM00gtM<_uv}m7^}j|N=}!PjT`3Z{ZWa1t-=H9l^dSUa&3XaMh4E>4rJ3E_{%jQURJha@Zl-|xEAb4{3;~a{x`Y`xR$sY$ z*=&c1uoFitD|qw|w9g8<(lkW~dgocTx*2$liUvaf=(aP3r9w=PR2@DrG>9?^ChX`C zQDSkshzjOD=Pdm7tquo_*%mXK7-0=-C;tQIzk3nJhy9_+B)Hr9wrQ zXWY7wI!$<*c{=DcgN{$_ISLHw3;|9r-UaS(^il;KJCd;C^Vze4+EeQjrdY{;@MJsx z-a&=&t&(68sDutU1Xam$#QVa_;5pW1D<{pEWCps)Y}Z22{q!NATI%d``8W<1{)PxH z(c7O>S)Q)j`%NxaL6+fy+nvSo3>+*B3Nhh$cSz64>{|qIXMbOJPdPoO?)TUDt+OykF7fB%x}=0 zRG<`sxaVF4vT{GqnUU{;z0#T;GN4PrOdXytdSmx!5^G&U)k&q;6^hW+A{Zy9!`8we zR>xpFE0dTriliZHWBOhgc+c6rOcizE3^;9o)}wxUZ85ddDu}1MS*9q7=(9>!ea_ z#{*EW^q0c}0YSyZ{~0>d8|4>#3*u;6%v#5ARzkhvAu~7linlz_?$bmb@QK5LFCiyD zpW_xjuM`_mt;urmqEhUNMg}?1XmOsxwyV}!d(LFb+}`*&@kL?@8^q!(i&n@mJY2j~ zfW@8r55qeJu^)^Fa>4tTI+snF!IXVL5-QtWve3H2Rfd6+g@Iw0z@1~Rmm!DdwS!7V zVR(ze1yX8kVUU2#m#iwTH>`>WFDvj8(-3sj-lGF*Uw9mASTKpz%jKkKoR|P=jplMv z0VD!COZ}SRZhytCIumYy_9G$e*aEYI4;JRyA>bevU`RZ|WZz(&vTeq;%Eb%37b)>E zBpy+UeZgmWYNv&`aHki&N>xm(;1vX1#CT4tMn$F3P2tDt3 z3InJ{KVdS-jBOHg61U=&NWDEepwo4dLC2y&4(@mjIyC>#Jptahm5{ZSjVNQaT>8@T zp#3*CT+N`O&(iATx;vr`NOY&ge&njXa?dS_LYe|kQ>~P z*4tCMR*_J-D9^wRuK(j11i+=EvBu$-%Wg1UYKh}f0oBRa%39EQN6RLb#NV8CgQeRq z`G#yYsJxeF0L^AX=5ntt6Ew)<5eBzZz;j+ZEbMA0%vX8I%=JV>bX*kkB=EN>b9+I z2+vXgwb%<1!pkmemmX9TQ&-rbvT$+Xye-{n59=!wxg=cWK;<)!$0GF~U>k)678@ns z;Hp?^eMUm;gO>{Ei~*313oc8P)o*79_X}s4eR)Th3e*rhJDCWCb8fo|gi?TOl$z*i|N1G-Rpg%YTClSk-cD_*f5 zH2gZ*u7Q26fDHpU6Dxscy_xu1I`6L7Ao$q-Rs!Ew#B9(88HPkF2Z7A)nBUno*M)b= zO}}0M8c9!B#aVpfb&fo!PJmy+1G=;LXVxK^PgWLcXB5{nPq?8B303fUH;C0*q4%U2 zcvu)1ngZP0Z--Yz@-ZX^zhTI9(oeH`BCsX6kqg4tS-1GtbIAEfN}zEX`24t9S%b+! z@#c=D;1uKIy^(pz#u?z<>k{Bua?t9}Z6-JXl@snrs9BU~fp0EPnP_)m!n(Jo_`u1BkpZ-a;{&J72MwPjc8<53 z6(=RJdk9w<>L&74?wt*~_YBrc6F6YvyFC_C}W>{Yy)$rEe~h}7!tG(Qzt5dcTaQdsQaa0pZM&?6i|-( zy^|I+*vQ^2$<6R^zAOVT3+Vi3CVsZv%ttyI zU}vfbGjM`OrZ?R=@H^b_S0<16;>DmlOFE5{Z_GQ~12U5XbovX6oKJ5h007;vQ& zh@tTWOg)xo0= zv9E;^l3Z83PMFQLPW8;fj5ybcHyEAvXfa$!U}DI)$P2A4=eQ>dQCeSO_6;y=Pzi>M z9p6_^@42w_r|i!NAP98m<{fKS(am~duk8>)4MDefX=K-6j zAE^?%ICY{HNIkUfG;q2mV(l>NLU$v0pD=X)p~m5tX-Bf1^x2d^=cBNz87RjIR~br9 zJt4{t3UTP(imAKj@Tu7Pi-7wfYz&s09Qg#)K_{_sBUX5wQ3K2JflwC%zgxv$~nRJ<$#WQH)Md6-cXSre)Z7P?W`0S_`&smJ-GG;W!%%< z7a#G~v;h+$h%+pgQwkh=B%l zf<^F^3FvNIc?K@j|7sw_D&}ol?4$nZRh-b;% zj#SKHee9hGt{pr;8#y@-osI(S$(^0V?r~e`PT=2YP(KqiqV^M7(Tt1Xvgt zTC7+7=VnMm(kTTFvnSP}u1V}1TVbIV{!N!#UmMygh;Feq`HQLxQc^8(U-6pdVX7js zToTAvppx$2L=8|qz1v?A)UN080JUDiT0UuiUw-Jck`!oF86-92Nd=b#2-q+<8RnY0 zt>L|=$PcRVAW?8A^jnpi1ZaF!xPo8`VF8Ufc5uN%Yoj`7#1+zHxV(_r^ZaWC$ozR# zL*_Io-xYQ~YtacxIVY?{LAUZ22pljuy(U<>WtX2ooEdc7zdV6&FFaD@6!z#SFg%=X(7uPS z?_giDwKjv?7N-vk99r8zE2rBZm_K!4QU>?Y5PoE@EoTt={Zy4fkcENaiQL1(ax-AQ zSA_=#5A)L zj7l}26vK03J{Ozn2ZtS};?8p@gVt^^@v~G+aZK{P^MIw33w{>jMzyrZpgbVpa?KoK zGkBdTYOehz5(r*@4%+FwQ7LY{vXHgIg5&@ODTd0OfBHP$Ff{f-Qez*-!`HF195N!) zmBGCN(8|gaR!SS0Ti#qYJU6)vbV@L2)>Z~IQ346A7=PsmQ2Y5|vV#}cb75vJ(^X|4 z{r~4@PMUP}gW6ob>)NeB=CrVWC|2NRXk<$OT@M}jFts0ck8cFK0hjq1xN?66&|0S{ zx$Y`u4HGsn)baH|`uT345>WY=s~dwj%nnaGrcEAm+&&uWd`Kv`|6UVarweTE5c!-q z83rL11_oZxNqP^2Cf|5!1H+|T|AOdRNHg`T-+nUs7 zQtEK&vy1WiNs1u<9CPge<=*)RP-M9qmpnHG?NnF62ZwF}fo+17F9%)C{g{kEXK zql?Uj2Yen?^D=_KeIB)E!qyH_-I2`~FJ4%w0A3y9qIncll&5sC$MxJR2iYr=hkmf=s+sa8ck4KoqM^7kKx~c!N*o?DZ#7^8LE49cp3iv zKYxbJ5)%4*7`QAG%WZ%UFZsI~V^6Eqhp&up|`LRK`+jE@1d_U=Wo$2&2DX&S5w z2w#eVeQBuo2(%vbKZ{(2$TSVsEvjoK`ur5(2lXYMi7#IK332)>>Zx0x*>t2edx|0q z4-u>5W*p6!$-B489dv6O)-`!-pcOBOl(RHh@cKrMB29ArQDf$8KuWd<40Iwls- zd7>JS;y%d^+{HBo`RW=sLnl(q34vTYP5MVDBSX|lNa&hD@8SJVJVx+=HDS#l!ILzoEixEd~eehpCF7nCxf#dGmsRwlrv` zB8Xp~W_ALSb(I;o82p+o_~R_}o|i;|@9pK_Wcc?Vq=NAgI9Ee^E})zY>bWGg7%+&i zFfa(Tf$rrkbb|C(I2d9|cehi}H9qXe^kzH_ty>+TDR=56{*g zi$eZMDu*fZflq${wT-|P^9)e?RNz4%Tc>GZv#?4QxQzsw$vHY}MlZ-je0>b)j^8}v z1QiGH9$xs4-#cjsJQ_edNfJT3jles8rL8{f+hp}#o27}JL4=7R1IMTurDJILdjpt# z5SR$Qb2PAxtAR#Kz}X7AS5_80@(Sv;f%eMIW>ju;{=l$djR@?PDAe7upq*M6J7rn; z9@MtVg2p7lD~n_qCccMX9P~)9QbtaOL6n7ofk(~Y&csRnnmfcNW-~J=G6;fdrMq9e zVmEXi1?}-&@d17UJ*Y+TT^%&43>l58mJx<%ZO+SSp0n%J`xk~n4c2^DV(l4t8MF?c zImDX*8LpbhpbBnNs=W5F6te^^29|ecZw$JuCnGu?|PptdFkccA)zQ!6lhv zX10thi&LQ5jDH%z&>oBosQ=tQ@qjFNSgmA^-2U}KzCVxe(9lUfa;Oa4UI*`*2i5$W z`s9=y<4&yrRYh|iU(p4PK7rO_5#G-RIz0utpY7$I^+LQ`e=M4@0UnB=J!Kh|s_~!} z2`D{-Zt81j`0cLr`h}s;74SNWxuLBh9H0f#j=K9YK2&%_!b^1cu-wLpGST5HtCabLYzH-hS^|x!ZmNV}Jp>t1)0yrE_NP*TF{9wETR-rjbUv#cslq5*?VoT_{2Iy!E*xjHK zVVd+0j-?Hti-|zzP-$>a4e>P;k|YaXv_-K?rSla0__Kb z#|e;boQ3p1K&u>Jr_ynQS1NFX-+V2Z2+51=pgPSS)K>tlFXCoEUZKFj5ZME68%+b{ zZPYahsB&@)0f#dC5Am)5P2@98tqqI_*w`z`t*zSY{DGk%M?o1n)8C+lduKT>gA8=O zpD`46pCQvhkat(y;9}2^R$~a@digGJ2SoPPa>zOYaGY|=Zn2Gb3wU=c`~5{VkXtcl z-i4tfb{F4UwXSe7mhH9>H3o&ieg@e5lRAS03j>3oR=Fpu1Jes5@CZF@3~hE$`z}o- z(40PWe9P~y|L%~9eu}Fm=z{FyhRhflIEj_(faW~n8Mr~G;4y5dSh?w659qdodInJ2 zAg_D6mT*$4GpKV0DuWdm1Rd1Cr!+5LYpHPT%1X#7vx!%)$@KJbHJ$jS1X2awVF%V3 zQW43Zz>o-Z~SLI`Pcv&xWNpOc2OMBVM zEHy|vSOUtY4BgYUEDHQDM6U8!E)aTx1GFNH=S1$upj0E!3`8c_kcB&S<5uM=cTd+! zj=6d0n$8{_X%rJd7A>?q@o4F(ij|4kEudC8bHtvIgNz$0RyOUwJsDzO2xwLbVzv`# zn>{DPLx`$JJ)o8@%9s_nwgTsKWrm4;sG_!J%0dT+rN5d}wrViE;IB*G@#N;A z{{-!D6KxcNGvY!?-S!Uy$>SD7pP>Z$^mK(9>!?*C$*Dza_FcHM+82qhOh%7s3 zF-C-RZbzFGgA@w`1AFssa~F1Ibv*`T`P<+dv8(4iT7T|<4g+YM8#-34ky!YP!%$TP zJn{@VamF~qTEg{|{DQE+B`(~57`ApPv97t1#_j+*YXx+&3|QVPE@HJt&?47e8^QvY zG>CR{3xZ7m&5wZFz4~tIpn0|}hA!;P$;V&JIGWMO=xE=z^!UoaqSooE;2YIJ>o|Qu z&Oam%npz4z2F^uBppkUYUSgq!2VdLfJaAg>20p0)e9nUy!%C^=-`jX5esEdwASU5T z;c|g1kGdD>Gcv4akY^|ilFkIJOiElW(!(v~?qCzBr}LW4RKG6&#DodVpfdyO88jGn zF81gItrk?=e00lMY1UYwrE_F%2ZExVDLu0EUU-EEr$A`n4MjDG%9l>%Cj!qM-8sW! ziiKq>tEl5K(8~W)!6~PLF6NZ_y17d*th7*HULz9F%i(PzziiGySpDq`a+Na3l%LEy zoYT59XPe&&u3XlZVUTypoY$jK!O(^)YN6cuMnwiikgAj1cNN_&#h)iBUF%KcC%UThL%70~*cTp3?Y9eDU3>$(q%xO0xKmS(MIq%JOvR zu?3A7EC9`99NiX?mZ2YST-9=5f-&f6(}btM{uR*IZZq zRfOCTx=R(@tc>RCs6Bn?bj=;eQ6MXhir@Xo2O2#9ue|BI82B)?Rv3Kx=gG|;;>(Kt z&t?Bnf1gyP%pipj-TGw0XQ}@ucV{@8*huJz)oDmEbS?&6p}ryF$MR+~m&45mlOE3h z*Z22zPoAa-T%TIUq^3F7fB4@!`sE*zX^T0fK0!37 zXXu=7Ct$(G3z`*GKIUox6Zr-jZ2;|9G+}^@LkKZ+US?-%@8FR9%kE*r{fFUerww=~ zWEt~D#~v?v4jCn-l#;j^6=E+B{c-`_MGx9%$OIXI$x|?Mb9eQIq!_-at^nvdAn*v^ zF;@i!6$Vb!wRLtAr%%pip2F=W3py)hm&;PV_>cc2LGh8NVAg@QvTptfVNl(y++v^t zYQZNvlreAAO@-`$(s5bjGxvKacper!np@JtBI}vUa4k?}tKcyU+q(GHsG7j0kDXPr z44gb3-k_8p-Xh`^^>jPn|)Yq4Rb?1M`>XPxgAW z$sVg?%AgPd$-C~lAPZV2`EG|^V5IB}F(ubW-rRC_Wig;M1WE;q7^E3ELAA>P*utv})r}78f69qu?Qq!cNOAkfXe%QndaxGWH#_@>Fnun}A)H&0W#Qp>e+sUX8m4@HhXP$k$1 zspL5rL>Vd}YgGR+FHvh%u!wrVzQX?rsAdubWg^2})AcsRYMno^2(}z`!p)>x&w88m zI=L8N=Dl<(PY}_(s1(~Fz`zT(;~(=5=EWXAnL+0fgX}!VeYY`i$&*$N2GCr1#;t}v z7lt>%PZ;DFHbyL9Ii8Sxr_J0zaIM`NNv*5z7kMiilyowMIq+BtAejcP{sj2JA`tT+ z?GMoW?Tvs2=91(Y3nd}u%WOG0@oH~P`gPC)Q zfk9bMUnJ<#%P+|hRdb|N!z*^qfz%P)q0ehuzk|w!L?(W;R?THW%bhzf9ad*b4>f!P zi9v7+2Q+#GKD%In+<8gR32-h;LEFt#IJGJ`3eT%Js+Mh@bl8 zGn?KlyTtN6v9(K)&-cxx(+lL74>BL%;{MZR!@$I#!ywPXz>whxnxhi}CGel8Rxzi{ zeFO?`&^AA*hpCF-{W>5Q_O9MrFfq?udl4vwN`PGi>2rWi48ZJtib8syd7##n(2h1& zf5Xtvelx-Q92fFISApDVW0F~*TEGlC$&rKM#d%PhxTNiJ z_M2gETf^GTh%s822%;qo?FYNcoep07UmMi>f}C+I3t2%9KI2%Np;CBK><4|Bi-{RE z2er~!*Y)dnDaEY<^`t>-DmI2&w>ECesOXGXz*5`w{!2RePTl<=*C{G7yvRQ+J!8dz z^(~UW44&rnNH94kE$z~jn6HtpxA;-lS z?h07mc+LFWIP zH~eH76j&G-R1H~I+{k+N$&u4-A)gv-j=6VU(yC{3jV2#peyCL~yVw{q-Ym`_3m(T^ z;_81V(M;V5Pv$?)oTwNTU_(~$@@fxiau5ZqraIjfgJgt+(LWJSr zV&1;#RdZflTx(Fuv#s!G*FuGpd<+jir(Un@54PPUx~$J}JGk#{>keA|05ZF(B zF*)-w2!mvE_=IC8bi6Q#=zU>evM=QgxPQaW5NYJT^0CQZFi#W_E5(x*RHtrw@qX&p zeXL+PaNI=m8A8_eH-79aYGsybGBya@*sLhXkSI`4TN5bq@scAuON@N{hX&B?MNqMz zsih7FzJ6p~&BG5-cd(fck|vo!>nuR34r;wVASl~*Oni+I!jEbUiYyEaFN8dEuYg8M z!0MX$ICj|W)99*r$pEwApw{b#hS!g~7j;Zu#RFPT(-dvm_jZAjfnA{ADh^T6fPO~M zE@K{s#4RE(3%i>8Vz<8zhIUDxByy!-K$@rAP5zSNR_o%boj!L zrcgD|j6c)`xZTbVs`F-K?`dYc5> zx_`(nHU{egkK6Dw{1k|sAKuH&{bOPm%LEP3`mFz;nF=LPUPJ7F0lAHjVdFYiUH@}2 z1rwYE_MB5=V#rtsJG*_(&Ibyu3Kes8LFGcC0_Zkz++~{&_&)M1|MH6qmZiDr?$c;( zRZ2c0FfHR$XUdA>3&i3@grTMB`c%bekxU~ch8L%{DL;*v(x|eH`H`SjQx#9vN7umC z)SerPiVR9D3=B71XRqiwv;b7vfai&@mzmh+(O{(}5#=b-s&>eUvb8Rtv;*ss|694GlD<1-rX!E`kckRgwx>|J50k8D8Xr%1MQ;w=S76to;1T zH7;v8uJULU@U@)C^Ht)?qwXXn22dU8>n198B{`s5ze|g0`34)%Na>=+_=CzippI+^ z&%?h8vJ5ZunZiMrI!hltuq4MtN9&Ud^Zq8TnEAWRIkeS4aiJ*2u<@;jrPxyDBW|XB zlG%&J;-_R4R-9C3WZ2IjhkUN#HFLfzu@XK}9SxgbD}6Pbs{LOXR9-+^Q!iH(&fBs& z&0Tk&#;PQ-g_CA{0^bDoO#BFQ%k;0H(M|Bq43VY;?)n_PgF-v(_B}Y86!G9-LRr9) z7E2KY&}w22&f*uKHN$0~^?tE@Uzb9A$x}QGikj$^3e|Kjd zeet(?s(jM*7w@M=E|(G0&}2|%VPM#)pa5#c?hF69{*Bb%y+O)*&K%!(a>XGh-DyW{ z;>9Ak>Ygf!g8DZnK^g1wv5j+E^?DCD=4%2deAY>;cs1(3`%C!izL|9y~g;~*ocb;qmb0O%|%KZ%3ZnMD5Y0&lwQoe$z zL2koPJvur&wy=~ zT83fb`@WNX)}CdK8m5a5C&>03tGuMgb9sH@3hyh5pxi9YFj2mu-C(1%s9DkaGOg zZef8K(20q5>lPO0mioFy{*aHWs0Zf&KadeiZlB!=>7#jo#&Ryk9-FsVmZQ=7jKs9S z4a|xT3QC}qz00~}`o`xO>`oITV?RMpRDC^#>u%~B%Ug{C3ZRo-T@nNq2lh;}xz#9O zqUQMw+-%Q(FcG|;z$J~xo5Ss(RpgiNpzDUJ=G;n(sL%!7wjjd5X|?P0jp8lLiUsW_ z7t3-uCQnMa3hCor0i9)(>|n&k@>gP--158=qH)i97oYWY%`9-H<%H)1AJh#` zmiBPze+Er$vcLu{WI=bCf_9K6Z*urqdP=+3`O3lNaZyI{Y~l=^%4H0EmmtG=tg)Y@ z3&10FppytWkL-95)~o!`W%gBB$ezLjpjG#vv#dbFf_2pyMwEpp#(` zK1t~ae3)u?ZgQEys~wXCcVAI`r2xK353~c=Dg0pvAF~>>n2$?|#Gf4hX;XKKfX@Hv zW4yU=caN>RwLlZk#!ZTQbl^IexX^Vdf=84(q(N(GKxQ@ti}k%QNH9t`=;G3T@cg%w zNK0ez{Q@Dj&`57EfUc_nojJnkD;?9tso3HrDFs@&1iBTy6XcmWT{k73ds-*4KTxQ> zrY;T|HCQpDL1MGSTBmZ!>b^1smY?8rqrvNZ%3kOtpTEf0qTswHheMxRoS{>GBXhw7 zzL~nqa_?!pm~_9PxKK|`NR&aAp%YwA<=3JzOz)8G4Qp-X-UH3oE3DEmq7`r zBuy3t-An|EVkXEqMgw$Y3vpW)WF8pOmN#dRWKe^x|Gxw(yFg>{Zby#dGO4xN~fI_>bMGln1z~>UHFmgY;$!M`)vQ}E9l04`NshXJ6*I8l{JU|EZ z-LqF^NIb%Kz|pF}rJZpyBe$B870(LQ$?BivHT0Tg8=5Z_@_lifzCxKn0o*T1VG=vD znYqBh_2d(Xl_u@SUY3S{j0ywoshPq8ae+;Et$~%+o-@Y-(^q&{&r_HyFU^p+d1=7A z2Mw&B-!RB@sDEPWyt@Kqxb?gR^FgP1@_5_~TEVk%)54oU8s!flndE>FL*jyUH$b|C z1!dVfCY>z4dRPbQ;ttscW~+Gbg(lO3T-q6B{$#Abp{8ShOWSNOPZiX6?59Siax zJvQ)uHziOX0@i`&cozl@+omO$c26J~Oz;3Q7kq6I^!%ID<~i zeRh2+JBR*fspDk<8&~S6>)f5x$^+fgIcbIf*GsFcm=~KKgePb+uYD^H+QnsfBkK;2 z7=tAQ4#olsn9XO;Wt9(w{^5i04%K}4Bqx6z9NhP~L z>q83?%nKwB3pE99@DuyHchfddA-+vQEUp`LArFHxXeGs@83Ko1XiWx{TgOyRdPzeM z=icS=bosmDie}IpY2u%|;E+ZQ;}XysOM+nxapjQ}KXyC2wDf>Bg7Y0v&-MzXKko-m_RQaB0#{=MM}Ph}|8a8&r>c(CND3 z?ftBn?Y#vHXjT3R_<1_4PLNa0cexz>pwo5YfnLc8w)dbN_y6uZ0YzkqKe)otfV9Kf zkk`ntfYPBYsNI1Wi&BKIsW`MRP4i~#iMZrL-uY-u}hx})>rUM<4%KC zV*KVQZ}h(SJp0Tanr6`K<@@~ncrSV=lX$-my0ZuE<91QB7 zFhxK>zws1TQ_++I0uh<#zP|}E{T)&C{cidGbD3(oGmef1@SEXvA|GY87g8t!sg>Y$tVu)ZSkHs~CI0Irp10--BMKL2bN zS29o$-El?5UFZ3$52Cl#7?cjT9o6bE^SLE2rwd6lV2=7hTeN<=Lt67pmIhzV=>8O(sQ~ILVQbOyKz2L3+Feb1 z@t+G6gRu51qBlus|1zizE5K0L-EyD*k6z`RbsLrKj#aCJQYiG6Mgu3Y>3*S$bx--X zg6gDr2B`SDUGvLUF6zirx)lVPfvjX#TM)ZSV^Q?0sV790LHePqTQm;8+>s2L@r3L2 zo2qp;$8$%4;73Cy@Td)F)ZviFzU5O_fi^sY%LVX>UMGB$SMk4?7O-(;;9teANS4MY z)lq)3Pae)WXbnoo0xs8(Z#v-vja_()x|S4o^q%0>*OmpfgNvAKK0sd@rW}=>q6_pgU5ngt&Yy;S~D56EAqqTi?PSzey()5exop{kxA)C zbMMlwk}mtuFxeRfexNgBKNPbpPN-F4&|+a=m_CU`JL@L=0K|))tTMjuAN=vW#vj3% zWvK{0`RK!Jg9$(Q8aKwk&c4jpli=`VIScY`0)FVO(M!w^9t5$^@#lujZf46Iocb(# zgUW;Rps_Cajg86m6f4W-cV17K@1{tXXAwcm*XWmR|1?){9U0V zsQ{7(-SP}MD;2at57ei$fVQbjK(W{&&}ITERhjtJW^EVilDzapCsgF3Z^?A6t`}+w zkh&7Q7n+k{=f)+AQv>U?R3J5^t)oG=0I0R21UgAU*V}4Gi53fZY{?3m{%kHhcR6xp z*ToiF(78D_7m)V+fl`Z*tz$YkIT%=(f!0l=#Pz&uV6_INA>s3V&pTFLv{nGM<9IEu;%U50B*wHm7VIqqHXdljrBIft`ihJG&fL5C}oIGZ%`oeAM3Abn#$m+`u@M(Zh z@nEaa-fbM97C30N=m}7L{O7G@ODAibQIOH;DQ=ep@2K`)HZ41Hyni}l@ar%QpAJW7!NWDL=Puw=arNMt%rO6}B536Au@Y#!m5HAtE4Yp2Zid(LRTsq= z!LiDPx-MP|zAnCWG3RbjIR>e}K=UXO;M);EsQ?-CLdFaHObixWmo8EVufo7quJS_5 zRXOety1({A){SA7wGa_i1|1d#h7?yhU2A9=3=vO3ne~9)0=Y6_#cc3;KoRf`*!~03 z%e(HgG3L+Fs$4u#OBu96h?IM@u#GP8LPsK|Oz zQnRYHk8}Xl0rd=`3_lr!f_}-zH7%T}zlSe&^(Aiu9Ujn}&3^^~20_ql%i;;sx9_^h zvF^}mC3#Rw4_2acg?w8Y-PE>@|>^_A{t52s$)fX-aS^DFB_su4kaI zg8iOF=qESjb`~9f)9p(pOqUO{1n}=ET=k^ajgK>8URGY`-7m91 z^Y=oak#;p}Kd#D3rlns~QeL=8Gl6fHDgw=>n;03DES~7hG;R5;=p^&K&p>wyA+_i7 zq=F+%TdR6>_i((uboxi^r-%k)aC_#8oxl}lyVh2vFp~oohYBX1%&Yp#doL1nLV|FG z!<(O4&{6_A@7V;(0iYTdy0S}aj}AYiX1wpn-Nbp(^w4P~&|2Z_Ti|`8kG{9@tlU}a z|Cl-X=7|HE462|~jNfIu_S>!cZ7H4+4(_(6^Sl}i*$)_t2K0Z-O0baRak;0+zz;rS z8GMt<>4R@9XE}oQ1|jZ3nbUpo=o`yj>vA$zM1tc~73#_~@M({!bb1H{1cJ) zz%y<6pjjo*n$`FItVEBq+6TYeuoRiIZ}SL&xU?Zxw+e7&tk7>!8DGD}nRV<k-rOcYx1?Ayo1NtzO^^#)D{7)4zCB^h4iZ*t(g;wZ=G z#Vxoy^g&Sa)f9oR{sw_5pc#ck1<fzrc zrpYsIkYMH!`nhF#SG99n^i=^tWOEN(%ycU;zuCB=HOF%k4`}=}Bpa(H1~DYFp}G`z zX3o*Up{H585wxco;j5z;toACVcQS||nbYI7%j7}Kj%XKEc_dM3!y~LKcAkEQw9ds4v%PIZVKN6dO6<4Z0~Ou_s?%}` zHypkH_8_<=u?aK=58ub7l&LG^Q3biS41B#Ic6VVvKS+kbfQ5l!X~L>BT_F!sxcxAf z9ggc}30evoNr1Q*?5gNUB{ zvdx>oZ5CEgkKGY;Cjj_#C(w=V!OOq>WZf9deokED`j=ngi!BAWOUmkk>N?PfP-9+; zUV-D@jgOBov9hfCc4pD`qZ|HkG#r&km~djbDtM>vmSvCbO?bG?W7T=8o}=XJmH#nO6EFaO=3|*s~ih;uks{8gF_gOxxJt$MQ;$TZju3qL9^A?4Z$Ml;zkbP^TuJ z5qvUV&1pq9)fmt{B>Q|px6m*tGe-1_^K|?XgN$QUfoe3+_zCE=4Xr&opdABD{A#l` zyg2Hg1S>$sXGK75b_;)Zi_(jW#TZOG|Lri++M@%yod8nLUDEg`F*&&JjRODthe{t- z&vq?onB~In2R<(;}~jVY+E0JU2|xd(OD8{}6I=7F?b&&7QB+I9!$S&zKncBTD|O+KHio!^1Z zXscvbd+@!D=jD7sXK&>6&fmCC&6WThz^A_F~hl^nB z5~|@%{5{QI?s&FN8N90iIwEr}cHPm6xQJ@aN#dYB3uvX%KXs*h>;J_`Si zJ-7uWTCG4SM;>(Ioejf;hmGfv}wV`zvmsg zqzh_Bh)7RJ5U&NttQ0uS@s%u|!PGM|`SS!WrTDGae(hNNwQY_m=#)1|&ORfpzU7jU zdT0yRqOt_$1D#?@23(~vpi{IG5&3-!tVQMvZIOX;i#o*o2NK=BjK|JwYk@-nv`%scm-iH=SrH3lz#^da zi8Bn^|1g+(s)BM2s4og?!^trivoJ8IIT{w{FoE`Xfc9`jIx+GIIC+|D9+zVPjX*;# znqTm!&&|{P<#Z+)hBXiSrqp;H+yXfzm0_axlLNMn*FYPHXFLL(^9b1)jCxMp1G_i_ zg-^jC-~YSgBF$CMAmFv@qyTtd*PkYdt8Gj&3N4fJg8H_IJYZ0qQZjj~Q|YFv+iUf~ zCCx8TsBnRI7C5ZbY+q&%ng@Wp%i+}?kp~P3yyZ)t1apA~=lMaWsUx{ch@h)LcbkD+ z#o)EK9<*ZsboMgHO$|Z8U>8lP3JsXM=3d!rWrTZRVF(UAIWBNGb2DsQx@2}qOfkD9 zn<@h*!%dI5JD%|s@qkk2eFkahu7<-a3K`grN5)NLXX}_=wEL=Jy2MY=C?qIdSo?K( z2Aq+Z&EPEvYO6D(R6JmRvB$tvbCP(L0%+$NXr;*OEB&`bnmT($#Cty5u|0SPx+arF z`;dipr|iE3@mfBRPBoZG?Lwe+kira!X*|(C1sS>xFC`v>)Sspd(hMfx_J2O8KlA7A zMs?6WPw>faM)N`A&kuzw9t2{J#q4{xxwm^;7E>Fh~3bgcJb#FE=*?S7Z^%x?Uh&f4>d z1GK~8S@6TuUTN@36Io?P&>e?c>gLGpUk^IFw-tQRD1#_?Y>|;WFGxjyjXzt5P*sfN zW(isF$iB$q2G(Z7dE(d9nO!(-K|^e^3^ELw83NCrlECT6&Bvgb`i-U|6_|S?4wH&f9DZ4%MG249q z;vS8p#zi&>2fM6)2_Agn@LmOUrn-o6as;@zcaQ;{oNKhd>!MNHQ+EcPV-gC}40FIN zjzg!F*cduNX1B94Jd`)o+r$9j8)|^ZoZAc-I2itA9&qQlSPVLwIN9M@FsDtym*4#i z5oh?y`9QsMgPTxy+e`uXv~7<=d;0(E8`&qzsvlL+NbB=$Pz8-;ra`KwiG1+t3AFye zzLCAJ?!O>I_sxgvKsSLP={xHTD!KoIPTaLqy}RV`Eb9{wgD?47t=rlB=dK*+EKd(m zS-ayIA79dSXn8mll=Y6AmQP3y0J{V=k27#ffm)2Pc95XQ+$TTPK5&0gy<*jMQBe*Q z=NE(2*X?X>mY8~g`Qm|wYb%2`_;ppwGnlb3FgUke2+HS2HL;xuRB8w^ByPFVnf*?I zUAOenEb9~Z--2cX5_wLjfw&eOvB3?@0k0NhtQ5X}$Fa{*5u}HQAyN0(XQ%QDK`Qz# zpjlle{#!E`-BVN7R+_9^m>u1?AzHSmZK6CALk1&gFXw>=77s+s+0IR2aud{K1Z`Kb zyBil7>Jf1)?e+YHa-ikvDyj@G{I_dQ)zb3SY20YGWz(dT{H$}HY|RgqgslHKuHMko zXuPx`@E&;Q>4JqPZd_SAcawv=ZEk4sZ@H78em8hsBR8lFJndO9!%#SM_m_X7 zenw`t{NbXaOGy!ar;;LERFoNnLHV+d=d{L4wcg4ihaABm!@| z2vui$5~vP?^m+6d%)#qFK&SPCTJYFMp7|lI_dG3~K(36W#v)KF8v80W%+@GmM`^zX zYf18q3kp-1W{GTEByyp=5VT|bJ_BS$nrtpdl`2P!J*Z_O!4L>)mHFqS?Oz;~k<9Mp z+_3dq+k$Y=`hc4fO>r;zZV7xj72<7_aPX|ams7t4e=T7IwMId;G3Zo|?a2` zi3d&9@PTI#kZTq(1<+X+$>0P2x+OrjGE8#UT=4$Uk<}0NAXhtx-6{=M5@PswXNoTT zD)ujJ3&NEk@s0h&&_El|3c|M%Y2a~gF$PQUV$gD)ZJ?_V#Krorm}?|VQ3tK?p8+}( zxj^UA+qC($kTwXuUIug(GM`f^d&D*AB6U>;3vm69JvK4>4FU`kIi~Ku3A*IHU;jsV zdV&II-d2p^qlWw8M;g;Nfv!-Ok5|&!eXe>ANbWy_Gy|xY#I6$%l00MUmXl1bUoDQt z&uzRc-4xdesu2Pg>9;}Se?KVxA?bx3w8a;^Lz&pU$)Hu2p!h%jf(IP;e2})5H-AI3 zw`_r(t|&vIK!NIYP94r4it{2CEU5xdUxMQQ-<=ZoiA5K8o3rfQ^sOzU!eB?WbBV!* z3DcEq{pK=&#;H;^It1GK>4FZg|L{@u6zF34J;ymGfm`g5d<5#xgT~}QqX(RjbI~`i zHU`~R1iIZNq(8W2WpV)M?627%k5xeVkeuBPT9?kmzf6c{nodASe{i=F;v9PDDJE8+ z_Aj|PgM*=R=Ztgb*PU|^hMt4|zOc)n)JIHX)p0EbOBMzO%|poNKOy^t2R!$&?lNe6 z!(S0Jv%IChBB@bmUQRwoRq9*N=G21kZ7&iM6!l%J=2$7>4y`2U>=$7-fu+O1h1?H7cAc`TxS%fhFmuI zB)9w}^yKm{GN84DUWZRq&zT^w7<>Z()A5AkmK!$i3O!yhkwZr7f->j~jFFIbq4U7& zdL;`=CK-WeQ9ySPn6G!$^h?-5wE_j9OE0aK^#g_y8LMRh@jm05G9 zTKNWdfY$#9ED+n-0bNfcyD#F9iiYt{PsW*_I~jyP=fE`RPrH!u1-dd>R1uU*L3>Vh zHoACDT;n_&bZ+r}20@02=f7=QETOhbp>X4q;Js_qL>Q#NVvk)oK9nwGcFz2|Y1Wqn zlRUPvM#V{rTwpoo?UDsY7J_OXTy-6^#j-B&k|Ae|#!nM)n1IfbgM<=Dn1hKS15YT0 z&2M#wg_0n(!iVw1@(0iVU=1H0P?%lNcxmzKg1xdHD6~Mk!M8Ft3&Y&_x3u=23Coh_tIhAli*z+v`yNen~p3`?`>sUR=lL3?}zpu0Zj^i5o_SeAoPN&&i43A*o-i6P^lBEt*+ z{`=v9mnUTm?zfWRO|XFafa`a-ezDWLlUSM{#2ci0oxbztpc1;b}j z%B>E$L*tR;*Jik-H%>r%ntL{k#vJvx;MrNw zfD;4g{1?cMs>;VVctVAO1B|EppYI0k1O0PXQOU{eKV#5jCjlAV56oB8KNS@%csEOc z{gxE_;y&xv1!5Op>oaJARu=q8D$$Qk*&Q-(;?euE3TDSR_uij-v}Q&T^n#_>MVqdg z9+w5()d5+lR$t!HG2vomVixE=C)ZsY>?XE@Zjkf<)n%#&U(7iALK<|vPcmp-u^s5{ zij)VS%MczkNdzxvf$j})JK3950@~H|?@kH3i$O%$e5b63wtl(bM#8 z$qR>M0s$Ka9f{UcKAa6z4lS)plj@E?{;LQ+p&8V=yk@8YT21jd|2*TPE0Dc0CnP|9 zP@x76w$qTt>q^}=Rym$!qS_30EDQ{BW+I^8C}@v2^4U5(kRFN%19YTD9o$}R+W=bO z#B<_L)TtR(SMPrUZCud?-Edi<5R zBA}6#4GS6A3#3f?_zV;dF{LLg@`ISVfI*I-@Nv^^i*3Q4K8#x1Rx|}qSvki;Ok&c< z#*J(K=vAu9f<`q#caa)e{XWK7rxfxaJm4QEw`<5W;b~V}D;dDI0zr3d7S7%5qq4yU zGV|`gVX0#$sLw0W1WQTAhd|{e{&pf4q>XrP`I6Z@Obi*I+9N-%J8Iq>e@}BsaLJ_t z-LdY`6mApOF1qL&SGT{Xx#qR#fR%OPu~Lno^MR(QfJ!ycxCp-d3CWG1auuEr;WIq2 z9E(^L3s(c5^MS4Ty7xH2_)EPixP-<%djmQNLM`FghB-4-8SGgY815M_0?)4Do27yD z)QvN&=jeQ3R!{-waaneSmz8nN=1Y$$9p>B_w4SN%!?G(8DHe+2uKPO{8|zDeRn1kN zaic@?QR9Kqt_%0IXDi8Z1bl_coOJgzkNh_?QrO4S{N;nG3Ug+D1@!?1p{u~6x^67Z zs^jUNs{v}&gVt?Tva12<{FlTuVdL&Z!HM8CGTflPIdm8teicl?ADyS zN)I%)TI^v-T&c3mh5@u|kcZ*sohc=g?@6Quf=3?jGjK8(7DA>RKsmskL69Nf@R5xj z(ud!D08d5y-fat>8D0b$%Zusx2MRRSrw6%@Kb@ne4NeazK822)&2>mB zf$RpYfof=Yy`2A(a9ZEl{zOa5OhX;@R6`x5Ns6F&2Ccz>4*4}cX}D3b`#{=UE(S4% ze|JibZ0MPkcWH(?`w_8&FTuxEDT7whiy?f&_iNdb*vsJo!K_M*!1-^?70&FD+i7pcCY}LRpjH zg@0@7;&92p;@|U>3Z{XUHy!IxloDfbWMN>KKPfLrU~71h@UatIUw&^YZ8QV7D!}Jw zfPDHvL&z3%-t4lD<&wRhm&Bfp`S&2)yjvL}Cw9iQxwChM(!4a2bCb(Vi+={QS6b+R zc1M5En6y}L`dT;9u8PtYJ&}(l$#c}-Wh1@brtYFCDBef`?l06C6fbN{>9xC`Dk*#*mwgsxTO8CdiGI84REd9bi;cZ z^fLECCvDy0)z&|*o@G)hX)xR-za;0OYexBVWob|ivMlLfjLD1}9_(*HjouAErj$%x z#P_Mdf)ne;^2OMI$EPoP|O4ll0saD;+ia%Q6@SZO`x+$LzHjK}uqLk>wR zBy!i>P;N1pF@^b&AUnIC{iXN>D^VTL{kbov8BFkC)OHh|DO%lPAnbdJ(a`h!!A9q` z%n3&`lr|^z3#2Xb+$kDoCIc$-Kr=R6hR=c*NQqx_@i4K}+~F-Z_q7Pi8eP!ZZ4y=` zsxUmvwoJXD*Z0G0HrJO0OJ;vTtc88XY`ODO0BWKFt#SG=nUU#~ znU)v-kt42KCkyDlct7=lhJHhj0Nk|LqV1RULcJ#nK}EzFoLLwcKyJLu5phW`)LW4c zDgzSZ*fH$_c=Zs(l}4*vUvk2?knPt{aC}mb0pcfAS#L)Cpw(|FzpZn zvW*-&QdM0il4p(}l4~w=%*gW$JOXOx3a>M|c~tPe1A_`m%o~)STwFZ2NusAP;L_dF zb4C+4%rdUsAgv(B@bK|_J_gBuS0)v3W`j06EJTjg4WK#EBUM=(JM1p`eiQTjTIqiK z%5&M=VCBnEha4V7ZBvPG-xS+$~Z=a!>=Pg_)V2iy}RT;Y-QWtH-o~6wD{j*^m(Z%RJ;<}a^k9k?`ir)yB{ zy^Chxcs{XZn!$t})1Ylav^W+a&yV1`0lacu7INATqMabQpkujbccP^xxB&@n>u@sM zydx{4*1mf)sKs=j0iGpWR zlHJ^=m6`9w99*9#20EKR&}K&0lNF~^R|mE##mO$@cC|Sx!LE8YHbPGF!!xeD!=Q6& z;z1{U7D_X?vM?~5np#$P#j$UllN1?# z9++x#ww@HWzo&?W{LFac)>lVF_m~$}@be<5;i4vU>K1+pd4f_gSfc6E5 zGCX`7v|dQ&&c=X_Ns_&@zno>-zbjG(H17^tbw9JO^_(L6k!vq}re0{B9xKl9@G*mm zEq_tLaVJHuG?Tnb=BIxx`yg)tn&XG6=Tl@qaxC_w!Y;_IG>MMw*~i9rKA-{fx|JALK6^^Qj#3yV5Dxwo<7b;P8}&6AEa%$jvGeQuH%W8iKL zP-=n9BJnaz)L7TN*uwg*u#ZTs2m@$M{)~)!9<~Qv1lwINvI~G#Fhll-2QTV4yyyip zAA_Y|3}k`6#!EHrMH~#4mU^c>3wXHL8E&fRuajx!V*uS&I!$^97o&lk>fI$1H6A5^ z%N3Khnxt#;3~nq844}OmJPe7sk2cL=ai6_IM;&x}_Mf|kD?lrMnfTSJ;u4QOUE#8g zL&$c$B4}TOuq}U4!^gS*<_JK~moeH8IuX+PMJ2Bkcqc{Wu9v%fzSh`+7kx3hyp!$T z(YI8I6I^17gKwt;-x~ulc}AbBj?(u&*C{V5c^SZ`GQjU)EmqV!ebRGIVWeM{Y&Yoi ziIPu`PC2UUulsXX4l+7%1hjIgMZgxaK7$i-dz9MUJU)>4;a$lAh`IfgtFP{^UL~P> z??9?q2BG|7U-QBYPZ1r$Z`oaW5hB(Y6NNs>W`0kYz0+jB^d z#I}BWI%o}(#}v>4DBbu|^#Q$!VJo03jgA;6-#7(XHV|`D$>QwM7Yg7NNO1ASCp$KM zENhIdh=km{*|esqqT$0P0fx@`psuxMyX4_8H_&JWXbsUZR}Tg`xD03s=7XsU4DKup z3@;(pD0e4n^Q+jdR|KhUF>nFx-b{7?nfbs<^{2*5wcn?V+Sc|=%G)Fay3?m~ekJHA zkPjdkZ8gy8qBD7mUT`#g1i9Enkp1!EC9^?^EKETdw3=$uodc<6C5FFFcHi!?bEvq< zz{{YSB|QD9ip8xXsg{PIyGJ#Xx|7d?c4J;DHqFzT{xNc|eP!WpScFM~S53ihIgRN! zT~s8L9y4un)Nv&R21y3Zc}Vt`=q&mec*$4F+0Ia#fs;W~E?Oq%V|n!l1~$;@suz|Y zaILO_uBK7|=VM!T1|d*=b-v9jjiHzA1>Gw&rLTF?kpMrH-)s1xEdbQ~CI#wyz|#$Cs^eCLD4M z8%21&oCBSXC+Gm00k8aUsPOHPwZ}HfN-)PQ`}2@xaR9qGxNptQPmpUxgYm$U|K1J?~v;o!fC8x9$9k7cVZHZ1-@_9uXm5(77J!pct4^CE8PJ#GIu3 zNoiL&C*Pv#sSGM*$#Xp8TQVA6EYP2Gx%QembWZ}S$D2Y>sC%w0?qFy9@)Xc!SFB{WM#DiH>iX$oI8Ji@8;K_ zeQBJaTgpK9Y+0zA*qf5 z9`%s9O3aId3pd5QvPE$);`!(H``J(naII0Xt+vE`@`SV)+OgTncl z_>mb$U%ZQWAyed#!&v+9LhE$U9zD)KcQ-=r<~`=h23k3ZH4eaey$uu>usg6oZ7hTE zl3m+cOee|ydYvs3mUMt4_NJ@Zp#s6wU{E_P9<4nCS$iW2zCGmi^N`-zjf!Hzp&Lbv z#9ZD&WB8s#!mK$_;2`6Z5>cPQ;avm+PZqUpMYy}i(#Im8`b#LO!kh7jm{~8!>ELQ-n z1BZ_DodK~`8N5K}KYi&~d34r{vs@t4JUrQFlV70xt5XwnmueytKVfLB}0Y#F%s#BpC!9kXC}L zoHuWbU!cG6T3`ov3+PjM}@%~b5=~TV9k2(xiA%O!Zff6n#ecEoOEFB2`zrNrs<)Q6I14U*#&CNE9#rR zawK1O3%{wrpawtF#3@fonD555n@-c+5>{B2hqb9(e9h7F$^We7$plq1(6}0CB_C+i z8g(y@BxHXIXlKh(Wrky*+WC??gEtEU!^RE+)w?OI;JpplW+|ZezkqLgQSt$`CqTCF zGE_n;`=<<#t^Zmwfa*gb&{)`%lF3C3M+_D(nZ1TZ2sDDZA2j2=bH+LUx1ifh)Y2#R zPs%e=fSogYp+n(i#0!U_eHUl0vh2F32qEEIISwDCg3@<>~d;!R#NCgpAF0?m}5p8i^S<)3~p(-se}5iAX$CGIeo4(=D6B# z%HjT;oM#T&cVCZl2ay0GjGx~4;iePB2Acck0MCOMzjz3~{Xm()a`VStCigZat7SSf zc4{tKe5}>7>!PoqY_OO&h`VUZGbQjCTtR}>R({tKpGbq^U>A2+{no`2cSSB5rf!@v zTgghxD+{!b7jxynM;* zk`JduHV2r4dWAWK1qYfy8w8reuf1Q9wh2D>Q4jM0%oXjk6hWm4rW-D+*zzc#tG+dB zA_=N*;8zWri-MFopuCH@3Kx2l6X@)R(p4gBgk?S&YJqb2egvIf$ zX(RDS>03<|X#N1nz6+PUSUEJLgO?`EE#L;7sfCaes#at0V_{&}$DqZ)k7Q!i)eWxt z3>*xk@0{jfsFWyZ@Z3IInFBNf0_rn^PYmIPwDM0EF~9c*?NA4uigvRReP3_65@>~K z0Vp3MMnOaFOzij}u@^FAx780+!WZ0IImvw1a#2C~!!zD-9ukyatOXvUDsVpb>_*Jf zD^jzQg<~DmnOM`*8zYY~SqZLi*YVH*-9HaHAtoMlzQ(#k2B1+7VbJ*Tg5)0Vn67H@ zE(q%*21=mOfXDCoHc0Q_I$Q^76LW&cRt@%Dp05mTT^k^kBe-&|Aan)6VvoLEF=a{b zH>E&U>%q@`cAqFy8rgS=6}%b`asIs&!;4qzTn^mKwRpAH=j_|+sQX*;c(!ycyA`!u zjh*2I=v-%}3I-8|7g-3`?d-!(wU0_Zu3@A(Le>oN8?O+8- z3|SrTBVW8?`MmWQ6hM23TYevUy+E()67$0M-0Phs9@}It&+(cUcg*iWGMgHx2GRuY zi0td_y2QMZOJK^i8#1%u%01SW8XT*<)F-Ls0=|6=w2A^(j7Y*_kY52CuNCE#Uj1kW>XRSnVw5y`nntd26Z5UGCrf4GR2V@tgA} zx&&X;5U?l*?Kq7Gw-G!cW z|7uc(mQ<+wmAxDIKz;z7ffnfma_0lSc9mIOZc7C#jc4r}9*Tt6%RUx}C zaK!<54}taPn{WP{UTomzmea<`23~Qx>^mnz7}!}v;8iGcAph6H_N$cZI66w61GkMhL2gf<<9Eaj zw4-G{gEXiQ1ziu~)*Ic?g>Qr`;64mJnN2i89bATeC@Gn~ zF}zOef@#^Dhy@KC{}Pf{D$RZ5KQ)wHt;bjmw3AEbphm>~r78!zqP87k)YZ7-z`Y{1 zB#6=dvb9D1q_50jO;LWJb@(4Zvy;vVI^hqV$;#?j^O{KMO9=eb1fSanDvxKJJ8!SZ z5Xi#70N&CKIspr`(gep&OVA1?HP9Zj?Yr+BU}a<3`ocv(I>5!SD*s|hJ^N_+U)xyW@E z^o~LUC$ZBRAG|>0ec-;0%>$z9F-4@BDy@0;G=W`53qbBvTgZOs(T*Or^=ph7L>T_v z3Awo<{8d*E+xjai%ferEbwwJ|w;luawW0UxoLg+*p~$iAgZrb$-ctGquzkWoj0?1xaFAscQqhm#+ICuagygD8LmID z`wc*w>?VPB)Xg?%f5}j|2$FhVfK#soct#ahtpYuJw9m{UZjuJ;7uR&(&VGGKP;UcU z%E1;EpnYn@hXUxnmk$~_56@3!QTX^#b=L=RbxtPm>Ne2oe{Hh9R9|YQf#_Ep0aGJ{|1*%&>b^OHleVoNJK&$xpA?;;v&f*A>Q;P5W zL2Y{Q4Y<&I%y@SSRX9k?=*N~^V*%|lOGLTb0K8)G-$dx$28fXi%+;?Z3?VEG;L$GZ z{Z3GP!%ik)TGxE=V;HUw#jI;#VT@R}Dh5tz_Ogu!KThj`MAVY~R?Og&13}|(=ph1~ z6mqw!F%0Ql|dHNY}$M9<0KbN21Q5;i~@xRW+-BBsX$x* ze#a%mcUbvc&b|Xa7Y=*ggtZs3mSofVGONJ*JHTVki}c&(mN(7{|KPk0Z6Fwx0zYXJ2GMqcqRL4QB}#{yw$h$L{1!%ofLX9B5U_69MHr z)YE{N(e6$Da#Z*<+P%p>t5aTX0o|CqW&6EZ2X{Ct6Mti}Aj6CPh7NaMZLuFdxz0ys ze0adeAkHw5wrF;~58txv8g z*d03&#}%FZOahg4~$4X7i=Q5aH7s4jvfo!l1U4iIJ!3-T&&K= z@M8VveP9b_x~%X_0j=!UWO%W@*Gp?!kdnmJ(75xbLyovdJTSl5Qyma}GkH^b=s(VG zu5)>U1unl2gL{eM3@^MsHgqS)SI91XJY!?qMVTYV{StnhIlv&m@M4veJA18$^bO86 zT&L67vhE^ z6;q`c!dVy?I;_C0H%I8s!angh_RFUGKx^)?msZN4y=n%^ala3}esCe5DPsD0jc@#? z+L@-G*En{a{pZ=P(=F#a!1DoI4240`o#2o%1(ltkm8*Kc74}CK?gSm2^3!6n*+d-! zl^B`dhhBRaIP7uwWO2_Pv=0Y-K5#FWw7k>o4__VYHa{{lRcC*-u5yx=)6tu{OnpI~ zK90J4`jwzF;y`LESibU!SIl)e@a#s+H?aD*66_^=)ZRy`8b0-8PzAM97*a4*?T#!u zZn5C8Y2|tF9wKG%X{k$kD&BIhZ+70#nZOIWrRdCY&cDJJtG^j+01ba^fZHi6mzZ1g zA`j&CaMq)*158hLT;KP>%HqpxhHIb|35j2tKP_}PWq9M5<4Nm}&k_^VKNuRb6omAH z&iyogv{io(AKzcKhN(q7uNXu@yI-PvAGcngsM5beCA*_nX@zVeXf;lIUi6E{xi@{}oW68J z#B~Fyh0%u25uU7|Q-7K?7H#!A0*V%<$HHF~8D8*zZSX%_IOY5aErG1U3eJCd;eDSZ zBUzi~9yoqxjaI`^P%dHwwU`+uJT%wJsfj2}l;sAM3qG zGl1Ij3=Io@OQXt@XO1irMjJoA^J?7M-4{$RNb9GE2tz!YiI*>Zc;} z3(LA27JrsyxM`yy&$UDb5`*{Ox;>uJ7^3j!CMS;&e>h9MGk{x@=1s&jz)H&@#ud^Lm_FvC=lj$tYc3e!$- ziI?`UwBUs~;~Ga$on6l$4>=_Sly;EwUoJwG0BEnW`dfhmfjgNFg2oZUG#EB2!HX207B(o-JG%#N&(mHFk%@OssOh3y}$LQXyft-k^50+%fCToC|m$$)Y$=oC|i2@eIY zSjRjl6=Iy7Yz!@_Vnt7}KXq<2VF)b(-8-^U>iN-*_ne;dJ-0~JbTu13NCj1m2@Ih7 zI{ z8S}Mv+|mY>V+&#Jn>iZ{>_ZE-hJ)HSs<54b0YWky`3HZvSZW_!zu?bjqYv602No*L z-^P(3qIFo6L5$&r)<@HoN>f;w_kO;6sL;Q$p^E3n)H9&n(%3>3vrh#b?^sdPkkubw z0$JG$nVmzvr6!F}83hmFSfAeEn?#Ijv?y2xFYz(jdvuJm6^S`)G1$EGx z;h5#1BaZL$>2OZ)m~-*Iw&|?}-YQ!e4f#N)LUAoI5&8H^nSq;O=VFhYFW%i)us>Xh zfrlZo>0jJSK8LNx^{tfA`-tk`KH@^(1kVH8L7Hm8=e!)!2-36qU1)4@Bj4c*q@gSVhk&fDJFL+TncDk;~&UhyyEjdt{(p@|5ZU_rRp!6|20OqxU?_) zs5%XF|EZ=w;k+#q-4osnP6FA#SPBrop^)Fm|Y2~txK9;U2 z-E!v3^4kq+7pp=>KV?97%}KbPa_!&xOgB( zvAYUeXu7IY8nu2APi65!N~C`A$FrvRkv zkhLCEawLLI3joh7flG;%8xv{{rABhru|AzYy)phi zqsxPUiT=?n23%7c6+!9`5?3PN8)ZQ+8RQsZSr{1N8L*WPpdLST9td&YF%dZ*RIdEQ zQ=*`k44e$Gu`nL+JQrvbXn7E%#6ZpYpn4gy4inS@o6jH)8%+T3oP9CBG=uR0B=$^ux0`rajF_Jg%fnQ=Jhrw7o+AHQ~bz^k{%W%hBy`m29WXvJiH7K|1zuAlTQ!^iPbKHL=;Bq{`#l8Dq+)T55 z4Igrym$MxWRm1M8Q^>A@xQ83$PH1Ui#=y_ed7tg?UZY%}`+SMN+SciUZzU2z6ag6* z?`vN^1};jrfM;8dxn2O@zX;NGb&~pP0hi;!F{?{fX)apqTEE_B>ywkZpffg=TMV{f zcN0oTLEHp6KT-@di}UBMA?QA`hswuXH9$KPs`Qp!X75hiC~Rmc1adj(v<36#$4ljw z%WXb%S_!l!|3LFfmgd>u5yb^^lR+~^Ee12G@6i4^vec;#n9N6bX!dLe3UceSj2Xx&-*1bO}(st}_3?B!1&pr>4{_@>R1=LEDz>;T!SNfI)DDp5QGSqcH^^B5bbI^vQ(Hc=w&a&` zEK1gZ#F})x!;fu&J#r%MMxZ%^6TLr^zc3y;UB|Tq7`c;53bE)wh~5zssa&xt>~jI?Bx8@+d1C}}i2)hJcP{vS}-UwyzsL7EnKvb`Lg^$ zFSbVuLnBrk6`w0upI#y6>QLMu4OuJWsLb%9-;7~N=9vo%*ZfJ=Ed3BC_+jPMS66f& zC2t90e=o?jdYO(q$h55dZmFy8Kcm@rU9~EHOKRk&5oFNL!LncpUtT-g((UYsb`iefcKk#(o`e+lVuYRe8@N- zt_aRs&@-?>XZhu~O|_aK!wt&oy-yD8j?3JqjFif_7H76t|@Hdh9AXuf1-U}H#J^T>+rEDvmNmzJ7>o1!?V z^_i{0e(x)2V;8TI-24?0M_*e_(_#=~c$h4DeW5Rx`_a|6KwDH&7J?1|X_NuA_S}xL zEau+>UbZUB-P^S=#4y{zX2PMo?-n8@V5 z26Q{}osAb(NO*}F%Qn5pcrfL-#l@EHvnfk0!23!Tg7#%`u6bk?agkv`w|z^kEaYTwa#Eu=ph7M%FK_%9RgO6?wt)^(6|C z?J^ZpLmHtqLJ6c)ZUfz_%jt8}?PY?NnOFUGbqR)t%EwB1PC%{(z8jMBq~{*QY_$Cy z?l2dDTa>o$pk6M|i8AT*aM8tJw;}KII1Fk_%s?J6*SD{CGq>e)(5)u0-5+4{+und$JWTv*Nf%zHh3r|EEO=4NObE34m0{vT z2X==PiwpNRcD;W8O#msK2r~pc(qKqpVPLrB+Quxq)3xm|SE$U%^0hnc7(n})@+LkE zP;_gZeiT$A{kgmGIdo2!6|`g7Py=j|gb`>=0@R{2;7`8(T5U!bXjKGg+zwmo7^D_D zPn)O2wl~l1=xZx6!L>=sjG&esw$?2#gW*Jf%^N?N4kS$qkFf`@pMl;7R<7gNC|I;e zH^n<(j@Ee_keythap?z7BbNN`(E!;6I)%gS=n}T$ixvf(d(p(OVFstZHt5^}9*-%> z6PTTJ@IznB-aPypIGHf`JH9I-*0BDyW z=-gtEI~|lj!mHlilIdoF-F63BLz1W~D!p{E4nr~v1H;m!#b3&+K`WdStJWR!eJb=c z;>j6M=tyD<8$VG7vCT@n3=gwc-q4T*8MFVkF$3sC0Z>?N(MjP>Wjc@)6kraTk^5Yv z%!|5!KwzL(w!OHH=UMqF?2_AGO&TpknuXc05tZ2 zum?0&1{rw-*)Iy|<*mzfUccCH>Vc3Pl|{NK-3&PQPvEaRAbm1p1E;XlPTN8t=~&RA z3UpMmV@0G8Xy!s;3e&8+ZE@~%wHhN&h%rLiWBlN=S?@7B9(8Mq65F&?36dkhbJP%* zgIta1n@U4meQxmwt3y*J>8!mnGeKCDAq8~)J71%4(z{?o+%rCybr{^$)8-2pgGcIl zz_a_}$5NfLg{MpMgLgtW&ff9nm&pB>=k*N0p~DAOlh424=oe;_Wi1Lq;MI=CkYl49 ze=$l0J1KxdK!QOKT#V~`^}4nRw@j~m>~qUylVQ?#b?~hSkbT1^gp%GVy$SXK?T7^L zNWOdE>haVx35LX+h?S4~BBNGLmO9>J+Vf1oZmY!}7Y_vL!c+ZjH|CZJ<5npjtD!m;3aME4oE(pbg%&3g9#gKD`%I=UaUc_Y`WG zuFAoXSm$)+-GojZNL~AF0;&y=8`nW=APb!&z&EZVYG*0rTG_p~dD0Pv_Q$U`_k{>@ zX$yhMj|YJjcY6|-o?}rza%Xu`n+l{BJ`&`1v~8-@yM)7Dvfs;p&z-!OnWtkzj|M|3 z==@LSSBA&tiC8Ov)E?Uqw7hHP+)G}vbzL)06f`Mxthql&Mph(6C)vNNzXe?1*tUbu zpyvdQadplET{{Pi>qLWu!<{+z+Z&s^Gi z?$ZQ{=XZs7&bxkq4@LEdP23EepxC*SqawJZ_h4ms z2=+ZVG~4!pb1q~o5|VR4Wt$YJY~y5Z%59#;AoR)h5c>DRH-UzQ<_g@NHH z_ep`=M8x{S3PU4rpl9Yk*`A!g>v$mOQTBfuwR< zlGshi>@uS5FT?QSl$l~0zstHRhut0eePe^QZRK1)X#S7LI?A&!Mr+FE4;}e=eNQykZ8|njB=Fw{6;SV? zYlSfje?!f+X@@plZIwxt^y83Y__;>c<-V@WqVVSzkAr64yC!VxvDGwd4Gn%QcZG97 z^Y##l>Yx^(2eu^|Yo>5dG|`u5c+q8-?Y;AjT4cx>B^TpwOKyZTpKR$;NdCD-_oPx6 zGiZ%M*FER7hP*SSP#XUB>Q(w zsMw*>%*2q8uSuPWEV>Y5bl4eK;-Tyx00;q-&K|YxuGK$!*!McTIUGyO-PhB%l z`3w(lXc=v>~rS}6tlUVSh=X}cp5R~SE;`b!^<9t?$z~fDxma=yABX#NCdSFZuDl!7+*7()%@eiqYpxg zhM=?Yz$Uzw5CP{X3Gkh(pmTH=$#ly+Vmx$u&#{Y)Y%USUIvBr7%r`Z#1D!*4!eo*e z+a%_s?zQ4K)&$@6xFzAi*U@X+7aLa*DT%iJ_|`=W4Nsna^Se=@+!S+1mmUb2yszcjXO zDLJlEyFgKQts$S6(BbsA>gu4f9I*>~5=hMwO;EU>Ubo1@_?YNs4$zX65(Q9u_Q;M0 zVZF=-JN9ZNOqq_)%_86t%9GV!c(qHHeQaWsV#r`&V3;_cYq1AAbd<6RQYKk2$bi>E zsGQn(LQ#yR;pmbD0&&kCFHkXDu`%x1W;;J9BVCivlx;2IM*oi(TAxx~OGJLH5sjyPJ{ z@I!}d1-Cx;GW#laXsib##j^>hMJeENO&rNw(0M0$poGNf=H5EJviEb^@y*kJu1Q|` zK5|czSUzZGcFiNJ8A?`pFMD1vl$fjoEu=90wxq)_X|57@2mf5bWW$Y9SQ!%xg+X3k zvU&Q(*-O{7%$jxc#^fY*Ery4mg_FwI9juh2yn|fB(m{54Iu>d!^f2*%@%=3!_zk=C#fodRUL_l zf!G3WX`eZ+$#`s8-b7>7jaO-P*PMFw6=IpAs5Z}A`Pw+G`DfwmDs4IzyOJNw}~uIBSJ)8d02>v+J+lSKTflFYFnbQxmi&f zVj8HwbFo--a+6eVFw+6a87rXfl!~;L8C2KH!|VEEQyz$jZZ_nbUJ#}L zt~a!MZ8gh4H(jliVppBMsQcCI*~1qrQwu(>S=w1*#(J5XX9)BrHD zmTTL$)AAf-=2XH8R7SIa*A9bx0P1UiN_5mc=O8sO4BbuOciiK`#4BtGvaUhWjG)zb z@cHw;i3^lh_G*E~Ez$Q8SiN7p;)3g|WG(i`!l9zjk;Hy$G1pl-3{ng)PHkK4k)_P+ zxle1K257R~q=eHk!s`8MWqfCJ^^V(gmZGes2O~~2-m{fpeZ9M)Xs*yT z1yJi7Jo>yRhXHi+Hu%g!4Yk=^TRIb8hD5EX40S%TK>GFqJw?!(oqu<}z)j?2?tEXN z*(F*at;~?k!oUzKbYkUHwq!;2U!b@JokzmY@G$$0f%XXHv_(TNWyleOV+0=6W6m@EMh; zw!5XTa`^-rEd-5VfbExvJu1uHs^KYW>;`VFcYs3!WU@r;QfANduR-Gn5253XSicUD_Nr(c7z@T|kmg8FV&s#;t}v7lt>%b>KM(QHFp+FWv?2V7#jI zE_jZ0*+#E2aiM=q3{ngMTo>*xE@0-;d&K^wRrzM@3zzka6I6Gr-vaA{loFs40x=o^ z${!#M9ZNa4xM0fx{s|RgKNz$64@;Wcp4)ObR7}dS;d2oEP`-9_r!QZMErt18O z%eZ){KmCR4k^HtaOGSQ$e|L_Y`0qv%R&b%{4K44!_Y9RI8b9YA8vrpGmUxCL*q!=n0 z9G6(dKDMvq-E@F|!n2c8>m)h~=WTg?sa_r|SGuch-l^;ftaS}6YgtS}7OcDR=6L0$ zb+Y~!l)-IwHU`7jnF}NtazX8Xe%L8Y%a?0fS=#z`Xg9OgHEfv{Q*<1(AoF#wB4~`| z);u<=Ew;R0%ByWaDGbtI1+AU2a&0>)x|@3%b5cmfOmn{vKYpM2BggS8bHyEV^W{p? zp!2I9URbqevDWn~7Ttz?8MBUhY1K^5%RDap1v(PQjZovR52+!+XId$P&dav%nbLeL zF~;DWw4O6)L$lBHx|M6T2P8KM=YVE;?7+9kLT5rxe_Qa+pbebc5_wL5IP186B(k~1 zD;-{FY3sYt%8^)lj=iSI@ImT?uPZ?(g)WxABJXy}(SC(}kH~}*x<)dy zE?;J8Y^j^^rQBLUngMh&?|O$HtJA(4#r|5l=uYX&>94BA&U>Bs6#^=uF7r?BySoB( zOV{j*)UINXVt9D@o5_WRZ!;I{zuhZ!oM#EsL;gs4P(x5(7Bv1~Wy>r2 zsBvQJ^vcIuG!<+PRdHu!rM<0aDzO9IaS00fvc(`%+t>7iS`)_^q!~CDth@1!q4a23 z{dVczWVWEj57+zDIksBtc>*f$AIdXd(lqi}cO!O#45;N(Gv~p_?=yee3VgX7uroi; zPnAK2;o*NJhCCJq1_q_W3qvE_L)T@_IV!dMp8zsz-J_xMs19d2ye$-C3qdd4L_C)@sH{{3jmDTUEIFyp@ZuGZnFyoP`Vc>r$u><(ugZcBo?Now z&H1k`ZOmIgG+Iwn>EPor2HlmIrOJ@c!oZNpaSb#|x+>Hp$@fkLALn_HiHV?E1>2Z| z7L4j<-;S;dD-<0knxUu#w?-O z%Zyn<*H*4#zH3q>9u6wiHiB;Z<_nm-!Eb5?Bg1|MN$?0YdvCZKvzJhgr}@iwZV8?a znH?+df>tEmXAl6(pU-~8w*0u};+e-el^7ZBGeG8~=9X&}H8Uwc`SSkQ$`ia?QoPWR zI?t9nx9iR?@CZ0)_2M=^*F38OOKzV9pPT|YRqFL~(8)sa43eOpz{$lM%5~NRPxQVF zNnafeD^G|*TGt5uKm6+XKy{Z4gI2P-=QO?s3BTh?JyOp-tylA<&My_?ee~IK&p|PU ziG8ZFMiZ^q9RqJ-NV~eQM@o2(4QPcc6N4;60Sf~|hN2R~i+;&$iL;J1M`rD4{b8vx z>7f!|r^!1<*^O#>1xupl%@GPwVt8?0apEfn?J%a#7K$s`CVQ^wlzyMfA@uO1jo;*@ zVdaT8gAwiRK${DUXL`l5AF-)>fbM#VXAoo9*bO>3j%S;cJG*XlWT^&^;;oO|;QQ5? z7&1WPe*6w?_g8Ev*Et#VqN#u5`#82asSBotwr@%jQ&g#ac0dhu^N;_|H(`wrj$iu~ ztFmco(aPrTr_9>Sk=r%yFbarWxpKxX8$3D*KD!>Y@3M@+l=F4SOQAS3$mxfc%U&B@ z{rnZY$&XcFXSvQJ&>S{Ds8tG@bqAf-=*iyk0aOABxLn)Lz{^nh*otk5YxHuZaL|5m zCGhO0^!il(9ePTKyssE8J)+9FZOQDCa^(#w3rvn&dFQ4n4{EZ3j+h6M^&6W zljr%@-JsJdLFp`>L54xl;a{PXQxBK^XQ|_50fHOV@)YYtcid}J_`3mAr!(=hR7`P9 z^1btbrSsA;&b1Tn3uQkNd-Qz53ef6!(7KpSv*T8Jo5gYavFQJcf0%05*T7LBxtgza z9_XY4=qZ93lMl^SnHk~ICVb4oile9E(mPQ1_H(4X3~1!daIT%m#OmXV7WW>T_`&#y zo_3m`Rc%+XxvdQ7W@6_4LvA_Ck{23smu8A}9eH-c#ZoM>?D-iZ=t$Nf@OZz%CkNRg zsV4uI5l57Y-bb(~fM?V}2{A*xX*Ty+QZ-a)@7jaE-gSmwj4 z4^YX2t*k{YM?txr4>BX3=p4Z3SfVmr5j0Q9&9HH@iZ{Ch&+=qJQ0(nzkb|z~V9~LV z?Oq|Zh!=FUrvAk0rtacvF5%@%|hnI^t9))P^%-ehD?mORg?gF4A*T zXOL(37xRCIqSZ00nT1b#UsUwS9DR}3(YMhrEv8c0O75l-=vL`F1$P8wljr)#7MZ<7 z@&&f^rU;ww-5@wSL2Q$2%yFfj!r9q^i4!Ai;?n2u;IKs3*N*5OIj=bJnC%LF25AQ5d-U9UldY3{?>NP{3pIzV0-YEm&j6VnKA-)_@8pqL zJAxHKH7l;0=&B!!mK1$h(CczhjRz#7W_=+c@=k_D0QejOHETaF#bY&GB09$Pbzfe@ELUJt zU{C_7V@Rpsv`xy|sAl%iw2+;BaUsi*Gew}9GN?$lBSHbT!;TjmBNAQw43>SDOWwGd z>glZBopkg9XjBC?q(JRU5Qgm$XE!j9TGJ^#M3j`-h8M4n$|s)*a$M6X?O(Y=0lbROjA6-1Wri28e1d-SX{*#e^ZKc=KuS=o$5ORp z&l(lOoTYJx<_Nif?xF#Wq46>(GL(Ske^Kr?WMq(Mkb|_MX81pxAS4#p@2?n;UhuAPSZl}kJ@28whUSf zg75UN9qBF4SQP$>YyKfcRUN0#FFn>@5w&Y|=rk>47CIzh&TQT8GKs@h9egVxv!vd2 zhkzS0vss=^Q7D>rLuU5Fe@VV~E=-NeZa*f<5&GzpBlx!751pok&B|9lg=DWSHIQ<5 zIHRL3)$WoC-s1?#C!lsBc;$#^gS({4wIjTK6IOs?Lm0G2{Uo1B#S}xs;vAtF!A&P3 zL2LNtGsuDc5aRoI1|y?yq@ac9ky$%F@|>SE=Z=P8kCUtpu`UFihKd*b^D2_AEYB5;o+Q3X1K>k%;NM(}hF7H!eZ z9EvZE!`r;)9gKUlVUiX@Dd_x{E!{323Q`O&x}G0sQ&QTpLF4J5Zzm8rl8Tm?-!<<<*2v9dPc3)Ec0( zB^HIP%xamg3To{z@uxlB`iAj3=iV6)Cb2|c^4+yNup+@}7s!-PJ`A7}O-u6iWE)Qf zG(KeW__Z#$ruZdCNSoK%psNo+=jq3-4!O&yb~mpNva&}WROa9{5j47lY$5~LZ4y}^ zA0W~=qAvkTEicyxPxRi+EX?HNx{d)n2E@&v#8Ae<0N&|HijS3Xx)0Rg?Us1Qr*mEf zudfea@ilR#66bS4hQc6ea4(97|Ay?03FRGYs!T+5dnmkDusFR)(gnGqyr4}oG9)Fv02@q4|E zLFmy8x#Is*|8gzWal5am2HH!n3L4ikbZ+0Im$V?M+3-Mt;Kg@>D+~{EcIkGturVZV zagI4YkC!3wS7V|fgB8ogi3eiT7<3rQLHVDd&`BZ*WCJ4YfXl~|irI;FACAOKny(9z zRRouheb$lOpB2~K+4?2Sa5>Aw^;Qy(WjuSqCB+;K@Xdpu^`PjzKSCuas2!^WGXG|U z?h7`yErE&)ZIt~$J@Cu|&nDfMYIpB?WcOYY1?6^0ggO&-P7Pi|RXs=-eJ!Z%HlG0| zuik3uS+MH1lF)RO8@BCPOfG7d zT24*`os|T--?(z;48I^3_ufU%H5M&iv_B0r+Mjsq3#-WCr^TQKO;_|SvZrc`*XuWwUADZ%i5)-AQtE23!t-;kx!$9 zs0#Ge;JVCtS-W(hiUYPL9uXwv82;=k!->W&d@^< zPnEzcmc>AFITyC_mSjvmq%rXv^J}wj&>+?U)kX<)8pcuh?4zT%fw$TR_))4XD-zoiq#@jl1p0|5$Kq zhb&aYRqk{!w8aDwkz=R=o&V`-cQx(Be=bnj3h9H*KOMaI@{IDuoYv45-nw(UFSc+R zaIP}~x9~tGx`Os;g3m9Dx^Lls>!8})~{s)z?@z8V7UW>HUSbOwC#RXq5F zZ_q~N4@TR&IJtxkJfjNQ9o={F=5-V|fbYa$V7#ust7KK$(Wf)~B{e{M zz0~teiY`2ioyXPqXl|U<(VaG;OsXmqzTG=`Mf2R#l>!<;Cr;NZazj-HrOGzX1KoPo zyx`V@qN!UQ#lvFK6j&KR<3JA>6u_&myI!tx@DW=Xw|W-OqJNyz4mDLd2(mi)vIYKU zS;NKfFGk(ar>WiPp)BP5vCHjj*Pnytf|4C}J>FdPy&z0mCtwYk@lT&2(*6?wCWYQ zZ_u_KnsTM#?mOX|?3H19WLw0?z{!qR><=D!APcT(B%&A@R2izl_rHQ}<%aA>`z`hS zz%i}eC)_0T9+mf;1J5>sVq0KInYdZx@fVj?UMlgQP}-w6*XuIqL^IH8t7q4ze&575 zM<8sXw^YfgmCWoqchY*2O6ozkj(~gMY15-PXRk>vc^Q(qOZ|kE+jPIBnTg=Mgx2Z+ zGeW1Gu)=Z5B z-T5%hZnujzW7qu~zUx=k{qVCnk-bX3KL6*OX?2Ye6FAg$8UDri>$y#5(?0l1=jtg- zy}uvUx~2a7xMJcx{o_m5I!*a_x-hRxYQN9fsVR=Dj2W~T{@rEoUOdK|A8b!4GRN936uO)rO!e>66ppY9iJy%5HYQjF!6mXGQI9+ zTXs>OxBPPP#wB5or$3I1JaZ}k&H1Ehbua%HMixyo)&}X=zAkE7$o`FQKb6~s{Zo0p z?S90q-r&dE{g~JE`#iiGe&CmDR^m6&4d=jncHgwWKeFrT`#%B&?{#aHe!F~|%}}1Z zr06K9gcgO=9W9+lIXUz^LuN$C1h6t>KvIMVZchT-3xC6HF-zHC_m(CB-Da5wWR28Oj-dvxTX>-L4rHcE?{CH?U{-Megs*28Vr zH*Ux?;eT+12i#x!z`PqYYR+x8(Sq@yDyJ;ywq27qV%N<{&N;H<`e(k30{OE{|d{VpKz2yoZ z6)grV46+QhEDQ`npc&|C(iQcf%UgX#R9oynX@bi+ThQG(iD>I9xfpgHR6k=bW%)wF zgd56Uxv9@lk%5C@=g*rNPZlI!-~_XloC2M|3mV&otuMH7BroJf$47Nt^I3~lwcL(7 zerVT4n+9QH1@L+L1qtD0m$gd|s)?y9>`+;_xNzQNon!=bMYx!?6jNvOh;Wrjz2TK?2JIBfr5zefOE>=d1NpaSlxs@*>d3;Q0>d^vd4 zzbI&hVISknzSh#k6Dx}xa`rqd0+sHjsglkAZvY0Sf=``6nMvzof z0+}n}5CFM$5hzHjzP@`nrFFWhI0NU}`Mqv@RyPiaa(&wj%4i^IEd`Lzm5;f)fmSVm zRIFOl%p0>X!CtyI#F7!DBY*jh9)3_$A^R`i``C@HFD4v3 zzpvx~MU2pOARh6g@$Xknc|5@$^P)Gc?ee{?1#8b$MOj zlkedo@OHB_cwN|BWu2gaIa;B9#i!YopS(G!5s}HzGXc`lh3awL$IbpXUJ=xShKV5B z)S%nI`%d;brrlJ`S#_+nn zoUfR##J~YzE-+5P|E1iDUs;u=M>uAGNQD-xymDD!|!P@Apc#Zmtx z_yZegU%|w$x{wm$3utddvUre{*^77YZ@hFcUZfY@`$|w(5Mcp0|5ht?d(SJmo~EyJLAMS3 zyYpc`N^pTomllI5&~jr6q>gR^%>;qH%c1ldG}a)Gb5sFz#vp7|L8|M8$6=+5j2Yhy zyiL@<#7C$IUe+$XxWU6o5j0O`qtF7ntHPwG=3yxZ=sNo;z9%oA1|JFsYIT5C!>J`4 zG?8F^{p-zB@FG`sof&M46Jq5(r+}8nMaqKL58P~2GfHmXz9^^ve+N8PfI)vY?T%lYAx5VJLn8|VL+f?LCD#~{!z-Jh zNuU#8w#;wM^VjV?yV3LT3Gi45`wa$UQ+9*T9DtNSpwb61lL~6JL1#1kjxP`}d+Y{U z*jzOqd@2QE9aW#B;u*Eka)-Eb2eelG*jsJsiQ;i)GLTeectXdz#rNut34OKOR!_NW zw5r;G>sq-I_{5{HGEIRS@H=su=5wU3Y^dVN`sli{AGy!$$Iu z>RZg7HMH(Tx}^-J261`{WHleQlUVpceQJhSyA2VP=+Ea_*SHV@QdMyt52cx=)kd0qawC zU97%wq>s^S(J5^n-E9}&@y+D|<*by`4GY#NAMEWAa*ckNdXqs8)Q+1pV;xt^9g}4) z%*=C^hO9WL@M?a;1PL`q={?F2dyspU%AmWm5|hlea*q6%yvf{Pf%IXPZ4&QXpJ<*q zS$Sz)LtsN%A*fFbx>HEdA#dVx<6YCeA}b=5kZtl2Tg-4)siWFW@WPH&>2p*T#Hu*) z+ymWDF5q$vW}75K3pD;AE5|VXCUswn_3^ib!HS^uDR(}!bjmVMahYmvaqrW@;Mrh~ zDN9VS<|&X0P@4g&LiF@H%xLa8Bk9#jpww+OSPvHlr7f20V^?K z>#T`7A;6HB#uE*?A5aFOqFD;G7O;r;LqWwC@TgD}ItJ0Z`^3mO?6 z?c3IVu`u;o_hA!gzd6F(5dMe-EGuqYS@BQclquUek&p!r2Q@+M#4C0J-V2jv>jX40 zxp_91-(Y2U2)2opL7t(Ng#kRGsRwN}fx;YgHV{J)s7KEOT}P(NB+(?Hss!o-Ly~+H zgXj6(&(jM*3)V{%URHkpll`#1;^ALKdGJkXu*56oaOv~ApOH5pmr2IEFf>;{dynAV zJ`aL?!daah_OPr!mp<2T{-Zk^z4e0+Xk>oi1Fahe?e>uf_L4sgx~uY+5|f0?W1GzM zs|(+3wo?Sf1L%TExhDq6AUe*-gT=t&n4kdT)6G2Mkrwajpz$LIn!V#Wq01x@bqcil zUjnpC2yE}86Z0N8u4Zy;3=vEcPyWCM+mkN`>7DO%WpM6!*SGG_={NZ?TnczJ1 zNkJZD!USl~KlFfx!yV(UhGV?$-zT$d>2~QjXbrl*gt-G8fZ)-CwjglWLT2_vpr;*f zPo7cxII1E|D?wz+e?{<_X)QC3akIJn#$IBxdI16qTHT>80(3y;CiqK z6vG10vQL4bjfH_BKq!<&ch&Y%G()SkwC*qBxdIZ6 z-3RKQgHBmwk>d!z`MQk97-YwPg^o4(kW(nufc&g{%ykU|C)g$ZhrX+5Fo5ngJn|{| z2G@Gm?;LYGo_)wMl7#Th@KobQOEe1wO@rnT>KV8}cb<88 zg0HCp)%Erapcw=BZJfLu#+_>FtmP*c7td{CU{GOLS!ldrwdG~@-6GSb=ma?Abh>4< zTw8Qj_aaAc0i&W{OZw_SUeGz!pjF|r3@^^77;>GmpSDW$zF=6_vhFL#L(cUi{uE^B zHf&R15M_A5zdHEe%9}OQHiwvGh*i$a;F3^n2DMTcLG4#T2Fo`VVxVIMz+&<~CbLYLfj zHR;U|<;>d2+|%KyitWZXx%Rp|B2qM zun~kLNE-?^E^rQ7_MCHEi70y{py6`l{4%E8qzJ3fS?@UOc)XWi5)oqfSH^5>%6)fU zR1_ps9`UGv#QG9M*1Yc$WVpPW$-_hXCD*QmFqIWgxfB%dx2|N_@?egU2uM}h!-lp! zTMC$U7fb`6blQdPA6ZcQ1JgeOHVi@kCLFXT%QqaLv|lx6S#khq1qEo;?C;A>PvI+sl^o-S~n*o}rV40n&m2%_KZKzTrbuNqvW`^1K(1YPqBs5_OlyWQx1D zz;+d9?o$6@s593qSV5fOUs?0(m60zb6*sgr9x3POc?vp@`hF8=HyA|MpB$|VYHdq{ zm%g0$;P{3TEnm>huTWjzu3Um{cLqllw+|Pj=6UbmI{hjesE(O%WD58c-jl09gHWJx zZ?(`CFJHFZpd|PpSlj(Z7O1Y}0r}40rc0pH59RqroD2^?KWKei#OL)F>c>Y6f}j?j zcmL&*4UO7gk|V0-L_zmxdx2^~R?vuvqap(*!^UFHHumPb8`T-4psgP8VZnQMupDka zxV37!p-!2S8Z+n=)B;sS(BT;q_cyCD${$dbkmGrm;Mq_hFAqAskwNd^hlCB*3^7d) z4<>vsua*F%d`R8T0k5@{k;@!V<#zsIuD){f^Ku2z9U5%Q42!xztzpn9`&R@HC#l;> z!PHOSjZL#m3^a@QAs^QPZp|sc%cfP3vPlT!-{?m6=DUm!gn0PbtS8)12Dt%JRttgW z#eP5<=1=7qx>y((cp1NO>1*?X^g-IlmAemcfl>vJM}LsRWF?OsUen78T|~VYYsJ+; zr)UXyG5UIecQ8%lf#|x?D6k{>`d)U1M78$a&B+%)r$~Oed(be0hapjoU6bYDV{W+; z9xVhfEb{mQeyCi+(PuxJ*gTX-f!1V#u)WcBpj0I)!FhlWbUGg-_c%=kB~Vs3rVYw+pj6hMczV4~@(eEh&xN~c zMdm!p=b59)+QVeRonXVm@US_6DQ zykeKwEh~Cj4?f|p+O0)&`eQ@Y#fN(mXM^VHgexv=VU!g#n98oiaAP@W+*P;&)FMi6 znJ5ivx867f>WCO5gXvyJC3&IcH7h$zl|U^9<79B};u$pc&I6UF(9j0$_X4@!<5